X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/226c3633fdc0a259aa73aa9e6555cd42dd9f168c..257210319f10abebbfd7c12784cf3a8e112c3562:/src/buffer.c diff --git a/src/buffer.c b/src/buffer.c index 838932db4d..5f9f6a79b6 100644 --- a/src/buffer.c +++ b/src/buffer.c @@ -153,7 +153,7 @@ 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 *, ptrdiff_t, ptrdiff_t); -static Lisp_Object buffer_lisp_local_variables (struct buffer *); +static Lisp_Object buffer_lisp_local_variables (struct buffer *, int); /* For debugging; temporary. See set_buffer_internal. */ /* Lisp_Object Qlisp_mode, Vcheck_symbol; */ @@ -329,7 +329,9 @@ even if it is dead. The return value is never nil. */) /* An ordinary buffer uses its own struct buffer_text. */ b->text = &b->own_text; - b->base_buffer = 0; + b->base_buffer = NULL; + /* No one shares the text with us now. */ + b->indirections = 0; BUF_GAP_SIZE (b) = 20; BLOCK_INPUT; @@ -458,12 +460,9 @@ copy_overlays (struct buffer *b, struct Lisp_Overlay *list) static void clone_per_buffer_values (struct buffer *from, struct buffer *to) { - Lisp_Object to_buffer; int offset; - XSETBUFFER (to_buffer, to); - - for_each_per_buffer_object_at (offset) + FOR_EACH_PER_BUFFER_OBJECT_AT (offset) { Lisp_Object obj; @@ -475,9 +474,9 @@ clone_per_buffer_values (struct buffer *from, struct buffer *to) if (MARKERP (obj) && XMARKER (obj)->buffer == from) { struct Lisp_Marker *m = XMARKER (obj); - obj = Fmake_marker (); + + obj = build_marker (to, m->charpos, m->bytepos); XMARKER (obj)->insertion_type = m->insertion_type; - set_marker_both (obj, to_buffer, m->charpos, m->bytepos); } PER_BUFFER_VALUE (to, offset) = obj; @@ -490,7 +489,7 @@ clone_per_buffer_values (struct buffer *from, struct buffer *to) /* Get (a copy of) the alist of Lisp-level local variables of FROM and install that in TO. */ - BVAR (to, local_var_alist) = buffer_lisp_local_variables (from); + BVAR (to, local_var_alist) = buffer_lisp_local_variables (from, 1); } @@ -571,12 +570,18 @@ CLONE nil means the indirect buffer's state is reset to default values. */) b = allocate_buffer (); + /* No double indirection - if base buffer is indirect, + new buffer becomes an indirect to base's base. */ b->base_buffer = (XBUFFER (base_buffer)->base_buffer ? XBUFFER (base_buffer)->base_buffer : XBUFFER (base_buffer)); /* Use the base buffer's text object. */ b->text = b->base_buffer->text; + /* We have no own text. */ + b->indirections = -1; + /* Notify base buffer that we share the text now. */ + b->base_buffer->indirections++; b->pt = b->base_buffer->pt; b->begv = b->base_buffer->begv; @@ -615,32 +620,24 @@ CLONE nil means the indirect buffer's state is reset to default values. */) eassert (NILP (BVAR (b->base_buffer, begv_marker))); eassert (NILP (BVAR (b->base_buffer, zv_marker))); - BVAR (b->base_buffer, pt_marker) = Fmake_marker (); - set_marker_both (BVAR (b->base_buffer, pt_marker), base_buffer, - b->base_buffer->pt, - b->base_buffer->pt_byte); + BVAR (b->base_buffer, pt_marker) + = build_marker (b->base_buffer, b->base_buffer->pt, b->base_buffer->pt_byte); + + BVAR (b->base_buffer, begv_marker) + = build_marker (b->base_buffer, b->base_buffer->begv, b->base_buffer->begv_byte); - BVAR (b->base_buffer, begv_marker) = Fmake_marker (); - set_marker_both (BVAR (b->base_buffer, begv_marker), base_buffer, - b->base_buffer->begv, - b->base_buffer->begv_byte); + BVAR (b->base_buffer, zv_marker) + = build_marker (b->base_buffer, b->base_buffer->zv, b->base_buffer->zv_byte); - BVAR (b->base_buffer, zv_marker) = Fmake_marker (); - set_marker_both (BVAR (b->base_buffer, zv_marker), base_buffer, - b->base_buffer->zv, - b->base_buffer->zv_byte); XMARKER (BVAR (b->base_buffer, zv_marker))->insertion_type = 1; } if (NILP (clone)) { /* Give the indirect buffer markers for its narrowing. */ - BVAR (b, pt_marker) = Fmake_marker (); - set_marker_both (BVAR (b, pt_marker), buf, b->pt, b->pt_byte); - BVAR (b, begv_marker) = Fmake_marker (); - set_marker_both (BVAR (b, begv_marker), buf, b->begv, b->begv_byte); - BVAR (b, zv_marker) = Fmake_marker (); - set_marker_both (BVAR (b, zv_marker), buf, b->zv, b->zv_byte); + BVAR (b, pt_marker) = build_marker (b, b->pt, b->pt_byte); + BVAR (b, begv_marker) = build_marker (b, b->begv, b->begv_byte); + BVAR (b, zv_marker) = build_marker (b, b->zv, b->zv_byte); XMARKER (BVAR (b, zv_marker))->insertion_type = 1; } else @@ -667,27 +664,40 @@ CLONE nil means the indirect buffer's state is reset to default values. */) return buf; } +/* Mark OV as no longer associated with B. */ + +static void +drop_overlay (struct buffer *b, struct Lisp_Overlay *ov) +{ + eassert (b == XBUFFER (Fmarker_buffer (ov->start))); + modify_overlay (b, marker_position (ov->start), marker_position (ov->end)); + Fset_marker (ov->start, Qnil, Qnil); + Fset_marker (ov->end, Qnil, Qnil); + +} + +/* Delete all overlays of B and reset it's overlay lists. */ + void delete_all_overlays (struct buffer *b) { - Lisp_Object overlay; + struct Lisp_Overlay *ov, *next; - /* `reset_buffer' blindly sets the list of overlays to NULL, so we - have to empty the list, otherwise we end up with overlays that - think they belong to this buffer while the buffer doesn't know about - them any more. */ - while (b->overlays_before) + for (ov = b->overlays_before; ov; ov = next) { - XSETMISC (overlay, b->overlays_before); - Fdelete_overlay (overlay); + drop_overlay (b, ov); + next = ov->next; + ov->next = NULL; } - while (b->overlays_after) + + for (ov = b->overlays_after; ov; ov = next) { - XSETMISC (overlay, b->overlays_after); - Fdelete_overlay (overlay); + drop_overlay (b, ov); + next = ov->next; + ov->next = NULL; } - eassert (b->overlays_before == NULL); - eassert (b->overlays_after == NULL); + + b->overlays_before = b->overlays_after = NULL; } /* Reinitialize everything about a buffer except its name and contents @@ -703,7 +713,7 @@ reset_buffer (register struct buffer *b) BVAR (b, filename) = Qnil; BVAR (b, file_truename) = Qnil; BVAR (b, directory) = (current_buffer) ? BVAR (current_buffer, directory) : Qnil; - EMACS_SET_SECS_NSECS (b->modtime, 0, UNKNOWN_MODTIME_NSECS); + b->modtime = make_emacs_time (0, UNKNOWN_MODTIME_NSECS); b->modtime_size = -1; XSETFASTINT (BVAR (b, save_length), 0); b->last_window_start = 1; @@ -815,7 +825,7 @@ reset_buffer_local_variables (register struct buffer *b, int permanent_too) SET_PER_BUFFER_VALUE_P (b, i, 0); /* For each slot that has a default value, copy that into the slot. */ - for_each_per_buffer_object_at (offset) + FOR_EACH_PER_BUFFER_OBJECT_AT (offset) { int idx = PER_BUFFER_IDX (offset); if ((idx > 0 @@ -859,8 +869,9 @@ is first appended to NAME, to speed up finding a non-existent buffer. */) if (!strncmp (SSDATA (name), " ", 1)) /* see bug#1229 */ { /* Note fileio.c:make_temp_name does random differently. */ - sprintf (number, "-%"pI"d", XFASTINT (Frandom (make_number (999999)))); - tem2 = concat2 (name, build_string (number)); + tem2 = concat2 (name, make_formatted_string + (number, "-%"pI"d", + XFASTINT (Frandom (make_number (999999))))); tem = Fget_buffer (tem2); if (NILP (tem)) return tem2; @@ -871,8 +882,8 @@ is first appended to NAME, to speed up finding a non-existent buffer. */) count = 1; while (1) { - sprintf (number, "<%"pD"d>", ++count); - gentemp = concat2 (tem2, build_string (number)); + gentemp = concat2 (tem2, make_formatted_string + (number, "<%"pD"d>", ++count)); tem = Fstring_equal (gentemp, ignore); if (!NILP (tem)) return gentemp; @@ -1009,10 +1020,12 @@ buffer_local_value_1 (Lisp_Object variable, Lisp_Object buffer) /* Return an alist of the Lisp-level buffer-local bindings of buffer BUF. That is, don't include the variables maintained - in special slots in the buffer object. */ + in special slots in the buffer object. + If CLONE is zero elements of the form (VAR . unbound) are replaced + by VAR. */ static Lisp_Object -buffer_lisp_local_variables (struct buffer *buf) +buffer_lisp_local_variables (struct buffer *buf, int clone) { Lisp_Object result = Qnil; register Lisp_Object tail; @@ -1032,7 +1045,7 @@ buffer_lisp_local_variables (struct buffer *buf) if (buf != current_buffer) val = XCDR (elt); - result = Fcons (EQ (val, Qunbound) + result = Fcons (!clone && EQ (val, Qunbound) ? XCAR (elt) : Fcons (XCAR (elt), val), result); @@ -1061,13 +1074,13 @@ No argument or nil as argument means use current buffer as BUFFER. */) buf = XBUFFER (buffer); } - result = buffer_lisp_local_variables (buf); + result = buffer_lisp_local_variables (buf, 0); /* Add on all the variables stored in special slots. */ { int offset, idx; - for_each_per_buffer_object_at (offset) + FOR_EACH_PER_BUFFER_OBJECT_AT (offset) { idx = PER_BUFFER_IDX (offset); if ((idx == -1 || PER_BUFFER_VALUE_P (buf, idx)) @@ -1429,14 +1442,55 @@ No argument or nil as argument means do this for the current buffer. */) return Qnil; } -/* - DEFVAR_LISP ("kill-buffer-hook", ..., "\ -Hook to be run (by `run-hooks', which see) when a buffer is killed.\n\ -The buffer being killed will be current while the hook is running.\n\ +/* Truncate undo list and shrink the gap of BUFFER. */ + +int +compact_buffer (struct buffer *buffer) +{ + /* Verify indirection counters. */ + if (buffer->base_buffer) + { + eassert (buffer->indirections == -1); + eassert (buffer->base_buffer->indirections > 0); + } + else + eassert (buffer->indirections >= 0); + + /* Skip dead buffers, indirect buffers and buffers + which aren't changed since last compaction. */ + if (!NILP (buffer->BUFFER_INTERNAL_FIELD (name)) + && (buffer->base_buffer == NULL) + && (buffer->text->compact != buffer->text->modiff)) + { + /* If a buffer's undo list is Qt, that means that undo is + turned off in that buffer. Calling truncate_undo_list on + Qt tends to return NULL, which effectively turns undo back on. + So don't call truncate_undo_list if undo_list is Qt. */ + if (!EQ (buffer->BUFFER_INTERNAL_FIELD (undo_list), Qt)) + truncate_undo_list (buffer); + + /* Shrink buffer gaps. */ + if (!buffer->text->inhibit_shrinking) + { + /* If a buffer's gap size is more than 10% of the buffer + size, or larger than 2000 bytes, then shrink it + accordingly. Keep a minimum size of 20 bytes. */ + int size = min (2000, max (20, (buffer->text->z_byte / 10))); + + if (buffer->text->gap_size > size) + { + struct buffer *save_current = current_buffer; + current_buffer = buffer; + make_gap (-(buffer->text->gap_size - size)); + current_buffer = save_current; + } + } + buffer->text->compact = buffer->text->modiff; + return 1; + } + return 0; +} -Functions run by this hook are supposed to not change the current -buffer. See `kill-buffer'." -*/ DEFUN ("kill-buffer", Fkill_buffer, Skill_buffer, 0, 1, "bKill buffer: ", doc: /* Kill the buffer specified by BUFFER-OR-NAME. The argument may be a buffer or the name of an existing buffer. @@ -1518,19 +1572,26 @@ cleaning up all windows currently displaying the buffer to be killed. */) if (EQ (buffer, XWINDOW (minibuf_window)->buffer)) return Qnil; - /* When we kill a base buffer, kill all its indirect buffers. + /* Notify our base buffer that we don't share the text anymore. */ + if (b->base_buffer) + { + eassert (b->indirections == -1); + b->base_buffer->indirections--; + eassert (b->base_buffer->indirections >= 0); + } + + /* When we kill an ordinary buffer which shares it's buffer text + with indirect buffer(s), we must kill indirect buffer(s) too. We do it at this stage so nothing terrible happens if they ask questions or their hooks get errors. */ - if (! b->base_buffer) + if (!b->base_buffer && b->indirections > 0) { struct buffer *other; GCPRO1 (buffer); - for (other = all_buffers; other; other = other->header.next.buffer) - /* all_buffers contains dead buffers too; - don't re-kill them. */ - if (other->base_buffer == b && !NILP (BVAR (other, name))) + FOR_EACH_BUFFER (other) + if (other->base_buffer == b) { Lisp_Object buf; XSETBUFFER (buf, other); @@ -2047,7 +2108,7 @@ DEFUN ("buffer-swap-text", Fbuffer_swap_text, Sbuffer_swap_text, { /* This is probably harder to make work. */ struct buffer *other; - for (other = all_buffers; other; other = other->header.next.buffer) + FOR_EACH_BUFFER (other) if (other->base_buffer == other_buffer || other->base_buffer == current_buffer) error ("One of the buffers to swap has indirect buffers"); @@ -2424,7 +2485,7 @@ current buffer is cleared. */) /* Copy this buffer's new multibyte status into all of its indirect buffers. */ - for (other = all_buffers; other; other = other->header.next.buffer) + FOR_EACH_BUFFER (other) if (other->base_buffer == current_buffer && !NILP (BVAR (other, name))) { BVAR (other, enable_multibyte_characters) @@ -2824,8 +2885,7 @@ overlay_touches_p (ptrdiff_t pos) ptrdiff_t endpos; XSETMISC (overlay ,tail); - if (!OVERLAYP (overlay)) - abort (); + eassert (OVERLAYP (overlay)); endpos = OVERLAY_POSITION (OVERLAY_END (overlay)); if (endpos < pos) @@ -2839,8 +2899,7 @@ overlay_touches_p (ptrdiff_t pos) ptrdiff_t startpos; XSETMISC (overlay, tail); - if (!OVERLAYP (overlay)) - abort (); + eassert (OVERLAYP (overlay)); startpos = OVERLAY_POSITION (OVERLAY_START (overlay)); if (pos < startpos) @@ -2895,7 +2954,7 @@ sort_overlays (Lisp_Object *overlay_vec, ptrdiff_t noverlays, struct window *w) Lisp_Object overlay; overlay = overlay_vec[i]; - if (OVERLAY_VALID (overlay) + if (OVERLAYP (overlay) && OVERLAY_POSITION (OVERLAY_START (overlay)) > 0 && OVERLAY_POSITION (OVERLAY_END (overlay)) > 0) { @@ -3166,22 +3225,7 @@ recenter_overlay_lists (struct buffer *buf, ptrdiff_t pos) { next = tail->next; XSETMISC (overlay, tail); - - /* If the overlay is not valid, get rid of it. */ - if (!OVERLAY_VALID (overlay)) -#if 1 - abort (); -#else - { - /* Splice the cons cell TAIL out of overlays_before. */ - if (!NILP (prev)) - XCDR (prev) = next; - else - buf->overlays_before = next; - tail = prev; - continue; - } -#endif + eassert (OVERLAYP (overlay)); beg = OVERLAY_START (overlay); end = OVERLAY_END (overlay); @@ -3206,7 +3250,7 @@ recenter_overlay_lists (struct buffer *buf, ptrdiff_t pos) Lisp_Object otherbeg, otheroverlay; XSETMISC (otheroverlay, other); - eassert (OVERLAY_VALID (otheroverlay)); + eassert (OVERLAYP (otheroverlay)); otherbeg = OVERLAY_START (otheroverlay); if (OVERLAY_POSITION (otherbeg) >= where) @@ -3234,22 +3278,7 @@ recenter_overlay_lists (struct buffer *buf, ptrdiff_t pos) { next = tail->next; XSETMISC (overlay, tail); - - /* If the overlay is not valid, get rid of it. */ - if (!OVERLAY_VALID (overlay)) -#if 1 - abort (); -#else - { - /* Splice the cons cell TAIL out of overlays_after. */ - if (!NILP (prev)) - XCDR (prev) = next; - else - buf->overlays_after = next; - tail = prev; - continue; - } -#endif + eassert (OVERLAYP (overlay)); beg = OVERLAY_START (overlay); end = OVERLAY_END (overlay); @@ -3279,7 +3308,7 @@ recenter_overlay_lists (struct buffer *buf, ptrdiff_t pos) Lisp_Object otherend, otheroverlay; XSETMISC (otheroverlay, other); - eassert (OVERLAY_VALID (otheroverlay)); + eassert (OVERLAYP (otheroverlay)); otherend = OVERLAY_END (otheroverlay); if (OVERLAY_POSITION (otherend) <= where) @@ -3670,18 +3699,17 @@ modify_overlay (struct buffer *buf, ptrdiff_t start, ptrdiff_t end) ++BUF_OVERLAY_MODIFF (buf); } - +/* Remove OVERLAY from LIST. */ + static struct Lisp_Overlay * unchain_overlay (struct Lisp_Overlay *list, struct Lisp_Overlay *overlay) { - struct Lisp_Overlay *tmp, *prev; - for (tmp = list, prev = NULL; tmp; prev = tmp, tmp = tmp->next) - if (tmp == overlay) + register struct Lisp_Overlay *tail, **prev = &list; + + for (tail = list; tail; prev = &tail->next, tail = *prev) + if (tail == overlay) { - if (prev) - prev->next = tmp->next; - else - list = tmp->next; + *prev = overlay->next; overlay->next = NULL; break; } @@ -3820,11 +3848,7 @@ DEFUN ("delete-overlay", Fdelete_overlay, Sdelete_overlay, 1, 1, 0, = unchain_overlay (b->overlays_after, XOVERLAY (overlay)); eassert (XOVERLAY (overlay)->next == NULL); - modify_overlay (b, - marker_position (OVERLAY_START (overlay)), - marker_position (OVERLAY_END (overlay))); - Fset_marker (OVERLAY_START (overlay), Qnil, Qnil); - Fset_marker (OVERLAY_END (overlay), Qnil, Qnil); + drop_overlay (b, XOVERLAY (overlay)); /* When deleting an overlay with before or after strings, turn off display optimizations for the affected buffer, on the basis that @@ -4900,7 +4924,7 @@ init_buffer_once (void) /* Must do these before making the first buffer! */ /* real setup is done in bindings.el */ - BVAR (&buffer_defaults, mode_line_format) = make_pure_c_string ("%-"); + BVAR (&buffer_defaults, mode_line_format) = build_pure_c_string ("%-"); BVAR (&buffer_defaults, header_line_format) = Qnil; BVAR (&buffer_defaults, abbrev_mode) = Qnil; BVAR (&buffer_defaults, overwrite_mode) = Qnil; @@ -5030,7 +5054,7 @@ init_buffer_once (void) current_buffer = 0; all_buffers = 0; - QSFundamental = make_pure_c_string ("Fundamental"); + QSFundamental = build_pure_c_string ("Fundamental"); Qfundamental_mode = intern_c_string ("fundamental-mode"); BVAR (&buffer_defaults, major_mode) = Qfundamental_mode; @@ -5045,10 +5069,10 @@ init_buffer_once (void) Fput (Qkill_buffer_hook, Qpermanent_local, Qt); /* super-magic invisible buffer */ - Vprin1_to_string_buffer = Fget_buffer_create (make_pure_c_string (" prin1")); + Vprin1_to_string_buffer = Fget_buffer_create (build_pure_c_string (" prin1")); Vbuffer_alist = Qnil; - Fset_buffer (Fget_buffer_create (make_pure_c_string ("*scratch*"))); + Fset_buffer (Fget_buffer_create (build_pure_c_string ("*scratch*"))); inhibit_modification_hooks = 0; } @@ -5067,7 +5091,7 @@ init_buffer (void) Map new memory. */ struct buffer *b; - for (b = all_buffers; b; b = b->header.next.buffer) + FOR_EACH_BUFFER (b) if (b->text->beg == NULL) enlarge_buffer_text (b, 0); } @@ -5093,9 +5117,10 @@ init_buffer (void) fatal ("`get_current_dir_name' failed: %s\n", strerror (errno)); pwd[len] = DIRECTORY_SEP; pwd[len + 1] = '\0'; + len++; } - BVAR (current_buffer, directory) = make_unibyte_string (pwd, strlen (pwd)); + BVAR (current_buffer, directory) = make_unibyte_string (pwd, len); if (! NILP (BVAR (&buffer_defaults, enable_multibyte_characters))) /* At this moment, we still don't know how to decode the directory name. So, we keep the bytes in multibyte form so @@ -5202,7 +5227,7 @@ syms_of_buffer (void) Fput (Qprotected_field, Qerror_conditions, pure_cons (Qprotected_field, pure_cons (Qerror, Qnil))); Fput (Qprotected_field, Qerror_message, - make_pure_c_string ("Attempt to modify a protected field")); + build_pure_c_string ("Attempt to modify a protected field")); DEFVAR_BUFFER_DEFAULTS ("default-mode-line-format", mode_line_format, @@ -6025,7 +6050,6 @@ and `bury-buffer-internal'. */); defsubr (&Smake_indirect_buffer); defsubr (&Sgenerate_new_buffer_name); defsubr (&Sbuffer_name); -/*defsubr (&Sbuffer_number);*/ defsubr (&Sbuffer_file_name); defsubr (&Sbuffer_base_buffer); defsubr (&Sbuffer_local_value);