X-Git-Url: https://git.hcoop.net/bpt/emacs.git/blobdiff_plain/f7ff1b0f0792f1f870778404531e68e77832c4a1..7f5515125fbc9b46454e1f84b7e3052a0a5326f0:/src/buffer.c diff --git a/src/buffer.c b/src/buffer.c index 05bd129976..48dde18b02 100644 --- a/src/buffer.c +++ b/src/buffer.c @@ -27,6 +27,8 @@ along with GNU Emacs. If not, see . */ #include #include +#include + #include "lisp.h" #include "intervals.h" #include "window.h" @@ -92,6 +94,11 @@ static Lisp_Object Vbuffer_local_symbols; #define PER_BUFFER_SYMBOL(OFFSET) \ (*(Lisp_Object *)((OFFSET) + (char *) &buffer_local_symbols)) +/* Maximum length of an overlay vector. */ +#define OVERLAY_COUNT_MAX \ + ((ptrdiff_t) min (MOST_POSITIVE_FIXNUM, \ + min (PTRDIFF_MAX, SIZE_MAX) / sizeof (Lisp_Object))) + /* Flags indicating which built-in buffer-local variables are permanent locals. */ static char buffer_permanent_local_flags[MAX_PER_BUFFER_VARS]; @@ -131,19 +138,21 @@ static Lisp_Object Qprotected_field; static Lisp_Object QSFundamental; /* A string "Fundamental" */ static Lisp_Object Qkill_buffer_hook; +static Lisp_Object Qbuffer_list_update_hook; static Lisp_Object Qget_file_buffer; static Lisp_Object Qoverlayp; Lisp_Object Qpriority, Qbefore_string, Qafter_string; + static Lisp_Object Qevaporate; Lisp_Object Qmodification_hooks; Lisp_Object Qinsert_in_front_hooks; Lisp_Object Qinsert_behind_hooks; -static void alloc_buffer_text (struct buffer *, size_t); +static void alloc_buffer_text (struct buffer *, ptrdiff_t); static void free_buffer_text (struct buffer *b); static struct Lisp_Overlay * copy_overlays (struct buffer *, struct Lisp_Overlay *); static void modify_overlay (struct buffer *, EMACS_INT, EMACS_INT); @@ -171,9 +180,9 @@ Value is nil if OBJECT is not a buffer or if it has been killed. */) DEFUN ("buffer-list", Fbuffer_list, Sbuffer_list, 0, 1, 0, doc: /* Return a list of all existing live buffers. -If the optional arg FRAME is a frame, we return the buffer list -in the proper order for that frame: the buffers in FRAME's `buffer-list' -frame parameter come first, followed by the rest of the buffers. */) +If the optional arg FRAME is a frame, we return the buffer list in the +proper order for that frame: the buffers show in FRAME come first, +followed by the rest of the buffers. */) (Lisp_Object frame) { Lisp_Object general; @@ -185,9 +194,9 @@ frame parameter come first, followed by the rest of the buffers. */) Lisp_Object args[3]; CHECK_FRAME (frame); - framelist = Fcopy_sequence (XFRAME (frame)->buffer_list); - prevlist = Fnreverse (Fcopy_sequence (XFRAME (frame)->buried_buffer_list)); + prevlist = Fnreverse (Fcopy_sequence + (XFRAME (frame)->buried_buffer_list)); /* Remove from GENERAL any buffer that duplicates one in FRAMELIST or PREVLIST. */ @@ -209,8 +218,8 @@ frame parameter come first, followed by the rest of the buffers. */) args[2] = prevlist; return Fnconc (3, args); } - - return general; + else + return general; } /* Like Fassoc, but use Fstring_equal to compare @@ -328,7 +337,7 @@ even if it is dead. The return value is never nil. */) alloc_buffer_text (b, BUF_GAP_SIZE (b) + 1); UNBLOCK_INPUT; if (! BUF_BEG_ADDR (b)) - buffer_memory_full (); + buffer_memory_full (BUF_GAP_SIZE (b) + 1); b->pt = BEG; b->begv = BEG; @@ -384,6 +393,9 @@ even if it is dead. The return value is never nil. */) /* Put this in the alist of all live buffers. */ XSETBUFFER (buffer, b); Vbuffer_alist = nconc2 (Vbuffer_alist, Fcons (Fcons (name, buffer), Qnil)); + /* And run buffer-list-update-hook. */ + if (!NILP (Vrun_hooks)) + call1 (Vrun_hooks, Qbuffer_list_update_hook); /* An error in calling the function here (should someone redefine it) can lead to infinite regress until you run out of stack. rms @@ -459,8 +471,8 @@ clone_per_buffer_values (struct buffer *from, struct buffer *to) /* buffer-local Lisp variables start at `undo_list', tho only the ones from `name' on are GC'd normally. */ - for (offset = PER_BUFFER_VAR_OFFSET (undo_list); - offset < sizeof *to; + for (offset = PER_BUFFER_VAR_OFFSET (FIRST_FIELD_PER_BUFFER); + offset <= PER_BUFFER_VAR_OFFSET (LAST_FIELD_PER_BUFFER); offset += sizeof (Lisp_Object)) { Lisp_Object obj; @@ -659,6 +671,10 @@ CLONE nil means the indirect buffer's state is reset to default values. */) set_buffer_internal_1 (old_b); } + /* Run buffer-list-update-hook. */ + if (!NILP (Vrun_hooks)) + call1 (Vrun_hooks, Qbuffer_list_update_hook); + return buf; } @@ -814,8 +830,8 @@ reset_buffer_local_variables (register struct buffer *b, int permanent_too) /* buffer-local Lisp variables start at `undo_list', tho only the ones from `name' on are GC'd normally. */ - for (offset = PER_BUFFER_VAR_OFFSET (undo_list); - offset < sizeof *b; + for (offset = PER_BUFFER_VAR_OFFSET (FIRST_FIELD_PER_BUFFER); + offset <= PER_BUFFER_VAR_OFFSET (LAST_FIELD_PER_BUFFER); offset += sizeof (Lisp_Object)) { int idx = PER_BUFFER_IDX (offset); @@ -841,8 +857,8 @@ it is in the sequence to be tried) even if a buffer with that name exists. */) (register Lisp_Object name, Lisp_Object ignore) { register Lisp_Object gentemp, tem; - int count; - char number[10]; + EMACS_INT count; + char number[INT_BUFSIZE_BOUND (EMACS_INT) + sizeof "<>"]; CHECK_STRING (name); @@ -856,7 +872,7 @@ it is in the sequence to be tried) even if a buffer with that name exists. */) count = 1; while (1) { - sprintf (number, "<%d>", ++count); + sprintf (number, "<%"pI"d>", ++count); gentemp = concat2 (name, build_string (number)); tem = Fstring_equal (gentemp, ignore); if (!NILP (tem)) @@ -1039,8 +1055,8 @@ No argument or nil as argument means use current buffer as BUFFER. */) /* buffer-local Lisp variables start at `undo_list', tho only the ones from `name' on are GC'd normally. */ - for (offset = PER_BUFFER_VAR_OFFSET (undo_list); - offset < sizeof (struct buffer); + for (offset = PER_BUFFER_VAR_OFFSET (FIRST_FIELD_PER_BUFFER); + offset <= PER_BUFFER_VAR_OFFSET (LAST_FIELD_PER_BUFFER); /* sizeof EMACS_INT == sizeof Lisp_Object */ offset += (sizeof (EMACS_INT))) { @@ -1262,81 +1278,119 @@ This does not change the name of the visited file (if any). */) if (NILP (BVAR (current_buffer, filename)) && !NILP (BVAR (current_buffer, auto_save_file_name))) call0 (intern ("rename-auto-save-file")); + + /* Run buffer-list-update-hook. */ + if (!NILP (Vrun_hooks)) + call1 (Vrun_hooks, Qbuffer_list_update_hook); + /* Refetch since that last call may have done GC. */ return BVAR (current_buffer, name); } DEFUN ("other-buffer", Fother_buffer, Sother_buffer, 0, 3, 0, doc: /* Return most recently selected buffer other than BUFFER. -Buffers not visible in windows are preferred to visible buffers, -unless optional second argument VISIBLE-OK is non-nil. -If the optional third argument FRAME is non-nil, use that frame's -buffer list instead of the selected frame's buffer list. -If no other buffer exists, the buffer `*scratch*' is returned. -If BUFFER is omitted or nil, some interesting buffer is returned. */) +Buffers not visible in windows are preferred to visible buffers, unless +optional second argument VISIBLE-OK is non-nil. Ignore the argument +BUFFER unless it denotes a live buffer. If the optional third argument +FRAME is non-nil, use that frame's buffer list instead of the selected +frame's buffer list. + +The buffer is found by scanning the selected or specified frame's buffer +list first, followed by the list of all buffers. If no other buffer +exists, return the buffer `*scratch*' (creating it if necessary). */) (register Lisp_Object buffer, Lisp_Object visible_ok, Lisp_Object frame) { - register Lisp_Object tail, buf, notsogood, tem, pred, add_ons; - notsogood = Qnil; + Lisp_Object Fset_buffer_major_mode (Lisp_Object buffer); + Lisp_Object tail, buf, pred; + Lisp_Object notsogood = Qnil; if (NILP (frame)) frame = selected_frame; CHECK_FRAME (frame); - tail = Vbuffer_alist; pred = frame_buffer_predicate (frame); - - /* Consider buffers that have been seen in the selected frame - before other buffers. */ - - tem = frame_buffer_list (frame); - add_ons = Qnil; - while (CONSP (tem)) + /* Consider buffers that have been seen in the frame first. */ + tail = XFRAME (frame)->buffer_list; + for (; CONSP (tail); tail = XCDR (tail)) { - if (BUFFERP (XCAR (tem))) - add_ons = Fcons (Fcons (Qnil, XCAR (tem)), add_ons); - tem = XCDR (tem); + buf = XCAR (tail); + if (BUFFERP (buf) && !EQ (buf, buffer) + && !NILP (BVAR (XBUFFER (buf), name)) + && (SREF (BVAR (XBUFFER (buf), name), 0) != ' ') + /* If the frame has a buffer_predicate, disregard buffers that + don't fit the predicate. */ + && (NILP (pred) || !NILP (call1 (pred, buf)))) + { + if (!NILP (visible_ok) + || NILP (Fget_buffer_window (buf, Qvisible))) + return buf; + else if (NILP (notsogood)) + notsogood = buf; + } } - tail = nconc2 (Fnreverse (add_ons), tail); + /* Consider alist of all buffers next. */ + tail = Vbuffer_alist; for (; CONSP (tail); tail = XCDR (tail)) { buf = Fcdr (XCAR (tail)); - if (EQ (buf, buffer)) - continue; + if (BUFFERP (buf) && !EQ (buf, buffer) + && !NILP (BVAR (XBUFFER (buf), name)) + && (SREF (BVAR (XBUFFER (buf), name), 0) != ' ') + /* If the frame has a buffer_predicate, disregard buffers that + don't fit the predicate. */ + && (NILP (pred) || !NILP (call1 (pred, buf)))) + { + if (!NILP (visible_ok) + || NILP (Fget_buffer_window (buf, Qvisible))) + return buf; + else if (NILP (notsogood)) + notsogood = buf; + } + } + + if (!NILP (notsogood)) + return notsogood; + else + { + buf = Fget_buffer (build_string ("*scratch*")); if (NILP (buf)) - continue; - if (NILP (BVAR (XBUFFER (buf), name))) - continue; - if (SREF (BVAR (XBUFFER (buf), name), 0) == ' ') - continue; - /* If the selected frame has a buffer_predicate, - disregard buffers that don't fit the predicate. */ - if (!NILP (pred)) { - tem = call1 (pred, buf); - if (NILP (tem)) - continue; + buf = Fget_buffer_create (build_string ("*scratch*")); + Fset_buffer_major_mode (buf); } + return buf; + } +} - if (NILP (visible_ok)) - tem = Fget_buffer_window (buf, Qvisible); - else - tem = Qnil; - if (NILP (tem)) +/* The following function is a safe variant of Fother_buffer: It doesn't + pay attention to any frame-local buffer lists, doesn't care about + visibility of buffers, and doesn't evaluate any frame predicates. */ + +Lisp_Object +other_buffer_safely (Lisp_Object buffer) +{ + Lisp_Object Fset_buffer_major_mode (Lisp_Object buffer); + Lisp_Object tail, buf; + + tail = Vbuffer_alist; + for (; CONSP (tail); tail = XCDR (tail)) + { + buf = Fcdr (XCAR (tail)); + if (BUFFERP (buf) && !EQ (buf, buffer) + && !NILP (BVAR (XBUFFER (buf), name)) + && (SREF (BVAR (XBUFFER (buf), name), 0) != ' ')) return buf; - if (NILP (notsogood)) - notsogood = buf; } - if (!NILP (notsogood)) - return notsogood; + buf = Fget_buffer (build_string ("*scratch*")); if (NILP (buf)) { buf = Fget_buffer_create (build_string ("*scratch*")); Fset_buffer_major_mode (buf); } + return buf; } @@ -1509,13 +1563,20 @@ with SIGHUP. */) if (NILP (BVAR (b, name))) return Qnil; + /* These may run Lisp code and into infinite loops (if someone + insisted on circular lists) so allow quitting here. */ + replace_buffer_in_windows (buffer); + frames_discard_buffer (buffer); + clear_charpos_cache (b); tem = Vinhibit_quit; Vinhibit_quit = Qt; - replace_buffer_in_all_windows (buffer); + /* Remove the buffer from the list of all buffers. */ Vbuffer_alist = Fdelq (Frassq (buffer, Vbuffer_alist), Vbuffer_alist); - frames_discard_buffer (buffer); + /* If replace_buffer_in_windows didn't do its job correctly fix that + now. */ + replace_buffer_in_windows_safely (buffer); Vinhibit_quit = tem; /* Delete any auto-save file, if we saved it in this session. @@ -1589,83 +1650,102 @@ with SIGHUP. */) UNBLOCK_INPUT; BVAR (b, undo_list) = Qnil; + /* Run buffer-list-update-hook. */ + if (!NILP (Vrun_hooks)) + call1 (Vrun_hooks, Qbuffer_list_update_hook); + return Qt; } -/* Move the assoc for buffer BUF to the front of buffer-alist. Since - we do this each time BUF is selected visibly, the more recently - selected buffers are always closer to the front of the list. This - means that other_buffer is more likely to choose a relevant buffer. */ +/* Move association for BUFFER to the front of buffer (a)lists. Since + we do this each time BUFFER is selected visibly, the more recently + selected buffers are always closer to the front of those lists. This + means that other_buffer is more likely to choose a relevant buffer. + + Note that this moves BUFFER to the front of the buffer lists of the + selected frame even if BUFFER is not shown there. If BUFFER is not + shown in the selected frame, consider the present behavior a feature. + `select-window' gets this right since it shows BUFFER in the selected + window when calling us. */ void -record_buffer (Lisp_Object buf) +record_buffer (Lisp_Object buffer) { - register Lisp_Object list, prev; - Lisp_Object frame; - frame = selected_frame; + Lisp_Object aelt, aelt_cons, tem; + register struct frame *f = XFRAME (selected_frame); - prev = Qnil; - for (list = Vbuffer_alist; CONSP (list); list = XCDR (list)) - { - if (EQ (XCDR (XCAR (list)), buf)) - break; - prev = list; - } + CHECK_BUFFER (buffer); - /* Effectively do Vbuffer_alist = Fdelq (list, Vbuffer_alist); - we cannot use Fdelq itself here because it allows quitting. */ + /* Update Vbuffer_alist (we know that it has an entry for BUFFER). + Don't allow quitting since this might leave the buffer list in an + inconsistent state. */ + tem = Vinhibit_quit; + Vinhibit_quit = Qt; + aelt = Frassq (buffer, Vbuffer_alist); + aelt_cons = Fmemq (aelt, Vbuffer_alist); + Vbuffer_alist = Fdelq (aelt, Vbuffer_alist); + XSETCDR (aelt_cons, Vbuffer_alist); + Vbuffer_alist = aelt_cons; + Vinhibit_quit = tem; - if (NILP (prev)) - Vbuffer_alist = XCDR (Vbuffer_alist); - else - XSETCDR (prev, XCDR (XCDR (prev))); + /* Update buffer list of selected frame. */ + f->buffer_list = Fcons (buffer, Fdelq (buffer, f->buffer_list)); + f->buried_buffer_list = Fdelq (buffer, f->buried_buffer_list); - XSETCDR (list, Vbuffer_alist); - Vbuffer_alist = list; + /* Run buffer-list-update-hook. */ + if (!NILP (Vrun_hooks)) + call1 (Vrun_hooks, Qbuffer_list_update_hook); +} - /* Effectively do a delq on buried_buffer_list. */ +DEFUN ("record-buffer", Frecord_buffer, Srecord_buffer, 1, 1, 0, + doc: /* Move BUFFER to the front of the buffer list. +Return BUFFER. */) + (Lisp_Object buffer) +{ + CHECK_BUFFER (buffer); - prev = Qnil; - for (list = XFRAME (frame)->buried_buffer_list; CONSP (list); - list = XCDR (list)) - { - if (EQ (XCAR (list), buf)) - { - if (NILP (prev)) - XFRAME (frame)->buried_buffer_list = XCDR (list); - else - XSETCDR (prev, XCDR (XCDR (prev))); - break; - } - prev = list; - } + record_buffer (buffer); - /* Now move this buffer to the front of frame_buffer_list also. */ + return buffer; +} - prev = Qnil; - for (list = frame_buffer_list (frame); CONSP (list); - list = XCDR (list)) - { - if (EQ (XCAR (list), buf)) - break; - prev = list; - } + /* Move BUFFER to the end of the buffer (a)lists. Do nothing if the + buffer is killed. For the selected frame's buffer list this moves + BUFFER to its end even if it was never shown in that frame. If + this happens we have a feature, hence `unrecord-buffer' should be + called only when BUFFER was shown in the selected frame. */ - /* Effectively do delq. */ +DEFUN ("unrecord-buffer", Funrecord_buffer, Sunrecord_buffer, 1, 1, 0, + doc: /* Move BUFFER to the end of the buffer list. +Return BUFFER. */) + (Lisp_Object buffer) +{ + Lisp_Object aelt, aelt_cons, tem; + register struct frame *f = XFRAME (selected_frame); - if (CONSP (list)) - { - if (NILP (prev)) - set_frame_buffer_list (frame, - XCDR (frame_buffer_list (frame))); - else - XSETCDR (prev, XCDR (XCDR (prev))); + CHECK_BUFFER (buffer); - XSETCDR (list, frame_buffer_list (frame)); - set_frame_buffer_list (frame, list); - } - else - set_frame_buffer_list (frame, Fcons (buf, frame_buffer_list (frame))); + /* Update Vbuffer_alist (we know that it has an entry for BUFFER). + Don't allow quitting since this might leave the buffer list in an + inconsistent state. */ + tem = Vinhibit_quit; + Vinhibit_quit = Qt; + aelt = Frassq (buffer, Vbuffer_alist); + aelt_cons = Fmemq (aelt, Vbuffer_alist); + Vbuffer_alist = Fdelq (aelt, Vbuffer_alist); + XSETCDR (aelt_cons, Qnil); + Vbuffer_alist = nconc2 (Vbuffer_alist, aelt_cons); + Vinhibit_quit = tem; + + /* Update buffer lists of selected frame. */ + f->buffer_list = Fdelq (buffer, f->buffer_list); + f->buried_buffer_list = Fcons (buffer, Fdelq (buffer, f->buried_buffer_list)); + + /* Run buffer-list-update-hook. */ + if (!NILP (Vrun_hooks)) + call1 (Vrun_hooks, Qbuffer_list_update_hook); + + return buffer; } DEFUN ("set-buffer-major-mode", Fset_buffer_major_mode, Sset_buffer_major_mode, 1, 1, 0, @@ -1708,86 +1788,6 @@ the current buffer's major mode. */) return unbind_to (count, Qnil); } -/* Switch to buffer BUFFER in the selected window. - If NORECORD is non-nil, don't call record_buffer. */ - -static Lisp_Object -switch_to_buffer_1 (Lisp_Object buffer_or_name, Lisp_Object norecord) -{ - register Lisp_Object buffer; - - if (NILP (buffer_or_name)) - buffer = Fother_buffer (Fcurrent_buffer (), Qnil, Qnil); - else - { - buffer = Fget_buffer (buffer_or_name); - if (NILP (buffer)) - { - buffer = Fget_buffer_create (buffer_or_name); - Fset_buffer_major_mode (buffer); - } - } - Fset_buffer (buffer); - if (NILP (norecord)) - record_buffer (buffer); - - Fset_window_buffer (EQ (selected_window, minibuf_window) - ? Fnext_window (minibuf_window, Qnil, Qnil) - : selected_window, - buffer, Qnil); - - return buffer; -} - -DEFUN ("switch-to-buffer", Fswitch_to_buffer, Sswitch_to_buffer, 1, 2, - "(list (read-buffer-to-switch \"Switch to buffer: \"))", - doc: /* Make BUFFER-OR-NAME current and display it in selected window. -BUFFER-OR-NAME may be a buffer, a string \(a buffer name), or -nil. Return the buffer switched to. - -If BUFFER-OR-NAME is a string and does not identify an existing -buffer, create a new buffer with that name. Interactively, if -`confirm-nonexistent-file-or-buffer' is non-nil, request -confirmation before creating a new buffer. If BUFFER-OR-NAME is -nil, switch to buffer returned by `other-buffer'. - -Optional second arg NORECORD non-nil means do not put this buffer -at the front of the list of recently selected ones. This -function returns the buffer it switched to as a Lisp object. - -If the selected window is the minibuffer window or dedicated to -its buffer, use `pop-to-buffer' for displaying the buffer. - -WARNING: This is NOT the way to work on another buffer temporarily -within a Lisp program! Use `set-buffer' instead. That avoids -messing with the window-buffer correspondences. */) - (Lisp_Object buffer_or_name, Lisp_Object norecord) -{ - if (EQ (buffer_or_name, Fwindow_buffer (selected_window))) - { - /* Basically a NOP. Avoid signalling an error in the case where - the selected window is dedicated, or a minibuffer. */ - - /* But do put this buffer at the front of the buffer list, unless - that has been inhibited. Note that even if BUFFER-OR-NAME is - at the front of the main buffer-list already, we still want to - move it to the front of the frame's buffer list. */ - if (NILP (norecord)) - record_buffer (buffer_or_name); - return Fset_buffer (buffer_or_name); - } - else if (EQ (minibuf_window, selected_window) - /* If `dedicated' is neither nil nor t, it means it's - dedicatedness can be overridden by an explicit request - such as a call to switch-to-buffer. */ - || EQ (Fwindow_dedicated_p (selected_window), Qt)) - /* We can't use the selected window so let `pop-to-buffer' try some - other window. */ - return call3 (intern ("pop-to-buffer"), buffer_or_name, Qnil, norecord); - else - return switch_to_buffer_1 (buffer_or_name, norecord); -} - DEFUN ("current-buffer", Fcurrent_buffer, Scurrent_buffer, 0, 0, 0, doc: /* Return the current buffer as a Lisp object. */) (void) @@ -1937,68 +1937,6 @@ DEFUN ("barf-if-buffer-read-only", Fbarf_if_buffer_read_only, xsignal1 (Qbuffer_read_only, Fcurrent_buffer ()); return Qnil; } - -DEFUN ("bury-buffer", Fbury_buffer, Sbury_buffer, 0, 1, "", - doc: /* Put BUFFER-OR-NAME at the end of the list of all buffers. -There it is the least likely candidate for `other-buffer' to return; -thus, the least likely buffer for \\[switch-to-buffer] to select by -default. - -The argument may be a buffer name or an actual buffer object. If -BUFFER-OR-NAME is nil or omitted, bury the current buffer and remove it -from the selected window if it is displayed there. If the selected -window is dedicated to its buffer, delete that window if there are other -windows on the same frame. If the selected window is the only window on -its frame, iconify that frame. */) - (register Lisp_Object buffer_or_name) -{ - Lisp_Object buffer; - - /* Figure out what buffer we're going to bury. */ - if (NILP (buffer_or_name)) - { - Lisp_Object tem; - XSETBUFFER (buffer, current_buffer); - - tem = Fwindow_buffer (selected_window); - /* If we're burying the current buffer, unshow it. */ - if (EQ (buffer, tem)) - { - if (NILP (Fwindow_dedicated_p (selected_window))) - Fswitch_to_buffer (Fother_buffer (buffer, Qnil, Qnil), Qnil); - else if (NILP (XWINDOW (selected_window)->parent)) - Ficonify_frame (Fwindow_frame (selected_window)); - else - Fdelete_window (selected_window); - } - } - else - { - buffer = Fget_buffer (buffer_or_name); - if (NILP (buffer)) - nsberror (buffer_or_name); - } - - /* Move buffer to the end of the buffer list. Do nothing if the - buffer is killed. */ - if (!NILP (BVAR (XBUFFER (buffer), name))) - { - Lisp_Object aelt, list; - - aelt = Frassq (buffer, Vbuffer_alist); - list = Fmemq (aelt, Vbuffer_alist); - Vbuffer_alist = Fdelq (aelt, Vbuffer_alist); - XSETCDR (list, Qnil); - Vbuffer_alist = nconc2 (Vbuffer_alist, list); - - XFRAME (selected_frame)->buffer_list - = Fdelq (buffer, XFRAME (selected_frame)->buffer_list); - XFRAME (selected_frame)->buried_buffer_list - = Fcons (buffer, Fdelq (buffer, XFRAME (selected_frame)->buried_buffer_list)); - } - - return Qnil; -} DEFUN ("erase-buffer", Ferase_buffer, Serase_buffer, 0, 0, "*", doc: /* Delete the entire contents of the current buffer. @@ -2038,7 +1976,7 @@ validate_region (register Lisp_Object *b, register Lisp_Object *e) /* Advance BYTE_POS up to a character boundary and return the adjusted position. */ -static int +static EMACS_INT advance_to_char_boundary (EMACS_INT byte_pos) { int c; @@ -2585,14 +2523,15 @@ swap_out_buffer_local_variables (struct buffer *b) *NEXT_PTR is guaranteed to be not equal to POS, unless it is the default (BEGV or ZV). */ -int -overlays_at (EMACS_INT pos, int extend, Lisp_Object **vec_ptr, int *len_ptr, +ptrdiff_t +overlays_at (EMACS_INT pos, int extend, Lisp_Object **vec_ptr, + ptrdiff_t *len_ptr, EMACS_INT *next_ptr, EMACS_INT *prev_ptr, int change_req) { Lisp_Object overlay, start, end; struct Lisp_Overlay *tail; - int idx = 0; - int len = *len_ptr; + ptrdiff_t idx = 0; + ptrdiff_t len = *len_ptr; Lisp_Object *vec = *vec_ptr; EMACS_INT next = ZV; EMACS_INT prev = BEGV; @@ -2628,10 +2567,10 @@ overlays_at (EMACS_INT pos, int extend, Lisp_Object **vec_ptr, int *len_ptr, Either make it bigger, or don't store any more in it. */ if (extend) { + if ((OVERLAY_COUNT_MAX - 4) / 2 < len) + memory_full (SIZE_MAX); /* Make it work with an initial len == 0. */ - len *= 2; - if (len == 0) - len = 4; + len = len * 2 + 4; *len_ptr = len; vec = (Lisp_Object *) xrealloc (vec, len * sizeof (Lisp_Object)); *vec_ptr = vec; @@ -2671,10 +2610,10 @@ overlays_at (EMACS_INT pos, int extend, Lisp_Object **vec_ptr, int *len_ptr, { if (extend) { + if ((OVERLAY_COUNT_MAX - 4) / 2 < len) + memory_full (SIZE_MAX); /* Make it work with an initial len == 0. */ - len *= 2; - if (len == 0) - len = 4; + len = len * 2 + 4; *len_ptr = len; vec = (Lisp_Object *) xrealloc (vec, len * sizeof (Lisp_Object)); *vec_ptr = vec; @@ -2724,15 +2663,15 @@ overlays_at (EMACS_INT pos, int extend, Lisp_Object **vec_ptr, int *len_ptr, and we store only as many overlays as will fit. But we still return the total number of overlays. */ -static int +static ptrdiff_t overlays_in (EMACS_INT beg, EMACS_INT end, int extend, - Lisp_Object **vec_ptr, int *len_ptr, + Lisp_Object **vec_ptr, ptrdiff_t *len_ptr, EMACS_INT *next_ptr, EMACS_INT *prev_ptr) { Lisp_Object overlay, ostart, oend; struct Lisp_Overlay *tail; - int idx = 0; - int len = *len_ptr; + ptrdiff_t idx = 0; + ptrdiff_t len = *len_ptr; Lisp_Object *vec = *vec_ptr; EMACS_INT next = ZV; EMACS_INT prev = BEGV; @@ -2768,10 +2707,10 @@ overlays_in (EMACS_INT beg, EMACS_INT end, int extend, Either make it bigger, or don't store any more in it. */ if (extend) { + if ((OVERLAY_COUNT_MAX - 4) / 2 < len) + memory_full (SIZE_MAX); /* Make it work with an initial len == 0. */ - len *= 2; - if (len == 0) - len = 4; + len = len * 2 + 4; *len_ptr = len; vec = (Lisp_Object *) xrealloc (vec, len * sizeof (Lisp_Object)); *vec_ptr = vec; @@ -2816,10 +2755,10 @@ overlays_in (EMACS_INT beg, EMACS_INT end, int extend, { if (extend) { + if ((OVERLAY_COUNT_MAX - 4) / 2 < len) + memory_full (SIZE_MAX); /* Make it work with an initial len == 0. */ - len *= 2; - if (len == 0) - len = 4; + len = len * 2 + 4; *len_ptr = len; vec = (Lisp_Object *) xrealloc (vec, len * sizeof (Lisp_Object)); *vec_ptr = vec; @@ -2852,7 +2791,7 @@ mouse_face_overlay_overlaps (Lisp_Object overlay) { EMACS_INT start = OVERLAY_POSITION (OVERLAY_START (overlay)); EMACS_INT end = OVERLAY_POSITION (OVERLAY_END (overlay)); - int n, i, size; + ptrdiff_t n, i, size; Lisp_Object *v, tem; size = 10; @@ -2918,7 +2857,7 @@ struct sortvec { Lisp_Object overlay; EMACS_INT beg, end; - int priority; + EMACS_INT priority; }; static int @@ -2927,21 +2866,21 @@ compare_overlays (const void *v1, const void *v2) const struct sortvec *s1 = (const struct sortvec *) v1; const struct sortvec *s2 = (const struct sortvec *) v2; if (s1->priority != s2->priority) - return s1->priority - s2->priority; + return s1->priority < s2->priority ? -1 : 1; if (s1->beg != s2->beg) - return s1->beg - s2->beg; + return s1->beg < s2->beg ? -1 : 1; if (s1->end != s2->end) - return s2->end - s1->end; + return s2->end < s1->end ? -1 : 1; return 0; } /* Sort an array of overlays by priority. The array is modified in place. The return value is the new size; this may be smaller than the original size if some of the overlays were invalid or were window-specific. */ -int -sort_overlays (Lisp_Object *overlay_vec, int noverlays, struct window *w) +ptrdiff_t +sort_overlays (Lisp_Object *overlay_vec, ptrdiff_t noverlays, struct window *w) { - int i, j; + ptrdiff_t i, j; struct sortvec *sortvec; sortvec = (struct sortvec *) alloca (noverlays * sizeof (struct sortvec)); @@ -2995,15 +2934,15 @@ sort_overlays (Lisp_Object *overlay_vec, int noverlays, struct window *w) struct sortstr { Lisp_Object string, string2; - int size; - int priority; + ptrdiff_t size; + EMACS_INT priority; }; struct sortstrlist { struct sortstr *buf; /* An array that expands as needed; never freed. */ - int size; /* Allocated length of that array. */ - int used; /* How much of the array is currently in use. */ + ptrdiff_t size; /* Allocated length of that array. */ + ptrdiff_t used; /* How much of the array is currently in use. */ EMACS_INT bytes; /* Total length of the strings in buf. */ }; @@ -3024,20 +2963,24 @@ cmp_for_strings (const void *as1, const void *as2) struct sortstr *s1 = (struct sortstr *)as1; struct sortstr *s2 = (struct sortstr *)as2; if (s1->size != s2->size) - return s2->size - s1->size; + return s2->size < s1->size ? -1 : 1; if (s1->priority != s2->priority) - return s1->priority - s2->priority; + return s1->priority < s2->priority ? -1 : 1; return 0; } static void -record_overlay_string (struct sortstrlist *ssl, Lisp_Object str, Lisp_Object str2, Lisp_Object pri, int size) +record_overlay_string (struct sortstrlist *ssl, Lisp_Object str, + Lisp_Object str2, Lisp_Object pri, ptrdiff_t size) { EMACS_INT nbytes; if (ssl->used == ssl->size) { - if (ssl->buf) + if (min (PTRDIFF_MAX, SIZE_MAX) / (sizeof (struct sortstr) * 2) + < ssl->size) + memory_full (SIZE_MAX); + else if (0 < ssl->size) ssl->size *= 2; else ssl->size = 5; @@ -3943,9 +3886,8 @@ DEFUN ("overlays-at", Foverlays_at, Soverlays_at, 1, 1, 0, doc: /* Return a list of the overlays that contain the character at POS. */) (Lisp_Object pos) { - int noverlays; + ptrdiff_t len, noverlays; Lisp_Object *overlay_vec; - int len; Lisp_Object result; CHECK_NUMBER_COERCE_MARKER (pos); @@ -3975,9 +3917,8 @@ between BEG and END, or at END provided END denotes the position at the end of the buffer. */) (Lisp_Object beg, Lisp_Object end) { - int noverlays; + ptrdiff_t len, noverlays; Lisp_Object *overlay_vec; - int len; Lisp_Object result; CHECK_NUMBER_COERCE_MARKER (beg); @@ -4005,11 +3946,9 @@ If there are no overlay boundaries from POS to (point-max), the value is (point-max). */) (Lisp_Object pos) { - int noverlays; + ptrdiff_t i, len, noverlays; EMACS_INT endpos; Lisp_Object *overlay_vec; - int len; - int i; CHECK_NUMBER_COERCE_MARKER (pos); @@ -4048,7 +3987,7 @@ the value is (point-min). */) { EMACS_INT prevpos; Lisp_Object *overlay_vec; - int len; + ptrdiff_t len; CHECK_NUMBER_COERCE_MARKER (pos); @@ -4117,7 +4056,8 @@ DEFUN ("overlay-get", Foverlay_get, Soverlay_get, 2, 2, 0, } DEFUN ("overlay-put", Foverlay_put, Soverlay_put, 3, 3, 0, - doc: /* Set one property of overlay OVERLAY: give property PROP value VALUE. */) + doc: /* Set one property of overlay OVERLAY: give property PROP value VALUE. +VALUE will be returned.*/) (Lisp_Object overlay, Lisp_Object prop, Lisp_Object value) { Lisp_Object tail, buffer; @@ -4876,7 +4816,7 @@ extern void r_alloc_free (POINTER_TYPE **ptr); /* Allocate NBYTES bytes for buffer B's text buffer. */ static void -alloc_buffer_text (struct buffer *b, size_t nbytes) +alloc_buffer_text (struct buffer *b, ptrdiff_t nbytes) { POINTER_TYPE *p; @@ -4892,7 +4832,7 @@ alloc_buffer_text (struct buffer *b, size_t nbytes) if (p == NULL) { UNBLOCK_INPUT; - memory_full (); + memory_full (nbytes); } b->text->beg = (unsigned char *) p; @@ -4906,8 +4846,8 @@ void enlarge_buffer_text (struct buffer *b, EMACS_INT delta) { POINTER_TYPE *p; - size_t nbytes = (BUF_Z_BYTE (b) - BUF_BEG_BYTE (b) + BUF_GAP_SIZE (b) + 1 - + delta); + ptrdiff_t nbytes = (BUF_Z_BYTE (b) - BUF_BEG_BYTE (b) + BUF_GAP_SIZE (b) + 1 + + delta); BLOCK_INPUT; #if defined USE_MMAP_FOR_BUFFERS p = mmap_realloc ((POINTER_TYPE **) &b->text->beg, nbytes); @@ -4920,7 +4860,7 @@ enlarge_buffer_text (struct buffer *b, EMACS_INT delta) if (p == NULL) { UNBLOCK_INPUT; - memory_full (); + memory_full (nbytes); } BUF_BEG_ADDR (b) = (unsigned char *) p; @@ -5040,7 +4980,7 @@ init_buffer_once (void) The local flag bits are in the local_var_flags slot of the buffer. */ /* Nothing can work if this isn't true */ - if (sizeof (EMACS_INT) != sizeof (Lisp_Object)) abort (); + { verify (sizeof (EMACS_INT) == sizeof (Lisp_Object)); } /* 0 means not a lisp var, -1 means always local, else mask */ memset (&buffer_local_flags, 0, sizeof buffer_local_flags); @@ -5146,7 +5086,7 @@ init_buffer (void) { char *pwd; Lisp_Object temp; - int len; + ptrdiff_t len; #ifdef USE_MMAP_FOR_BUFFERS { @@ -5270,39 +5210,26 @@ syms_of_buffer (void) staticpro (&Vbuffer_alist); staticpro (&Qprotected_field); staticpro (&Qpermanent_local); - Qpermanent_local_hook = intern_c_string ("permanent-local-hook"); - staticpro (&Qpermanent_local_hook); staticpro (&Qkill_buffer_hook); - Qoverlayp = intern_c_string ("overlayp"); - staticpro (&Qoverlayp); - Qevaporate = intern_c_string ("evaporate"); - staticpro (&Qevaporate); - Qmodification_hooks = intern_c_string ("modification-hooks"); - staticpro (&Qmodification_hooks); - Qinsert_in_front_hooks = intern_c_string ("insert-in-front-hooks"); - staticpro (&Qinsert_in_front_hooks); - Qinsert_behind_hooks = intern_c_string ("insert-behind-hooks"); - staticpro (&Qinsert_behind_hooks); - Qget_file_buffer = intern_c_string ("get-file-buffer"); - staticpro (&Qget_file_buffer); - Qpriority = intern_c_string ("priority"); - staticpro (&Qpriority); - Qbefore_string = intern_c_string ("before-string"); - staticpro (&Qbefore_string); - Qafter_string = intern_c_string ("after-string"); - staticpro (&Qafter_string); - Qfirst_change_hook = intern_c_string ("first-change-hook"); - staticpro (&Qfirst_change_hook); - Qbefore_change_functions = intern_c_string ("before-change-functions"); - staticpro (&Qbefore_change_functions); - Qafter_change_functions = intern_c_string ("after-change-functions"); - staticpro (&Qafter_change_functions); + + DEFSYM (Qpermanent_local_hook, "permanent-local-hook"); + DEFSYM (Qoverlayp, "overlayp"); + DEFSYM (Qevaporate, "evaporate"); + DEFSYM (Qmodification_hooks, "modification-hooks"); + DEFSYM (Qinsert_in_front_hooks, "insert-in-front-hooks"); + DEFSYM (Qinsert_behind_hooks, "insert-behind-hooks"); + DEFSYM (Qget_file_buffer, "get-file-buffer"); + DEFSYM (Qpriority, "priority"); + DEFSYM (Qbefore_string, "before-string"); + DEFSYM (Qafter_string, "after-string"); + DEFSYM (Qfirst_change_hook, "first-change-hook"); + DEFSYM (Qbefore_change_functions, "before-change-functions"); + DEFSYM (Qafter_change_functions, "after-change-functions"); + DEFSYM (Qkill_buffer_query_functions, "kill-buffer-query-functions"); + /* The next one is initialized in init_buffer_once. */ staticpro (&Qucs_set_table_for_input); - Qkill_buffer_query_functions = intern_c_string ("kill-buffer-query-functions"); - staticpro (&Qkill_buffer_query_functions); - Fput (Qprotected_field, Qerror_conditions, pure_cons (Qprotected_field, pure_cons (Qerror, Qnil))); Fput (Qprotected_field, Qerror_message, @@ -6096,8 +6023,15 @@ If any of them returns nil, the buffer is not killed. */); doc: /* Normal hook run before changing the major mode of a buffer. The function `kill-all-local-variables' runs this before doing anything else. */); Vchange_major_mode_hook = Qnil; - Qchange_major_mode_hook = intern_c_string ("change-major-mode-hook"); - staticpro (&Qchange_major_mode_hook); + DEFSYM (Qchange_major_mode_hook, "change-major-mode-hook"); + + DEFVAR_LISP ("buffer-list-update-hook", Vbuffer_list_update_hook, + doc: /* Hook run when the buffer list changes. +Functions running this hook are `get-buffer-create', +`make-indirect-buffer', `rename-buffer', `kill-buffer', +`record-buffer' and `unrecord-buffer'. */); + Vbuffer_list_update_hook = Qnil; + DEFSYM (Qbuffer_list_update_hook, "buffer-list-update-hook"); defsubr (&Sbuffer_live_p); defsubr (&Sbuffer_list); @@ -6120,12 +6054,12 @@ The function `kill-all-local-variables' runs this before doing anything else. * defsubr (&Sother_buffer); defsubr (&Sbuffer_enable_undo); defsubr (&Skill_buffer); + defsubr (&Srecord_buffer); + defsubr (&Sunrecord_buffer); defsubr (&Sset_buffer_major_mode); - defsubr (&Sswitch_to_buffer); defsubr (&Scurrent_buffer); defsubr (&Sset_buffer); defsubr (&Sbarf_if_buffer_read_only); - defsubr (&Sbury_buffer); defsubr (&Serase_buffer); defsubr (&Sbuffer_swap_text); defsubr (&Sset_buffer_multibyte);