=== modified file 'src/alloc.c' --- src/alloc.c 2012-07-23 11:15:43 +0000 +++ src/alloc.c 2012-07-25 09:05:16 +0000 @@ -3653,17 +3653,10 @@ doc: /* Return a newly allocated marker which does not point at any place. */) (void) { - register Lisp_Object val; - register struct Lisp_Marker *p; + register Lisp_Object marker = allocate_misc (Lisp_Misc_Marker); - val = allocate_misc (Lisp_Misc_Marker); - p = XMARKER (val); - p->buffer = 0; - p->bytepos = 0; - p->charpos = 0; - p->next = NULL; - p->insertion_type = 0; - return val; + init_marker (XMARKER (marker), NULL, 0, 0, 0); + return marker; } /* Return a newly allocated marker which points into BUF @@ -3672,24 +3665,23 @@ Lisp_Object build_marker (struct buffer *buf, ptrdiff_t charpos, ptrdiff_t bytepos) { - Lisp_Object obj; - struct Lisp_Marker *m; + register Lisp_Object marker = allocate_misc (Lisp_Misc_Marker); + + /* Use Fmake_marker to create marker points to nowhere. */ + eassert (buf != NULL); /* No dead buffers here. */ eassert (!NILP (BVAR (buf, name))); - /* Every character is at least one byte. */ - eassert (charpos <= bytepos); + /* In a single-byte buffer, two positions must be equal. + Otherwise, every character is at least one byte. */ + if (BUF_Z (buf) == BUF_Z_BYTE (buf)) + eassert (charpos == bytepos); + else + eassert (charpos <= bytepos); - obj = allocate_misc (Lisp_Misc_Marker); - m = XMARKER (obj); - m->buffer = buf; - m->charpos = charpos; - m->bytepos = bytepos; - m->insertion_type = 0; - m->next = BUF_MARKERS (buf); - BUF_MARKERS (buf) = m; - return obj; + init_marker (XMARKER (marker), buf, charpos, bytepos, 0); + return marker; } /* Put MARKER back on the free list after using it temporarily. */ @@ -5865,6 +5857,17 @@ mark_overlay (buffer->overlays_before); mark_overlay (buffer->overlays_after); + /* If we have currently active excursions, mark + the window objects referenced from them. */ + if (!NILP (BVAR (buffer, excursions))) + { + struct Lisp_Excursion *e; + + for (e = XEXCURSION (BVAR (buffer, excursions)); e; e = e->next) + if (!VECTOR_MARKED_P (e->window)) + mark_vectorlike ((struct Lisp_Vector *) e->window); + } + /* If this is an indirect buffer, mark its base buffer. */ if (buffer->base_buffer && !VECTOR_MARKED_P (buffer->base_buffer)) mark_buffer (buffer->base_buffer); @@ -6058,6 +6061,8 @@ break; case PVEC_FREE: + case PVEC_EXCURSION: + /* These are too special. */ abort (); default: === modified file 'src/buffer.c' --- src/buffer.c 2012-07-25 05:09:02 +0000 +++ src/buffer.c 2012-07-25 07:53:00 +0000 @@ -368,6 +368,7 @@ b->newline_cache = 0; b->width_run_cache = 0; + BVAR (b, excursions) = Qnil; BVAR (b, width_table) = Qnil; b->prevent_redisplay_optimizations_p = 1; @@ -580,6 +581,7 @@ b->newline_cache = 0; b->width_run_cache = 0; + BVAR (b, excursions) = Qnil; BVAR (b, width_table) = Qnil; /* Put this on the chain of all buffers including killed ones. */ @@ -4895,6 +4897,8 @@ reset_buffer (&buffer_local_symbols); reset_buffer_local_variables (&buffer_local_symbols, 1); /* Prevent GC from getting confused. */ + BVAR (&buffer_defaults, excursions) = Qnil; + BVAR (&buffer_local_symbols, excursions) = Qnil; buffer_defaults.text = &buffer_defaults.own_text; buffer_local_symbols.text = &buffer_local_symbols.own_text; /* No one will share the text with these buffers, but let's play it safe. */ === modified file 'src/buffer.h' --- src/buffer.h 2012-07-22 03:44:35 +0000 +++ src/buffer.h 2012-07-25 07:57:08 +0000 @@ -741,8 +741,9 @@ See `cursor-type' for other values. */ Lisp_Object BUFFER_INTERNAL_FIELD (cursor_in_non_selected_windows); - /* No more Lisp_Object beyond this point. Except undo_list, - which is handled specially in Fgarbage_collect . */ + /* No more Lisp_Object beyond this point. Except undo_list and + excursions, which are handled specially in Fgarbage_collect + and mark_buffer, respectively. */ /* This structure holds the coordinates of the buffer contents in ordinary buffers. In indirect buffers, this is not used. */ @@ -856,6 +857,9 @@ /* Position where the overlay lists are centered. */ ptrdiff_t overlay_center; + /* List of excursions which are in effect for this buffer. */ + Lisp_Object BUFFER_INTERNAL_FIELD (excursions); + /* Changes in the buffer are recorded here for undo, and t means don't record anything. This information belongs to the base buffer of an indirect buffer. But we can't store it in the @@ -1023,8 +1027,9 @@ offsetof (struct buffer, BUFFER_INTERNAL_FIELD (VAR)) /* Used to iterate over normal Lisp_Object fields of struct buffer (all - Lisp_Objects except undo_list). If you add, remove, or reorder - Lisp_Objects in a struct buffer, make sure that this is still correct. */ + Lisp_Objects except excursions and undo_list). If you add, remove, or + reorder Lisp_Objects in a struct buffer, make sure that this is still + correct. */ #define FOR_EACH_PER_BUFFER_OBJECT_AT(offset) \ for (offset = PER_BUFFER_VAR_OFFSET (name); \ @@ -1121,3 +1126,22 @@ /* Upcase a character C, or make no change if that cannot be done. */ static inline int upcase (int c) { return uppercasep (c) ? c : upcase1 (c); } + +/* Initialize just allocated Lisp_Marker. */ + +static inline void +init_marker (struct Lisp_Marker *m, struct buffer *b, + ptrdiff_t charpos, ptrdiff_t bytepos, int type) +{ + m->buffer = b; + m->charpos = charpos; + m->bytepos = bytepos; + m->insertion_type = type; + if (b) + { + m->next = BUF_MARKERS (b); + BUF_MARKERS (b) = m; + } + else + m->next = NULL; +} === modified file 'src/editfns.c' --- src/editfns.c 2012-07-17 07:43:01 +0000 +++ src/editfns.c 2012-07-25 08:55:53 +0000 @@ -223,6 +223,19 @@ return build_marker (current_buffer, PT, PT_BYTE); } +/* Fast path to set point at MARK. */ + +static inline void +set_position (struct Lisp_Marker *mark) +{ + if (mark->charpos < BEGV) + SET_PT_BOTH (BEGV, BEGV_BYTE); + else if (mark->charpos > ZV) + SET_PT_BOTH (ZV, ZV_BYTE); + else + SET_PT_BOTH (mark->charpos, mark->bytepos); +} + DEFUN ("goto-char", Fgoto_char, Sgoto_char, 1, 1, "NGoto char: ", doc: /* Set point to POSITION, a number or marker. Beginning of buffer is position (point-min), end is (point-max). @@ -235,14 +248,7 @@ if (MARKERP (position) && current_buffer == XMARKER (position)->buffer) { - pos = marker_position (position); - if (pos < BEGV) - SET_PT_BOTH (BEGV, BEGV_BYTE); - else if (pos > ZV) - SET_PT_BOTH (ZV, ZV_BYTE); - else - SET_PT_BOTH (pos, marker_byte_position (position)); - + set_position (XMARKER (position)); return position; } @@ -821,104 +827,113 @@ Qnil, Qt, Qnil); } - +/* Record buffer state before entering save-excursion. */ + Lisp_Object save_excursion_save (void) { - int visible = (XBUFFER (XWINDOW (selected_window)->buffer) - == current_buffer); - - return Fcons (Fpoint_marker (), - Fcons (Fcopy_marker (BVAR (current_buffer, mark), Qnil), - Fcons (visible ? Qt : Qnil, - Fcons (BVAR (current_buffer, mark_active), - selected_window)))); + struct buffer *b = current_buffer; + struct window *w = XWINDOW (selected_window); + struct Lisp_Excursion *ex = xmalloc (sizeof *ex); + struct Lisp_Marker *m = XMARKER (BVAR (b, mark)); + + ex->size = 0; + ex->window = w; + ex->visible = (XBUFFER (w->buffer) == b); + ex->active = !NILP (BVAR (b, mark_active)); + + /* We do not initialize type and gcmarkbit since this marker + is never referenced via Lisp_Object and invisible for GC. */ + init_marker (&ex->point, b, PT, PT_BYTE, 0); + + /* Likewise. Note that charpos and bytepos may be zero. */ + init_marker (&ex->mark, m->buffer, m->charpos, + m->bytepos, m->insertion_type); + + /* Make it a pseudovector and link to the + chain of currently active excursions. */ + XSETTYPED_PVECTYPE (ex, size, PVEC_EXCURSION); + if (NILP (BVAR (b, excursions))) + { + XSETEXCURSION (BVAR (b, excursions), ex); + ex->next = NULL; + } + else + { + ex->next = XEXCURSION (BVAR (b, excursions)); + XSETEXCURSION (BVAR (b, excursions), ex); + } + return Fcurrent_buffer (); } +/* Restore buffer state before leaving save-excursion. */ + Lisp_Object -save_excursion_restore (Lisp_Object info) +save_excursion_restore (Lisp_Object buffer) { - Lisp_Object tem, tem1, omark, nmark; - struct gcpro gcpro1, gcpro2, gcpro3; - int visible_p; - - tem = Fmarker_buffer (XCAR (info)); - /* If buffer being returned to is now deleted, avoid error */ - /* Otherwise could get error here while unwinding to top level - and crash */ - /* In that case, Fmarker_buffer returns nil now. */ - if (NILP (tem)) - return Qnil; - - omark = nmark = Qnil; - GCPRO3 (info, omark, nmark); - - Fset_buffer (tem); - - /* Point marker. */ - tem = XCAR (info); - Fgoto_char (tem); - unchain_marker (XMARKER (tem)); - - /* Mark marker. */ - info = XCDR (info); - tem = XCAR (info); - omark = Fmarker_position (BVAR (current_buffer, mark)); - Fset_marker (BVAR (current_buffer, mark), tem, Fcurrent_buffer ()); - nmark = Fmarker_position (tem); - unchain_marker (XMARKER (tem)); - - /* visible */ - info = XCDR (info); - visible_p = !NILP (XCAR (info)); - -#if 0 /* We used to make the current buffer visible in the selected window - if that was true previously. That avoids some anomalies. - But it creates others, and it wasn't documented, and it is simpler - and cleaner never to alter the window/buffer connections. */ - tem1 = Fcar (tem); - if (!NILP (tem1) - && current_buffer != XBUFFER (XWINDOW (selected_window)->buffer)) - Fswitch_to_buffer (Fcurrent_buffer (), Qnil); -#endif /* 0 */ - - /* Mark active */ - info = XCDR (info); - tem = XCAR (info); - tem1 = BVAR (current_buffer, mark_active); - BVAR (current_buffer, mark_active) = tem; - - /* If mark is active now, and either was not active - or was at a different place, run the activate hook. */ - if (! NILP (tem)) - { - if (! EQ (omark, nmark)) - { - tem = intern ("activate-mark-hook"); - Frun_hooks (1, &tem); - } - } - /* If mark has ceased to be active, run deactivate hook. */ - else if (! NILP (tem1)) - { - tem = intern ("deactivate-mark-hook"); - Frun_hooks (1, &tem); - } - - /* If buffer was visible in a window, and a different window was - selected, and the old selected window is still showing this - buffer, restore point in that window. */ - tem = XCDR (info); - if (visible_p - && !EQ (tem, selected_window) - && (tem1 = XWINDOW (tem)->buffer, - (/* Window is live... */ - BUFFERP (tem1) - /* ...and it shows the current buffer. */ - && XBUFFER (tem1) == current_buffer))) - Fset_window_point (tem, make_number (PT)); - - UNGCPRO; + struct buffer *b; + struct Lisp_Excursion *ex; + + CHECK_BUFFER (buffer); + b = XBUFFER (buffer); + ex = XEXCURSION (BVAR (b, excursions)); + + /* Restore buffer state only if the buffer is live. + Otherwise, just cancel an excursion state. */ + + if (!NILP (BVAR (b, name))) + { + int active; + struct Lisp_Marker *m; + ptrdiff_t oldmark, newmark; + + /* Restore current buffer. */ + set_buffer_internal (b); + + /* Restore buffer position. */ + set_position (&ex->point); + unchain_marker (&ex->point); + + /* Restore mark if it was non-zero. */ + m = XMARKER (BVAR (b, mark)); + oldmark = m->charpos; + if (BEGV <= ex->mark.charpos) + attach_marker (m, b, ex->mark.charpos, ex->mark.bytepos); + newmark = ex->mark.charpos; + unchain_marker (&ex->mark); + + /* If mark and region was active, restore them. */ + active = !NILP (BVAR (b, mark_active)); + BVAR (b, mark_active) = ex->active ? Qt : Qnil; + + /* If mark is active now, and either was not active + or was at a different place, run the activate hook. */ + if (ex->active && oldmark != newmark) + { + Lisp_Object tem = intern ("activate-mark-hook"); + Frun_hooks (1, &tem); + } + /* If mark has ceased to be active, run deactivate hook. */ + else if (active) + { + Lisp_Object tem = intern ("deactivate-mark-hook"); + Frun_hooks (1, &tem); + } + + /* If buffer was visible in a window, and a different window + was selected, and the old selected window is still showing + this buffer, restore point in that window. */ + if (ex->visible + && ex->window != XWINDOW (selected_window) + && EQ (ex->window->buffer, buffer)) + set_marker_restricted (ex->window->pointm, make_number (PT), buffer); + } + + if (ex->next) + XSETEXCURSION (BVAR (b, excursions), ex->next); + else + BVAR (b, excursions) = Qnil; + xfree (ex); return Qnil; } === modified file 'src/lisp.h' --- src/lisp.h 2012-07-24 06:45:44 +0000 +++ src/lisp.h 2012-07-25 08:53:54 +0000 @@ -352,6 +352,7 @@ PVEC_TERMINAL, PVEC_WINDOW_CONFIGURATION, PVEC_SUBR, + PVEC_EXCURSION, PVEC_OTHER, /* These last 4 are special because we OR them in fns.c:internal_equal, so they have to use a disjoint bit pattern: @@ -507,6 +508,8 @@ (struct terminal *) XUNTAG (a, Lisp_Vectorlike)) #define XSUBR(a) (eassert (SUBRP (a)), \ (struct Lisp_Subr *) XUNTAG (a, Lisp_Vectorlike)) +#define XEXCURSION(a) (eassert (EXCURSIONP (a)), \ + (struct Lisp_Excursion *) XUNTAG (a, Lisp_Vectorlike)) #define XBUFFER(a) (eassert (BUFFERP (a)), \ (struct buffer *) XUNTAG (a, Lisp_Vectorlike)) #define XCHAR_TABLE(a) (eassert (CHAR_TABLE_P (a)), \ @@ -559,9 +562,12 @@ #define XSETPROCESS(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_PROCESS)) #define XSETWINDOW(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_WINDOW)) #define XSETTERMINAL(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_TERMINAL)) -/* XSETSUBR is special since Lisp_Subr lacks struct vectorlike_header. */ +/* These are special because both Lisp_Subr and Lisp_Excursion lacks + struct vectorlike_header. */ #define XSETSUBR(a, b) \ XSETTYPED_PSEUDOVECTOR (a, b, XSUBR (a)->size, PVEC_SUBR) +#define XSETEXCURSION(a, b) \ + XSETTYPED_PSEUDOVECTOR (a, b, XEXCURSION (a)->size, PVEC_EXCURSION) #define XSETCOMPILED(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_COMPILED)) #define XSETBUFFER(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_BUFFER)) #define XSETCHAR_TABLE(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_CHAR_TABLE)) @@ -1478,6 +1484,34 @@ #define XFLOAT_INIT(f,n) (XFLOAT (f)->u.data = (n)) #endif +/* This structure is used to record buffer state for save-excursion. + It's mostly treated as Lisp_Vector but allocated and freed explicitly + with xmalloc and xfree, so there is no vectorlike_header here. */ + +struct Lisp_Excursion +{ + ptrdiff_t size; + + /* Saved value of XWINDOW (selected_window). */ + struct window *window; + + /* Non-zero if the window above has displayed the buffer. */ + unsigned visible : 1; + + /* Non-zero if this buffer has mark active. */ + unsigned active : 1; + + /* Saved point. */ + struct Lisp_Marker point; + + /* Saved mark. May point to nowhere. */ + struct Lisp_Marker mark; + + /* When the calls to save-excursion are nested, this points + to an outer save-excursion state, or NULL otherwise. */ + struct Lisp_Excursion *next; +}; + /* A character, declared with the following typedef, is a member of some character set associated with the current buffer. */ #ifndef _UCHAR_T /* Protect against something in ctab.h on AIX. */ @@ -1660,8 +1694,10 @@ #define PROCESSP(x) PSEUDOVECTORP (x, PVEC_PROCESS) #define WINDOWP(x) PSEUDOVECTORP (x, PVEC_WINDOW) #define TERMINALP(x) PSEUDOVECTORP (x, PVEC_TERMINAL) -/* SUBRP is special since Lisp_Subr lacks struct vectorlike_header. */ +/* These are special because both Lisp_Subr and Lisp_Excursion lacks + struct vectorlike_header. */ #define SUBRP(x) TYPED_PSEUDOVECTORP (x, Lisp_Subr, PVEC_SUBR) +#define EXCURSIONP(x) TYPED_PSEUDOVECTORP (x, Lisp_Excursion, PVEC_EXCURSION) #define COMPILEDP(x) PSEUDOVECTORP (x, PVEC_COMPILED) #define BUFFERP(x) PSEUDOVECTORP (x, PVEC_BUFFER) #define CHAR_TABLE_P(x) PSEUDOVECTORP (x, PVEC_CHAR_TABLE) @@ -2880,7 +2916,9 @@ extern Lisp_Object set_marker_restricted (Lisp_Object, Lisp_Object, Lisp_Object); extern Lisp_Object set_marker_both (Lisp_Object, Lisp_Object, ptrdiff_t, ptrdiff_t); extern Lisp_Object set_marker_restricted_both (Lisp_Object, Lisp_Object, - ptrdiff_t, ptrdiff_t); + ptrdiff_t, ptrdiff_t); +extern void attach_marker (struct Lisp_Marker *, struct buffer *, + ptrdiff_t, ptrdiff_t); extern Lisp_Object build_marker (struct buffer *, ptrdiff_t, ptrdiff_t); extern void syms_of_marker (void); === modified file 'src/marker.c' --- src/marker.c 2012-07-22 05:37:24 +0000 +++ src/marker.c 2012-07-25 07:21:28 +0000 @@ -427,7 +427,7 @@ /* Change M so it points to B at CHARPOS and BYTEPOS. */ -static inline void +void attach_marker (struct Lisp_Marker *m, struct buffer *b, ptrdiff_t charpos, ptrdiff_t bytepos) {