Mercurial > hg > xemacs-beta
annotate src/buffer.c @ 5124:623d57b7fbe8 ben-lisp-object
separate regular and disksave finalization, print method fixes.
Create separate disksave method and make the finalize method only be for
actual object finalization, not disksave finalization.
Fix places where 0 was given in place of a printer -- print methods are
mandatory, and internal objects formerly without a print method now must
explicitly specify internal_object_printer().
Change the defn of CONSOLE_LIVE_P to avoid problems in some weird situations.
-------------------- ChangeLog entries follow: --------------------
src/ChangeLog addition:
2010-01-20 Ben Wing <ben@xemacs.org>
* alloc.c:
* alloc.c (very_old_free_lcrecord):
* alloc.c (disksave_object_finalization_1):
* alloc.c (make_lcrecord_list):
* alloc.c (alloc_managed_lcrecord):
* alloc.c (free_managed_lcrecord):
* alloc.c (sweep_lcrecords_1):
* buffer.c:
* bytecode.c:
* bytecode.c (Fcompiled_function_p):
* chartab.c:
* console-impl.h:
* console-impl.h (CONSOLE_TYPE_P):
* console.c:
* console.c (set_quit_events):
* data.c:
* data.c (Fmake_ephemeron):
* database.c:
* database.c (finalize_database):
* database.c (Fclose_database):
* device-msw.c:
* device-msw.c (finalize_devmode):
* device-msw.c (allocate_devmode):
* device.c:
* elhash.c:
* elhash.c (finalize_hash_table):
* eval.c:
* eval.c (bind_multiple_value_limits):
* event-stream.c:
* event-stream.c (finalize_command_builder):
* events.c:
* events.c (mark_event):
* extents.c:
* extents.c (finalize_extent_info):
* extents.c (uninit_buffer_extents):
* faces.c:
* file-coding.c:
* file-coding.c (finalize_coding_system):
* file-coding.h:
* file-coding.h (struct coding_system_methods):
* file-coding.h (struct detector):
* floatfns.c:
* floatfns.c (extract_float):
* fns.c:
* fns.c (Fidentity):
* font-mgr.c (finalize_fc_pattern):
* font-mgr.c (finalize_fc_config):
* frame.c:
* glyphs.c:
* glyphs.c (finalize_image_instance):
* glyphs.c (unmap_subwindow_instance_cache_mapper):
* gui.c:
* gui.c (gui_error):
* keymap.c:
* lisp.h (struct Lisp_Symbol):
* lrecord.h:
* lrecord.h (struct lrecord_implementation):
* lrecord.h (MC_ALLOC_CALL_FINALIZER):
* lrecord.h (MC_ALLOC_CALL_FINALIZER_FOR_DISKSAVE):
* lrecord.h (DEFINE_DUMPABLE_LISP_OBJECT):
* lrecord.h (DEFINE_DUMPABLE_GENERAL_LISP_OBJECT):
* lrecord.h (DEFINE_DUMPABLE_SIZABLE_LISP_OBJECT):
* lrecord.h (DEFINE_DUMPABLE_SIZABLE_GENERAL_LISP_OBJECT):
* lrecord.h (DEFINE_DUMPABLE_FROB_BLOCK_LISP_OBJECT):
* lrecord.h (DEFINE_DUMPABLE_FROB_BLOCK_GENERAL_LISP_OBJECT):
* lrecord.h (DEFINE_DUMPABLE_FROB_BLOCK_SIZABLE_LISP_OBJECT):
* lrecord.h (DEFINE_DUMPABLE_INTERNAL_LISP_OBJECT):
* lrecord.h (DEFINE_DUMPABLE_SIZABLE_INTERNAL_LISP_OBJECT):
* lrecord.h (DEFINE_NODUMP_LISP_OBJECT):
* lrecord.h (DEFINE_NODUMP_GENERAL_LISP_OBJECT):
* lrecord.h (DEFINE_NODUMP_SIZABLE_LISP_OBJECT):
* lrecord.h (DEFINE_NODUMP_SIZABLE_GENERAL_LISP_OBJECT):
* lrecord.h (DEFINE_NODUMP_FROB_BLOCK_LISP_OBJECT):
* lrecord.h (DEFINE_NODUMP_FROB_BLOCK_GENERAL_LISP_OBJECT):
* lrecord.h (DEFINE_NODUMP_FROB_BLOCK_SIZABLE_LISP_OBJECT):
* lrecord.h (DEFINE_NODUMP_INTERNAL_LISP_OBJECT):
* lrecord.h (DEFINE_NODUMP_SIZABLE_INTERNAL_LISP_OBJECT):
* lrecord.h (MAKE_LISP_OBJECT):
* lrecord.h (DEFINE_DUMPABLE_MODULE_LISP_OBJECT):
* lrecord.h (DEFINE_DUMPABLE_MODULE_GENERAL_LISP_OBJECT):
* lrecord.h (DEFINE_DUMPABLE_MODULE_SIZABLE_LISP_OBJECT):
* lrecord.h (DEFINE_DUMPABLE_MODULE_SIZABLE_GENERAL_LISP_OBJECT):
* lrecord.h (DEFINE_NODUMP_MODULE_LISP_OBJECT):
* lrecord.h (DEFINE_NODUMP_MODULE_GENERAL_LISP_OBJECT):
* lrecord.h (DEFINE_NODUMP_MODULE_SIZABLE_LISP_OBJECT):
* lrecord.h (DEFINE_NODUMP_MODULE_SIZABLE_GENERAL_LISP_OBJECT):
* lrecord.h (MAKE_MODULE_LISP_OBJECT):
* lstream.c:
* lstream.c (finalize_lstream):
* lstream.c (disksave_lstream):
* marker.c:
* marker.c (finalize_marker):
* mule-charset.c (make_charset):
* number.c:
* objects.c:
* objects.c (finalize_color_instance):
* objects.c (finalize_font_instance):
* opaque.c:
* opaque.c (make_opaque_ptr):
* process-nt.c:
* process-nt.c (nt_finalize_process_data):
* process-nt.c (nt_deactivate_process):
* process.c:
* process.c (finalize_process):
* procimpl.h (struct process_methods):
* scrollbar.c:
* scrollbar.c (free_scrollbar_instance):
* specifier.c (finalize_specifier):
* symbols.c:
* toolbar.c:
* toolbar.c (Ftoolbar_button_p):
* tooltalk.c:
* ui-gtk.c:
* ui-gtk.c (emacs_gtk_object_finalizer):
* ui-gtk.c (allocate_emacs_gtk_boxed_data):
* window.c:
* window.c (finalize_window):
* window.c (mark_window_as_deleted):
Separate out regular and disksave finalization. Instead of a
FOR_DISKSAVE argument to the finalizer, create a separate object
method `disksaver'. Make `finalizer' have only one argument.
Go through and separate out all finalize methods into finalize
and disksave. Delete lots of thereby redundant disksave checking.
Delete places that signal an error if we attempt to disksave --
all of these objects are non-dumpable and we will get an error
from pdump anyway if we attempt to dump them. After this is done,
only one object remains that has a disksave method -- lstream.
Change DEFINE_*_LISP_OBJECT_WITH_PROPS to DEFINE_*_GENERAL_LISP_OBJECT,
which is used for specifying either property methods or disksave
methods (or in the future, any other less-used methods).
Remove the for_disksave argument to finalize_process_data. Don't
provide a disksaver for processes because no one currently needs
it.
Clean up various places where objects didn't provide a print method.
It was made mandatory in previous changes, and all methods now
either provide their own print method or use internal_object_printer
or external_object_printer.
Change the definition of CONSOLE_LIVE_P to use the contype enum
rather than looking into the conmeths structure -- in some weird
situations with dead objects, the conmeths structure is NULL,
and printing such objects from debug_print() will crash if we try
to look into the conmeths structure.
| author | Ben Wing <ben@xemacs.org> |
|---|---|
| date | Wed, 20 Jan 2010 07:05:57 -0600 |
| parents | d1247f3cc363 |
| children | b5df3737028a |
| rev | line source |
|---|---|
| 428 | 1 /* Buffer manipulation primitives for XEmacs. |
| 2 Copyright (C) 1985-1989, 1992-1995 Free Software Foundation, Inc. | |
| 3 Copyright (C) 1995 Sun Microsystems, Inc. | |
| 2367 | 4 Copyright (C) 1995, 1996, 2000, 2001, 2002, 2004 Ben Wing. |
| 428 | 5 |
| 6 This file is part of XEmacs. | |
| 7 | |
| 8 XEmacs is free software; you can redistribute it and/or modify it | |
| 9 under the terms of the GNU General Public License as published by the | |
| 10 Free Software Foundation; either version 2, or (at your option) any | |
| 11 later version. | |
| 12 | |
| 13 XEmacs is distributed in the hope that it will be useful, but WITHOUT | |
| 14 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or | |
| 15 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License | |
| 16 for more details. | |
| 17 | |
| 18 You should have received a copy of the GNU General Public License | |
| 19 along with XEmacs; see the file COPYING. If not, write to | |
| 20 the Free Software Foundation, Inc., 59 Temple Place - Suite 330, | |
| 21 Boston, MA 02111-1307, USA. */ | |
| 22 | |
| 23 /* Synched up with: Mule 2.0, FSF 19.30. */ | |
| 24 | |
| 25 /* Authorship: | |
| 26 | |
| 853 | 27 Based on code from pre-release FSF 19, c. 1991. |
| 28 Some changes by Jamie Zawinski, c. 1991-1994 (e.g. separate buffer | |
| 29 list per frame, buffer slots). | |
| 30 A few changes for buffer-local vars by Richard Mlynarik for | |
| 31 19.8 or 19.9, c. 1993. | |
| 32 Many changes by Ben Wing: changes and cleanups for Mule, esp. the | |
| 33 macros in buffer.h and the intial version of the coding-system | |
| 34 conversion macros (in buffer.h) and associated fns. (in this file), | |
| 35 19.12 (c. 1995); synch. to FSF 19.30 c. 1994; memory usage stats | |
| 36 c. 1996; generated-modeline-string c. 1996 for mousable modeline in | |
| 37 19.14. | |
| 38 Indirect buffer code by Hrvoje Niksic, c. 1997? | |
| 39 Coding conversion code rewritten by Martin Buchholz, early 2000, | |
| 40 based on design by Ben Wing. */ | |
| 428 | 41 |
| 42 /* This file contains functions that work with buffer objects. | |
| 43 Functions that manipulate a buffer's text, however, are not | |
| 44 in this file: | |
| 45 | |
| 46 1) The low-level functions that actually know about the | |
| 47 implementation of a buffer's text are located in insdel.c. | |
| 48 2) The higher-level (mostly Lisp) functions that manipulate a | |
| 49 buffer's text are in editfns.c. | |
| 50 3) The highest-level Lisp commands are in cmds.c. | |
| 51 | |
| 52 However: | |
| 53 | |
| 54 -- Functions that know about syntax tables (forward-word, | |
| 55 scan-sexps, etc.) are in syntax.c, as are functions | |
| 56 that manipulate syntax tables. | |
| 57 -- Functions that know about case tables (upcase, downcase, | |
| 58 etc.) are in casefiddle.c. Functions that manipulate | |
| 59 case tables (case-table-p, set-case-table, etc.) are | |
| 60 in casetab.c. | |
| 61 -- Functions that do searching and replacing are in | |
| 62 search.c. The low-level functions that implement | |
| 63 regular expressions are in regex.c. | |
| 64 | |
| 65 Also: | |
| 66 | |
| 67 -- Some file and process functions (in fileio.c and process.c) | |
| 68 copy text from or insert text into a buffer; they call | |
| 69 low-level functions in insdel.c to do this. | |
| 70 -- insdel.c calls low-level functions in undo.c and extents.c | |
| 71 to record buffer modifications for undoing and to handle | |
| 72 extent adjustment and extent-data creation and insertion. | |
| 73 | |
| 74 */ | |
| 75 | |
| 76 #include <config.h> | |
| 77 #include "lisp.h" | |
| 78 | |
| 79 #include "buffer.h" | |
| 80 #include "chartab.h" | |
| 446 | 81 #include "casetab.h" |
| 428 | 82 #include "commands.h" |
| 872 | 83 #include "device-impl.h" |
| 428 | 84 #include "elhash.h" |
| 85 #include "extents.h" | |
| 86 #include "faces.h" | |
| 440 | 87 #include "file-coding.h" |
| 872 | 88 #include "frame-impl.h" |
| 428 | 89 #include "insdel.h" |
| 440 | 90 #include "lstream.h" |
| 428 | 91 #include "process.h" /* for kill_buffer_processes */ |
| 92 #ifdef REGION_CACHE_NEEDS_WORK | |
| 93 #include "region-cache.h" | |
| 94 #endif | |
| 442 | 95 #include "select.h" /* for select_notify_buffer_kill */ |
| 428 | 96 #include "specifier.h" |
| 97 #include "syntax.h" | |
| 98 #include "window.h" | |
| 99 | |
| 100 #include "sysfile.h" | |
| 771 | 101 #include "sysdir.h" |
| 102 | |
| 103 #ifdef WIN32_NATIVE | |
| 104 #include "syswindows.h" | |
| 105 #endif | |
| 428 | 106 |
| 107 struct buffer *current_buffer; /* the current buffer */ | |
| 108 | |
| 109 /* This structure holds the default values of the buffer-local variables | |
| 110 defined with DEFVAR_BUFFER_LOCAL, that have special slots in each buffer. | |
| 111 The default value occupies the same slot in this structure | |
| 112 as an individual buffer's value occupies in that buffer. | |
| 113 Setting the default value also goes through the alist of buffers | |
| 114 and stores into each buffer that does not say it has a local value. */ | |
| 115 Lisp_Object Vbuffer_defaults; | |
| 116 static void *buffer_defaults_saved_slots; | |
| 117 | |
| 118 /* This structure marks which slots in a buffer have corresponding | |
| 119 default values in Vbuffer_defaults. | |
| 120 Each such slot has a nonzero value in this structure. | |
| 121 The value has only one nonzero bit. | |
| 122 | |
| 123 When a buffer has its own local value for a slot, | |
| 124 the bit for that slot (found in the same slot in this structure) | |
| 125 is turned on in the buffer's local_var_flags slot. | |
| 126 | |
| 127 If a slot in this structure is 0, then there is a DEFVAR_BUFFER_LOCAL | |
| 128 for the slot, but there is no default value for it; the corresponding | |
| 129 slot in Vbuffer_defaults is not used except to initialize newly-created | |
| 130 buffers. | |
| 131 | |
| 132 If a slot is -1, then there is a DEFVAR_BUFFER_LOCAL for it | |
| 133 as well as a default value which is used to initialize newly-created | |
| 134 buffers and as a reset-value when local-vars are killed. | |
| 135 | |
| 136 If a slot is -2, there is no DEFVAR_BUFFER_LOCAL for it. | |
| 137 (The slot is always local, but there's no lisp variable for it.) | |
| 138 The default value is only used to initialize newly-creation buffers. | |
| 139 | |
| 140 If a slot is -3, then there is no DEFVAR_BUFFER_LOCAL for it but | |
| 141 there is a default which is used to initialize newly-creation | |
| 142 buffers and as a reset-value when local-vars are killed. */ | |
| 143 struct buffer buffer_local_flags; | |
| 144 | |
| 145 /* This is the initial (startup) directory, as used for the *scratch* buffer. | |
| 771 | 146 This is no longer global. Use get_initial_directory() to retrieve it. |
| 428 | 147 */ |
| 867 | 148 static Ibyte *initial_directory; |
| 428 | 149 |
| 150 /* This structure holds the names of symbols whose values may be | |
| 151 buffer-local. It is indexed and accessed in the same way as the above. */ | |
| 152 static Lisp_Object Vbuffer_local_symbols; | |
| 153 static void *buffer_local_symbols_saved_slots; | |
| 154 | |
| 155 /* Alist of all buffer names vs the buffers. */ | |
| 156 /* This used to be a variable, but is no longer, | |
| 157 to prevent lossage due to user rplac'ing this alist or its elements. | |
| 158 Note that there is a per-frame copy of this as well; the frame slot | |
| 159 and the global variable contain the same data, but possibly in different | |
| 160 orders, so that the buffer ordering can be per-frame. | |
| 161 */ | |
| 162 Lisp_Object Vbuffer_alist; | |
| 163 | |
| 164 /* Functions to call before and after each text change. */ | |
| 165 Lisp_Object Qbefore_change_functions; | |
| 166 Lisp_Object Qafter_change_functions; | |
| 167 Lisp_Object Vbefore_change_functions; | |
| 168 Lisp_Object Vafter_change_functions; | |
| 169 | |
| 170 /* #### Obsolete, for compatibility */ | |
| 171 Lisp_Object Qbefore_change_function; | |
| 172 Lisp_Object Qafter_change_function; | |
| 173 Lisp_Object Vbefore_change_function; | |
| 174 Lisp_Object Vafter_change_function; | |
| 175 | |
| 176 #if 0 /* FSFmacs */ | |
| 177 Lisp_Object Vtransient_mark_mode; | |
| 178 #endif | |
| 179 | |
| 180 /* t means ignore all read-only text properties. | |
| 181 A list means ignore such a property if its value is a member of the list. | |
| 182 Any non-nil value means ignore buffer-read-only. */ | |
| 183 Lisp_Object Vinhibit_read_only; | |
| 184 | |
| 185 /* List of functions to call that can query about killing a buffer. | |
| 186 If any of these functions returns nil, we don't kill it. */ | |
| 187 Lisp_Object Vkill_buffer_query_functions; | |
| 188 | |
| 189 /* Non-nil means delete a buffer's auto-save file when the buffer is saved. */ | |
| 190 int delete_auto_save_files; | |
| 191 | |
| 192 Lisp_Object Qbuffer_live_p; | |
| 193 Lisp_Object Qbuffer_or_string_p; | |
| 194 | |
| 195 /* List of functions to call before changing an unmodified buffer. */ | |
| 196 Lisp_Object Vfirst_change_hook; | |
| 197 Lisp_Object Qfirst_change_hook; | |
| 198 | |
| 199 Lisp_Object Qfundamental_mode; | |
| 200 Lisp_Object Qmode_class; | |
| 201 Lisp_Object Qpermanent_local; | |
| 202 | |
| 203 Lisp_Object Qprotected_field; | |
| 204 | |
| 205 Lisp_Object QSFundamental; /* A string "Fundamental" */ | |
| 206 Lisp_Object QSscratch; /* "*scratch*" */ | |
| 207 Lisp_Object Qdefault_directory; | |
| 208 | |
| 209 Lisp_Object Qkill_buffer_hook; | |
| 210 | |
| 211 Lisp_Object Qrename_auto_save_file; | |
| 212 | |
| 213 Lisp_Object Qget_file_buffer; | |
| 214 Lisp_Object Qchange_major_mode_hook, Vchange_major_mode_hook; | |
| 215 | |
| 216 Lisp_Object Qfind_file_compare_truenames; | |
| 217 | |
| 218 Lisp_Object Qswitch_to_buffer; | |
| 219 | |
| 220 /* Two thresholds controlling how much undo information to keep. */ | |
| 458 | 221 Fixnum undo_threshold; |
| 222 Fixnum undo_high_threshold; | |
| 428 | 223 |
| 224 int find_file_compare_truenames; | |
| 225 int find_file_use_truenames; | |
| 226 | |
| 227 | |
| 228 static void reset_buffer_local_variables (struct buffer *, int first_time); | |
| 229 static void nuke_all_buffer_slots (struct buffer *b, Lisp_Object zap); | |
| 230 | |
| 1204 | 231 static const struct memory_description buffer_text_description_1 [] = { |
| 232 { XD_LISP_OBJECT, offsetof (struct buffer_text, line_number_cache) }, | |
| 233 { XD_END } | |
| 234 }; | |
| 235 | |
| 3092 | 236 #ifdef NEW_GC |
|
5118
e0db3c197671
merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
diff
changeset
|
237 DEFINE_DUMPABLE_INTERNAL_LISP_OBJECT ("buffer-text", buffer_text, |
|
e0db3c197671
merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
diff
changeset
|
238 0, buffer_text_description_1, |
|
e0db3c197671
merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
diff
changeset
|
239 Lisp_Buffer_Text); |
| 3092 | 240 #endif /* NEW_GC */ |
| 241 | |
| 1204 | 242 static const struct sized_memory_description buffer_text_description = { |
| 243 sizeof (struct buffer_text), | |
| 244 buffer_text_description_1 | |
| 245 }; | |
| 246 | |
| 247 static const struct memory_description buffer_description [] = { | |
| 248 #define MARKED_SLOT(x) { XD_LISP_OBJECT, offsetof (struct buffer, x) }, | |
| 249 #include "bufslots.h" | |
| 250 | |
| 251 { XD_LISP_OBJECT, offsetof (struct buffer, extent_info) }, | |
| 252 | |
| 3092 | 253 #ifdef NEW_GC |
| 254 { XD_BLOCK_PTR, offsetof (struct buffer, text), | |
| 255 1, { &buffer_text_description } }, | |
| 256 { XD_LISP_OBJECT, offsetof (struct buffer, syntax_cache) }, | |
| 257 #else /* not NEW_GC */ | |
| 2367 | 258 { XD_BLOCK_PTR, offsetof (struct buffer, text), |
| 2551 | 259 1, { &buffer_text_description } }, |
| 2367 | 260 { XD_BLOCK_PTR, offsetof (struct buffer, syntax_cache), |
| 2551 | 261 1, { &syntax_cache_description } }, |
| 3092 | 262 #endif /* not NEW_GC */ |
| 1204 | 263 |
| 264 { XD_LISP_OBJECT, offsetof (struct buffer, indirect_children) }, | |
| 265 { XD_LISP_OBJECT, offsetof (struct buffer, base_buffer) }, | |
| 266 { XD_END } | |
| 267 }; | |
| 268 | |
| 428 | 269 static Lisp_Object |
| 270 mark_buffer (Lisp_Object obj) | |
| 271 { | |
| 272 struct buffer *buf = XBUFFER (obj); | |
| 273 | |
| 1204 | 274 #define MARKED_SLOT(x) mark_object (buf->x); |
| 428 | 275 #include "bufslots.h" |
| 276 | |
| 277 mark_object (buf->extent_info); | |
| 278 if (buf->text) | |
| 279 mark_object (buf->text->line_number_cache); | |
| 826 | 280 mark_buffer_syntax_cache (buf); |
| 428 | 281 |
| 1204 | 282 /* [[ Don't mark normally through the children slot. Actually, in this |
| 283 case, it doesn't matter. ]] | |
| 284 | |
| 285 Indirect buffers, like all buffers, are permanent objects and stay | |
| 286 around by themselves, so it doesn't matter whether we mark their | |
| 287 children. This used to contain a call to mark_conses_in_list(), to | |
| 288 mark only the conses. I deleted that function, since it's not used | |
| 289 any more and causes problems with KKCC. If we really needed such a | |
| 290 weak list, just use a weak list object, like extents do. --ben */ | |
| 428 | 291 if (! EQ (buf->indirect_children, Qnull_pointer)) |
| 1204 | 292 mark_object (buf->indirect_children); |
| 428 | 293 |
| 771 | 294 return buf->base_buffer ? wrap_buffer (buf->base_buffer) : Qnil; |
| 428 | 295 } |
| 296 | |
| 297 static void | |
| 298 print_buffer (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag) | |
| 299 { | |
| 300 struct buffer *b = XBUFFER (obj); | |
| 301 | |
| 302 if (print_readably) | |
| 303 { | |
| 304 if (!BUFFER_LIVE_P (b)) | |
| 563 | 305 printing_unreadable_object ("#<killed buffer>"); |
| 428 | 306 else |
| 563 | 307 printing_unreadable_object ("#<buffer %s>", XSTRING_DATA (b->name)); |
| 428 | 308 } |
| 309 else if (!BUFFER_LIVE_P (b)) | |
| 826 | 310 write_c_string (printcharfun, "#<killed buffer>"); |
| 428 | 311 else if (escapeflag) |
| 800 | 312 write_fmt_string_lisp (printcharfun, "#<buffer %S>", 1, b->name); |
| 428 | 313 else |
| 800 | 314 print_internal (b->name, printcharfun, 0); |
| 428 | 315 } |
| 316 | |
| 1204 | 317 void |
| 318 cleanup_buffer_undo_lists (void) | |
| 319 { | |
| 320 /* Truncate undo information at GC time. Used to be in mark_object() but | |
| 321 moved here for KKCC purposes. */ | |
| 322 | |
| 323 ALIST_LOOP_3 (name, buf, Vbuffer_alist) | |
| 324 { | |
| 325 XBUFFER (buf)->undo_list = truncate_undo_list (XBUFFER (buf)->undo_list, | |
| 326 undo_threshold, | |
| 327 undo_high_threshold); | |
| 328 } | |
| 329 } | |
| 330 | |
| 428 | 331 /* We do not need a finalize method to handle a buffer's children list |
| 332 because all buffers have `kill-buffer' applied to them before | |
| 333 they disappear, and the children removal happens then. */ | |
|
5118
e0db3c197671
merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
diff
changeset
|
334 DEFINE_NODUMP_LISP_OBJECT ("buffer", buffer, mark_buffer, |
|
5124
623d57b7fbe8
separate regular and disksave finalization, print method fixes.
Ben Wing <ben@xemacs.org>
parents:
5120
diff
changeset
|
335 print_buffer, 0, 0, 0, |
|
623d57b7fbe8
separate regular and disksave finalization, print method fixes.
Ben Wing <ben@xemacs.org>
parents:
5120
diff
changeset
|
336 buffer_description, |
|
623d57b7fbe8
separate regular and disksave finalization, print method fixes.
Ben Wing <ben@xemacs.org>
parents:
5120
diff
changeset
|
337 struct buffer); |
| 428 | 338 |
| 339 DEFUN ("bufferp", Fbufferp, 1, 1, 0, /* | |
| 340 Return t if OBJECT is an editor buffer. | |
| 341 */ | |
| 342 (object)) | |
| 343 { | |
| 344 return BUFFERP (object) ? Qt : Qnil; | |
| 345 } | |
| 346 | |
| 347 DEFUN ("buffer-live-p", Fbuffer_live_p, 1, 1, 0, /* | |
| 348 Return t if OBJECT is an editor buffer that has not been deleted. | |
| 349 */ | |
| 350 (object)) | |
| 351 { | |
| 352 return BUFFERP (object) && BUFFER_LIVE_P (XBUFFER (object)) ? Qt : Qnil; | |
| 353 } | |
| 354 | |
| 2268 | 355 static DECLARE_DOESNT_RETURN (nsberror (Lisp_Object)); |
| 356 | |
| 357 static DOESNT_RETURN | |
| 428 | 358 nsberror (Lisp_Object spec) |
| 359 { | |
| 360 if (STRINGP (spec)) | |
| 563 | 361 invalid_argument ("No buffer named", spec); |
| 362 invalid_argument ("Invalid buffer argument", spec); | |
| 428 | 363 } |
| 364 | |
| 365 DEFUN ("buffer-list", Fbuffer_list, 0, 1, 0, /* | |
| 366 Return a list of all existing live buffers. | |
| 367 The order is specific to the selected frame; if the optional FRAME | |
| 368 argument is provided, the ordering for that frame is returned instead. | |
| 369 If the FRAME argument is t, then the global (non-frame) ordering is | |
| 370 returned instead. | |
| 371 */ | |
| 372 (frame)) | |
| 373 { | |
| 374 return Fmapcar (Qcdr, | |
| 375 EQ (frame, Qt) ? Vbuffer_alist : | |
| 376 decode_frame (frame)->buffer_alist); | |
| 377 } | |
| 378 | |
| 379 Lisp_Object | |
| 380 get_buffer (Lisp_Object name, int error_if_deleted_or_does_not_exist) | |
| 381 { | |
| 382 if (BUFFERP (name)) | |
| 383 { | |
| 384 if (!BUFFER_LIVE_P (XBUFFER (name))) | |
| 385 { | |
| 386 if (error_if_deleted_or_does_not_exist) | |
| 387 nsberror (name); | |
| 388 return Qnil; | |
| 389 } | |
| 390 return name; | |
| 391 } | |
| 392 else | |
| 393 { | |
| 394 Lisp_Object buf; | |
| 395 struct gcpro gcpro1; | |
| 396 | |
| 397 CHECK_STRING (name); | |
| 771 | 398 name = LISP_GETTEXT (name); |
| 428 | 399 GCPRO1 (name); |
| 400 buf = Fcdr (Fassoc (name, Vbuffer_alist)); | |
| 401 UNGCPRO; | |
| 402 if (NILP (buf) && error_if_deleted_or_does_not_exist) | |
| 403 nsberror (name); | |
| 404 return buf; | |
| 405 } | |
| 406 } | |
| 407 | |
| 408 struct buffer * | |
| 409 decode_buffer (Lisp_Object buffer, int allow_string) | |
| 410 { | |
| 707 | 411 if (NILP (buffer) || (!POINTER_TYPE_P( XTYPE(buffer)))) |
| 428 | 412 return current_buffer; |
| 413 | |
| 414 if (allow_string && STRINGP (buffer)) | |
| 415 return XBUFFER (get_buffer (buffer, 1)); | |
| 416 | |
| 417 CHECK_LIVE_BUFFER (buffer); | |
| 418 return XBUFFER (buffer); | |
| 419 } | |
| 420 | |
| 421 DEFUN ("decode-buffer", Fdecode_buffer, 1, 1, 0, /* | |
| 422 Validate BUFFER or if BUFFER is nil, return the current buffer. | |
| 423 If BUFFER is a valid buffer or a string representing a valid buffer, | |
| 424 the corresponding buffer object will be returned. Otherwise an error | |
| 425 will be signaled. | |
| 426 */ | |
| 427 (buffer)) | |
| 428 { | |
| 429 struct buffer *b = decode_buffer (buffer, 1); | |
| 793 | 430 return wrap_buffer (b); |
| 428 | 431 } |
| 432 | |
| 433 #if 0 /* FSFmacs */ | |
| 434 /* bleagh!!! */ | |
| 435 /* Like Fassoc, but use Fstring_equal to compare | |
| 436 (which ignores text properties), | |
| 437 and don't ever QUIT. */ | |
| 438 | |
| 439 static Lisp_Object | |
| 440 assoc_ignore_text_properties (REGISTER Lisp_Object key, Lisp_Object list) | |
| 441 { | |
| 442 REGISTER Lisp_Object tail; | |
| 443 for (tail = list; !NILP (tail); tail = Fcdr (tail)) | |
| 444 { | |
| 445 REGISTER Lisp_Object elt, tem; | |
| 446 elt = Fcar (tail); | |
| 447 tem = Fstring_equal (Fcar (elt), key); | |
| 448 if (!NILP (tem)) | |
| 449 return elt; | |
| 450 } | |
| 451 return Qnil; | |
| 452 } | |
| 453 | |
| 454 #endif /* FSFmacs */ | |
| 455 | |
| 456 DEFUN ("get-buffer", Fget_buffer, 1, 1, 0, /* | |
| 444 | 457 Return the buffer named BUFFER-NAME (a string), or nil if there is none. |
| 458 BUFFER-NAME may also be a buffer; if so, the value is that buffer. | |
| 428 | 459 */ |
| 444 | 460 (buffer_name)) |
| 428 | 461 { |
| 462 #ifdef I18N3 | |
| 463 /* #### Doc string should indicate that the buffer name will get | |
| 464 translated. */ | |
| 465 #endif | |
| 466 | |
| 467 /* #### This might return a dead buffer. This is gross. This is | |
| 468 called FSF compatibility. */ | |
| 444 | 469 if (BUFFERP (buffer_name)) |
| 470 return buffer_name; | |
| 471 return get_buffer (buffer_name, 0); | |
| 428 | 472 /* FSFmacs 19.29 calls assoc_ignore_text_properties() here. |
| 473 Bleagh!! */ | |
| 474 } | |
| 475 | |
| 476 | |
| 477 DEFUN ("get-file-buffer", Fget_file_buffer, 1, 1, 0, /* | |
| 478 Return the buffer visiting file FILENAME (a string). | |
| 479 The buffer's `buffer-file-name' must match exactly the expansion of FILENAME. | |
| 480 If there is no such live buffer, return nil. | |
| 481 | |
| 482 Normally, the comparison is done by canonicalizing FILENAME (using | |
| 483 `expand-file-name') and comparing that to the value of `buffer-file-name' | |
| 484 for each existing buffer. However, If `find-file-compare-truenames' is | |
| 485 non-nil, FILENAME will be converted to its truename and the search will be | |
| 486 done on each buffer's value of `buffer-file-truename' instead of | |
| 487 `buffer-file-name'. Otherwise, if `find-file-use-truenames' is non-nil, | |
| 488 FILENAME will be converted to its truename and used for searching, but | |
| 489 the search will still be done on `buffer-file-name'. | |
| 490 */ | |
| 491 (filename)) | |
| 492 { | |
| 442 | 493 /* This function can GC. GC checked and fixed 7-11-2000 ben. */ |
| 428 | 494 struct gcpro gcpro1; |
| 495 | |
| 496 #ifdef I18N3 | |
| 497 /* DO NOT translate the filename. */ | |
| 498 #endif | |
| 499 GCPRO1 (filename); | |
| 500 CHECK_STRING (filename); | |
| 501 filename = Fexpand_file_name (filename, Qnil); | |
| 502 { | |
| 503 /* If the file name has special constructs in it, | |
| 504 call the corresponding file handler. */ | |
| 505 Lisp_Object handler = Ffind_file_name_handler (filename, Qget_file_buffer); | |
| 506 if (!NILP (handler)) | |
| 507 { | |
| 508 UNGCPRO; | |
| 509 return call2 (handler, Qget_file_buffer, filename); | |
| 510 } | |
| 511 } | |
| 512 UNGCPRO; | |
| 513 | |
| 514 if (find_file_compare_truenames || find_file_use_truenames) | |
| 515 { | |
| 516 struct gcpro ngcpro1, ngcpro2, ngcpro3; | |
| 517 Lisp_Object fn = Qnil; | |
| 518 Lisp_Object dn = Qnil; | |
| 519 | |
| 520 NGCPRO3 (fn, dn, filename); | |
| 521 fn = Ffile_truename (filename, Qnil); | |
| 522 if (NILP (fn)) | |
| 523 { | |
| 524 dn = Ffile_name_directory (filename); | |
| 525 fn = Ffile_truename (dn, Qnil); | |
| 526 if (! NILP (fn)) dn = fn; | |
| 442 | 527 /* Formerly the two calls below were combined, but that is |
| 528 not GC-safe because the first call returns unprotected | |
| 529 data and the second call can GC. --ben */ | |
| 530 fn = Ffile_name_nondirectory (filename); | |
| 531 fn = Fexpand_file_name (fn, dn); | |
| 428 | 532 } |
| 533 filename = fn; | |
| 534 NUNGCPRO; | |
| 535 } | |
| 536 | |
| 537 { | |
| 1204 | 538 ALIST_LOOP_3 (name, buf, Vbuffer_alist) |
| 428 | 539 { |
| 540 if (!STRINGP (XBUFFER (buf)->filename)) continue; | |
| 541 if (!NILP (Fstring_equal (filename, | |
| 542 (find_file_compare_truenames | |
| 543 ? XBUFFER (buf)->file_truename | |
| 544 : XBUFFER (buf)->filename)))) | |
| 545 return buf; | |
| 546 } | |
| 547 } | |
| 548 return Qnil; | |
| 549 } | |
| 550 | |
| 551 | |
| 552 static void | |
| 553 push_buffer_alist (Lisp_Object name, Lisp_Object buf) | |
| 554 { | |
| 555 Lisp_Object cons = Fcons (name, buf); | |
| 556 Lisp_Object frmcons, devcons, concons; | |
| 557 | |
| 558 Vbuffer_alist = nconc2 (Vbuffer_alist, Fcons (cons, Qnil)); | |
| 559 FRAME_LOOP_NO_BREAK (frmcons, devcons, concons) | |
| 560 { | |
| 561 struct frame *f; | |
| 562 f = XFRAME (XCAR (frmcons)); | |
| 563 f->buffer_alist = nconc2 (f->buffer_alist, Fcons (cons, Qnil)); | |
| 564 } | |
| 565 } | |
| 566 | |
| 567 static void | |
| 568 delete_from_buffer_alist (Lisp_Object buf) | |
| 569 { | |
| 570 Lisp_Object cons = Frassq (buf, Vbuffer_alist); | |
| 571 Lisp_Object frmcons, devcons, concons; | |
| 572 if (NILP (cons)) | |
| 2500 | 573 return; /* ABORT() ? */ |
| 428 | 574 Vbuffer_alist = delq_no_quit (cons, Vbuffer_alist); |
| 575 | |
| 576 FRAME_LOOP_NO_BREAK (frmcons, devcons, concons) | |
| 577 { | |
| 578 struct frame *f; | |
| 579 f = XFRAME (XCAR (frmcons)); | |
| 580 f->buffer_alist = delq_no_quit (cons, f->buffer_alist); | |
| 581 } | |
| 582 } | |
| 583 | |
| 584 Lisp_Object | |
| 585 get_truename_buffer (REGISTER Lisp_Object filename) | |
| 586 { | |
| 442 | 587 /* This function can GC. GC correct 7-11-00 ben */ |
| 428 | 588 /* FSFmacs has its own code here and doesn't call get-file-buffer. |
| 589 That's because their equivalent of find-file-compare-truenames | |
| 590 (find-file-existing-other-name) isn't looked at in get-file-buffer. | |
| 591 This way is more correct. */ | |
| 592 int count = specpdl_depth (); | |
| 593 | |
| 594 specbind (Qfind_file_compare_truenames, Qt); | |
| 771 | 595 return unbind_to_1 (count, Fget_file_buffer (filename)); |
| 428 | 596 } |
| 597 | |
| 598 static struct buffer * | |
| 599 allocate_buffer (void) | |
| 600 { | |
|
5117
3742ea8250b5
Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents:
3024
diff
changeset
|
601 Lisp_Object obj = ALLOC_LISP_OBJECT (buffer); |
|
3742ea8250b5
Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents:
3024
diff
changeset
|
602 struct buffer *b = XBUFFER (obj); |
| 3017 | 603 |
|
5120
d1247f3cc363
latest work on lisp-object workspace;
Ben Wing <ben@xemacs.org>
parents:
5118
diff
changeset
|
604 COPY_LISP_OBJECT (b, XBUFFER (Vbuffer_defaults)); |
| 428 | 605 |
| 606 return b; | |
| 607 } | |
| 608 | |
| 609 static Lisp_Object | |
| 610 finish_init_buffer (struct buffer *b, Lisp_Object name) | |
| 611 { | |
| 793 | 612 Lisp_Object buf = wrap_buffer (b); |
| 428 | 613 |
| 614 name = Fcopy_sequence (name); | |
| 615 /* #### This really does not need to be called. We already | |
| 616 initialized the buffer-local variables in allocate_buffer(). | |
| 617 local_var_alist is set to Qnil at the same point, in | |
| 618 nuke_all_buffer_slots(). */ | |
| 619 reset_buffer_local_variables (b, 1); | |
| 442 | 620 b->directory = current_buffer ? current_buffer->directory : Qnil; |
| 428 | 621 |
| 622 b->last_window_start = 1; | |
| 623 | |
| 624 b->name = name; | |
| 826 | 625 if (string_byte (name, 0) != ' ') |
| 428 | 626 b->undo_list = Qnil; |
| 627 else | |
| 628 b->undo_list = Qt; | |
| 629 | |
| 630 /* initialize the extent list */ | |
| 631 init_buffer_extents (b); | |
| 632 | |
| 633 /* Put this in the alist of all live buffers. */ | |
| 634 push_buffer_alist (name, buf); | |
| 853 | 635 note_object_created (buf); |
| 428 | 636 |
| 637 init_buffer_markers (b); | |
| 826 | 638 init_buffer_syntax_cache (b); |
| 428 | 639 |
| 640 b->generated_modeline_string = Fmake_string (make_int (84), make_int (' ')); | |
| 641 b->modeline_extent_table = make_lisp_hash_table (20, HASH_TABLE_KEY_WEAK, | |
| 642 HASH_TABLE_EQ); | |
| 643 | |
| 853 | 644 |
| 428 | 645 return buf; |
| 646 } | |
| 647 | |
| 648 DEFUN ("get-buffer-create", Fget_buffer_create, 1, 1, 0, /* | |
| 649 Return the buffer named NAME, or create such a buffer and return it. | |
| 650 A new buffer is created if there is no live buffer named NAME. | |
| 651 If NAME starts with a space, the new buffer does not keep undo information. | |
| 652 If NAME is a buffer instead of a string, then it is the value returned. | |
| 653 The value is never nil. | |
| 654 */ | |
| 655 (name)) | |
| 656 { | |
| 657 /* This function can GC */ | |
| 658 Lisp_Object buf; | |
| 659 REGISTER struct buffer *b; | |
| 660 | |
| 661 #ifdef I18N3 | |
| 662 /* #### Doc string should indicate that the buffer name will get | |
| 663 translated. */ | |
| 664 #endif | |
| 665 | |
| 666 name = LISP_GETTEXT (name); | |
| 667 buf = Fget_buffer (name); | |
| 668 if (!NILP (buf)) | |
| 669 return buf; | |
| 670 | |
| 671 if (XSTRING_LENGTH (name) == 0) | |
| 563 | 672 invalid_argument ("Empty string for buffer name is not allowed", |
| 673 Qunbound); | |
| 428 | 674 |
| 675 b = allocate_buffer (); | |
| 676 | |
| 677 b->text = &b->own_text; | |
| 678 b->base_buffer = 0; | |
| 679 b->indirect_children = Qnil; | |
| 680 init_buffer_text (b); | |
| 681 | |
| 682 return finish_init_buffer (b, name); | |
| 683 } | |
| 684 | |
| 685 DEFUN ("make-indirect-buffer", Fmake_indirect_buffer, 2, 2, | |
| 686 "bMake indirect buffer (to buffer): \nBName of indirect buffer: ", /* | |
| 444 | 687 Create and return an indirect buffer for buffer BASE-BUFFER, named NAME. |
| 688 BASE-BUFFER should be an existing buffer (or buffer name). | |
| 428 | 689 NAME should be a string which is not the name of an existing buffer. |
| 444 | 690 |
| 691 If BASE-BUFFER is itself an indirect buffer, the base buffer for that buffer | |
| 428 | 692 is made the base buffer for the newly created buffer. (Thus, there will |
| 693 never be indirect buffers whose base buffers are themselves indirect.) | |
| 694 */ | |
| 695 (base_buffer, name)) | |
| 696 { | |
| 697 /* This function can GC */ | |
| 698 | |
| 699 /* #### The above interactive specification is totally bogus, | |
| 700 because it offers an existing buffer as default answer to the | |
| 701 second question. However, the second argument may not BE an | |
| 702 existing buffer! */ | |
| 703 struct buffer *b; | |
| 704 | |
| 705 base_buffer = get_buffer (base_buffer, 1); | |
| 706 | |
| 707 #ifdef I18N3 | |
| 708 /* #### Doc string should indicate that the buffer name will get | |
| 709 translated. */ | |
| 710 #endif | |
| 711 CHECK_STRING (name); | |
| 712 name = LISP_GETTEXT (name); | |
| 713 if (!NILP (Fget_buffer (name))) | |
| 563 | 714 invalid_argument ("Buffer name already in use", name); |
| 428 | 715 if (XSTRING_LENGTH (name) == 0) |
| 563 | 716 invalid_argument ("Empty string for buffer name is not allowed", Qunbound); |
| 428 | 717 |
| 718 b = allocate_buffer (); | |
| 719 | |
| 720 b->base_buffer = BUFFER_BASE_BUFFER (XBUFFER (base_buffer)); | |
| 721 | |
| 722 /* Use the base buffer's text object. */ | |
| 723 b->text = b->base_buffer->text; | |
| 724 b->indirect_children = Qnil; | |
| 725 b->base_buffer->indirect_children = | |
| 771 | 726 Fcons (wrap_buffer (b), b->base_buffer->indirect_children); |
| 428 | 727 init_buffer_text (b); |
| 728 | |
| 729 return finish_init_buffer (b, name); | |
| 730 } | |
| 731 | |
| 732 | |
| 733 | |
| 734 static void | |
| 735 reset_buffer_local_variables (struct buffer *b, int first_time) | |
| 736 { | |
| 737 struct buffer *def = XBUFFER (Vbuffer_defaults); | |
| 738 | |
| 739 b->local_var_flags = 0; | |
| 740 /* For each slot that has a default value, | |
| 741 copy that into the slot. */ | |
| 742 #define MARKED_SLOT(slot) \ | |
| 743 { int mask = XINT (buffer_local_flags.slot); \ | |
| 744 if ((mask > 0 || mask == -1 || mask == -3) \ | |
| 745 && (first_time \ | |
| 746 || NILP (Fget (XBUFFER (Vbuffer_local_symbols)->slot, \ | |
| 747 Qpermanent_local, Qnil)))) \ | |
| 748 b->slot = def->slot; \ | |
| 749 } | |
| 750 #include "bufslots.h" | |
| 751 } | |
| 752 | |
| 753 | |
| 754 /* We split this away from generate-new-buffer, because rename-buffer | |
| 755 and set-visited-file-name ought to be able to use this to really | |
| 756 rename the buffer properly. */ | |
| 757 | |
| 758 DEFUN ("generate-new-buffer-name", Fgenerate_new_buffer_name, 1, 2, 0, /* | |
| 759 Return a string that is the name of no existing buffer based on NAME. | |
| 760 If there is no live buffer named NAME, then return NAME. | |
| 761 Otherwise modify name by appending `<NUMBER>', incrementing NUMBER | |
| 762 until an unused name is found, and then return that name. | |
| 763 Optional second argument IGNORE specifies a name that is okay to use | |
| 764 \(if it is in the sequence to be tried) | |
| 765 even if a buffer with that name exists. | |
| 766 */ | |
| 767 (name, ignore)) | |
| 768 { | |
| 769 REGISTER Lisp_Object gentemp, tem; | |
| 770 int count; | |
| 867 | 771 Ibyte number[10]; |
| 428 | 772 |
| 773 CHECK_STRING (name); | |
| 774 | |
| 775 name = LISP_GETTEXT (name); | |
| 776 #ifdef I18N3 | |
| 777 /* #### Doc string should indicate that the buffer name will get | |
| 778 translated. */ | |
| 779 #endif | |
| 780 | |
| 781 tem = Fget_buffer (name); | |
| 782 if (NILP (tem)) | |
| 783 return name; | |
| 784 | |
| 785 count = 1; | |
| 786 while (1) | |
| 787 { | |
| 771 | 788 qxesprintf (number, "<%d>", ++count); |
| 789 gentemp = concat2 (name, build_intstring (number)); | |
| 428 | 790 if (!NILP (ignore)) |
| 791 { | |
| 792 tem = Fstring_equal (gentemp, ignore); | |
| 793 if (!NILP (tem)) | |
| 794 return gentemp; | |
| 795 } | |
| 796 tem = Fget_buffer (gentemp); | |
| 797 if (NILP (tem)) | |
| 798 return gentemp; | |
| 799 } | |
| 800 } | |
| 801 | |
| 802 | |
| 803 DEFUN ("buffer-name", Fbuffer_name, 0, 1, 0, /* | |
| 804 Return the name of BUFFER, as a string. | |
| 805 With no argument or nil as argument, return the name of the current buffer. | |
| 806 */ | |
| 807 (buffer)) | |
| 808 { | |
| 809 /* For compatibility, we allow a dead buffer here. | |
| 810 Earlier versions of Emacs didn't provide buffer-live-p. */ | |
| 811 if (NILP (buffer)) | |
| 812 return current_buffer->name; | |
| 813 CHECK_BUFFER (buffer); | |
| 814 return XBUFFER (buffer)->name; | |
| 815 } | |
| 816 | |
| 817 DEFUN ("buffer-file-name", Fbuffer_file_name, 0, 1, 0, /* | |
| 818 Return name of file BUFFER is visiting, or nil if none. | |
| 819 No argument or nil as argument means use the current buffer. | |
| 820 */ | |
| 821 (buffer)) | |
| 822 { | |
| 823 /* For compatibility, we allow a dead buffer here. Yuck! */ | |
| 824 if (NILP (buffer)) | |
| 825 return current_buffer->filename; | |
| 826 CHECK_BUFFER (buffer); | |
| 827 return XBUFFER (buffer)->filename; | |
| 828 } | |
| 829 | |
| 830 DEFUN ("buffer-base-buffer", Fbuffer_base_buffer, 0, 1, 0, /* | |
| 831 Return the base buffer of indirect buffer BUFFER. | |
| 832 If BUFFER is not indirect, return nil. | |
| 833 */ | |
| 834 (buffer)) | |
| 835 { | |
| 836 struct buffer *buf = decode_buffer (buffer, 0); | |
| 837 | |
| 771 | 838 return buf->base_buffer ? wrap_buffer (buf->base_buffer) : Qnil; |
| 428 | 839 } |
| 840 | |
| 841 DEFUN ("buffer-indirect-children", Fbuffer_indirect_children, 0, 1, 0, /* | |
| 842 Return a list of all indirect buffers whose base buffer is BUFFER. | |
| 843 If BUFFER is indirect, the return value will always be nil; see | |
| 844 `make-indirect-buffer'. | |
| 845 */ | |
| 846 (buffer)) | |
| 847 { | |
| 848 struct buffer *buf = decode_buffer (buffer, 0); | |
| 849 | |
| 850 return Fcopy_sequence (buf->indirect_children); | |
| 851 } | |
| 852 | |
| 853 DEFUN ("buffer-local-variables", Fbuffer_local_variables, 0, 1, 0, /* | |
| 854 Return an alist of variables that are buffer-local in BUFFER. | |
| 855 Most elements look like (SYMBOL . VALUE), describing one variable. | |
| 856 For a symbol that is locally unbound, just the symbol appears in the value. | |
| 857 Note that storing new VALUEs in these elements doesn't change the variables. | |
| 858 No argument or nil as argument means use current buffer as BUFFER. | |
| 859 */ | |
| 860 (buffer)) | |
| 861 { | |
| 862 struct buffer *buf = decode_buffer (buffer, 0); | |
| 863 Lisp_Object result = Qnil; | |
| 864 | |
| 865 { | |
| 866 Lisp_Object tail; | |
| 867 for (tail = buf->local_var_alist; CONSP (tail); tail = XCDR (tail)) | |
| 868 { | |
| 869 Lisp_Object elt = XCAR (tail); | |
| 870 /* Reference each variable in the alist in buf. | |
| 871 If inquiring about the current buffer, this gets the current values, | |
| 872 so store them into the alist so the alist is up to date. | |
| 873 If inquiring about some other buffer, this swaps out any values | |
| 874 for that buffer, making the alist up to date automatically. */ | |
| 875 Lisp_Object val = find_symbol_value (XCAR (elt)); | |
| 876 /* Use the current buffer value only if buf is the current buffer. */ | |
| 877 if (buf != current_buffer) | |
| 878 val = XCDR (elt); | |
| 879 | |
| 880 /* If symbol is unbound, put just the symbol in the list. */ | |
| 881 if (UNBOUNDP (val)) | |
| 882 result = Fcons (XCAR (elt), result); | |
| 883 /* Otherwise, put (symbol . value) in the list. */ | |
| 884 else | |
| 885 result = Fcons (Fcons (XCAR (elt), val), result); | |
| 886 } | |
| 887 } | |
| 888 | |
| 889 /* Add on all the variables stored in special slots. */ | |
| 890 { | |
| 891 struct buffer *syms = XBUFFER (Vbuffer_local_symbols); | |
| 892 #define MARKED_SLOT(slot) \ | |
| 893 { int mask = XINT (buffer_local_flags.slot); \ | |
| 894 if (mask == 0 || mask == -1 \ | |
| 895 || ((mask > 0) && (buf->local_var_flags & mask))) \ | |
| 896 result = Fcons (Fcons (syms->slot, buf->slot), result); \ | |
| 897 } | |
| 898 #include "bufslots.h" | |
| 899 } | |
| 900 return result; | |
| 901 } | |
| 902 | |
| 903 | |
| 904 DEFUN ("buffer-modified-p", Fbuffer_modified_p, 0, 1, 0, /* | |
| 905 Return t if BUFFER was modified since its file was last read or saved. | |
| 906 No argument or nil as argument means use current buffer as BUFFER. | |
| 907 */ | |
| 908 (buffer)) | |
| 909 { | |
| 910 struct buffer *buf = decode_buffer (buffer, 0); | |
| 911 | |
| 912 return BUF_SAVE_MODIFF (buf) < BUF_MODIFF (buf) ? Qt : Qnil; | |
| 913 } | |
| 914 | |
| 915 DEFUN ("set-buffer-modified-p", Fset_buffer_modified_p, 1, 2, 0, /* | |
| 916 Mark BUFFER as modified or unmodified according to FLAG. | |
| 917 A non-nil FLAG means mark the buffer modified. No argument or nil | |
| 918 as BUFFER means use current buffer. | |
| 919 */ | |
| 920 (flag, buffer)) | |
| 921 { | |
| 922 /* This function can GC */ | |
| 923 struct buffer *buf = decode_buffer (buffer, 0); | |
| 924 | |
| 925 #ifdef CLASH_DETECTION | |
| 926 /* If buffer becoming modified, lock the file. | |
| 927 If buffer becoming unmodified, unlock the file. */ | |
| 928 | |
| 929 Lisp_Object fn = buf->file_truename; | |
| 930 if (!NILP (fn)) | |
| 931 { | |
| 932 int already = BUF_SAVE_MODIFF (buf) < BUF_MODIFF (buf); | |
| 933 if (already == NILP (flag)) | |
| 934 { | |
| 935 int count = specpdl_depth (); | |
| 936 /* lock_file() and unlock_file() currently use current_buffer */ | |
| 937 /* #### - dmoore, what if lock_file or unlock_file kill | |
| 938 the current buffer? */ | |
| 939 record_unwind_protect (Fset_buffer, Fcurrent_buffer ()); | |
| 940 set_buffer_internal (buf); | |
| 941 if (!already && !NILP (flag)) | |
| 942 lock_file (fn); | |
| 943 else if (already && NILP (flag)) | |
| 944 unlock_file (fn); | |
| 771 | 945 unbind_to (count); |
| 428 | 946 } |
| 947 } | |
| 948 #endif /* CLASH_DETECTION */ | |
| 949 | |
| 950 /* This is often called when the buffer contents are altered but we | |
| 951 don't want to treat the changes that way (e.g. selective | |
| 952 display). We still need to make sure redisplay realizes that the | |
| 953 contents have potentially altered and it needs to do some | |
| 954 work. */ | |
| 444 | 955 buf = decode_buffer (buffer, 0); |
| 428 | 956 BUF_MODIFF (buf)++; |
| 957 BUF_SAVE_MODIFF (buf) = NILP (flag) ? BUF_MODIFF (buf) : 0; | |
| 958 MARK_MODELINE_CHANGED; | |
| 959 | |
| 960 return flag; | |
| 961 } | |
| 962 | |
| 963 DEFUN ("buffer-modified-tick", Fbuffer_modified_tick, 0, 1, 0, /* | |
| 964 Return BUFFER's tick counter, incremented for each change in text. | |
| 965 Each buffer has a tick counter which is incremented each time the text in | |
| 966 that buffer is changed. It wraps around occasionally. | |
| 967 No argument or nil as argument means use current buffer as BUFFER. | |
| 968 */ | |
| 969 (buffer)) | |
| 970 { | |
| 971 struct buffer *buf = decode_buffer (buffer, 0); | |
| 972 | |
| 973 return make_int (BUF_MODIFF (buf)); | |
| 974 } | |
| 975 | |
| 976 DEFUN ("rename-buffer", Frename_buffer, 1, 2, | |
| 977 "sRename buffer (to new name): \nP", /* | |
| 978 Change current buffer's name to NEWNAME (a string). | |
| 979 If second arg UNIQUE is nil or omitted, it is an error if a | |
| 980 buffer named NEWNAME already exists. | |
| 981 If UNIQUE is non-nil, come up with a new name using | |
| 982 `generate-new-buffer-name'. | |
| 983 Interactively, one can set UNIQUE with a prefix argument. | |
| 984 Returns the name we actually gave the buffer. | |
| 985 This does not change the name of the visited file (if any). | |
| 986 */ | |
| 987 (newname, unique)) | |
| 988 { | |
| 989 /* This function can GC */ | |
| 990 Lisp_Object tem, buf; | |
| 991 | |
| 992 #ifdef I18N3 | |
| 993 /* #### Doc string should indicate that the buffer name will get | |
| 994 translated. */ | |
| 995 #endif | |
| 996 CHECK_STRING (newname); | |
| 997 newname = LISP_GETTEXT (newname); | |
| 998 | |
| 999 if (XSTRING_LENGTH (newname) == 0) | |
| 563 | 1000 invalid_argument ("Empty string is invalid as a buffer name", Qunbound); |
| 428 | 1001 |
| 1002 tem = Fget_buffer (newname); | |
| 1003 /* Don't short-circuit if UNIQUE is t. That is a useful way to rename | |
| 1004 the buffer automatically so you can create another with the original name. | |
| 1005 It makes UNIQUE equivalent to | |
| 1006 (rename-buffer (generate-new-buffer-name NEWNAME)). */ | |
| 1007 /* XEmacs change: added check for nil */ | |
| 1008 if (NILP (unique) && !NILP (tem) && XBUFFER (tem) == current_buffer) | |
| 1009 return current_buffer->name; | |
| 1010 if (!NILP (tem)) | |
| 1011 { | |
| 1012 if (!NILP (unique)) | |
| 1013 newname = Fgenerate_new_buffer_name (newname, current_buffer->name); | |
| 1014 else | |
| 563 | 1015 invalid_argument ("Buffer name is in use", newname); |
| 428 | 1016 } |
| 1017 | |
| 1018 current_buffer->name = newname; | |
| 1019 | |
| 1020 /* Catch redisplay's attention. Unless we do this, the modelines for | |
| 1021 any windows displaying current_buffer will stay unchanged. */ | |
| 1022 MARK_MODELINE_CHANGED; | |
| 1023 | |
| 1024 buf = Fcurrent_buffer (); | |
| 1025 | |
| 1026 /* The aconses in the Vbuffer_alist are shared with frame->buffer_alist, | |
| 1027 so this will change it in the per-frame ordering as well. */ | |
| 1028 Fsetcar (Frassq (buf, Vbuffer_alist), newname); | |
| 442 | 1029 |
| 428 | 1030 if (NILP (current_buffer->filename) |
| 1031 && !NILP (current_buffer->auto_save_file_name)) | |
| 1032 call0 (Qrename_auto_save_file); | |
| 1033 /* refetch since that last call may have done GC */ | |
| 1034 /* (hypothetical relocating GC) */ | |
| 1035 return current_buffer->name; | |
| 1036 } | |
| 1037 | |
| 1038 DEFUN ("other-buffer", Fother_buffer, 0, 3, 0, /* | |
| 1039 Return most recently selected buffer other than BUFFER. | |
| 1040 Buffers not visible in windows are preferred to visible buffers, | |
| 1041 unless optional third argument VISIBLE-OK is non-nil. | |
| 1042 If no other buffer exists, the buffer `*scratch*' is returned. | |
| 1043 If BUFFER is omitted or nil, some interesting buffer is returned. | |
| 1044 | |
| 1045 The ordering is for this frame; If second optional argument FRAME | |
| 1046 is provided, then the ordering is for that frame. If the second arg | |
| 1047 is t, then the global ordering is returned. | |
| 1048 | |
| 1049 Note: In FSF Emacs, this function takes two arguments: BUFFER and | |
| 1050 VISIBLE-OK. | |
| 1051 */ | |
| 1052 (buffer, frame, visible_ok)) | |
| 1053 { | |
| 1054 /* This function can GC */ | |
| 1055 Lisp_Object tail, buf, notsogood, tem; | |
| 1056 Lisp_Object alist; | |
| 1057 | |
| 1058 notsogood = Qnil; | |
| 1059 | |
| 1060 if (EQ (frame, Qt)) | |
| 1061 alist = Vbuffer_alist; | |
| 1062 else | |
| 1063 { | |
| 1064 struct frame *f = decode_frame (frame); | |
| 1065 | |
| 793 | 1066 frame = wrap_frame (f); |
| 428 | 1067 alist = f->buffer_alist; |
| 1068 } | |
| 1069 | |
| 1070 for (tail = alist; !NILP (tail); tail = Fcdr (tail)) | |
| 1071 { | |
| 1072 buf = Fcdr (Fcar (tail)); | |
| 1073 if (EQ (buf, buffer)) | |
| 1074 continue; | |
| 826 | 1075 if (string_byte (XBUFFER (buf)->name, 0) == ' ') |
| 428 | 1076 continue; |
| 1077 /* If FRAME has a buffer_predicate, | |
| 1078 disregard buffers that don't fit the predicate. */ | |
| 1079 if (FRAMEP (frame)) | |
| 1080 { | |
| 1081 tem = XFRAME (frame)->buffer_predicate; | |
| 1082 if (!NILP (tem)) | |
| 1083 { | |
| 1084 tem = call1 (tem, buf); | |
| 1085 if (NILP (tem)) | |
| 1086 continue; | |
| 1087 } | |
| 1088 } | |
| 1089 | |
| 1090 if (NILP (visible_ok)) | |
| 1091 { | |
| 1092 /* get-buffer-window will handle nil or t frame */ | |
| 1093 tem = Fget_buffer_window (buf, frame, Qnil); | |
| 1094 } | |
| 1095 else | |
| 1096 tem = Qnil; | |
| 1097 if (NILP (tem)) | |
| 1098 return buf; | |
| 1099 if (NILP (notsogood)) | |
| 1100 notsogood = buf; | |
| 1101 } | |
| 1102 if (!NILP (notsogood)) | |
| 1103 return notsogood; | |
| 1104 return Fget_buffer_create (QSscratch); | |
| 1105 } | |
| 1106 | |
| 1107 DEFUN ("buffer-disable-undo", Fbuffer_disable_undo, 0, 1, "", /* | |
| 444 | 1108 Stop keeping undo information for BUFFER. |
| 428 | 1109 Any undo records it already has are discarded. |
| 1110 No argument or nil as argument means do this for the current buffer. | |
| 1111 */ | |
| 1112 (buffer)) | |
| 1113 { | |
| 1114 /* Allowing nil is an RMSism */ | |
| 1115 struct buffer *real_buf = decode_buffer (buffer, 1); | |
| 1116 real_buf->undo_list = Qt; | |
| 1117 return Qnil; | |
| 1118 } | |
| 1119 | |
| 1120 DEFUN ("buffer-enable-undo", Fbuffer_enable_undo, 0, 1, "", /* | |
| 444 | 1121 Start keeping undo information for BUFFER. |
| 428 | 1122 No argument or nil as argument means do this for the current buffer. |
| 1123 */ | |
| 1124 (buffer)) | |
| 1125 { | |
| 1126 /* Allowing nil is an RMSism */ | |
| 1127 struct buffer *real_buf = decode_buffer (buffer, 1); | |
| 1128 if (EQ (real_buf->undo_list, Qt)) | |
| 1129 real_buf->undo_list = Qnil; | |
| 1130 | |
| 1131 return Qnil; | |
| 1132 } | |
| 1133 | |
| 1134 DEFUN ("kill-buffer", Fkill_buffer, 1, 1, "bKill buffer: ", /* | |
| 1135 Kill the buffer BUFFER. | |
| 1136 The argument may be a buffer or may be the name of a buffer. | |
| 1137 An argument of nil means kill the current buffer. | |
| 1138 | |
| 1139 Value is t if the buffer is actually killed, nil if user says no. | |
| 1140 | |
| 1141 The value of `kill-buffer-hook' (which may be local to that buffer), | |
| 1142 if not void, is a list of functions to be called, with no arguments, | |
| 1143 before the buffer is actually killed. The buffer to be killed is current | |
| 1144 when the hook functions are called. | |
| 1145 | |
| 1146 Any processes that have this buffer as the `process-buffer' are killed | |
| 1147 with `delete-process'. | |
| 1148 */ | |
| 1149 (buffer)) | |
| 1150 { | |
| 1151 /* This function can call lisp */ | |
| 1152 Lisp_Object buf; | |
| 1153 REGISTER struct buffer *b; | |
| 2367 | 1154 struct gcpro gcpro1; |
| 428 | 1155 |
| 1156 if (NILP (buffer)) | |
| 1157 buf = Fcurrent_buffer (); | |
| 1158 else if (BUFFERP (buffer)) | |
| 1159 buf = buffer; | |
| 1160 else | |
| 1161 { | |
| 1162 buf = get_buffer (buffer, 0); | |
| 1163 if (NILP (buf)) nsberror (buffer); | |
| 1164 } | |
| 1165 | |
| 1166 b = XBUFFER (buf); | |
| 1167 | |
| 1168 /* OK to delete an already-deleted buffer. */ | |
| 1169 if (!BUFFER_LIVE_P (b)) | |
| 1170 return Qnil; | |
| 1171 | |
| 853 | 1172 check_allowed_operation (OPERATION_DELETE_OBJECT, buf, Qnil); |
| 1173 | |
| 428 | 1174 /* Don't kill the minibuffer now current. */ |
| 1175 if (EQ (buf, Vminibuffer_zero)) | |
| 1176 return Qnil; | |
| 1177 | |
| 1178 /* Or the echo area. */ | |
| 1179 if (EQ (buf, Vecho_area_buffer)) | |
| 1180 return Qnil; | |
| 1181 | |
| 1182 /* Query if the buffer is still modified. */ | |
| 1183 if (INTERACTIVE && !NILP (b->filename) | |
| 1184 && BUF_MODIFF (b) > BUF_SAVE_MODIFF (b)) | |
| 1185 { | |
| 1186 Lisp_Object killp; | |
| 1187 GCPRO1 (buf); | |
| 771 | 1188 killp = |
| 1189 call1 (Qyes_or_no_p, | |
| 1190 (emacs_sprintf_string ("Buffer %s modified; kill anyway? ", | |
| 1191 XSTRING_DATA (b->name)))); | |
| 428 | 1192 UNGCPRO; |
| 1193 if (NILP (killp)) | |
| 1194 return Qnil; | |
| 1195 b = XBUFFER (buf); /* Hypothetical relocating GC. */ | |
| 1196 } | |
| 1197 | |
| 1198 /* Run hooks with the buffer to be killed temporarily selected, | |
| 1199 unless the buffer is already dead (could have been deleted | |
| 1200 in the question above). | |
| 1201 */ | |
| 1202 if (BUFFER_LIVE_P (b)) | |
| 1203 { | |
| 1204 int speccount = specpdl_depth (); | |
| 2367 | 1205 |
| 1206 GCPRO1 (buf); | |
| 428 | 1207 record_unwind_protect (save_excursion_restore, save_excursion_save ()); |
| 1208 Fset_buffer (buf); | |
| 1209 | |
| 2367 | 1210 { |
| 1211 /* First run the query functions; if any query is answered no, | |
| 1212 don't kill the buffer. */ | |
| 1213 EXTERNAL_LIST_LOOP_2 (arg, Vkill_buffer_query_functions) | |
| 1214 { | |
| 1215 if (NILP (call0 (arg))) | |
| 1216 { | |
| 1217 UNGCPRO; | |
| 1218 return unbind_to (speccount); | |
| 1219 } | |
| 1220 } | |
| 1221 } | |
| 428 | 1222 |
| 1223 /* Then run the hooks. */ | |
| 1224 run_hook (Qkill_buffer_hook); | |
| 442 | 1225 |
| 1226 /* Inform the selection code that a buffer just got killed. | |
| 1227 We do this in C because (a) it's faster, and (b) it needs | |
| 1228 to access data internal to select.c that can't be seen from | |
| 1229 Lisp (so the Lisp code would just call into C anyway. */ | |
| 1230 select_notify_buffer_kill (buf); | |
| 1231 | |
| 771 | 1232 unbind_to (speccount); |
| 428 | 1233 UNGCPRO; |
| 1234 b = XBUFFER (buf); /* Hypothetical relocating GC. */ | |
| 1235 } | |
| 1236 | |
| 1237 /* We have no more questions to ask. Verify that it is valid | |
| 1238 to kill the buffer. This must be done after the questions | |
| 1239 since anything can happen within yes-or-no-p. */ | |
| 1240 | |
| 1241 /* Might have been deleted during the last question above */ | |
| 1242 if (!BUFFER_LIVE_P (b)) | |
| 1243 return Qnil; | |
| 1244 | |
| 1245 /* Don't kill the minibuffer now current. */ | |
| 872 | 1246 if (EQ (buf, XWINDOW_BUFFER (minibuf_window))) |
| 428 | 1247 return Qnil; |
| 1248 | |
| 1249 /* When we kill a base buffer, kill all its indirect buffers. | |
| 1250 We do it at this stage so nothing terrible happens if they | |
| 1251 ask questions or their hooks get errors. */ | |
| 1252 if (! b->base_buffer) | |
| 1253 { | |
| 1254 Lisp_Object rest; | |
| 1255 | |
| 1256 GCPRO1 (buf); | |
| 1257 | |
| 1258 LIST_LOOP (rest, b->indirect_children) | |
| 1259 { | |
| 1260 Fkill_buffer (XCAR (rest)); | |
| 1261 /* Keep indirect_children updated in case a | |
| 1262 query-function/hook throws. */ | |
| 1263 b->indirect_children = XCDR (rest); | |
| 1264 } | |
| 1265 | |
| 1266 UNGCPRO; | |
| 1267 } | |
| 1268 | |
| 1269 /* Make this buffer not be current. | |
| 1270 In the process, notice if this is the sole visible buffer | |
| 1271 and give up if so. */ | |
| 1272 if (b == current_buffer) | |
| 1273 { | |
| 1274 Fset_buffer (Fother_buffer (buf, Qnil, Qnil)); | |
| 1275 if (b == current_buffer) | |
| 1276 return Qnil; | |
| 1277 } | |
| 1278 | |
| 1279 /* Now there is no question: we can kill the buffer. */ | |
| 1280 | |
| 1281 #ifdef CLASH_DETECTION | |
| 1282 /* Unlock this buffer's file, if it is locked. unlock_buffer | |
| 1283 can both GC and kill the current buffer, and wreak general | |
| 1284 havok by running lisp code. */ | |
| 1285 GCPRO1 (buf); | |
| 1286 unlock_buffer (b); | |
| 1287 UNGCPRO; | |
| 1288 b = XBUFFER (buf); | |
| 1289 | |
| 1290 if (!BUFFER_LIVE_P (b)) | |
| 1291 return Qnil; | |
| 1292 | |
| 1293 if (b == current_buffer) | |
| 1294 { | |
| 1295 Fset_buffer (Fother_buffer (buf, Qnil, Qnil)); | |
| 1296 if (b == current_buffer) | |
| 1297 return Qnil; | |
| 1298 } | |
| 1299 #endif /* CLASH_DETECTION */ | |
| 1300 | |
| 1301 { | |
| 1302 int speccount = specpdl_depth (); | |
| 1303 specbind (Qinhibit_quit, Qt); | |
| 1304 | |
| 1305 kill_buffer_processes (buf); | |
| 1306 | |
| 442 | 1307 delete_from_buffer_alist (buf); |
| 1308 | |
| 428 | 1309 /* #### This is a problem if this buffer is in a dedicated window. |
| 1310 Need to undedicate any windows of this buffer first (and delete them?) | |
| 1311 */ | |
| 448 | 1312 GCPRO1 (buf); |
| 1313 Freplace_buffer_in_windows (buf, Qnil, Qall); | |
| 1314 UNGCPRO; | |
| 428 | 1315 |
| 826 | 1316 #ifdef USE_C_FONT_LOCK |
| 428 | 1317 font_lock_buffer_was_killed (b); |
| 826 | 1318 #endif |
| 428 | 1319 |
| 1320 /* Delete any auto-save file, if we saved it in this session. */ | |
| 1321 if (STRINGP (b->auto_save_file_name) | |
| 1322 && b->auto_save_modified != 0 | |
| 1323 && BUF_SAVE_MODIFF (b) < b->auto_save_modified) | |
| 1324 { | |
| 1325 if (delete_auto_save_files != 0) | |
| 1326 { | |
| 1327 /* deleting the auto save file might kill b! */ | |
| 1328 /* #### dmoore - fix this crap, we do this same gcpro and | |
| 1329 buffer liveness check multiple times. Let's get a | |
| 1330 macro or something for it. */ | |
| 1331 GCPRO1 (buf); | |
| 1332 internal_delete_file (b->auto_save_file_name); | |
| 1333 UNGCPRO; | |
| 1334 b = XBUFFER (buf); | |
| 1335 | |
| 1336 if (!BUFFER_LIVE_P (b)) | |
| 1337 return Qnil; | |
| 1338 | |
| 1339 if (b == current_buffer) | |
| 1340 { | |
| 1341 Fset_buffer (Fother_buffer (buf, Qnil, Qnil)); | |
| 1342 if (b == current_buffer) | |
| 1343 return Qnil; | |
| 1344 } | |
| 1345 } | |
| 1346 } | |
| 1347 | |
| 1348 uninit_buffer_markers (b); | |
| 826 | 1349 uninit_buffer_syntax_cache (b); |
| 428 | 1350 |
| 1351 kill_buffer_local_variables (b); | |
| 1352 | |
| 1353 b->name = Qnil; | |
| 1354 uninit_buffer_text (b); | |
| 1355 b->undo_list = Qnil; | |
| 1356 uninit_buffer_extents (b); | |
| 1357 if (b->base_buffer) | |
| 1358 { | |
| 800 | 1359 #ifdef ERROR_CHECK_STRUCTURES |
| 428 | 1360 assert (!NILP (memq_no_quit (buf, b->base_buffer->indirect_children))); |
| 1361 #endif | |
| 1362 b->base_buffer->indirect_children = | |
| 1363 delq_no_quit (buf, b->base_buffer->indirect_children); | |
| 1364 } | |
| 1365 | |
| 1366 /* Clear away all Lisp objects, so that they | |
| 1367 won't be protected from GC. */ | |
| 1368 nuke_all_buffer_slots (b, Qnil); | |
| 1369 | |
| 853 | 1370 note_object_deleted (buf); |
| 1371 | |
| 771 | 1372 unbind_to (speccount); |
| 428 | 1373 } |
| 1374 return Qt; | |
| 1375 } | |
| 1376 | |
| 1377 DEFUN ("record-buffer", Frecord_buffer, 1, 1, 0, /* | |
| 1378 Place buffer BUFFER first in the buffer order. | |
| 1379 Call this function when a buffer is selected "visibly". | |
| 1380 | |
| 1381 This function changes the global buffer order and the per-frame buffer | |
| 1382 order for the selected frame. The buffer order keeps track of recency | |
| 1383 of selection so that `other-buffer' will return a recently selected | |
| 1384 buffer. See `other-buffer' for more information. | |
| 1385 */ | |
| 1386 (buffer)) | |
| 1387 { | |
| 1388 REGISTER Lisp_Object lynk, prev; | |
| 1389 struct frame *f = selected_frame (); | |
| 2353 | 1390 int buffer_found = 0; |
| 1391 | |
| 1392 CHECK_BUFFER (buffer); | |
| 1393 if (!BUFFER_LIVE_P (XBUFFER (buffer))) | |
| 1394 return Qnil; | |
| 428 | 1395 prev = Qnil; |
| 1396 for (lynk = Vbuffer_alist; CONSP (lynk); lynk = XCDR (lynk)) | |
| 1397 { | |
| 1398 if (EQ (XCDR (XCAR (lynk)), buffer)) | |
| 2353 | 1399 { |
| 1400 buffer_found = 1; | |
| 1401 break; | |
| 1402 } | |
| 428 | 1403 prev = lynk; |
| 1404 } | |
| 2353 | 1405 if (buffer_found) |
| 1406 { | |
| 1407 /* Effectively do Vbuffer_alist = delq_no_quit (lynk, Vbuffer_alist) */ | |
| 1408 if (NILP (prev)) | |
| 1409 Vbuffer_alist = XCDR (Vbuffer_alist); | |
| 1410 else | |
| 1411 XCDR (prev) = XCDR (XCDR (prev)); | |
| 1412 XCDR (lynk) = Vbuffer_alist; | |
| 1413 Vbuffer_alist = lynk; | |
| 1414 } | |
| 428 | 1415 else |
| 2353 | 1416 Vbuffer_alist = Fcons (Fcons (Fbuffer_name(buffer), buffer), Vbuffer_alist); |
| 428 | 1417 |
| 1418 /* That was the global one. Now do the same thing for the | |
| 1419 per-frame buffer-alist. */ | |
| 2353 | 1420 buffer_found = 0; |
| 428 | 1421 prev = Qnil; |
| 1422 for (lynk = f->buffer_alist; CONSP (lynk); lynk = XCDR (lynk)) | |
| 1423 { | |
| 1424 if (EQ (XCDR (XCAR (lynk)), buffer)) | |
| 2353 | 1425 { |
| 1426 buffer_found = 1; | |
| 1427 break; | |
| 1428 } | |
| 428 | 1429 prev = lynk; |
| 1430 } | |
| 2353 | 1431 if (buffer_found) |
| 1432 { | |
| 1433 /* Effectively do f->buffer_alist = delq_no_quit (lynk, f->buffer_alist) */ | |
| 1434 if (NILP (prev)) | |
| 1435 f->buffer_alist = XCDR (f->buffer_alist); | |
| 1436 else | |
| 1437 XCDR (prev) = XCDR (XCDR (prev)); | |
| 1438 XCDR (lynk) = f->buffer_alist; | |
| 1439 f->buffer_alist = lynk; | |
| 1440 } | |
| 428 | 1441 else |
| 2353 | 1442 f->buffer_alist = Fcons (Fcons (Fbuffer_name(buffer), buffer), |
| 1443 f->buffer_alist); | |
| 428 | 1444 |
| 1445 return Qnil; | |
| 1446 } | |
| 1447 | |
| 1448 DEFUN ("set-buffer-major-mode", Fset_buffer_major_mode, 1, 1, 0, /* | |
| 1449 Set an appropriate major mode for BUFFER, according to `default-major-mode'. | |
| 1450 Use this function before selecting the buffer, since it may need to inspect | |
| 1451 the current buffer's major mode. | |
| 1452 */ | |
| 1453 (buffer)) | |
| 1454 { | |
| 1455 int speccount = specpdl_depth (); | |
| 1456 Lisp_Object function = XBUFFER (Vbuffer_defaults)->major_mode; | |
| 1457 | |
| 1458 if (NILP (function)) | |
| 1459 { | |
| 1460 Lisp_Object tem = Fget (current_buffer->major_mode, Qmode_class, Qnil); | |
| 1461 if (NILP (tem)) | |
| 1462 function = current_buffer->major_mode; | |
| 1463 } | |
| 1464 | |
| 1465 if (NILP (function) || EQ (function, Qfundamental_mode)) | |
| 1466 return Qnil; | |
| 1467 | |
| 1468 /* To select a nonfundamental mode, | |
| 1469 select the buffer temporarily and then call the mode function. */ | |
| 1470 | |
| 1471 record_unwind_protect (Fset_buffer, Fcurrent_buffer ()); | |
| 1472 | |
| 1473 Fset_buffer (buffer); | |
| 1474 call0 (function); | |
| 1475 | |
| 771 | 1476 return unbind_to (speccount); |
| 428 | 1477 } |
| 1478 | |
| 1479 void | |
| 1480 switch_to_buffer (Lisp_Object bufname, Lisp_Object norecord) | |
| 1481 { | |
| 1482 call2 (Qswitch_to_buffer, bufname, norecord); | |
| 1483 } | |
| 1484 | |
| 1485 | |
| 1486 DEFUN ("current-buffer", Fcurrent_buffer, 0, 0, 0, /* | |
| 1487 Return the current buffer as a Lisp object. | |
| 1488 */ | |
| 1489 ()) | |
| 1490 { | |
| 793 | 1491 return wrap_buffer (current_buffer); |
| 428 | 1492 } |
| 1493 | |
| 1494 /* Set the current buffer to B. */ | |
| 1495 | |
| 1496 void | |
| 1497 set_buffer_internal (struct buffer *b) | |
| 1498 { | |
| 1499 REGISTER struct buffer *old_buf; | |
| 1500 REGISTER Lisp_Object tail; | |
| 1501 | |
| 1502 if (current_buffer == b) | |
| 1503 return; | |
| 1504 | |
| 1505 INVALIDATE_PIXEL_TO_GLYPH_CACHE; | |
| 1506 | |
| 1507 old_buf = current_buffer; | |
| 1508 current_buffer = b; | |
| 1509 invalidate_current_column (); /* invalidate indentation cache */ | |
| 1510 | |
| 1511 if (old_buf) | |
| 1512 { | |
|
4761
b604d235f028
Synchronize window point with current point of old buffer.
Mike Sperber <sperber@deinprogramm.de>
parents:
4736
diff
changeset
|
1513 /* synchronize window point */ |
|
b604d235f028
Synchronize window point with current point of old buffer.
Mike Sperber <sperber@deinprogramm.de>
parents:
4736
diff
changeset
|
1514 Lisp_Object current_window = Fselected_window (Qnil); |
|
b604d235f028
Synchronize window point with current point of old buffer.
Mike Sperber <sperber@deinprogramm.de>
parents:
4736
diff
changeset
|
1515 if (!NILP (current_window) |
|
b604d235f028
Synchronize window point with current point of old buffer.
Mike Sperber <sperber@deinprogramm.de>
parents:
4736
diff
changeset
|
1516 && EQ(Fwindow_buffer (current_window), wrap_buffer (old_buf))) |
|
b604d235f028
Synchronize window point with current point of old buffer.
Mike Sperber <sperber@deinprogramm.de>
parents:
4736
diff
changeset
|
1517 Fset_window_point (current_window, make_int (BUF_PT (old_buf))); |
|
b604d235f028
Synchronize window point with current point of old buffer.
Mike Sperber <sperber@deinprogramm.de>
parents:
4736
diff
changeset
|
1518 |
| 428 | 1519 /* Put the undo list back in the base buffer, so that it appears |
| 1520 that an indirect buffer shares the undo list of its base. */ | |
| 1521 if (old_buf->base_buffer) | |
| 1522 old_buf->base_buffer->undo_list = old_buf->undo_list; | |
| 1523 } | |
| 1524 | |
| 1525 /* Get the undo list from the base buffer, so that it appears | |
| 1526 that an indirect buffer shares the undo list of its base. */ | |
| 1527 if (b->base_buffer) | |
| 1528 b->undo_list = b->base_buffer->undo_list; | |
| 1529 | |
| 1530 /* Look down buffer's list of local Lisp variables | |
| 1531 to find and update any that forward into C variables. */ | |
| 1532 | |
| 1533 LIST_LOOP (tail, b->local_var_alist) | |
| 1534 { | |
| 1535 Lisp_Object sym = XCAR (XCAR (tail)); | |
| 1536 Lisp_Object valcontents = XSYMBOL (sym)->value; | |
| 1537 if (SYMBOL_VALUE_MAGIC_P (valcontents)) | |
| 1538 { | |
| 1539 /* Just reference the variable | |
| 1540 to cause it to become set for this buffer. */ | |
| 1541 /* Use find_symbol_value_quickly to avoid an unnecessary O(n) | |
| 1542 lookup. */ | |
| 1543 (void) find_symbol_value_quickly (XCAR (tail), 1); | |
| 1544 } | |
| 1545 } | |
| 1546 | |
| 1547 /* Do the same with any others that were local to the previous buffer */ | |
| 1548 | |
| 1549 if (old_buf) | |
| 1550 { | |
| 1551 LIST_LOOP (tail, old_buf->local_var_alist) | |
| 1552 { | |
| 1553 Lisp_Object sym = XCAR (XCAR (tail)); | |
| 1554 Lisp_Object valcontents = XSYMBOL (sym)->value; | |
| 1555 | |
| 1556 if (SYMBOL_VALUE_MAGIC_P (valcontents)) | |
| 1557 { | |
| 1558 /* Just reference the variable | |
| 1559 to cause it to become set for this buffer. */ | |
| 1560 /* Use find_symbol_value_quickly with find_it_p as 0 to avoid an | |
| 1561 unnecessary O(n) lookup which is guaranteed to be worst case. | |
| 1562 Any symbols which are local are guaranteed to have been | |
| 1563 handled in the previous loop, above. */ | |
| 1564 (void) find_symbol_value_quickly (sym, 0); | |
| 1565 } | |
| 1566 } | |
| 1567 } | |
| 1568 } | |
| 1569 | |
| 1570 DEFUN ("set-buffer", Fset_buffer, 1, 1, 0, /* | |
| 1571 Make the buffer BUFFER current for editing operations. | |
| 1572 BUFFER may be a buffer or the name of an existing buffer. | |
| 1573 See also `save-excursion' when you want to make a buffer current temporarily. | |
| 1574 This function does not display the buffer, so its effect ends | |
| 1575 when the current command terminates. | |
| 1576 Use `switch-to-buffer' or `pop-to-buffer' to switch buffers permanently. | |
| 1577 */ | |
| 1578 (buffer)) | |
| 1579 { | |
| 1580 buffer = get_buffer (buffer, 0); | |
| 1581 if (NILP (buffer)) | |
| 563 | 1582 invalid_operation ("Selecting deleted or non-existent buffer", Qunbound); |
| 428 | 1583 set_buffer_internal (XBUFFER (buffer)); |
| 1584 return buffer; | |
| 1585 } | |
| 1586 | |
| 1587 | |
| 1588 DEFUN ("barf-if-buffer-read-only", Fbarf_if_buffer_read_only, 0, 3, 0, /* | |
| 444 | 1589 Signal a `buffer-read-only' error if BUFFER is read-only. |
| 428 | 1590 Optional argument BUFFER defaults to the current buffer. |
| 1591 | |
| 1592 If optional argument START is non-nil, all extents in the buffer | |
| 1593 which overlap that part of the buffer are checked to ensure none has a | |
| 1594 `read-only' property. (Extents that lie completely within the range, | |
| 1595 however, are not checked.) END defaults to the value of START. | |
| 1596 | |
| 1597 If START and END are equal, the range checked is [START, END] (i.e. | |
| 1598 closed on both ends); otherwise, the range checked is (START, END) | |
| 1599 \(open on both ends), except that extents that lie completely within | |
| 1600 [START, END] are not checked. See `extent-in-region-p' for a fuller | |
| 1601 discussion. | |
| 1602 */ | |
| 1603 (buffer, start, end)) | |
| 1604 { | |
| 1605 struct buffer *b = decode_buffer (buffer, 0); | |
| 665 | 1606 Charbpos s, e; |
| 428 | 1607 |
| 1608 if (NILP (start)) | |
| 1609 s = e = -1; | |
| 1610 else | |
| 1611 { | |
| 1612 if (NILP (end)) | |
| 1613 end = start; | |
| 1614 get_buffer_range_char (b, start, end, &s, &e, 0); | |
| 1615 } | |
| 1616 barf_if_buffer_read_only (b, s, e); | |
| 1617 | |
| 1618 return Qnil; | |
| 1619 } | |
| 1620 | |
| 1621 static void | |
| 1622 bury_buffer_1 (Lisp_Object buffer, Lisp_Object before, | |
| 1623 Lisp_Object *buffer_alist) | |
| 1624 { | |
| 1625 Lisp_Object aelt = rassq_no_quit (buffer, *buffer_alist); | |
| 1626 Lisp_Object lynk = memq_no_quit (aelt, *buffer_alist); | |
| 1627 Lisp_Object iter, before_before; | |
| 1628 | |
| 1629 *buffer_alist = delq_no_quit (aelt, *buffer_alist); | |
| 1630 for (before_before = Qnil, iter = *buffer_alist; | |
| 1631 !NILP (iter) && !EQ (XCDR (XCAR (iter)), before); | |
| 1632 before_before = iter, iter = XCDR (iter)) | |
| 1633 ; | |
| 1634 XCDR (lynk) = iter; | |
| 1635 if (!NILP (before_before)) | |
| 1636 XCDR (before_before) = lynk; | |
| 1637 else | |
| 1638 *buffer_alist = lynk; | |
| 1639 } | |
| 1640 | |
| 1641 DEFUN ("bury-buffer", Fbury_buffer, 0, 2, "", /* | |
| 1642 Put BUFFER at the end of the list of all buffers. | |
| 1643 There it is the least likely candidate for `other-buffer' to return; | |
| 1644 thus, the least likely buffer for \\[switch-to-buffer] to select by default. | |
| 1645 If BUFFER is nil or omitted, bury the current buffer. | |
| 1646 Also, if BUFFER is nil or omitted, remove the current buffer from the | |
| 1647 selected window if it is displayed there. | |
| 434 | 1648 Because of this, you may need to specify (current-buffer) as |
| 1649 BUFFER when calling from minibuffer. | |
| 428 | 1650 If BEFORE is non-nil, it specifies a buffer before which BUFFER |
| 1651 will be placed, instead of being placed at the end. | |
| 1652 */ | |
| 1653 (buffer, before)) | |
| 1654 { | |
| 1655 /* This function can GC */ | |
| 1656 struct buffer *buf = decode_buffer (buffer, 1); | |
| 1657 /* If we're burying the current buffer, unshow it. */ | |
| 1658 /* Note that the behavior of (bury-buffer nil) and | |
| 1659 (bury-buffer (current-buffer)) is not the same. | |
| 1660 This is illogical but is historical. Changing it | |
| 1661 breaks mh-e and TeX and such packages. */ | |
| 1662 if (NILP (buffer)) | |
| 1663 switch_to_buffer (Fother_buffer (Fcurrent_buffer (), Qnil, Qnil), Qnil); | |
| 793 | 1664 buffer = wrap_buffer (buf); |
| 428 | 1665 |
| 1666 if (!NILP (before)) | |
| 1667 before = get_buffer (before, 1); | |
| 1668 | |
| 1669 if (EQ (before, buffer)) | |
| 563 | 1670 invalid_operation ("Cannot place a buffer before itself", Qunbound); |
| 428 | 1671 |
| 1672 bury_buffer_1 (buffer, before, &Vbuffer_alist); | |
| 1673 bury_buffer_1 (buffer, before, &selected_frame ()->buffer_alist); | |
| 1674 | |
| 1675 return Qnil; | |
| 1676 } | |
| 1677 | |
| 1678 | |
| 1679 DEFUN ("erase-buffer", Ferase_buffer, 0, 1, "*", /* | |
| 1680 Delete the entire contents of the BUFFER. | |
| 1681 Any clipping restriction in effect (see `narrow-to-region') is removed, | |
| 1682 so the buffer is truly empty after this. | |
| 1683 BUFFER defaults to the current buffer if omitted. | |
| 1684 */ | |
| 1685 (buffer)) | |
| 1686 { | |
| 1687 /* This function can GC */ | |
| 1688 struct buffer *b = decode_buffer (buffer, 1); | |
| 1689 /* #### yuck yuck yuck. This is gross. The old echo-area code, | |
| 1690 however, was the only place that called erase_buffer() with a | |
| 1691 non-zero NO_CLIP argument. | |
| 1692 | |
| 1693 Someone needs to fix up the redisplay code so it is smarter | |
| 1694 about this, so that the NO_CLIP junk isn't necessary. */ | |
| 1695 int no_clip = (b == XBUFFER (Vecho_area_buffer)); | |
| 1696 | |
| 1697 INVALIDATE_PIXEL_TO_GLYPH_CACHE; | |
| 1698 | |
| 1699 widen_buffer (b, no_clip); | |
| 1700 buffer_delete_range (b, BUF_BEG (b), BUF_Z (b), 0); | |
| 1701 b->last_window_start = 1; | |
| 1702 | |
| 1703 /* Prevent warnings, or suspension of auto saving, that would happen | |
| 1704 if future size is less than past size. Use of erase-buffer | |
| 1705 implies that the future text is not really related to the past text. */ | |
| 1706 b->saved_size = Qzero; | |
| 1707 | |
| 1708 return Qnil; | |
| 1709 } | |
| 1710 | |
| 1711 | |
| 1712 | |
| 1713 DEFUN ("kill-all-local-variables", Fkill_all_local_variables, 0, 0, 0, /* | |
| 1714 Switch to Fundamental mode by killing current buffer's local variables. | |
| 1715 Most local variable bindings are eliminated so that the default values | |
| 1716 become effective once more. Also, the syntax table is set from | |
| 3143 | 1717 the standard syntax table, the category table is set from the |
| 1718 standard category table (if support for Mule exists), local keymap is set | |
| 428 | 1719 to nil, the abbrev table is set from `fundamental-mode-abbrev-table', |
| 1720 and all specifier specifications whose locale is the current buffer | |
| 1721 are removed. This function also forces redisplay of the modeline. | |
| 1722 | |
| 1723 Every function to select a new major mode starts by | |
| 1724 calling this function. | |
| 1725 | |
| 1726 As a special exception, local variables whose names have | |
| 1727 a non-nil `permanent-local' property are not eliminated by this function. | |
| 1728 | |
| 1729 The first thing this function does is run | |
| 1730 the normal hook `change-major-mode-hook'. | |
| 1731 */ | |
| 1732 ()) | |
| 1733 { | |
| 1734 /* This function can GC */ | |
| 1735 run_hook (Qchange_major_mode_hook); | |
| 1736 | |
| 1737 reset_buffer_local_variables (current_buffer, 0); | |
| 1738 | |
| 1739 kill_buffer_local_variables (current_buffer); | |
| 1740 | |
| 1741 kill_specifier_buffer_locals (Fcurrent_buffer ()); | |
| 1742 | |
| 1743 /* Force modeline redisplay. Useful here because all major mode | |
| 1744 commands call this function. */ | |
| 1745 MARK_MODELINE_CHANGED; | |
| 1746 | |
| 1747 return Qnil; | |
| 1748 } | |
| 1749 | |
| 1750 #ifdef MEMORY_USAGE_STATS | |
| 1751 | |
| 1752 struct buffer_stats | |
| 1753 { | |
| 1754 int text; | |
| 1755 int markers; | |
| 1756 int extents; | |
| 1757 int other; | |
| 1758 }; | |
| 1759 | |
| 665 | 1760 static Bytecount |
| 428 | 1761 compute_buffer_text_usage (struct buffer *b, struct overhead_stats *ovstats) |
| 1762 { | |
| 1763 int was_requested = b->text->z - 1; | |
| 665 | 1764 Bytecount gap = b->text->gap_size + b->text->end_gap_size; |
| 1765 Bytecount malloc_use = malloced_storage_size (b->text->beg, was_requested + gap, 0); | |
| 428 | 1766 |
| 1767 ovstats->gap_overhead += gap; | |
| 1768 ovstats->was_requested += was_requested; | |
| 1769 ovstats->malloc_overhead += malloc_use - (was_requested + gap); | |
| 1770 return malloc_use; | |
| 1771 } | |
| 1772 | |
| 1773 static void | |
| 1774 compute_buffer_usage (struct buffer *b, struct buffer_stats *stats, | |
| 1775 struct overhead_stats *ovstats) | |
| 1776 { | |
| 1777 xzero (*stats); | |
|
5120
d1247f3cc363
latest work on lisp-object workspace;
Ben Wing <ben@xemacs.org>
parents:
5118
diff
changeset
|
1778 stats->other += LISP_OBJECT_STORAGE_SIZE (b, sizeof (*b), ovstats); |
| 428 | 1779 stats->text += compute_buffer_text_usage (b, ovstats); |
| 1780 stats->markers += compute_buffer_marker_usage (b, ovstats); | |
| 1781 stats->extents += compute_buffer_extent_usage (b, ovstats); | |
| 1782 } | |
| 1783 | |
| 1784 DEFUN ("buffer-memory-usage", Fbuffer_memory_usage, 1, 1, 0, /* | |
| 1785 Return stats about the memory usage of buffer BUFFER. | |
| 1786 The values returned are in the form of an alist of usage types and byte | |
| 1787 counts. The byte counts attempt to encompass all the memory used | |
| 1788 by the buffer (separate from the memory logically associated with a | |
| 1789 buffer or frame), including internal structures and any malloc() | |
| 1790 overhead associated with them. In practice, the byte counts are | |
| 1791 underestimated because certain memory usage is very hard to determine | |
| 1792 \(e.g. the amount of memory used inside the Xt library or inside the | |
| 1793 X server) and because there is other stuff that might logically | |
| 1794 be associated with a window, buffer, or frame (e.g. window configurations, | |
| 1795 glyphs) but should not obviously be included in the usage counts. | |
| 1796 | |
| 1797 Multiple slices of the total memory usage may be returned, separated | |
| 1798 by a nil. Each slice represents a particular view of the memory, a | |
| 1799 particular way of partitioning it into groups. Within a slice, there | |
| 1800 is no overlap between the groups of memory, and each slice collectively | |
| 1801 represents all the memory concerned. | |
| 1802 */ | |
| 1803 (buffer)) | |
| 1804 { | |
| 1805 struct buffer_stats stats; | |
| 1806 struct overhead_stats ovstats; | |
| 1807 Lisp_Object val = Qnil; | |
| 1808 | |
| 1809 CHECK_BUFFER (buffer); /* dead buffers should be allowed, no? */ | |
| 1810 xzero (ovstats); | |
| 1811 compute_buffer_usage (XBUFFER (buffer), &stats, &ovstats); | |
| 1812 | |
| 1813 val = acons (Qtext, make_int (stats.text), val); | |
| 1814 val = acons (Qmarkers, make_int (stats.markers), val); | |
| 1815 val = acons (Qextents, make_int (stats.extents), val); | |
| 1816 val = acons (Qother, make_int (stats.other), val); | |
| 1817 val = Fcons (Qnil, val); | |
| 1818 val = acons (Qactually_requested, make_int (ovstats.was_requested), val); | |
| 1819 val = acons (Qmalloc_overhead, make_int (ovstats.malloc_overhead), val); | |
| 1820 val = acons (Qgap_overhead, make_int (ovstats.gap_overhead), val); | |
| 1821 val = acons (Qdynarr_overhead, make_int (ovstats.dynarr_overhead), val); | |
| 1822 | |
| 1823 return Fnreverse (val); | |
| 1824 } | |
| 1825 | |
| 1826 #endif /* MEMORY_USAGE_STATS */ | |
| 814 | 1827 |
| 1828 #if defined (DEBUG_XEMACS) && defined (MULE) | |
| 1829 | |
| 1830 DEFUN ("buffer-char-byte-conversion-info", Fbuffer_char_byte_converion_info, | |
| 1831 1, 1, 0, /* | |
| 1832 Return the current info used for char-byte conversion in BUFFER. | |
| 1833 The values returned are in the form of a plist of properties and values. | |
| 1834 */ | |
| 1835 (buffer)) | |
| 1836 { | |
| 1837 struct buffer *b; | |
| 1838 Lisp_Object plist = Qnil; | |
| 1839 | |
| 1840 CHECK_BUFFER (buffer); /* dead buffers should be allowed, no? */ | |
| 1841 b = XBUFFER (buffer); | |
| 1842 | |
| 1843 #define ADD_INT(field) \ | |
| 1844 plist = cons3 (make_int (b->text->field), \ | |
| 1845 intern_converting_underscores_to_dashes (#field), plist) | |
| 1846 #define ADD_BOOL(field) \ | |
| 1847 plist = cons3 (b->text->field ? Qt : Qnil, \ | |
| 1848 intern_converting_underscores_to_dashes (#field), plist) | |
| 1849 ADD_INT (bufz); | |
| 1850 ADD_INT (z); | |
| 2367 | 1851 #ifdef OLD_BYTE_CHAR |
| 814 | 1852 ADD_INT (mule_bufmin); |
| 1853 ADD_INT (mule_bufmax); | |
| 1854 ADD_INT (mule_bytmin); | |
| 1855 ADD_INT (mule_bytmax); | |
| 1856 ADD_INT (mule_shifter); | |
| 1857 ADD_BOOL (mule_three_p); | |
| 2367 | 1858 #endif |
| 826 | 1859 ADD_BOOL (entirely_one_byte_p); |
| 1860 ADD_INT (num_ascii_chars); | |
| 1861 ADD_INT (num_8_bit_fixed_chars); | |
| 1862 ADD_INT (num_16_bit_fixed_chars); | |
| 2367 | 1863 ADD_INT (cached_charpos); |
| 1864 ADD_INT (cached_bytepos); | |
| 1865 ADD_INT (next_cache_pos); | |
| 1866 | |
| 814 | 1867 { |
| 2367 | 1868 Lisp_Object pos[NUM_CACHED_POSITIONS]; |
| 814 | 1869 int i; |
| 2367 | 1870 for (i = 0; i < b->text->next_cache_pos; i++) |
| 814 | 1871 pos[i] = make_int (b->text->mule_charbpos_cache[i]); |
| 2367 | 1872 plist = cons3 (Flist (b->text->next_cache_pos, pos), |
| 1873 intern ("mule-charbpos-cache"), plist); | |
| 1874 for (i = 0; i < b->text->next_cache_pos; i++) | |
| 814 | 1875 pos[i] = make_int (b->text->mule_bytebpos_cache[i]); |
| 2367 | 1876 plist = cons3 (Flist (b->text->next_cache_pos, pos), |
| 1877 intern ("mule-bytebpos-cache"), plist); | |
| 814 | 1878 } |
| 1879 #undef ADD_INT | |
| 1880 #undef ADD_BOOL | |
| 1881 | |
| 1882 return Fnreverse (plist); | |
| 1883 } | |
| 1884 | |
| 1885 DEFUN ("string-char-byte-conversion-info", Fstring_char_byte_converion_info, 1, 1, 0, /* | |
| 1886 Return the current info used for char-byte conversion in STRING. | |
| 1887 The values returned are in the form of a plist of properties and values. | |
| 1888 */ | |
| 1889 (string)) | |
| 1890 { | |
| 1891 Lisp_Object plist = Qnil; | |
| 1892 CHECK_STRING (string); | |
| 1893 | |
| 1894 plist = cons3 (make_int (XSTRING_LENGTH (string)), | |
| 1895 intern ("byte-length"), plist); | |
| 1896 plist = cons3 (make_int (XSTRING_ASCII_BEGIN (string)), | |
| 1897 intern ("ascii-begin"), plist); | |
| 1898 | |
| 1899 return Fnreverse (plist); | |
| 1900 } | |
| 1901 | |
| 1902 #endif /* defined (DEBUG_XEMACS) && defined (MULE) */ | |
| 1903 | |
| 440 | 1904 |
| 1905 | |
| 428 | 1906 void |
| 1907 syms_of_buffer (void) | |
| 1908 { | |
|
5117
3742ea8250b5
Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents:
3024
diff
changeset
|
1909 INIT_LISP_OBJECT (buffer); |
| 3092 | 1910 #ifdef NEW_GC |
|
5118
e0db3c197671
merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
diff
changeset
|
1911 INIT_LISP_OBJECT (buffer_text); |
| 3092 | 1912 #endif /* NEW_GC */ |
| 442 | 1913 |
| 563 | 1914 DEFSYMBOL (Qbuffer_live_p); |
| 1915 DEFSYMBOL (Qbuffer_or_string_p); | |
| 1916 DEFSYMBOL (Qmode_class); | |
| 1917 DEFSYMBOL (Qrename_auto_save_file); | |
| 1918 DEFSYMBOL (Qkill_buffer_hook); | |
| 1919 DEFSYMBOL (Qpermanent_local); | |
| 1920 | |
| 1921 DEFSYMBOL (Qfirst_change_hook); | |
| 1922 DEFSYMBOL (Qbefore_change_functions); | |
| 1923 DEFSYMBOL (Qafter_change_functions); | |
| 428 | 1924 |
| 1925 /* #### Obsolete, for compatibility */ | |
| 563 | 1926 DEFSYMBOL (Qbefore_change_function); |
| 1927 DEFSYMBOL (Qafter_change_function); | |
| 1928 | |
| 1929 DEFSYMBOL (Qdefault_directory); | |
| 1930 | |
| 1931 DEFSYMBOL (Qget_file_buffer); | |
| 1932 DEFSYMBOL (Qchange_major_mode_hook); | |
| 1933 | |
| 1934 DEFSYMBOL (Qfundamental_mode); | |
| 1935 | |
| 1936 DEFSYMBOL (Qfind_file_compare_truenames); | |
| 1937 | |
| 1938 DEFSYMBOL (Qswitch_to_buffer); | |
| 428 | 1939 |
| 1940 DEFSUBR (Fbufferp); | |
| 1941 DEFSUBR (Fbuffer_live_p); | |
| 1942 DEFSUBR (Fbuffer_list); | |
| 1943 DEFSUBR (Fdecode_buffer); | |
| 1944 DEFSUBR (Fget_buffer); | |
| 1945 DEFSUBR (Fget_file_buffer); | |
| 1946 DEFSUBR (Fget_buffer_create); | |
| 1947 DEFSUBR (Fmake_indirect_buffer); | |
| 1948 | |
| 1949 DEFSUBR (Fgenerate_new_buffer_name); | |
| 1950 DEFSUBR (Fbuffer_name); | |
| 1951 DEFSUBR (Fbuffer_file_name); | |
| 1952 DEFSUBR (Fbuffer_base_buffer); | |
| 1953 DEFSUBR (Fbuffer_indirect_children); | |
| 1954 DEFSUBR (Fbuffer_local_variables); | |
| 1955 DEFSUBR (Fbuffer_modified_p); | |
| 1956 DEFSUBR (Fset_buffer_modified_p); | |
| 1957 DEFSUBR (Fbuffer_modified_tick); | |
| 1958 DEFSUBR (Frename_buffer); | |
| 1959 DEFSUBR (Fother_buffer); | |
| 1960 DEFSUBR (Fbuffer_disable_undo); | |
| 1961 DEFSUBR (Fbuffer_enable_undo); | |
| 1962 DEFSUBR (Fkill_buffer); | |
| 1963 DEFSUBR (Ferase_buffer); | |
| 1964 DEFSUBR (Frecord_buffer); | |
| 1965 DEFSUBR (Fset_buffer_major_mode); | |
| 1966 DEFSUBR (Fcurrent_buffer); | |
| 1967 DEFSUBR (Fset_buffer); | |
| 1968 DEFSUBR (Fbarf_if_buffer_read_only); | |
| 1969 DEFSUBR (Fbury_buffer); | |
| 1970 DEFSUBR (Fkill_all_local_variables); | |
| 1971 #ifdef MEMORY_USAGE_STATS | |
| 1972 DEFSUBR (Fbuffer_memory_usage); | |
| 1973 #endif | |
| 814 | 1974 #if defined (DEBUG_XEMACS) && defined (MULE) |
| 1975 DEFSUBR (Fbuffer_char_byte_converion_info); | |
| 1976 DEFSUBR (Fstring_char_byte_converion_info); | |
| 1977 #endif | |
| 428 | 1978 |
| 442 | 1979 DEFERROR (Qprotected_field, "Attempt to modify a protected field", |
| 1980 Qinvalid_change); | |
| 428 | 1981 } |
| 1982 | |
| 1983 void | |
| 1984 reinit_vars_of_buffer (void) | |
| 1985 { | |
| 1986 staticpro_nodump (&Vbuffer_alist); | |
| 1987 Vbuffer_alist = Qnil; | |
| 1988 current_buffer = 0; | |
| 1989 } | |
| 1990 | |
| 1991 /* initialize the buffer routines */ | |
| 1992 void | |
| 1993 vars_of_buffer (void) | |
| 1994 { | |
| 1995 /* This function can GC */ | |
| 1996 staticpro (&QSFundamental); | |
| 1997 staticpro (&QSscratch); | |
| 1998 | |
| 1999 QSFundamental = build_string ("Fundamental"); | |
| 2000 QSscratch = build_string (DEFER_GETTEXT ("*scratch*")); | |
| 2001 | |
| 2002 DEFVAR_LISP ("change-major-mode-hook", &Vchange_major_mode_hook /* | |
| 2003 List of hooks to be run before killing local variables in a buffer. | |
| 2004 This should be used by any mode that temporarily alters the contents or | |
| 2005 the read-only state of the buffer. See also `kill-all-local-variables'. | |
| 2006 */ ); | |
| 2007 Vchange_major_mode_hook = Qnil; | |
| 2008 | |
| 2009 DEFVAR_BOOL ("find-file-compare-truenames", &find_file_compare_truenames /* | |
| 444 | 2010 If this is true, then the `find-file' command will check the truenames |
| 428 | 2011 of all visited files when deciding whether a given file is already in |
| 444 | 2012 a buffer, instead of just `buffer-file-name'. This means that if you |
| 2013 attempt to visit another file which is a symbolic link to a file which | |
| 2014 is already in a buffer, the existing buffer will be found instead of a | |
| 2015 newly-created one. This works if any component of the pathname | |
| 2016 (including a non-terminal component) is a symbolic link as well, but | |
| 2017 doesn't work with hard links (nothing does). | |
| 2018 | |
| 2019 See also the variable `find-file-use-truenames'. | |
| 428 | 2020 */ ); |
| 446 | 2021 #if defined(CYGWIN) || defined(WIN32_NATIVE) |
| 2022 find_file_compare_truenames = 1; | |
| 2023 #else | |
| 428 | 2024 find_file_compare_truenames = 0; |
| 446 | 2025 #endif |
| 428 | 2026 |
| 2027 DEFVAR_BOOL ("find-file-use-truenames", &find_file_use_truenames /* | |
| 2028 If this is true, then a buffer's visited file-name will always be | |
| 2029 chased back to the real file; it will never be a symbolic link, and there | |
| 2030 will never be a symbolic link anywhere in its directory path. | |
| 2031 That is, the buffer-file-name and buffer-file-truename will be equal. | |
| 2032 This doesn't work with hard links. | |
| 2033 | |
| 444 | 2034 See also the variable `find-file-compare-truenames'. |
| 428 | 2035 */ ); |
| 2036 find_file_use_truenames = 0; | |
| 2037 | |
| 2038 DEFVAR_LISP ("before-change-functions", &Vbefore_change_functions /* | |
| 2039 List of functions to call before each text change. | |
| 2040 Two arguments are passed to each function: the positions of | |
| 2041 the beginning and end of the range of old text to be changed. | |
| 2042 \(For an insertion, the beginning and end are at the same place.) | |
| 2043 No information is given about the length of the text after the change. | |
| 2044 | |
| 2045 Buffer changes made while executing the `before-change-functions' | |
| 2046 don't call any before-change or after-change functions. | |
| 2047 */ ); | |
| 2048 Vbefore_change_functions = Qnil; | |
| 2049 | |
| 2050 /* FSF Emacs has the following additional doc at the end of | |
| 2051 before-change-functions and after-change-functions: | |
| 2052 | |
| 2053 That's because these variables are temporarily set to nil. | |
| 2054 As a result, a hook function cannot straightforwardly alter the value of | |
| 2055 these variables. See the Emacs Lisp manual for a way of | |
| 2056 accomplishing an equivalent result by using other variables. | |
| 2057 | |
| 2058 But this doesn't apply under XEmacs because things are | |
| 2059 handled better. */ | |
| 2060 | |
| 2061 DEFVAR_LISP ("after-change-functions", &Vafter_change_functions /* | |
| 2062 List of functions to call after each text change. | |
| 2063 Three arguments are passed to each function: the positions of | |
| 2064 the beginning and end of the range of changed text, | |
| 2065 and the length of the pre-change text replaced by that range. | |
| 2066 \(For an insertion, the pre-change length is zero; | |
| 2067 for a deletion, that length is the number of characters deleted, | |
| 2068 and the post-change beginning and end are at the same place.) | |
| 2069 | |
| 2070 Buffer changes made while executing `after-change-functions' | |
| 2071 don't call any before-change or after-change functions. | |
| 2072 */ ); | |
| 2073 Vafter_change_functions = Qnil; | |
| 2074 | |
| 2075 DEFVAR_LISP ("before-change-function", &Vbefore_change_function /* | |
| 2076 | |
| 2077 */ ); /* obsoleteness will be documented */ | |
| 2078 Vbefore_change_function = Qnil; | |
| 2079 | |
| 2080 DEFVAR_LISP ("after-change-function", &Vafter_change_function /* | |
| 2081 | |
| 2082 */ ); /* obsoleteness will be documented */ | |
| 2083 Vafter_change_function = Qnil; | |
| 2084 | |
| 2085 DEFVAR_LISP ("first-change-hook", &Vfirst_change_hook /* | |
| 2086 A list of functions to call before changing a buffer which is unmodified. | |
| 2087 The functions are run using the `run-hooks' function. | |
| 2088 */ ); | |
| 2089 Vfirst_change_hook = Qnil; | |
| 2090 | |
| 2091 #if 0 /* FSFmacs */ | |
| 2092 xxDEFVAR_LISP ("transient-mark-mode", &Vtransient_mark_mode /* | |
| 2093 *Non-nil means deactivate the mark when the buffer contents change. | |
| 2094 */ ); | |
| 2095 Vtransient_mark_mode = Qnil; | |
| 2096 #endif /* FSFmacs */ | |
| 2097 | |
| 2098 DEFVAR_INT ("undo-threshold", &undo_threshold /* | |
| 2099 Keep no more undo information once it exceeds this size. | |
| 2100 This threshold is applied when garbage collection happens. | |
| 2101 The size is counted as the number of bytes occupied, | |
| 2102 which includes both saved text and other data. | |
| 2103 */ ); | |
| 2104 undo_threshold = 20000; | |
| 2105 | |
| 2106 DEFVAR_INT ("undo-high-threshold", &undo_high_threshold /* | |
| 2107 Don't keep more than this much size of undo information. | |
| 2108 A command which pushes past this size is itself forgotten. | |
| 2109 This threshold is applied when garbage collection happens. | |
| 2110 The size is counted as the number of bytes occupied, | |
| 2111 which includes both saved text and other data. | |
| 2112 */ ); | |
| 2113 undo_high_threshold = 30000; | |
| 2114 | |
| 2115 DEFVAR_LISP ("inhibit-read-only", &Vinhibit_read_only /* | |
| 2116 *Non-nil means disregard read-only status of buffers or characters. | |
| 2117 If the value is t, disregard `buffer-read-only' and all `read-only' | |
| 2118 text properties. If the value is a list, disregard `buffer-read-only' | |
| 2119 and disregard a `read-only' extent property or text property if the | |
| 2120 property value is a member of the list. | |
| 2121 */ ); | |
| 2122 Vinhibit_read_only = Qnil; | |
| 2123 | |
| 2124 DEFVAR_LISP ("kill-buffer-query-functions", &Vkill_buffer_query_functions /* | |
| 2125 List of functions called with no args to query before killing a buffer. | |
| 2126 */ ); | |
| 2127 Vkill_buffer_query_functions = Qnil; | |
| 2128 | |
| 2129 DEFVAR_BOOL ("delete-auto-save-files", &delete_auto_save_files /* | |
| 2130 *Non-nil means delete auto-save file when a buffer is saved or killed. | |
| 2131 */ ); | |
| 2132 delete_auto_save_files = 1; | |
| 2133 } | |
| 2134 | |
| 2135 /* The docstrings for DEFVAR_* are recorded externally by make-docfile. */ | |
| 2136 | |
| 3263 | 2137 #ifdef NEW_GC |
| 2720 | 2138 #define DEFVAR_BUFFER_LOCAL_1(lname, field_name, forward_type, magic_fun) \ |
| 2139 do \ | |
| 2140 { \ | |
| 2141 struct symbol_value_forward *I_hate_C = \ | |
|
5120
d1247f3cc363
latest work on lisp-object workspace;
Ben Wing <ben@xemacs.org>
parents:
5118
diff
changeset
|
2142 XSYMBOL_VALUE_FORWARD (ALLOC_LISP_OBJECT (symbol_value_forward)); \ |
|
5117
3742ea8250b5
Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents:
3024
diff
changeset
|
2143 /*mcpro ((Lisp_Object) I_hate_C);*/ \ |
| 2720 | 2144 \ |
| 2145 I_hate_C->magic.value = &(buffer_local_flags.field_name); \ | |
| 2146 I_hate_C->magic.type = forward_type; \ | |
| 2147 I_hate_C->magicfun = magic_fun; \ | |
| 2148 \ | |
| 2149 MARK_LRECORD_AS_LISP_READONLY (I_hate_C); \ | |
| 2150 \ | |
| 2151 { \ | |
| 2152 int offset = ((char *)symbol_value_forward_forward (I_hate_C) - \ | |
| 2153 (char *)&buffer_local_flags); \ | |
| 2154 defvar_magic (lname, I_hate_C); \ | |
| 2155 \ | |
| 2156 *((Lisp_Object *)(offset + (char *)XBUFFER (Vbuffer_local_symbols))) \ | |
| 2157 = intern (lname); \ | |
| 2158 } \ | |
| 2159 } while (0) | |
| 2160 | |
| 3263 | 2161 #else /* not NEW_GC */ |
| 428 | 2162 /* Renamed from DEFVAR_PER_BUFFER because FSFmacs D_P_B takes |
| 2163 a bogus extra arg, which confuses an otherwise identical make-docfile.c */ | |
| 2720 | 2164 #define DEFVAR_BUFFER_LOCAL_1(lname, field_name, forward_type, magicfun) \ |
| 2165 do { \ | |
| 2166 static const struct symbol_value_forward I_hate_C = \ | |
| 2167 { /* struct symbol_value_forward */ \ | |
| 2168 { /* struct symbol_value_magic */ \ | |
| 3024 | 2169 { /* struct old_lcrecord_header */ \ |
| 2720 | 2170 { /* struct lrecord_header */ \ |
| 2171 lrecord_type_symbol_value_forward, /* lrecord_type_index */ \ | |
| 2172 1, /* mark bit */ \ | |
| 2173 1, /* c_readonly bit */ \ | |
| 2174 1 /* lisp_readonly bit */ \ | |
| 2175 }, \ | |
| 2176 0, /* next */ \ | |
| 2177 0, /* uid */ \ | |
| 2178 0 /* free */ \ | |
| 2179 }, \ | |
| 2180 &(buffer_local_flags.field_name), \ | |
| 2181 forward_type \ | |
| 2182 }, \ | |
| 2183 magicfun \ | |
| 2184 }; \ | |
| 2185 \ | |
| 2186 { \ | |
| 2187 int offset = ((char *)symbol_value_forward_forward (&I_hate_C) - \ | |
| 2188 (char *)&buffer_local_flags); \ | |
| 2189 defvar_magic (lname, &I_hate_C); \ | |
| 2190 \ | |
| 2191 *((Lisp_Object *)(offset + (char *)XBUFFER (Vbuffer_local_symbols))) \ | |
| 2192 = intern (lname); \ | |
| 2193 } \ | |
| 428 | 2194 } while (0) |
| 3263 | 2195 #endif /* not NEW_GC */ |
| 2720 | 2196 |
| 428 | 2197 #define DEFVAR_BUFFER_LOCAL_MAGIC(lname, field_name, magicfun) \ |
| 2198 DEFVAR_BUFFER_LOCAL_1 (lname, field_name, \ | |
| 2199 SYMVAL_CURRENT_BUFFER_FORWARD, magicfun) | |
| 2200 #define DEFVAR_BUFFER_LOCAL(lname, field_name) \ | |
| 2201 DEFVAR_BUFFER_LOCAL_MAGIC (lname, field_name, 0) | |
| 2202 #define DEFVAR_CONST_BUFFER_LOCAL_MAGIC(lname, field_name, magicfun) \ | |
| 2203 DEFVAR_BUFFER_LOCAL_1 (lname, field_name, \ | |
| 2204 SYMVAL_CONST_CURRENT_BUFFER_FORWARD, magicfun) | |
| 2205 #define DEFVAR_CONST_BUFFER_LOCAL(lname, field_name) \ | |
| 2206 DEFVAR_CONST_BUFFER_LOCAL_MAGIC (lname, field_name, 0) | |
| 2207 | |
| 2208 #define DEFVAR_BUFFER_DEFAULTS_MAGIC(lname, field_name, magicfun) \ | |
| 2209 DEFVAR_SYMVAL_FWD (lname, &(buffer_local_flags.field_name), \ | |
| 2210 SYMVAL_DEFAULT_BUFFER_FORWARD, magicfun) | |
| 2211 #define DEFVAR_BUFFER_DEFAULTS(lname, field_name) \ | |
| 2212 DEFVAR_BUFFER_DEFAULTS_MAGIC (lname, field_name, 0) | |
| 2213 | |
| 2214 static void | |
| 2215 nuke_all_buffer_slots (struct buffer *b, Lisp_Object zap) | |
| 2216 { | |
|
5120
d1247f3cc363
latest work on lisp-object workspace;
Ben Wing <ben@xemacs.org>
parents:
5118
diff
changeset
|
2217 ZERO_LISP_OBJECT (b); |
| 428 | 2218 |
| 2219 b->extent_info = Qnil; | |
| 2220 b->indirect_children = Qnil; | |
| 2221 b->own_text.line_number_cache = Qnil; | |
| 2222 | |
| 1204 | 2223 #define MARKED_SLOT(x) b->x = zap; |
| 428 | 2224 #include "bufslots.h" |
| 2225 } | |
| 2226 | |
| 2227 static void | |
| 2228 common_init_complex_vars_of_buffer (void) | |
| 2229 { | |
| 2230 /* Make sure all markable slots in buffer_defaults | |
| 2231 are initialized reasonably, so mark_buffer won't choke. */ | |
|
5117
3742ea8250b5
Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents:
3024
diff
changeset
|
2232 Lisp_Object defobj = ALLOC_LISP_OBJECT (buffer); |
|
3742ea8250b5
Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents:
3024
diff
changeset
|
2233 struct buffer *defs = XBUFFER (defobj); |
|
3742ea8250b5
Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents:
3024
diff
changeset
|
2234 Lisp_Object symobj = ALLOC_LISP_OBJECT (buffer); |
|
3742ea8250b5
Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents:
3024
diff
changeset
|
2235 struct buffer *syms = XBUFFER (symobj); |
| 428 | 2236 |
| 2237 staticpro_nodump (&Vbuffer_defaults); | |
| 2238 staticpro_nodump (&Vbuffer_local_symbols); | |
|
5117
3742ea8250b5
Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents:
3024
diff
changeset
|
2239 Vbuffer_defaults = defobj; |
|
3742ea8250b5
Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents:
3024
diff
changeset
|
2240 Vbuffer_local_symbols = symobj; |
| 428 | 2241 |
| 2242 nuke_all_buffer_slots (syms, Qnil); | |
| 2243 nuke_all_buffer_slots (defs, Qnil); | |
| 2244 defs->text = &defs->own_text; | |
| 2245 syms->text = &syms->own_text; | |
| 2246 | |
| 2247 /* Set up the non-nil default values of various buffer slots. | |
| 2248 Must do these before making the first buffer. */ | |
| 2249 defs->major_mode = Qfundamental_mode; | |
| 2250 defs->mode_name = QSFundamental; | |
| 2251 defs->abbrev_table = Qnil; /* real default setup by Lisp code */ | |
| 2252 | |
| 446 | 2253 defs->case_table = Vstandard_case_table; |
| 428 | 2254 #ifdef MULE |
| 2255 defs->category_table = Vstandard_category_table; | |
| 2256 #endif /* MULE */ | |
| 2257 defs->syntax_table = Vstandard_syntax_table; | |
| 2258 defs->mirror_syntax_table = | |
| 2259 XCHAR_TABLE (Vstandard_syntax_table)->mirror_table; | |
| 2260 defs->modeline_format = build_string ("%-"); /* reset in loaddefs.el */ | |
| 2261 defs->case_fold_search = Qt; | |
| 2262 defs->selective_display_ellipses = Qt; | |
| 2263 defs->tab_width = make_int (8); | |
| 2264 defs->ctl_arrow = Qt; | |
| 2265 defs->fill_column = make_int (70); | |
| 2266 defs->left_margin = Qzero; | |
| 2267 defs->saved_size = Qzero; /* lisp code wants int-or-nil */ | |
| 2268 defs->modtime = 0; | |
| 2269 defs->auto_save_modified = 0; | |
| 2270 defs->auto_save_failure_time = -1; | |
| 2271 defs->invisibility_spec = Qt; | |
| 448 | 2272 defs->buffer_local_face_property = 0; |
| 428 | 2273 |
| 2274 defs->indirect_children = Qnil; | |
| 2275 syms->indirect_children = Qnil; | |
| 2276 | |
| 2277 { | |
| 2278 /* 0 means var is always local. Default used only at creation. | |
| 2279 * -1 means var is always local. Default used only at reset and | |
| 2280 * creation. | |
| 2281 * -2 means there's no lisp variable corresponding to this slot | |
| 2282 * and the default is only used at creation. | |
| 2283 * -3 means no Lisp variable. Default used only at reset and creation. | |
| 2284 * >0 is mask. Var is local if ((buffer->local_var_flags & mask) != 0) | |
| 2285 * Otherwise default is used. | |
| 2286 */ | |
| 2287 Lisp_Object always_local_no_default = make_int (0); | |
| 2288 Lisp_Object always_local_resettable = make_int (-1); | |
| 2289 Lisp_Object resettable = make_int (-3); | |
| 2290 | |
| 2291 /* Assign the local-flags to the slots that have default values. | |
| 2292 The local flag is a bit that is used in the buffer | |
| 2293 to say that it has its own local value for the slot. | |
| 2294 The local flag bits are in the local_var_flags slot of the | |
| 2295 buffer. */ | |
| 2296 | |
| 2297 nuke_all_buffer_slots (&buffer_local_flags, make_int (-2)); | |
| 2298 buffer_local_flags.filename = always_local_no_default; | |
| 2299 buffer_local_flags.directory = always_local_no_default; | |
| 2300 buffer_local_flags.backed_up = always_local_no_default; | |
| 2301 buffer_local_flags.saved_size = always_local_no_default; | |
| 2302 buffer_local_flags.auto_save_file_name = always_local_no_default; | |
| 2303 buffer_local_flags.read_only = always_local_no_default; | |
| 2304 | |
| 2305 buffer_local_flags.major_mode = always_local_resettable; | |
| 2306 buffer_local_flags.mode_name = always_local_resettable; | |
| 2307 buffer_local_flags.undo_list = always_local_no_default; | |
| 2308 #if 0 /* FSFmacs */ | |
| 2309 buffer_local_flags.mark_active = always_local_resettable; | |
| 2310 #endif | |
| 2311 buffer_local_flags.point_before_scroll = always_local_resettable; | |
| 2312 buffer_local_flags.file_truename = always_local_no_default; | |
| 2313 buffer_local_flags.invisibility_spec = always_local_resettable; | |
| 2314 buffer_local_flags.file_format = always_local_resettable; | |
| 2315 buffer_local_flags.generated_modeline_string = always_local_no_default; | |
| 2316 | |
| 2317 buffer_local_flags.keymap = resettable; | |
| 446 | 2318 buffer_local_flags.case_table = resettable; |
| 428 | 2319 buffer_local_flags.syntax_table = resettable; |
| 2320 #ifdef MULE | |
| 2321 buffer_local_flags.category_table = resettable; | |
| 2322 #endif | |
| 2323 | |
| 2324 buffer_local_flags.modeline_format = make_int (1<<0); | |
| 2325 buffer_local_flags.abbrev_mode = make_int (1<<1); | |
| 2326 buffer_local_flags.overwrite_mode = make_int (1<<2); | |
| 2327 buffer_local_flags.case_fold_search = make_int (1<<3); | |
| 2328 buffer_local_flags.auto_fill_function = make_int (1<<4); | |
| 2329 buffer_local_flags.selective_display = make_int (1<<5); | |
| 2330 buffer_local_flags.selective_display_ellipses = make_int (1<<6); | |
| 2331 buffer_local_flags.tab_width = make_int (1<<7); | |
| 2332 buffer_local_flags.truncate_lines = make_int (1<<8); | |
| 2333 buffer_local_flags.ctl_arrow = make_int (1<<9); | |
| 2334 buffer_local_flags.fill_column = make_int (1<<10); | |
| 2335 buffer_local_flags.left_margin = make_int (1<<11); | |
| 2336 buffer_local_flags.abbrev_table = make_int (1<<12); | |
| 2337 #ifdef REGION_CACHE_NEEDS_WORK | |
| 2338 buffer_local_flags.cache_long_line_scans = make_int (1<<13); | |
| 2339 #endif | |
| 2340 buffer_local_flags.buffer_file_coding_system = make_int (1<<14); | |
| 2341 | |
| 2342 /* #### Warning: 1<<31 is the largest number currently allowable | |
| 2343 due to the XINT() handling of this value. With some | |
| 558 | 2344 rearrangement you can get 3 more bits. |
| 2345 | |
| 2346 #### 3 more? 34 bits???? -ben */ | |
| 428 | 2347 } |
| 2348 } | |
| 2349 | |
| 2350 #define BUFFER_SLOTS_SIZE (offsetof (struct buffer, BUFFER_SLOTS_LAST_NAME) - offsetof (struct buffer, BUFFER_SLOTS_FIRST_NAME) + sizeof (Lisp_Object)) | |
| 2351 #define BUFFER_SLOTS_COUNT (BUFFER_SLOTS_SIZE / sizeof (Lisp_Object)) | |
| 2352 | |
| 2353 void | |
| 771 | 2354 reinit_complex_vars_of_buffer_runtime_only (void) |
| 428 | 2355 { |
| 2356 struct buffer *defs, *syms; | |
| 2357 | |
| 2358 common_init_complex_vars_of_buffer (); | |
| 2359 | |
| 2360 defs = XBUFFER (Vbuffer_defaults); | |
| 2361 syms = XBUFFER (Vbuffer_local_symbols); | |
| 2362 memcpy (&defs->BUFFER_SLOTS_FIRST_NAME, | |
| 2363 buffer_defaults_saved_slots, | |
| 2364 BUFFER_SLOTS_SIZE); | |
| 2365 memcpy (&syms->BUFFER_SLOTS_FIRST_NAME, | |
| 2366 buffer_local_symbols_saved_slots, | |
| 2367 BUFFER_SLOTS_SIZE); | |
| 2368 } | |
| 2369 | |
| 2370 | |
| 1204 | 2371 static const struct memory_description buffer_slots_description_1[] = { |
| 440 | 2372 { XD_LISP_OBJECT_ARRAY, 0, BUFFER_SLOTS_COUNT }, |
| 428 | 2373 { XD_END } |
| 2374 }; | |
| 2375 | |
| 1204 | 2376 static const struct sized_memory_description buffer_slots_description = { |
| 428 | 2377 BUFFER_SLOTS_SIZE, |
| 2378 buffer_slots_description_1 | |
| 2379 }; | |
| 2380 | |
| 2381 void | |
| 2382 complex_vars_of_buffer (void) | |
| 2383 { | |
| 2384 struct buffer *defs, *syms; | |
| 2385 | |
| 2386 common_init_complex_vars_of_buffer (); | |
| 2387 | |
| 2388 defs = XBUFFER (Vbuffer_defaults); | |
| 2389 syms = XBUFFER (Vbuffer_local_symbols); | |
| 2390 buffer_defaults_saved_slots = &defs->BUFFER_SLOTS_FIRST_NAME; | |
| 2391 buffer_local_symbols_saved_slots = &syms->BUFFER_SLOTS_FIRST_NAME; | |
| 2367 | 2392 dump_add_root_block_ptr (&buffer_defaults_saved_slots, &buffer_slots_description); |
| 2393 dump_add_root_block_ptr (&buffer_local_symbols_saved_slots, &buffer_slots_description); | |
| 440 | 2394 |
| 428 | 2395 DEFVAR_BUFFER_DEFAULTS ("default-modeline-format", modeline_format /* |
| 2396 Default value of `modeline-format' for buffers that don't override it. | |
| 2397 This is the same as (default-value 'modeline-format). | |
| 2398 */ ); | |
| 2399 | |
| 2400 DEFVAR_BUFFER_DEFAULTS ("default-abbrev-mode", abbrev_mode /* | |
| 2401 Default value of `abbrev-mode' for buffers that do not override it. | |
| 2402 This is the same as (default-value 'abbrev-mode). | |
| 2403 */ ); | |
| 2404 | |
| 2405 DEFVAR_BUFFER_DEFAULTS ("default-ctl-arrow", ctl_arrow /* | |
| 2406 Default value of `ctl-arrow' for buffers that do not override it. | |
| 2407 This is the same as (default-value 'ctl-arrow). | |
| 2408 */ ); | |
| 2409 | |
| 2410 #if 0 /* #### make this a specifier! */ | |
| 2411 DEFVAR_BUFFER_DEFAULTS ("default-display-direction", display_direction /* | |
| 2412 Default display-direction for buffers that do not override it. | |
| 2413 This is the same as (default-value 'display-direction). | |
| 2414 Note: This is not yet implemented. | |
| 2415 */ ); | |
| 2416 #endif | |
| 2417 | |
| 2418 DEFVAR_BUFFER_DEFAULTS ("default-truncate-lines", truncate_lines /* | |
| 2419 Default value of `truncate-lines' for buffers that do not override it. | |
| 2420 This is the same as (default-value 'truncate-lines). | |
| 2421 */ ); | |
| 2422 | |
| 2423 DEFVAR_BUFFER_DEFAULTS ("default-fill-column", fill_column /* | |
| 2424 Default value of `fill-column' for buffers that do not override it. | |
| 2425 This is the same as (default-value 'fill-column). | |
| 2426 */ ); | |
| 2427 | |
| 2428 DEFVAR_BUFFER_DEFAULTS ("default-left-margin", left_margin /* | |
| 2429 Default value of `left-margin' for buffers that do not override it. | |
| 2430 This is the same as (default-value 'left-margin). | |
| 2431 */ ); | |
| 2432 | |
| 2433 DEFVAR_BUFFER_DEFAULTS ("default-tab-width", tab_width /* | |
| 2434 Default value of `tab-width' for buffers that do not override it. | |
| 2435 This is the same as (default-value 'tab-width). | |
| 2436 */ ); | |
| 2437 | |
| 2438 DEFVAR_BUFFER_DEFAULTS ("default-case-fold-search", case_fold_search /* | |
| 2439 Default value of `case-fold-search' for buffers that don't override it. | |
| 2440 This is the same as (default-value 'case-fold-search). | |
| 2441 */ ); | |
| 2442 | |
| 2443 DEFVAR_BUFFER_LOCAL ("modeline-format", modeline_format /* | |
| 2444 Template for displaying modeline for current buffer. | |
| 2445 Each buffer has its own value of this variable. | |
| 442 | 2446 Value may be a string, symbol, glyph, generic specifier, list or cons cell. |
| 2447 For a symbol, its value is processed (but it is ignored if t or nil). | |
| 428 | 2448 A string appearing directly as the value of a symbol is processed verbatim |
| 2449 in that the %-constructs below are not recognized. | |
| 2450 For a glyph, it is inserted as is. | |
| 442 | 2451 For a generic specifier (i.e. a specifier of type `generic'), its instance |
| 2452 is computed in the current window using the equivalent of `specifier-instance' | |
| 2453 and the value is processed. | |
| 428 | 2454 For a list whose car is a symbol, the symbol's value is taken, |
| 2455 and if that is non-nil, the cadr of the list is processed recursively. | |
| 2456 Otherwise, the caddr of the list (if there is one) is processed. | |
| 771 | 2457 For a list whose car is a boolean specifier, its instance is computed |
| 2458 in the current window using the equivalent of `specifier-instance', | |
| 2459 and if that is non-nil, the cadr of the list is processed recursively. | |
| 2460 Otherwise, the caddr of the list (if there is one) is processed. | |
| 428 | 2461 For a list whose car is a string or list, each element is processed |
| 2462 recursively and the results are effectively concatenated. | |
| 2463 For a list whose car is an integer, the cdr of the list is processed | |
| 442 | 2464 and padded (if the number is positive) or truncated (if negative) |
| 2465 to the width specified by that number. | |
| 428 | 2466 For a list whose car is an extent, the cdr of the list is processed |
| 2467 normally but the results are displayed using the face of the | |
| 2468 extent, and mouse clicks over this section are processed using the | |
| 2469 keymap of the extent. (In addition, if the extent has a help-echo | |
| 2470 property, that string will be echoed when the mouse moves over this | |
| 442 | 2471 section.) If extents are nested, all keymaps are properly consulted |
| 2472 when processing mouse clicks, but multiple faces are not correctly | |
| 2473 merged (only the first face is used), and lists of faces are not | |
| 2474 correctly handled. See `generated-modeline-string' for more information. | |
| 428 | 2475 A string is printed verbatim in the modeline except for %-constructs: |
| 2476 (%-constructs are processed when the string is the entire modeline-format | |
| 2477 or when it is found in a cons-cell or a list) | |
| 2478 %b -- print buffer name. %c -- print the current column number. | |
| 2479 %f -- print visited file name. | |
| 2480 %* -- print %, * or hyphen. %+ -- print *, % or hyphen. | |
| 2481 % means buffer is read-only and * means it is modified. | |
| 2482 For a modified read-only buffer, %* gives % and %+ gives *. | |
| 2483 %s -- print process status. %l -- print the current line number. | |
| 2484 %S -- print name of selected frame (only meaningful under X Windows). | |
| 2485 %p -- print percent of buffer above top of window, or Top, Bot or All. | |
| 2486 %P -- print percent of buffer above bottom of window, perhaps plus Top, | |
| 2487 or print Bottom or All. | |
| 2488 %n -- print Narrow if appropriate. | |
| 771 | 2489 %C -- print the mnemonic for `buffer-file-coding-system'. |
| 428 | 2490 %[ -- print one [ for each recursive editing level. %] similar. |
| 2491 %% -- print %. %- -- print infinitely many dashes. | |
| 2492 Decimal digits after the % specify field width to which to pad. | |
| 2493 */ ); | |
| 2494 | |
| 2495 DEFVAR_BUFFER_DEFAULTS ("default-major-mode", major_mode /* | |
| 2496 *Major mode for new buffers. Defaults to `fundamental-mode'. | |
| 2497 nil here means use current buffer's major mode. | |
| 2498 */ ); | |
| 2499 | |
| 2500 DEFVAR_BUFFER_DEFAULTS ("fundamental-mode-abbrev-table", abbrev_table /* | |
| 2501 The abbrev table of mode-specific abbrevs for Fundamental Mode. | |
| 2502 */ ); | |
| 2503 | |
| 2504 DEFVAR_BUFFER_LOCAL ("major-mode", major_mode /* | |
| 2505 Symbol for current buffer's major mode. | |
| 2506 */ ); | |
| 2507 | |
| 2508 DEFVAR_BUFFER_LOCAL ("mode-name", mode_name /* | |
| 2509 Pretty name of current buffer's major mode (a string). | |
| 2510 */ ); | |
| 2511 | |
| 2512 DEFVAR_BUFFER_LOCAL ("abbrev-mode", abbrev_mode /* | |
| 2513 Non-nil turns on automatic expansion of abbrevs as they are inserted. | |
| 2514 Automatically becomes buffer-local when set in any fashion. | |
| 2515 */ ); | |
| 2516 | |
| 2517 DEFVAR_BUFFER_LOCAL ("case-fold-search", case_fold_search /* | |
| 2518 *Non-nil if searches should ignore case. | |
| 2519 Automatically becomes buffer-local when set in any fashion. | |
| 2520 */ ); | |
| 2521 | |
| 2522 DEFVAR_BUFFER_LOCAL ("fill-column", fill_column /* | |
| 2523 *Column beyond which automatic line-wrapping should happen. | |
| 2524 Automatically becomes buffer-local when set in any fashion. | |
| 2525 */ ); | |
| 2526 | |
| 2527 DEFVAR_BUFFER_LOCAL ("left-margin", left_margin /* | |
| 2528 *Column for the default indent-line-function to indent to. | |
| 2529 Linefeed indents to this column in Fundamental mode. | |
| 2530 Automatically becomes buffer-local when set in any fashion. | |
| 2531 Do not confuse this with the specifier `left-margin-width'; | |
| 2532 that controls the size of a margin that is displayed outside | |
| 2533 of the text area. | |
| 2534 */ ); | |
| 2535 | |
| 2536 DEFVAR_BUFFER_LOCAL_MAGIC ("tab-width", tab_width /* | |
| 2537 *Distance between tab stops (for display of tab characters), in columns. | |
| 2538 Automatically becomes buffer-local when set in any fashion. | |
| 2539 */ , redisplay_variable_changed); | |
| 2540 | |
| 2541 DEFVAR_BUFFER_LOCAL_MAGIC ("ctl-arrow", ctl_arrow /* | |
| 2542 *Non-nil means display control chars with uparrow. | |
| 2543 Nil means use backslash and octal digits. | |
| 2544 An integer means characters >= ctl-arrow are assumed to be printable, and | |
| 2545 will be displayed as a single glyph. | |
| 2546 Any other value is the same as 160 - the code SPC with the high bit on. | |
| 2547 | |
| 2548 The interpretation of this variable is likely to change in the future. | |
| 2549 | |
| 2550 Automatically becomes buffer-local when set in any fashion. | |
| 2551 This variable does not apply to characters whose display is specified | |
| 2552 in the current display table (if there is one). | |
| 2553 */ , redisplay_variable_changed); | |
| 2554 | |
| 2555 #if 0 /* #### Make this a specifier! */ | |
| 2556 xxDEFVAR_BUFFER_LOCAL ("display-direction", display_direction /* | |
| 2557 *Non-nil means lines in the buffer are displayed right to left. | |
| 2558 Nil means left to right. (Not yet implemented.) | |
| 2559 */ ); | |
| 2560 #endif /* Not yet implemented */ | |
| 2561 | |
| 2562 DEFVAR_BUFFER_LOCAL_MAGIC ("truncate-lines", truncate_lines /* | |
| 2563 *Non-nil means do not display continuation lines; | |
| 2564 give each line of text one frame line. | |
| 2565 Automatically becomes buffer-local when set in any fashion. | |
| 2566 | |
| 2567 Note that this is overridden by the variable | |
| 2568 `truncate-partial-width-windows' if that variable is non-nil | |
| 2569 and this buffer is not full-frame width. | |
| 2570 */ , redisplay_variable_changed); | |
| 2571 | |
| 2572 DEFVAR_BUFFER_LOCAL ("default-directory", directory /* | |
| 2573 Name of default directory of current buffer. Should end with slash. | |
| 2574 Each buffer has its own value of this variable. | |
| 2575 */ ); | |
| 2576 | |
| 771 | 2577 /* NOTE: The default value is set in code-init.el. */ |
| 428 | 2578 DEFVAR_BUFFER_DEFAULTS ("default-buffer-file-coding-system", buffer_file_coding_system /* |
| 2579 Default value of `buffer-file-coding-system' for buffers that do not override it. | |
| 2580 This is the same as (default-value 'buffer-file-coding-system). | |
| 2581 This value is used both for buffers without associated files and | |
| 2582 for buffers whose files do not have any apparent coding system. | |
| 2583 See `buffer-file-coding-system'. | |
| 2584 */ ); | |
| 2585 | |
| 2586 DEFVAR_BUFFER_LOCAL ("buffer-file-coding-system", buffer_file_coding_system /* | |
| 2587 *Current coding system for the current buffer. | |
| 2588 When the buffer is written out into a file, this coding system will be | |
| 2589 used for the encoding. Automatically buffer-local when set in any | |
| 2590 fashion. This is normally set automatically when a file is loaded in | |
| 2591 based on the determined coding system of the file (assuming that | |
| 2592 `buffer-file-coding-system-for-read' is set to `undecided', which | |
| 2593 calls for automatic determination of the file's coding system). | |
| 2594 Normally the modeline indicates the current file coding system using | |
| 2595 its mnemonic abbreviation. | |
| 2596 | |
| 2597 The default value for this variable (which is normally used for | |
| 2598 buffers without associated files) is also used when automatic | |
| 2599 detection of a file's encoding is called for and there was no | |
| 2600 discernible encoding in the file (i.e. it was entirely or almost | |
| 2601 entirely ASCII). The default value should generally *not* be set to | |
| 2602 nil (equivalent to `no-conversion'), because if extended characters | |
| 2603 are ever inserted into the buffer, they will be lost when the file is | |
| 2604 written out. A good choice is `iso-2022-8' (the simple ISO 2022 8-bit | |
| 2605 encoding), which will write out ASCII and Latin-1 characters in the | |
| 2606 standard (and highly portable) fashion and use standard escape | |
| 2607 sequences for other charsets. Another reasonable choice is | |
| 2608 `escape-quoted', which is equivalent to `iso-2022-8' but prefixes | |
| 2609 certain control characters with ESC to make sure they are not | |
| 2610 interpreted as escape sequences when read in. This latter coding | |
| 2611 system results in more "correct" output in the presence of control | |
| 2612 characters in the buffer, in the sense that when read in again using | |
| 2613 the same coding system, the result will virtually always match the | |
| 2614 original contents of the buffer, which is not the case with | |
| 2615 `iso-2022-8'; but the output is less portable when dealing with binary | |
| 2616 data -- there may be stray ESC characters when the file is read by | |
| 2617 another program. | |
| 2618 | |
| 2619 `buffer-file-coding-system' does *not* control the coding system used when | |
| 2620 a file is read in. Use the variables `buffer-file-coding-system-for-read' | |
| 771 | 2621 and `file-coding-system-alist' for that. From a Lisp program, if |
| 428 | 2622 you wish to unilaterally specify the coding system used for one |
| 2623 particular operation, you should bind the variable | |
| 2624 `coding-system-for-read' rather than changing the other two | |
| 2625 variables just mentioned, which are intended to be used for | |
| 2626 global environment specification. | |
| 771 | 2627 |
| 2628 See `insert-file-contents' for a full description of how a file's | |
| 2629 coding system is determined when it is read in. | |
| 428 | 2630 */ ); |
| 2631 | |
| 2632 DEFVAR_BUFFER_LOCAL ("auto-fill-function", auto_fill_function /* | |
| 2633 Function called (if non-nil) to perform auto-fill. | |
| 2634 It is called after self-inserting a space at a column beyond `fill-column'. | |
| 2635 Each buffer has its own value of this variable. | |
| 2636 NOTE: This variable is not an ordinary hook; | |
| 2637 It may not be a list of functions. | |
| 2638 */ ); | |
| 2639 | |
| 2640 DEFVAR_BUFFER_LOCAL ("buffer-file-name", filename /* | |
| 2641 Name of file visited in current buffer, or nil if not visiting a file. | |
| 2642 Each buffer has its own value of this variable. | |
| 3693 | 2643 Code that changes this variable must maintain the invariant |
| 2644 `(equal buffer-file-truename (file-truename buffer-file-name))'. | |
| 428 | 2645 */ ); |
| 2646 | |
| 2647 #if 0 /* FSFmacs */ | |
| 2648 /* | |
| 2649 Abbreviated truename of file visited in current buffer, or nil if none. | |
| 2650 The truename of a file is calculated by `file-truename' | |
| 2651 and then abbreviated with `abbreviate-file-name'. | |
| 2652 Each buffer has its own value of this variable. | |
| 2653 */ | |
| 2654 #endif /* FSFmacs */ | |
| 2655 | |
| 2656 DEFVAR_BUFFER_LOCAL ("buffer-file-truename", file_truename /* | |
| 3693 | 2657 The real name of the file visited in the current buffer, or nil if not |
| 2658 visiting a file. This is the result of passing `buffer-file-name' to the | |
| 2659 `file-truename' function. Every buffer has its own value of this variable. | |
| 2660 Code that changes the file name associated with a buffer maintains the | |
| 2661 invariant `(equal buffer-file-truename (file-truename buffer-file-name))'. | |
| 428 | 2662 */ ); |
| 2663 | |
| 2664 DEFVAR_BUFFER_LOCAL ("buffer-auto-save-file-name", auto_save_file_name /* | |
| 2665 Name of file for auto-saving current buffer, | |
| 2666 or nil if buffer should not be auto-saved. | |
| 2667 Each buffer has its own value of this variable. | |
| 2668 */ ); | |
| 2669 | |
| 2670 DEFVAR_BUFFER_LOCAL ("buffer-read-only", read_only /* | |
| 2671 Non-nil if this buffer is read-only. | |
| 2672 Each buffer has its own value of this variable. | |
| 2673 */ ); | |
| 2674 | |
| 2675 DEFVAR_BUFFER_LOCAL ("buffer-backed-up", backed_up /* | |
| 2676 Non-nil if this buffer's file has been backed up. | |
| 2677 Backing up is done before the first time the file is saved. | |
| 2678 Each buffer has its own value of this variable. | |
| 2679 */ ); | |
| 2680 | |
| 2681 DEFVAR_BUFFER_LOCAL ("buffer-saved-size", saved_size /* | |
| 2682 Length of current buffer when last read in, saved or auto-saved. | |
| 2683 0 initially. | |
| 2684 Each buffer has its own value of this variable. | |
| 2685 */ ); | |
| 2686 | |
| 2687 DEFVAR_BUFFER_LOCAL_MAGIC ("selective-display", selective_display /* | |
| 2688 Non-nil enables selective display: | |
| 2689 Integer N as value means display only lines | |
| 2690 that start with less than n columns of space. | |
| 2691 A value of t means, after a ^M, all the rest of the line is invisible. | |
| 2692 Then ^M's in the file are written into files as newlines. | |
| 2693 | |
| 2694 Automatically becomes buffer-local when set in any fashion. | |
| 2695 */, redisplay_variable_changed); | |
| 2696 | |
| 2697 #ifndef old | |
| 2698 DEFVAR_BUFFER_LOCAL_MAGIC ("selective-display-ellipses", | |
| 2699 selective_display_ellipses /* | |
| 2700 t means display ... on previous line when a line is invisible. | |
| 2701 Automatically becomes buffer-local when set in any fashion. | |
| 2702 */, redisplay_variable_changed); | |
| 2703 #endif | |
| 2704 | |
| 2705 DEFVAR_BUFFER_LOCAL ("local-abbrev-table", abbrev_table /* | |
| 2706 Local (mode-specific) abbrev table of current buffer. | |
| 2707 */ ); | |
| 2708 | |
| 2709 DEFVAR_BUFFER_LOCAL ("overwrite-mode", overwrite_mode /* | |
| 2710 Non-nil if self-insertion should replace existing text. | |
| 2711 The value should be one of `overwrite-mode-textual', | |
| 2712 `overwrite-mode-binary', or nil. | |
| 2713 If it is `overwrite-mode-textual', self-insertion still | |
| 2714 inserts at the end of a line, and inserts when point is before a tab, | |
| 2715 until the tab is filled in. | |
| 2716 If `overwrite-mode-binary', self-insertion replaces newlines and tabs too. | |
| 2717 Automatically becomes buffer-local when set in any fashion. | |
| 2718 | |
| 2719 Normally, you shouldn't modify this variable by hand, but use the functions | |
| 2720 `overwrite-mode' and `binary-overwrite-mode' instead. However, you can | |
| 2721 customize the default value from the options menu. | |
| 2722 */ ); | |
| 2723 | |
| 2724 #if 0 /* FSFmacs */ | |
| 2725 /* Adds the following to the doc string for buffer-undo-list: | |
| 2726 | |
| 2727 An entry (nil PROPERTY VALUE BEG . END) indicates that a text property | |
| 2728 was modified between BEG and END. PROPERTY is the property name, | |
| 2729 and VALUE is the old value. | |
| 2730 */ | |
| 2731 #endif /* FSFmacs */ | |
| 2732 | |
| 2733 DEFVAR_BUFFER_LOCAL ("buffer-undo-list", undo_list /* | |
| 2734 List of undo entries in current buffer. | |
| 2735 Recent changes come first; older changes follow newer. | |
| 2736 | |
| 444 | 2737 An entry (START . END) represents an insertion which begins at |
| 2738 position START and ends at position END. | |
| 428 | 2739 |
| 2740 An entry (TEXT . POSITION) represents the deletion of the string TEXT | |
| 2741 from (abs POSITION). If POSITION is positive, point was at the front | |
| 2742 of the text being deleted; if negative, point was at the end. | |
| 2743 | |
| 2744 An entry (t HIGH . LOW) indicates that the buffer previously had | |
| 2745 "unmodified" status. HIGH and LOW are the high and low 16-bit portions | |
| 2746 of the visited file's modification time, as of that time. If the | |
| 2747 modification time of the most recent save is different, this entry is | |
| 2748 obsolete. | |
| 2749 | |
| 2750 An entry of the form EXTENT indicates that EXTENT was attached in | |
| 2751 the buffer. Undoing an entry of this form detaches EXTENT. | |
| 2752 | |
| 2753 An entry of the form (EXTENT START END) indicates that EXTENT was | |
| 2754 detached from the buffer. Undoing an entry of this form attaches | |
| 2755 EXTENT from START to END. | |
| 2756 | |
| 2757 An entry of the form POSITION indicates that point was at the buffer | |
| 2758 location given by the integer. Undoing an entry of this form places | |
| 2759 point at POSITION. | |
| 2760 | |
| 2761 nil marks undo boundaries. The undo command treats the changes | |
| 2762 between two undo boundaries as a single step to be undone. | |
| 2763 | |
| 2764 If the value of the variable is t, undo information is not recorded. | |
| 2765 */ ); | |
| 2766 | |
| 2767 #if 0 /* FSFmacs */ | |
| 2768 xxDEFVAR_BUFFER_LOCAL ("mark-active", mark_active /* | |
| 2769 Non-nil means the mark and region are currently active in this buffer. | |
| 2770 Automatically local in all buffers. | |
| 2771 */ ); | |
| 2772 #endif /* FSFmacs */ | |
| 2773 | |
| 2774 #ifdef REGION_CACHE_NEEDS_WORK | |
| 2775 xxDEFVAR_BUFFER_LOCAL ("cache-long-line-scans", cache_long_line_scans /* | |
| 2776 Non-nil means that Emacs should use caches to handle long lines more quickly. | |
| 2777 This variable is buffer-local, in all buffers. | |
| 2778 | |
| 2779 Normally, the line-motion functions work by scanning the buffer for | |
| 2780 newlines. Columnar operations (like move-to-column and | |
| 2781 compute-motion) also work by scanning the buffer, summing character | |
| 2782 widths as they go. This works well for ordinary text, but if the | |
| 2783 buffer's lines are very long (say, more than 500 characters), these | |
| 2784 motion functions will take longer to execute. Emacs may also take | |
| 2785 longer to update the display. | |
| 2786 | |
| 2787 If cache-long-line-scans is non-nil, these motion functions cache the | |
| 2788 results of their scans, and consult the cache to avoid rescanning | |
| 2789 regions of the buffer until the text is modified. The caches are most | |
| 2790 beneficial when they prevent the most searching---that is, when the | |
| 2791 buffer contains long lines and large regions of characters with the | |
| 2792 same, fixed screen width. | |
| 2793 | |
| 2794 When cache-long-line-scans is non-nil, processing short lines will | |
| 2795 become slightly slower (because of the overhead of consulting the | |
| 2796 cache), and the caches will use memory roughly proportional to the | |
| 2797 number of newlines and characters whose screen width varies. | |
| 2798 | |
| 2799 The caches require no explicit maintenance; their accuracy is | |
| 2800 maintained internally by the Emacs primitives. Enabling or disabling | |
| 2801 the cache should not affect the behavior of any of the motion | |
| 2802 functions; it should only affect their performance. | |
| 2803 */ ); | |
| 2804 #endif /* REGION_CACHE_NEEDS_WORK */ | |
| 2805 | |
| 2806 DEFVAR_BUFFER_LOCAL ("point-before-scroll", point_before_scroll /* | |
| 2807 Value of point before the last series of scroll operations, or nil. | |
| 2808 */ ); | |
| 2809 | |
| 2810 DEFVAR_BUFFER_LOCAL ("buffer-file-format", file_format /* | |
| 2811 List of formats to use when saving this buffer. | |
| 2812 Formats are defined by `format-alist'. This variable is | |
| 2813 set when a file is visited. Automatically local in all buffers. | |
| 2814 */ ); | |
| 2815 | |
| 2816 DEFVAR_BUFFER_LOCAL_MAGIC ("buffer-invisibility-spec", invisibility_spec /* | |
| 2817 Invisibility spec of this buffer. | |
| 2818 The default is t, which means that text is invisible | |
| 2819 if it has (or is covered by an extent with) a non-nil `invisible' property. | |
| 2820 If the value is a list, a text character is invisible if its `invisible' | |
| 2821 property is an element in that list. | |
| 444 | 2822 If an element is a cons cell of the form (PROPERTY . ELLIPSIS), |
| 2823 then characters with property value PROPERTY are invisible, | |
| 428 | 2824 and they have an ellipsis as well if ELLIPSIS is non-nil. |
| 2825 Note that the actual characters used for the ellipsis are controllable | |
| 2826 using `invisible-text-glyph', and default to "...". | |
| 2827 */, redisplay_variable_changed); | |
| 2828 | |
| 2829 DEFVAR_CONST_BUFFER_LOCAL ("generated-modeline-string", | |
| 2830 generated_modeline_string /* | |
| 2831 String of characters in this buffer's modeline as of the last redisplay. | |
| 2832 Each time the modeline is recomputed, the resulting characters are | |
| 2833 stored in this string, which is resized as necessary. You may not | |
| 2834 set this variable, and modifying this string will not change the | |
| 2835 modeline; you have to change `modeline-format' if you want that. | |
| 2836 | |
| 2837 For each extent in `modeline-format' that is encountered when | |
| 2838 processing the modeline, a corresponding extent is placed in | |
| 2839 `generated-modeline-string' and covers the text over which the | |
| 2840 extent in `modeline-format' applies. The extent in | |
| 2841 `generated-modeline-string' is made a child of the extent in | |
| 2842 `modeline-format', which means that it inherits all properties from | |
| 2843 that extent. Note that the extents in `generated-modeline-string' | |
| 2844 are managed automatically. You should not explicitly put any extents | |
| 2845 in `generated-modeline-string'; if you do, they will disappear the | |
| 2846 next time the modeline is processed. | |
| 2847 | |
| 2848 For extents in `modeline-format', the following properties are currently | |
| 2849 handled: | |
| 2850 | |
| 2851 `face' | |
| 2852 Affects the face of the modeline text. Currently, faces do | |
| 2853 not merge properly; only the most recently encountered face | |
| 2854 is used. This is a bug. | |
| 2855 | |
| 2856 `keymap' | |
| 2857 Affects the disposition of button events over the modeline | |
| 2858 text. Multiple applicable keymaps *are* handled properly, | |
| 2859 and `modeline-map' still applies to any events that don't | |
| 2860 have bindings in extent-specific keymaps. | |
| 2861 | |
| 2862 `help-echo' | |
| 2863 If a string, causes the string to be displayed when the mouse | |
| 2864 moves over the text. | |
| 2865 */ ); | |
| 2866 | |
| 2867 /* Check for DEFVAR_BUFFER_LOCAL without initializing the corresponding | |
| 2868 slot of buffer_local_flags and vice-versa. Must be done after all | |
| 2869 DEFVAR_BUFFER_LOCAL() calls. */ | |
| 2870 #define MARKED_SLOT(slot) \ | |
| 2871 if ((XINT (buffer_local_flags.slot) != -2 && \ | |
| 2872 XINT (buffer_local_flags.slot) != -3) \ | |
| 2873 != !(NILP (XBUFFER (Vbuffer_local_symbols)->slot))) \ | |
| 2500 | 2874 ABORT (); |
| 428 | 2875 #include "bufslots.h" |
| 2876 | |
| 2877 { | |
| 2878 Lisp_Object scratch = Fget_buffer_create (QSscratch); | |
| 2879 Fset_buffer (scratch); | |
| 2880 /* Want no undo records for *scratch* until after Emacs is dumped */ | |
| 2881 Fbuffer_disable_undo (scratch); | |
| 2882 } | |
| 2883 } | |
| 2884 | |
| 442 | 2885 #ifndef WIN32_NATIVE |
| 428 | 2886 /* Is PWD another name for `.' ? */ |
| 2887 static int | |
| 867 | 2888 directory_is_current_directory (Ibyte *pwd) |
| 428 | 2889 { |
| 2890 struct stat dotstat, pwdstat; | |
| 2891 | |
| 771 | 2892 return (IS_DIRECTORY_SEP (*pwd) |
| 2893 && qxe_stat (pwd, &pwdstat) == 0 | |
| 867 | 2894 && qxe_stat ((Ibyte *) ".", &dotstat) == 0 |
| 428 | 2895 && dotstat.st_ino == pwdstat.st_ino |
| 771 | 2896 && dotstat.st_dev == pwdstat.st_dev); |
| 428 | 2897 } |
| 442 | 2898 #endif |
| 428 | 2899 |
| 771 | 2900 /* A stand-in for getcwd() #### Fix not to depend on arbitrary size limits */ |
| 2901 | |
| 867 | 2902 Ibyte * |
| 2903 get_initial_directory (Ibyte *pathname, Bytecount size) | |
| 771 | 2904 { |
| 2905 if (pathname) | |
| 2906 { | |
| 2907 qxestrncpy (pathname, initial_directory, size); | |
| 2908 pathname[size - 1] = '\0'; | |
| 2909 } | |
| 2910 return initial_directory; | |
| 2911 } | |
| 2912 | |
| 428 | 2913 void |
| 2914 init_initial_directory (void) | |
| 2915 { | |
| 2916 /* This function can GC */ | |
| 2917 | |
| 442 | 2918 #ifndef WIN32_NATIVE |
| 867 | 2919 Ibyte *pwd; |
| 442 | 2920 #endif |
| 428 | 2921 |
| 2922 /* If PWD is accurate, use it instead of calling getcwd. This is faster | |
| 2923 when PWD is right, and may avoid a fatal error. */ | |
| 442 | 2924 #ifndef WIN32_NATIVE |
| 771 | 2925 if ((pwd = egetenv ("PWD")) != NULL |
| 428 | 2926 && directory_is_current_directory (pwd)) |
| 771 | 2927 initial_directory = qxestrdup (pwd); |
| 442 | 2928 else |
| 2929 #endif | |
| 771 | 2930 if ((initial_directory = qxe_allocating_getcwd ()) == NULL) |
| 2931 { | |
| 867 | 2932 Ibyte *errmess; |
| 771 | 2933 GET_STRERROR (errmess, errno); |
|
4733
a5210e70ffbe
No need to fatal () on startup if $PWD doesn't exist; chdir to "/" instead.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4141
diff
changeset
|
2934 stderr_out ("`getcwd' failed: %s: changing default directory to %s\n", |
|
a5210e70ffbe
No need to fatal () on startup if $PWD doesn't exist; chdir to "/" instead.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4141
diff
changeset
|
2935 errmess, DEFAULT_DIRECTORY_FALLBACK); |
|
a5210e70ffbe
No need to fatal () on startup if $PWD doesn't exist; chdir to "/" instead.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4141
diff
changeset
|
2936 |
|
4736
d261888e5069
Fix Win32 native build after my DEFAULT_DIRECTORY_FALLBACK change, thanks Vin!
Aidan Kehoe <kehoea@parhasard.net>
parents:
4733
diff
changeset
|
2937 if (qxe_chdir ((Ibyte *)DEFAULT_DIRECTORY_FALLBACK) < 0) |
|
4733
a5210e70ffbe
No need to fatal () on startup if $PWD doesn't exist; chdir to "/" instead.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4141
diff
changeset
|
2938 { |
|
a5210e70ffbe
No need to fatal () on startup if $PWD doesn't exist; chdir to "/" instead.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4141
diff
changeset
|
2939 GET_STRERROR (errmess, errno); |
|
a5210e70ffbe
No need to fatal () on startup if $PWD doesn't exist; chdir to "/" instead.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4141
diff
changeset
|
2940 |
|
a5210e70ffbe
No need to fatal () on startup if $PWD doesn't exist; chdir to "/" instead.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4141
diff
changeset
|
2941 fatal ("could not `chdir' to `%s': %s\n", |
|
a5210e70ffbe
No need to fatal () on startup if $PWD doesn't exist; chdir to "/" instead.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4141
diff
changeset
|
2942 DEFAULT_DIRECTORY_FALLBACK, errmess); |
|
a5210e70ffbe
No need to fatal () on startup if $PWD doesn't exist; chdir to "/" instead.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4141
diff
changeset
|
2943 } |
|
a5210e70ffbe
No need to fatal () on startup if $PWD doesn't exist; chdir to "/" instead.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4141
diff
changeset
|
2944 |
|
a5210e70ffbe
No need to fatal () on startup if $PWD doesn't exist; chdir to "/" instead.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4141
diff
changeset
|
2945 initial_directory = qxe_allocating_getcwd(); |
|
a5210e70ffbe
No need to fatal () on startup if $PWD doesn't exist; chdir to "/" instead.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4141
diff
changeset
|
2946 assert (initial_directory != NULL); |
| 771 | 2947 } |
| 428 | 2948 |
| 2949 /* Make sure pwd is DIRECTORY_SEP-terminated. | |
| 2950 Maybe this should really use some standard subroutine | |
| 2951 whose definition is filename syntax dependent. */ | |
| 2952 { | |
| 771 | 2953 Bytecount len = qxestrlen (initial_directory); |
| 428 | 2954 |
| 2955 if (! IS_DIRECTORY_SEP (initial_directory[len - 1])) | |
| 2956 { | |
| 867 | 2957 XREALLOC_ARRAY (initial_directory, Ibyte, len + 2); |
| 428 | 2958 initial_directory[len] = DIRECTORY_SEP; |
| 2959 initial_directory[len + 1] = '\0'; | |
| 2960 } | |
| 2961 } | |
| 2962 | |
| 771 | 2963 #ifdef WIN32_NATIVE |
| 2964 { | |
| 867 | 2965 Ibyte *newinit = mswindows_canonicalize_filename (initial_directory); |
| 1726 | 2966 xfree (initial_directory, Ibyte *); |
| 771 | 2967 initial_directory = newinit; |
| 2968 } | |
| 2969 | |
| 2970 { | |
| 2971 /* Make the real wd be the location of xemacs.exe to avoid conflicts | |
| 2972 when renaming or deleting directories. (We also don't call chdir | |
| 2973 when running subprocesses for the same reason.) */ | |
| 2974 | |
| 2975 Extbyte *p; | |
| 814 | 2976 Extbyte *modname = mswindows_get_module_file_name (); |
| 771 | 2977 |
| 814 | 2978 assert (modname); |
| 2421 | 2979 p = qxetcsrchr (modname, '\\'); |
| 859 | 2980 assert (p); |
| 771 | 2981 XECOPY_TCHAR (p, '\0'); |
| 2982 | |
| 2983 qxeSetCurrentDirectory (modname); | |
| 1726 | 2984 xfree (modname, Extbyte *); |
| 771 | 2985 } |
| 428 | 2986 #endif |
| 2987 } | |
| 2988 | |
| 2989 void | |
| 771 | 2990 init_buffer_1 (void) |
| 2991 { | |
| 2992 Fset_buffer (Fget_buffer_create (QSscratch)); | |
| 2993 } | |
| 2994 | |
| 2995 void | |
| 2996 init_buffer_2 (void) | |
| 428 | 2997 { |
| 2998 /* This function can GC */ | |
| 771 | 2999 Fset_buffer (Fget_buffer (QSscratch)); |
| 3000 | |
| 3001 current_buffer->directory = build_intstring (initial_directory); | |
| 428 | 3002 |
| 3003 #if 0 /* FSFmacs */ | |
| 3004 /* #### is this correct? */ | |
| 3005 temp = get_minibuffer (0); | |
| 3006 XBUFFER (temp)->directory = current_buffer->directory; | |
| 3007 #endif /* FSFmacs */ | |
| 3008 } |