diff options
| author | Gregory Heytings | 2022-08-21 19:33:46 +0000 |
|---|---|---|
| committer | Gregory Heytings | 2022-08-21 21:35:42 +0200 |
| commit | 01efdbd33664d45818f0686589d38e2bfad0ab69 (patch) | |
| tree | 9d498557427bb05b389f2939096af92d2d5d043a | |
| parent | 22375315f1471b8a89b203215295f6ea21072ec6 (diff) | |
| download | emacs-01efdbd33664d45818f0686589d38e2bfad0ab69.tar.gz emacs-01efdbd33664d45818f0686589d38e2bfad0ab69.zip | |
Better way to protect redisplay routines from locked narrowings.
* src/xdisp.c (reset_outermost_narrowing,
unwind_reset_outermost_narrowing): New functions.
(redisplay_internal): Use the new functions.
* src/editfns.c (Fnarrow_to_region): Use the limits of the
locked restriction instead of the position arguments if necessary.
Update docstring.
(Fnarrowing_lock): Update docstring.
| -rw-r--r-- | src/editfns.c | 36 | ||||
| -rw-r--r-- | src/xdisp.c | 35 |
2 files changed, 59 insertions, 12 deletions
diff --git a/src/editfns.c b/src/editfns.c index f52db223e47..c6727832928 100644 --- a/src/editfns.c +++ b/src/editfns.c | |||
| @@ -2731,7 +2731,9 @@ remain visible. | |||
| 2731 | 2731 | ||
| 2732 | When restrictions have been locked with `narrowing-lock', which see, | 2732 | When restrictions have been locked with `narrowing-lock', which see, |
| 2733 | `narrow-to-region' can be used only within the limits of the | 2733 | `narrow-to-region' can be used only within the limits of the |
| 2734 | restrictions that were current when `narrowing-lock' was called. */) | 2734 | restrictions that were current when `narrowing-lock' was called. If |
| 2735 | the START or END arguments are outside these limits, the corresponding | ||
| 2736 | limit of the locked restriction is used instead of the argument. */) | ||
| 2735 | (Lisp_Object start, Lisp_Object end) | 2737 | (Lisp_Object start, Lisp_Object end) |
| 2736 | { | 2738 | { |
| 2737 | EMACS_INT s = fix_position (start), e = fix_position (end); | 2739 | EMACS_INT s = fix_position (start), e = fix_position (end); |
| @@ -2741,17 +2743,15 @@ restrictions that were current when `narrowing-lock' was called. */) | |||
| 2741 | EMACS_INT tem = s; s = e; e = tem; | 2743 | EMACS_INT tem = s; s = e; e = tem; |
| 2742 | } | 2744 | } |
| 2743 | 2745 | ||
| 2744 | if (NILP (Vnarrowing_locks)) | 2746 | if (!(BEG <= s && s <= e && e <= Z)) |
| 2745 | { | 2747 | args_out_of_range (start, end); |
| 2746 | if (!(BEG <= s && s <= e && e <= Z)) | 2748 | |
| 2747 | args_out_of_range (start, end); | 2749 | if (! NILP (Vnarrowing_locks)) |
| 2748 | } | ||
| 2749 | else | ||
| 2750 | { | 2750 | { |
| 2751 | ptrdiff_t begv = XFIXNUM (Fcar (Fcdr (Fcar (Vnarrowing_locks)))); | 2751 | ptrdiff_t begv = XFIXNUM (Fcar (Fcdr (Fcar (Vnarrowing_locks)))); |
| 2752 | ptrdiff_t zv = XFIXNUM (Fcdr (Fcdr (Fcar (Vnarrowing_locks)))); | 2752 | ptrdiff_t zv = XFIXNUM (Fcdr (Fcdr (Fcar (Vnarrowing_locks)))); |
| 2753 | if (!(begv <= s && s <= e && e <= zv)) | 2753 | if (s < begv) s = begv; |
| 2754 | args_out_of_range (start, end); | 2754 | if (e > zv) e = zv; |
| 2755 | } | 2755 | } |
| 2756 | 2756 | ||
| 2757 | Fset (Qoutermost_narrowing, | 2757 | Fset (Qoutermost_narrowing, |
| @@ -2774,12 +2774,24 @@ restrictions that were current when `narrowing-lock' was called. */) | |||
| 2774 | return Qnil; | 2774 | return Qnil; |
| 2775 | } | 2775 | } |
| 2776 | 2776 | ||
| 2777 | DEFUN ("narrowing-lock", Fnarrowing_lock, Snarrowing_lock, 1, 1, "", | 2777 | DEFUN ("narrowing-lock", Fnarrowing_lock, Snarrowing_lock, 1, 1, 0, |
| 2778 | doc: /* Lock the current narrowing with TAG. | 2778 | doc: /* Lock the current narrowing with TAG. |
| 2779 | 2779 | ||
| 2780 | When restrictions are locked, `narrow-to-region' and `widen' can be | 2780 | When restrictions are locked, `narrow-to-region' and `widen' can be |
| 2781 | used only within the limits of the restrictions that were current when | 2781 | used only within the limits of the restrictions that were current when |
| 2782 | `narrowing-lock' was called. */) | 2782 | `narrowing-lock' was called, unless the lock is removed with |
| 2783 | \(narrowing-unlock TAG). | ||
| 2784 | |||
| 2785 | Locking restrictions should be used sparingly, after carefully | ||
| 2786 | considering the potential adverse effects on the code that will be | ||
| 2787 | executed with locked restrictions. It is meant to be used around | ||
| 2788 | portions of code that would become too slow, and make Emacs | ||
| 2789 | unresponsive, if they were executed in a large buffer. For example, | ||
| 2790 | restrictions are locked by Emacs around low-level hooks such as | ||
| 2791 | `fontification-functions' or `post-command-hook'. | ||
| 2792 | |||
| 2793 | Locked restrictions are never visible on display, and can therefore | ||
| 2794 | not be used as a stronger variant of normal restrictions. */) | ||
| 2783 | (Lisp_Object tag) | 2795 | (Lisp_Object tag) |
| 2784 | { | 2796 | { |
| 2785 | if (NILP (Vnarrowing_locks)) | 2797 | if (NILP (Vnarrowing_locks)) |
| @@ -2790,7 +2802,7 @@ used only within the limits of the restrictions that were current when | |||
| 2790 | return Qnil; | 2802 | return Qnil; |
| 2791 | } | 2803 | } |
| 2792 | 2804 | ||
| 2793 | DEFUN ("narrowing-unlock", Fnarrowing_unlock, Snarrowing_unlock, 1, 1, "", | 2805 | DEFUN ("narrowing-unlock", Fnarrowing_unlock, Snarrowing_unlock, 1, 1, 0, |
| 2794 | doc: /* Unlock a narrowing locked with (narrowing-lock TAG). | 2806 | doc: /* Unlock a narrowing locked with (narrowing-lock TAG). |
| 2795 | 2807 | ||
| 2796 | Unlocking restrictions locked with `narrowing-lock' should be used | 2808 | Unlocking restrictions locked with `narrowing-lock' should be used |
diff --git a/src/xdisp.c b/src/xdisp.c index 8f63b029c1f..2ee02684dc4 100644 --- a/src/xdisp.c +++ b/src/xdisp.c | |||
| @@ -16363,6 +16363,39 @@ do { if (! polling_stopped_here) stop_polling (); \ | |||
| 16363 | do { if (polling_stopped_here) start_polling (); \ | 16363 | do { if (polling_stopped_here) start_polling (); \ |
| 16364 | polling_stopped_here = false; } while (false) | 16364 | polling_stopped_here = false; } while (false) |
| 16365 | 16365 | ||
| 16366 | static void | ||
| 16367 | unwind_reset_outermost_narrowing (Lisp_Object buf) | ||
| 16368 | { | ||
| 16369 | Lisp_Object innermost_narrowing = | ||
| 16370 | Fcar (buffer_local_value (Qnarrowing_locks, buf)); | ||
| 16371 | if (! NILP (innermost_narrowing)) | ||
| 16372 | { | ||
| 16373 | SET_BUF_BEGV (XBUFFER (buf), | ||
| 16374 | XFIXNUM (Fcar (Fcdr (innermost_narrowing)))); | ||
| 16375 | SET_BUF_ZV (XBUFFER (buf), | ||
| 16376 | XFIXNUM (Fcdr (Fcdr (innermost_narrowing)))); | ||
| 16377 | } | ||
| 16378 | } | ||
| 16379 | |||
| 16380 | static void | ||
| 16381 | reset_outermost_narrowings (void) | ||
| 16382 | { | ||
| 16383 | Lisp_Object tail, buf, outermost_narrowing; | ||
| 16384 | FOR_EACH_LIVE_BUFFER (tail, buf) | ||
| 16385 | { | ||
| 16386 | outermost_narrowing = | ||
| 16387 | Fassq (Qoutermost_narrowing, | ||
| 16388 | buffer_local_value (Qnarrowing_locks, buf)); | ||
| 16389 | if (!NILP (outermost_narrowing)) | ||
| 16390 | { | ||
| 16391 | SET_BUF_BEGV (XBUFFER (buf), | ||
| 16392 | XFIXNUM (Fcar (Fcdr (outermost_narrowing)))); | ||
| 16393 | SET_BUF_ZV (XBUFFER (buf), | ||
| 16394 | XFIXNUM (Fcdr (Fcdr (outermost_narrowing)))); | ||
| 16395 | record_unwind_protect (unwind_reset_outermost_narrowing, buf); | ||
| 16396 | } | ||
| 16397 | } | ||
| 16398 | } | ||
| 16366 | 16399 | ||
| 16367 | /* Perhaps in the future avoid recentering windows if it | 16400 | /* Perhaps in the future avoid recentering windows if it |
| 16368 | is not necessary; currently that causes some problems. */ | 16401 | is not necessary; currently that causes some problems. */ |
| @@ -16449,6 +16482,8 @@ redisplay_internal (void) | |||
| 16449 | FOR_EACH_FRAME (tail, frame) | 16482 | FOR_EACH_FRAME (tail, frame) |
| 16450 | XFRAME (frame)->already_hscrolled_p = false; | 16483 | XFRAME (frame)->already_hscrolled_p = false; |
| 16451 | 16484 | ||
| 16485 | reset_outermost_narrowings (); | ||
| 16486 | |||
| 16452 | retry: | 16487 | retry: |
| 16453 | /* Remember the currently selected window. */ | 16488 | /* Remember the currently selected window. */ |
| 16454 | sw = w; | 16489 | sw = w; |