commit 76bcbe5f930f16014343ae75e92df94c727f30af (HEAD, refs/remotes/origin/master) Merge: 40c0124816 e0f54c62ec Author: Stefan Kangas Date: Sat Jul 30 06:30:23 2022 +0200 Merge from origin/emacs-28 e0f54c62ec CC Mode: fontify variables/functions after line comments e... 2c6a94c5b8 ; Correct the meaning of "cf." in tips.texi commit 40c0124816969985d00cb7edf55859ef2264d332 Author: Po Lu Date: Sat Jul 30 11:26:46 2022 +0800 Minor improvements to precision scroll interpolation * lisp/pixel-scroll.el (pixel-scroll-start-momentum): Bump GC cons threshold temporarily. This leads to a very noticable improvement to animation speed. diff --git a/lisp/pixel-scroll.el b/lisp/pixel-scroll.el index fc7e680c26..aefe3c12dc 100644 --- a/lisp/pixel-scroll.el +++ b/lisp/pixel-scroll.el @@ -759,6 +759,9 @@ It is a vector of the form [ VELOCITY TIME SIGN ]." (interactive "e") (when pixel-scroll-precision-use-momentum (let ((window (mwheel-event-window event)) + ;; The animations are smoother if the GC threshold is + ;; reduced for the duration of the animation. + (gc-cons-threshold (* gc-cons-threshold 3)) (state nil)) (when (framep window) (setq window (frame-selected-window window))) @@ -767,43 +770,43 @@ It is a vector of the form [ VELOCITY TIME SIGN ]." (listp (aref state 0))) (condition-case nil (while-no-input - (unwind-protect (progn - (aset state 0 (pixel-scroll-calculate-velocity state)) - (when (> (abs (aref state 0)) - pixel-scroll-precision-momentum-min-velocity) - (let* ((velocity (aref state 0)) - (original-velocity velocity) - (time-spent 0)) - (if (> velocity 0) - (while (and (> velocity 0) - (<= time-spent - pixel-scroll-precision-momentum-seconds)) - (when (> (round velocity) 0) - (with-selected-window window - (pixel-scroll-precision-scroll-up (round velocity)))) - (setq velocity (- velocity - (/ original-velocity - (/ pixel-scroll-precision-momentum-seconds - pixel-scroll-precision-momentum-tick)))) - (redisplay t) - (sit-for pixel-scroll-precision-momentum-tick) - (setq time-spent (+ time-spent - pixel-scroll-precision-momentum-tick)))) - (while (and (< velocity 0) - (<= time-spent - pixel-scroll-precision-momentum-seconds)) - (when (> (round (abs velocity)) 0) - (with-selected-window window - (pixel-scroll-precision-scroll-down (round - (abs velocity))))) - (setq velocity (+ velocity - (/ (abs original-velocity) - (/ pixel-scroll-precision-momentum-seconds - pixel-scroll-precision-momentum-tick)))) - (redisplay t) - (sit-for pixel-scroll-precision-momentum-tick) - (setq time-spent (+ time-spent - pixel-scroll-precision-momentum-tick)))))) + (unwind-protect + (progn + (aset state 0 (pixel-scroll-calculate-velocity state)) + (when (> (abs (aref state 0)) + pixel-scroll-precision-momentum-min-velocity) + (let* ((velocity (aref state 0)) + (original-velocity velocity) + (time-spent 0)) + (if (> velocity 0) + (while (and (> velocity 0) + (<= time-spent + pixel-scroll-precision-momentum-seconds)) + (when (> (round velocity) 0) + (with-selected-window window + (pixel-scroll-precision-scroll-up (round velocity)))) + (setq velocity (- velocity + (/ original-velocity + (/ pixel-scroll-precision-momentum-seconds + pixel-scroll-precision-momentum-tick)))) + (sit-for pixel-scroll-precision-momentum-tick) + (setq time-spent (+ time-spent + pixel-scroll-precision-momentum-tick)))) + (while (and (< velocity 0) + (<= time-spent + pixel-scroll-precision-momentum-seconds)) + (when (> (round (abs velocity)) 0) + (with-selected-window window + (pixel-scroll-precision-scroll-down (round + (abs velocity))))) + (setq velocity (+ velocity + (/ (abs original-velocity) + (/ pixel-scroll-precision-momentum-seconds + pixel-scroll-precision-momentum-tick)))) + (redisplay t) + (sit-for pixel-scroll-precision-momentum-tick) + (setq time-spent (+ time-spent + pixel-scroll-precision-momentum-tick)))))) (aset state 0 (make-ring 30)) (aset state 1 nil))) (beginning-of-buffer commit a1975a69b24f01c0ab6a039f0e2f6bde6b2bf741 Author: Po Lu Date: Sat Jul 30 10:04:26 2022 +0800 Fix failure caused by misreading the frame synchronization spec * src/xterm.c (x_sync_update_begin): Ensure value % 4 is 1. (x_sync_update_finish): Then, add 3. diff --git a/src/xterm.c b/src/xterm.c index 9f8afa61cf..dc9637d35c 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -6736,7 +6736,7 @@ x_sync_update_begin (struct frame *f) x_sync_wait_for_frame_drawn_event (f); /* Since Emacs needs a non-urgent redraw, ensure that value % 4 == - 0. */ + 1. Later, add 3 to create the even counter value. */ if (XSyncValueLow32 (value) % 4 == 2) XSyncIntToValue (&add, 3); else @@ -6748,7 +6748,7 @@ x_sync_update_begin (struct frame *f) if (overflow) XSyncIntToValue (&FRAME_X_COUNTER_VALUE (f), 3); - eassert (XSyncValueLow32 (FRAME_X_COUNTER_VALUE (f)) % 4 != 1); + eassert (XSyncValueLow32 (FRAME_X_COUNTER_VALUE (f)) % 4 == 1); XSyncSetCounter (FRAME_X_DISPLAY (f), FRAME_X_EXTENDED_COUNTER (f), @@ -6772,7 +6772,15 @@ x_sync_update_finish (struct frame *f) if (!(XSyncValueLow32 (value) % 2)) return; - XSyncIntToValue (&add, 1); + if ((XSyncValueLow32 (value) % 4) == 1) + /* This means the frame is non-urgent and should be drawn at the + next redraw point. */ + XSyncIntToValue (&add, 3); + else + /* Otherwise, the frame is urgent and should be drawn as soon as + possible. */ + XSyncIntToValue (&add, 1); + XSyncValueAdd (&FRAME_X_COUNTER_VALUE (f), value, add, &overflow); commit af152ffab15174838f11075248353ce66ace1635 Author: Po Lu Date: Sat Jul 30 09:40:00 2022 +0800 Don't freeze if the compositing manager crashes * src/xterm.c (x_if_event): New function, like XIfEvent but with a timeout. (x_sync_wait_for_frame_drawn_event): Disable frame synchronization if x_if_event times out after 1 second. diff --git a/src/xterm.c b/src/xterm.c index 60eab0f9b0..9f8afa61cf 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -6597,6 +6597,55 @@ x_set_frame_alpha (struct frame *f) ***********************************************************************/ #if defined HAVE_XSYNC && !defined USE_GTK + +/* Wait for an event matching PREDICATE to show up in the event + queue, or TIMEOUT to elapse. + + If TIMEOUT passes without an event being found, return 1. + Otherwise, return 0 and behave as XIfEvent would. */ + +static int +x_if_event (Display *dpy, XEvent *event_return, + Bool (*predicate) (Display *, XEvent *, XPointer), + XPointer arg, struct timespec timeout) +{ + struct timespec current_time, target; + int fd; + fd_set fds; + + fd = ConnectionNumber (dpy); + current_time = current_timespec (); + target = timespec_add (current_time, timeout); + + while (true) + { + /* Get events into the queue. */ + XSync (dpy, False); + + /* Check if an event is now in the queue. */ + if (XCheckIfEvent (dpy, event_return, predicate, arg)) + return 0; + + /* Calculate the timeout. */ + current_time = current_timespec (); + timeout = timespec_sub (target, current_time); + + /* If not, wait for some input to show up on the X connection, + or for the timeout to elapse. */ + FD_ZERO (&fds); + FD_SET (fd, &fds); + + /* If this fails due to an IO error, XSync will call the IO + error handler. */ + pselect (fd + 1, &fds, NULL, NULL, &timeout, NULL); + + /* Timeout elapsed. */ + current_time = current_timespec (); + if (timespec_cmp (target, current_time) < 0) + return 1; + } +} + static Bool x_sync_is_frame_drawn_event (Display *dpy, XEvent *event, XPointer user_data) @@ -6632,8 +6681,16 @@ x_sync_wait_for_frame_drawn_event (struct frame *f) return; /* Wait for the frame drawn message to arrive. */ - XIfEvent (FRAME_X_DISPLAY (f), &event, - x_sync_is_frame_drawn_event, (XPointer) f); + if (x_if_event (FRAME_X_DISPLAY (f), &event, + x_sync_is_frame_drawn_event, (XPointer) f, + make_timespec (1, 0))) + { + /* TODO: display this warning in the echo area. */ + fprintf (stderr, "Warning: compositing manager spent more than 1 second " + "drawing a frame. Frame synchronization has been disabled\n"); + FRAME_X_OUTPUT (f)->use_vsync_p = false; + } + FRAME_X_WAITING_FOR_DRAW (f) = false; } commit e0f54c62ecb72c41a9afc6d6c3e22b1a0b113f11 Author: Alan Mackenzie Date: Fri Jul 29 20:18:58 2022 +0000 CC Mode: fontify variables/functions after line comments ending in spaces * lisp/progmodes/cc-engine.el (c-forward-comment-minus-1): Take account of spaces preceding a linefeed when scanning a putative line comment end. diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el index 3068c41a57..80ac496749 100644 --- a/lisp/progmodes/cc-engine.el +++ b/lisp/progmodes/cc-engine.el @@ -1668,9 +1668,13 @@ comment at the start of cc-engine.el for more info." Return the result of `forward-comment' if it gets called, nil otherwise." `(if (not comment-end-can-be-escaped) (forward-comment -1) - (when (and (< (skip-syntax-backward " >") 0) - (eq (char-after) ?\n)) - (forward-char)) + (let ((dist (skip-syntax-backward " >"))) + (when (and + (< dist 0) + (progn + (skip-syntax-forward " " (- (point) dist 1)) + (eq (char-after) ?\n))) + (forward-char))) (cond ((and (eq (char-before) ?\n) (eq (char-before (1- (point))) ?\\)) commit 4b5b447b7fab827c00fe97167b5c92c34b2f1ea3 Author: Gregory Heytings Date: Fri Jul 29 19:21:20 2022 +0200 ; * src/xdisp.c (handle_fontified_prop): Fix BOB case. diff --git a/src/xdisp.c b/src/xdisp.c index cdef90b686..b1ee7889d4 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -4415,6 +4415,7 @@ handle_fontified_prop (struct it *it) if (charpos < begv || charpos > zv) { begv = get_narrowed_begv (it->w, charpos); + if (!begv) begv = BEGV; zv = get_narrowed_zv (it->w, charpos); } Fnarrow_to_region (make_fixnum (begv), make_fixnum (zv), Qt); commit 9c12c3b7c59ee102d3a022368ea050fc9e3bb186 Author: Gregory Heytings Date: Fri Jul 29 16:23:16 2022 +0000 Improve narrowing when iterator has moved outside of narrowing bounds. * src/xdisp.c (get_narrowed_begv, get_narrowed_zv): Add 'pos' parameter. (init_iterator): Add arguments to 'get_narrowed_begv' and 'get_narrowed_zv'. (handle_fontified_prop): Recompute the narrowing when iterator has moved outside of narrowing bounds. * src/dispextern.h (get_narrowed_begv, get_narrowed_zv): Adapt prototypes. * src/composite.c (find_automatic_composition): Add argument to 'get_narrowed_begv'. diff --git a/src/composite.c b/src/composite.c index b04d34337b..0f90b92a78 100644 --- a/src/composite.c +++ b/src/composite.c @@ -1599,7 +1599,7 @@ find_automatic_composition (ptrdiff_t pos, ptrdiff_t limit, ptrdiff_t backlim, head = backlim; /* In buffers with very long lines, this function becomes very slow. Pretend that the buffer is narrowed to make it fast. */ - narrowed_begv = get_narrowed_begv (w); + narrowed_begv = get_narrowed_begv (w, window_point (w)); if (narrowed_begv && pos > narrowed_begv) head = narrowed_begv; tail = ZV; diff --git a/src/dispextern.h b/src/dispextern.h index 2772e8cda8..817211e795 100644 --- a/src/dispextern.h +++ b/src/dispextern.h @@ -3404,8 +3404,8 @@ void mark_window_display_accurate (Lisp_Object, bool); void redisplay_preserve_echo_area (int); void init_iterator (struct it *, struct window *, ptrdiff_t, ptrdiff_t, struct glyph_row *, enum face_id); -ptrdiff_t get_narrowed_begv (struct window *); -ptrdiff_t get_narrowed_zv (struct window *); +ptrdiff_t get_narrowed_begv (struct window *, ptrdiff_t); +ptrdiff_t get_narrowed_zv (struct window *, ptrdiff_t); ptrdiff_t get_closer_narrowed_begv (struct window *, ptrdiff_t); void init_iterator_to_row_start (struct it *, struct window *, struct glyph_row *); diff --git a/src/xdisp.c b/src/xdisp.c index 9580e59601..cdef90b686 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -3427,8 +3427,8 @@ init_iterator (struct it *it, struct window *w, if (current_buffer->long_line_optimizations_p) { - it->narrowed_begv = get_narrowed_begv (w); - it->narrowed_zv = get_narrowed_zv (w); + it->narrowed_begv = get_narrowed_begv (w, window_point (w)); + it->narrowed_zv = get_narrowed_zv (w, window_point (w)); } /* If a buffer position was specified, set the iterator there, @@ -3519,19 +3519,19 @@ get_narrowed_len (struct window *w) } ptrdiff_t -get_narrowed_begv (struct window *w) +get_narrowed_begv (struct window *w, ptrdiff_t pos) { int len = get_narrowed_len (w); ptrdiff_t begv; - begv = max ((window_point (w) / len - 1) * len, BEGV); + begv = max ((pos / len - 1) * len, BEGV); return begv == BEGV ? 0 : begv; } ptrdiff_t -get_narrowed_zv (struct window *w) +get_narrowed_zv (struct window *w, ptrdiff_t pos) { int len = get_narrowed_len (w); - return min ((window_point (w) / len + 1) * len, ZV); + return min ((pos / len + 1) * len, ZV); } ptrdiff_t @@ -4408,9 +4408,17 @@ handle_fontified_prop (struct it *it) eassert (it->end_charpos == ZV); if (current_buffer->long_line_optimizations_p) - Fnarrow_to_region (make_fixnum (it->narrowed_begv ? - it->narrowed_begv : BEGV), - make_fixnum (it->narrowed_zv), Qt); + { + ptrdiff_t begv = it->narrowed_begv ? it->narrowed_begv : BEGV; + ptrdiff_t zv = it->narrowed_zv; + ptrdiff_t charpos = IT_CHARPOS (*it); + if (charpos < begv || charpos > zv) + { + begv = get_narrowed_begv (it->w, charpos); + zv = get_narrowed_zv (it->w, charpos); + } + Fnarrow_to_region (make_fixnum (begv), make_fixnum (zv), Qt); + } /* Don't allow Lisp that runs from 'fontification-functions' clear our face and image caches behind our back. */ commit 006f621a89ca327ff0ca0287e14ae9fd432309e1 Author: Philip Kaludercic Date: Fri Jul 29 18:21:54 2022 +0200 ; * buffers.texi (Buffer List): Mention t diff --git a/doc/lispref/buffers.texi b/doc/lispref/buffers.texi index aee440fe78..6a1d125701 100644 --- a/doc/lispref/buffers.texi +++ b/doc/lispref/buffers.texi @@ -994,6 +994,9 @@ Satisfied if the buffer's major mode derives from @var{expr}. Satisfied if the buffer's major mode is equal to @var{expr}. Prefer using @code{derived-mode} instead when both can work. @end table +@item t +Satisfied by any buffer. A convenient alternative to @code{""} (empty +string), @code{(and)} (empty conjunction) or @code{always}. @end itemize @end defun commit 497b2689dad0770cd90ba0410a7a120ad94b6def Author: Philip Kaludercic Date: Fri Jul 29 13:54:47 2022 +0200 * subr.el (buffer-match-p): Add t as trivial a condition diff --git a/lisp/subr.el b/lisp/subr.el index 6b121a314a..9f7cb3ab6a 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -6899,6 +6899,7 @@ lines." (defun buffer-match-p (condition buffer-or-name &optional arg) "Return non-nil if BUFFER-OR-NAME matches CONDITION. CONDITION is either: +- the symbol t, to always match - a regular expression, to match a buffer name, - a predicate function that takes a buffer object and ARG as arguments, and returns non-nil if the buffer matches, @@ -6921,6 +6922,7 @@ CONDITION is either: (catch 'match (dolist (condition conditions) (when (cond + ((eq condition t)) ((stringp condition) (string-match-p condition (buffer-name buffer))) ((functionp condition) commit ebe9cd3e9fbf7817b8bf458a036f5a33a786662d Author: Gregory Heytings Date: Fri Jul 29 15:26:49 2022 +0000 Improvement for long line optimizations. * src/xdisp.c (handle_fontified_prop): Also apply the forced narrowing at BOB. diff --git a/src/xdisp.c b/src/xdisp.c index 8a4cca8434..9580e59601 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -4407,8 +4407,9 @@ handle_fontified_prop (struct it *it) eassert (it->end_charpos == ZV); - if (it->narrowed_begv) - Fnarrow_to_region (make_fixnum (it->narrowed_begv), + if (current_buffer->long_line_optimizations_p) + Fnarrow_to_region (make_fixnum (it->narrowed_begv ? + it->narrowed_begv : BEGV), make_fixnum (it->narrowed_zv), Qt); /* Don't allow Lisp that runs from 'fontification-functions' commit 9ebd0455f344e6806400fef2ee0b410a33b68ad5 Author: Gerd Möllmann Date: Fri Jul 29 17:28:25 2022 +0200 Adapt native compiler to change in narrow-to-region * lisp/emacs-lisp/comp.el (comp-limplify-lap-inst): Add third argument nil for narrow-to-region. diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index 5ee10fcbca..6e9132e430 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -1918,7 +1918,8 @@ and the annotation emission." (byte-narrow-to-region (comp-emit-set-call (comp-call 'narrow-to-region (comp-slot) - (comp-slot+1)))) + (comp-slot+1) + (make-comp-mvar :constant nil)))) (byte-widen (comp-emit-set-call (comp-call 'widen))) (byte-end-of-line auto) commit 9547c285837e80af059f7676e8af856fb55d1c14 Author: Po Lu Date: Fri Jul 29 20:54:30 2022 +0800 Fix handling of extended frame resize synchronization * src/xterm.c (x_sync_wait_for_frame_drawn_event): Don't wait if the frame is invisible. If it is mapped again the compositing manager is obliged to send us another event, so we can wait in that case. (x_sync_update_begin, x_sync_update_finish): Handle extended resize synchronization here. (XTframe_up_to_date, handle_one_xevent): Save stuff here. * src/xterm.h (struct x_output): New field `resize_counter_value'. diff --git a/src/xterm.c b/src/xterm.c index 7399ec3e42..60eab0f9b0 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -6625,7 +6625,10 @@ x_sync_wait_for_frame_drawn_event (struct frame *f) { XEvent event; - if (!FRAME_X_WAITING_FOR_DRAW (f)) + if (!FRAME_X_WAITING_FOR_DRAW (f) + /* The compositing manager can't draw a frame if it is + unmapped. */ + || !FRAME_VISIBLE_P (f)) return; /* Wait for the frame drawn message to arrive. */ @@ -6648,6 +6651,25 @@ x_sync_update_begin (struct frame *f) value = FRAME_X_COUNTER_VALUE (f); + if (FRAME_X_OUTPUT (f)->ext_sync_end_pending_p) + { + FRAME_X_COUNTER_VALUE (f) + = FRAME_X_OUTPUT (f)->resize_counter_value; + + value = FRAME_X_COUNTER_VALUE (f); + + if (XSyncValueLow32 (value) % 2) + { + XSyncIntToValue (&add, 1); + XSyncValueAdd (&value, value, add, &overflow); + + if (overflow) + XSyncIntToValue (&value, 0); + } + + FRAME_X_OUTPUT (f)->ext_sync_end_pending_p = false; + } + /* Since a frame is already in progress, there is no point in continuing. */ if (XSyncValueLow32 (value) % 2) @@ -6688,9 +6710,6 @@ x_sync_update_finish (struct frame *f) if (FRAME_X_EXTENDED_COUNTER (f) == None) return; - if (FRAME_X_OUTPUT (f)->ext_sync_end_pending_p) - return; - value = FRAME_X_COUNTER_VALUE (f); if (!(XSyncValueLow32 (value) % 2)) @@ -6824,11 +6843,12 @@ x_draw_window_divider (struct window *w, int x0, int x1, int y0, int y1) } } +#ifdef HAVE_XDBE + /* Show the frame back buffer. If frame is double-buffered, atomically publish to the user's screen graphics updates made since the last call to show_back_buffer. */ -#ifdef HAVE_XDBE static void show_back_buffer (struct frame *f) { @@ -6870,6 +6890,7 @@ show_back_buffer (struct frame *f) unblock_input (); } + #endif /* Updates back buffer and flushes changes to display. Called from @@ -6927,11 +6948,7 @@ x_update_end (struct frame *f) static void XTframe_up_to_date (struct frame *f) { -#if defined HAVE_XSYNC && !defined HAVE_GTK3 - XSyncValue add; - XSyncValue current; - Bool overflow_p; -#elif defined HAVE_XSYNC +#if defined HAVE_XSYNC && defined HAVE_GTK3 GtkWidget *widget; GdkWindow *window; GdkFrameClock *clock; @@ -6957,34 +6974,6 @@ XTframe_up_to_date (struct frame *f) FRAME_X_OUTPUT (f)->pending_basic_counter_value); FRAME_X_OUTPUT (f)->sync_end_pending_p = false; } - - if (FRAME_X_OUTPUT (f)->ext_sync_end_pending_p - && FRAME_X_EXTENDED_COUNTER (f) != None) - { - current = FRAME_X_COUNTER_VALUE (f); - - if (XSyncValueLow32 (current) % 2) - XSyncIntToValue (&add, 1); - else - XSyncIntToValue (&add, 2); - - XSyncValueAdd (&FRAME_X_COUNTER_VALUE (f), - current, add, &overflow_p); - - if (overflow_p) - emacs_abort (); - - XSyncSetCounter (FRAME_X_DISPLAY (f), - FRAME_X_EXTENDED_COUNTER (f), - FRAME_X_COUNTER_VALUE (f)); - - FRAME_X_OUTPUT (f)->ext_sync_end_pending_p = false; - -#ifndef USE_GTK - if (FRAME_OUTPUT_DATA (f)->use_vsync_p) - FRAME_X_WAITING_FOR_DRAW (f) = true; -#endif - } #else if (FRAME_X_OUTPUT (f)->xg_sync_end_pending_p) { @@ -17023,7 +17012,7 @@ handle_one_xevent (struct x_display_info *dpyinfo, } else if (event->xclient.data.l[4] == 1) { - XSyncIntsToValue (&FRAME_X_COUNTER_VALUE (f), + XSyncIntsToValue (&FRAME_X_OUTPUT (f)->resize_counter_value, event->xclient.data.l[2], event->xclient.data.l[3]); diff --git a/src/xterm.h b/src/xterm.h index 1163dd5cd1..2e3d0950d9 100644 --- a/src/xterm.h +++ b/src/xterm.h @@ -1038,6 +1038,9 @@ struct x_output /* The current value of the extended counter. */ XSyncValue current_extended_counter_value; + /* The configure event value of the extended counter. */ + XSyncValue resize_counter_value; + /* Whether or not basic resize synchronization is in progress. */ bool_bf sync_end_pending_p : 1; commit dedd05d2831d650b07cd9f0c639bdc8eb3bef1e4 Author: Lars Ingebrigtsen Date: Fri Jul 29 13:21:45 2022 +0200 Fix outline byte compilation warning from previous change * lisp/outline.el (outline--use-buttons-p): Move around to fix byte compilation warning. diff --git a/lisp/outline.el b/lisp/outline.el index b7935551db..6ec7d95d3a 100644 --- a/lisp/outline.el +++ b/lisp/outline.el @@ -438,13 +438,6 @@ outline font-lock faces to those of major mode." (outline--insert-open-button))) (goto-char (match-end 0)))))) -(defun outline--use-buttons-p () - (and outline-minor-mode - outline-minor-mode-use-buttons - (or (eq outline-minor-mode-use-buttons t) - (buffer-match-p outline-minor-mode-use-buttons - (current-buffer))))) - ;;;###autoload (define-minor-mode outline-minor-mode "Toggle Outline minor mode. @@ -482,6 +475,13 @@ See the command `outline-mode' for more information on this mode." ;; When turning off outline mode, get rid of any outline hiding. (outline-show-all))) +(defun outline--use-buttons-p () + (and outline-minor-mode + outline-minor-mode-use-buttons + (or (eq outline-minor-mode-use-buttons t) + (buffer-match-p outline-minor-mode-use-buttons + (current-buffer))))) + (defvar-local outline-heading-alist () "Alist associating a heading for every possible level. Each entry is of the form (HEADING . LEVEL). commit 0728764faeb30c7d03106f4e075a839905f2662e Author: Lars Ingebrigtsen Date: Fri Jul 29 13:20:06 2022 +0200 Fix up the outline minor mode button logic * lisp/outline.el (outline-minor-mode-highlight-buffer): Factor out... (bug#56820). (outline--use-buttons-p): ... to here. (outline-hide-subtree, outline--fix-up-all-buttons) (outline-show-subtree): Use it. diff --git a/lisp/outline.el b/lisp/outline.el index dd5df4c896..b7935551db 100644 --- a/lisp/outline.el +++ b/lisp/outline.el @@ -434,13 +434,17 @@ outline font-lock faces to those of major mode." (goto-char (match-beginning 0)) (not (get-text-property (point) 'face)))) (overlay-put overlay 'face (outline-font-lock-face))) - (when (and outline-minor-mode-use-buttons - (or (eq outline-minor-mode-use-buttons t) - (buffer-match-p outline-minor-mode-use-buttons - (current-buffer)))) + (when (outline--use-buttons-p) (outline--insert-open-button))) (goto-char (match-end 0)))))) +(defun outline--use-buttons-p () + (and outline-minor-mode + outline-minor-mode-use-buttons + (or (eq outline-minor-mode-use-buttons t) + (buffer-match-p outline-minor-mode-use-buttons + (current-buffer))))) + ;;;###autoload (define-minor-mode outline-minor-mode "Toggle Outline minor mode. @@ -982,7 +986,7 @@ If non-nil, EVENT should be a mouse event." (interactive (list last-nonmenu-event)) (when (mouse-event-p event) (mouse-set-point event)) - (when (and outline-minor-mode-use-buttons outline-minor-mode) + (when (outline--use-buttons-p) (outline--insert-close-button)) (outline-flag-subtree t)) @@ -1042,7 +1046,7 @@ If non-nil, EVENT should be a mouse event." (save-excursion (goto-char from) (setq from (line-beginning-position)))) - (when outline-minor-mode-use-buttons + (when (outline--use-buttons-p) (outline-map-region (lambda () ;; `outline--cycle-state' will fail if we're in a totally @@ -1073,7 +1077,7 @@ If non-nil, EVENT should be a mouse event." (interactive (list last-nonmenu-event)) (when (mouse-event-p event) (mouse-set-point event)) - (when (and outline-minor-mode-use-buttons outline-minor-mode) + (when (outline--use-buttons-p) (outline--insert-open-button)) (outline-flag-subtree nil)) commit 501eb685be94f36e41e57bf48f3dcbb3bcd8a028 Author: Eli Zaretskii Date: Fri Jul 29 14:12:24 2022 +0300 ; Improve NEWS entries for buttons and icons * etc/NEWS: Improve documentation of 'outline-minor-mode-use-buttons'. diff --git a/etc/NEWS b/etc/NEWS index 6241d5286b..b6f77e3e49 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -851,7 +851,8 @@ or is itself too long. +++ *** New user option 'outline-minor-mode-use-buttons'. If non-nil, Outline Minor Mode will use buttons to hide/show outlines -in addition to the ellipsis. The default is nil. +in addition to the ellipsis. The default is nil in editing modes, but +non-nil in 'special-mode' and its derivatives. +++ ** Support for the WebP image format. @@ -1339,7 +1340,11 @@ characters instead of just 'SPC' and 'TAB'. --- ** New mode, 'emacs-news-mode', for editing the NEWS file. This mode adds some highlighting, fixes the 'M-q' command, and has -commands for doing maintenance. +commands for doing maintenance of the Emacs NEWS files. In addition, +this mode turns on 'outline-minor-mode', and thus displays +customizable icons (see 'icon-preference') on heading lines. To +disable these icons, customize 'outline-minor-mode-use-buttons' to a +nil value. --- ** Kmacro commit 3756a13c30f056d9c822c381c5866b89d16f64ad Author: Eli Zaretskii Date: Fri Jul 29 13:59:15 2022 +0300 ; * doc/emacs/display.texi (Icons): Improve indexing and wording. diff --git a/doc/emacs/display.texi b/doc/emacs/display.texi index b87ca81fae..b7c8825efa 100644 --- a/doc/emacs/display.texi +++ b/doc/emacs/display.texi @@ -854,9 +854,10 @@ would be selected if you click a mouse or press @key{RET}. @node Icons @section Icons +@cindex icons, on clickable buttons Emacs sometimes displays clickable buttons (or other informative -icons), and the look of these can be customized by the user. +icons), and you can customize how these look on display. @vindex icon-preference The main customization point here is the @code{icon-preference} user commit 01ca1c70aec1db6cbd971a419ca20d89bb7a0099 Author: Eli Zaretskii Date: Fri Jul 29 13:20:38 2022 +0300 ; Minor copyedits of documentation related to long-line handling * src/xdisp.c (syms_of_xdisp) : * etc/NEWS: Fix documentation related to long lines. (Bug#56682) diff --git a/etc/NEWS b/etc/NEWS index cd2897cd6d..6241d5286b 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -355,19 +355,19 @@ option) and can be set to nil to disable Just-in-time Lock mode. * Changes in Emacs 29.1 --- -** Emacs is now capable of editing files with arbitrarily long lines. -The display of long lines has been optimized, and Emacs no longer -chokes when a buffer on display contains long lines. The variable -'long-line-threshold' controls whether and when these display +** Emacs is now capable of editing files with very long lines. +The display of long lines has been optimized, and Emacs should no +longer choke when a buffer on display contains long lines. The +variable 'long-line-threshold' controls whether and when these display optimizations are in effect. If you still experience slowdowns while editing files with long lines, -this is due to line truncation, or to one of the enabled minor modes, -or to the current major mode. Try turning off line truncation with -'C-x x t', or try disabling all known slow minor modes with 'M-x -so-long-minor-mode', or try disabling all known slow minor modes and -the major mode with 'M-x so-long-mode', or visit the file with 'M-x -find-file-literally' instead of the usual 'C-x C-f'. +this may be due to line truncation, or to one of the enabled minor +modes, or to the current major mode. Try turning off line truncation +with 'C-x x t', or try disabling all known slow minor modes with +'M-x so-long-minor-mode', or try disabling both known slow minor modes +and the major mode with 'M-x so-long-mode', or visit the file with +'M-x find-file-literally' instead of the usual 'C-x C-f'. Note that the display optimizations in these cases may cause the buffer to be occasionally mis-fontified. diff --git a/src/xdisp.c b/src/xdisp.c index 2c889586cd..8a4cca8434 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -36660,10 +36660,10 @@ fontify a region starting at POS in the current buffer, and give fontified regions the property `fontified' with a non-nil value. Note that, when the buffer contains one or more lines whose length is -above `long-line-threshold', these functions only have access to a -small portion of the buffer around POS, and cannot use `widen' to gain -access to other portions of buffer text because the narrowing of the -buffer is locked (see `narrow-to-region'). */); +above `long-line-threshold', these functions are called with the buffer +narrowed to a small portion around POS, and the narrowing is locked (see +`narrow-to-region'), so that these functions cannot use `widen' to gain +access to other portions of buffer text. */); Vfontification_functions = Qnil; Fmake_variable_buffer_local (Qfontification_functions); commit 02b180e955ab0923b5fe2b8f362f1fedb092f760 Author: Po Lu Date: Fri Jul 29 17:23:52 2022 +0800 ; * src/xterm.c (x_update_begin): Fix build without DBE. diff --git a/src/xterm.c b/src/xterm.c index 4d4febcc36..7399ec3e42 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -6736,7 +6736,9 @@ x_update_begin (struct frame *f) #if defined HAVE_XSYNC && !defined USE_GTK /* If F is double-buffered, we can make the entire frame center around XdbeSwapBuffers. */ +#ifdef HAVE_XDBE if (!FRAME_X_DOUBLE_BUFFERED_P (f)) +#endif x_sync_update_begin (f); #else /* Nothing to do. */ commit acefbcf8351180b4eff46b30491ce758dcc42feb Author: Po Lu Date: Fri Jul 29 17:14:05 2022 +0800 Minor additions to last change * doc/emacs/xresources.texi (Table of Resources): Update description of `extended'. * etc/NEWS: Announce frame tearing reduction. * src/xterm.c (x_sync_update_finish, x_sync_update_begin) (x_update_begin, x_update_end, show_back_buffer, x_flip_and_flush) (XTframe_up_to_date, handle_one_xevent): Minor redesign of frame synchronization feature. Fix crash with overflow and checking. diff --git a/doc/emacs/xresources.texi b/doc/emacs/xresources.texi index 8915d2025b..ab0df3563f 100644 --- a/doc/emacs/xresources.texi +++ b/doc/emacs/xresources.texi @@ -382,7 +382,9 @@ which prevents blank areas of a frame that have not yet been painted from being displayed. If set to @samp{extended}, it will enable use of an alternative frame synchronization protocol, which might be supported by some compositing window managers that don't support the -protocol Emacs uses by default. +protocol Emacs uses by default, and causes Emacs to synchronize +display with the monitor refresh rate when a compatible compositing +window manager is in use. @item @code{verticalScrollBars} (class @code{ScrollBars}) Give frames scroll bars on the left if @samp{left}, on the right if diff --git a/etc/NEWS b/etc/NEWS index 43f057a407..cd2897cd6d 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -598,13 +598,22 @@ Only in the Lucid build, this controls colors used for highlighted menu item widgets. +++ -** On X11, Emacs now tries to synchronize window resize with the window manager. +** On X, Emacs now tries to synchronize window resize with the window manager. This leads to less flicker and empty areas of a frame being displayed when a frame is being resized. Unfortunately, it does not work on some ancient buggy window managers, so if Emacs appears to freeze, but is still responsive to input, you can turn it off by setting the X resource "synchronizeResize" to "off". ++++ +** On X, Emacs can optionally synchronize display with the graphics hardware. +When this is enabled by setting the X resource "synchronizeResize" to +"extended", frame content "tearing" is drastically reduced. This is +only supported on the Motif, Lucid, and no-toolkit builds, and +requires an X compositing manager supporting the extended frame +synchronization protocol (see +https://fishsoup.net/misc/wm-spec-synchronization.html). + +++ ** New frame parameter 'alpha-background' and X resource "alphaBackground". This controls the opacity of the text background when running on a diff --git a/src/xterm.c b/src/xterm.c index d3ffd432dd..4d4febcc36 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -6653,14 +6653,8 @@ x_sync_update_begin (struct frame *f) if (XSyncValueLow32 (value) % 2) return; - /* Wait for a pending frame draw event if the last frame has not yet - been drawn if F isn't double buffered. (In double buffered - frames, this happens before buffer flipping). */ - -#ifdef HAVE_XDBE - if (!FRAME_X_DOUBLE_BUFFERED_P (f)) -#endif - x_sync_wait_for_frame_drawn_event (f); + /* Wait for the last frame to be drawn before drawing this one. */ + x_sync_wait_for_frame_drawn_event (f); /* Since Emacs needs a non-urgent redraw, ensure that value % 4 == 0. */ @@ -6672,11 +6666,10 @@ x_sync_update_begin (struct frame *f) XSyncValueAdd (&FRAME_X_COUNTER_VALUE (f), value, add, &overflow); - if (XSyncValueLow32 (FRAME_X_COUNTER_VALUE (f)) % 4 != 1) - emacs_abort (); - if (overflow) - XSyncIntToValue (&FRAME_X_COUNTER_VALUE (f), 1); + XSyncIntToValue (&FRAME_X_COUNTER_VALUE (f), 3); + + eassert (XSyncValueLow32 (FRAME_X_COUNTER_VALUE (f)) % 4 != 1); XSyncSetCounter (FRAME_X_DISPLAY (f), FRAME_X_EXTENDED_COUNTER (f), @@ -6741,7 +6734,10 @@ static void x_update_begin (struct frame *f) { #if defined HAVE_XSYNC && !defined USE_GTK - x_sync_update_begin (f); + /* If F is double-buffered, we can make the entire frame center + around XdbeSwapBuffers. */ + if (!FRAME_X_DOUBLE_BUFFERED_P (f)) + x_sync_update_begin (f); #else /* Nothing to do. */ #endif @@ -6847,6 +6843,9 @@ show_back_buffer (struct frame *f) /* Wait for drawing of the previous frame to complete before displaying this new frame. */ x_sync_wait_for_frame_drawn_event (f); + + /* Begin a new frame. */ + x_sync_update_begin (f); #endif #ifdef USE_CAIRO @@ -6858,7 +6857,13 @@ show_back_buffer (struct frame *f) swap_info.swap_window = FRAME_X_WINDOW (f); swap_info.swap_action = XdbeCopied; XdbeSwapBuffers (FRAME_X_DISPLAY (f), &swap_info, 1); + +#if defined HAVE_XSYNC && !defined USE_GTK + /* Finish the frame here. */ + x_sync_update_finish (f); +#endif } + FRAME_X_NEED_BUFFER_FLIP (f) = false; unblock_input (); @@ -6883,10 +6888,7 @@ x_flip_and_flush (struct frame *f) block_input (); #ifdef HAVE_XDBE if (FRAME_X_NEED_BUFFER_FLIP (f)) - { - show_back_buffer (f); - x_sync_update_finish (f); - } + show_back_buffer (f); #endif x_flush (f); unblock_input (); @@ -6941,11 +6943,6 @@ XTframe_up_to_date (struct frame *f) if (!buffer_flipping_blocked_p () && FRAME_X_NEED_BUFFER_FLIP (f)) show_back_buffer (f); - -#if defined HAVE_XSYNC && !defined USE_GTK - if (FRAME_X_DOUBLE_BUFFERED_P (f)) - x_sync_update_finish (f); -#endif #endif #ifdef HAVE_XSYNC @@ -17027,6 +17024,7 @@ handle_one_xevent (struct x_display_info *dpyinfo, XSyncIntsToValue (&FRAME_X_COUNTER_VALUE (f), event->xclient.data.l[2], event->xclient.data.l[3]); + FRAME_X_OUTPUT (f)->ext_sync_end_pending_p = true; } commit ee93a06b8b1922b31e12cfe60566779f185ddeba Author: Po Lu Date: Fri Jul 29 16:20:32 2022 +0800 Implement monitor refresh rate synchronization on X * src/xfns.c (x_set_parent_frame, Fx_create_frame): Disable vsync on child and embedded frames. * src/xmenu.c (x_menu_show): Fix XMenu position calculation in child frames. * src/xterm.c (x_sync_is_frame_drawn_event) (x_sync_wait_for_frame_drawn_event): New functions. (x_sync_update_begin): Wait for frame to be drawn if not double buffered. (x_sync_update_finish): Set FRAME_X_WAITING_FOR_DRAW (f). (show_back_buffer): Wait for frame to be drawn before flipping buffers. (XTframe_up_to_date): Set FRAME_X_WAITING_FOR_DRAW if bumped. (handle_one_xevent): Handle frame drawn events. * src/xterm.h (struct x_output): New fields for frame dirtyness and vsync. diff --git a/src/xfns.c b/src/xfns.c index 076cd97875..579237068a 100644 --- a/src/xfns.c +++ b/src/xfns.c @@ -976,6 +976,16 @@ x_set_parent_frame (struct frame *f, Lisp_Object new_value, Lisp_Object old_valu gdk_x11_window_set_frame_sync_enabled (window, FALSE); } #endif + +#if defined HAVE_XSYNC && !defined USE_GTK + /* Frame synchronization can't be used in child frames since + they are not directly managed by the compositing manager. + Re-enabling vsync in former child frames also leads to + inconsistent display. In addition, they can only be updated + outside of a toplevel frame. */ + FRAME_X_OUTPUT (f)->use_vsync_p = false; + FRAME_X_WAITING_FOR_DRAW (f) = false; +#endif unblock_input (); fset_parent_frame (f, new_value); @@ -5113,7 +5123,10 @@ This function is an internal primitive--use `make-frame' instead. */) } #ifdef HAVE_XSYNC - if (dpyinfo->xsync_supported_p) + if (dpyinfo->xsync_supported_p + /* Frame synchronization isn't supported in child frames. */ + && NILP (parent_frame) + && !f->output_data.x->explicit_parent) { #ifndef HAVE_GTK3 XSyncValue initial_value; @@ -5149,6 +5162,12 @@ This function is an internal primitive--use `make-frame' instead. */) ((STRINGP (value) && !strcmp (SSDATA (value), "extended")) ? 2 : 1)); #endif + +#ifndef USE_GTK + if (FRAME_X_EXTENDED_COUNTER (f)) + FRAME_X_OUTPUT (f)->use_vsync_p + = x_wm_supports (f, dpyinfo->Xatom_net_wm_frame_drawn); +#endif } #endif diff --git a/src/xmenu.c b/src/xmenu.c index e5e24b87d1..3be0fb1876 100644 --- a/src/xmenu.c +++ b/src/xmenu.c @@ -2536,6 +2536,9 @@ Lisp_Object x_menu_show (struct frame *f, int x, int y, int menuflags, Lisp_Object title, const char **error_name) { +#ifdef HAVE_X_WINDOWS + Window dummy_window; +#endif Window root; XMenu *menu; int pane, selidx, lpane, status; @@ -2584,20 +2587,22 @@ x_menu_show (struct frame *f, int x, int y, int menuflags, inhibit_garbage_collection (); #ifdef HAVE_X_WINDOWS - { - /* Adjust coordinates to relative to the outer (window manager) window. */ - int left_off, top_off; + XTranslateCoordinates (FRAME_X_DISPLAY (f), - x_real_pos_and_offsets (f, &left_off, NULL, &top_off, NULL, - NULL, NULL, NULL, NULL, NULL); + /* From-window, to-window. */ + FRAME_X_WINDOW (f), + FRAME_DISPLAY_INFO (f)->root_window, - x += left_off; - y += top_off; - } -#endif /* HAVE_X_WINDOWS */ + /* From-position, to-position. */ + x, y, &x, &y, + /* Child of win. */ + &dummy_window); +#else + /* MSDOS without X support. */ x += f->left_pos; y += f->top_pos; +#endif /* Create all the necessary panes and their items. */ maxwidth = maxlines = lines = i = 0; diff --git a/src/xterm.c b/src/xterm.c index e9db4b364f..d3ffd432dd 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -6597,6 +6597,43 @@ x_set_frame_alpha (struct frame *f) ***********************************************************************/ #if defined HAVE_XSYNC && !defined USE_GTK +static Bool +x_sync_is_frame_drawn_event (Display *dpy, XEvent *event, + XPointer user_data) +{ + struct frame *f; + struct x_display_info *dpyinfo; + + f = (struct frame *) user_data; + dpyinfo = FRAME_DISPLAY_INFO (f); + + if (event->type == ClientMessage + && (event->xclient.message_type + == dpyinfo->Xatom_net_wm_frame_drawn) + && event->xclient.window == FRAME_OUTER_WINDOW (f)) + return True; + + return False; +} + +/* Wait for the compositing manager to finish drawing the last frame. + If the compositing manager has already drawn everything, do + nothing. */ + +static void +x_sync_wait_for_frame_drawn_event (struct frame *f) +{ + XEvent event; + + if (!FRAME_X_WAITING_FOR_DRAW (f)) + return; + + /* Wait for the frame drawn message to arrive. */ + XIfEvent (FRAME_X_DISPLAY (f), &event, + x_sync_is_frame_drawn_event, (XPointer) f); + FRAME_X_WAITING_FOR_DRAW (f) = false; +} + /* Tell the compositing manager to postpone updates of F until a frame has finished drawing. */ @@ -6616,6 +6653,15 @@ x_sync_update_begin (struct frame *f) if (XSyncValueLow32 (value) % 2) return; + /* Wait for a pending frame draw event if the last frame has not yet + been drawn if F isn't double buffered. (In double buffered + frames, this happens before buffer flipping). */ + +#ifdef HAVE_XDBE + if (!FRAME_X_DOUBLE_BUFFERED_P (f)) +#endif + x_sync_wait_for_frame_drawn_event (f); + /* Since Emacs needs a non-urgent redraw, ensure that value % 4 == 0. */ if (XSyncValueLow32 (value) % 4 == 2) @@ -6668,7 +6714,20 @@ x_sync_update_finish (struct frame *f) FRAME_X_EXTENDED_COUNTER (f), FRAME_X_COUNTER_VALUE (f)); - /* TODO: implement sync fences. */ + /* FIXME: this leads to freezes if the compositing manager crashes + in the meantime. */ + if (FRAME_OUTPUT_DATA (f)->use_vsync_p) + FRAME_X_WAITING_FOR_DRAW (f) = true; +} + +/* Handle a _NET_WM_FRAME_DRAWN message from the compositor. */ + +static void +x_sync_handle_frame_drawn (struct x_display_info *dpyinfo, + XEvent *message, struct frame *f) +{ + if (FRAME_OUTER_WINDOW (f) == message->xclient.window) + FRAME_X_WAITING_FOR_DRAW (f) = false; } #endif @@ -6775,16 +6834,26 @@ x_draw_window_divider (struct window *w, int x0, int x1, int y0, int y1) static void show_back_buffer (struct frame *f) { + XdbeSwapInfo swap_info; +#ifdef USE_CAIRO + cairo_t *cr; +#endif + block_input (); if (FRAME_X_DOUBLE_BUFFERED_P (f)) { +#if defined HAVE_XSYNC && !defined USE_GTK + /* Wait for drawing of the previous frame to complete before + displaying this new frame. */ + x_sync_wait_for_frame_drawn_event (f); +#endif + #ifdef USE_CAIRO - cairo_t *cr = FRAME_CR_CONTEXT (f); + cr = FRAME_CR_CONTEXT (f); if (cr) cairo_surface_flush (cairo_get_target (cr)); #endif - XdbeSwapInfo swap_info; memset (&swap_info, 0, sizeof (swap_info)); swap_info.swap_window = FRAME_X_WINDOW (f); swap_info.swap_action = XdbeCopied; @@ -6911,6 +6980,11 @@ XTframe_up_to_date (struct frame *f) FRAME_X_COUNTER_VALUE (f)); FRAME_X_OUTPUT (f)->ext_sync_end_pending_p = false; + +#ifndef USE_GTK + if (FRAME_OUTPUT_DATA (f)->use_vsync_p) + FRAME_X_WAITING_FOR_DRAW (f) = true; +#endif } #else if (FRAME_X_OUTPUT (f)->xg_sync_end_pending_p) @@ -17072,8 +17146,17 @@ handle_one_xevent (struct x_display_info *dpyinfo, #if defined HAVE_XSYNC && !defined USE_GTK /* These messages are sent by the compositing manager after a frame is drawn under extended synchronization. */ - if (event->xclient.message_type == dpyinfo->Xatom_net_wm_frame_drawn - || event->xclient.message_type == dpyinfo->Xatom_net_wm_frame_timings) + if (event->xclient.message_type + == dpyinfo->Xatom_net_wm_frame_drawn) + { + if (any) + x_sync_handle_frame_drawn (dpyinfo, (XEvent *) event, any); + + goto done; + } + + if (event->xclient.message_type + == dpyinfo->Xatom_net_wm_frame_timings) goto done; #endif diff --git a/src/xterm.h b/src/xterm.h index 3e237158e7..1163dd5cd1 100644 --- a/src/xterm.h +++ b/src/xterm.h @@ -1026,16 +1026,39 @@ struct x_output #endif #ifdef HAVE_XSYNC + /* The "basic frame counter" used for resize synchronization. */ XSyncCounter basic_frame_counter; + + /* The "extended frame counter" used for frame synchronization. */ XSyncCounter extended_frame_counter; + + /* The pending value of the basic counter. */ XSyncValue pending_basic_counter_value; + + /* The current value of the extended counter. */ XSyncValue current_extended_counter_value; + /* Whether or not basic resize synchronization is in progress. */ bool_bf sync_end_pending_p : 1; + + /* Whether or not extended resize synchronization is in + progress. */ bool_bf ext_sync_end_pending_p : 1; + #ifdef HAVE_GTK3 + /* Whether or not GDK resize synchronization is in progress. */ bool_bf xg_sync_end_pending_p : 1; #endif + + /* Whether or Emacs is waiting for the compositing manager to draw a + frame. */ + bool_bf waiting_for_frame_p : 1; + +#ifndef USE_GTK + /* Whether or not Emacs should wait for the compositing manager to + draw frames before starting a new frame. */ + bool_bf use_vsync_p : 1; +#endif #endif /* Relief GCs, colors etc. */ @@ -1215,6 +1238,8 @@ extern void x_mark_frame_dirty (struct frame *f); FRAME_X_OUTPUT (f)->basic_frame_counter #define FRAME_X_EXTENDED_COUNTER(f) \ FRAME_X_OUTPUT (f)->extended_frame_counter +#define FRAME_X_WAITING_FOR_DRAW(f) \ + FRAME_X_OUTPUT (f)->waiting_for_frame_p #define FRAME_X_COUNTER_VALUE(f) \ FRAME_X_OUTPUT (f)->current_extended_counter_value #endif commit db03eda6369a9d4af3c72a8ab6ec29e3cc58acc4 Merge: 77882158b2 cdaa3b51f1 Author: Gregory Heytings Date: Fri Jul 29 10:22:03 2022 +0200 Merge branch 'feature/long-lines-and-font-locking' commit cdaa3b51f1500ca1d91452037efe68fa0f7808bc (refs/remotes/origin/feature/long-lines-and-font-locking) Author: Gregory Heytings Date: Fri Jul 29 08:11:10 2022 +0000 Further minor improvements of documentation * src/xdisp.c (syms_of_xdisp) : * etc/NEWS: Further minor wording improvements. diff --git a/etc/NEWS b/etc/NEWS index 2259c0e766..2d1ca8e98d 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -334,18 +334,19 @@ Use something like 'M-x shell RET ssh RET' instead. * Changes in Emacs 29.1 --- -** Emacs is now capable of editing files with very long lines. -The display of long lines has been optimized, and Emacs should no -longer choke when a buffer on display contains long lines. The -variable 'long-line-threshold' controls whether and when these display +** Emacs is now capable of editing files with arbitrarily long lines. +The display of long lines has been optimized, and Emacs no longer +chokes when a buffer on display contains long lines. The variable +'long-line-threshold' controls whether and when these display optimizations are in effect. If you still experience slowdowns while editing files with long lines, -this is due either to the current major mode or to one of the enabled -minor modes. Try disabling the minor modes, or turn on 'so-long-mode' -or 'so-long-minor-mode', or visit the file with find-file-literally' -instead of the usual 'C-x C-f'. Another reason for slowdown could be -line truncation, which you can turn off with 'C-x x t'. +this is due to line truncation, or to one of the enabled minor modes, +or to the current major mode. Try turning off line truncation with +'C-x x t', or try disabling all known slow minor modes with 'M-x +so-long-minor-mode', or try disabling all known slow minor modes and +the major mode with 'M-x so-long-mode', or visit the file with 'M-x +find-file-literally' instead of the usual 'C-x C-f'. Note that the display optimizations in these cases may cause the buffer to be occasionally mis-fontified. diff --git a/src/xdisp.c b/src/xdisp.c index 3ef3c0d379..e13d68eab9 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -36656,10 +36656,10 @@ fontify a region starting at POS in the current buffer, and give fontified regions the property `fontified' with a non-nil value. Note that, when the buffer contains one or more lines whose length is -above `long-line-threshold', the narrowing of the buffer is locked -(see `narrow-to-region'), and these functions only have access to a -small portion of the buffer around POS and cannot use `widen' to gain -access to other portions of buffer text. */); +above `long-line-threshold', these functions only have access to a +small portion of the buffer around POS, and cannot use `widen' to gain +access to other portions of buffer text because the narrowing of the +buffer is locked (see `narrow-to-region'). */); Vfontification_functions = Qnil; Fmake_variable_buffer_local (Qfontification_functions); commit 2c6a94c5b8df86c04479dd725dcfbb86ef8e6c2b Author: Štěpán Němec Date: Fri Jul 29 09:37:50 2022 +0200 ; Correct the meaning of "cf." in tips.texi Cf. e.g. https://en.wiktionary.org/wiki/cf. * doc/lispref/tips.texi (Documentation Tips): Correct the meaning of "cf.". diff --git a/doc/lispref/tips.texi b/doc/lispref/tips.texi index a3f49c19bc..eddbbfe8b9 100644 --- a/doc/lispref/tips.texi +++ b/doc/lispref/tips.texi @@ -845,7 +845,7 @@ find an alternate phrasing that conveys the meaning. @item Try to avoid using abbreviations such as ``e.g.'' (for ``for example''), ``i.e.'' (for ``that is''), ``no.'' (for ``number''), -``cf.'' (for ``in contrast to'') and ``w.r.t.'' (for ``with respect +``cf.'' (for ``compare''/``see also'') and ``w.r.t.'' (for ``with respect to'') as much as possible. It is almost always clearer and easier to read the expanded version.@footnote{We do use these occasionally, but try not to overdo it.} commit c6029ed34ea83c7c0adbd723d63bd78ff0ec0796 Author: Eli Zaretskii Date: Fri Jul 29 10:08:50 2022 +0300 Minor improvements of recent documentation changes * src/editfns.c (Fwiden): * doc/lispref/display.texi (Auto Faces): * src/xdisp.c (syms_of_xdisp) : * etc/NEWS: Clarify and improve wording of documentation changes. diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi index 08bf7441df..f5fb0aaee7 100644 --- a/doc/lispref/display.texi +++ b/doc/lispref/display.texi @@ -3479,6 +3479,12 @@ function finishes are the ones that really matter. For efficiency, we recommend writing these functions so that they usually assign faces to around 400 to 600 characters at each call. + +When the buffer text includes very long lines, these functions are +called with the buffer narrowed to a relatively small region around +@var{pos}, and with narrowing locked, so the functions cannot use +@code{widen} to gain access to the rest of the buffer. +@xref{Narrowing}. @end defvar @node Basic Faces diff --git a/etc/NEWS b/etc/NEWS index 8d958c66cd..2259c0e766 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -334,16 +334,21 @@ Use something like 'M-x shell RET ssh RET' instead. * Changes in Emacs 29.1 --- -** Emacs is now capable of editing files with arbitrarily long lines. -The display of long lines has been optimized, and Emacs no longer -chokes when a buffer on display contains long lines. If you still -experience slowdowns while editing files with long lines, this is due -either to the current major mode or one of the enabled minor modes, in -which case you should open the the file with M-x find-file-literally -instead of C-x C-f, or to truncation of long lines, which you can -disable with C-x x t. The buffer may also be occasionally -mis-fontified. The variable 'long-line-threshold' controls whether -and when these display optimizations are used. +** Emacs is now capable of editing files with very long lines. +The display of long lines has been optimized, and Emacs should no +longer choke when a buffer on display contains long lines. The +variable 'long-line-threshold' controls whether and when these display +optimizations are in effect. + +If you still experience slowdowns while editing files with long lines, +this is due either to the current major mode or to one of the enabled +minor modes. Try disabling the minor modes, or turn on 'so-long-mode' +or 'so-long-minor-mode', or visit the file with find-file-literally' +instead of the usual 'C-x C-f'. Another reason for slowdown could be +line truncation, which you can turn off with 'C-x x t'. + +Note that the display optimizations in these cases may cause the +buffer to be occasionally mis-fontified. +++ ** New command to change the font size globally. @@ -2458,10 +2463,10 @@ be saved. +++ ** New argument LOCK of 'narrow-to-region'. -When 'narrow-to-region' is called from Lisp with the optional third -argument LOCK non-nil, calls to 'widen', or to 'narrow-to-region' with -an optional argument LOCK nil, do not produce any effect until the end -of the current body form. +If 'narrow-to-region' is called from Lisp with the new optional +argument LOCK non-nil, then calls to 'widen' and calls to +'narrow-to-region' with the optional argument LOCK nil or omitted do +not produce any effect until the end of the current body form. ** Themes diff --git a/src/editfns.c b/src/editfns.c index 40e65dda0c..d15d4dc68b 100644 --- a/src/editfns.c +++ b/src/editfns.c @@ -2661,8 +2661,8 @@ DEFUN ("widen", Fwiden, Swiden, 0, 0, "", This allows the buffer's full text to be seen and edited. When called from Lisp inside a body form in which `narrow-to-region' -was called with an optional argument LOCK non-nil, this does not -produce any effect. */) +was called with an optional argument LOCK non-nil, this function does +not produce any effect. */) (void) { if (! NILP (Vrestrictions_locked)) diff --git a/src/xdisp.c b/src/xdisp.c index 8867406c4e..3ef3c0d379 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -36653,12 +36653,13 @@ The tool bar style must also show labels for this to have any effect, see doc: /* List of functions to call to fontify regions of text. Each function is called with one argument POS. Functions must fontify a region starting at POS in the current buffer, and give -fontified regions the property `fontified'. +fontified regions the property `fontified' with a non-nil value. Note that, when the buffer contains one or more lines whose length is -above `long-line-threshold', the restrictions of the buffer are locked +above `long-line-threshold', the narrowing of the buffer is locked (see `narrow-to-region'), and these functions only have access to a -small portion of the buffer around POS. */); +small portion of the buffer around POS and cannot use `widen' to gain +access to other portions of buffer text. */); Vfontification_functions = Qnil; Fmake_variable_buffer_local (Qfontification_functions); commit 77882158b2aeff7f235c409d6572173ae4c3a38f Author: Po Lu Date: Fri Jul 29 14:52:31 2022 +0800 Also update after buffer flip caused by flush_frame * src/xterm.c (x_flip_and_flush): Mark the end of a sync frame. diff --git a/src/xterm.c b/src/xterm.c index acdac92d94..e9db4b364f 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -6814,7 +6814,10 @@ x_flip_and_flush (struct frame *f) block_input (); #ifdef HAVE_XDBE if (FRAME_X_NEED_BUFFER_FLIP (f)) - show_back_buffer (f); + { + show_back_buffer (f); + x_sync_update_finish (f); + } #endif x_flush (f); unblock_input (); commit ddd9a7e56ceb8745de0931123991e2e8a3a9aa3e Author: Eli Zaretskii Date: Fri Jul 29 09:31:26 2022 +0300 ; Fix wording of some doc strings in selection.el * lisp/select.el (xselect-dnd-target-available-p) (xselect-dt-netfile-available-p, xselect-uri-list-available-p): Doc fixes. diff --git a/lisp/select.el b/lisp/select.el index a2c396a7ff..019be9cb23 100644 --- a/lisp/select.el +++ b/lisp/select.el @@ -829,7 +829,8 @@ This function returns the string \"emacs\"." (concat value [0])))) (defun xselect-uri-list-available-p (selection _type value) - "Return whether or not `text/uri-list' is a valid target for SELECTION. + "Return non-nil if `text/uri-list' is a valid target for SELECTION. +Return nil otherwise. VALUE is the local selection value of SELECTION." (and (eq selection 'XdndSelection) (or (stringp value) @@ -839,7 +840,8 @@ VALUE is the local selection value of SELECTION." "") (defun xselect-dt-netfile-available-p (selection _type value) - "Return whether or not `_DT_NETFILE' is a valid target for SELECTION. + "Return non-nil if `_DT_NETFILE' is a valid target for SELECTION. +Return nil otherwise. VALUE is SELECTION's local selection value." (and (eq selection 'XdndSelection) (stringp value) @@ -847,7 +849,8 @@ VALUE is SELECTION's local selection value." (not (file-remote-p value)))) (defun xselect-dnd-target-available-p (selection _type _value) - "Return whether or not TYPE is a valid target for SELECTION. + "Return non-nil if TYPE is a valid target for SELECTION. +Return nil otherwise. VALUE is SELECTION's local selection value." (eq selection 'XdndSelection)) commit 1cdc64cdda59fd6ff84e0fd6da9b61c5451cb9e5 Author: Po Lu Date: Fri Jul 29 10:13:54 2022 +0800 Implement extended frame synchronization * src/xterm.c (x_atom_refs): New atom _NET_WM_FRAME_TIMINGS. (x_sync_update_finish, x_sync_update_begin): New frame. (x_update_begin, x_update_end, XTframe_up_to_date): Begin and end frames accordingly if extended frame synchronization is enabled. (handle_one_xevent): Ignore timing and frame drawn events. * src/xterm.h (struct x_display_info): New atom. (FRAME_X_COUNTER_VALUE): New macro. diff --git a/src/xterm.c b/src/xterm.c index e7222d35b3..acdac92d94 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -998,6 +998,7 @@ static const struct x_atom_ref x_atom_refs[] = ATOM_REFS_INIT ("_NET_WM_SYNC_REQUEST", Xatom_net_wm_sync_request) ATOM_REFS_INIT ("_NET_WM_SYNC_REQUEST_COUNTER", Xatom_net_wm_sync_request_counter) ATOM_REFS_INIT ("_NET_WM_FRAME_DRAWN", Xatom_net_wm_frame_drawn) + ATOM_REFS_INIT ("_NET_WM_FRAME_TIMINGS", Xatom_net_wm_frame_timings) ATOM_REFS_INIT ("_NET_WM_USER_TIME", Xatom_net_wm_user_time) ATOM_REFS_INIT ("_NET_WM_USER_TIME_WINDOW", Xatom_net_wm_user_time_window) ATOM_REFS_INIT ("_NET_CLIENT_LIST_STACKING", Xatom_net_client_list_stacking) @@ -6595,6 +6596,82 @@ x_set_frame_alpha (struct frame *f) Starting and ending an update ***********************************************************************/ +#if defined HAVE_XSYNC && !defined USE_GTK +/* Tell the compositing manager to postpone updates of F until a frame + has finished drawing. */ + +static void +x_sync_update_begin (struct frame *f) +{ + XSyncValue value, add; + Bool overflow; + + if (FRAME_X_EXTENDED_COUNTER (f) == None) + return; + + value = FRAME_X_COUNTER_VALUE (f); + + /* Since a frame is already in progress, there is no point in + continuing. */ + if (XSyncValueLow32 (value) % 2) + return; + + /* Since Emacs needs a non-urgent redraw, ensure that value % 4 == + 0. */ + if (XSyncValueLow32 (value) % 4 == 2) + XSyncIntToValue (&add, 3); + else + XSyncIntToValue (&add, 1); + + XSyncValueAdd (&FRAME_X_COUNTER_VALUE (f), + value, add, &overflow); + + if (XSyncValueLow32 (FRAME_X_COUNTER_VALUE (f)) % 4 != 1) + emacs_abort (); + + if (overflow) + XSyncIntToValue (&FRAME_X_COUNTER_VALUE (f), 1); + + XSyncSetCounter (FRAME_X_DISPLAY (f), + FRAME_X_EXTENDED_COUNTER (f), + FRAME_X_COUNTER_VALUE (f)); +} + +/* Tell the compositing manager that FRAME has been drawn and can be + updated. */ + +static void +x_sync_update_finish (struct frame *f) +{ + XSyncValue value, add; + Bool overflow; + + if (FRAME_X_EXTENDED_COUNTER (f) == None) + return; + + if (FRAME_X_OUTPUT (f)->ext_sync_end_pending_p) + return; + + value = FRAME_X_COUNTER_VALUE (f); + + if (!(XSyncValueLow32 (value) % 2)) + return; + + XSyncIntToValue (&add, 1); + XSyncValueAdd (&FRAME_X_COUNTER_VALUE (f), + value, add, &overflow); + + if (overflow) + XSyncIntToValue (&FRAME_X_COUNTER_VALUE (f), 0); + + XSyncSetCounter (FRAME_X_DISPLAY (f), + FRAME_X_EXTENDED_COUNTER (f), + FRAME_X_COUNTER_VALUE (f)); + + /* TODO: implement sync fences. */ +} +#endif + /* Start an update of frame F. This function is installed as a hook for update_begin, i.e. it is called when update_begin is called. This function is called prior to calls to gui_update_window_begin for @@ -6604,7 +6681,11 @@ x_set_frame_alpha (struct frame *f) static void x_update_begin (struct frame *f) { +#if defined HAVE_XSYNC && !defined USE_GTK + x_sync_update_begin (f); +#else /* Nothing to do. */ +#endif } /* Draw a vertical window border from (x,y0) to (x,y1) */ @@ -6750,17 +6831,17 @@ x_update_end (struct frame *f) #ifdef USE_CAIRO if (!FRAME_X_DOUBLE_BUFFERED_P (f) && FRAME_CR_CONTEXT (f)) - { - block_input (); - cairo_surface_flush (cairo_get_target (FRAME_CR_CONTEXT (f))); - unblock_input (); - } + cairo_surface_flush (cairo_get_target (FRAME_CR_CONTEXT (f))); #endif -#ifndef XFlush - block_input (); - XFlush (FRAME_X_DISPLAY (f)); - unblock_input (); + /* If double buffering is disabled, finish the update here. + Otherwise, finish the update when the back buffer is next + displayed. */ +#if defined HAVE_XSYNC && !defined USE_GTK +#ifdef HAVE_XDBE + if (!FRAME_X_DOUBLE_BUFFERED_P (f)) +#endif + x_sync_update_finish (f); #endif } @@ -6788,6 +6869,11 @@ XTframe_up_to_date (struct frame *f) if (!buffer_flipping_blocked_p () && FRAME_X_NEED_BUFFER_FLIP (f)) show_back_buffer (f); + +#if defined HAVE_XSYNC && !defined USE_GTK + if (FRAME_X_DOUBLE_BUFFERED_P (f)) + x_sync_update_finish (f); +#endif #endif #ifdef HAVE_XSYNC @@ -6804,14 +6890,14 @@ XTframe_up_to_date (struct frame *f) if (FRAME_X_OUTPUT (f)->ext_sync_end_pending_p && FRAME_X_EXTENDED_COUNTER (f) != None) { - current = FRAME_X_OUTPUT (f)->current_extended_counter_value; + current = FRAME_X_COUNTER_VALUE (f); if (XSyncValueLow32 (current) % 2) XSyncIntToValue (&add, 1); else XSyncIntToValue (&add, 2); - XSyncValueAdd (&FRAME_X_OUTPUT (f)->current_extended_counter_value, + XSyncValueAdd (&FRAME_X_COUNTER_VALUE (f), current, add, &overflow_p); if (overflow_p) @@ -6819,7 +6905,7 @@ XTframe_up_to_date (struct frame *f) XSyncSetCounter (FRAME_X_DISPLAY (f), FRAME_X_EXTENDED_COUNTER (f), - FRAME_X_OUTPUT (f)->current_extended_counter_value); + FRAME_X_COUNTER_VALUE (f)); FRAME_X_OUTPUT (f)->ext_sync_end_pending_p = false; } @@ -16861,8 +16947,9 @@ handle_one_xevent (struct x_display_info *dpyinfo, } else if (event->xclient.data.l[4] == 1) { - XSyncIntsToValue (&FRAME_X_OUTPUT (f)->current_extended_counter_value, - event->xclient.data.l[2], event->xclient.data.l[3]); + XSyncIntsToValue (&FRAME_X_COUNTER_VALUE (f), + event->xclient.data.l[2], + event->xclient.data.l[3]); FRAME_X_OUTPUT (f)->ext_sync_end_pending_p = true; } @@ -16979,6 +17066,14 @@ handle_one_xevent (struct x_display_info *dpyinfo, goto done; } +#if defined HAVE_XSYNC && !defined USE_GTK + /* These messages are sent by the compositing manager after a + frame is drawn under extended synchronization. */ + if (event->xclient.message_type == dpyinfo->Xatom_net_wm_frame_drawn + || event->xclient.message_type == dpyinfo->Xatom_net_wm_frame_timings) + goto done; +#endif + xft_settings_event (dpyinfo, event); f = any; diff --git a/src/xterm.h b/src/xterm.h index b9e7b094e3..3e237158e7 100644 --- a/src/xterm.h +++ b/src/xterm.h @@ -614,7 +614,7 @@ struct x_display_info Xatom_net_wm_state_shaded, Xatom_net_frame_extents, Xatom_net_current_desktop, Xatom_net_workarea, Xatom_net_wm_opaque_region, Xatom_net_wm_ping, Xatom_net_wm_sync_request, Xatom_net_wm_sync_request_counter, - Xatom_net_wm_frame_drawn, Xatom_net_wm_user_time, + Xatom_net_wm_frame_drawn, Xatom_net_wm_frame_timings, Xatom_net_wm_user_time, Xatom_net_wm_user_time_window, Xatom_net_client_list_stacking, Xatom_net_wm_pid; @@ -1211,8 +1211,12 @@ extern void x_mark_frame_dirty (struct frame *f); #endif #ifdef HAVE_XSYNC -#define FRAME_X_BASIC_COUNTER(f) FRAME_X_OUTPUT (f)->basic_frame_counter -#define FRAME_X_EXTENDED_COUNTER(f) FRAME_X_OUTPUT (f)->extended_frame_counter +#define FRAME_X_BASIC_COUNTER(f) \ + FRAME_X_OUTPUT (f)->basic_frame_counter +#define FRAME_X_EXTENDED_COUNTER(f) \ + FRAME_X_OUTPUT (f)->extended_frame_counter +#define FRAME_X_COUNTER_VALUE(f) \ + FRAME_X_OUTPUT (f)->current_extended_counter_value #endif /* This is the Colormap which frame F uses. */ commit f2465b6b2ff64fe81612b5a02c16a98942c5ca57 Author: Po Lu Date: Fri Jul 29 08:50:55 2022 +0800 Don't offer meaningless selection targets during drag-and-drop * lisp/select.el (xselect-dnd-target-available-p): New function. (selection-converter-alist): Register it as the availability function for DND specific targets. diff --git a/lisp/select.el b/lisp/select.el index 2d501f207f..a2c396a7ff 100644 --- a/lisp/select.el +++ b/lisp/select.el @@ -846,6 +846,11 @@ VALUE is SELECTION's local selection value." (file-exists-p value) (not (file-remote-p value)))) +(defun xselect-dnd-target-available-p (selection _type _value) + "Return whether or not TYPE is a valid target for SELECTION. +VALUE is SELECTION's local selection value." + (eq selection 'XdndSelection)) + (defun xselect-tt-net-file (file) "Get the canonical ToolTalk filename for FILE. FILE must be a local file, or otherwise the conversion will fail. @@ -890,7 +895,8 @@ VALUE should be SELECTION's local value." (text/plain\;charset=utf-8 . xselect-convert-to-string) (text/uri-list . (xselect-uri-list-available-p . xselect-convert-to-text-uri-list)) - (text/x-xdnd-username . xselect-convert-to-username) + (text/x-xdnd-username . (xselect-dnd-target-available-p + . xselect-convert-to-username)) (FILE . (xselect-uri-list-available-p . xselect-convert-to-xm-file)) (TARGETS . xselect-convert-to-targets) @@ -909,8 +915,10 @@ VALUE should be SELECTION's local value." (INTEGER . xselect-convert-to-integer) (SAVE_TARGETS . xselect-convert-to-save-targets) (_EMACS_INTERNAL . xselect-convert-to-identity) - (XmTRANSFER_SUCCESS . xselect-convert-xm-special) - (XmTRANSFER_FAILURE . xselect-convert-xm-special) + (XmTRANSFER_SUCCESS . (xselect-dnd-target-available-p + . xselect-convert-xm-special)) + (XmTRANSFER_FAILURE . (xselect-dnd-target-available-p + . xselect-convert-xm-special)) (_DT_NETFILE . (xselect-dt-netfile-available-p . xselect-convert-to-dt-netfile)))) commit 67a218d33926931b20096edce3eaba2958283bde Author: Gregory Heytings Date: Thu Jul 28 21:12:05 2022 +0000 Final documentation tweaks. * etc/NEWS: Update the NEWS entry. * src/xdisp.c (syms_of_xdisp): Mention the fact that restrictions may be locked around 'fontification-functions'. diff --git a/etc/NEWS b/etc/NEWS index ec6f6c7168..8d958c66cd 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -337,13 +337,13 @@ Use something like 'M-x shell RET ssh RET' instead. ** Emacs is now capable of editing files with arbitrarily long lines. The display of long lines has been optimized, and Emacs no longer chokes when a buffer on display contains long lines. If you still -experience slowdowns while editing files with long lines, this is -either due to font locking, which you can turn off with M-x -font-lock-mode or C-u C-x x f, or to the current major mode or one of -the enabled minor modes, in which case you should open the the file -with M-x find-file-literally instead of C-x C-f. The variable -'long-line-threshold' controls whether and when these display -optimizations are used. +experience slowdowns while editing files with long lines, this is due +either to the current major mode or one of the enabled minor modes, in +which case you should open the the file with M-x find-file-literally +instead of C-x C-f, or to truncation of long lines, which you can +disable with C-x x t. The buffer may also be occasionally +mis-fontified. The variable 'long-line-threshold' controls whether +and when these display optimizations are used. +++ ** New command to change the font size globally. diff --git a/src/xdisp.c b/src/xdisp.c index d91a7ac65b..8867406c4e 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -36653,7 +36653,12 @@ The tool bar style must also show labels for this to have any effect, see doc: /* List of functions to call to fontify regions of text. Each function is called with one argument POS. Functions must fontify a region starting at POS in the current buffer, and give -fontified regions the property `fontified'. */); +fontified regions the property `fontified'. + +Note that, when the buffer contains one or more lines whose length is +above `long-line-threshold', the restrictions of the buffer are locked +(see `narrow-to-region'), and these functions only have access to a +small portion of the buffer around POS. */); Vfontification_functions = Qnil; Fmake_variable_buffer_local (Qfontification_functions); commit d3c4833d1350e26a2ae35e00eaf2d6bef1724679 Author: Gregory Heytings Date: Thu Jul 28 20:37:49 2022 +0000 Add an optional 'lock' parameter to 'narrow-to-region' * src/editfns.c (Fnarrow_to_region): Add the parameter to the function, and handle it. Update docstring. (unwind_locked_begv, unwind_locked_zv): New functions. (Fwiden): Do nothing when restrictions are locked. Update docstring. (syms_of_editfns): Replace the 'inhibit-widen' symbol and variable with a 'restrictions-locked' symbol and variable. Update docstring. * src/xdisp.c (handle_fontified_prop): Use Fnarrow_to_region with the new parameter. (unwind_narrowed_zv): Remove function. * src/process.c (Finternal_default_process_filter): Add a third argument to Fnarrow_to_region. * src/lread.c (readevalloop): Add a third argument to Fnarrow_to_region. * src/bytecode.c (exec_byte_code): Add a third argument to Fnarrow_to_region. * etc/NEWS (like): Mention the new parameter of 'narrow-to-region'. * doc/lispref/positions.texi (Narrowing): Document it. diff --git a/doc/lispref/positions.texi b/doc/lispref/positions.texi index ca1166caac..3a9a152f8d 100644 --- a/doc/lispref/positions.texi +++ b/doc/lispref/positions.texi @@ -995,13 +995,18 @@ the entire buffer regardless of any narrowing. types of text, consider using an alternative facility described in @ref{Swapping Text}. -@deffn Command narrow-to-region start end +@deffn Command narrow-to-region start end &optional lock This function sets the accessible portion of the current buffer to start at @var{start} and end at @var{end}. Both arguments should be character positions. In an interactive call, @var{start} and @var{end} are set to the bounds of the current region (point and the mark, with the smallest first). + +When @var{lock} is non-@code{nil}, calls to @code{widen}, or to +@code{narrow-to-region} with an optional argument @var{lock} +@code{nil}, do not produce any effect until the end of the current +body form. @end deffn @deffn Command narrow-to-page &optional move-count @@ -1027,6 +1032,10 @@ It is equivalent to the following expression: @end example @end deffn +However, when @code{widen} is called inside a body form in which +@code{narrow-to-region} was called with an optional argument +@code{lock} non-@code{nil}, it does not produce any effect. + @defun buffer-narrowed-p This function returns non-@code{nil} if the buffer is narrowed, and @code{nil} otherwise. diff --git a/etc/NEWS b/etc/NEWS index 9de106c26f..ec6f6c7168 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2456,6 +2456,13 @@ abbrevs. This has been generalized via the 'save-some-buffers-functions', and packages can now register things to be saved. ++++ +** New argument LOCK of 'narrow-to-region'. +When 'narrow-to-region' is called from Lisp with the optional third +argument LOCK non-nil, calls to 'widen', or to 'narrow-to-region' with +an optional argument LOCK nil, do not produce any effect until the end +of the current body form. + ** Themes --- diff --git a/src/bytecode.c b/src/bytecode.c index d75767bb0c..241cbaf04f 100644 --- a/src/bytecode.c +++ b/src/bytecode.c @@ -1481,7 +1481,7 @@ exec_byte_code (Lisp_Object fun, ptrdiff_t args_template, CASE (Bnarrow_to_region): { Lisp_Object v1 = POP; - TOP = Fnarrow_to_region (TOP, v1); + TOP = Fnarrow_to_region (TOP, v1, Qnil); NEXT; } diff --git a/src/editfns.c b/src/editfns.c index 6dec2d468c..40e65dda0c 100644 --- a/src/editfns.c +++ b/src/editfns.c @@ -2658,10 +2658,14 @@ DEFUN ("delete-and-extract-region", Fdelete_and_extract_region, DEFUN ("widen", Fwiden, Swiden, 0, 0, "", doc: /* Remove restrictions (narrowing) from current buffer. -This allows the buffer's full text to be seen and edited. */) +This allows the buffer's full text to be seen and edited. + +When called from Lisp inside a body form in which `narrow-to-region' +was called with an optional argument LOCK non-nil, this does not +produce any effect. */) (void) { - if (!NILP (Vinhibit_widen)) + if (! NILP (Vrestrictions_locked)) return Qnil; if (BEG != BEGV || Z != ZV) current_buffer->clip_changed = 1; @@ -2673,7 +2677,19 @@ This allows the buffer's full text to be seen and edited. */) return Qnil; } -DEFUN ("narrow-to-region", Fnarrow_to_region, Snarrow_to_region, 2, 2, "r", +static void +unwind_locked_begv (Lisp_Object point_min) +{ + SET_BUF_BEGV (current_buffer, XFIXNUM (point_min)); +} + +static void +unwind_locked_zv (Lisp_Object point_max) +{ + SET_BUF_ZV (current_buffer, XFIXNUM (point_max)); +} + +DEFUN ("narrow-to-region", Fnarrow_to_region, Snarrow_to_region, 2, 3, "r", doc: /* Restrict editing in this buffer to the current region. The rest of the text becomes temporarily invisible and untouchable but is not deleted; if you save the buffer in a file, the invisible @@ -2682,8 +2698,13 @@ See also `save-restriction'. When calling from Lisp, pass two arguments START and END: positions (integers or markers) bounding the text that should -remain visible. */) - (Lisp_Object start, Lisp_Object end) +remain visible. + +When called from Lisp with the optional argument LOCK non-nil, +calls to `widen', or to `narrow-to-region' with an optional +argument LOCK nil, do not produce any effect until the end of +the current body form. */) + (Lisp_Object start, Lisp_Object end, Lisp_Object lock) { EMACS_INT s = fix_position (start), e = fix_position (end); @@ -2692,14 +2713,37 @@ remain visible. */) EMACS_INT tem = s; s = e; e = tem; } - if (!(BEG <= s && s <= e && e <= Z)) - args_out_of_range (start, end); + if (! NILP (lock)) + { + if (!(BEGV <= s && s <= e && e <= ZV)) + args_out_of_range (start, end); - if (BEGV != s || ZV != e) - current_buffer->clip_changed = 1; + if (BEGV != s || ZV != e) + current_buffer->clip_changed = 1; + + record_unwind_protect (unwind_locked_begv, Fpoint_min ()); + record_unwind_protect (unwind_locked_zv, Fpoint_max ()); + + SET_BUF_BEGV (current_buffer, s); + SET_BUF_ZV (current_buffer, e); + + specbind (Qrestrictions_locked, Qt); + } + else + { + if (! NILP (Vrestrictions_locked)) + return Qnil; + + if (!(BEG <= s && s <= e && e <= Z)) + args_out_of_range (start, end); + + if (BEGV != s || ZV != e) + current_buffer->clip_changed = 1; + + SET_BUF_BEGV (current_buffer, s); + SET_BUF_ZV (current_buffer, e); + } - SET_BUF_BEGV (current_buffer, s); - SET_BUF_ZV (current_buffer, e); if (PT < s) SET_PT (s); if (e < PT) @@ -4459,7 +4503,6 @@ syms_of_editfns (void) DEFSYM (Qbuffer_access_fontify_functions, "buffer-access-fontify-functions"); DEFSYM (Qwall, "wall"); DEFSYM (Qpropertize, "propertize"); - DEFSYM (Qinhibit_widen, "inhibit-widen"); DEFVAR_LISP ("inhibit-field-text-motion", Vinhibit_field_text_motion, doc: /* Non-nil means text motion commands don't notice fields. */); @@ -4520,14 +4563,14 @@ This variable is experimental; email 32252@debbugs.gnu.org if you need it to be non-nil. */); binary_as_unsigned = false; - DEFVAR_LISP ("inhibit-widen", Vinhibit_widen, - doc: /* Non-nil inhibits the `widen' function. + DEFSYM (Qrestrictions_locked, "restrictions-locked"); + DEFVAR_LISP ("restrictions-locked", Vrestrictions_locked, + doc: /* If non-nil, restrictions are currently locked. -Do NOT set this globally to a non-nil value, as doing that will -disable the `widen' function everywhere, including the \\[widen\] -command. This variable is intended to be let-bound around code -that needs to disable `widen' temporarily. */); - Vinhibit_widen = Qnil; +This happens when `narrow-to-region', which see, is called from Lisp +with an optional argument LOCK non-nil. */); + Vrestrictions_locked = Qnil; + Funintern (Qrestrictions_locked, Qnil); defsubr (&Spropertize); defsubr (&Schar_equal); diff --git a/src/lread.c b/src/lread.c index 0b46a2e4ee..0720774db2 100644 --- a/src/lread.c +++ b/src/lread.c @@ -2261,7 +2261,7 @@ readevalloop (Lisp_Object readcharfun, /* Set point and ZV around stuff to be read. */ Fgoto_char (start); if (!NILP (end)) - Fnarrow_to_region (make_fixnum (BEGV), end); + Fnarrow_to_region (make_fixnum (BEGV), end, Qnil); /* Just for cleanliness, convert END to a marker if it is an integer. */ diff --git a/src/process.c b/src/process.c index d6d51b26e1..444265a1bc 100644 --- a/src/process.c +++ b/src/process.c @@ -6329,7 +6329,7 @@ Otherwise it discards the output. */) /* If the restriction isn't what it should be, set it. */ if (old_begv != BEGV || old_zv != ZV) - Fnarrow_to_region (make_fixnum (old_begv), make_fixnum (old_zv)); + Fnarrow_to_region (make_fixnum (old_begv), make_fixnum (old_zv), Qnil); bset_read_only (current_buffer, old_read_only); SET_PT_BOTH (opoint, opoint_byte); diff --git a/src/xdisp.c b/src/xdisp.c index 6237d5a022..d91a7ac65b 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -3547,12 +3547,6 @@ unwind_narrowed_begv (Lisp_Object point_min) SET_BUF_BEGV (current_buffer, XFIXNUM (point_min)); } -static void -unwind_narrowed_zv (Lisp_Object point_max) -{ - SET_BUF_ZV (current_buffer, XFIXNUM (point_max)); -} - /* Set DST to EXPR. When IT indicates that BEGV should temporarily be updated to optimize display, evaluate EXPR with BEGV set to BV. */ @@ -4414,13 +4408,8 @@ handle_fontified_prop (struct it *it) eassert (it->end_charpos == ZV); if (it->narrowed_begv) - { - record_unwind_protect (unwind_narrowed_begv, Fpoint_min ()); - record_unwind_protect (unwind_narrowed_zv, Fpoint_max ()); - SET_BUF_BEGV (current_buffer, it->narrowed_begv); - SET_BUF_ZV (current_buffer, it->narrowed_zv); - specbind (Qinhibit_widen, Qt); - } + Fnarrow_to_region (make_fixnum (it->narrowed_begv), + make_fixnum (it->narrowed_zv), Qt); /* Don't allow Lisp that runs from 'fontification-functions' clear our face and image caches behind our back. */ commit 3f05698dfb5edfce050c7402ea400b61ad808ce4 Author: Juri Linkov Date: Thu Jul 28 22:49:09 2022 +0300 * lisp/tab-bar.el (tab-prefix-map): Fix key broken by conversion. diff --git a/lisp/tab-bar.el b/lisp/tab-bar.el index 1a3f35891e..cf5ae09a24 100644 --- a/lisp/tab-bar.el +++ b/lisp/tab-bar.el @@ -2411,7 +2411,7 @@ When `switch-to-buffer-obey-display-actions' is non-nil, (keymap-set tab-prefix-map "M" #'tab-move-to) (keymap-set tab-prefix-map "G" #'tab-group) (keymap-set tab-prefix-map "r" #'tab-rename) -(keymap-set tab-prefix-map "r" #'tab-switch) +(keymap-set tab-prefix-map "RET" #'tab-switch) (keymap-set tab-prefix-map "b" #'switch-to-buffer-other-tab) (keymap-set tab-prefix-map "f" #'find-file-other-tab) (keymap-set tab-prefix-map "C-f" #'find-file-other-tab) commit dc96fe5c101a4e1b0a332497c94c021bf7be4ce1 Author: Eli Zaretskii Date: Thu Jul 28 21:41:15 2022 +0300 ; * test/lisp/subr-tests.el (string-comparison-test): Add more tests. diff --git a/test/lisp/subr-tests.el b/test/lisp/subr-tests.el index 6df4a46932..be613ce759 100644 --- a/test/lisp/subr-tests.el +++ b/test/lisp/subr-tests.el @@ -374,6 +374,8 @@ (should-not (string-equal-ignore-case "abc" "abCD")) (should (string-equal-ignore-case "S" "s")) (should (string-equal-ignore-case "ẞ" "ß")) + (should (string-equal-ignore-case "Dz" "DZ")) + (should (string-equal-ignore-case "Όσος" "ΌΣΟΣ")) ;; not yet: (should (string-equal-ignore-case "SS" "ß")) ;; not yet: (should (string-equal-ignore-case "SS" "ẞ")) commit eeeb481750b5cec264af0f4ea5298cae011e5050 Author: Sam Steingold Date: Thu Jul 28 12:35:21 2022 -0400 Cleanup `string-equal-ignore-case' declarations. Also, a minor declaration cleanup for other `compare-strings' thin wrappers. * lisp/emacs-lisp/byte-opt.el (side-effect-free-fns): Remove `string-equal-ignore-case', `string-prefix-p', `string-suffix-p'. (side-effect-and-error-free-fns): Add `proper-list-p' (it already was in `pure-fns'). (pure-fns): Remove `string-prefix-p', `string-suffix-p' (`string-equal-ignore-case' was missing here). * lisp/subr.el (proper-list-p): Remove partially duplicate `put's from here. (string-equal-ignore-case, string-prefix-p, string-suffix-p): Add `pure' and `side-effect-free' declarations. (string-equal-ignore-case): Make inline. diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index 3f4af44051..9817fa0eb1 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -1451,8 +1451,7 @@ See Info node `(elisp) Integer Basics'." radians-to-degrees rassq rassoc read-from-string regexp-opt regexp-quote region-beginning region-end reverse round sin sqrt string string< string= string-equal string-lessp - string> string-greaterp string-empty-p string-equal-ignore-case - string-prefix-p string-suffix-p string-blank-p + string> string-greaterp string-empty-p string-blank-p string-search string-to-char string-to-number string-to-syntax substring sxhash sxhash-equal sxhash-eq sxhash-eql @@ -1500,7 +1499,7 @@ See Info node `(elisp) Integer Basics'." natnump nlistp not null number-or-marker-p numberp one-window-p overlayp point point-marker point-min point-max preceding-char primary-charset - processp + processp proper-list-p recent-keys recursion-depth safe-length selected-frame selected-window sequencep standard-case-table standard-syntax-table stringp subrp symbolp @@ -1545,7 +1544,7 @@ See Info node `(elisp) Integer Basics'." floor ceiling round truncate ffloor fceiling fround ftruncate string= string-equal string< string-lessp string> string-greaterp - string-empty-p string-blank-p string-prefix-p string-suffix-p + string-empty-p string-blank-p string-search consp atom listp nlistp proper-list-p sequencep arrayp vectorp stringp bool-vector-p hash-table-p diff --git a/lisp/subr.el b/lisp/subr.el index c82b33bba5..6b121a314a 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -733,11 +733,6 @@ If N is omitted or nil, remove the last element." (if (> n 0) (setcdr (nthcdr (- (1- m) n) list) nil)) list)))) -;; The function's definition was moved to fns.c, -;; but it's easier to set properties here. -(put 'proper-list-p 'pure t) -(put 'proper-list-p 'side-effect-free 'error-free) - (defun delete-dups (list) "Destructively remove `equal' duplicates from LIST. Store the result in LIST and return it. LIST must be a proper list. @@ -5302,16 +5297,18 @@ and replace a sub-expression, e.g. (setq matches (cons (substring string start l) matches)) ; leftover (apply #'concat (nreverse matches))))) -(defun string-equal-ignore-case (string1 string2) +(defsubst string-equal-ignore-case (string1 string2) "Like `string-equal', but case-insensitive. Upper-case and lower-case letters are treated as equal. Unibyte strings are converted to multibyte for comparison." + (declare (pure t) (side-effect-free t)) (eq t (compare-strings string1 0 nil string2 0 nil t))) (defun string-prefix-p (prefix string &optional ignore-case) "Return non-nil if PREFIX is a prefix of STRING. If IGNORE-CASE is non-nil, the comparison is done without paying attention to case differences." + (declare (pure t) (side-effect-free t)) (let ((prefix-length (length prefix))) (if (> prefix-length (length string)) nil (eq t (compare-strings prefix 0 prefix-length string @@ -5321,6 +5318,7 @@ to case differences." "Return non-nil if SUFFIX is a suffix of STRING. If IGNORE-CASE is non-nil, the comparison is done without paying attention to case differences." + (declare (pure t) (side-effect-free t)) (let ((start-pos (- (length string) (length suffix)))) (and (>= start-pos 0) (eq t (compare-strings suffix nil nil commit 6023b95948e85f44d827e0066832de145737aea7 Author: Sam Steingold Date: Tue Jul 26 14:40:49 2022 -0400 a couple more `string-equal-ignore-case' test cases diff --git a/test/lisp/subr-tests.el b/test/lisp/subr-tests.el index 1d85631a4b..6df4a46932 100644 --- a/test/lisp/subr-tests.el +++ b/test/lisp/subr-tests.el @@ -373,7 +373,9 @@ (should (string-equal-ignore-case "abc" "abC")) (should-not (string-equal-ignore-case "abc" "abCD")) (should (string-equal-ignore-case "S" "s")) + (should (string-equal-ignore-case "ẞ" "ß")) ;; not yet: (should (string-equal-ignore-case "SS" "ß")) + ;; not yet: (should (string-equal-ignore-case "SS" "ẞ")) (should (string-lessp "abc" "acb")) (should (string-lessp "aBc" "abc")) commit 5999dc1cd925ddf8af0b893432124af7904a6918 Author: Lars Ingebrigtsen Date: Thu Jul 28 17:49:57 2022 +0200 Comment fixes for recent icon code * lisp/cus-edit.el (custom-icon-state): Add comment. * lisp/emacs-lisp/icons.el: Remove comment. diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el index 9b0d2a10f6..1012d08ab5 100644 --- a/lisp/cus-edit.el +++ b/lisp/cus-edit.el @@ -5520,6 +5520,8 @@ changes." (or state (custom-icon-state (widget-value widget) value))))) +;;; FIXME -- more work is needed here. We don't properly +;;; differentiate between `saved' and `set'. (defun custom-icon-state (symbol value) "Return the state of customize icon SYMBOL for VALUE. Possible return values are `standard', `saved', `set', `themed', diff --git a/lisp/emacs-lisp/icons.el b/lisp/emacs-lisp/icons.el index 74ce0476a2..00784c4d95 100644 --- a/lisp/emacs-lisp/icons.el +++ b/lisp/emacs-lisp/icons.el @@ -22,8 +22,6 @@ ;;; Commentary: -;; Todo: describe-icon - ;;; Code: (require 'cl-lib) commit 41b63f7bed2eb9b186a3866e3a5c90d4846b8fce Author: Eli Zaretskii Date: Thu Jul 28 17:21:30 2022 +0300 ; Minor fixes to the "icons" feature * lisp/emacs-lisp/icons.el (icons--create): Use 'display-images-p' to test for image capability. * doc/lispref/display.texi (Icons): Improve indexing, cross-references, and wording. diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi index b5e4cb41fd..86f490677d 100644 --- a/doc/lispref/display.texi +++ b/doc/lispref/display.texi @@ -7004,18 +7004,19 @@ example: :help-echo "Open this section") @end lisp -This is used in tandem with the @code{icon-preference} user option, as -well as run-time checks for what the current Emacs frame can actually -display. - -The macro in this example defines @code{outline-open} as an icon, and -inherits properties from the icon called @code{button} (so this is -meant as a clickable button to be inserted in a buffer). We then get -a list of @dfn{icon types} along with the actual icon shapes -themselves. In addition, there's a doc string and various keywords -that contain additional information and properties. - -When instantiating an icon you use @code{icon-string}, and this will +Which alternative will actually be displayed depends on the value of +the user option @code{icon-preference} (@pxref{Icons,,, emacs, The GNU +Emacs Manual}) and on the results of run-time checks for what the +current frame's terminal can actually display. + +The macro in the example above defines @code{outline-open} as an icon, +and inherits properties from the icon called @code{button} (so this is +meant as a clickable button to be inserted in a buffer). It is +followed by a list of @dfn{icon types} along with the actual icon +shapes themselves. In addition, there's a doc string and various +keywords that contain additional information and properties. + +To instantiate an icon, you use @code{icon-string}, which will consult the current Customize theming, and the @code{icon-preference} user option, and finally what the Emacs is able to actually display. If @code{icon-preference} is @code{(image emoji symbol text)} (i.e., @@ -7031,40 +7032,42 @@ For instance, if @code{icon-preference} doesn't contain @code{image} or @code{emoji}, it'll skip those entries. Code can confidently call @code{icon-string} in all circumstances and -be confident that something readable will appear on the screen, no +be sure that something readable will appear on the screen, no matter whether the user is on a graphical terminal or a text terminal, and no matter which features Emacs was built with. @defmac define-icon name parent specs doc &rest keywords -@var{name} should be a symbol, and is the name of the resulting -keyword. @code{icon-string} can later be used to instantiate the -icon. +Define an icon @var{name}, a symbol, with the display alternatives in +@var{spec}, that can be later instantiated using @code{icon-string}. +The @var{name} is the name of the resulting keyword. -This icon will inherit specs from @var{parent}, and recursively from -the parent's parents, and so on, and the lowest descendent element +The resulting icon will inherit specs from @var{parent}, and from +their parent's parents, and so on, and the lowest descendent element wins. -@var{specs} is a list of specifications. The first element of each +@var{specs} is a list of icon specifications. The first element of each specification is the type, and the rest is something that can be used as an icon of that type, and then optionally followed by a keyword -list. The following types are available: +list. The following icon types are available: +@cindex icon types @table @code @item image In this case, there may be many images listed as candidates. Emacs will choose the first one that the current Emacs instance can show. -If an image listed is an absolute file name, it's used as is, but it's -otherwise looked up in the image load path. +If an image is listed is an absolute file name, it's used as is, but it's +otherwise looked up in the list @code{image-load-path} +(@pxref{Defining Images}). @item emoji This should be a (possibly colorful) emoji. @item symbol -This should be a (monochrome) symbol. +This should be a (monochrome) symbol character. @item text Icons should also have a textual fallback. This can also be used for -by the visually impaired: If @code{icon-preference} is just +the visually impaired: if @code{icon-preference} is just @code{(text)}, all icons will be replaced by text. @end table @@ -7077,9 +7080,10 @@ instance: Unknown keywords are ignored. The following keywords are allowed: +@cindex icon keywords @table @code @item :face -The face to be used. +The face to be used for the icon. @item :height This is only valid for @code{image} icons, and can be either a number @@ -7115,11 +7119,11 @@ buffer for @var{icon}. @defun icon-elements icon Alternatively, you can get a ``deconstructed'' version of @var{icon} -with this function. This returns a plist where the keys are -@code{string}, @code{face} and @var{image}. (The latter is only -present if the icon is represented by an image.) This can be useful -if the icon isn't to be inserted directly in the buffer, but needs -some sort of post-processing first. +with this function. It returns a plist (@pxref{Property Lists}) where +the keys are @code{string}, @code{face} and @var{image}. (The latter +is only present if the icon is represented by an image.) This can be +useful if the icon isn't to be inserted directly in the buffer, but +needs some sort of pre-processing first. @end defun Icons can be customized with @kbd{M-x customize-icon}. Themes can diff --git a/lisp/emacs-lisp/icons.el b/lisp/emacs-lisp/icons.el index da7f68f523..74ce0476a2 100644 --- a/lisp/emacs-lisp/icons.el +++ b/lisp/emacs-lisp/icons.el @@ -192,7 +192,7 @@ present if the icon is represented by an image." (let ((file (if (file-name-absolute-p icon) icon (image-search-load-path icon)))) - (and (display-graphic-p) + (and (display-images-p) (image-supported-file-p file) (propertize " " 'display @@ -207,6 +207,8 @@ present if the icon is represented by an image." (cl-defmethod icons--create ((_type (eql 'emoji)) icon _keywords) (when-let ((font (and (display-multi-font-p) + ;; FIXME: This is not enough for ensuring + ;; display of color Emoji. (car (internal-char-font nil ?😀))))) (and (font-has-char-p font (aref icon 0)) icon))) commit 6b96c630f7ae76bc0bd200097f7d9bf9e856f2db Author: Stefan Kangas Date: Thu Jul 28 15:32:42 2022 +0200 Delete fast-lock.el and lazy-lock.el The 'font-lock-support-mode' is occasionally useful for debugging purposes, so it remains as a defvar. Ref: https://lists.gnu.org/r/emacs-devel/2020-08/msg00125.html * lisp/obsolete/fast-lock.el: * lisp/obsolete/lazy-lock.el: Delete libraries obsolete since 22.1. (Bug#56560) * lisp/font-lock.el (font-lock-support-mode): Make into a defvar and delete any mention of 'lazy-lock-mode' and 'fast-lock-mode'. (font-lock-turn-on-thing-lock, font-lock-turn-off-thing-lock): Drop support for obsolete modes lazy-lock and fast-lock. (font-lock-after-fontify-buffer) (font-lock-after-unfontify-buffer): Make into obsolete function aliases for 'ignore'. Adjust callers. (font-lock-keywords, font-lock-inhibit-thing-lock): Adjust documentation to not mention lazy-lock and fast-lock. * lisp/font-core.el (font-lock-defaults): Adjust documentation to not mention 'font-lock-inhibit-thing-lock'. * lisp/mail/rmail.el (rmail-variables): Don't inhibit obsolete lazy-lock-mode and fast-lock-mode. diff --git a/etc/NEWS b/etc/NEWS index 72dd5572a2..b6d22fdf2b 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -343,6 +343,14 @@ Use 'skeleton' or 'tempo' instead. ** The rlogin.el library and 'rsh' command are now obsolete. Use something like 'M-x shell RET ssh RET' instead. +--- +** The fast-lock.el and lazy-lock.el library have been removed. +They have been obsolete since Emacs 22.1. + +The variable 'font-lock-support-mode' is occasionally useful for +debugging purposes. It is now a regular variable (instead of a user +option) and can be set to nil to disable Just-in-time Lock mode. + * Changes in Emacs 29.1 diff --git a/lisp/font-core.el b/lisp/font-core.el index f92d1e3830..f70c42bb03 100644 --- a/lisp/font-core.el +++ b/lisp/font-core.el @@ -65,7 +65,7 @@ Other variables include that for syntactic keyword fontification, `font-lock-syntactic-keywords' and those for buffer-specialized fontification functions, `font-lock-fontify-buffer-function', `font-lock-unfontify-buffer-function', `font-lock-fontify-region-function', -`font-lock-unfontify-region-function', and `font-lock-inhibit-thing-lock'.") +`font-lock-unfontify-region-function'.") ;; Autoload if this file no longer dumped. ;;;###autoload (put 'font-lock-defaults 'risky-local-variable t) diff --git a/lisp/font-lock.el b/lisp/font-lock.el index d815a9c9c4..4ae84220a7 100644 --- a/lisp/font-lock.el +++ b/lisp/font-lock.el @@ -490,8 +490,7 @@ of the line, i.e., cause the MATCHER search to span lines. These regular expressions can match text which spans lines, although it is better to avoid it if possible since updating them while editing text is slower, and it is not guaranteed to be -always correct when using support modes like jit-lock or -lazy-lock. +always correct. This variable is set by major modes via the variable `font-lock-defaults'. Be careful when composing regexps for this @@ -623,11 +622,8 @@ fontified.") It should take two args, the beginning and end of the region. This is normally set via `font-lock-defaults'.") -(defvar font-lock-inhibit-thing-lock nil - "List of Font Lock mode related modes that should not be turned on. -Currently, valid mode names are `fast-lock-mode', `jit-lock-mode' and -`lazy-lock-mode'. This is normally set via `font-lock-defaults'.") -(make-obsolete-variable 'font-lock-inhibit-thing-lock nil "25.1") +(defvar font-lock-inhibit-thing-lock nil) +(make-obsolete-variable 'font-lock-inhibit-thing-lock "it does nothing." "25.1") (defvar-local font-lock-multiline nil "Whether font-lock should cater to multiline keywords. @@ -642,7 +638,6 @@ Major/minor modes can set this variable if they know which option applies.") (eval-when-compile ;; - ;; Borrowed from lazy-lock.el. ;; We use this to preserve or protect things when modifying text properties. (defmacro save-buffer-state (&rest body) "Bind variables according to VARLIST and eval BODY restoring buffer state." @@ -881,65 +876,17 @@ happens, so the major mode can be corrected." ;;; Font Lock Support mode. -;; This is the code used to interface font-lock.el with any of its add-on -;; packages, and provide the user interface. Packages that have their own -;; local buffer fontification functions (see below) may have to call -;; `font-lock-after-fontify-buffer' and/or `font-lock-after-unfontify-buffer' -;; themselves. - -(defcustom font-lock-support-mode 'jit-lock-mode +(defvar font-lock-support-mode #'jit-lock-mode "Support mode for Font Lock mode. -Support modes speed up Font Lock mode by being choosy about when fontification -occurs. The default support mode, Just-in-time Lock mode (symbol -`jit-lock-mode'), is recommended. - -Other, older support modes are Fast Lock mode (symbol `fast-lock-mode') and -Lazy Lock mode (symbol `lazy-lock-mode'). See those modes for more info. -However, they are no longer recommended, as Just-in-time Lock mode is better. - If nil, means support for Font Lock mode is never performed. -If a symbol, use that support mode. -If a list, each element should be of the form (MAJOR-MODE . SUPPORT-MODE), -where MAJOR-MODE is a symbol or t (meaning the default). For example: - ((c-mode . fast-lock-mode) (c++-mode . fast-lock-mode) (t . lazy-lock-mode)) -means that Fast Lock mode is used to support Font Lock mode for buffers in C or -C++ modes, and Lazy Lock mode is used to support Font Lock mode otherwise. - -The value of this variable is used when Font Lock mode is turned on." - :type '(choice (const :tag "none" nil) - (const :tag "fast lock" fast-lock-mode) - (const :tag "lazy lock" lazy-lock-mode) - (const :tag "jit lock" jit-lock-mode) - (repeat :menu-tag "mode specific" :tag "mode specific" - :value ((t . jit-lock-mode)) - (cons :tag "Instance" - (radio :tag "Mode" - (const :tag "all" t) - (symbol :tag "name")) - (radio :tag "Support" - (const :tag "none" nil) - (const :tag "fast lock" fast-lock-mode) - (const :tag "lazy lock" lazy-lock-mode) - (const :tag "JIT lock" jit-lock-mode))) - )) - :version "21.1" - :group 'font-lock) +This can be useful for debugging. -(defvar fast-lock-mode) -(defvar lazy-lock-mode) -(defvar jit-lock-mode) +The value of this variable is used when Font Lock mode is turned on.") -(declare-function fast-lock-after-fontify-buffer "fast-lock") -(declare-function fast-lock-after-unfontify-buffer "fast-lock") -(declare-function fast-lock-mode "fast-lock") -(declare-function lazy-lock-after-fontify-buffer "lazy-lock") -(declare-function lazy-lock-after-unfontify-buffer "lazy-lock") -(declare-function lazy-lock-mode "lazy-lock") +(defvar jit-lock-mode) (defun font-lock-turn-on-thing-lock () (pcase (font-lock-value-in-major-mode font-lock-support-mode) - ('fast-lock-mode (fast-lock-mode t)) - ('lazy-lock-mode (lazy-lock-mode t)) ('jit-lock-mode ;; Prepare for jit-lock (remove-hook 'after-change-functions @@ -962,39 +909,11 @@ The value of this variable is used when Font Lock mode is turned on." nil t)))) (defun font-lock-turn-off-thing-lock () - (cond ((bound-and-true-p fast-lock-mode) - (fast-lock-mode -1)) - ((bound-and-true-p jit-lock-mode) + (cond ((bound-and-true-p jit-lock-mode) (jit-lock-unregister 'font-lock-fontify-region) ;; Reset local vars to the non-jit-lock case. - (kill-local-variable 'font-lock-fontify-buffer-function)) - ((bound-and-true-p lazy-lock-mode) - (lazy-lock-mode -1)))) - -(defun font-lock-after-fontify-buffer () - (cond ((bound-and-true-p fast-lock-mode) - (fast-lock-after-fontify-buffer)) - ;; Useless now that jit-lock intercepts font-lock-fontify-buffer. -sm - ;; (jit-lock-mode - ;; (jit-lock-after-fontify-buffer)) - ((bound-and-true-p lazy-lock-mode) - (lazy-lock-after-fontify-buffer)))) - -(defun font-lock-after-unfontify-buffer () - (cond ((bound-and-true-p fast-lock-mode) - (fast-lock-after-unfontify-buffer)) - ;; Useless as well. It's only called when: - ;; - turning off font-lock: it does not matter if we leave spurious - ;; `fontified' text props around since jit-lock-mode is also off. - ;; - font-lock-default-fontify-buffer fails: this is not run - ;; any more anyway. -sm - ;; - ;; (jit-lock-mode - ;; (jit-lock-after-unfontify-buffer)) - ((bound-and-true-p lazy-lock-mode) - (lazy-lock-after-unfontify-buffer)))) - -;; End of Font Lock Support mode. + (kill-local-variable 'font-lock-fontify-buffer-function)))) + ;;; Fontification functions. @@ -1160,7 +1079,6 @@ Lock mode." (save-excursion (save-match-data (font-lock-fontify-region (point-min) (point-max) verbose) - (font-lock-after-fontify-buffer) (setq font-lock-fontified t))) ;; We don't restore the old fontification, so it's best to unfontify. (quit (font-lock-unfontify-buffer))))))) @@ -1171,7 +1089,6 @@ Lock mode." (save-restriction (widen) (font-lock-unfontify-region (point-min) (point-max)) - (font-lock-after-unfontify-buffer) (setq font-lock-fontified nil))) (defvar font-lock-dont-widen nil @@ -2395,6 +2312,10 @@ This should be an integer. Used in `cpp-font-lock-keywords'.") for C preprocessor directives. This definition is for the other modes in which C preprocessor directives are used, e.g. `asm-mode' and `ld-script-mode'.") + +(define-obsolete-function-alias 'font-lock-after-fontify-buffer #'ignore "29.1") +(define-obsolete-function-alias 'font-lock-after-unfontify-buffer #'ignore "29.1") + (provide 'font-lock) diff --git a/lisp/mail/rmail.el b/lisp/mail/rmail.el index 71eda7cd2b..4bfec22b3a 100644 --- a/lisp/mail/rmail.el +++ b/lisp/mail/rmail.el @@ -1451,8 +1451,7 @@ If so restore the actual mbox message collection." (setq-local font-lock-defaults '(rmail-font-lock-keywords t t nil nil - (font-lock-dont-widen . t) - (font-lock-inhibit-thing-lock . (lazy-lock-mode fast-lock-mode)))) + (font-lock-dont-widen . t))) (setq-local require-final-newline nil) (setq-local version-control 'never) (add-hook 'kill-buffer-hook #'rmail-mode-kill-summary nil t) diff --git a/lisp/obsolete/fast-lock.el b/lisp/obsolete/fast-lock.el deleted file mode 100644 index 1614935f03..0000000000 --- a/lisp/obsolete/fast-lock.el +++ /dev/null @@ -1,730 +0,0 @@ -;;; fast-lock.el --- automagic text properties caching for fast Font Lock mode -*- lexical-binding: t; -*- - -;; Copyright (C) 1994-1998, 2001-2022 Free Software Foundation, Inc. - -;; Author: Simon Marshall -;; Maintainer: emacs-devel@gnu.org -;; Keywords: faces files -;; Version: 3.14 -;; Obsolete-since: 22.1 - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs. If not, see . - -;;; Commentary: - -;; Fast Lock mode is a Font Lock support mode. -;; It makes visiting a file in Font Lock mode faster by restoring its face text -;; properties from automatically saved associated Font Lock cache files. -;; -;; See caveats and feedback below. -;; See also the lazy-lock package. (But don't use the two at the same time!) - -;; Installation: -;; -;; Put in your ~/.emacs: -;; -;; (setq font-lock-support-mode 'fast-lock-mode) -;; -;; Start up a new Emacs and use font-lock as usual (except that you can use the -;; so-called "gaudier" fontification regexps on big files without frustration). -;; -;; When you visit a file (which has `font-lock-mode' enabled) that has a -;; corresponding Font Lock cache file associated with it, the Font Lock cache -;; will be loaded from that file instead of being generated by Font Lock code. - -;; Caveats: -;; -;; A cache will be saved when visiting a compressed file using crypt++, but not -;; be read. This is a "feature"/"consequence"/"bug" of crypt++. -;; -;; Version control packages are likely to stamp all over file modification -;; times. Therefore the act of checking out may invalidate a cache. - -;; History: -;; -;; 0.02--1.00: -;; - Changed name from turbo-prop to fast-lock. Automagic for font-lock only -;; - Made `fast-lock-mode' a minor mode, like G. Dinesh Dutt's fss-mode -;; 1.00--1.01: -;; - Turn on `fast-lock-mode' only if `buffer-file-name' or `interactive-p' -;; - Made `fast-lock-file-name' use `buffer-name' if `buffer-file-name' is nil -;; - Moved save-all conditions to `fast-lock-save-cache' -;; - Added `fast-lock-save-text-properties' to `kill-buffer-hook' -;; 1.01--2.00: complete rewrite---not worth the space to document -;; - Changed structure of text properties cache and threw out file mod checks -;; 2.00--2.01: -;; - Made `condition-case' forms understand `quit'. -;; - Made `fast-lock' require `font-lock' -;; - Made `fast-lock-cache-name' chase links (from Ben Liblit) -;; 2.01--3.00: -;; - Changed structure of cache to include `font-lock-keywords' (from rms) -;; - Changed `fast-lock-cache-mechanisms' to `fast-lock-cache-directories' -;; - Removed `fast-lock-read-others' -;; - Made `fast-lock-read-cache' ignore cache owner -;; - Made `fast-lock-save-cache-external' create cache directory -;; - Made `fast-lock-save-cache-external' save `font-lock-keywords' -;; - Made `fast-lock-cache-data' check `font-lock-keywords' -;; 3.00--3.01: incorporated port of 2.00 to Lucid, made by Barry Warsaw -;; - Package now provides itself -;; - Lucid: Use `font-lock-any-extents-p' for `font-lock-any-properties-p' -;; - Lucid: Use `list-faces' for `face-list' -;; - Lucid: Added `set-text-properties' -;; - Lucid: Made `turn-on-fast-lock' pass 1 not t to `fast-lock-mode' -;; - Removed test for `fast-lock-mode' from `fast-lock-read-cache' -;; - Lucid: Added Lucid-specific `fast-lock-get-face-properties' -;; 3.01--3.02: now works with Lucid Emacs, thanks to Barry Warsaw -;; - Made `fast-lock-cache-name' map ":" to ";" for OS/2 (from Serganova Vera) -;; - Made `fast-lock-cache-name' use abbreviated file name (from Barry Warsaw) -;; - Lucid: Separated handlers for `error' and `quit' for `condition-case' -;; 3.02--3.03: -;; - Changed `fast-lock-save-cache-external' to `fast-lock-save-cache-data' -;; - Lucid: Added Lucid-specific `fast-lock-set-face-properties' -;; 3.03--3.04: -;; - Corrected `subrp' test of Lucid code -;; - Replaced `font-lock-any-properties-p' with `text-property-not-all' -;; - Lucid: Made `fast-lock-set-face-properties' put `text-prop' on extents -;; - Made `fast-lock-cache-directories' a regexp alist (from Colin Rafferty) -;; - Made `fast-lock-cache-directory' to return a usable cache file directory -;; 3.04--3.05: -;; - Lucid: Fix for XEmacs 19.11 `text-property-not-all' -;; - Replaced `subrp' test of Lucid code with `emacs-version' `string-match' -;; - Made `byte-compile-warnings' omit `unresolved' on compilation -;; - Made `fast-lock-save-cache-data' use a buffer (from Rick Sladkey) -;; - Reverted to old `fast-lock-get-face-properties' (from Rick Sladkey) -;; 3.05--3.06: incorporated hack of 3.03, made by Jonathan Stigelman (Stig) -;; - Reverted to 3.04 version of `fast-lock-get-face-properties' -;; - XEmacs: Removed `list-faces' `defalias' -;; - Made `fast-lock-mode' and `turn-on-fast-lock' succeed `autoload' cookies -;; - Added `fast-lock-submit-bug-report' -;; - Renamed `fast-lock-save-size' to `fast-lock-minimum-size' -;; - Made `fast-lock-save-cache' output a message if no save ever attempted -;; - Made `fast-lock-save-cache-data' output a message if save attempted -;; - Made `fast-lock-cache-data' output a message if load attempted -;; - Made `fast-lock-save-cache-data' do `condition-case' not `unwind-protect' -;; - Made `fast-lock-save-cache' and `fast-lock-read-cache' return nothing -;; - Made `fast-lock-save-cache' check `buffer-modified-p' (Stig) -;; - Added `fast-lock-save-events' -;; - Added `fast-lock-after-save-hook' to `after-save-hook' (Stig) -;; - Added `fast-lock-kill-buffer-hook' to `kill-buffer-hook' -;; - Changed `fast-lock-save-caches' to `fast-lock-kill-emacs-hook' -;; - Added `fast-lock-kill-emacs-hook' to `kill-emacs-hook' -;; - Made `fast-lock-save-cache' check `verify-visited-file-modtime' (Stig) -;; - Made `visited-file-modtime' be the basis of the timestamp (Stig) -;; - Made `fast-lock-save-cache-1' and `fast-lock-cache-data' use/reformat it -;; - Added `fast-lock-cache-filename' to keep track of the cache file name -;; - Added `fast-lock-after-fontify-buffer' -;; - Added `fast-lock-save-faces' list of faces to save (idea from Stig/Tibor) -;; - Made `fast-lock-get-face-properties' functions use it -;; - XEmacs: Made `fast-lock-set-face-properties' do extents the Font Lock way -;; - XEmacs: Removed fix for `text-property-not-all' (19.11 support dropped) -;; - Made `fast-lock-mode' ensure `font-lock-mode' is on -;; - Made `fast-lock-save-cache' do `cdr-safe' not `cdr' (from Dave Foster) -;; - Made `fast-lock-save-cache' do `set-buffer' first (from Dave Foster) -;; - Made `fast-lock-save-cache' loop until saved or quit (from Georg Nikodym) -;; - Made `fast-lock-cache-data' check `buffer-modified-p' -;; - Made `fast-lock-cache-data' do `font-lock-compile-keywords' if necessary -;; - XEmacs: Made `font-lock-compile-keywords' `defalias' -;; 3.06--3.07: -;; - XEmacs: Add `fast-lock-after-fontify-buffer' to the Font Lock hook -;; - Made `fast-lock-cache-name' explain the use of `directory-abbrev-alist' -;; - Made `fast-lock-mode' use `buffer-file-truename' not `buffer-file-name' -;; 3.07--3.08: -;; - Made `fast-lock-read-cache' set `fast-lock-cache-filename' -;; 3.08--3.09: -;; - Made `fast-lock-save-cache' cope if `fast-lock-minimum-size' is a list -;; - Made `fast-lock-mode' respect the value of `font-lock-inhibit-thing-lock' -;; - Added `fast-lock-after-unfontify-buffer' -;; 3.09--3.10: -;; - Rewrite for Common Lisp macros -;; - Made fast-lock.el barf on a crap 8+3 pseudo-OS (Eli Zaretskii help) -;; - XEmacs: Made `add-minor-mode' succeed `autoload' cookie -;; - XEmacs: Made `fast-lock-save-faces' default to `font-lock-face-list' -;; - Made `fast-lock-save-cache' use `font-lock-value-in-major-mode' -;; - Wrap with `save-buffer-state' (Ray Van Tassle report) -;; - Made `fast-lock-mode' wrap `font-lock-support-mode' -;; 3.10--3.11: -;; - Made `fast-lock-get-face-properties' cope with face lists -;; - Added `fast-lock-verbose' -;; - XEmacs: Add `font-lock-value-in-major-mode' if necessary -;; - Removed `fast-lock-submit-bug-report' and bade farewell -;; 3.11--3.12: -;; - Added Custom support (Hrvoje Nikšić help) -;; - Made `save-buffer-state' wrap `inhibit-point-motion-hooks' -;; - Made `fast-lock-cache-data' simplify calls of `font-lock-compile-keywords' -;; 3.12--3.13: -;; - Removed `byte-*' variables from `eval-when-compile' (Erik Naggum hint) -;; - Changed structure of cache to include `font-lock-syntactic-keywords' -;; - Made `fast-lock-save-cache-1' save syntactic fontification data -;; - Made `fast-lock-cache-data' take syntactic fontification data -;; - Added `fast-lock-get-syntactic-properties' -;; - Renamed `fast-lock-set-face-properties' to `fast-lock-add-properties' -;; - Made `fast-lock-add-properties' add syntactic and face fontification data -;; 3.13--3.14: -;; - Made `fast-lock-cache-name' cope with `windowsnt' (Geoff Voelker fix) -;; - Made `fast-lock-verbose' use `other' widget (Andreas Schwab fix) -;; - Used `with-temp-message' where possible to make messages temporary. - -;;; Code: - -(require 'font-lock) - -(declare-function msdos-long-file-names "msdos.c") - -;; Make sure fast-lock.el is supported. -(if (and (eq system-type 'ms-dos) (not (msdos-long-file-names))) - (error "`fast-lock' was written for long file name systems")) - -(defvar font-lock-face-list) - -(eval-when-compile - ;; - ;; We use this to verify that a face should be saved. - (defmacro fast-lock-save-facep (face) - "Return non-nil if FACE is one of `fast-lock-save-faces'." - `(or (null fast-lock-save-faces) - (if (symbolp ,face) - (memq ,face fast-lock-save-faces) - (let ((faces ,face)) - (while (unless (memq (car faces) fast-lock-save-faces) - (setq faces (cdr faces)))) - faces))))) - -(defgroup fast-lock nil - "Font Lock support mode to cache fontification." - :load 'fast-lock - :group 'font-lock) - -(defvar fast-lock-mode nil) ; Whether we are turned on. -(defvar fast-lock-cache-timestamp nil) ; For saving/reading. -(defvar fast-lock-cache-filename nil) ; For deleting. - -;; User Variables: - -(defcustom fast-lock-minimum-size 25600 - "Minimum size of a buffer for cached fontification. -Only buffers more than this can have associated Font Lock cache files saved. -If nil, means cache files are never created. -If a list, each element should be a cons pair of the form (MAJOR-MODE . SIZE), -where MAJOR-MODE is a symbol or t (meaning the default). For example: - ((c-mode . 25600) (c++-mode . 25600) (rmail-mode . 1048576)) -means that the minimum size is 25K for buffers in C or C++ modes, one megabyte -for buffers in Rmail mode, and size is irrelevant otherwise." - :type '(choice (const :tag "none" nil) - (integer :tag "size") - (repeat :menu-tag "mode specific" :tag "mode specific" - :value ((t . nil)) - (cons :tag "Instance" - (radio :tag "Mode" - (const :tag "all" t) - (symbol :tag "name")) - (radio :tag "Size" - (const :tag "none" nil) - (integer :tag "size")))))) - -(defcustom fast-lock-cache-directories '("~/.emacs-flc") -; - `internal', keep each file's Font Lock cache file in the same file. -; - `external', keep each file's Font Lock cache file in the same directory. - "Directories in which Font Lock cache files are saved and read. -Each item should be either DIR or a cons pair of the form (REGEXP . DIR) where -DIR is a directory name (relative or absolute) and REGEXP is a regexp. - -An attempt will be made to save or read Font Lock cache files using these items -until one succeeds (i.e., until a readable or writable one is found). If an -item contains REGEXP, DIR is used only if the buffer file name matches REGEXP. -For example: - - (let ((home (expand-file-name (abbreviate-file-name (file-truename \"~/\"))))) - (list (cons (concat \"^\" (regexp-quote home)) \".\") \"~/.emacs-flc\")) - => - ((\"^/your/true/home/directory/\" . \".\") \"~/.emacs-flc\") - -would cause a file's current directory to be used if the file is under your -home directory hierarchy, or otherwise the absolute directory `~/.emacs-flc'. -For security reasons, it is not advisable to use the file's current directory -to avoid the possibility of using the cache of another user." - :type '(repeat (radio (directory :tag "directory") - (cons :tag "Matching" - (regexp :tag "regexp") - (directory :tag "directory"))))) -(put 'fast-lock-cache-directories 'risky-local-variable t) - -(defcustom fast-lock-save-events '(kill-buffer kill-emacs) - "Events under which caches will be saved. -Valid events are `save-buffer', `kill-buffer' and `kill-emacs'. -If concurrent editing sessions use the same associated cache file for a file's -buffer, then you should add `save-buffer' to this list." - :type '(set (const :tag "buffer saving" save-buffer) - (const :tag "buffer killing" kill-buffer) - (const :tag "emacs killing" kill-emacs))) - -(defcustom fast-lock-save-others t - "If non-nil, save Font Lock cache files irrespective of file owner. -If nil, means only buffer files known to be owned by you can have associated -Font Lock cache files saved. Ownership may be unknown for networked files." - :type 'boolean) - -(defcustom fast-lock-verbose font-lock-verbose - "If non-nil, means show status messages for cache processing. -If a number, only buffers greater than this size have processing messages." - :type '(choice (const :tag "never" nil) - (other :tag "always" t) - (integer :tag "size"))) - -(defvar fast-lock-save-faces nil - "Faces that will be saved in a Font Lock cache file. -If nil, means information for all faces will be saved.") - -;; User Functions: - -;;;###autoload -(defun fast-lock-mode (&optional arg) - "Toggle Fast Lock mode. -With arg, turn Fast Lock mode on if and only if arg is positive and the buffer -is associated with a file. Enable it automatically in your `~/.emacs' by: - - (setq font-lock-support-mode \\='fast-lock-mode) - -If Fast Lock mode is enabled, and the current buffer does not contain any text -properties, any associated Font Lock cache is used if its timestamp matches the -buffer's file, and its `font-lock-keywords' match those that you are using. - -Font Lock caches may be saved: -- When you save the file's buffer. -- When you kill an unmodified file's buffer. -- When you exit Emacs, for all unmodified or saved buffers. -Depending on the value of `fast-lock-save-events'. -See also the commands `fast-lock-read-cache' and `fast-lock-save-cache'. - -Use \\[font-lock-fontify-buffer] to fontify the buffer if the cache is bad. - -Various methods of control are provided for the Font Lock cache. In general, -see variable `fast-lock-cache-directories' and function `fast-lock-cache-name'. -For saving, see variables `fast-lock-minimum-size', `fast-lock-save-events', -`fast-lock-save-others' and `fast-lock-save-faces'." - (interactive "P") - ;; Only turn on if we are visiting a file. We could use `buffer-file-name', - ;; but many packages temporarily wrap that to nil when doing their own thing. - (set (make-local-variable 'fast-lock-mode) - (and buffer-file-truename - (not (memq 'fast-lock-mode font-lock-inhibit-thing-lock)) - (if arg (> (prefix-numeric-value arg) 0) (not fast-lock-mode)))) - (if (and fast-lock-mode (not font-lock-mode)) - ;; Turned on `fast-lock-mode' rather than `font-lock-mode'. - (progn - (message "Use font-lock-support-mode rather than calling fast-lock-mode") - (sit-for 2)) - ;; Let's get down to business. - (set (make-local-variable 'fast-lock-cache-timestamp) nil) - (set (make-local-variable 'fast-lock-cache-filename) nil) - (when (and fast-lock-mode (not font-lock-fontified)) - (fast-lock-read-cache)))) - -(defun fast-lock-read-cache () - "Read the Font Lock cache for the current buffer. - -The following criteria must be met for a Font Lock cache file to be read: -- Fast Lock mode must be turned on in the buffer. -- The buffer must not be modified. -- The buffer's `font-lock-keywords' must match the cache's. -- The buffer file's timestamp must match the cache's. -- Criteria imposed by `fast-lock-cache-directories'. - -See `fast-lock-mode'." - (interactive) - (let ((directories fast-lock-cache-directories) - (modified (buffer-modified-p)) (inhibit-read-only t) - (fontified font-lock-fontified)) - (set (make-local-variable 'font-lock-fontified) nil) - ;; Keep trying directories until fontification is turned off. - (while (and directories (not font-lock-fontified)) - (let ((directory (fast-lock-cache-directory (car directories) nil))) - (condition-case nil - (when directory - (setq fast-lock-cache-filename (fast-lock-cache-name directory)) - (when (file-readable-p fast-lock-cache-filename) - (load fast-lock-cache-filename t t t))) - (error nil) (quit nil)) - (setq directories (cdr directories)))) - ;; Unset `fast-lock-cache-filename', and restore `font-lock-fontified', if - ;; we don't use a cache. (Note that `fast-lock-cache-data' sets the value - ;; of `fast-lock-cache-timestamp'.) - (set-buffer-modified-p modified) - (unless font-lock-fontified - (setq fast-lock-cache-filename nil font-lock-fontified fontified)))) - -(defun fast-lock-save-cache (&optional buffer) - "Save the Font Lock cache of BUFFER or the current buffer. - -The following criteria must be met for a Font Lock cache file to be saved: -- Fast Lock mode must be turned on in the buffer. -- The event must be one of `fast-lock-save-events'. -- The buffer must be at least `fast-lock-minimum-size' bytes long. -- The buffer file must be owned by you, or `fast-lock-save-others' must be t. -- The buffer must contain at least one `face' text property. -- The buffer must not be modified. -- The buffer file's timestamp must be the same as the file's on disk. -- The on disk file's timestamp must be different than the buffer's cache. -- Criteria imposed by `fast-lock-cache-directories'. - -See `fast-lock-mode'." - (interactive) - (save-excursion - (when buffer - (set-buffer buffer)) - (let ((min-size (font-lock-value-in-major-mode fast-lock-minimum-size)) - (file-timestamp (visited-file-modtime)) (saved nil)) - (when (and fast-lock-mode - ;; - ;; "Only save if the buffer matches the file, the file has - ;; changed, and it was changed by the current emacs session." - ;; - ;; Only save if the buffer is not modified, - ;; (i.e., so we don't save for something not on disk) - (not (buffer-modified-p)) - ;; and the file's timestamp is the same as the buffer's, - ;; (i.e., someone else hasn't written the file in the meantime) - (verify-visited-file-modtime (current-buffer)) - ;; and the file's timestamp is different from the cache's. - ;; (i.e., a save has occurred since the cache was read) - (not (equal fast-lock-cache-timestamp file-timestamp)) - ;; - ;; Only save if user's restrictions are satisfied. - (and min-size (>= (buffer-size) min-size)) - (or fast-lock-save-others - (eq (user-uid) (file-attribute-user-id - (file-attributes buffer-file-name)))) - ;; - ;; Only save if there are `face' properties to save. - (text-property-not-all (point-min) (point-max) 'face nil)) - ;; - ;; Try each directory until we manage to save or the user quits. - (let ((directories fast-lock-cache-directories)) - (while (and directories (memq saved '(nil error))) - (let* ((dir (fast-lock-cache-directory (car directories) t)) - (file (and dir (fast-lock-cache-name dir)))) - (when (and file (file-writable-p file)) - (setq saved (fast-lock-save-cache-1 file file-timestamp))) - (setq directories (cdr directories))))))))) - -;;;###autoload -(defun turn-on-fast-lock () - "Unconditionally turn on Fast Lock mode." - (fast-lock-mode t)) - -;;; API Functions: - -(defun fast-lock-after-fontify-buffer () - ;; Delete the Font Lock cache file used to restore fontification, if any. - (when fast-lock-cache-filename - (if (file-writable-p fast-lock-cache-filename) - (delete-file fast-lock-cache-filename) - (message "File %s font lock cache cannot be deleted" (buffer-name)))) - ;; Flag so that a cache will be saved later even if the file is never saved. - (setq fast-lock-cache-timestamp nil)) - -(defalias 'fast-lock-after-unfontify-buffer #'ignore) - -;; Miscellaneous Functions: - -(defun fast-lock-save-cache-after-save-file () - ;; Do `fast-lock-save-cache' if `save-buffer' is on `fast-lock-save-events'. - (when (memq 'save-buffer fast-lock-save-events) - (fast-lock-save-cache))) - -(defun fast-lock-save-cache-before-kill-buffer () - ;; Do `fast-lock-save-cache' if `kill-buffer' is on `fast-lock-save-events'. - (when (memq 'kill-buffer fast-lock-save-events) - (fast-lock-save-cache))) - -(defun fast-lock-save-caches-before-kill-emacs () - ;; Do `fast-lock-save-cache's if `kill-emacs' is on `fast-lock-save-events'. - (when (memq 'kill-emacs fast-lock-save-events) - (mapcar #'fast-lock-save-cache (buffer-list)))) - -(defun fast-lock-cache-directory (directory create) - "Return usable directory based on DIRECTORY. -Returns nil if the directory does not exist, or, if CREATE non-nil, cannot be -created. DIRECTORY may be a string or a cons pair of the form (REGEXP . DIR). -See `fast-lock-cache-directories'." - (let ((dir - (cond ((not buffer-file-name) - ;; Should never be nil, but `crypt++' screws it up. - nil) - ((stringp directory) - ;; Just a directory. - directory) - (t - ;; A directory if the file name matches the regexp. - (let ((bufile (expand-file-name buffer-file-truename)) - (case-fold-search nil)) - (when (save-match-data (string-match (car directory) bufile)) - (cdr directory))))))) - (cond ((not dir) - nil) - ((file-accessible-directory-p dir) - dir) - (create - (condition-case nil - (progn (make-directory dir t) dir) - (error nil)))))) - -;; If you are wondering why we only hash if the directory is not ".", rather -;; than if `file-name-absolute-p', it is because if we just appended ".flc" for -;; relative cache directories (that are not ".") then it is possible that more -;; than one file would have the same cache name in that directory, if the luser -;; made a link from one relative cache directory to another. (Phew!) -(defun fast-lock-cache-name (directory) - "Return full cache file name using caching DIRECTORY. -If DIRECTORY is `.', the file name is the buffer file name appended with `.flc'. -Otherwise, the file name is constructed from DIRECTORY and the buffer's true -abbreviated file name, with all `/' characters in the name replaced with `#' -characters, and appended with `.flc'. - -If the same file has different cache file names when edited on different -machines, e.g., on one machine the cache file name has the prefix `#home', -perhaps due to automount, try putting in your `~/.emacs' something like: - - (setq directory-abbrev-alist (cons \\='(\"^/home/\" . \"/\") directory-abbrev-alist)) - -Emacs automagically removes the common `/tmp_mnt' automount prefix by default. - -See `fast-lock-cache-directory'." - (if (string-equal directory ".") - (concat buffer-file-name ".flc") - (let* ((bufile (expand-file-name buffer-file-truename)) - (chars-alist - (if (memq system-type '(windows-nt cygwin)) - '((?/ . (?#)) (?# . (?# ?#)) (?: . (?\;)) (?\; . (?\; ?\;))) - '((?/ . (?#)) (?# . (?# ?#))))) - (mapchars - (function (lambda (c) (or (cdr (assq c chars-alist)) (list c)))))) - (concat - (file-name-as-directory (expand-file-name directory)) - (mapconcat #'char-to-string (apply #'append (mapcar mapchars bufile)) "") - ".flc")))) - -;; Font Lock Cache Processing Functions: - -;; The version 3 format of the cache is: -;; -;; (fast-lock-cache-data VERSION TIMESTAMP -;; font-lock-syntactic-keywords SYNTACTIC-PROPERTIES -;; font-lock-keywords FACE-PROPERTIES) - -(defun fast-lock-save-cache-1 (file timestamp) - ;; Save the FILE with the TIMESTAMP plus fontification data. - ;; Returns non-nil if a save was attempted to a writable cache file. - (let ((tpbuf (generate-new-buffer " *fast-lock*")) - (verbose (if (numberp fast-lock-verbose) - (> (buffer-size) fast-lock-verbose) - fast-lock-verbose)) - (saved t)) - (with-temp-message - (when verbose - (format "Saving %s font lock cache..." (buffer-name))) - (condition-case nil - (save-excursion - (print (list 'fast-lock-cache-data 3 - (list 'quote timestamp) - (list 'quote font-lock-syntactic-keywords) - (list 'quote (fast-lock-get-syntactic-properties)) - (list 'quote font-lock-keywords) - (list 'quote (fast-lock-get-face-properties))) - tpbuf) - (set-buffer tpbuf) - (write-region (point-min) (point-max) file nil 'quietly) - (setq fast-lock-cache-timestamp timestamp - fast-lock-cache-filename file)) - (error (setq saved 'error)) (quit (setq saved 'quit))) - (kill-buffer tpbuf)) - (cond ((eq saved 'quit) - (message "Saving %s font lock cache...quit" (buffer-name))) - ((eq saved 'error) - (message "Saving %s font lock cache...failed" (buffer-name)))) - ;; We return non-nil regardless of whether a failure occurred. - saved)) - -(defun fast-lock-cache-data (version timestamp - syntactic-keywords syntactic-properties - keywords face-properties - &rest _ignored) - ;; Find value of syntactic keywords in case it is a symbol. - (setq font-lock-syntactic-keywords (font-lock-eval-keywords - font-lock-syntactic-keywords)) - ;; Compile all keywords in case some are and some aren't. - (when font-lock-syntactic-keywords - (setq font-lock-syntactic-keywords (font-lock-compile-keywords - font-lock-syntactic-keywords t))) - (when syntactic-keywords - (setq syntactic-keywords (font-lock-compile-keywords syntactic-keywords t))) - (setq font-lock-keywords (font-lock-compile-keywords font-lock-keywords) - keywords (font-lock-compile-keywords keywords)) - ;; Use the Font Lock cache SYNTACTIC-PROPERTIES and FACE-PROPERTIES if we're - ;; using cache VERSION format 3, the current buffer's file timestamp matches - ;; the TIMESTAMP, the current buffer's `font-lock-syntactic-keywords' are the - ;; same as SYNTACTIC-KEYWORDS, and the current buffer's `font-lock-keywords' - ;; are the same as KEYWORDS. - (let ((buf-timestamp (visited-file-modtime)) - (verbose (if (numberp fast-lock-verbose) - (> (buffer-size) fast-lock-verbose) - fast-lock-verbose)) - (loaded t)) - (if (or (/= version 3) - (buffer-modified-p) - (not (equal timestamp buf-timestamp)) - (not (equal syntactic-keywords font-lock-syntactic-keywords)) - (not (equal keywords font-lock-keywords))) - (setq loaded nil) - (with-temp-message - (when verbose - (format "Loading %s font lock cache..." (buffer-name))) - (condition-case nil - (fast-lock-add-properties syntactic-properties face-properties) - (error (setq loaded 'error)) (quit (setq loaded 'quit)))) - (cond ((eq loaded 'quit) - (message "Loading %s font lock cache...quit" (buffer-name))) - ((eq loaded 'error) - (message "Loading %s font lock cache...failed" (buffer-name))))) - (setq font-lock-fontified (eq loaded t) - fast-lock-cache-timestamp (and (eq loaded t) timestamp)))) - -;; Text Properties Processing Functions: - -;; This is fast, but fails if adjacent characters have different `face' text -;; properties. Maybe that's why I dropped it in the first place? -;(defun fast-lock-get-face-properties () -; "Return a list of `face' text properties in the current buffer. -;Each element of the list is of the form (VALUE START1 END1 START2 END2 ...) -;where VALUE is a `face' property value and STARTx and ENDx are positions." -; (save-restriction -; (widen) -; (let ((start (text-property-not-all (point-min) (point-max) 'face nil)) -; (limit (point-max)) end properties value cell) -; (while start -; (setq end (next-single-property-change start 'face nil limit) -; value (get-text-property start 'face)) -; ;; Make, or add to existing, list of regions with same `face'. -; (if (setq cell (assq value properties)) -; (setcdr cell (cons start (cons end (cdr cell)))) -; (setq properties (cons (list value start end) properties))) -; (setq start (next-single-property-change end 'face))) -; properties))) - -;; This is slow, but copes if adjacent characters have different `face' text -;; properties, but fails if they are lists. -;(defun fast-lock-get-face-properties () -; "Return a list of `face' text properties in the current buffer. -;Each element of the list is of the form (VALUE START1 END1 START2 END2 ...) -;where VALUE is a `face' property value and STARTx and ENDx are positions. -;Only those `face' VALUEs in `fast-lock-save-faces' are returned." -; (save-restriction -; (widen) -; (let ((faces (or fast-lock-save-faces (face-list))) (limit (point-max)) -; properties regions face start end) -; (while faces -; (setq face (car faces) faces (cdr faces) regions () end (point-min)) -; ;; Make a list of start/end regions with `face' property face. -; (while (setq start (text-property-any end limit 'face face)) -; (setq end (or (text-property-not-all start limit 'face face) limit) -; regions (cons start (cons end regions)))) -; ;; Add `face' face's regions, if any, to properties. -; (when regions -; (push (cons face regions) properties))) -; properties))) - -(defun fast-lock-get-face-properties () - "Return a list of `face' text properties in the current buffer. -Each element of the list is of the form (VALUE START1 END1 START2 END2 ...) -where VALUE is a `face' property value and STARTx and ENDx are positions." - (save-restriction - (widen) - (let ((start (text-property-not-all (point-min) (point-max) 'face nil)) - end properties value cell) - (while start - (setq end (next-single-property-change start 'face nil (point-max)) - value (get-text-property start 'face)) - ;; Make, or add to existing, list of regions with same `face'. - (cond ((setq cell (assoc value properties)) - (setcdr cell (cons start (cons end (cdr cell))))) - ((fast-lock-save-facep value) - (push (list value start end) properties))) - (setq start (text-property-not-all end (point-max) 'face nil))) - properties))) - -(defun fast-lock-get-syntactic-properties () - "Return a list of `syntax-table' text properties in the current buffer. -See `fast-lock-get-face-properties'." - (save-restriction - (widen) - (let ((start (text-property-not-all (point-min) (point-max) 'syntax-table - nil)) - end properties value cell) - (while start - (setq end (next-single-property-change start 'syntax-table nil - (point-max)) - value (get-text-property start 'syntax-table)) - ;; Make, or add to existing, list of regions with same `syntax-table'. - (if (setq cell (assoc value properties)) - (setcdr cell (cons start (cons end (cdr cell)))) - (push (list value start end) properties)) - (setq start (text-property-not-all end (point-max) 'syntax-table nil))) - properties))) - -(defun fast-lock-add-properties (syntactic-properties face-properties) - "Add `syntax-table' and `face' text properties to the current buffer. -Any existing `syntax-table' and `face' text properties are removed first. -See `fast-lock-get-face-properties'." - (with-silent-modifications - (let ((inhibit-point-motion-hooks t)) - (save-restriction - (widen) - (font-lock-unfontify-region (point-min) (point-max)) - ;; - ;; Set the `syntax-table' property for each start/end region. - (pcase-dolist (`(,plist . ,regions) syntactic-properties) - (while regions - (add-text-properties (nth 0 regions) (nth 1 regions) plist) - (setq regions (nthcdr 2 regions)))) - ;; - ;; Set the `face' property for each start/end region. - (pcase-dolist (`(,plist . ,regions) face-properties) - (while regions - (add-text-properties (nth 0 regions) (nth 1 regions) plist) - (setq regions (nthcdr 2 regions)))))))) - - -;; Install ourselves: - -(add-hook 'after-save-hook #'fast-lock-save-cache-after-save-file) -(add-hook 'kill-buffer-hook #'fast-lock-save-cache-before-kill-buffer) -(unless noninteractive - (add-hook 'kill-emacs-hook #'fast-lock-save-caches-before-kill-emacs)) - -;;;###autoload -(when (fboundp 'add-minor-mode) - (defvar fast-lock-mode nil) - (add-minor-mode 'fast-lock-mode nil)) -;;;###dont-autoload -(unless (assq 'fast-lock-mode minor-mode-alist) - (setq minor-mode-alist (append minor-mode-alist '((fast-lock-mode nil))))) - -(provide 'fast-lock) - -;;; fast-lock.el ends here - -;; Local Variables: -;; byte-compile-warnings: (not obsolete) -;; End: diff --git a/lisp/obsolete/lazy-lock.el b/lisp/obsolete/lazy-lock.el deleted file mode 100644 index 5c35cb3212..0000000000 --- a/lisp/obsolete/lazy-lock.el +++ /dev/null @@ -1,1025 +0,0 @@ -;;; lazy-lock.el --- lazy demand-driven fontification for fast Font Lock mode -*- lexical-binding: t; -*- - -;; Copyright (C) 1994-1998, 2001-2022 Free Software Foundation, Inc. - -;; Author: Simon Marshall -;; Maintainer: emacs-devel@gnu.org -;; Keywords: faces files -;; Version: 2.11 -;; Obsolete-since: 22.1 - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs. If not, see . - -;;; Commentary: - -;; Purpose: -;; -;; Lazy Lock mode is a Font Lock support mode. -;; It makes visiting buffers in Font Lock mode faster by making fontification -;; be demand-driven, deferred and stealthy, so that fontification only occurs -;; when, and where, necessary. -;; -;; See caveats and feedback below. -;; See also the fast-lock package. (But don't use them at the same time!) - -;; Installation: -;; -;; Put in your ~/.emacs: -;; -;; (setq font-lock-support-mode 'lazy-lock-mode) -;; -;; Start up a new Emacs and use font-lock as usual (except that you can use the -;; so-called "gaudier" fontification regexps on big files without frustration). -;; -;; In a buffer (which has `font-lock-mode' enabled) which is at least -;; `lazy-lock-minimum-size' characters long, buffer fontification will not -;; occur and only the visible portion of the buffer will be fontified. Motion -;; around the buffer will fontify those visible portions not previously -;; fontified. If stealth fontification is enabled, buffer fontification will -;; occur in invisible parts of the buffer after `lazy-lock-stealth-time' -;; seconds of idle time. If on-the-fly fontification is deferred, on-the-fly -;; fontification will occur after `lazy-lock-defer-time' seconds of idle time. - -;; User-visible differences with version 1: -;; -;; - Version 2 can defer on-the-fly fontification. Therefore you need not, and -;; should not, use defer-lock.el with this version of lazy-lock.el. -;; -;; A number of variables have changed meaning: -;; -;; - A value of nil for the variable `lazy-lock-minimum-size' means never turn -;; on demand-driven fontification. In version 1 this meant always turn on -;; demand-driven fontification. If you really want demand-driven fontification -;; regardless of buffer size, set this variable to 0. -;; -;; - The variable `lazy-lock-stealth-lines' cannot have a nil value. In -;; version 1 this meant use `window-height' as the maximum number of lines to -;; fontify as a stealth chunk. This makes no sense; stealth fontification is -;; of a buffer, not a window. - -;; Implementation differences with version 1: -;; -;; - Version 1 of lazy-lock.el is a bit of a hack. Version 1 demand-driven -;; fontification, the core feature of lazy-lock.el, is implemented by placing a -;; function on `post-command-hook'. This function fontifies where necessary, -;; i.e., where a window scroll has occurred. However, there are a number of -;; problems with using `post-command-hook': -;; -;; (a) As the name suggests, `post-command-hook' is run after every command, -;; i.e., frequently and regardless of whether scrolling has occurred. -;; (b) Scrolling can occur during a command, when `post-command-hook' is not -;; run, i.e., it is not necessarily run after scrolling has occurred. -;; (c) When `post-command-hook' is run, there is nothing to suggest where -;; scrolling might have occurred, i.e., which windows have scrolled. -;; -;; Thus lazy-lock.el's function is called almost as often as possible, usually -;; when it need not be called, yet it is not always called when it is needed. -;; Also, lazy-lock.el's function must check each window to see if a scroll has -;; occurred there. Worse still, lazy-lock.el's function must fontify a region -;; twice as large as necessary to make sure the window is completely fontified. -;; Basically, `post-command-hook' is completely inappropriate for lazy-lock.el. -;; -;; Ideally, we want to attach lazy-lock.el's function to a hook that is run -;; only when scrolling occurs, e.g., `window-start' has changed, and tells us -;; as much information as we need, i.e., the window and its new buffer region. -;; Richard Stallman implemented a `window-scroll-functions' for Emacs 19.30. -;; Functions on it are run when `window-start' has changed, and are supplied -;; with the window and the window's new `window-start' position. (It would be -;; better if it also supplied the window's new `window-end' position, but that -;; is calculated as part of the redisplay process, and the functions on -;; `window-scroll-functions' are run before redisplay has finished.) Thus, the -;; hook deals with the above problems (a), (b) and (c). -;; -;; If only life was that easy. Version 2 demand-driven fontification is mostly -;; implemented by placing a function on `window-scroll-functions'. However, -;; not all scrolling occurs when `window-start' has changed. A change in -;; window size, e.g., via C-x 1, or a significant deletion, e.g., of a number -;; of lines, causes text previously invisible (i.e., after `window-end') to -;; become visible without changing `window-start'. Arguably, these events are -;; not scrolling events, but fontification must occur for lazy-lock.el to work. -;; Hooks `window-size-change-functions' and `redisplay-end-trigger-functions' -;; were added for these circumstances. -;; -;; (Ben Wing thinks these hooks are "horribly horribly kludgy", and implemented -;; a `pre-idle-hook', a `mother-of-all-post-command-hooks', for XEmacs 19.14. -;; He then hacked up a version 1 lazy-lock.el to use `pre-idle-hook' rather -;; than `post-command-hook'. Whereas functions on `post-command-hook' are -;; called almost as often as possible, functions on `pre-idle-hook' really are -;; called as often as possible, even when the mouse moves and, on some systems, -;; while XEmacs is idle. Thus, the hook deals with the above problem (b), but -;; unfortunately it makes (a) worse and does not address (c) at all. -;; -;; I freely admit that `redisplay-end-trigger-functions' and, to a much lesser -;; extent, `window-size-change-functions' are not pretty. However, I feel that -;; a `window-scroll-functions' feature is cleaner than a `pre-idle-hook', and -;; the result is faster and smaller, less intrusive and more targeted, code. -;; Since `pre-idle-hook' is pretty much like `post-command-hook', there is no -;; point in making this version of lazy-lock.el work with it. Anyway, that's -;; Lit 30 of my humble opinion. -;; -;; - Version 1 stealth fontification is also implemented by placing a function -;; on `post-command-hook'. This function waits for a given amount of time, -;; and, if Emacs remains idle, fontifies where necessary. Again, there are a -;; number of problems with using `post-command-hook': -;; -;; (a) Functions on `post-command-hook' are run sequentially, so this function -;; can interfere with other functions on the hook, and vice versa. -;; (b) This function waits for a given amount of time, so it can interfere with -;; various features that are dealt with by Emacs after a command, e.g., -;; region highlighting, asynchronous updating and keystroke echoing. -;; (c) Fontification may be required during a command, when `post-command-hook' -;; is not run. (Version 2 deferred fontification only.) -;; -;; Again, `post-command-hook' is completely inappropriate for lazy-lock.el. -;; Richard Stallman and Morten Welinder implemented internal Timers and Idle -;; Timers for Emacs 19.31. Functions can be run independently at given times -;; or after given amounts of idle time. Thus, the feature deals with the above -;; problems (a), (b) and (c). Version 2 deferral and stealth are implemented -;; by functions on Idle Timers. (A function on XEmacs' `pre-idle-hook' is -;; similar to an Emacs Idle Timer function with a fixed zero second timeout.) - -;; - Version 1 has the following problems (relative to version 2): -;; -;; (a) It is slow when it does its job. -;; (b) It does not always do its job when it should. -;; (c) It slows all interaction (when it doesn't need to do its job). -;; (d) It interferes with other package functions on `post-command-hook'. -;; (e) It interferes with Emacs things within the read-eval loop. -;; -;; Ben's hacked-up lazy-lock.el 1.14 almost solved (b) but made (c) worse. -;; -;; - Version 2 has the following additional features (relative to version 1): -;; -;; (a) It can defer fontification (both on-the-fly and on-scrolling). -;; (b) It can fontify contextually (syntactically true on-the-fly). - -;; Caveats: -;; -;; Lazy Lock mode does not work efficiently with Outline mode. -;; This is because when in Outline mode, although text may be not visible to -;; you in the window, the text is visible to Emacs Lisp code (not surprisingly) -;; and Lazy Lock fontifies it mercilessly. Maybe it will be fixed one day. -;; -;; Because buffer text is not necessarily fontified, other packages that expect -;; buffer text to be fontified in Font Lock mode either might not work as -;; expected, or might not display buffer text as expected. An example of the -;; latter is `occur', which copies lines of buffer text into another buffer. -;; -;; In Emacs 19.30, Lazy Lock mode does not ensure that an existing buffer is -;; fontified if it is made visible via a minibuffer-less command that replaces -;; an existing window's buffer (e.g., via the Buffers menu). Upgrade! -;; -;; In Emacs 19.30, Lazy Lock mode does not work well with Transient Mark mode -;; or modes based on Comint mode (e.g., Shell mode), and also interferes with -;; the echoing of keystrokes in the minibuffer. This is because of the way -;; deferral and stealth have to be implemented for Emacs 19.30. Upgrade! -;; -;; Currently XEmacs does not have the features to support this version of -;; lazy-lock.el. Maybe it will one day. - -;; History: -;; -;; 1.15--2.00: -;; - Rewrite for Emacs 19.30 and the features rms added to support lazy-lock.el -;; so that it could work correctly and efficiently. -;; - Many thanks to those who reported bugs, fixed bugs, made suggestions or -;; otherwise contributed in the version 1 cycle; Jari Aalto, Kevin Broadey, -;; Ulrik Dickow, Bill Dubuque, Bob Glickstein, Boris Goldowsky, -;; Jonas Jarnestrom, David Karr, Michael Kifer, Erik Naggum, Rick Sladkey, -;; Jim Thompson, Ben Wing, Ilya Zakharevich, and Richard Stallman. -;; 2.00--2.01: -;; - Made `lazy-lock-fontify-after-command' always `sit-for' and so redisplay -;; - Use `buffer-name' not `buffer-live-p' (Bill Dubuque hint) -;; - Made `lazy-lock-install' do `add-to-list' not `setq' of `current-buffer' -;; - Made `lazy-lock-fontify-after-install' loop over buffer list -;; - Made `lazy-lock-arrange-before-change' to arrange `window-end' triggering -;; - Made `lazy-lock-let-buffer-state' wrap both `befter-change-functions' -;; - Made `lazy-lock-fontify-region' do `condition-case' (Hyman Rosen report) -;; 2.01--2.02: -;; - Use `buffer-live-p' as `buffer-name' can barf (Richard Stanton report) -;; - Made `lazy-lock-install' set `font-lock-fontified' (Kevin Davidson report) -;; - Made `lazy-lock-install' add hooks only if needed -;; - Made `lazy-lock-unstall' add `font-lock-after-change-function' if needed -;; 2.02--2.03: -;; - Made `lazy-lock-fontify-region' do `condition-case' for `quit' too -;; - Made `lazy-lock-mode' respect the value of `font-lock-inhibit-thing-lock' -;; - Added `lazy-lock-after-unfontify-buffer' -;; - Removed `lazy-lock-fontify-after-install' hack -;; - Made `lazy-lock-fontify-after-scroll' not `set-buffer' to `window-buffer' -;; - Made `lazy-lock-fontify-after-trigger' not `set-buffer' to `window-buffer' -;; - Made `lazy-lock-fontify-after-idle' be interruptible (Scott Burson hint) -;; 2.03--2.04: -;; - Rewrite for Emacs 19.31 idle timers -;; - Renamed `buffer-windows' to `get-buffer-window-list' -;; - Removed `buffer-live-p' -;; - Made `lazy-lock-defer-after-change' always save `current-buffer' -;; - Made `lazy-lock-fontify-after-defer' just process buffers -;; - Made `lazy-lock-install-hooks' add hooks correctly (Kevin Broadey report) -;; - Made `lazy-lock-install' cope if `lazy-lock-defer-time' is a list -;; 2.04--2.05: -;; - Rewrite for Common Lisp macros -;; - Added `do-while' macro -;; - Renamed `lazy-lock-let-buffer-state' macro to `save-buffer-state' -;; - Returned `lazy-lock-fontify-after-install' hack (Darren Hall hint) -;; - Added `lazy-lock-defer-on-scrolling' functionality (Scott Byer hint) -;; - Made `lazy-lock-mode' wrap `font-lock-support-mode' -;; 2.05--2.06: -;; - Made `lazy-lock-fontify-after-defer' swap correctly (Scott Byer report) -;; 2.06--2.07: -;; - Added `lazy-lock-stealth-load' functionality (Rob Hooft hint) -;; - Made `lazy-lock-unstall' call `lazy-lock-fontify-region' if needed -;; - Made `lazy-lock-mode' call `lazy-lock-unstall' only if needed -;; - Made `lazy-lock-defer-after-scroll' do `set-window-redisplay-end-trigger' -;; - Added `lazy-lock-defer-contextually' functionality -;; - Added `lazy-lock-defer-on-the-fly' from `lazy-lock-defer-time' -;; - Renamed `lazy-lock-defer-driven' to `lazy-lock-defer-on-scrolling' -;; - Removed `lazy-lock-submit-bug-report' and bade farewell -;; 2.07--2.08: -;; - Made `lazy-lock-fontify-conservatively' fontify around `window-point' -;; - Made `save-buffer-state' wrap `inhibit-point-motion-hooks' -;; - Added Custom support -;; 2.08--2.09: -;; - Removed `byte-*' variables from `eval-when-compile' (Erik Naggum hint) -;; - Made various wrapping `inhibit-point-motion-hooks' (Vinicius Latorre hint) -;; - Made `lazy-lock-fontify-after-idle' wrap `minibuffer-auto-raise' -;; - Made `lazy-lock-fontify-after-defer' paranoid about deferred buffers -;; 2.09--2.10: -;; - Use `window-end' UPDATE arg for Emacs 20.4 and later. -;; - Made deferral `widen' before unfontifying (Dan Nicolaescu report) -;; - Use `lazy-lock-fontify-after-visage' for hideshow.el (Dan Nicolaescu hint) -;; - Use `other' widget where possible (Andreas Schwab fix) -;; 2.10--2.11: -;; - Used `with-temp-message' where possible to make messages temporary. - -;;; Code: - -(require 'font-lock) -(eval-when-compile (require 'cl-lib)) - -(eval-when-compile - ;; - ;; We use this for clarity and speed. Naughty but nice. - (defmacro do-while (test &rest body) - "(do-while TEST BODY...): eval BODY... and repeat if TEST yields non-nil. -The order of execution is thus BODY, TEST, BODY, TEST and so on -until TEST returns nil." - (declare (indent 1) (debug t)) - `(while (progn ,@body ,test)))) - -(defgroup lazy-lock nil - "Font Lock support mode to fontify lazily." - :group 'font-lock) - -(defvar lazy-lock-mode nil) ; Whether we are turned on. -(defvar lazy-lock-buffers nil) ; For deferral. -(defvar lazy-lock-timers (cons nil nil)) ; For deferral and stealth. - -;; User Variables: - -(defcustom lazy-lock-minimum-size 25600 - "Minimum size of a buffer for demand-driven fontification. -On-demand fontification occurs if the buffer size is greater than this value. -If nil, means demand-driven fontification is never performed. -If a list, each element should be a cons pair of the form (MAJOR-MODE . SIZE), -where MAJOR-MODE is a symbol or t (meaning the default). For example: - ((c-mode . 25600) (c++-mode . 25600) (rmail-mode . 1048576)) -means that the minimum size is 25K for buffers in C or C++ modes, one megabyte -for buffers in Rmail mode, and size is irrelevant otherwise. - -The value of this variable is used when Lazy Lock mode is turned on." - :type '(choice (const :tag "none" nil) - (integer :tag "size") - (repeat :menu-tag "mode specific" :tag "mode specific" - :value ((t . nil)) - (cons :tag "Instance" - (radio :tag "Mode" - (const :tag "all" t) - (symbol :tag "name")) - (radio :tag "Size" - (const :tag "none" nil) - (integer :tag "size")))))) - -(defcustom lazy-lock-defer-on-the-fly t - "If non-nil, means fontification after a change should be deferred. -If nil, means on-the-fly fontification is performed. This means when changes -occur in the buffer, those areas are immediately fontified. -If a list, it should be a list of `major-mode' symbol names for which deferred -fontification should occur. The sense of the list is negated if it begins with -`not'. For example: - (c-mode c++-mode) -means that on-the-fly fontification is deferred for buffers in C and C++ modes -only, and deferral does not occur otherwise. - -The value of this variable is used when Lazy Lock mode is turned on." - :type '(choice (const :tag "never" nil) - (const :tag "always" t) - (set :menu-tag "mode specific" :tag "modes" - :value (not) - (const :tag "Except" not) - (repeat :inline t (symbol :tag "mode"))))) - -(defcustom lazy-lock-defer-on-scrolling nil - "If non-nil, means fontification after a scroll should be deferred. -If nil, means demand-driven fontification is performed. This means when -scrolling into unfontified areas of the buffer, those areas are immediately -fontified. Thus scrolling never presents unfontified areas. However, since -fontification occurs during scrolling, scrolling may be slow. -If t, means defer-driven fontification is performed. This means fontification -of those areas is deferred. Thus scrolling may present momentarily unfontified -areas. However, since fontification does not occur during scrolling, scrolling -will be faster than demand-driven fontification. -If any other value, e.g., `eventually', means demand-driven fontification is -performed until the buffer is fontified, then buffer fontification becomes -defer-driven. Thus scrolling never presents unfontified areas until the buffer -is first fontified, after which subsequent scrolling may present future buffer -insertions momentarily unfontified. However, since fontification does not -occur during scrolling after the buffer is first fontified, scrolling will -become faster. (But, since contextual changes continually occur, such a value -makes little sense if `lazy-lock-defer-contextually' is non-nil.) - -The value of this variable is used when Lazy Lock mode is turned on." - :type '(choice (const :tag "never" nil) - (const :tag "always" t) - (other :tag "eventually" eventually))) - -(defcustom lazy-lock-defer-contextually 'syntax-driven - "If non-nil, means deferred fontification should be syntactically true. -If nil, means deferred fontification occurs only on those lines modified. This -means where modification on a line causes syntactic change on subsequent lines, -those subsequent lines are not refontified to reflect their new context. -If t, means deferred fontification occurs on those lines modified and all -subsequent lines. This means those subsequent lines are refontified to reflect -their new syntactic context, either immediately or when scrolling into them. -If any other value, e.g., `syntax-driven', means deferred syntactically true -fontification occurs only if syntactic fontification is performed using the -buffer mode's syntax table, i.e., only if `font-lock-keywords-only' is nil. - -The value of this variable is used when Lazy Lock mode is turned on." - :type '(choice (const :tag "never" nil) - (const :tag "always" t) - (other :tag "syntax-driven" syntax-driven))) - -(defcustom lazy-lock-defer-time 0.25 - "Time in seconds to delay before beginning deferred fontification. -Deferred fontification occurs if there is no input within this time. -If nil, means fontification is never deferred, regardless of the values of the -variables `lazy-lock-defer-on-the-fly', `lazy-lock-defer-on-scrolling' and -`lazy-lock-defer-contextually'. - -The value of this variable is used when Lazy Lock mode is turned on." - :type '(choice (const :tag "never" nil) - (number :tag "seconds"))) - -(defcustom lazy-lock-stealth-time 30 - "Time in seconds to delay before beginning stealth fontification. -Stealth fontification occurs if there is no input within this time. -If nil, means stealth fontification is never performed. - -The value of this variable is used when Lazy Lock mode is turned on." - :type '(choice (const :tag "never" nil) - (number :tag "seconds"))) - -(defcustom lazy-lock-stealth-lines (if font-lock-maximum-decoration 100 250) - "Maximum size of a chunk of stealth fontification. -Each iteration of stealth fontification can fontify this number of lines. -To speed up input response during stealth fontification, at the cost of stealth -taking longer to fontify, you could reduce the value of this variable." - :type '(integer :tag "lines")) - -(defcustom lazy-lock-stealth-load - (if (condition-case nil (load-average) (error)) 200) - "Load in percentage above which stealth fontification is suspended. -Stealth fontification pauses when the system short-term load average (as -returned by the function `load-average' if supported) goes above this level, -thus reducing the demand that stealth fontification makes on the system. -If nil, means stealth fontification is never suspended. -To reduce machine load during stealth fontification, at the cost of stealth -taking longer to fontify, you could reduce the value of this variable. -See also `lazy-lock-stealth-nice'." - :type (if (condition-case nil (load-average) (error)) - '(choice (const :tag "never" nil) - (integer :tag "load")) - '(const :format "%t: unsupported\n" nil))) - -(defcustom lazy-lock-stealth-nice 0.125 - "Time in seconds to pause between chunks of stealth fontification. -Each iteration of stealth fontification is separated by this amount of time, -thus reducing the demand that stealth fontification makes on the system. -If nil, means stealth fontification is never paused. -To reduce machine load during stealth fontification, at the cost of stealth -taking longer to fontify, you could increase the value of this variable. -See also `lazy-lock-stealth-load'." - :type '(choice (const :tag "never" nil) - (number :tag "seconds"))) - -(defcustom lazy-lock-stealth-verbose - (and (not lazy-lock-defer-contextually) (not (null font-lock-verbose))) - "If non-nil, means stealth fontification should show status messages." - :type 'boolean) - -;; User Functions: - -;;;###autoload -(defun lazy-lock-mode (&optional arg) - "Toggle Lazy Lock mode. -With arg, turn Lazy Lock mode on if and only if arg is positive. Enable it -automatically in your `~/.emacs' by: - - (setq font-lock-support-mode \\='lazy-lock-mode) - -For a newer font-lock support mode with similar functionality, see -`jit-lock-mode'. Eventually, Lazy Lock mode will be deprecated in -JIT Lock's favor. - -When Lazy Lock mode is enabled, fontification can be lazy in a number of ways: - -- Demand-driven buffer fontification if `lazy-lock-minimum-size' is non-nil. - This means initial fontification does not occur if the buffer is greater than - `lazy-lock-minimum-size' characters in length. Instead, fontification occurs - when necessary, such as when scrolling through the buffer would otherwise - reveal unfontified areas. This is useful if buffer fontification is too slow - for large buffers. - -- Deferred scroll fontification if `lazy-lock-defer-on-scrolling' is non-nil. - This means demand-driven fontification does not occur as you scroll. - Instead, fontification is deferred until after `lazy-lock-defer-time' seconds - of Emacs idle time, while Emacs remains idle. This is useful if - fontification is too slow to keep up with scrolling. - -- Deferred on-the-fly fontification if `lazy-lock-defer-on-the-fly' is non-nil. - This means on-the-fly fontification does not occur as you type. Instead, - fontification is deferred until after `lazy-lock-defer-time' seconds of Emacs - idle time, while Emacs remains idle. This is useful if fontification is too - slow to keep up with your typing. - -- Deferred context fontification if `lazy-lock-defer-contextually' is non-nil. - This means fontification updates the buffer corresponding to true syntactic - context, after `lazy-lock-defer-time' seconds of Emacs idle time, while Emacs - remains idle. Otherwise, fontification occurs on modified lines only, and - subsequent lines can remain fontified corresponding to previous syntactic - contexts. This is useful where strings or comments span lines. - -- Stealthy buffer fontification if `lazy-lock-stealth-time' is non-nil. - This means remaining unfontified areas of buffers are fontified if Emacs has - been idle for `lazy-lock-stealth-time' seconds, while Emacs remains idle. - This is useful if any buffer has any deferred fontification. - -Basic Font Lock mode on-the-fly fontification behavior fontifies modified -lines only. Thus, if `lazy-lock-defer-contextually' is non-nil, Lazy Lock mode -on-the-fly fontification may fontify differently, albeit correctly. In any -event, to refontify some lines you can use \\[font-lock-fontify-block]. - -Stealth fontification only occurs while the system remains unloaded. -If the system load rises above `lazy-lock-stealth-load' percent, stealth -fontification is suspended. Stealth fontification intensity is controlled via -the variable `lazy-lock-stealth-nice' and `lazy-lock-stealth-lines', and -verbosity is controlled via the variable `lazy-lock-stealth-verbose'." - (interactive "P") - (let* ((was-on lazy-lock-mode) - (now-on (unless (memq 'lazy-lock-mode font-lock-inhibit-thing-lock) - (if arg (> (prefix-numeric-value arg) 0) (not was-on))))) - (cond ((and now-on (not font-lock-mode)) - ;; Turned on `lazy-lock-mode' rather than `font-lock-mode'. - (message "Use font-lock-support-mode rather than calling lazy-lock-mode") - (sit-for 2)) - (now-on - ;; Turn ourselves on. - (set (make-local-variable 'lazy-lock-mode) t) - (lazy-lock-install)) - (was-on - ;; Turn ourselves off. - (set (make-local-variable 'lazy-lock-mode) nil) - (lazy-lock-unstall))))) - -;;;###autoload -(defun turn-on-lazy-lock () - "Unconditionally turn on Lazy Lock mode." - (lazy-lock-mode t)) - -(defun lazy-lock-install () - (let ((min-size (font-lock-value-in-major-mode lazy-lock-minimum-size)) - (defer-change (and lazy-lock-defer-time lazy-lock-defer-on-the-fly)) - (defer-scroll (and lazy-lock-defer-time lazy-lock-defer-on-scrolling)) - (defer-context (and lazy-lock-defer-time lazy-lock-defer-contextually - (or (eq lazy-lock-defer-contextually t) - (null font-lock-keywords-only))))) - ;; - ;; Tell Font Lock whether Lazy Lock will do fontification. - (make-local-variable 'font-lock-fontified) - (setq font-lock-fontified (and min-size (>= (buffer-size) min-size))) - ;; - ;; Add the text properties and fontify. - (if (not font-lock-fontified) - (lazy-lock-after-fontify-buffer) - ;; Make sure we fontify in any existing windows showing the buffer. - (let ((windows (get-buffer-window-list (current-buffer) 'nomini t))) - (lazy-lock-after-unfontify-buffer) - (while windows - (lazy-lock-fontify-conservatively (car windows)) - (setq windows (cdr windows))))) - ;; - ;; Add the fontification hooks. - (lazy-lock-install-hooks - font-lock-fontified - (cond ((eq (car-safe defer-change) 'not) - (not (memq major-mode (cdr defer-change)))) - ((listp defer-change) - (memq major-mode defer-change)) - (t - defer-change)) - (eq defer-scroll t) - defer-context) - ;; - ;; Add the fontification timers. - (lazy-lock-install-timers - (if (or defer-change defer-scroll defer-context) lazy-lock-defer-time) - lazy-lock-stealth-time))) - -(defun lazy-lock-install-hooks (fontifying - defer-change defer-scroll defer-context) - ;; - ;; Add hook if lazy-lock.el is fontifying on scrolling or is deferring. - (when (or fontifying defer-change defer-scroll defer-context) - (add-hook 'window-scroll-functions (if defer-scroll - #'lazy-lock-defer-after-scroll - #'lazy-lock-fontify-after-scroll) - nil t)) - ;; - ;; Add hook if lazy-lock.el is fontifying and is not deferring changes. - (when (and fontifying (not defer-change) (not defer-context)) - (add-hook 'before-change-functions #'lazy-lock-arrange-before-change nil t)) - ;; - ;; Replace Font Lock mode hook. - (remove-hook 'after-change-functions #'font-lock-after-change-function t) - (add-hook 'after-change-functions - (cond ((and defer-change defer-context) - #'lazy-lock-defer-rest-after-change) - (defer-change - #'lazy-lock-defer-line-after-change) - (defer-context - #'lazy-lock-fontify-rest-after-change) - (t - #'lazy-lock-fontify-line-after-change)) - nil t) - ;; - ;; Add package-specific hook. - (add-hook 'outline-view-change-hook #'lazy-lock-fontify-after-visage nil t) - (add-hook 'hs-hide-hook #'lazy-lock-fontify-after-visage nil t)) - -(defun lazy-lock-install-timers (dtime stime) - ;; Schedule or re-schedule the deferral and stealth timers. - ;; The layout of `lazy-lock-timers' is: - ;; ((DEFER-TIME . DEFER-TIMER) (STEALTH-TIME . STEALTH-TIMER) - ;; If an idle timeout has changed, cancel the existing idle timer (if there - ;; is one) and schedule a new one (if the new idle timeout is non-nil). - (unless (eq dtime (car (car lazy-lock-timers))) - (let ((defer (car lazy-lock-timers))) - (when (cdr defer) - (cancel-timer (cdr defer))) - (setcar lazy-lock-timers (cons dtime (and dtime - (run-with-idle-timer dtime t #'lazy-lock-fontify-after-defer)))))) - (unless (eq stime (car (cdr lazy-lock-timers))) - (let ((stealth (cdr lazy-lock-timers))) - (when (cdr stealth) - (cancel-timer (cdr stealth))) - (setcdr lazy-lock-timers (cons stime (and stime - (run-with-idle-timer stime t #'lazy-lock-fontify-after-idle))))))) - -(defun lazy-lock-unstall () - ;; - ;; If Font Lock mode is still enabled, make sure that the buffer is - ;; fontified, and reinstall its hook. We must do this first. - (when font-lock-mode - (when (lazy-lock-unfontified-p) - (let ((verbose (if (numberp font-lock-verbose) - (> (buffer-size) font-lock-verbose) - font-lock-verbose))) - (with-temp-message - (when verbose - (format "Fontifying %s..." (buffer-name))) - ;; Make sure we fontify etc. in the whole buffer. - (save-restriction - (widen) - (lazy-lock-fontify-region (point-min) (point-max)))))) - (add-hook 'after-change-functions #'font-lock-after-change-function nil t)) - ;; - ;; Remove the text properties. - (lazy-lock-after-unfontify-buffer) - ;; - ;; Remove the fontification hooks. - (remove-hook 'window-scroll-functions #'lazy-lock-fontify-after-scroll t) - (remove-hook 'window-scroll-functions #'lazy-lock-defer-after-scroll t) - (remove-hook 'before-change-functions #'lazy-lock-arrange-before-change t) - (remove-hook 'after-change-functions #'lazy-lock-fontify-line-after-change t) - (remove-hook 'after-change-functions #'lazy-lock-fontify-rest-after-change t) - (remove-hook 'after-change-functions #'lazy-lock-defer-line-after-change t) - (remove-hook 'after-change-functions #'lazy-lock-defer-rest-after-change t) - (remove-hook 'outline-view-change-hook #'lazy-lock-fontify-after-visage t) - (remove-hook 'hs-hide-hook #'lazy-lock-fontify-after-visage t)) - -;; Hook functions. - -;; Lazy Lock mode intervenes when (1) a previously invisible buffer region -;; becomes visible, i.e., for demand- or defer-driven on-the-scroll -;; fontification, (2) a buffer modification occurs, i.e., for defer-driven -;; on-the-fly fontification, (3) Emacs becomes idle, i.e., for fontification of -;; deferred fontification and stealth fontification, and (4) other special -;; occasions. - -;; 1. There are three ways whereby this can happen. -;; -;; (a) Scrolling the window, either explicitly (e.g., `scroll-up') or -;; implicitly (e.g., `search-forward'). Here, `window-start' changes. -;; Fontification occurs by adding `lazy-lock-fontify-after-scroll' (for -;; demand-driven fontification) or `lazy-lock-defer-after-scroll' (for -;; defer-driven fontification) to the hook `window-scroll-functions'. - -(defun lazy-lock-fontify-after-scroll (window window-start) - ;; Called from `window-scroll-functions'. - ;; Fontify WINDOW from WINDOW-START following the scroll. - (let ((inhibit-point-motion-hooks t)) - (lazy-lock-fontify-region window-start (window-end window t))) - ;; A prior deletion that did not cause scrolling, followed by a scroll, would - ;; result in an unnecessary trigger after this if we did not cancel it now. - (set-window-redisplay-end-trigger window nil)) - -(defun lazy-lock-defer-after-scroll (window _window-start) - ;; Called from `window-scroll-functions'. - ;; Defer fontification following the scroll. Save the current buffer so that - ;; we subsequently fontify in all windows showing the buffer. - (unless (memq (current-buffer) lazy-lock-buffers) - (push (current-buffer) lazy-lock-buffers)) - ;; A prior deletion that did not cause scrolling, followed by a scroll, would - ;; result in an unnecessary trigger after this if we did not cancel it now. - (set-window-redisplay-end-trigger window nil)) - -;; (b) Resizing the window, either explicitly (e.g., `enlarge-window') or -;; implicitly (e.g., `delete-other-windows'). Here, `window-end' changes. -;; Fontification occurs by adding `lazy-lock-fontify-after-resize' to the -;; hook `window-size-change-functions'. - -(defun lazy-lock-fontify-after-resize (frame) - ;; Called from `window-size-change-functions'. - ;; Fontify windows in FRAME following the resize. We cannot use - ;; `window-start' or `window-end' so we fontify conservatively. - (save-excursion - (save-selected-window - (select-frame frame) - (walk-windows (function (lambda (window) - (set-buffer (window-buffer window)) - (when lazy-lock-mode - (lazy-lock-fontify-conservatively window)) - (set-window-redisplay-end-trigger window nil))) - 'nomini frame)))) - -;; (c) Deletion in the buffer. Here, a `window-end' marker can become visible. -;; Fontification occurs by adding `lazy-lock-arrange-before-change' to -;; `before-change-functions' and `lazy-lock-fontify-after-trigger' to the -;; hook `redisplay-end-trigger-functions'. Before every deletion, the -;; marker `window-redisplay-end-trigger' position is set to the soon-to-be -;; changed `window-end' position. If the marker becomes visible, -;; `lazy-lock-fontify-after-trigger' gets called. Ouch. Note that we only -;; have to deal with this eventuality if there is no on-the-fly deferral. - -(defun lazy-lock-arrange-before-change (beg end) - ;; Called from `before-change-functions'. - ;; Arrange that if text becomes visible it will be fontified (if a deletion - ;; is pending, text might become visible at the bottom). - (unless (eq beg end) - (let ((windows (get-buffer-window-list (current-buffer) 'nomini t)) window) - (while windows - (setq window (car windows)) - (unless (markerp (window-redisplay-end-trigger window)) - (set-window-redisplay-end-trigger window (make-marker))) - (set-marker (window-redisplay-end-trigger window) (window-end window)) - (setq windows (cdr windows)))))) - -(defun lazy-lock-fontify-after-trigger (window trigger-point) - ;; Called from `redisplay-end-trigger-functions'. - ;; Fontify WINDOW from TRIGGER-POINT following the redisplay. - ;; We could probably just use `lazy-lock-fontify-after-scroll' without loss: - ;; (inline (lazy-lock-fontify-after-scroll window (window-start window))) - (let ((inhibit-point-motion-hooks t)) - (lazy-lock-fontify-region trigger-point (window-end window t)))) - -;; 2. Modified text must be marked as unfontified so it can be identified and -;; fontified later when Emacs is idle. Deferral occurs by adding one of -;; `lazy-lock-fontify-*-after-change' (for on-the-fly fontification) or -;; `lazy-lock-defer-*-after-change' (for deferred fontification) to the -;; hook `after-change-functions'. - -(defalias 'lazy-lock-fontify-line-after-change - ;; Called from `after-change-functions'. - ;; Fontify the current change. - #'font-lock-after-change-function) - -(defun lazy-lock-fontify-rest-after-change (beg end old-len) - ;; Called from `after-change-functions'. - ;; Fontify the current change and defer fontification of the rest of the - ;; buffer. Save the current buffer so that we subsequently fontify in all - ;; windows showing the buffer. - (lazy-lock-fontify-line-after-change beg end old-len) - (with-silent-modifications - (unless (memq (current-buffer) lazy-lock-buffers) - (push (current-buffer) lazy-lock-buffers)) - (save-restriction - (widen) - (remove-text-properties end (point-max) '(lazy-lock nil))))) - -(defun lazy-lock-defer-line-after-change (beg end _old-len) - ;; Called from `after-change-functions'. - ;; Defer fontification of the current change. Save the current buffer so - ;; that we subsequently fontify in all windows showing the buffer. - (with-silent-modifications - (unless (memq (current-buffer) lazy-lock-buffers) - (push (current-buffer) lazy-lock-buffers)) - (remove-text-properties (max (1- beg) (point-min)) - (min (1+ end) (point-max)) - '(lazy-lock nil)))) - -(defun lazy-lock-defer-rest-after-change (beg _end _old-len) - ;; Called from `after-change-functions'. - ;; Defer fontification of the rest of the buffer. Save the current buffer so - ;; that we subsequently fontify in all windows showing the buffer. - (with-silent-modifications - (unless (memq (current-buffer) lazy-lock-buffers) - (push (current-buffer) lazy-lock-buffers)) - (save-restriction - (widen) - (remove-text-properties (max (1- beg) (point-min)) - (point-max) - '(lazy-lock nil))))) - -;; 3. Deferred fontification and stealth fontification are done from these two -;; functions. They are set up as Idle Timers. - -(defun lazy-lock-fontify-after-defer () - ;; Called from `timer-idle-list'. - ;; Fontify all windows where deferral has occurred for its buffer. - (save-excursion - (while (and lazy-lock-buffers (not (input-pending-p))) - (let ((buffer (car lazy-lock-buffers)) windows) - ;; Paranoia: check that the buffer is still live and Lazy Lock mode on. - (when (buffer-live-p buffer) - (set-buffer buffer) - (when lazy-lock-mode - (setq windows (get-buffer-window-list buffer 'nomini t)) - (while windows - (lazy-lock-fontify-window (car windows)) - (setq windows (cdr windows))))) - (setq lazy-lock-buffers (cdr lazy-lock-buffers))))) - ;; Add hook if fontification should now be defer-driven in this buffer. - (when (and lazy-lock-mode lazy-lock-defer-on-scrolling - (memq #'lazy-lock-fontify-after-scroll window-scroll-functions) - (not (or (input-pending-p) (lazy-lock-unfontified-p)))) - (remove-hook 'window-scroll-functions #'lazy-lock-fontify-after-scroll t) - (add-hook 'window-scroll-functions #'lazy-lock-defer-after-scroll nil t))) - -(defun lazy-lock-fontify-after-idle () - ;; Called from `timer-idle-list'. - ;; Fontify all buffers that need it, stealthily while idle. - (unless (or executing-kbd-macro (window-minibuffer-p (selected-window))) - ;; Loop over all buffers, fontify stealthily for each if necessary. - (let ((buffers (buffer-list)) (continue t) - message message-log-max minibuffer-auto-raise) - (save-excursion - (do-while (and buffers continue) - (set-buffer (car buffers)) - (if (not (and lazy-lock-mode (lazy-lock-unfontified-p))) - (setq continue (not (input-pending-p))) - ;; Fontify regions in this buffer while there is no input. - (with-temp-message - (when lazy-lock-stealth-verbose - "Fontifying stealthily...") - (do-while (and (lazy-lock-unfontified-p) continue) - (if (and lazy-lock-stealth-load - (> (car (load-average)) lazy-lock-stealth-load)) - ;; Wait a while before continuing with the loop. - (progn - (when message - (message "Fontifying stealthily...suspended") - (setq message nil)) - (setq continue (sit-for (or lazy-lock-stealth-time 30)))) - ;; Fontify a chunk. - (when lazy-lock-stealth-verbose - (if message - (message "Fontifying stealthily... %2d%% of %s" - (lazy-lock-percent-fontified) (buffer-name)) - (message "Fontifying stealthily...") - (setq message t))) - ;; Current buffer may have changed during `sit-for'. - (set-buffer (car buffers)) - (lazy-lock-fontify-chunk) - (setq continue (sit-for (or lazy-lock-stealth-nice 0))))))) - (setq buffers (cdr buffers))))))) - -;; 4. Special circumstances. - -(defun lazy-lock-fontify-after-visage () - ;; Called from `outline-view-change-hook' and `hs-hide-hook'. - ;; Fontify windows showing the current buffer, as its visibility has changed. - ;; This is a conspiracy hack between lazy-lock.el, outline.el and - ;; hideshow.el. - (let ((windows (get-buffer-window-list (current-buffer) 'nomini t))) - (while windows - (lazy-lock-fontify-conservatively (car windows)) - (setq windows (cdr windows))))) - -(defun lazy-lock-after-fontify-buffer () - ;; Called from `font-lock-after-fontify-buffer'. - ;; Mark the current buffer as fontified. - ;; This is a conspiracy hack between lazy-lock.el and font-lock.el. - (with-silent-modifications - (add-text-properties (point-min) (point-max) '(lazy-lock t)))) - -(defun lazy-lock-after-unfontify-buffer () - ;; Called from `font-lock-after-unfontify-buffer'. - ;; Mark the current buffer as unfontified. - ;; This is a conspiracy hack between lazy-lock.el and font-lock.el. - (with-silent-modifications - (remove-text-properties (point-min) (point-max) '(lazy-lock nil)))) - -;; Fontification functions. - -;; If packages want to ensure that some region of the buffer is fontified, they -;; should use this function. For an example, see ps-print.el. -(defun lazy-lock-fontify-region (beg end) - ;; Fontify between BEG and END, where necessary, in the current buffer. - (save-restriction - (widen) - (when (setq beg (text-property-any beg end 'lazy-lock nil)) - (save-excursion - (with-silent-modifications - (let ((inhibit-point-motion-hooks t)) - ;; Find successive unfontified regions between BEG and END. - (condition-case data - (do-while beg - (let ((next (or (text-property-any beg end 'lazy-lock t) - end))) - ;; Make sure the region end points are at beginning of line. - (goto-char beg) - (unless (bolp) - (beginning-of-line) - (setq beg (point))) - (goto-char next) - (unless (bolp) - (forward-line) - (setq next (point))) - ;; Fontify the region, then flag it as fontified. - (font-lock-fontify-region beg next) - (add-text-properties beg next '(lazy-lock t)) - (setq beg (text-property-any next end 'lazy-lock nil)))) - ((error quit) (message "Fontifying region...%s" data))))))))) - -(defun lazy-lock-fontify-chunk () - ;; Fontify the nearest chunk, for stealth, in the current buffer. - (let ((inhibit-point-motion-hooks t)) - (save-excursion - (save-restriction - (widen) - ;; Move to end of line in case the character at point is not fontified. - (end-of-line) - ;; Find where the previous (next) unfontified regions end (begin). - (let ((prev (previous-single-property-change (point) 'lazy-lock)) - (next (text-property-any (point) (point-max) 'lazy-lock nil))) - ;; Fontify from the nearest unfontified position. - (if (or (null prev) (and next (< (- next (point)) (- (point) prev)))) - ;; The next, or neither, region is the nearest not fontified. - (lazy-lock-fontify-region - (progn (goto-char (or next (point-min))) - (beginning-of-line) - (point)) - (progn (goto-char (or next (point-min))) - (forward-line lazy-lock-stealth-lines) - (point))) - ;; The previous region is the nearest not fontified. - (lazy-lock-fontify-region - (progn (goto-char prev) - (forward-line (- lazy-lock-stealth-lines)) - (point)) - (progn (goto-char prev) - (forward-line) - (point))))))))) - -(defun lazy-lock-fontify-window (window) - ;; Fontify in WINDOW between `window-start' and `window-end'. - ;; We can only do this when we can use `window-start' and `window-end'. - (with-current-buffer (window-buffer window) - (lazy-lock-fontify-region (window-start window) (window-end window)))) - -(defun lazy-lock-fontify-conservatively (window) - ;; Fontify in WINDOW conservatively around point. - ;; Where we cannot use `window-start' and `window-end' we do `window-height' - ;; lines around point. That way we guarantee to have done enough. - (with-current-buffer (window-buffer window) - (let ((inhibit-point-motion-hooks t)) - (lazy-lock-fontify-region - (save-excursion - (goto-char (window-point window)) - (vertical-motion (- (window-height window)) window) (point)) - (save-excursion - (goto-char (window-point window)) - (vertical-motion (window-height window) window) (point)))))) - -(defun lazy-lock-unfontified-p () - ;; Return non-nil if there is anywhere still to be fontified. - (save-restriction - (widen) - (text-property-any (point-min) (point-max) 'lazy-lock nil))) - -(defun lazy-lock-percent-fontified () - ;; Return the percentage (of characters) of the buffer that are fontified. - (save-restriction - (widen) - (let ((beg (point-min)) (size 0) next) - ;; Find where the next fontified region begins. - (while (setq beg (text-property-any beg (point-max) 'lazy-lock t)) - (setq next (or (text-property-any beg (point-max) 'lazy-lock nil) - (point-max))) - (cl-incf size (- next beg)) - (setq beg next)) - ;; Float because using integer multiplication will frequently overflow. - (truncate (* (/ (float size) (point-max)) 100))))) - -;; Version dependent workarounds and fixes. - -(when (consp lazy-lock-defer-time) - ;; - ;; In 2.06.04 and below, `lazy-lock-defer-time' could specify modes and time. - (with-output-to-temp-buffer "*Help*" - (princ "The value of the variable `lazy-lock-defer-time' was\n ") - (princ lazy-lock-defer-time) - (princ "\n") - (princ "This variable cannot now be a list of modes and time,\n") - (princ "so instead use ") - (princ (substitute-command-keys "\\[customize-option]")) - (princ " to modify the variables, or put the forms:\n") - (princ " (setq lazy-lock-defer-time ") - (princ (cdr lazy-lock-defer-time)) - (princ ")\n") - (princ " (setq lazy-lock-defer-on-the-fly '") - (princ (car lazy-lock-defer-time)) - (princ ")\n") - (princ "in your ~/.emacs. ") - (princ "The above forms have been evaluated for this editor session,\n") - (princ "but you should use ") - (princ (substitute-command-keys "\\[customize-option]")) - (princ " or change your ~/.emacs now.")) - (setq lazy-lock-defer-on-the-fly (car lazy-lock-defer-time) - lazy-lock-defer-time (cdr lazy-lock-defer-time))) - -(when (boundp 'lazy-lock-defer-driven) - ;; - ;; In 2.06.04 and below, `lazy-lock-defer-driven' was the variable name. - (with-output-to-temp-buffer "*Help*" - (princ "The value of the variable `lazy-lock-defer-driven' is set to ") - (if (memq lazy-lock-defer-driven '(nil t)) - (princ lazy-lock-defer-driven) - (princ "`") - (princ lazy-lock-defer-driven) - (princ "'")) - (princ ".\n") - (princ "This variable is now called `lazy-lock-defer-on-scrolling',\n") - (princ "so instead use ") - (princ (substitute-command-keys "\\[customize-option]")) - (princ " to modify the variable, or put the form:\n") - (princ " (setq lazy-lock-defer-on-scrolling ") - (unless (memq lazy-lock-defer-driven '(nil t)) - (princ "'")) - (princ lazy-lock-defer-driven) - (princ ")\n") - (princ "in your ~/.emacs. ") - (princ "The above form has been evaluated for this editor session,\n") - (princ "but you should use ") - (princ (substitute-command-keys "\\[customize-option]")) - (princ " or change your ~/.emacs now.")) - (setq lazy-lock-defer-on-scrolling lazy-lock-defer-driven)) - -;; Install ourselves: - -(add-hook 'window-size-change-functions #'lazy-lock-fontify-after-resize) -(add-hook 'redisplay-end-trigger-functions #'lazy-lock-fontify-after-trigger) - -(unless (assq 'lazy-lock-mode minor-mode-alist) - (setq minor-mode-alist (append minor-mode-alist '((lazy-lock-mode nil))))) - -(provide 'lazy-lock) - -;; Local Variables: -;; byte-compile-warnings: (not obsolete) -;; End: - -;;; lazy-lock.el ends here commit 977aed9f7981fee0ba9ac8711a86da908fc5057e Author: Po Lu Date: Thu Jul 28 13:24:10 2022 +0000 Fix grab view persisting on Haiku after popup menu closes * src/haiku_support.cc (BasicMouseUp): Improve handling of wait_for_release_message. (be_clear_grab_view): New function. * src/haiku_support.h: Update prototypes. * src/haikumenu.c (haiku_menu_show): Call it here. diff --git a/src/haiku_support.cc b/src/haiku_support.cc index cb378d2d81..b7590f68a4 100644 --- a/src/haiku_support.cc +++ b/src/haiku_support.cc @@ -1930,11 +1930,14 @@ class EmacsView : public BView button = (grabbed_buttons & ~buttons); grabbed_buttons = buttons; - if (!grabbed_buttons && wait_for_release_message) + if (wait_for_release_message) { - wait_for_release_message->SendReply (wait_for_release_message); - delete wait_for_release_message; - wait_for_release_message = NULL; + if (!grabbed_buttons) + { + wait_for_release_message->SendReply (wait_for_release_message); + delete wait_for_release_message; + wait_for_release_message = NULL; + } return; } @@ -5457,3 +5460,17 @@ be_get_explicit_workarea (int *x, int *y, int *width, int *height) return true; } + +/* Clear the grab view. This has to be called manually from some + places, since we don't get B_MOUSE_UP messages after a popup menu + is run. */ + +void +be_clear_grab_view (void) +{ + if (grab_view_locker.Lock ()) + { + grab_view = NULL; + grab_view_locker.Unlock (); + } +} diff --git a/src/haiku_support.h b/src/haiku_support.h index 5577d2f151..76fe071f2c 100644 --- a/src/haiku_support.h +++ b/src/haiku_support.h @@ -727,6 +727,7 @@ extern void be_set_window_fullscreen_mode (void *, enum haiku_fullscreen_mode); extern void be_lock_window (void *); extern void be_unlock_window (void *); extern bool be_get_explicit_workarea (int *, int *, int *, int *); +extern void be_clear_grab_view (void); #ifdef __cplusplus } diff --git a/src/haikumenu.c b/src/haikumenu.c index 929ed95210..69bb56c124 100644 --- a/src/haikumenu.c +++ b/src/haikumenu.c @@ -432,6 +432,11 @@ haiku_menu_show (struct frame *f, int x, int y, int menuflags, FRAME_DISPLAY_INFO (f)->grabbed = 0; + /* Clear the grab view manually. There is a race condition here if + the window thread receives a button press between here and the + end of BMenu_run. */ + be_clear_grab_view (); + if (menu_item_selection) { prefix = entry = Qnil; commit b8fdef7aa65f5b1d2eeb726ff1627d9e169c2b3a Author: Stefan Kangas Date: Thu Jul 28 14:38:24 2022 +0200 Convert ffap comments to tests * test/lisp/ffap-tests.el (ffap-file-remote-p, ffap-machine-p): New tests. diff --git a/lisp/ffap.el b/lisp/ffap.el index dc286db130..ffed9f9759 100644 --- a/lisp/ffap.el +++ b/lisp/ffap.el @@ -427,13 +427,6 @@ Returned values: t means that HOST answered. `accept' means the relevant variable told us to accept. \"mesg\" means HOST exists, but does not respond for some reason." - ;; Try some (Emory local): - ;; (ffap-machine-p "ftp" nil nil 'ping) - ;; (ffap-machine-p "nonesuch" nil nil 'ping) - ;; (ffap-machine-p "ftp.mathcs.emory.edu" nil nil 'ping) - ;; (ffap-machine-p "mathcs" 5678 nil 'ping) - ;; (ffap-machine-p "foo.bonk" nil nil 'ping) - ;; (ffap-machine-p "foo.bonk.com" nil nil 'ping) (if (or (string-match "[^-[:alnum:].]" host) ; Invalid chars (?) (not (string-match "[^0-9]" host))) ; 1: a number? 2: quick reject nil @@ -530,9 +523,6 @@ The optional NOMODIFY argument suppresses the extra search." (defun ffap-file-remote-p (filename) "If FILENAME looks remote, return it (maybe slightly improved)." - ;; (ffap-file-remote-p "/user@foo.bar.com:/pub") - ;; (ffap-file-remote-p "/cssun.mathcs.emory.edu://dir") - ;; (ffap-file-remote-p "/ffap.el:80") (or (and ffap-ftp-regexp (string-match ffap-ftp-regexp filename) ;; Convert "/host.com://dir" to "/host:/dir", to handle a dying @@ -573,7 +563,7 @@ Looks at `ffap-ftp-default-user', returns \"\" for \"localhost\"." ;; www.ncsa.uiuc.edu ((and (string-match "\\`w\\(ww\\|eb\\)[-.]" mach)) (concat "http://" mach "/")) - ;; More cases? Maybe "telnet:" for archie? + ;; More cases? (ffap-ftp-regexp (ffap-host-to-filename mach)) )) diff --git a/test/lisp/ffap-tests.el b/test/lisp/ffap-tests.el index a11af9507e..076d825642 100644 --- a/test/lisp/ffap-tests.el +++ b/test/lisp/ffap-tests.el @@ -33,6 +33,25 @@ (ffap-replace-file-component "/ftp:who@foo.com:/whatever" "/new") "/ftp:who@foo.com:/new"))) +(ert-deftest ffap-file-remote-p () + (dolist (test '(("/user@foo.bar.com:/pub" . + "/user@foo.bar.com:/pub") + ("/cssun.mathcs.emory.edu://dir" . + "/cssun.mathcs.emory.edu:/dir") + ("/ffap.el:80" . + "/ffap.el:80"))) + (let ((A (car test)) + (B (cdr test))) + (should (equal (ffap-file-remote-p A) B))))) + +(ert-deftest ffap-machine-p () + (should-not (ffap-machine-p "ftp")) + (should-not (ffap-machine-p "nonesuch")) + (should (eq (ffap-machine-p "ftp.mathcs.emory.edu") 'accept)) + (should-not (ffap-machine-p "mathcs" 5678)) + (should-not (ffap-machine-p "foo.bonk")) + (should (eq (ffap-machine-p "foo.bonk.com") 'accept))) + (ert-deftest ffap-tests-25243 () "Test for https://debbugs.gnu.org/25243 ." (ert-with-temp-file file commit 38e7400a8c1feaba4362c3d7ab9d44d360a1fac6 Author: Stefan Kangas Date: Thu Jul 28 14:20:56 2022 +0200 ; Delete LCD Archive entries * lisp/emacs-lisp/advice.el: * lisp/emacs-lisp/trace.el: * lisp/mail/feedmail.el: * lisp/mail/supercite.el: Delete entries for the defunct LCD Archive. diff --git a/lisp/emacs-lisp/advice.el b/lisp/emacs-lisp/advice.el index 86a42b208e..2a2bcca700 100644 --- a/lisp/emacs-lisp/advice.el +++ b/lisp/emacs-lisp/advice.el @@ -1,6 +1,6 @@ ;;; advice.el --- An overloading mechanism for Emacs Lisp functions -*- lexical-binding: t -*- -;; Copyright (C) 1993-1994, 2000-2022 Free Software Foundation, Inc. +;; Copyright (C) 1993-2022 Free Software Foundation, Inc. ;; Author: Hans Chalupsky ;; Maintainer: emacs-devel@gnu.org @@ -23,12 +23,6 @@ ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs. If not, see . -;; LCD Archive Entry: -;; advice|Hans Chalupsky|hans@cs.buffalo.edu| -;; Overloading mechanism for Emacs Lisp functions| -;; 1994/08/05 03:42:04|2.14|~/packages/advice.el.Z| - - ;;; Commentary: ;; Advice is documented in the Emacs Lisp Manual. diff --git a/lisp/emacs-lisp/trace.el b/lisp/emacs-lisp/trace.el index c2f6c16226..aea12f146d 100644 --- a/lisp/emacs-lisp/trace.el +++ b/lisp/emacs-lisp/trace.el @@ -1,6 +1,6 @@ ;;; trace.el --- tracing facility for Emacs Lisp functions -*- lexical-binding: t -*- -;; Copyright (C) 1993, 1998, 2000-2022 Free Software Foundation, Inc. +;; Copyright (C) 1993-2022 Free Software Foundation, Inc. ;; Author: Hans Chalupsky ;; Maintainer: emacs-devel@gnu.org @@ -22,12 +22,6 @@ ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs. If not, see . -;; LCD Archive Entry: -;; trace|Hans Chalupsky|hans@cs.buffalo.edu| -;; Tracing facility for Emacs Lisp functions| -;; 1993/05/18 00:41:16|2.0|~/packages/trace.el.Z| - - ;;; Commentary: ;; Introduction: diff --git a/lisp/mail/feedmail.el b/lisp/mail/feedmail.el index af12417f70..989a8b3cd6 100644 --- a/lisp/mail/feedmail.el +++ b/lisp/mail/feedmail.el @@ -211,14 +211,6 @@ ;; ;;;;;;;; ;; -;; I think the LCD is no longer being updated, but if it were, this -;; would be a proper LCD record. There is an old version of -;; feedmail.el in the LCD archive. It works but is missing a lot of -;; features. -;; -;; LCD record: -;; feedmail|WJCarpenter|bill-feedmail@carpenter.ORG|Outbound mail queue handling|01-??-??|11-beta-??|feedmail.el -;; ;; Change log: ;; original, 31 March 1991 ;; patchlevel 1, 5 April 1991 diff --git a/lisp/mail/supercite.el b/lisp/mail/supercite.el index f320246f2d..3f8a940382 100644 --- a/lisp/mail/supercite.el +++ b/lisp/mail/supercite.el @@ -1,6 +1,6 @@ ;;; supercite.el --- minor mode for citing mail and news replies -*- lexical-binding: t; -*- -;; Copyright (C) 1993, 1997, 2001-2022 Free Software Foundation, Inc. +;; Copyright (C) 1993-2022 Free Software Foundation, Inc. ;; Author: 1993 Barry A. Warsaw ;; Maintainer: emacs-devel@gnu.org @@ -22,11 +22,6 @@ ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs. If not, see . -;; LCD Archive Entry -;; supercite|Barry A. Warsaw|supercite-help@python.org -;; |Mail and news reply citation package -;; |1993/09/22 18:58:46|3.1| - ;;; Commentary: ;;; Code: commit d17a867d7085a1f68ff01f9fb01f2a1b4d1e8484 Author: Po Lu Date: Thu Jul 28 21:04:06 2022 +0800 ; * src/print.c (print_vectorlike): Fix Lisp_Object type mixup. diff --git a/src/print.c b/src/print.c index 7bb905b269..7303e847aa 100644 --- a/src/print.c +++ b/src/print.c @@ -1662,7 +1662,7 @@ print_vectorlike (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag, problems if, for instance, the callback function switches a window to this buffer -- this will make Emacs segfault. */ if (!NILP (Vprint__unreadable_callback_buffer) - && Fbuffer_live_p (Vprint__unreadable_callback_buffer)) + && !NILP (Fbuffer_live_p (Vprint__unreadable_callback_buffer))) { record_unwind_current_buffer (); set_buffer_internal (XBUFFER (Vprint__unreadable_callback_buffer)); commit 1ec70ef3df49b473f6f8fe261d5b531db3fabc9d Merge: cf252ef4db 68093c6db3 Author: Stefan Kangas Date: Thu Jul 28 14:56:25 2022 +0200 ; Merge from origin/emacs-28 The following commit was skipped: 68093c6db3 ; Auto-commit of loaddefs files. commit cf252ef4db9b5b79e12cc51c23d98fcbda81533b Merge: eeb51e3db7 ba54f7e39c Author: Stefan Kangas Date: Thu Jul 28 14:56:25 2022 +0200 Merge from origin/emacs-28 ba54f7e39c ; * doc/lispref/windows.texi (Window Sizes): Another typo.... 7990d0c36a ; * doc/lispref/windows.texi (Window Sizes): Fix a typo. ... commit eeb51e3db7335f599af846adf9be154d89a1af95 Merge: 224f7564c6 1c8e90649e Author: Stefan Kangas Date: Thu Jul 28 14:56:25 2022 +0200 ; Merge from origin/emacs-28 The following commit was skipped: 1c8e90649e Bump Emacs version to 28.1.91 commit 224f7564c627a5e3d1af42ac47c47efacb0c93cb Merge: 5f6f1c0754 92e77873ad Author: Stefan Kangas Date: Thu Jul 28 14:56:24 2022 +0200 Merge from origin/emacs-28 92e77873ad Update ChangeLog and AUTHORS for 28.1.91 pretest 093214402b ; * admin/authors.el (authors-aliases): Update. commit 5f6f1c075431453a68963bf937b8b35917f1b719 Merge: 7b55a3dab6 05df70e755 Author: Stefan Kangas Date: Thu Jul 28 14:56:24 2022 +0200 ; Merge from origin/emacs-28 The following commit was skipped: 05df70e755 Revert the `...' documentation back to actual usage commit 7b55a3dab66aa25ddb6c89d8d7f3b6c86a097de6 Merge: 0db604a914 23112f89f9 Author: Stefan Kangas Date: Thu Jul 28 14:56:24 2022 +0200 Merge from origin/emacs-28 23112f89f9 ; Improve documentation of 'file-name-with-extension' 4be938169d Release the desktop lock in 'kill-emacs-hook' 4ea1f6c7f8 ; * doc/lispref/tips.texi (Documentation Tips): Fix typos.... # Conflicts: # doc/lispref/tips.texi commit 0db604a91499496b8f39d9b19e6eadb06f52cb0f Author: Lars Ingebrigtsen Date: Thu Jul 28 14:38:54 2022 +0200 Use icons in warnings buffers * lisp/emacs-lisp/warnings.el (warning-suppress-action) (warning-suppress-log-action): Removed. New icon. (warnings-suppress): New helper function. (display-warning): Use it (bug#46025). diff --git a/lisp/emacs-lisp/warnings.el b/lisp/emacs-lisp/warnings.el index 23e20c3b10..516fdeb10e 100644 --- a/lisp/emacs-lisp/warnings.el +++ b/lisp/emacs-lisp/warnings.el @@ -27,6 +27,8 @@ ;;; Code: +(require 'icons) + (defgroup warnings nil "Log and display warnings." :version "22.1" @@ -201,20 +203,28 @@ SUPPRESS-LIST is the list of kinds of warnings to suppress." ;; we return t. some-match)) -(define-button-type 'warning-suppress-warning - 'action #'warning-suppress-action - 'help-echo "mouse-2, RET: Don't display this warning automatically") -(defun warning-suppress-action (button) - (customize-save-variable 'warning-suppress-types - (cons (list (button-get button 'warning-type)) - warning-suppress-types))) -(define-button-type 'warning-suppress-log-warning - 'action #'warning-suppress-log-action - 'help-echo "mouse-2, RET: Don't log this warning") -(defun warning-suppress-log-action (button) - (customize-save-variable 'warning-suppress-log-types - (cons (list (button-get button 'warning-type)) - warning-suppress-types))) +(define-icon warnings-suppress button + '((emoji "⛔") + (symbol " ■ ") + (text " stop ")) + "Suppress warnings." + :version "29.1" + :help-echo "Click to supress this warning type") + +(defun warnings-suppress (type) + (pcase (car + (read-multiple-choice + (format "Suppress `%s' warnings? " type) + `((?y ,(format "yes, ignore `%s' warnings completely" type)) + (?n "no, just disable showing them") + (?q "quit and do nothing")))) + (?y + (customize-save-variable 'warning-suppress-log-types + (cons type warning-suppress-log-types))) + (?n + (customize-save-variable 'warning-suppress-types + (cons type warning-suppress-types))) + (_ (message "Exiting")))) ;;;###autoload (defun display-warning (type message &optional level buffer-name) @@ -289,23 +299,18 @@ entirely by setting `warning-suppress-types' or (unless (bolp) (funcall newline)) (setq start (point)) + ;; Don't output the button when doing batch compilation + ;; and similar. + (unless (or noninteractive (eq type 'bytecomp)) + (insert (buttonize (icon-string 'warnings-suppress) + #'warnings-suppress type) + " ")) (if warning-prefix-function (setq level-info (funcall warning-prefix-function level level-info))) (insert (format (nth 1 level-info) (format warning-type-format typename)) message) - ;; Don't output the buttons when doing batch compilation - ;; and similar. - (unless (or noninteractive (eq type 'bytecomp)) - (insert " ") - (insert-button "Disable showing" - 'type 'warning-suppress-warning - 'warning-type type) - (insert " ") - (insert-button "Disable logging" - 'type 'warning-suppress-log-warning - 'warning-type type)) (funcall newline) (when (and warning-fill-prefix (not (string-search "\n" message)) commit d7e848ccdaab81fed187b415e95c436b6deb2657 Author: Lars Ingebrigtsen Date: Thu Jul 28 14:37:59 2022 +0200 Use icons in outline * lisp/help.el (describe-bindings): Don't force buttons on (bug#56691). * lisp/outline.el (outline-minor-mode-use-buttons): Default buttons on in special-mode buffers. * lisp/outline.el (outline-minor-mode-buttons): Remove. (outline-open, outline-close): New icons. (outline-minor-mode-highlight-buffer): Use the new predicate to switch on/off. (outline--make-button): Remove. (outline--make-button-overlay): Use icons.el instantiation. (outline--valid-emoji-p): Remove. (outline--valid-char-p): Remove. (outline--insert-open-button, outline--insert-close-button): Make point movement better in *Help* buffers. diff --git a/etc/NEWS b/etc/NEWS index 3753326a19..72dd5572a2 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -830,10 +830,6 @@ or is itself too long. If non-nil, Outline Minor Mode will use buttons to hide/show outlines in addition to the ellipsis. The default is nil. ---- -*** New user option 'outline-minor-mode-buttons'. -This is a list of pairs of open/close strings used to display buttons. - +++ ** Support for the WebP image format. This support is built by default when the libwebp library is diff --git a/lisp/help.el b/lisp/help.el index 65c537d119..1c1ce1618c 100644 --- a/lisp/help.el +++ b/lisp/help.el @@ -606,7 +606,6 @@ or a buffer name." (setq-local outline-level (lambda () 1)) (setq-local outline-minor-mode-cycle t outline-minor-mode-highlight t) - (setq-local outline-minor-mode-use-buttons t) (outline-minor-mode 1) (save-excursion (goto-char (point-min)) diff --git a/lisp/outline.el b/lisp/outline.el index f6428db1a0..dd5df4c896 100644 --- a/lisp/outline.el +++ b/lisp/outline.el @@ -35,6 +35,7 @@ ;;; Code: (eval-when-compile (require 'cl-lib)) +(require 'icons) (defgroup outlines nil "Support for hierarchical outlining." @@ -280,34 +281,33 @@ This option is only in effect when `outline-minor-mode-cycle' is non-nil." [outline-1 outline-2 outline-3 outline-4 outline-5 outline-6 outline-7 outline-8]) -(defcustom outline-minor-mode-use-buttons nil - "If non-nil, display clickable buttons on the headings. +(defcustom outline-minor-mode-use-buttons '(derived-mode . special-mode) + "Whether to display clickable buttons on the headings. +The value should be a `buffer-match-p' condition, or nil to +disable in all buffers and t to enable in all buffers. + These buttons can be used to hide and show the body under the heading. Note that this feature is not meant to be used in editing -buffers (yet) -- that will be amended in a future version. - -The `outline-minor-mode-buttons' variable specifies how the -buttons should look." +buffers (yet) -- that will be amended in a future version." :type 'boolean :safe #'booleanp :version "29.1") -(defcustom outline-minor-mode-buttons - '(("▶️" "🔽" outline--valid-emoji-p) - ("▶" "▼" outline--valid-char-p)) - "How to show open/close buttons on the headings. -Value should be a list of elements of the form (CLOSE OPEN TEST-FN), -where CLOSE and OPEN are strings to display as, respectively, the -close and open buttons, and TEST-FN is a function of one argument -which will be called with CLOSE or OPEN and should return non-nil if -the argument string can be displayed by the current frame's terminal. -The pair of buttons that will be actually used is the first pair -whose element in the list passes the test of TEST-FN for both the -CLOSE and OPEN strings. - -This is only used when `outline-minor-mode-use-buttons' is non-nil" - :type 'sexp - :version "29.1") +(define-icon outline-open button + '((emoji "▶️") + (symbol " ▶ ") + (text " open ")) + "Icon used for buttons for opening a section in outline buffers." + :version "29.1" + :help-echo "Open this section") + +(define-icon outline-close button + '((emoji "🔽") + (symbol " ▼ ") + (text " close ")) + "Icon used for buttons for closing a section in outline buffers." + :version "29.1" + :help-echo "Close this section") (defvar outline-level #'outline-level @@ -434,7 +434,10 @@ outline font-lock faces to those of major mode." (goto-char (match-beginning 0)) (not (get-text-property (point) 'face)))) (overlay-put overlay 'face (outline-font-lock-face))) - (when outline-minor-mode-use-buttons + (when (and outline-minor-mode-use-buttons + (or (eq outline-minor-mode-use-buttons t) + (buffer-match-p outline-minor-mode-use-buttons + (current-buffer)))) (outline--insert-open-button))) (goto-char (match-end 0)))))) @@ -983,22 +986,6 @@ If non-nil, EVENT should be a mouse event." (outline--insert-close-button)) (outline-flag-subtree t)) -(defun outline--make-button (type) - (cl-loop for (close open test) in outline-minor-mode-buttons - when (and (funcall test close) (funcall test open)) - return (concat (if (eq type 'close) - close - open) - " " (buffer-substring (point) (1+ (point)))))) - -(defun outline--valid-emoji-p (string) - (when-let ((font (and (display-multi-font-p) - (car (internal-char-font nil ?😀))))) - (font-has-char-p font (aref string 0)))) - -(defun outline--valid-char-p (string) - (char-displayable-p (aref string 0))) - (defun outline--make-button-overlay (type) (let ((o (seq-find (lambda (o) (overlay-get o 'outline-button)) @@ -1008,12 +995,27 @@ If non-nil, EVENT should be a mouse event." (overlay-put o 'follow-link 'mouse-face) (overlay-put o 'mouse-face 'highlight) (overlay-put o 'outline-button t)) - (overlay-put o 'display (outline--make-button type)) + (let ((icon + (icon-elements (if (eq type 'close) 'outline-close 'outline-open))) + (inhibit-read-only t)) + ;; In editing buffers we use overlays only, but in other buffers + ;; we use a mix of text properties, text and overlays to make + ;; movement commands work more logically. + (when (derived-mode-p 'special-mode) + (put-text-property (point) (1+ (point)) 'face (plist-get icon 'face))) + (when-let ((image (plist-get icon 'image))) + (overlay-put o 'display image)) + (overlay-put o 'display (plist-get icon 'string)) + (overlay-put o 'face (plist-get icon 'face))) o)) (defun outline--insert-open-button () (save-excursion (beginning-of-line) + (when (derived-mode-p 'special-mode) + (let ((inhibit-read-only t)) + (insert " ") + (beginning-of-line))) (let ((o (outline--make-button-overlay 'open))) (overlay-put o 'help-echo "Click to hide") (overlay-put o 'keymap @@ -1024,6 +1026,10 @@ If non-nil, EVENT should be a mouse event." (defun outline--insert-close-button () (save-excursion (beginning-of-line) + (when (derived-mode-p 'special-mode) + (let ((inhibit-read-only t)) + (insert " ") + (beginning-of-line))) (let ((o (outline--make-button-overlay 'close))) (overlay-put o 'help-echo "Click to show") (overlay-put o 'keymap commit 601737d7506727d66953a65e68105cf7eb3ee044 Author: Lars Ingebrigtsen Date: Thu Jul 28 14:31:33 2022 +0200 Add support for user-customizable icons * doc/emacs/custom.texi (Specific Customization): Mention it. * doc/emacs/display.texi (Icons): New node. * doc/lispref/display.texi (Icons): New node. * lisp/button.el (buttonize): (button--properties, buttonize-region): Allow not overriding faces. * lisp/cus-edit.el (custom-save-all): Save icons. (custom-icon): New widget. (custom-icon-value-create, custom-toggle-hide-icon) (custom--icons-widget-value, custom-icon-set): Helper functions for the widget. (customize-icon): Main command. (custom-icon-state-set, custom-icon-state): Helper functions. (custom-theme-set-icons): Function to be used by theme writers. (custom-set-icons): Function to be used in .emacs. (custom-save-icons): New function. * lisp/custom.el (custom-push-theme): Add icons. * lisp/emacs-lisp/icons.el: New file. * test/lisp/emacs-lisp/icons-tests.el: Add some tests. diff --git a/doc/emacs/custom.texi b/doc/emacs/custom.texi index 46a2291b74..6ed43bcb79 100644 --- a/doc/emacs/custom.texi +++ b/doc/emacs/custom.texi @@ -511,6 +511,9 @@ Set up a customization buffer for just one user option, @var{option}. @item M-x customize-face @key{RET} @var{face} @key{RET} Set up a customization buffer for just one face, @var{face}. +@item M-x customize-icon @key{RET} @var{face} @key{RET} +Set up a customization buffer for just one icon, @var{icon}. + @item M-x customize-group @key{RET} @var{group} @key{RET} Set up a customization buffer for just one group, @var{group}. diff --git a/doc/emacs/display.texi b/doc/emacs/display.texi index 96e05a902d..b87ca81fae 100644 --- a/doc/emacs/display.texi +++ b/doc/emacs/display.texi @@ -24,6 +24,7 @@ the text is displayed. * Faces:: How to change the display style using faces. * Colors:: Specifying colors for faces. * Standard Faces:: The main predefined faces. +* Icons:: How to change how icons look. * Text Scale:: Increasing or decreasing text size in a buffer. * Font Lock:: Minor mode for syntactic highlighting using faces. * Highlight Interactively:: Tell Emacs what text to highlight. @@ -851,6 +852,38 @@ This face is used to display on text-mode terminals the menu item that would be selected if you click a mouse or press @key{RET}. @end table +@node Icons +@section Icons + +Emacs sometimes displays clickable buttons (or other informative +icons), and the look of these can be customized by the user. + +@vindex icon-preference +The main customization point here is the @code{icon-preference} user +option. By using this, you can tell Emacs your overall preferences +for icons. This is a list of icon types, and the first icon type +that's supported will be used. The supported types are: + +@table @code +@item image +Use an image for the icon. + +@item emoji +Use a colorful emoji for the icon. + +@item symbol +Use a monochrome symbol for the icon. + +@item text +Use a simple text for the icon. +@end table + +In addition, each individual icon can be customized with @kbd{M-x +customize-icon}, and themes can further alter the looks of the icons. + +To get a quick description of an icon, use the @kbd{M-x describe-icon} +command. + @node Text Scale @section Text Scale diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi index 08bf7441df..b5e4cb41fd 100644 --- a/doc/lispref/display.texi +++ b/doc/lispref/display.texi @@ -27,6 +27,7 @@ that Emacs presents to the user. * Window Dividers:: Separating windows visually. * Display Property:: Images, margins, text size, etc. * Images:: Displaying images in Emacs buffers. +* Icons:: Displaying icons in Emacs buffers. * Xwidgets:: Displaying native widgets in Emacs buffers. * Buttons:: Adding clickable buttons to Emacs buffers. * Abstract Display:: Emacs's Widget for Object Collections. @@ -6979,6 +6980,161 @@ bytes. An image of size 200x100 with 24 bits per color will have a cache size of 60000 bytes, for instance. @end defun +@node Icons +@section Icons + +Emacs sometimes uses buttons (for clicking on) or small graphics (to +illustrate something). Since Emacs is available on a wide variety of +systems with different capabilities, and users have different +preferences, Emacs provides a facility to handle this in a convenient +way, allowing customization, graceful degradation, accessibility, as +well as themability: @dfn{Icons}. + +The central macro here is @code{define-icon}, and here's a simple +example: + +@lisp +(define-icon outline-open button + '((image "right.svg" "open.xpm" "open.pbm" :height line) + (emoji "▶️") + (symbol "▶" "➤") + (text "open" :face icon-button)) + "Icon used for buttons for opening a section in outline buffers." + :version "29.1" + :help-echo "Open this section") +@end lisp + +This is used in tandem with the @code{icon-preference} user option, as +well as run-time checks for what the current Emacs frame can actually +display. + +The macro in this example defines @code{outline-open} as an icon, and +inherits properties from the icon called @code{button} (so this is +meant as a clickable button to be inserted in a buffer). We then get +a list of @dfn{icon types} along with the actual icon shapes +themselves. In addition, there's a doc string and various keywords +that contain additional information and properties. + +When instantiating an icon you use @code{icon-string}, and this will +consult the current Customize theming, and the @code{icon-preference} +user option, and finally what the Emacs is able to actually display. +If @code{icon-preference} is @code{(image emoji symbol text)} (i.e., +allowing all of these forms of icons), in this case, +@code{icon-string} will first check that Emacs is able to display +images at all, and then whether it has support for each of those +different image formats. If that fails, Emacs will check whether +Emacs can display emojis (in the current frame). If that fails, it'll +check whether it can display the symbol in question. If that fails, +it'll use the plain text version. + +For instance, if @code{icon-preference} doesn't contain @code{image} +or @code{emoji}, it'll skip those entries. + +Code can confidently call @code{icon-string} in all circumstances and +be confident that something readable will appear on the screen, no +matter whether the user is on a graphical terminal or a text terminal, +and no matter which features Emacs was built with. + +@defmac define-icon name parent specs doc &rest keywords +@var{name} should be a symbol, and is the name of the resulting +keyword. @code{icon-string} can later be used to instantiate the +icon. + +This icon will inherit specs from @var{parent}, and recursively from +the parent's parents, and so on, and the lowest descendent element +wins. + +@var{specs} is a list of specifications. The first element of each +specification is the type, and the rest is something that can be used +as an icon of that type, and then optionally followed by a keyword +list. The following types are available: + +@table @code +@item image +In this case, there may be many images listed as candidates. Emacs +will choose the first one that the current Emacs instance can show. +If an image listed is an absolute file name, it's used as is, but it's +otherwise looked up in the image load path. + +@item emoji +This should be a (possibly colorful) emoji. + +@item symbol +This should be a (monochrome) symbol. + +@item text +Icons should also have a textual fallback. This can also be used for +by the visually impaired: If @code{icon-preference} is just +@code{(text)}, all icons will be replaced by text. +@end table + +Various keywords may follow the list of icon specifications. For +instance: + +@example +(symbol "▶" "➤" :face icon-button) +@end example + +Unknown keywords are ignored. The following keywords are allowed: + +@table @code +@item :face +The face to be used. + +@item :height +This is only valid for @code{image} icons, and can be either a number +(which specifies the height in pixels), or the symbol @code{line}, +which will use the default line height in the currently selected +window. +@end table + +@var{doc} should be a doc string. + +@var{keywords} is a list of keyword/value pairs. The following +keywords are allowed: + +@table @code +@item :version +The (approximate) Emacs version this button first appeared. (This +keyword is mandatory.) + +@item :group +The customization group this icon belongs in. If not present, it is +inferred. + +@item :help-echo +The help string shown when hovering over the icon with the mouse +pointer. +@end table +@end defmac + +@defun icon-string icon +This function returns a string suitable for display in the current +buffer for @var{icon}. +@end defun + +@defun icon-elements icon +Alternatively, you can get a ``deconstructed'' version of @var{icon} +with this function. This returns a plist where the keys are +@code{string}, @code{face} and @var{image}. (The latter is only +present if the icon is represented by an image.) This can be useful +if the icon isn't to be inserted directly in the buffer, but needs +some sort of post-processing first. +@end defun + +Icons can be customized with @kbd{M-x customize-icon}. Themes can +specify changes to icons with, for instance: + +@lisp +(custom-theme-set-icons + 'my-theme + '(outline-open ((image :height 100) + (text " OPEN "))) + '(outline-close ((image :height 100) + (text " CLOSE " :face warning)))) +@end lisp + + @node Xwidgets @section Embedded Native Widgets @cindex xwidget diff --git a/etc/NEWS b/etc/NEWS index 3941455efc..3753326a19 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2454,6 +2454,11 @@ patcomp.el, pc-mode.el, pc-select.el, s-region.el, and sregex.el. * Lisp Changes in Emacs 29.1 ++++ +** Emacs now supports user-customizable and themable icons. +These can be used for buttons in buffers and the like. See +'(elisp)Icons' and '(emacs)Icons' for details. + +++ ** New arguments MESSAGE and TIMEOUT of 'set-transient-map'. MESSAGE specifies a message to display after activating the transient diff --git a/lisp/button.el b/lisp/button.el index 80b73033d6..21047ad554 100644 --- a/lisp/button.el +++ b/lisp/button.el @@ -623,12 +623,15 @@ itself will be used instead as the function argument. If HELP-ECHO, use that as the `help-echo' property. Also see `buttonize-region'." - (apply #'propertize string - (button--properties callback data help-echo))) + (let ((string + (apply #'propertize string + (button--properties callback data help-echo)))) + ;; Add the face to the end so that it can be overridden. + (add-face-text-property 0 (length string) 'button t string) + string)) (defun button--properties (callback data help-echo) - (list 'face 'button - 'font-lock-face 'button + (list 'font-lock-face 'button 'mouse-face 'highlight 'help-echo help-echo 'button t @@ -647,7 +650,8 @@ itself will be used instead as the function argument. If HELP-ECHO, use that as the `help-echo' property. Also see `buttonize'." - (add-text-properties start end (button--properties callback data help-echo))) + (add-text-properties start end (button--properties callback data help-echo)) + (add-face-text-property start end 'button t)) (provide 'button) diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el index 50dce5ee28..9b0d2a10f6 100644 --- a/lisp/cus-edit.el +++ b/lisp/cus-edit.el @@ -139,6 +139,7 @@ (require 'cus-face) (require 'wid-edit) +(require 'icons) (defvar custom-versions-load-alist) ; from cus-load (defvar recentf-exclude) ; from recentf.el @@ -4849,7 +4850,8 @@ if only the first line of the docstring is shown.")) (print-escape-control-characters t)) (atomic-change-group (custom-save-variables) - (custom-save-faces))) + (custom-save-faces) + (custom-save-icons))) (let ((file-precious-flag t)) (save-buffer)) (if old-buffer @@ -5290,6 +5292,290 @@ if that value is non-nil." (put 'Custom-mode 'mode-class 'special) +;; Icons. + +(define-widget 'custom-icon 'custom + "A widget for displaying an icon. +The following properties have special meanings for this widget: + +:hidden-states should be a list of widget states for which the + widget's initial contents are to be hidden. + +:custom-form should be a symbol describing how to display and + edit the variable---either `edit' (using edit widgets), + `lisp' (as a Lisp sexp), or `mismatch' (should not happen); + if nil, use the return value of `custom-variable-default-form'. + +:shown-value, if non-nil, should be a list whose `car' is the + variable value to display in place of the current value. + +:custom-style describes the widget interface style; nil is the + default style, while `simple' means a simpler interface that + inhibits the magic custom-state widget." + :format "%v" + :help-echo "Alter or reset this icon." + :documentation-property #'icon-documentation + :custom-category 'option + :custom-state nil + :custom-form nil + :value-create 'custom-icon-value-create + :hidden-states '(standard) + :custom-set 'custom-icon-set + :custom-reset-current 'custom-redraw + :custom-reset-saved 'custom-variable-reset-saved) + +(defun custom-icon-value-create (widget) + "Here is where you edit the icon's specification." + (custom-load-widget widget) + (unless (widget-get widget :custom-form) + (widget-put widget :custom-form custom-variable-default-form)) + (let* ((buttons (widget-get widget :buttons)) + (children (widget-get widget :children)) + (form (widget-get widget :custom-form)) + (symbol (widget-get widget :value)) + (tag (widget-get widget :tag)) + (type '(repeat + (list (choice (const :tag "Images" image) + (const :tag "Colorful Emojis" emoji) + (const :tag "Monochrome Symbols" symbol) + (const :tag "Text Only" text)) + (repeat string) + plist))) + (prefix (widget-get widget :custom-prefix)) + (last (widget-get widget :custom-last)) + (style (widget-get widget :custom-style)) + (value (let ((shown-value (widget-get widget :shown-value))) + (cond (shown-value + (car shown-value)) + (t (icon-complete-spec symbol nil t))))) + (state (or (widget-get widget :custom-state) + (if (memq (custom-icon-state symbol value) + (widget-get widget :hidden-states)) + 'hidden)))) + + ;; Transform the spec into something that agrees with the type. + (setq value + (mapcar + (lambda (elem) + (list (car elem) + (icon-spec-values elem) + (icon-spec-keywords elem))) + value)) + + ;; Now we can create the child widget. + (cond ((eq custom-buffer-style 'tree) + (insert prefix (if last " `--- " " |--- ")) + (push (widget-create-child-and-convert + widget 'custom-browse-variable-tag) + buttons) + (insert " " tag "\n") + (widget-put widget :buttons buttons)) + ((eq state 'hidden) + ;; Indicate hidden value. + (push (widget-create-child-and-convert + widget 'custom-visibility + :help-echo "Show the value of this option." + :on-glyph "down" + :on "Hide" + :off-glyph "right" + :off "Show Value" + :action 'custom-toggle-hide-icon + nil) + buttons) + (insert " ") + (push (widget-create-child-and-convert + widget 'item + :format "%{%t%} " + :sample-face 'custom-variable-tag + :tag tag + :parent widget) + buttons)) + (t + ;; Edit mode. + (push (widget-create-child-and-convert + widget 'custom-visibility + :help-echo "Hide or show this option." + :on "Hide" + :off "Show" + :on-glyph "down" + :off-glyph "right" + :action 'custom-toggle-hide-icon + t) + buttons) + (insert " ") + (let* ((format (widget-get type :format)) + tag-format) + (unless (string-match ":\\s-?" format) + (error "Bad format")) + (setq tag-format (substring format 0 (match-end 0))) + (push (widget-create-child-and-convert + widget 'item + :format tag-format + :action 'custom-tag-action + :help-echo "Change specs of this face." + :mouse-down-action 'custom-tag-mouse-down-action + :button-face 'custom-variable-button + :sample-face 'custom-variable-tag + :tag tag) + buttons) + (push (widget-create-child-and-convert + widget type + :value value) + children)))) + (unless (eq custom-buffer-style 'tree) + (unless (eq (preceding-char) ?\n) + (widget-insert "\n")) + ;; Create the magic button. + (unless (eq style 'simple) + (let ((magic (widget-create-child-and-convert + widget 'custom-magic nil))) + (widget-put widget :custom-magic magic) + (push magic buttons))) + (widget-put widget :buttons buttons) + ;; Insert documentation. + (widget-put widget :documentation-indent 3) + (unless (and (eq style 'simple) + (eq state 'hidden)) + (widget-add-documentation-string-button + widget :visibility-widget 'custom-visibility)) + + ;; Update the rest of the properties. + (widget-put widget :custom-form form) + (widget-put widget :children children) + ;; Now update the state. + (if (eq state 'hidden) + (widget-put widget :custom-state state) + (custom-icon-state-set widget)) + ;; See also. + (unless (eq state 'hidden) + (when (eq (widget-get widget :custom-level) 1) + (custom-add-parent-links widget)) + (custom-add-see-also widget))))) + +(defun custom-toggle-hide-icon (visibility-widget &rest _ignore) + "Toggle the visibility of a `custom-icon' parent widget. +By default, this signals an error if the parent has unsaved +changes." + (let ((widget (widget-get visibility-widget :parent))) + (unless (eq (widget-type widget) 'custom-icon) + (error "Invalid widget type")) + (custom-load-widget widget) + (let ((state (widget-get widget :custom-state))) + (if (eq state 'hidden) + (widget-put widget :custom-state 'unknown) + ;; In normal interface, widget can't be hidden if modified. + (when (memq state '(invalid modified set)) + (error "There are unsaved changes")) + (widget-put widget :custom-state 'hidden)) + (custom-redraw widget) + (widget-setup)))) + +(defun custom--icons-widget-value (widget) + ;; Transform back to the real format. + (mapcar + (lambda (elem) + (cons (nth 0 elem) + (append (nth 1 elem) (nth 2 elem)))) + (widget-value widget))) + +(defun custom-icon-set (widget) + "Set the current spec for the icon being edited by WIDGET." + (let* ((state (widget-get widget :custom-state)) + (child (car (widget-get widget :children))) + (symbol (widget-value widget)) + val) + (when (eq state 'hidden) + (user-error "Cannot update hidden icon")) + + (setq val (custom--icons-widget-value child)) + (unless (equal val (icon-complete-spec symbol)) + (custom-variable-backup-value widget)) + (custom-push-theme 'theme-icon symbol 'user 'set val) + (custom-redraw-magic widget))) + +;;;###autoload +(defun customize-icon (icon) + "Customize ICON." + (interactive + (let* ((v (symbol-at-point)) + (default (and (iconp v) (symbol-name v))) + val) + (setq val (completing-read (format-prompt "Customize icon" default) + obarray 'iconp t nil nil default)) + (list (if (equal val "") + (if (symbolp v) v nil) + (intern val))))) + (unless icon + (error "No icon specified")) + (custom-buffer-create (list (list icon 'custom-icon)) + (format "*Customize Icon: %s*" + (custom-unlispify-tag-name icon)))) + +(defun custom-icon-state-set (widget &optional state) + "Set the state of WIDGET to STATE." + (let ((value (custom--icons-widget-value + (car (widget-get widget :children))))) + (widget-put + widget :custom-state + (or state + (custom-icon-state (widget-value widget) value))))) + +(defun custom-icon-state (symbol value) + "Return the state of customize icon SYMBOL for VALUE. +Possible return values are `standard', `saved', `set', `themed', +and `changed'." + (cond + ((equal (icon-complete-spec symbol t t) value) + 'standard) + ((equal (icon-complete-spec symbol nil t) value) + (if (eq (caar (get symbol 'theme-icon)) 'user) + 'set + 'themed)) + (t 'changed))) + +(defun custom-theme-set-icons (theme &rest specs) + "Apply a list of icon specs associated with THEME. +THEME should be a symbol, and SPECS are icon name/spec pairs. +See `define-icon' for details." + (custom-check-theme theme) + (pcase-dolist (`(,icon ,spec) specs) + (custom-push-theme 'theme-icon icon theme 'set spec))) + +(defun custom-set-icons (&rest args) + "Install user customizations of icon specs specified in ARGS. +These settings are registered as theme `user'. +The arguments should each be a list of the form: + + (SYMBOL EXP) + +This stores EXP (without evaluating it) as the saved spec for SYMBOL." + (apply #'custom-theme-set-icons 'user args)) + +;;;###autoload +(defun custom-save-icons () + "Save all customized icons in `custom-file'." + (save-excursion + (custom-save-delete 'custom-set-icons) + (let ((values nil)) + (mapatoms + (lambda (symbol) + (let ((value (car-safe (get symbol 'theme-icon)))) + (when (eq (car value) 'user) + (push (list symbol (cadr value)) values))))) + (ensure-empty-lines) + (insert "(custom-set-icons + ;; custom-set-icons was added by Custom. + ;; If you edit it by hand, you could mess it up, so be careful. + ;; Your init file should contain only one such instance. + ;; If there is more than one, they won't work right.\n") + (dolist (value (sort values (lambda (s1 s2) + (string< (car s1) (car s2))))) + (unless (bolp) + (insert "\n")) + (insert " '") + (prin1 value (current-buffer))) + (insert ")\n")))) + (provide 'cus-edit) ;;; cus-edit.el ends here diff --git a/lisp/custom.el b/lisp/custom.el index bbbe70c5ea..5ece5047a8 100644 --- a/lisp/custom.el +++ b/lisp/custom.el @@ -910,7 +910,7 @@ symbol `set', then VALUE is the value to use. If it is the symbol `reset', then SYMBOL will be removed from THEME (VALUE is ignored). See `custom-known-themes' for a list of known themes." - (unless (memq prop '(theme-value theme-face)) + (unless (memq prop '(theme-value theme-face theme-icon)) (error "Unknown theme property")) (let* ((old (get symbol prop)) (setting (assq theme old)) ; '(theme value) diff --git a/lisp/emacs-lisp/icons.el b/lisp/emacs-lisp/icons.el new file mode 100644 index 0000000000..da7f68f523 --- /dev/null +++ b/lisp/emacs-lisp/icons.el @@ -0,0 +1,265 @@ +;;; icons.el --- Handling icons -*- lexical-binding:t -*- + +;; Copyright (C) 2022 Free Software Foundation, Inc. + +;; Author: Lars Ingebrigtsen +;; Keywords: icons buttons + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Commentary: + +;; Todo: describe-icon + +;;; Code: + +(require 'cl-lib) + +(defface icon + '((t :underline nil)) + "Face for buttons." + :version "29.1" + :group 'customize) + +(defface icon-button + '((((type x w32 ns haiku pgtk) (class color)) + :inherit icon + :box (:line-width (3 . -1) :color "#404040" :style flat-button) + :background "#808080" + :foreground "black")) + "Face for buttons." + :version "29.1" + :group 'customize) + +(defcustom icon-preference '(image emoji symbol text) + "List of icon types to use, in order of preference. +Emacs will choose the icon of the highest preference possible +on the current display, and \"degrade\" gracefully to an icon +type that's available." + :version "29.1" + :group 'customize + :type '(repeat (const :tag "Images" image) + (const :tag "Colorful Emojis" emoji) + (const :tag "Monochrome Symbols" symbol) + (const :tag "Text Only" text))) + +(defmacro define-icon (name parent specification documentation &rest keywords) + "Define an icon identified by NAME. +If non-nil, inherit the specification from PARENT. Entries from +SPECIFICATION will override inherited specifications. + +SPECIFICATION is an alist of entries where the first element is +the type, and the rest are icons of that type. Valid types are +`image', `emoji', `symbol' and `text'. + +KEYWORDS specify additional information. Valid keywords are: + +`:version': The first Emacs version to include this icon; this is +mandatory. + +`:group': The customization group the icon belongs in; this is +inferred if not present. + +`:help-echo': Informational text that explains what happens if +the icon is used as a button and you click it." + (declare (indent 2)) + (unless (symbolp name) + (error "NAME must be a symbol: %S" name)) + (unless (plist-get keywords :version) + (error "There must be a :version keyword in `define-icon'")) + `(icons--register ',name ',parent ,specification ,documentation + ',keywords)) + +(defun icons--register (name parent spec doc keywords) + (put name 'icon--properties (list parent spec doc keywords)) + (custom-add-to-group + (or (plist-get keywords :group) + (custom-current-group)) + name 'custom-icon)) + +(defun icon-spec-keywords (spec) + (seq-drop-while (lambda (e) (not (keywordp e))) (cdr spec))) + +(defun icon-spec-values (spec) + (seq-take-while (lambda (e) (not (keywordp e))) (cdr spec))) + +(defun iconp (object) + "Return nil if OBJECT is not an icon. +If OBJECT is an icon, return the icon properties." + (get object 'icon--properties)) + +(defun icon-documentation (icon) + "Return the documentation for ICON." + (let ((props (iconp icon))) + (unless props + (user-error "%s is not a valid icon" icon)) + (nth 2 props))) + +(defun icons--spec (icon) + (nth 1 (iconp icon))) + +(defun icons--copy-spec (spec) + (mapcar #'copy-sequence spec)) + +(defun icon-complete-spec (icon &optional inhibit-theme inhibit-inheritance) + "Return the merged spec for ICON." + (pcase-let ((`(,parent ,spec _ _) (iconp icon))) + ;; We destructively modify `spec' when merging, so copy it. + (setq spec (icons--copy-spec spec)) + ;; Let the Customize theme override. + (unless inhibit-theme + (when-let ((theme-spec (cadr (car (get icon 'theme-icon))))) + (setq spec (icons--merge-spec (icons--copy-spec theme-spec) spec)))) + ;; Inherit from the parent spec (recursively). + (unless inhibit-inheritance + (while parent + (let ((parent-props (get parent 'icon--properties))) + (when parent-props + (setq spec (icons--merge-spec spec (cadr parent-props)))) + (setq parent (car parent-props))))) + spec)) + +(defun icon-string (name) + "Return a string suitable for display in the current buffer for icon NAME." + (let ((props (iconp name))) + (unless props + (user-error "%s is not a valid icon" name)) + (pcase-let ((`(_ ,spec _ ,keywords) props)) + (setq spec (icon-complete-spec name)) + ;; We now have a full spec, so check the intersection of what + ;; the user wants and what this Emacs is capable of showing. + (let ((icon-string + (catch 'found + (dolist (type icon-preference) + (let* ((type-spec (assq type spec)) + ;; Find the keywords at the end of the section + ;; (if any). + (type-keywords (icon-spec-keywords type-spec))) + ;; Go through all the variations in this section + ;; and return the first one we can display. + (dolist (icon (icon-spec-values type-spec)) + (when-let ((result + (icons--create type icon type-keywords))) + (throw 'found + (if-let ((face (plist-get type-keywords :face))) + (propertize result 'face face) + result))))))))) + (unless icon-string + (error "Couldn't find any way to display the %s icon" name)) + (when-let ((help (plist-get keywords :help-echo))) + (setq icon-string (propertize icon-string 'help-echo help))) + (propertize icon-string 'rear-nonsticky t))))) + +(defun icon-elements (name) + "Return the elements of icon NAME. +The elements are represented as a plist where the keys are +`string', `face' and `display'. The `image' element is only +present if the icon is represented by an image." + (let ((string (icon-string name))) + (list 'face (get-text-property 0 'face string) + 'image (get-text-property 0 'display string) + 'string (substring-no-properties string)))) + +(defun icons--merge-spec (merged parent-spec) + (dolist (elem parent-spec) + (let ((current (assq (car elem) merged))) + (if (not current) + ;; Just add the entry. + (push elem merged) + ;; See if there are any keywords to inherit. + (let ((parent-keywords (icon-spec-keywords elem)) + (current-keywords (icon-spec-keywords current))) + (while parent-keywords + (unless (plist-get (car parent-keywords) current-keywords) + (nconc current (take 2 parent-keywords)) + (setq parent-keywords (cddr parent-keywords)))))))) + merged) + +(cl-defmethod icons--create ((_type (eql 'image)) icon keywords) + (let ((file (if (file-name-absolute-p icon) + icon + (image-search-load-path icon)))) + (and (display-graphic-p) + (image-supported-file-p file) + (propertize + " " 'display + (if-let ((height (plist-get keywords :height))) + (create-image file + nil nil + :height (if (eq height 'line) + (window-default-line-height) + height) + :scale 1) + (create-image file)))))) + +(cl-defmethod icons--create ((_type (eql 'emoji)) icon _keywords) + (when-let ((font (and (display-multi-font-p) + (car (internal-char-font nil ?😀))))) + (and (font-has-char-p font (aref icon 0)) + icon))) + +(cl-defmethod icons--create ((_type (eql 'symbol)) icon _keywords) + (and (cl-every #'char-displayable-p icon) + icon)) + +(cl-defmethod icons--create ((_type (eql 'text)) icon _keywords) + icon) + +(define-icon button nil + '((image :face icon-button) + (emoji "🔵" :face icon) + (symbol "●" :face icon-button) + (text "button" :face icon-button)) + "Base icon for buttons." + :version "29.1") + +;;;###autoload +(defun describe-icon (icon) + "Pop to a buffer to describe ICON." + (interactive + (list (intern (completing-read "Describe icon: " obarray 'iconp t)))) + (let ((help-buffer-under-preparation t)) + (help-setup-xref (list #'describe-icon icon) + (called-interactively-p 'interactive)) + (with-help-window (help-buffer) + (with-current-buffer standard-output + (insert "Icon: " (symbol-name icon) "\n\n") + (insert "Documentation:\n" + (substitute-command-keys (icon-documentation icon))) + (ensure-empty-lines) + (let ((spec (icon-complete-spec icon)) + (plain (icon-complete-spec icon t t))) + (insert "Specification including inheritance and theming:\n") + (icons--describe-spec spec) + (unless (equal spec plain) + (insert "\nSpecification not including inheritance and theming:\n") + (icons--describe-spec plain))))))) + +(defun icons--describe-spec (spec) + (dolist (elem spec) + (let ((type (car elem)) + (values (icon-spec-values elem)) + (keywords (icon-spec-keywords elem))) + (when (or values keywords) + (insert (format "\nType: %s\n" type)) + (dolist (value values) + (insert (format " %s\n" value))) + (while keywords + (insert (format " %s: %s\n" (pop keywords) (pop keywords)))))))) + +(provide 'icons) + +;;; icons.el ends here diff --git a/test/lisp/emacs-lisp/icons-tests.el b/test/lisp/emacs-lisp/icons-tests.el new file mode 100644 index 0000000000..e6e71a8e4f --- /dev/null +++ b/test/lisp/emacs-lisp/icons-tests.el @@ -0,0 +1,63 @@ +;;; icons-tests.el --- Tests for icons.el -*- lexical-binding: t; -*- + +;; Copyright (C) 2022 Free Software Foundation, Inc. + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Commentary: + +;; + +;;; Code: + +(require 'icons) +(require 'ert) +(require 'ert-x) +(require 'cus-edit) + +(define-icon icon-test1 nil + '((symbol ">") + (text "great")) + "Test icon" + :version "29.1") + +(define-icon icon-test2 icon-test1 + '((text "child")) + "Test icon" + :version "29.1") + +(deftheme test-icons-theme "") + +(ert-deftest test-icon-theme () + (let ((icon-preference '(image emoji symbol text))) + (should (equal (icon-string 'icon-test1) ">"))) + (let ((icon-preference '(text))) + (should (equal (icon-string 'icon-test1) "great"))) + (custom-theme-set-icons + 'test-icons-theme + '(icon-test1 ((symbol "<") (text "less")))) + (let ((icon-preference '(image emoji symbol text))) + (should (equal (icon-string 'icon-test1) ">")) + (enable-theme 'test-icons-theme) + (should (equal (icon-string 'icon-test1) "<")))) + +(ert-deftest test-icon-inheretance () + (let ((icon-preference '(image emoji symbol text))) + (should (equal (icon-string 'icon-test2) ">"))) + (let ((icon-preference '(text))) + (should (equal (icon-string 'icon-test2) "child")))) + +;;; icons-tests.el ends here commit 68093c6db3af14616d4b0831cdad85108ea0d776 Author: Stefan Kangas Date: Thu Jul 28 13:31:43 2022 +0200 ; Auto-commit of loaddefs files. diff --git a/lisp/ldefs-boot.el b/lisp/ldefs-boot.el index 3dbf195bc2..5ac3b56e7f 100644 --- a/lisp/ldefs-boot.el +++ b/lisp/ldefs-boot.el @@ -24505,7 +24505,7 @@ Set restriction lock for agenda to current subtree or file. When in a restricted subtree, remove it. The restriction will span over the entire file if TYPE is `file', -or if type is '(4), or if the cursor is before the first headline +or if type is \\='(4), or if the cursor is before the first headline in the file. Otherwise, only apply the restriction to the current subtree. commit 163424e04b7f75a1655fd263ba4b6d6d4fa880b2 Author: Po Lu Date: Thu Jul 28 19:25:46 2022 +0800 Correctly set marker position after specpdl is unwound during printing * src/print.c (PRINTFINISH): Don't call set_marker_both with the wrong current_buffer. Reported by Lars Ingebrigtsen . diff --git a/src/print.c b/src/print.c index 5ad4d4fbb5..7bb905b269 100644 --- a/src/print.c +++ b/src/print.c @@ -180,14 +180,14 @@ bool print_output_debug_flag EXTERNALLY_VISIBLE = 1; print_buffer_pos_byte, 0, 1, 0); \ signal_after_change (PT - print_buffer_pos, 0, print_buffer_pos);\ } \ - unbind_to (specpdl_count, Qnil); \ if (MARKERP (original)) \ set_marker_both (original, Qnil, PT, PT_BYTE); \ if (old_point >= 0) \ SET_PT_BOTH (old_point + (old_point >= start_point \ ? PT - start_point : 0), \ old_point_byte + (old_point_byte >= start_point_byte \ - ? PT_BYTE - start_point_byte : 0)); + ? PT_BYTE - start_point_byte : 0)); \ + unbind_to (specpdl_count, Qnil); \ /* This is used to free the print buffer; we don't simply record xfree since print_buffer can be reallocated during the printing. */ commit 04b9216b92a4ee1661e79da785cf87fc7c3a4c4e Author: Stefan Kangas Date: Fri Jul 15 18:46:16 2022 +0200 Make quickurl.el obsolete (part 2/2) * lisp/obsolete/quickurl.el: Add "Obsolete-since" header. * lisp/info.el (Info-file-list-for-emacs): Delete quickurl entry. * doc/misc/autotype.texi (QuickURL): Delete section. diff --git a/doc/misc/autotype.texi b/doc/misc/autotype.texi index b005c9c34f..93c65692d0 100644 --- a/doc/misc/autotype.texi +++ b/doc/misc/autotype.texi @@ -92,7 +92,6 @@ completions and expansions of text at point. * Copyrights:: Inserting and updating copyrights. * Executables:: Turning interpreter scripts into executables. * Timestamps:: Updating dates and times in modified files. -* QuickURL:: Inserting URLs based on text at point. * Tempo:: Flexible template insertion. * Hippie Expand:: Expansion of text trying various methods. * Skeleton Language:: Making skeleton commands insert what you want. @@ -478,31 +477,6 @@ The time stamp is written between the brackets or quotes: Time-stamp: <1998-02-18 10:20:51 gildea> @end example -@node QuickURL -@chapter QuickURL: Inserting URLs Based on Text at Point - -@vindex quickurl-url-file -@findex quickurl -@cindex URLs -@kbd{M-x quickurl} can be used to insert a URL into a buffer based on -the text at point. The URLs are stored in an external file defined by -the variable @code{quickurl-url-file} as a list of either cons cells of -the form @code{(@var{key} . @var{URL})} or -lists of the form @code{(@var{key} @var{URL} @var{comment})}. These -specify that @kbd{M-x quickurl} should insert @var{URL} if the word -@var{key} is at point, for example: - -@example -(("FSF" "https://www.fsf.org/" "The Free Software Foundation") - ("emacs" . "https://www.gnu.org/software/emacs/")) -@end example - -@findex quickurl-add-url -@findex quickurl-list -@kbd{M-x quickurl-add-url} can be used to add a new @var{key}/@var{URL} -pair. @kbd{M-x quickurl-list} provides interactive editing of the URL -list. - @node Tempo @chapter Tempo: Flexible Template Insertion diff --git a/etc/NEWS b/etc/NEWS index 8ca2e51e28..3941455efc 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -335,6 +335,10 @@ the major mode according to 'initial-major-mode', like at Emacs startup. Previously, these functions ignored 'initial-scratch-message' and left "*scratch*" in 'fundamental-mode'. +--- +** The quickurl.el library is now obsolete. +Use 'skeleton' or 'tempo' instead. + --- ** The rlogin.el library and 'rsh' command are now obsolete. Use something like 'M-x shell RET ssh RET' instead. diff --git a/lisp/info.el b/lisp/info.el index fca4051224..7c1b34ed64 100644 --- a/lisp/info.el +++ b/lisp/info.el @@ -4520,7 +4520,7 @@ Advanced commands: ("java" . "ccmode") ("idl" . "ccmode") ("pike" . "ccmode") ("skeleton" . "autotype") ("auto-insert" . "autotype") ("copyright" . "autotype") ("executable" . "autotype") - ("time-stamp" . "autotype") ("quickurl" . "autotype") + ("time-stamp" . "autotype") ("tempo" . "autotype") ("hippie-expand" . "autotype") ("cvs" . "pcl-cvs") ("ada" . "ada-mode") "calc" ("calcAlg" . "calc") ("calcDigit" . "calc") ("calcVar" . "calc") diff --git a/lisp/obsolete/quickurl.el b/lisp/obsolete/quickurl.el index 61cae43a88..5ac10323d1 100644 --- a/lisp/obsolete/quickurl.el +++ b/lisp/obsolete/quickurl.el @@ -5,6 +5,7 @@ ;; Author: Dave Pearson ;; Created: 1999-05-28 ;; Keywords: hypermedia +;; Obsolete-since: 29.1 ;; This file is part of GNU Emacs. commit 73465fe481e0db21234b1564e668b4e9a47a08aa Author: Stefan Kangas Date: Fri Jul 15 18:40:58 2022 +0200 Make net/quickurl.el obsolete (part 1/2) * lisp/net/quickurl.el: Move from here... * lisp/obsolete/quickurl.el: ...to here. diff --git a/lisp/net/quickurl.el b/lisp/obsolete/quickurl.el similarity index 100% rename from lisp/net/quickurl.el rename to lisp/obsolete/quickurl.el commit f2c7c664a7777584f62e23c02fc9e06cde0788bf Author: Lars Ingebrigtsen Date: Thu Jul 28 12:39:45 2022 +0200 Don't export print--unreadable-callback-buffer to lisp * src/print.c (syms_of_print): Don't export `print--unreadable-callback-buffer' to lisp. diff --git a/src/print.c b/src/print.c index 48c945d08a..5ad4d4fbb5 100644 --- a/src/print.c +++ b/src/print.c @@ -2931,6 +2931,8 @@ be printed. */); Vprint__unreadable_callback_buffer = Qnil; DEFSYM (Qprint__unreadable_callback_buffer, "print--unreadable-callback-buffer"); + /* Don't export this variable to Elisp. */ + Funintern (Qprint__unreadable_callback_buffer, Qnil); defsubr (&Sflush_standard_output); commit 4895ca16f76aa0ec044212a2b96ef8646cf4d0ed Author: Lars Ingebrigtsen Date: Thu Jul 28 12:23:53 2022 +0200 Ensure that we don't call print-unreadable-function from " prin1" * src/print.c (PRINTPREPARE): Bind the current buffer so that we can retrieve it later. (print_vectorlike): Use it (bug#56773). (syms_of_print): New internal `print--unreadable-callback-buffer' variable. diff --git a/src/print.c b/src/print.c index 384a639b31..48c945d08a 100644 --- a/src/print.c +++ b/src/print.c @@ -105,6 +105,7 @@ bool print_output_debug_flag EXTERNALLY_VISIBLE = 1; = !NILP (BVAR (current_buffer, enable_multibyte_characters)); \ Lisp_Object original = printcharfun; \ record_unwind_current_buffer (); \ + specbind(Qprint__unreadable_callback_buffer, Fcurrent_buffer ()); \ if (NILP (printcharfun)) printcharfun = Qt; \ if (BUFFERP (printcharfun)) \ { \ @@ -1655,6 +1656,17 @@ print_vectorlike (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag, infinite recursion in the function called. */ Lisp_Object func = Vprint_unreadable_function; specbind (Qprint_unreadable_function, Qnil); + + /* If we're being called from `prin1-to-string' or the like, + we're now in the secret " prin1" buffer. This can lead to + problems if, for instance, the callback function switches a + window to this buffer -- this will make Emacs segfault. */ + if (!NILP (Vprint__unreadable_callback_buffer) + && Fbuffer_live_p (Vprint__unreadable_callback_buffer)) + { + record_unwind_current_buffer (); + set_buffer_internal (XBUFFER (Vprint__unreadable_callback_buffer)); + } Lisp_Object result = CALLN (Ffuncall, func, obj, escapeflag? Qt: Qnil); unbind_to (count, Qnil); @@ -2913,6 +2925,13 @@ be printed. */); Vprint_unreadable_function = Qnil; DEFSYM (Qprint_unreadable_function, "print-unreadable-function"); + DEFVAR_LISP ("print--unreadable-callback-buffer", + Vprint__unreadable_callback_buffer, + doc: /* Dynamically bound to indicate current buffer. */); + Vprint__unreadable_callback_buffer = Qnil; + DEFSYM (Qprint__unreadable_callback_buffer, + "print--unreadable-callback-buffer"); + defsubr (&Sflush_standard_output); /* Initialized in print_create_variable_mapping. */ diff --git a/test/lisp/subr-tests.el b/test/lisp/subr-tests.el index 20f81d1ddc..1d85631a4b 100644 --- a/test/lisp/subr-tests.el +++ b/test/lisp/subr-tests.el @@ -1122,5 +1122,15 @@ final or penultimate step during initialization.")) (should (equal (butlast l n) (subr-tests--butlast-ref l n)))))) +(ert-deftest test-print-unreadable-function-buffer () + (with-temp-buffer + (let ((current (current-buffer)) + callback-buffer) + (let ((print-unreadable-function + (lambda (_object _escape) + (setq callback-buffer (current-buffer))))) + (prin1-to-string (make-marker))) + (should (eq current callback-buffer))))) + (provide 'subr-tests) ;;; subr-tests.el ends here diff --git a/test/src/print-tests.el b/test/src/print-tests.el index f818b4d471..91187d9f45 100644 --- a/test/src/print-tests.el +++ b/test/src/print-tests.el @@ -529,6 +529,5 @@ otherwise, use a different charset." (should (equal (% (- (length numbers) loopback-index) loop) 0))))))))))) - (provide 'print-tests) ;;; print-tests.el ends here commit ba54f7e39c22de097340dafa39abbef12b601260 Author: Eli Zaretskii Date: Thu Jul 28 12:56:44 2022 +0300 ; * doc/lispref/windows.texi (Window Sizes): Another typo. (Bug#56811) diff --git a/doc/lispref/windows.texi b/doc/lispref/windows.texi index 60baf51780..597e31fe85 100644 --- a/doc/lispref/windows.texi +++ b/doc/lispref/windows.texi @@ -747,7 +747,7 @@ the selected window. If @var{window} is internal, the return value is the total width occupied by its descendant windows. If a window's pixel width is not an integral multiple of its frame's -character width, the number of lines occupied by the window is rounded +character width, the number of columns occupied by the window is rounded internally. This is done in a way such that, if the window is a parent window, the sum of the total widths of all its children internally equals the total width of their parent. This means that although two commit 7990d0c36ae09c5b1d033f189c6218fcfa65afc2 Author: Eli Zaretskii Date: Thu Jul 28 12:29:07 2022 +0300 ; * doc/lispref/windows.texi (Window Sizes): Fix a typo. (Bug#56811) diff --git a/doc/lispref/windows.texi b/doc/lispref/windows.texi index e070e84c67..60baf51780 100644 --- a/doc/lispref/windows.texi +++ b/doc/lispref/windows.texi @@ -737,7 +737,7 @@ with any other @var{round} it returns the internal value of @cindex window width @cindex width of a window @cindex total width of a window -The @dfn{total width} of a window is the number of lines comprising its +The @dfn{total width} of a window is the number of columns comprising its body and its left and right decorations (@pxref{Basic Windows}). @defun window-total-width &optional window round commit 1c8e90649e440830ebe288251848170f42ade3b4 Author: Stefan Kangas Date: Thu Jul 28 11:20:47 2022 +0200 Bump Emacs version to 28.1.91 * README: * configure.ac: * msdos/sed2v2.inp: * nt/README.W32: Bump Emacs version to 28.1.91. diff --git a/README b/README index c822650f6d..c949c34b4d 100644 --- a/README +++ b/README @@ -2,7 +2,7 @@ Copyright (C) 2001-2022 Free Software Foundation, Inc. See the end of the file for license conditions. -This directory tree holds version 28.1.90 of GNU Emacs, the extensible, +This directory tree holds version 28.1.91 of GNU Emacs, the extensible, customizable, self-documenting real-time display editor. The file INSTALL in this directory says how to build and install GNU diff --git a/configure.ac b/configure.ac index 03eb9783a9..57b86e8542 100644 --- a/configure.ac +++ b/configure.ac @@ -23,7 +23,7 @@ dnl along with GNU Emacs. If not, see . AC_PREREQ(2.65) dnl Note this is parsed by (at least) make-dist and lisp/cedet/ede/emacs.el. -AC_INIT(GNU Emacs, 28.1.90, bug-gnu-emacs@gnu.org, , https://www.gnu.org/software/emacs/) +AC_INIT(GNU Emacs, 28.1.91, bug-gnu-emacs@gnu.org, , https://www.gnu.org/software/emacs/) dnl Set emacs_config_options to the options of 'configure', quoted for the shell, dnl and then quoted again for a C string. Separate options with spaces. diff --git a/msdos/sed2v2.inp b/msdos/sed2v2.inp index 2914838d8b..d6b06519b9 100644 --- a/msdos/sed2v2.inp +++ b/msdos/sed2v2.inp @@ -67,7 +67,7 @@ /^#undef PACKAGE_NAME/s/^.*$/#define PACKAGE_NAME ""/ /^#undef PACKAGE_STRING/s/^.*$/#define PACKAGE_STRING ""/ /^#undef PACKAGE_TARNAME/s/^.*$/#define PACKAGE_TARNAME ""/ -/^#undef PACKAGE_VERSION/s/^.*$/#define PACKAGE_VERSION "28.1.90"/ +/^#undef PACKAGE_VERSION/s/^.*$/#define PACKAGE_VERSION "28.1.91"/ /^#undef SYSTEM_TYPE/s/^.*$/#define SYSTEM_TYPE "ms-dos"/ /^#undef HAVE_DECL_GETENV/s/^.*$/#define HAVE_DECL_GETENV 1/ /^#undef SYS_SIGLIST_DECLARED/s/^.*$/#define SYS_SIGLIST_DECLARED 1/ diff --git a/nt/README.W32 b/nt/README.W32 index b02935e51a..f5a9cfb688 100644 --- a/nt/README.W32 +++ b/nt/README.W32 @@ -1,7 +1,7 @@ Copyright (C) 2001-2022 Free Software Foundation, Inc. See the end of the file for license conditions. - Emacs version 28.1.90 for MS-Windows + Emacs version 28.1.91 for MS-Windows This README file describes how to set up and run a precompiled distribution of the latest version of GNU Emacs for MS-Windows. You commit 92e77873adbe12e364132653595b03dc702573f8 Author: Stefan Kangas Date: Thu Jul 28 11:15:51 2022 +0200 Update ChangeLog and AUTHORS for 28.1.91 pretest * ChangeLog.3: * etc/AUTHORS: Update. diff --git a/ChangeLog.3 b/ChangeLog.3 index 9c7a86466c..c64b8f3785 100644 --- a/ChangeLog.3 +++ b/ChangeLog.3 @@ -1,3 +1,361 @@ +2022-07-28 Lars Ingebrigtsen + + Revert the `...' documentation back to actual usage + + * doc/lispref/tips.texi (Documentation Tips): Document how `...' + is really used now (bug#55780). ‘...’ is not really used in the + Emacs sources. + + (cherry picked from commit 1ed9c1c7f9fe32ff5123091033350beb1ccae4ca) + +2022-07-28 Paul Pogonyshev + + Release the desktop lock in 'kill-emacs-hook' + + * lisp/desktop.el: Run 'desktop--on-kill' in 'kill-emacs-hook'. + (desktop--on-kill): New function, refactored from 'desktop-kill'. + (desktop-kill): Call 'desktop--on-kill'. (Bug#56800) + +2022-07-25 Eli Zaretskii + + Avoid infloop in 'recenter' + + * src/window.c (Frecenter): Avoid infinite loop in the minibuffer + under 'fido-vertical-mode'. (Bug#56765) + +2022-07-25 Eli Zaretskii + + Fix inaccuracies in "lax search" documentation + + * doc/emacs/search.texi (Lax Search): Update the examples of + character folding in search. (Bug#56747) + +2022-07-24 Kyle Meyer + + Update to Org 9.5.4-17-g6e991f + +2022-07-24 Eugene Ha (tiny change) + + Find libgccjit.dylib on Homebrew Macos + + * configure.ac: Also find libggcjit on Homebrew (bug#55173). + + (cherry picked from commit faa29fa2c9e9d5a5d7544a1a39b2a89cf57a8439) + +2022-07-23 Michael Albinus + + Set `default-directory' of Tramp archive connection buffer + + * lisp/net/tramp-archive.el (tramp-archive-file-name-handler): + Set `default-directory' of Tramp connection buffer. (Bug#56628) + +2022-07-23 Eli Zaretskii + + Update the documentation of 'declare' forms + + * doc/lispref/compile.texi (Native-Compilation Variables): Mention + the 'declare' alternative for 'native-comp-speed'. + * doc/lispref/functions.texi (Declare Form): Document 'declare' + forms that were previously undocumented. + +2022-07-23 Eli Zaretskii + + Fix bookmark support for Help functions in native-compilation builds + + * lisp/help.el (describe-key--helper, describe-function--helper): + New helper functions. + (describe-key): Call 'describe-key--helper' instead of a + lambda-function. + * lisp/help-fns.el (describe-function): Call + 'describe-function--helper' instead of a lambda-function. + (Bug#56643) + +2022-07-23 Miha Rihtarsic + + Fix mode line mouse-1 binding when showing only column numbers + + * lisp/bindings.el (mode-line-position): Fix the mouse-1 binding + when showing only column numbers (bug#56694). Do not merge to + master. + +2022-07-23 Stefan Kangas + + Adjust help-fns.el tests for recent change + + * test/lisp/help-fns-tests.el (help-fns-test-lisp-defun) + (help-fns-test-lisp-defsubst): Adjust tests for recent change. + +2022-07-22 Robert Pluim + + * src/terminal.c (Fframe_terminal): Use active voice + +2022-07-22 Robert Pluim + + Improve 'terminal-live-p' docstring some more + + * src/terminal.c (Fterminal_live_p): Improve description of + arguments and return value. + +2022-07-22 Robert Pluim + + Improve terminal-live-p docstring + + * src/terminal.c (Fterminal_live_p): Explain what happens when the + argument is nil. + +2022-07-22 Robert Pluim + + * lisp/net/tramp-gvfs.el (tramp-gvfs-dbus-event-vector): Fix grammar + +2022-07-21 Stefan Kangas + + * lisp/progmodes/cperl-mode.el: Don't mention obsolete archive. + +2022-07-21 Eli Zaretskii + + Make 'describe-function' say "byte-compiled" when appropriate + + * lisp/help-fns.el (help-fns-function-description-header): Say + "byte-compiled" when describing byte-compiled functions. + +2022-07-21 Eli Zaretskii + + ;Improve documentation of locale-specific string comparison + + * doc/lispref/strings.texi (Text Comparison): Mention the Unicode + collation rules and buffer-local case-tables. + +2022-07-19 Gerd Moellmann + + Prevent GC of window referenced from EmacsScroller + + * src/nsterm.m (EmacsScroller.mark, mark_nsterm): New functions. + * src/nsterm.h (EmacsScroller.mark, mark_nsterm): Declare. + * src/alloc.c (garbage_collect) [MAVE_NS]: Call mark_nsterm. + (Bug#56095) + + (cherry picked from commit 5f1bd872478927ad4bc635502e74628d39885286) + +2022-07-16 Stefan Kangas + + Fix obsoletion of nntp-authinfo-file + + * lisp/gnus/nntp.el (nntp-authinfo-file): Fix obsoletion. + +2022-07-15 Philipp Stephani + + Build Seccomp filter only if we have a 64-bit userspace (Bug#56549) + + * configure.ac (SIZEOF_LONG): New variable. + * lib-src/Makefile.in (SIZEOF_LONG): New variable; added conditional. + +2022-07-14 Stefan Kangas + + Update the Samaritan's contact details in M-x doctor + + * lisp/play/doctor.el (doctor-death): Update the Samaritans's contact + details; anon.twwells.com is no longer valid. Add link to Wikipedia. + +2022-07-14 Eli Zaretskii + + * etc/PROBLEMS: Describe problems with remote files. (Bug#56499) + +2022-07-13 Andrea Corallo + + Remove uneffective test + + * test/src/comp-tests.el (45603-1): Remove test. + * test/src/comp-resources/comp-test-45603.el: Delete. + +2022-07-13 Andrea Corallo + + Mark async worker tmp file as utf-8-emacs-unix (bug#48029) + + * lisp/emacs-lisp/comp.el (comp-final): Mark async worker tmp file + as utf-8. + * test/src/comp-tests.el (48029-1): New test. + * test/src/comp-resources/comp-test-funcs.el + (comp-test-48029-nonascii-žžž-f): New function. + +2022-07-13 Michael Albinus + + Adapt Tramp version (don't merge) + + * doc/misc/trampver.texi: + * lisp/net/trampver.el: Change version to "2.5.3.28.2". + (customize-package-emacs-version-alist): + Add Tramp version integrated in Emacs 28.2. + +2022-07-13 Michael Albinus + + Adapt Tramp doc + + * doc/misc/tramp.texi (Configuration): Mention enable-remote-dir-locals. + (Traces and Profiles): Fix tramp-verbose description. + + * lisp/net/tramp.el (tramp-verbose): Fix docstring. + +2022-07-12 Stefan Kangas + + Don't mention cl-cXXXr aliases in cl-lib manual + + * doc/misc/cl.texi (Lists, List Functions, Efficiency Concerns): Don't + mention 'cl-cXXXr' compatibility aliases for built-in 'cXXXr' + functions. They shouldn't be used in new code. + +2022-07-11 Ken Brown + + etc/PROBLEMS: Describe issues with native compilation on Cygwin + +2022-07-11 Stefan Kangas + + * lisp/find-dired.el (find-dired): Doc fix; add crossreference. + +2022-07-08 Stefan Kangas + + Doc fix; don't mention obsolete variable + + * src/window.c (Fset_window_hscroll): Doc fix; don't mention obsolete + variable. + +2022-07-05 Stefan Kangas + + Add index entry for "ignore case" + + * doc/emacs/glossary.texi (Glossary): Add index entry for "ignore + case" pointing to "Case Folding". + +2022-07-05 Stefan Kangas + + Expand docstrings related to auto-saving + + * lisp/files.el (auto-save-visited-mode): + * lisp/simple.el (auto-save-mode): Expand docstring. + +2022-07-04 Lars Ingebrigtsen + + Don't bug out in manual-html-fix-index-2 on newer makeinfo versions + + Backport from master. + + * admin/admin.el (manual-html-fix-index-2): Don't bug out if the + makeinfo version doesn't include
    . + + (cherry picked from commit e0e3f2b672bc42da52ac9c7596c7560a88684651) + +2022-07-04 Lars Ingebrigtsen + + Preserve in the Emacs manuals + + Backport from master. + + * admin/admin.el (manual-html-fix-headers): Preserve the <title> + element (bug#48334). + + (cherry picked from commit b778e71af7ca8c59917334b4bb1b34cdb52faca9) + +2022-07-03 Eli Zaretskii <eliz@gnu.org> + + Document 'jit-lock-debug-mode' + + * doc/lispref/modes.texi (Other Font Lock Variables): Document + 'jit-lock-debug-mode'. + +2022-07-02 Alan Mackenzie <acm@muc.de> + + * lisp/progmodes/cc-mode.el (c-common-init): Bind case-fold-search to nil + + Backport: This fixes bug #53605. + +2022-07-02 Alan Mackenzie <acm@muc.de> + + CC Mode: Fix a c-backward-token-2 call wrongly jumping back over macros. + + This fixes bug #56256. + + * lisp/progmodes/cc-fonts.el (c-font-lock-c++-lambda-captures): Replace a + c-backward-token-2, which could jump back too far leading to an infinite + loop, with a save-excursion to remember the point we've got to go back to. + +2022-07-02 Stefan Kangas <stefan@marxist.se> + + Doc fixes; don't use obsolete names + + * etc/compilation.txt: + * lisp/mh-e/mh-funcs.el (mh-kill-folder): Don't use obsolete + names. + +2022-07-02 Stefan Kangas <stefan@marxist.se> + + Don't refer to obsolete alias for insert-char + + * lisp/leim/quail/persian.el: Don't refer to obsolete alias for + insert-char. + +2022-07-02 Stefan Kangas <stefan@marxist.se> + + Don't use obsolete face name in manoj-dark-theme + + * etc/themes/manoj-dark-theme.el (change-log-acknowledgment): Don't + use obsolete/non-existent face name. + +2022-07-01 Eli Zaretskii <eliz@gnu.org> + + Fix "C-u C-x =" for SPC + + * lisp/descr-text.el (describe-char): Don't report 'nobreak-space' + face for SPC. (Bug#56337) + +2022-06-30 Stefan Kangas <stefan@marxist.se> + + Doc fixes: don't refer to some obsolete items + + * admin/notes/multi-tty: + * lisp/chistory.el (command-history): + * lisp/emacs-lisp/nadvice.el: + * lisp/vc/diff-mode.el: Doc fix; don't refer to obsolete variables and + functions. + +2022-06-30 Stefan Kangas <stefan@marxist.se> + + Remove obsolete cust-print from elisp index + + * doc/lispref/edebug.texi (Printing in Edebug): Remove obsolete + library "cust-print" from index. + +2022-06-30 Stefan Kangas <stefan@marxist.se> + + * admin/make-tarball.txt: Minor clarifications. + +2022-06-30 Eli Zaretskii <eliz@gnu.org> + + Fix external image conversion on MS-Windows + + * lisp/image/image-converter.el (image-converter--convert-magick) + (image-converter--convert): Force encoding/decoding to avoid any + text or EOL conversions, since we are reading/writing binary + data. (Bug#56317) + +2022-06-29 Stefan Monnier <monnier@iro.umontreal.ca> + + * doc/emacs/buffers.texi (Indirect Buffers): Mention modification hook quirk + +2022-06-29 Stefan Kangas <stefan@marxist.se> + + Bump Emacs version to 28.1.90 + + * README: + * configure.ac: + * msdos/sed2v2.inp: + * nt/README.W32: Bump Emacs version to 28.1.90. + +2022-06-29 Stefan Kangas <stefan@marxist.se> + + Update ChangeLog and AUTHORS for 28.1.90 pretest + + * ChangeLog.3: + * etc/AUTHORS: Update. + 2022-06-29 Michael Albinus <michael.albinus@gmx.de> Update Tramp version (don't merge with master) @@ -236200,7 +236558,7 @@ This file records repository revisions from commit 9d56a21e6a696ad19ac65c4b405aeca44785884a (exclusive) to -commit 7f749e44dbd50430e14f319b4c4d3f767740b10b (inclusive). +commit 05df70e755f72b7a4c7b7d94ca2349f1c5c67968 (inclusive). See ChangeLog.2 for earlier changes. ;; Local Variables: diff --git a/etc/AUTHORS b/etc/AUTHORS index b5444e60a7..8946800e0b 100644 --- a/etc/AUTHORS +++ b/etc/AUTHORS @@ -281,8 +281,8 @@ Andrea Corallo: wrote comp-cstr-tests.el comp-cstr.el comp-tests.el comp.el and changed comp.c pdumper.c lread.c bytecomp.el comp.h configure.ac lisp.h startup.el loadup.el alloc.c data.c emacs.c .gitlab-ci.yml - nadvice.el cl-macs.el advice.el help.el lisp/Makefile.in package.el - Makefile.in comp-test-funcs.el and 62 other files + nadvice.el cl-macs.el advice.el comp-test-funcs.el help.el + lisp/Makefile.in package.el Makefile.in and 61 other files André A. Gomes: changed ispell.el @@ -1733,6 +1733,8 @@ Etienne Prud’Homme: changed align.el css-mode-tests.el css-mode.el Eugene Exarevsky: changed sql.el +Eugene Ha: changed configure.ac + Evangelos Evangelou: changed progmodes/f90.el Evan Moses: changed progmodes/python.el @@ -1981,7 +1983,7 @@ Gerd Möllmann: wrote authors.el ebrowse.el jit-lock.el tooltip.el and changed xdisp.c xterm.c dispnew.c dispextern.h xfns.c xfaces.c window.c keyboard.c lisp.h faces.el alloc.c buffer.c startup.el xterm.h fns.c simple.el term.c configure.ac frame.c xmenu.c emacs.c - and 607 other files + and 609 other files Gergely Nagy: changed erc.el @@ -3311,7 +3313,7 @@ and co-wrote gnus-kill.el gnus-mh.el gnus-msg.el gnus-score.el and changed gnus.texi simple.el subr.el files.el process.c display.texi text.texi dired.el gnutls.c gnus-ems.el smtpmail.el help-fns.el auth-source.el url-http.el edebug.el image.el gnus-cite.el pop3.el - dired-aux.el fns.c image.c and 866 other files + dired-aux.el fns.c image.c and 867 other files Lars Rasmusson: changed ebrowse.c @@ -3930,8 +3932,8 @@ Miguel Ruiz: changed ob-gnuplot.el Mihai Olteanu: changed hexl.el Miha Rihtaršič: changed keyboard.c commands.texi minibuf.c minibuffer.el - simple.el comint.el data.c delsel.el errors.texi esh-mode.el eval.c - ibuffer.el macros.c process.c sh-script.el + simple.el bindings.el comint.el data.c delsel.el errors.texi + esh-mode.el eval.c ibuffer.el macros.c process.c sh-script.el Mihir Rege: changed js.el @@ -4327,9 +4329,9 @@ and changed message.el gnus-util.el gnus-int.el gnus.el gnus-agent.el Paul Pogonyshev: changed subr.el byte-opt.el bytecomp.el emacs-lisp/debug.el eval.c progmodes/python.el which-func.el align.el - bytecode.c cc-langs.el cl-macs.el configure.ac dabbrev.el display.texi - eldoc.el elisp-mode.el ert.el ert.texi etags.el fns-tests.el fns.c - and 20 other files + bytecode.c cc-langs.el cl-macs.el configure.ac dabbrev.el desktop.el + display.texi eldoc.el elisp-mode.el ert.el ert.texi etags.el + fns-tests.el and 21 other files Paul Rankin: changed outline.el @@ -4785,7 +4787,7 @@ Robert Pluim: wrote nsm-tests.el and changed configure.ac process.c blocks.awk network-stream-tests.el font.c processes.texi ftfont.c gtkutil.c vc-git.el process-tests.el emoji-zwj.awk gnutls.el network-stream.el nsm.el tramp.texi mml-sec.el - nsterm.m unicode xfns.c auth.texi composite.c and 136 other files + nsterm.m unicode xfns.c auth.texi composite.c and 138 other files Robert Thorpe: changed cus-start.el indent.el rmail.texi @@ -5179,7 +5181,7 @@ and co-wrote help-tests.el keymap-tests.el and changed efaq.texi checkdoc.el package.el cperl-mode.el bookmark.el help.el keymap.c subr.el simple.el erc.el ediff-util.el idlwave.el time.el bytecomp-tests.el comp.el speedbar.el bytecomp.el edebug.el - emacs-lisp-intro.texi flyspell.el ibuffer.el and 1339 other files + emacs-lisp-intro.texi flyspell.el ibuffer.el and 1344 other files Stefan Merten: co-wrote rst.el commit 093214402bf776f6732c5534889a9151057454de Author: Stefan Kangas <stefan@marxist.se> Date: Thu Jul 28 11:07:27 2022 +0200 ; * admin/authors.el (authors-aliases): Update. diff --git a/admin/authors.el b/admin/authors.el index aec52515d9..46d824306b 100644 --- a/admin/authors.el +++ b/admin/authors.el @@ -163,6 +163,7 @@ files.") ("Michael R. Cook" "Michael Cook") ("Michael Sperber" "Mike Sperber" "Michael Sperber \\[Mr. Preprocessor\\]") ("Michalis V" "^mvar") + ("Miha Rihtaršič" "Miha Rihtarsic") ("Mikio Nakajima" "Nakajima Mikio") ("Nelson Jose dos Santos Ferreira" "Nelson Ferreira") ("Noorul Islam" "Noorul Islam K M") commit 22a5f022344af8c0c0a9eddc2ac5ad36392d0cef Author: Stefan Kangas <stefan@marxist.se> Date: Thu Jul 28 10:48:07 2022 +0200 Doc fixes: don't mention EFS * doc/misc/ede.texi (ede-project): * doc/misc/gnus.texi (Directory Groups, Various Various): * lisp/cedet/ede/base.el (ede-project): * lisp/gnus/mml.el (mml-attach-external): * lisp/org/org.el (org-file-apps): * lisp/url/url-file.el (url-file-find-possibly-compressed-file): Doc fixes; don't mention XEmacs specific library EFS. diff --git a/doc/misc/ede.texi b/doc/misc/ede.texi index af8e2153dd..9867883b24 100644 --- a/doc/misc/ede.texi +++ b/doc/misc/ede.texi @@ -1551,14 +1551,14 @@ This is a URL to be sent to a web site for documentation. @item :web-site-directory @* A directory where web pages can be found by Emacs. -For remote locations use a path compatible with ange-ftp or EFS@. +For remote locations use a path compatible with ange-ftp. You can also use TRAMP for use with rcp & scp. @item :web-site-file @* A file which contains the website for this project. This file can be relative to slot @code{web-site-directory}. -This can be a local file, use ange-ftp, EFS, or TRAMP. +This can be a local file, use ange-ftp or TRAMP. @item :ftp-site Type: @code{string} @* diff --git a/doc/misc/gnus.texi b/doc/misc/gnus.texi index 6b5173d3c2..7da90dfb1d 100644 --- a/doc/misc/gnus.texi +++ b/doc/misc/gnus.texi @@ -17518,16 +17518,16 @@ If you have a directory that has lots of articles in separate files in it, you might treat it as a newsgroup. The files have to have numerical names, of course. -This might be an opportune moment to mention @code{ange-ftp} (and its -successor @code{efs}), that most wonderful of all wonderful Emacs -packages. When I wrote @code{nndir}, I didn't think much about it---a -back end to read directories. Big deal. +This might be an opportune moment to mention @code{ange-ftp}, that +most wonderful of all wonderful Emacs packages. When I wrote +@code{nndir}, I didn't think much about it---a back end to read +directories. Big deal. @code{ange-ftp} changes that picture dramatically. For instance, if you enter the @code{ange-ftp} file name @file{/ftp.hpc.uh.edu:/pub/emacs/ding-list/} as the directory name, -@code{ange-ftp} or @code{efs} will actually allow you to read this -directory over at @samp{sina} as a newsgroup. Distributed news ahoy! +@code{ange-ftp} will actually allow you to read this directory over at +@samp{sina} as a newsgroup. Distributed news ahoy! @code{nndir} will use @acronym{NOV} files if they are present. @@ -26778,7 +26778,7 @@ on finding a separator line between the head and the body. If this variable is @code{nil}, there is no upper read bound. If it is @code{t}, the back ends won't try to read the articles piece by piece, but read the entire articles. This makes sense with some versions of -@code{ange-ftp} or @code{efs}. +@code{ange-ftp}. @item nnheader-head-chop-length @vindex nnheader-head-chop-length diff --git a/lisp/cedet/ede/base.el b/lisp/cedet/ede/base.el index 9d23909d62..27016f0f5c 100644 --- a/lisp/cedet/ede/base.el +++ b/lisp/cedet/ede/base.el @@ -204,7 +204,7 @@ This is a URL to be sent to a web site for documentation.") :group name :documentation "A directory where web pages can be found by Emacs. -For remote locations use a path compatible with ange-ftp or EFS. +For remote locations use a path compatible with ange-ftp. You can also use TRAMP for use with rcp & scp.") (web-site-file :initarg :web-site-file :initform "" @@ -214,7 +214,7 @@ You can also use TRAMP for use with rcp & scp.") :documentation "A file which contains the website for this project. This file can be relative to slot `web-site-directory'. -This can be a local file, use ange-ftp, EFS, or TRAMP.") +This can be a local file, use ange-ftp or TRAMP.") (ftp-site :initarg :ftp-site :initform "" :type string diff --git a/lisp/gnus/mml.el b/lisp/gnus/mml.el index a36f29ba10..5cd57d2f80 100644 --- a/lisp/gnus/mml.el +++ b/lisp/gnus/mml.el @@ -1514,7 +1514,7 @@ BUFFER is the name of the buffer to attach. See (defun mml-attach-external (file &optional type description) "Attach an external file into the buffer. -FILE is an ange-ftp/efs specification of the part location. +FILE is an ange-ftp specification of the part location. TYPE is the MIME type to use." (interactive (let* ((file (mml-minibuffer-read-file "Attach external file: ")) diff --git a/lisp/org/org.el b/lisp/org/org.el index d5dfc36e04..7ab1801cfa 100644 --- a/lisp/org/org.el +++ b/lisp/org/org.el @@ -1357,7 +1357,7 @@ Possible values for the file identifier are: to open [[file:document.pdf::5]] with evince at page 5. `directory' Matches a directory - `remote' Matches a remote file, accessible through tramp or efs. + `remote' Matches a remote file, accessible through tramp. Remote files most likely should be visited through Emacs because external applications cannot handle such paths. `auto-mode' Matches files that are matched by any entry in `auto-mode-alist', diff --git a/lisp/url/url-file.el b/lisp/url/url-file.el index 3863ac9914..99e62d9b7a 100644 --- a/lisp/url/url-file.el +++ b/lisp/url/url-file.el @@ -42,10 +42,10 @@ src=\"/ssh:host...\"> element, which can be disturbing.") (defun url-file-find-possibly-compressed-file (fname &rest _) "Find the exact file referenced by `fname'. This tries the common compression extensions, because things like -ange-ftp and efs are not quite smart enough to realize when a server -can do automatic decompression for them, and won't find `foo' if -`foo.gz' exists, even though the FTP server would happily serve it up -to them." +ange-ftp is not quite smart enough to realize when a server can +do automatic decompression for them, and won't find `foo' if +`foo.gz' exists, even though the FTP server would happily serve +it up to them." (let ((scratch nil) (compressed-extensions '("" ".gz" ".z" ".Z" ".bz2" ".xz")) (found nil)) commit 2bab0f2db6fff3a99d3bc498d6139ee42aab96ea Author: Eli Zaretskii <eliz@gnu.org> Date: Thu Jul 28 11:39:28 2022 +0300 Minor update of truncate-line optimization * src/xdisp.c (forward_to_next_line_start): Look into display and overlay strings only when lines are truncated on display. diff --git a/src/xdisp.c b/src/xdisp.c index 66b37a855b..6237d5a022 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -7266,7 +7266,8 @@ forward_to_next_line_start (struct it *it, bool *skipped_p, if (!no_strings_with_newlines) { - if (!current_buffer->long_line_optimizations_p) + if (!(current_buffer->long_line_optimizations_p + && it->line_wrap == TRUNCATE)) { /* Quick-and-dirty check: if there isn't any `display' property in sight, and no overlays, we're done. */ @@ -7280,10 +7281,10 @@ forward_to_next_line_start (struct it *it, bool *skipped_p, } else { - /* For buffers with very long lines we try harder, - because it's worth our while to spend some time - looking into the overlays and 'display' properties - to try to avoid iterating through all of them. */ + /* For buffers with very long and truncated lines we try + harder, because it's worth our while to spend some + time looking into the overlays and 'display' properties + if we can then avoid iterating through all of them. */ no_strings_with_newlines = !strings_with_newlines (start, limit, it->w); } commit 799788899628a9b34fa5d1c297d3678de0622323 Author: Stefan Kangas <stefan@marxist.se> Date: Thu Jul 28 10:33:25 2022 +0200 New test ffap-replace-file-component * test/lisp/ffap-tests.el (ffap-replace-file-component): New test. diff --git a/lisp/ffap.el b/lisp/ffap.el index 169c64a395..dc286db130 100644 --- a/lisp/ffap.el +++ b/lisp/ffap.el @@ -492,7 +492,6 @@ Returned values: (and (stringp fullname) (stringp name) (concat (file-remote-p fullname) name))) -;; (ffap-replace-file-component "/who@foo.com:/whatever" "/new") (defun ffap-file-suffix (file) "Return trailing `.foo' suffix of FILE, or nil if none." diff --git a/test/lisp/ffap-tests.el b/test/lisp/ffap-tests.el index 4b580b5af5..a11af9507e 100644 --- a/test/lisp/ffap-tests.el +++ b/test/lisp/ffap-tests.el @@ -28,6 +28,11 @@ (require 'ert-x) (require 'ffap) +(ert-deftest ffap-replace-file-component () + (should (equal + (ffap-replace-file-component "/ftp:who@foo.com:/whatever" "/new") + "/ftp:who@foo.com:/new"))) + (ert-deftest ffap-tests-25243 () "Test for https://debbugs.gnu.org/25243 ." (ert-with-temp-file file commit dc64128867d74d472b478bbb71bdcaca35eb692f Author: Stefan Kangas <stefan@marxist.se> Date: Thu Jul 28 10:19:20 2022 +0200 Minor doc fixes in ffap.el * lisp/ffap.el: (ffap-url-fetcher): Minor doc fixes. Adapt to new default; don't mention defunct/missing library ffap-url.el. diff --git a/lisp/ffap.el b/lisp/ffap.el index d490cd434a..169c64a395 100644 --- a/lisp/ffap.el +++ b/lisp/ffap.el @@ -24,10 +24,10 @@ ;;; Commentary: -;; -;; Command find-file-at-point replaces find-file. With a prefix, it -;; behaves exactly like find-file. Without a prefix, it first tries -;; to guess a default file or URL from the text around the point + +;; Command `find-file-at-point' replaces `find-file'. With a prefix, +;; it behaves exactly like find-file. Without a prefix, it first +;; tries to guess a default file or URL from the text around the point ;; (`ffap-require-prefix' swaps these behaviors). This is useful for ;; following references in situations such as mail or news buffers, ;; README's, MANIFEST's, and so on. Submit bugs or suggestions with @@ -68,29 +68,27 @@ ;; If you do not like these bindings, modify the variable ;; `ffap-bindings', or write your own. ;; -;; If you use ange-ftp, browse-url, complete, efs, it is best to load -;; or autoload them before ffap. If you use ff-paths, load it -;; afterwards. Try apropos {C-h a ffap RET} to get a list of the many -;; option variables. In particular, if ffap is slow, try these: +;; If you use ange-ftp, it is best to load or autoload it before ffap. +;; If you use ff-paths, load it afterwards. Try apropos {C-h a ffap +;; RET} to get a list of the many option variables. In particular, if +;; ffap is slow, try these: ;; ;; (setq ffap-alist nil) ; faster, dumber prompting -;; (setq ffap-machine-p-known 'accept) ; no pinging ;; (setq ffap-url-regexp nil) ; disable URL features in ffap ;; (setq ffap-shell-prompt-regexp nil) ; disable shell prompt stripping ;; (setq ffap-gopher-regexp nil) ; disable gopher bookmark matching ;; ;; ffap uses `browse-url' to fetch URLs. -;; For a hairier `ffap-url-fetcher', try ffap-url.el (same ftp site). ;; Also, you can add `ffap-menu-rescan' to various hooks to fontify ;; the file and URL references within a buffer. +;;; Code: + ;;; Change Log: -;; -;; The History and Contributors moved to ffap.LOG (same ftp site), +;; The History and Contributors moved to ffap.LOG, ;; which also has some old examples and commentary from ffap 1.5. - ;;; Todo list: ;; * let "/dir/file#key" jump to key (tag or regexp) in /dir/file ;; * find file of symbol if TAGS is loaded (like above) @@ -98,13 +96,10 @@ ;; * notice node in "(dired)Virtual Dired" (quotes, parentheses, whitespace) ;; * notice "machine.dom blah blah blah dir/file" (how?) ;; * regexp options for ffap-string-at-point, like font-lock (MCOOK) -;; * v19: could replace `ffap-locate-file' with a quieter `locate-library' +;; * could replace `ffap-locate-file' with a quieter `locate-library' ;; * handle "$(VAR)" in Makefiles ;; * use the font-lock machinery - -;;; Code: - (eval-when-compile (require 'cl-lib)) (require 'url-parse) (require 'thingatpt) @@ -273,8 +268,7 @@ ffap most of the time." :risky t) (defcustom ffap-url-fetcher 'browse-url - "A function of one argument, called by ffap to fetch an URL. -For a fancy alternative, get `ffap-url.el'." + "A function of one argument, called by ffap to fetch an URL." :type '(choice (const browse-url) function) :group 'ffap commit 05df70e755f72b7a4c7b7d94ca2349f1c5c67968 Author: Lars Ingebrigtsen <larsi@gnus.org> Date: Fri Jun 3 13:04:13 2022 +0200 Revert the `...' documentation back to actual usage * doc/lispref/tips.texi (Documentation Tips): Document how `...' is really used now (bug#55780). ‘...’ is not really used in the Emacs sources. (cherry picked from commit 1ed9c1c7f9fe32ff5123091033350beb1ccae4ca) diff --git a/doc/lispref/tips.texi b/doc/lispref/tips.texi index 1b256f752a..a3f49c19bc 100644 --- a/doc/lispref/tips.texi +++ b/doc/lispref/tips.texi @@ -687,26 +687,20 @@ starting double-quote is not part of the string! @cindex curly quotes @cindex curved quotes When a documentation string refers to a Lisp symbol, write it as it -would be printed (which usually means in lower case), surrounding it -with curved single quotes (@t{‘..’}). There are two exceptions: write -@code{t} and @code{nil} without surrounding punctuation. For example: +would be printed (which usually means in lower case), with a grave +accent @samp{`} before and apostrophe @samp{'} after it. There are +two exceptions: write @code{t} and @code{nil} without surrounding +punctuation. For example: @example -CODE can be ‘lambda’, nil, or t. +CODE can be `lambda', nil, or t. @end example -@noindent -@xref{Quotation Marks,,, emacs, The GNU Emacs Manual}, for how to -enter curved single quotes. - -Documentation strings can also use an older single-quoting convention, -which quotes symbols with grave accent @t{`} and apostrophe -@t{'}: @t{`like-this'} rather than @t{‘like-this’}. This -older convention was designed for now-obsolete displays in which grave -accent and apostrophe were mirror images. -Documentation using this convention is converted to the user's -preferred format when it is copied into a help buffer. @xref{Keys in -Documentation}. +Note that when Emacs displays these doc strings, Emacs will usually +display @samp{`} (grave accent) as @samp{‘} (left single quotation +mark) and @samp{'} (apostrophe) as @samp{’} (right single quotation +mark), if the display supports displaying these characters. +@xref{Keys in Documentation}. @cindex hyperlinks in documentation strings Help mode automatically creates a hyperlink when a documentation string commit 23112f89f9c0a253a6f30e566d7e4b4e3a3fe8ca Author: Eli Zaretskii <eliz@gnu.org> Date: Thu Jul 28 10:45:43 2022 +0300 ; Improve documentation of 'file-name-with-extension' * lisp/files.el (file-name-with-extension): Doc fix. (Bug#56809) diff --git a/lisp/files.el b/lisp/files.el index 1212187274..860b9ca724 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -5033,14 +5033,16 @@ extension, the value is \"\"." ""))))) (defun file-name-with-extension (filename extension) - "Set the EXTENSION of a FILENAME. + "Return FILENAME modified to have the specified EXTENSION. The extension (in a file name) is the part that begins with the last \".\". +This function removes any existing extension from FILENAME, and then +appends EXTENSION to it. -Trims a leading dot from the EXTENSION so that either \"foo\" or -\".foo\" can be given. +EXTENSION may include the leading dot; if it doesn't, this function +will provide it. -Errors if the FILENAME or EXTENSION are empty, or if the given -FILENAME has the format of a directory. +It is an error if FILENAME or EXTENSION is empty, or if FILENAME +is in the form of a directory name according to `directory-name-p'. See also `file-name-sans-extension'." (let ((extn (string-trim-left extension "[.]"))) commit 02ab6aaf7bc4d9c31d8e034ba3fe778bf2f35def Author: Po Lu <luangruo@yahoo.com> Date: Thu Jul 28 07:28:23 2022 +0000 Fix minor problem with scroll bar grabs on Haiku * haiku_support.cc (class EmacsScrollBar, EmacsScrollBar) (MouseDown, MouseUp): Keep a counter of the mouse down events received. diff --git a/src/haiku_support.cc b/src/haiku_support.cc index 204fdb81c2..cb378d2d81 100644 --- a/src/haiku_support.cc +++ b/src/haiku_support.cc @@ -1996,8 +1996,9 @@ class EmacsScrollBar : public BScrollBar float old_value; scroll_bar_info info; - /* True if button events should be passed to the parent. */ - bool handle_button; + /* How many button events were passed to the parent without + release. */ + int handle_button_count; bool in_overscroll; bool can_overscroll; bool maybe_overscroll; @@ -2013,7 +2014,7 @@ class EmacsScrollBar : public BScrollBar : BScrollBar (BRect (x, y, x1, y1), NULL, NULL, 0, 0, horizontal_p ? B_HORIZONTAL : B_VERTICAL), dragging (0), - handle_button (false), + handle_button_count (0), in_overscroll (false), can_overscroll (false), maybe_overscroll (false), @@ -2234,10 +2235,10 @@ class EmacsScrollBar : public BScrollBar if (message && (message->FindInt32 ("modifiers", &mods) == B_OK) - && mods & B_CONTROL_KEY && !handle_button) + && mods & B_CONTROL_KEY) { /* Allow C-mouse-3 to split the window on a scroll bar. */ - handle_button = true; + handle_button_count += 1; SetMouseEventMask (B_POINTER_EVENTS, (B_SUSPEND_VIEW_FOCUS | B_LOCK_WINDOW_FOCUS)); parent->BasicMouseDown (ConvertToParent (pt), this, message); @@ -2309,9 +2310,9 @@ class EmacsScrollBar : public BScrollBar in_overscroll = false; maybe_overscroll = false; - if (handle_button) + if (handle_button_count) { - handle_button = false; + handle_button_count--; looper = Looper (); msg = (looper ? looper->CurrentMessage () commit 27a0bcd7797d8059ec1b0bb000e25146bde3bf9d Author: Po Lu <luangruo@yahoo.com> Date: Thu Jul 28 07:17:04 2022 +0000 Fix race conditions in mouse button handling on Haiku * src/haiku_support.cc (class EmacsView): New field `grabbed_buttons'. Remove `previous_buttons'. (BasicMouseDown, BasicMouseUp): Accept new parameter `message'. Use data from that message instead. (MouseDown, MouseUp): Pass the current message to BasicMouseUp and BasicMouseDown. diff --git a/src/haiku_support.cc b/src/haiku_support.cc index 098739cd98..204fdb81c2 100644 --- a/src/haiku_support.cc +++ b/src/haiku_support.cc @@ -1496,7 +1496,6 @@ class EmacsMenuBar : public BMenuBar class EmacsView : public BView { public: - uint32_t previous_buttons; int looper_locked_count; BRegion sb_region; BRegion invalid_region; @@ -1512,10 +1511,10 @@ class EmacsView : public BView #endif BMessage *wait_for_release_message; + int64 grabbed_buttons; EmacsView () : BView (BRect (0, 0, 0, 0), "Emacs", B_FOLLOW_NONE, B_WILL_DRAW), - previous_buttons (0), looper_locked_count (0), offscreen_draw_view (NULL), offscreen_draw_bitmap_1 (NULL), @@ -1524,7 +1523,8 @@ class EmacsView : public BView cr_surface (NULL), cr_context (NULL), #endif - wait_for_release_message (NULL) + wait_for_release_message (NULL), + grabbed_buttons (0) { } @@ -1826,42 +1826,51 @@ class EmacsView : public BView } void - BasicMouseDown (BPoint point, BView *scroll_bar) + BasicMouseDown (BPoint point, BView *scroll_bar, BMessage *message) { struct haiku_button_event rq; - uint32 mods, buttons; + int64 when; + int32 mods, buttons, button; - this->GetMouse (&point, &buttons, false); + if (message->FindInt64 ("when", &when) != B_OK + || message->FindInt32 ("modifiers", &mods) != B_OK + || message->FindInt32 ("buttons", &buttons) != B_OK) + return; - if (!grab_view_locker.Lock ()) - gui_abort ("Couldn't lock grab view locker"); - if (buttons) - grab_view = this; - grab_view_locker.Unlock (); + /* Find which button was pressed by comparing the previous button + mask to the current one. This assumes that B_MOUSE_DOWN will + be sent for each button press. */ + button = buttons & ~grabbed_buttons; + grabbed_buttons = buttons; + + if (!scroll_bar) + { + if (!grab_view_locker.Lock ()) + gui_abort ("Couldn't lock grab view locker"); + grab_view = this; + grab_view_locker.Unlock (); + } rq.window = this->Window (); rq.scroll_bar = scroll_bar; - if (!(previous_buttons & B_PRIMARY_MOUSE_BUTTON) - && (buttons & B_PRIMARY_MOUSE_BUTTON)) + if (button == B_PRIMARY_MOUSE_BUTTON) rq.btn_no = 0; - else if (!(previous_buttons & B_SECONDARY_MOUSE_BUTTON) - && (buttons & B_SECONDARY_MOUSE_BUTTON)) + else if (button == B_SECONDARY_MOUSE_BUTTON) rq.btn_no = 2; - else if (!(previous_buttons & B_TERTIARY_MOUSE_BUTTON) - && (buttons & B_TERTIARY_MOUSE_BUTTON)) + else if (button == B_TERTIARY_MOUSE_BUTTON) rq.btn_no = 1; else + /* We don't know which button was pressed. This usually happens + when a B_MOUSE_UP is sent to a view that didn't receive a + corresponding B_MOUSE_DOWN event, so simply ignore the + message. */ return; - previous_buttons = buttons; - rq.x = point.x; rq.y = point.y; - - mods = modifiers (); - rq.modifiers = 0; + if (mods & B_SHIFT_KEY) rq.modifiers |= HAIKU_MODIFIER_SHIFT; @@ -1878,62 +1887,73 @@ class EmacsView : public BView SetMouseEventMask (B_POINTER_EVENTS, (B_LOCK_WINDOW_FOCUS | B_NO_POINTER_HISTORY)); - rq.time = system_time (); + rq.time = when; haiku_write (BUTTON_DOWN, &rq); } void MouseDown (BPoint point) { - BasicMouseDown (point, NULL); + BMessage *msg; + BLooper *looper; + + looper = Looper (); + msg = (looper + ? looper->CurrentMessage () + : NULL); + + if (msg) + BasicMouseDown (point, NULL, msg); } void - BasicMouseUp (BPoint point, BView *scroll_bar) + BasicMouseUp (BPoint point, BView *scroll_bar, BMessage *message) { struct haiku_button_event rq; - uint32 buttons, mods; + int64 when; + int32 mods, button, buttons; - this->GetMouse (&point, &buttons, false); + if (message->FindInt64 ("when", &when) != B_OK + || message->FindInt32 ("modifiers", &mods) != B_OK + || message->FindInt32 ("buttons", &buttons) != B_OK) + return; - if (!grab_view_locker.Lock ()) - gui_abort ("Couldn't lock grab view locker"); - if (!buttons) - grab_view = NULL; - grab_view_locker.Unlock (); + if (!scroll_bar) + { + if (!grab_view_locker.Lock ()) + gui_abort ("Couldn't lock grab view locker"); + if (!buttons) + grab_view = NULL; + grab_view_locker.Unlock (); + } - if (!buttons && wait_for_release_message) + button = (grabbed_buttons & ~buttons); + grabbed_buttons = buttons; + + if (!grabbed_buttons && wait_for_release_message) { wait_for_release_message->SendReply (wait_for_release_message); delete wait_for_release_message; wait_for_release_message = NULL; - previous_buttons = buttons; return; } rq.window = this->Window (); rq.scroll_bar = scroll_bar; - if ((previous_buttons & B_PRIMARY_MOUSE_BUTTON) - && !(buttons & B_PRIMARY_MOUSE_BUTTON)) + if (button == B_PRIMARY_MOUSE_BUTTON) rq.btn_no = 0; - else if ((previous_buttons & B_SECONDARY_MOUSE_BUTTON) - && !(buttons & B_SECONDARY_MOUSE_BUTTON)) + else if (button == B_SECONDARY_MOUSE_BUTTON) rq.btn_no = 2; - else if ((previous_buttons & B_TERTIARY_MOUSE_BUTTON) - && !(buttons & B_TERTIARY_MOUSE_BUTTON)) + else if (button == B_TERTIARY_MOUSE_BUTTON) rq.btn_no = 1; else return; - previous_buttons = buttons; - rq.x = point.x; rq.y = point.y; - mods = modifiers (); - rq.modifiers = 0; if (mods & B_SHIFT_KEY) rq.modifiers |= HAIKU_MODIFIER_SHIFT; @@ -1947,14 +1967,23 @@ class EmacsView : public BView if (mods & B_OPTION_KEY) rq.modifiers |= HAIKU_MODIFIER_SUPER; - rq.time = system_time (); + rq.time = when; haiku_write (BUTTON_UP, &rq); } void MouseUp (BPoint point) { - BasicMouseUp (point, NULL); + BMessage *msg; + BLooper *looper; + + looper = Looper (); + msg = (looper + ? looper->CurrentMessage () + : NULL); + + if (msg) + BasicMouseUp (point, NULL, msg); } }; @@ -2205,13 +2234,13 @@ class EmacsScrollBar : public BScrollBar if (message && (message->FindInt32 ("modifiers", &mods) == B_OK) - && mods & B_CONTROL_KEY) + && mods & B_CONTROL_KEY && !handle_button) { /* Allow C-mouse-3 to split the window on a scroll bar. */ handle_button = true; SetMouseEventMask (B_POINTER_EVENTS, (B_SUSPEND_VIEW_FOCUS | B_LOCK_WINDOW_FOCUS)); - parent->BasicMouseDown (ConvertToParent (pt), this); + parent->BasicMouseDown (ConvertToParent (pt), this, message); return; } @@ -2274,6 +2303,8 @@ class EmacsScrollBar : public BScrollBar MouseUp (BPoint pt) { struct haiku_scroll_bar_drag_event rq; + BMessage *msg; + BLooper *looper; in_overscroll = false; maybe_overscroll = false; @@ -2281,7 +2312,14 @@ class EmacsScrollBar : public BScrollBar if (handle_button) { handle_button = false; - parent->BasicMouseUp (ConvertToParent (pt), this); + looper = Looper (); + msg = (looper + ? looper->CurrentMessage () + : NULL); + + if (msg) + parent->BasicMouseUp (ConvertToParent (pt), + this, msg); return; } commit 4be938169d6d1fc7bf0f44b78728f21a65317aed Author: Paul Pogonyshev <pogonyshev@gmail.com> Date: Wed Jul 27 21:20:55 2022 +0200 Release the desktop lock in 'kill-emacs-hook' * lisp/desktop.el: Run 'desktop--on-kill' in 'kill-emacs-hook'. (desktop--on-kill): New function, refactored from 'desktop-kill'. (desktop-kill): Call 'desktop--on-kill'. (Bug#56800) diff --git a/lisp/desktop.el b/lisp/desktop.el index 041dbcf7c1..9cd26646de 100644 --- a/lisp/desktop.el +++ b/lisp/desktop.el @@ -733,7 +733,10 @@ if different)." ;; ---------------------------------------------------------------------------- (unless noninteractive - (add-hook 'kill-emacs-query-functions #'desktop-kill)) + (add-hook 'kill-emacs-query-functions #'desktop-kill) + ;; Certain things should be done even if + ;; `kill-emacs-query-functions' are not called. + (add-hook 'kill-emacs-hook #'desktop--on-kill)) (defun desktop-kill () "If `desktop-save-mode' is non-nil, do what `desktop-save' says to do. @@ -760,12 +763,15 @@ is nil, ask the user where to save the desktop." (file-error (unless (yes-or-no-p "Error while saving the desktop. Ignore? ") (signal (car err) (cdr err)))))) + (desktop--on-kill) + t) + +(defun desktop--on-kill () ;; If we own it, we don't anymore. (when (eq (emacs-pid) (desktop-owner)) ;; Allow exiting Emacs even if we can't delete the desktop file. (ignore-error 'file-error - (desktop-release-lock))) - t) + (desktop-release-lock)))) ;; ---------------------------------------------------------------------------- (defun desktop-list* (&rest args) commit 4ea1f6c7f84a6f70a184a0e33a0b35ba4950839a Author: Arash Esbati <arash@gnu.org> Date: Wed Jul 27 19:59:25 2022 +0200 ; * doc/lispref/tips.texi (Documentation Tips): Fix typos. (Bug#56802) diff --git a/doc/lispref/tips.texi b/doc/lispref/tips.texi index e15ed0cb7c..1b256f752a 100644 --- a/doc/lispref/tips.texi +++ b/doc/lispref/tips.texi @@ -692,7 +692,7 @@ with curved single quotes (@t{‘..’}). There are two exceptions: write @code{t} and @code{nil} without surrounding punctuation. For example: @example - CODE can be ‘lambda’, nil, or t. +CODE can be ‘lambda’, nil, or t. @end example @noindent @@ -851,7 +851,7 @@ find an alternate phrasing that conveys the meaning. @item Try to avoid using abbreviations such as ``e.g.'' (for ``for example''), ``i.e.'' (for ``that is''), ``no.'' (for ``number''), -``c.f.'' (for ``in contrast to'') and ``w.r.t.'' (for ``with respect +``cf.'' (for ``in contrast to'') and ``w.r.t.'' (for ``with respect to'') as much as possible. It is almost always clearer and easier to read the expanded version.@footnote{We do use these occasionally, but try not to overdo it.} commit 4313c695cd6370667ccf086cef0d9201fdf796ca Author: Eli Zaretskii <eliz@gnu.org> Date: Wed Jul 27 20:10:46 2022 +0300 ; Fix typos in comments and remove debug code. diff --git a/src/xdisp.c b/src/xdisp.c index db3a780fcf..66b37a855b 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -7087,11 +7087,10 @@ back_to_previous_line_start (struct it *it) /* Find in the current buffer the first display or overlay string between STARTPOS and ENDPOS that includes embedded newlines. Consider only overlays that apply to window W. - Value is non-zero if such a display/overlay strong is found found. */ + Value is non-zero if such a display/overlay string is found. */ static bool strings_with_newlines (ptrdiff_t startpos, ptrdiff_t endpos, struct window *w) { - int n = 0; /* Process overlays before the overlay center. */ for (struct Lisp_Overlay *ov = current_buffer->overlays_before; ov; ov = ov->next) @@ -7099,7 +7098,6 @@ strings_with_newlines (ptrdiff_t startpos, ptrdiff_t endpos, struct window *w) Lisp_Object overlay = make_lisp_ptr (ov, Lisp_Vectorlike); eassert (OVERLAYP (overlay)); - n++; /* Skip this overlay if it doesn't apply to our window. */ Lisp_Object window = Foverlay_get (overlay, Qwindow); if (WINDOWP (window) && XWINDOW (window) != w) @@ -7137,7 +7135,6 @@ strings_with_newlines (ptrdiff_t startpos, ptrdiff_t endpos, struct window *w) { Lisp_Object overlay = make_lisp_ptr (ov, Lisp_Vectorlike); eassert (OVERLAYP (overlay)); - n++; /* Skip this overlay if it doesn't apply to our window. */ Lisp_Object window = Foverlay_get (overlay, Qwindow); commit a25cd7f68aa5babb7cc9002d89ff02077937927b Author: Eli Zaretskii <eliz@gnu.org> Date: Wed Jul 27 20:05:44 2022 +0300 Speed up Isearch in very long lines under line truncation * src/xdisp.c (strings_with_newlines): New function. (forward_to_next_line_start): Call 'strings_with_newlines' in buffers with very long lines, to avoid falling back on slow iteration. (Bug#56682) diff --git a/src/xdisp.c b/src/xdisp.c index bd3beef134..db3a780fcf 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -7084,6 +7084,109 @@ back_to_previous_line_start (struct it *it) get_closer_narrowed_begv (it->w, IT_CHARPOS (*it))); } +/* Find in the current buffer the first display or overlay string + between STARTPOS and ENDPOS that includes embedded newlines. + Consider only overlays that apply to window W. + Value is non-zero if such a display/overlay strong is found found. */ +static bool +strings_with_newlines (ptrdiff_t startpos, ptrdiff_t endpos, struct window *w) +{ + int n = 0; + /* Process overlays before the overlay center. */ + for (struct Lisp_Overlay *ov = current_buffer->overlays_before; + ov; ov = ov->next) + { + Lisp_Object overlay = make_lisp_ptr (ov, Lisp_Vectorlike); + eassert (OVERLAYP (overlay)); + + n++; + /* Skip this overlay if it doesn't apply to our window. */ + Lisp_Object window = Foverlay_get (overlay, Qwindow); + if (WINDOWP (window) && XWINDOW (window) != w) + continue; + + ptrdiff_t ostart = OVERLAY_POSITION (OVERLAY_START (overlay)); + ptrdiff_t oend = OVERLAY_POSITION (OVERLAY_END (overlay)); + + /* Due to the order of overlays in overlays_before, once we get + to an overlay whose end position is before STARTPOS, all the + rest also end before STARTPOS, and thus are of no concern to us. */ + if (oend < startpos) + break; + + /* Skip overlays that don't overlap the range. */ + if (!((startpos < oend && ostart < endpos) + || (ostart == oend + && (startpos == oend || (endpos == ZV && oend == endpos))))) + continue; + + Lisp_Object str; + str = Foverlay_get (overlay, Qbefore_string); + if (STRINGP (str) && SCHARS (str) + && memchr (SDATA (str), '\n', SBYTES (str))) + return true; + str = Foverlay_get (overlay, Qafter_string); + if (STRINGP (str) && SCHARS (str) + && memchr (SDATA (str), '\n', SBYTES (str))) + return true; + } + + /* Process overlays after the overlay center. */ + for (struct Lisp_Overlay *ov = current_buffer->overlays_after; + ov; ov = ov->next) + { + Lisp_Object overlay = make_lisp_ptr (ov, Lisp_Vectorlike); + eassert (OVERLAYP (overlay)); + n++; + + /* Skip this overlay if it doesn't apply to our window. */ + Lisp_Object window = Foverlay_get (overlay, Qwindow); + if (WINDOWP (window) && XWINDOW (window) != w) + continue; + + ptrdiff_t ostart = OVERLAY_POSITION (OVERLAY_START (overlay)); + ptrdiff_t oend = OVERLAY_POSITION (OVERLAY_END (overlay)); + + /* Due to the order of overlays in overlays_after, once we get + to an overlay whose start position is after ENDPOS, all the + rest also start after ENDPOS, and thus are of no concern to us. */ + if (ostart > endpos) + break; + + /* Skip overlays that don't overlap the range. */ + if (!((startpos < oend && ostart < endpos) + || (ostart == oend + && (startpos == oend || (endpos == ZV && oend == endpos))))) + continue; + + Lisp_Object str; + str = Foverlay_get (overlay, Qbefore_string); + if (STRINGP (str) && SCHARS (str) + && memchr (SDATA (str), '\n', SBYTES (str))) + return true; + str = Foverlay_get (overlay, Qafter_string); + if (STRINGP (str) && SCHARS (str) + && memchr (SDATA (str), '\n', SBYTES (str))) + return true; + } + + /* Check for 'display' properties whose values include strings. */ + Lisp_Object cpos = make_fixnum (startpos); + Lisp_Object limpos = make_fixnum (endpos); + + while ((cpos = Fnext_single_property_change (cpos, Qdisplay, Qnil, limpos), + !(NILP (cpos) || XFIXNAT (cpos) >= endpos))) + { + Lisp_Object spec = Fget_char_property (cpos, Qdisplay, Qnil); + Lisp_Object string = string_from_display_spec (spec); + if (STRINGP (string) + && memchr (SDATA (string), '\n', SBYTES (string))) + return true; + } + + return false; +} + /* Move IT to the next line start. @@ -7136,7 +7239,8 @@ forward_to_next_line_start (struct it *it, bool *skipped_p, it->selective = 0; /* Scan for a newline within MAX_NEWLINE_DISTANCE display elements - from buffer text. */ + from buffer text, or till the end of the string if iterating a + string. */ for (n = 0; !newline_found_p && n < MAX_NEWLINE_DISTANCE; n += !STRINGP (it->string)) @@ -7156,27 +7260,54 @@ forward_to_next_line_start (struct it *it, bool *skipped_p, ptrdiff_t bytepos, start = IT_CHARPOS (*it); ptrdiff_t limit = find_newline_no_quit (start, IT_BYTEPOS (*it), 1, &bytepos); - Lisp_Object pos; - eassert (!STRINGP (it->string)); - /* If there isn't any `display' property in sight, and no - overlays, we can just use the position of the newline in - buffer text. */ - if (it->stop_charpos >= limit - || ((pos = Fnext_single_property_change (make_fixnum (start), - Qdisplay, Qnil, - make_fixnum (limit)), - (NILP (pos) || XFIXNAT (pos) == limit)) - && next_overlay_change (start) == ZV)) + /* it->stop_charpos >= limit means we already know there's no + stop position up until the newline at LIMIT, so there's no + need for any further checks. */ + bool no_strings_with_newlines = it->stop_charpos >= limit; + + if (!no_strings_with_newlines) + { + if (!current_buffer->long_line_optimizations_p) + { + /* Quick-and-dirty check: if there isn't any `display' + property in sight, and no overlays, we're done. */ + Lisp_Object pos = + Fnext_single_property_change (make_fixnum (start), + Qdisplay, Qnil, + make_fixnum (limit)); + no_strings_with_newlines = + (NILP (pos) || XFIXNAT (pos) == limit) /* no 'display' props */ + && next_overlay_change (start) == ZV; /* no overlays */ + } + else + { + /* For buffers with very long lines we try harder, + because it's worth our while to spend some time + looking into the overlays and 'display' properties + to try to avoid iterating through all of them. */ + no_strings_with_newlines = + !strings_with_newlines (start, limit, it->w); + } + } + + /* If there's no display or overlay strings with embedded + newlines until the position of the newline in buffer text, we + can just use that position. */ + if (no_strings_with_newlines) { if (!it->bidi_p || !bidi_it_prev) { + /* The optimal case: just jump there. */ IT_CHARPOS (*it) = limit; IT_BYTEPOS (*it) = bytepos; } else { + /* The less optimal case: need to bidi-walk there, but + this is still cheaper that the full iteration using + get_next_display_element and set_iterator_to_next. */ struct bidi_it bprev; /* Help bidi.c avoid expensive searches for display @@ -7200,6 +7331,7 @@ forward_to_next_line_start (struct it *it, bool *skipped_p, } else { + /* The slow case. */ while (!newline_found_p) { if (!get_next_display_element (it)) commit cd41ce8c6c107901a499bf55dd2b0383befd37af Author: Gregory Heytings <gregory@heytings.org> Date: Mon Jul 25 20:27:17 2022 +0000 Improvement for long lines in buffers with font locking. * src/xdisp.c (get_narrowed_width): Factored out from 'get_narrowed_len'. (get_narrowed_len): Updated to use 'get_narrowed_width'. (get_closer_narrowed_begv): New function. (SET_WITH_NARROWED_BEGV): Add parameter to the macro. (back_to_previous_line_start): Use the new function. (get_visually_first_element, move_it_vertically_backward): Update the calls to the macro. * src/dispextern.h: Prototype of 'get_closer_narrowed_begv'. Fix the prototypes of 'get_narrowed_begv' and 'get_narrowed_zv'. diff --git a/src/dispextern.h b/src/dispextern.h index bafa98161d..2772e8cda8 100644 --- a/src/dispextern.h +++ b/src/dispextern.h @@ -3404,8 +3404,9 @@ void mark_window_display_accurate (Lisp_Object, bool); void redisplay_preserve_echo_area (int); void init_iterator (struct it *, struct window *, ptrdiff_t, ptrdiff_t, struct glyph_row *, enum face_id); -ptrdiff_t get_narrowed_begv (struct window *w); -ptrdiff_t get_narrowed_zv (struct window *w); +ptrdiff_t get_narrowed_begv (struct window *); +ptrdiff_t get_narrowed_zv (struct window *); +ptrdiff_t get_closer_narrowed_begv (struct window *, ptrdiff_t); void init_iterator_to_row_start (struct it *, struct window *, struct glyph_row *); void start_display (struct it *, struct window *, struct text_pos); diff --git a/src/xdisp.c b/src/xdisp.c index add14a084f..bd3beef134 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -3502,14 +3502,20 @@ init_iterator (struct it *it, struct window *w, long lines. */ static int -get_narrowed_len (struct window *w) +get_narrowed_width (struct window *w) { int fact; /* In a character-only terminal, only one font size is used, so we can use a smaller factor. */ fact = EQ (Fterminal_live_p (Qnil), Qt) ? 2 : 3; - return fact * (window_body_width (w, WINDOW_BODY_IN_CANONICAL_CHARS) * - window_body_height (w, WINDOW_BODY_IN_CANONICAL_CHARS)); + return fact * window_body_width (w, WINDOW_BODY_IN_CANONICAL_CHARS); +} + +static int +get_narrowed_len (struct window *w) +{ + return get_narrowed_width (w) * + window_body_height (w, WINDOW_BODY_IN_CANONICAL_CHARS); } ptrdiff_t @@ -3528,6 +3534,13 @@ get_narrowed_zv (struct window *w) return min ((window_point (w) / len + 1) * len, ZV); } +ptrdiff_t +get_closer_narrowed_begv (struct window *w, ptrdiff_t pos) +{ + int len = get_narrowed_width (w); + return max ((pos / len - 1) * len, BEGV); +} + static void unwind_narrowed_begv (Lisp_Object point_min) { @@ -3541,15 +3554,15 @@ unwind_narrowed_zv (Lisp_Object point_max) } /* Set DST to EXPR. When IT indicates that BEGV should temporarily be - updated to optimize display, evaluate EXPR with an updated BEGV. */ + updated to optimize display, evaluate EXPR with BEGV set to BV. */ -#define SET_WITH_NARROWED_BEGV(IT,DST,EXPR) \ +#define SET_WITH_NARROWED_BEGV(IT,DST,EXPR,BV) \ do { \ if (IT->narrowed_begv) \ { \ specpdl_ref count = SPECPDL_INDEX (); \ record_unwind_protect (unwind_narrowed_begv, Fpoint_min ()); \ - SET_BUF_BEGV (current_buffer, IT->narrowed_begv); \ + SET_BUF_BEGV (current_buffer, BV); \ DST = EXPR; \ unbind_to (count, Qnil); \ } \ @@ -7067,7 +7080,8 @@ back_to_previous_line_start (struct it *it) dec_both (&cp, &bp); SET_WITH_NARROWED_BEGV (it, IT_CHARPOS (*it), - find_newline_no_quit (cp, bp, -1, &IT_BYTEPOS (*it))); + find_newline_no_quit (cp, bp, -1, &IT_BYTEPOS (*it)), + get_closer_narrowed_begv (it->w, IT_CHARPOS (*it))); } @@ -8706,7 +8720,8 @@ get_visually_first_element (struct it *it) SET_WITH_NARROWED_BEGV (it, bob, string_p ? 0 : - IT_BYTEPOS (*it) < BEGV ? obegv : BEGV); + IT_BYTEPOS (*it) < BEGV ? obegv : BEGV, + it->narrowed_begv); if (STRINGP (it->string)) { @@ -8749,7 +8764,8 @@ get_visually_first_element (struct it *it) SET_WITH_NARROWED_BEGV (it, it->bidi_it.charpos, find_newline_no_quit (IT_CHARPOS (*it), IT_BYTEPOS (*it), -1, - &it->bidi_it.bytepos)); + &it->bidi_it.bytepos), + it->narrowed_begv); bidi_paragraph_init (it->paragraph_embedding, &it->bidi_it, true); do { @@ -10668,7 +10684,8 @@ move_it_vertically_backward (struct it *it, int dy) dec_both (&cp, &bp); SET_WITH_NARROWED_BEGV (it, cp, - find_newline_no_quit (cp, bp, -1, NULL)); + find_newline_no_quit (cp, bp, -1, NULL), + it->narrowed_begv); move_it_to (it, cp, -1, -1, -1, MOVE_TO_POS); } bidi_unshelve_cache (it3data, true); commit 280b8c96ccaeb95548adda78466ef2b1c3cf4546 Author: Eli Zaretskii <eliz@gnu.org> Date: Sat Jul 23 19:27:30 2022 +0300 Improve display of columns on mode-line * src/xdisp.c (decode_mode_spec): A better representation for "unknown column number". diff --git a/src/xdisp.c b/src/xdisp.c index c73958854c..add14a084f 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -27620,10 +27620,20 @@ decode_mode_spec (struct window *w, register int c, int field_width, even crash emacs.) */ if (mode_line_target == MODE_LINE_TITLE) return ""; + else if (b->long_line_optimizations_p) + { + char *p = decode_mode_spec_buf; + int pad = width - 2; + while (pad-- > 0) + *p++ = ' '; + *p++ = '?'; + *p++ = '?'; + *p = '\0'; + return decode_mode_spec_buf; + } else { - ptrdiff_t col = - b->long_line_optimizations_p ? 0 : current_column (); + ptrdiff_t col = current_column (); int disp_col = (c == 'C') ? col + 1 : col; w->column_number_displayed = col; pint2str (decode_mode_spec_buf, width, disp_col); commit 57a978fd74454392a041ac65a5abba8d012b88cc Author: Eli Zaretskii <eliz@gnu.org> Date: Sat Jul 23 18:57:06 2022 +0300 Optimize 'set_vertical_scroll_bar' for long lines * src/xdisp.c (set_vertical_scroll_bar): Don't bother being accurate about window_end_pos if long-line shortcuts are in effect in the current buffer. diff --git a/src/xdisp.c b/src/xdisp.c index c507d0caf2..c73958854c 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -18968,8 +18968,9 @@ set_vertical_scroll_bar (struct window *w) ptrdiff_t window_end_pos = w->window_end_pos; /* If w->window_end_pos cannot be trusted, recompute it "the - hard way". */ - if (!w->window_end_valid) + hard way". But don't bother to be too accurate when + long-line shortcuts are in effect. */ + if (!w->window_end_valid && !buf->long_line_optimizations_p) { struct it it; struct text_pos start_pos; commit fc53961c1df8bee07b6a1d461d31f449b66f1d65 Author: Eli Zaretskii <eliz@gnu.org> Date: Sat Jul 23 17:43:40 2022 +0300 Avoid calling 'current_column' in buffers with long lines. * src/xdisp.c (decode_mode_spec, redisplay_window) (mode_line_update_needed): * src/indent.c (Fcurrent_column): In a buffer with long-line optimizations enabled, avoid calling 'current_column', which is very slow in that case. diff --git a/src/indent.c b/src/indent.c index d4ef075f00..e90e3fde20 100644 --- a/src/indent.c +++ b/src/indent.c @@ -306,6 +306,8 @@ and point (e.g., control characters will have a width of 2 or 4, tabs will have a variable width). Ignores finite width of frame, which means that this function may return values greater than (frame-width). +In a buffer with very long lines, the value can be zero, because calculating +the exact number is very expensive. Whether the line is visible (if `selective-display' is t) has no effect; however, ^M is treated as end of line when `selective-display' is t. Text that has an invisible property is considered as having width 0, unless @@ -313,6 +315,9 @@ Text that has an invisible property is considered as having width 0, unless (void) { Lisp_Object temp; + + if (current_buffer->long_line_optimizations_p) + return make_fixnum (0); XSETFASTINT (temp, current_column ()); return temp; } diff --git a/src/xdisp.c b/src/xdisp.c index 690f10b840..c507d0caf2 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -12998,7 +12998,8 @@ mode_line_update_needed (struct window *w) { return (w->column_number_displayed != -1 && !(PT == w->last_point && !window_outdated (w)) - && (w->column_number_displayed != current_column ())); + && (!current_buffer->long_line_optimizations_p + && w->column_number_displayed != current_column ())); } /* True if window start of W is frozen and may not be changed during @@ -20116,6 +20117,7 @@ redisplay_window (Lisp_Object window, bool just_this_one_p) || w->base_line_pos > 0 /* Column number is displayed and different from the one displayed. */ || (w->column_number_displayed != -1 + && !current_buffer->long_line_optimizations_p && (w->column_number_displayed != current_column ()))) /* This means that the window has a mode line. */ && (window_wants_mode_line (w) @@ -27619,7 +27621,8 @@ decode_mode_spec (struct window *w, register int c, int field_width, return ""; else { - ptrdiff_t col = current_column (); + ptrdiff_t col = + b->long_line_optimizations_p ? 0 : current_column (); int disp_col = (c == 'C') ? col + 1 : col; w->column_number_displayed = col; pint2str (decode_mode_spec_buf, width, disp_col); commit 350e97d78e7803650c6dd2bf46fcfece8e2b4b32 Author: Eli Zaretskii <eliz@gnu.org> Date: Sat Jul 23 16:13:32 2022 +0300 Speed up redisplay of long truncated lines * src/xdisp.c (forward_to_next_line_start): Fix logic of interpreting the result of Fnext_single_property_change. (reseat_at_next_visible_line_start): When ON_NEWLINE_P is zero, pass NULL to 'forward_to_next_line_start', to avoid costly bidi iteration when none is needed. This speeds up redisplay of very long lines under 'truncate-lines'. diff --git a/src/xdisp.c b/src/xdisp.c index 215a6d561e..690f10b840 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -7153,10 +7153,10 @@ forward_to_next_line_start (struct it *it, bool *skipped_p, || ((pos = Fnext_single_property_change (make_fixnum (start), Qdisplay, Qnil, make_fixnum (limit)), - NILP (pos)) + (NILP (pos) || XFIXNAT (pos) == limit)) && next_overlay_change (start) == ZV)) { - if (!it->bidi_p) + if (!it->bidi_p || !bidi_it_prev) { IT_CHARPOS (*it) = limit; IT_BYTEPOS (*it) = bytepos; @@ -7319,7 +7319,8 @@ reseat_at_next_visible_line_start (struct it *it, bool on_newline_p) bool skipped_p = false; struct bidi_it bidi_it_prev; bool newline_found_p - = forward_to_next_line_start (it, &skipped_p, &bidi_it_prev); + = forward_to_next_line_start (it, &skipped_p, + on_newline_p ? &bidi_it_prev : NULL); /* Skip over lines that are invisible because they are indented more than the value of IT->selective. */ @@ -7331,7 +7332,8 @@ reseat_at_next_visible_line_start (struct it *it, bool on_newline_p) eassert (IT_BYTEPOS (*it) == BEGV || FETCH_BYTE (IT_BYTEPOS (*it) - 1) == '\n'); newline_found_p = - forward_to_next_line_start (it, &skipped_p, &bidi_it_prev); + forward_to_next_line_start (it, &skipped_p, + on_newline_p ? &bidi_it_prev : NULL); } /* Position on the newline if that's what's requested. */ commit 304e2a3a05feee6578aadfa0228dde734fe850cf Author: Eli Zaretskii <eliz@gnu.org> Date: Fri Jul 22 22:22:08 2022 +0300 Avoid assertion violations in 'handle_fontified_prop' * src/xdisp.c (handle_fontified_prop): Avoid assertion violations due to automatic narrowing. (Bug#56682) diff --git a/src/xdisp.c b/src/xdisp.c index caa421c281..215a6d561e 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -4395,6 +4395,11 @@ handle_fontified_prop (struct it *it) bool old_clip_changed = current_buffer->clip_changed; bool saved_inhibit_flag = it->f->inhibit_clear_image_cache; + val = Vfontification_functions; + specbind (Qfontification_functions, Qnil); + + eassert (it->end_charpos == ZV); + if (it->narrowed_begv) { record_unwind_protect (unwind_narrowed_begv, Fpoint_min ()); @@ -4404,11 +4409,6 @@ handle_fontified_prop (struct it *it) specbind (Qinhibit_widen, Qt); } - val = Vfontification_functions; - specbind (Qfontification_functions, Qnil); - - eassert (it->end_charpos == ZV); - /* Don't allow Lisp that runs from 'fontification-functions' clear our face and image caches behind our back. */ it->f->inhibit_clear_image_cache = true; commit 874e2525035d45efa6fa374a2ebec3740ecc1457 Author: Gregory Heytings <gregory@heytings.org> Date: Fri Jul 22 10:03:13 2022 +0000 Improve font locking in buffers with long lines (bug#56682). * src/dispextern.h (struct it): New 'narrowed_zv' field. * src/xdisp.c (init_iterator): Set the field. (get_narrowed_zv): New function to set the field. (handle_fontified_prop): Use the field, together with 'narrowed_begv', to narrow the portion of the buffer that 'Vfontification_functions' will see. Also bind 'inhibit-widen'. (get_narrowed_len): New function, factored out of 'get_narrowed_begv'. (unwind_narrowed_zv): New function. * src/editfns.c (syms_of_editfns): New variable and symbol 'inhibit-widen'. (Fwiden): Do nothing when 'inhibit-widen' is non-nil. diff --git a/src/dispextern.h b/src/dispextern.h index 1cdfdca74c..bafa98161d 100644 --- a/src/dispextern.h +++ b/src/dispextern.h @@ -2336,6 +2336,10 @@ struct it optimize display (see the SET_WITH_NARROWED_BEGV macro). */ ptrdiff_t narrowed_begv; + /* Alternate end position of the buffer that may be used to + optimize display. */ + ptrdiff_t narrowed_zv; + /* C string to iterate over. Non-null means get characters from this string, otherwise characters are read from current_buffer or it->string. */ @@ -3401,6 +3405,7 @@ void redisplay_preserve_echo_area (int); void init_iterator (struct it *, struct window *, ptrdiff_t, ptrdiff_t, struct glyph_row *, enum face_id); ptrdiff_t get_narrowed_begv (struct window *w); +ptrdiff_t get_narrowed_zv (struct window *w); void init_iterator_to_row_start (struct it *, struct window *, struct glyph_row *); void start_display (struct it *, struct window *, struct text_pos); diff --git a/src/editfns.c b/src/editfns.c index 4587b1132b..6dec2d468c 100644 --- a/src/editfns.c +++ b/src/editfns.c @@ -2661,6 +2661,8 @@ DEFUN ("widen", Fwiden, Swiden, 0, 0, "", This allows the buffer's full text to be seen and edited. */) (void) { + if (!NILP (Vinhibit_widen)) + return Qnil; if (BEG != BEGV || Z != ZV) current_buffer->clip_changed = 1; BEGV = BEG; @@ -4457,6 +4459,7 @@ syms_of_editfns (void) DEFSYM (Qbuffer_access_fontify_functions, "buffer-access-fontify-functions"); DEFSYM (Qwall, "wall"); DEFSYM (Qpropertize, "propertize"); + DEFSYM (Qinhibit_widen, "inhibit-widen"); DEFVAR_LISP ("inhibit-field-text-motion", Vinhibit_field_text_motion, doc: /* Non-nil means text motion commands don't notice fields. */); @@ -4517,6 +4520,15 @@ This variable is experimental; email 32252@debbugs.gnu.org if you need it to be non-nil. */); binary_as_unsigned = false; + DEFVAR_LISP ("inhibit-widen", Vinhibit_widen, + doc: /* Non-nil inhibits the `widen' function. + +Do NOT set this globally to a non-nil value, as doing that will +disable the `widen' function everywhere, including the \\[widen\] +command. This variable is intended to be let-bound around code +that needs to disable `widen' temporarily. */); + Vinhibit_widen = Qnil; + defsubr (&Spropertize); defsubr (&Schar_equal); defsubr (&Sgoto_char); diff --git a/src/xdisp.c b/src/xdisp.c index ebeaf2a3da..caa421c281 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -3426,7 +3426,10 @@ init_iterator (struct it *it, struct window *w, } if (current_buffer->long_line_optimizations_p) - it->narrowed_begv = get_narrowed_begv (w); + { + it->narrowed_begv = get_narrowed_begv (w); + it->narrowed_zv = get_narrowed_zv (w); + } /* If a buffer position was specified, set the iterator there, getting overlays and face properties from that position. */ @@ -3494,29 +3497,49 @@ init_iterator (struct it *it, struct window *w, CHECK_IT (it); } -/* Compute a suitable alternate value for BEGV that may be used +/* Compute a suitable alternate value for BEGV and ZV that may be used temporarily to optimize display if the buffer in window W contains long lines. */ -ptrdiff_t -get_narrowed_begv (struct window *w) +static int +get_narrowed_len (struct window *w) { - int len, fact; ptrdiff_t begv; + int fact; /* In a character-only terminal, only one font size is used, so we can use a smaller factor. */ fact = EQ (Fterminal_live_p (Qnil), Qt) ? 2 : 3; - len = fact * (window_body_width (w, WINDOW_BODY_IN_CANONICAL_CHARS) * - window_body_height (w, WINDOW_BODY_IN_CANONICAL_CHARS)); + return fact * (window_body_width (w, WINDOW_BODY_IN_CANONICAL_CHARS) * + window_body_height (w, WINDOW_BODY_IN_CANONICAL_CHARS)); +} + +ptrdiff_t +get_narrowed_begv (struct window *w) +{ + int len = get_narrowed_len (w); + ptrdiff_t begv; begv = max ((window_point (w) / len - 1) * len, BEGV); return begv == BEGV ? 0 : begv; } +ptrdiff_t +get_narrowed_zv (struct window *w) +{ + int len = get_narrowed_len (w); + return min ((window_point (w) / len + 1) * len, ZV); +} + static void unwind_narrowed_begv (Lisp_Object point_min) { SET_BUF_BEGV (current_buffer, XFIXNUM (point_min)); } +static void +unwind_narrowed_zv (Lisp_Object point_max) +{ + SET_BUF_ZV (current_buffer, XFIXNUM (point_max)); +} + /* Set DST to EXPR. When IT indicates that BEGV should temporarily be updated to optimize display, evaluate EXPR with an updated BEGV. */ @@ -4372,6 +4395,15 @@ handle_fontified_prop (struct it *it) bool old_clip_changed = current_buffer->clip_changed; bool saved_inhibit_flag = it->f->inhibit_clear_image_cache; + if (it->narrowed_begv) + { + record_unwind_protect (unwind_narrowed_begv, Fpoint_min ()); + record_unwind_protect (unwind_narrowed_zv, Fpoint_max ()); + SET_BUF_BEGV (current_buffer, it->narrowed_begv); + SET_BUF_ZV (current_buffer, it->narrowed_zv); + specbind (Qinhibit_widen, Qt); + } + val = Vfontification_functions; specbind (Qfontification_functions, Qnil);