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