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