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