commit 99bbc1fa23c3a54f1cbd2c56c57773dd471b3ef3 (HEAD, refs/remotes/origin/master) Author: Gerd Möllmann Date: Wed Aug 3 08:46:52 2022 +0200 ; Fix last change (bug#56902) * lisp/cedet/semantic/complete.el (semantic-displayer-focus-abstract): Define after base class has been defined. diff --git a/lisp/cedet/semantic/complete.el b/lisp/cedet/semantic/complete.el index 2597a431e1..5895b75fa9 100644 --- a/lisp/cedet/semantic/complete.el +++ b/lisp/cedet/semantic/complete.el @@ -313,26 +313,6 @@ HISTORY is a symbol representing a variable to story the history in." -;; Abstract baseclass for any displayer which supports focus -(defclass semantic-displayer-focus-abstract (semantic-displayer-abstract) - ((focus :type number - :protection :protected - :documentation "A tag index from `table' which has focus. -Multiple calls to the display function can choose to focus on a -given tag, by highlighting its location.") - (find-file-focus - :allocation :class - :initform nil - :documentation - "Non-nil if focusing requires a tag's buffer be in memory.") - ) - "Abstract displayer supporting `focus'. -A displayer which has the ability to focus in on one tag. -Focusing is a way of differentiating among multiple tags -which have the same name." - :abstract t) - - (defun semantic-complete-current-match () "Calculate a match from the current completion environment. Save this in our completion variable. Make sure that variable @@ -1317,6 +1297,7 @@ Uses semanticdb for searching all tags in the current project." ;; * semantic-displayer-scroll-request ;; * semantic-displayer-focus-request + (defclass semantic-displayer-abstract () ((table :type (or null semanticdb-find-result-with-nil) :initform nil @@ -1425,6 +1406,25 @@ to click on the items to aid in completion.") ;;; Methods for any displayer which supports focus +;; Abstract baseclass for any displayer which supports focus +(defclass semantic-displayer-focus-abstract (semantic-displayer-abstract) + ((focus :type number + :protection :protected + :documentation "A tag index from `table' which has focus. +Multiple calls to the display function can choose to focus on a +given tag, by highlighting its location.") + (find-file-focus + :allocation :class + :initform nil + :documentation + "Non-nil if focusing requires a tag's buffer be in memory.") + ) + "Abstract displayer supporting `focus'. +A displayer which has the ability to focus in on one tag. +Focusing is a way of differentiating among multiple tags +which have the same name." + :abstract t) + (define-obsolete-function-alias 'semantic-displayor-next-action #'semantic-displayer-next-action "27.1") (cl-defmethod semantic-displayer-next-action ((obj semantic-displayer-focus-abstract)) commit cfb295f1e55e4d04beaad5d57ede494c436cf277 Author: Po Lu Date: Wed Aug 3 11:42:22 2022 +0800 Prevent GC threshold from exceeding fixnum limit during precision scrolling * lisp/pixel-scroll.el (pixel-scroll-start-momentum): Prevent GC threshold from exceeding most-positive-fixnum. diff --git a/lisp/pixel-scroll.el b/lisp/pixel-scroll.el index aefe3c12dc..6dba733b9c 100644 --- a/lisp/pixel-scroll.el +++ b/lisp/pixel-scroll.el @@ -761,7 +761,8 @@ It is a vector of the form [ VELOCITY TIME SIGN ]." (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)) + (gc-cons-threshold (min most-positive-fixnum + (* gc-cons-threshold 3))) (state nil)) (when (framep window) (setq window (frame-selected-window window))) commit 9a9634dc725278a6a676fa4590f53543cada34b2 Author: Po Lu Date: Wed Aug 3 11:38:27 2022 +0800 Add preparations for animation frame timing support * src/xterm.c (x_sync_get_monotonic_time) (x_sync_current_monotonic_time, x_sync_note_frame_times): New functions. (x_sync_wait_for_frame_drawn_event, x_sync_update_begin) (x_sync_handle_frame_drawn): Note frame times. (x_display_set_last_user_time): Check if the X server time is probably the same as CLOCK_MONOTONIC. * src/xterm.h (struct x_display_info, struct x_output): New fields and flags for clock handling and frame times. diff --git a/src/xterm.c b/src/xterm.c index 2455b205bd..2239b9fa4e 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -6634,6 +6634,57 @@ x_if_event (Display *dpy, XEvent *event_return, } } +/* Return the monotonic time corresponding to the high-resolution + server timestamp TIMESTAMP. Return 0 if the necessary information + is not available. */ + +static uint64_t +x_sync_get_monotonic_time (struct x_display_info *dpyinfo, + uint64_t timestamp) +{ + if (dpyinfo->server_time_monotonic_p) + return timestamp; + + return 0; +} + +/* Return the current monotonic time in the same format as a + high-resolution server timestamp. */ + +static uint64_t +x_sync_current_monotonic_time (void) +{ + struct timespec time; + + clock_gettime (CLOCK_MONOTONIC, &time); + return time.tv_sec * 1000000 + time.tv_nsec / 1000; +} + +/* Decode a _NET_WM_FRAME_DRAWN message and calculate the time it took + to draw the last frame. */ + +static void +x_sync_note_frame_times (struct x_display_info *dpyinfo, + struct frame *f, XEvent *event) +{ + uint64_t low, high, time; + struct x_output *output; + + low = event->xclient.data.l[2]; + high = event->xclient.data.l[3]; + output = FRAME_X_OUTPUT (f); + + time = x_sync_get_monotonic_time (dpyinfo, low | (high << 32)); + + if (time) + output->last_frame_time = time - output->temp_frame_time; + +#ifdef FRAME_DEBUG + fprintf (stderr, "Drawing the last frame took: %lu ms (%lu)\n", + output->last_frame_time / 1000, time); +#endif +} + static Bool x_sync_is_frame_drawn_event (Display *dpy, XEvent *event, XPointer user_data) @@ -6681,6 +6732,8 @@ x_sync_wait_for_frame_drawn_event (struct frame *f) /* Also change the frame parameter to reflect the new state. */ store_frame_param (f, Quse_frame_synchronization, Qnil); } + else + x_sync_note_frame_times (FRAME_DISPLAY_INFO (f), f, &event); FRAME_X_WAITING_FOR_DRAW (f) = false; } @@ -6726,6 +6779,10 @@ x_sync_update_begin (struct frame *f) /* Wait for the last frame to be drawn before drawing this one. */ x_sync_wait_for_frame_drawn_event (f); + /* Make a note of the time at which we started to draw this + frame. */ + FRAME_X_OUTPUT (f)->temp_frame_time = x_sync_current_monotonic_time (); + /* Since Emacs needs a non-urgent redraw, ensure that value % 4 == 1. Later, add 3 to create the even counter value. */ if (XSyncValueLow32 (value) % 4 == 2) @@ -6796,6 +6853,8 @@ x_sync_handle_frame_drawn (struct x_display_info *dpyinfo, { if (FRAME_OUTER_WINDOW (f) == message->xclient.window) FRAME_X_WAITING_FOR_DRAW (f) = false; + + x_sync_note_frame_times (dpyinfo, f, message); } #endif @@ -7379,6 +7438,9 @@ x_display_set_last_user_time (struct x_display_info *dpyinfo, Time time, #ifndef USE_GTK struct frame *focus_frame; Time old_time; +#if defined HAVE_XSYNC + uint64_t monotonic_time; +#endif focus_frame = dpyinfo->x_focus_frame; old_time = dpyinfo->last_user_time; @@ -7391,6 +7453,21 @@ x_display_set_last_user_time (struct x_display_info *dpyinfo, Time time, if (!send_event || time > dpyinfo->last_user_time) dpyinfo->last_user_time = time; +#if defined HAVE_XSYNC && !defined USE_GTK + if (!send_event) + { + /* See if the current CLOCK_MONOTONIC time is reasonably close + to the X server time. */ + monotonic_time = x_sync_current_monotonic_time (); + + if (time * 1000 > monotonic_time - 500 * 1000 + && time * 1000 < monotonic_time + 500 * 1000) + dpyinfo->server_time_monotonic_p = true; + else + dpyinfo->server_time_monotonic_p = false; + } +#endif + #ifndef USE_GTK /* Don't waste bandwidth if the time hasn't actually changed. */ if (focus_frame && old_time != dpyinfo->last_user_time) diff --git a/src/xterm.h b/src/xterm.h index 2b8a2e5da4..b656c8dcb2 100644 --- a/src/xterm.h +++ b/src/xterm.h @@ -769,6 +769,12 @@ struct x_display_info /* The pending drag-and-drop time for middle-click based drag-and-drop emulation. */ Time pending_dnd_time; + +#if defined HAVE_XSYNC && !defined USE_GTK + /* Whether or not the server time is probably the same as + "clock_gettime (CLOCK_MONOTONIC, ...)". */ + bool server_time_monotonic_p; +#endif }; #ifdef HAVE_X_I18N @@ -1061,6 +1067,12 @@ struct x_output /* Whether or not Emacs should wait for the compositing manager to draw frames before starting a new frame. */ bool_bf use_vsync_p : 1; + + /* The time (in microseconds) it took to draw the last frame. */ + uint64_t last_frame_time; + + /* A temporary time used to calculate that value. */ + uint64_t temp_frame_time; #endif #endif commit fdbe3362c5a72be7d4c930a614fe5853bf6eff1f Author: Po Lu Date: Wed Aug 3 09:28:44 2022 +0800 Fix window iconification, raising and lowering frames, etc * src/xterm.c (XFlush): Remove define to 0. (x_clear_frame, x_scroll_run, x_draw_window_cursor) (x_free_frame_resources): Remove calls to XFlush where it is not really necessary. Leave the calls that actually are intact. diff --git a/src/xterm.c b/src/xterm.c index 52d08e76a7..2455b205bd 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -4960,15 +4960,6 @@ x_xr_ensure_picture (struct frame *f) } #endif -/* Remove calls to XFlush by defining XFlush to an empty replacement. - Calls to XFlush should be unnecessary because the X output buffer - is flushed automatically as needed by calls to XPending, - XNextEvent, or XWindowEvent according to the XFlush man page. - XTread_socket calls XPending. Removing XFlush improves - performance. */ - -#define XFlush(DISPLAY) (void) 0 - /*********************************************************************** Debugging @@ -10464,16 +10455,12 @@ x_clear_frame (struct frame *f) mark_window_cursors_off (XWINDOW (FRAME_ROOT_WINDOW (f))); block_input (); - font_drop_xrender_surfaces (f); x_clear_window (f); /* We have to clear the scroll bars. If we have changed colors or something like that, then they should be notified. */ x_scroll_bar_clear (f); - - XFlush (FRAME_X_DISPLAY (f)); - unblock_input (); } @@ -10851,7 +10838,6 @@ x_scroll_run (struct window *w, struct run *run) view->clip_bottom - view->clip_top); } xwidget_expose (view); - XFlush (dpy); } } } @@ -23157,8 +23143,6 @@ x_draw_window_cursor (struct window *w, struct glyph_row *glyph_row, int x, xic_set_preeditarea (w, x, y); #endif } - - XFlush (FRAME_X_DISPLAY (f)); } @@ -26216,8 +26200,6 @@ x_free_frame_resources (struct frame *f) XFreeCursor (FRAME_X_DISPLAY (f), f->output_data.x->bottom_edge_cursor); if (f->output_data.x->bottom_left_corner_cursor != 0) XFreeCursor (FRAME_X_DISPLAY (f), f->output_data.x->bottom_left_corner_cursor); - - XFlush (FRAME_X_DISPLAY (f)); } #ifdef HAVE_GTK3 commit 72c7ee2e525d87b58a28aea8af8cef31f607d7c0 Author: Stefan Kangas Date: Wed Aug 3 01:40:32 2022 +0200 Avoid cl-cXXXr compat aliases * lisp/emacs-lisp/cl-lib.el (cl-third, cl-fourth): * lisp/emacs-lisp/cl-macs.el (cl--do-&aux, cl--do-arglist) (cl--parse-loop-clause, cl--loop-let, cl--loop-build-ands) (cl--do-proclaim, cl-defstruct): Prefer using cXXXr functions directly, instead of cl-cXXXr prefixed compat aliases. diff --git a/lisp/emacs-lisp/cl-lib.el b/lisp/emacs-lisp/cl-lib.el index 3f40ab0760..a54fa21fa9 100644 --- a/lisp/emacs-lisp/cl-lib.el +++ b/lisp/emacs-lisp/cl-lib.el @@ -372,8 +372,8 @@ SEQ, this is like `mapcar'. With several, it is like the Common Lisp (cl--defalias 'cl-second 'cadr) (cl--defalias 'cl-rest 'cdr) -(cl--defalias 'cl-third 'cl-caddr "Return the third element of the list X.") -(cl--defalias 'cl-fourth 'cl-cadddr "Return the fourth element of the list X.") +(cl--defalias 'cl-third #'caddr "Return the third element of the list X.") +(cl--defalias 'cl-fourth #'cadddr "Return the fourth element of the list X.") (defsubst cl-fifth (x) "Return the fifth element of the list X." diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index 727b3098e3..12917c99e1 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -527,7 +527,7 @@ its argument list allows full Common Lisp conventions." (while (and (eq (car args) '&aux) (pop args)) (while (and args (not (memq (car args) cl--lambda-list-keywords))) (if (consp (car args)) - (if (and cl--bind-enquote (cl-cadar args)) + (if (and cl--bind-enquote (cadar args)) (cl--do-arglist (caar args) `',(cadr (pop args))) (cl--do-arglist (caar args) (cadr (pop args)))) @@ -612,7 +612,7 @@ its argument list allows full Common Lisp conventions." (if (eq ?_ (aref name 0)) (setq name (substring name 1))) (intern (format ":%s" name))))) - (varg (if (consp (car arg)) (cl-cadar arg) (car arg))) + (varg (if (consp (car arg)) (cadar arg) (car arg))) (def (if (cdr arg) (cadr arg) ;; The ordering between those two or clauses is ;; irrelevant, since in practice only one of the two @@ -1339,7 +1339,7 @@ For more details, see Info node `(cl)Loop Facility'. (temp-idx (if (eq (car cl--loop-args) 'using) (if (and (= (length (cadr cl--loop-args)) 2) - (eq (cl-caadr cl--loop-args) 'index)) + (eq (caadr cl--loop-args) 'index)) (cadr (cl--pop2 cl--loop-args)) (error "Bad `using' clause")) (make-symbol "--cl-idx--")))) @@ -1370,8 +1370,8 @@ For more details, see Info node `(cl)Loop Facility'. (other (if (eq (car cl--loop-args) 'using) (if (and (= (length (cadr cl--loop-args)) 2) - (memq (cl-caadr cl--loop-args) hash-types) - (not (eq (cl-caadr cl--loop-args) word))) + (memq (caadr cl--loop-args) hash-types) + (not (eq (caadr cl--loop-args) word))) (cadr (cl--pop2 cl--loop-args)) (error "Bad `using' clause")) (make-symbol "--cl-var--")))) @@ -1433,8 +1433,8 @@ For more details, see Info node `(cl)Loop Facility'. (other (if (eq (car cl--loop-args) 'using) (if (and (= (length (cadr cl--loop-args)) 2) - (memq (cl-caadr cl--loop-args) key-types) - (not (eq (cl-caadr cl--loop-args) word))) + (memq (caadr cl--loop-args) key-types) + (not (eq (caadr cl--loop-args) word))) (cadr (cl--pop2 cl--loop-args)) (error "Bad `using' clause")) (make-symbol "--cl-var--")))) @@ -1656,7 +1656,7 @@ If BODY is `setq', then use SPECS for assignments rather than for bindings." (let ((temps nil) (new nil)) (when par (let ((p specs)) - (while (and p (or (symbolp (car-safe (car p))) (null (cl-cadar p)))) + (while (and p (or (symbolp (car-safe (car p))) (null (cadar p)))) (setq p (cdr p))) (when p (setq par nil) @@ -1731,7 +1731,7 @@ such that COMBO is equivalent to (and . CLAUSES)." (setq clauses (cons (nconc (butlast (car clauses)) (if (eq (car-safe (cadr clauses)) 'progn) - (cl-cdadr clauses) + (cdadr clauses) (list (cadr clauses)))) (cddr clauses))) ;; A final (progn ,@A t) is moved outside of the `and'. @@ -2613,7 +2613,7 @@ Example: ((and (eq (car-safe spec) 'warn) (boundp 'byte-compile-warnings)) (while (setq spec (cdr spec)) (if (consp (car spec)) - (if (eq (cl-cadar spec) 0) + (if (eq (cadar spec) 0) (byte-compile-disable-warning (caar spec)) (byte-compile-enable-warning (caar spec))))))) nil) @@ -3093,9 +3093,9 @@ To see the documentation for a defined struct type, use (t `(and (consp cl-x) (memq (nth ,pos cl-x) ,tag-symbol)))))) pred-check (and pred-form (> safety 0) - (if (and (eq (cl-caadr pred-form) 'vectorp) + (if (and (eq (caadr pred-form) 'vectorp) (= safety 1)) - (cons 'and (cl-cdddr pred-form)) + (cons 'and (cdddr pred-form)) `(,predicate cl-x)))) (when pred-form (push `(,defsym ,predicate (cl-x) commit 85f1ad0c798b5556c37185f4930929d5aa386a5e Author: Stefan Kangas Date: Wed Aug 3 01:20:51 2022 +0200 * doc/misc/vtable.texi (Commands): Fix typo. (Bug#56899) diff --git a/doc/misc/vtable.texi b/doc/misc/vtable.texi index 296dc520a1..59cd9d0f56 100644 --- a/doc/misc/vtable.texi +++ b/doc/misc/vtable.texi @@ -465,9 +465,9 @@ When point is placed on a vtable, the following keys are bound: Sort the table by the current column (@code{vtable-sort-by-current-column}). Note that the table is sorted according to the data returned by the getter function (@pxref{Making A -Table}), not by how it's -displayed in the buffer. Columns that have only numerical data is -sorted as numbers, the rest are sorted as strings. +Table}), not by how it's displayed in the buffer. Columns that have +only numerical data are sorted as numbers, the rest are sorted as +strings. @findex vtable-narrow-current-column @item @{ commit e1553142fefaf39d4742d1a161de2bce691204b2 Author: Stefan Kangas Date: Wed Aug 3 00:48:07 2022 +0200 Prefer defvar-keymap in footnote.el * lisp/mail/footnote.el (footnote-mode-map) (footnote-minor-mode-map): Prefer defvar-keymap. diff --git a/lisp/mail/footnote.el b/lisp/mail/footnote.el index ab29a16096..a594fa3ccb 100644 --- a/lisp/mail/footnote.el +++ b/lisp/mail/footnote.el @@ -840,22 +840,18 @@ being set it is automatically widened." (when (looking-at (footnote--current-regexp)) (goto-char (match-end 0)))))) -(defvar footnote-mode-map - (let ((map (make-sparse-keymap))) - (define-key map "a" #'footnote-add-footnote) - (define-key map "b" #'footnote-back-to-message) - (define-key map "c" #'footnote-cycle-style) - (define-key map "d" #'footnote-delete-footnote) - (define-key map "g" #'footnote-goto-footnote) - (define-key map "r" #'footnote-renumber-footnotes) - (define-key map "s" #'footnote-set-style) - map)) - -(defvar footnote-minor-mode-map - (let ((map (make-sparse-keymap))) - (define-key map footnote-prefix footnote-mode-map) - map) - "Keymap used for binding footnote minor mode.") +(defvar-keymap footnote-mode-map + "a" #'footnote-add-footnote + "b" #'footnote-back-to-message + "c" #'footnote-cycle-style + "d" #'footnote-delete-footnote + "g" #'footnote-goto-footnote + "r" #'footnote-renumber-footnotes + "s" #'footnote-set-style) + +(defvar-keymap footnote-minor-mode-map + :doc "Keymap used for binding footnote minor mode." + (key-description footnote-prefix) footnote-mode-map) (defmacro footnote--local-advice (mode variable function) "Add advice to a variable holding buffer-local functions. @@ -889,7 +885,6 @@ play around with the following keys: (footnote--local-advice footnote-mode fill-paragraph-function footnote--fill-paragraph) (when footnote-mode - ;; (footnote-setup-keybindings) (make-local-variable 'footnote-style) (make-local-variable 'footnote-body-tag-spacing) (make-local-variable 'footnote-spaced-footnotes) commit 39aa623479128b465b01490845f0781c03eece8d Author: Stefan Kangas Date: Wed Aug 3 00:37:24 2022 +0200 Obsolete unused variable footnote-use-message-mode * lisp/mail/footnote.el (footnote-use-message-mode): Make obsolete. diff --git a/lisp/mail/footnote.el b/lisp/mail/footnote.el index 29e16c419b..ab29a16096 100644 --- a/lisp/mail/footnote.el +++ b/lisp/mail/footnote.el @@ -93,6 +93,7 @@ displaying footnotes." (defcustom footnote-use-message-mode t ; Nowhere used. "If non-nil, assume Footnoting will be done in `message-mode'." :type 'boolean) +(make-obsolete-variable 'footnote-use-message-mode "it does nothing." "29.1") (defcustom footnote-body-tag-spacing 2 "Number of spaces separating a footnote body tag and its text. commit 286e308561d00a31e0321919ef36d9bc6dadbeb3 Author: Eli Zaretskii Date: Tue Aug 2 20:27:46 2022 +0300 ; Fix system-info in url-privacy.el * lisp/url/url-privacy.el (url-setup-privacy-info): Fix MS-Windows configurations. diff --git a/lisp/url/url-privacy.el b/lisp/url/url-privacy.el index 93a512c02e..36ccbe2adc 100644 --- a/lisp/url/url-privacy.el +++ b/lisp/url/url-privacy.el @@ -41,9 +41,16 @@ nil) ;; First, we handle the inseparable OS/Windowing system ;; combinations - ((eq system-type 'windows-nt) "Windows-NT; 32bit") + ((memq system-type '(windows-nt cygwin)) + (concat "MS-Windows; " + (if (string-match-p "\\`x86_64" system-configuration) + "64bit" + "32bit") + "; " + (cond ((eq window-system 'w32) "w32") + ((eq window-system 'x) "X11") + (t "TTY")))) ((eq system-type 'ms-dos) "MS-DOS; 32bit") - ((memq window-system '(win32 w32)) "Windows; 32bit") (t (pcase (or window-system 'tty) ('x "X11") commit 8af91dee9a9031ac0d49848b16bd288685f1f370 Author: Lars Ingebrigtsen Date: Tue Aug 2 12:44:06 2022 +0200 Improve sendmail-program doc string * lisp/mail/sendmail.el (sendmail-program): Document that the program shouldn't output text (bug#56855). diff --git a/lisp/mail/sendmail.el b/lisp/mail/sendmail.el index f985b2ceac..189ad075c4 100644 --- a/lisp/mail/sendmail.el +++ b/lisp/mail/sendmail.el @@ -49,7 +49,9 @@ ((file-exists-p "/usr/lib/sendmail") "/usr/lib/sendmail") ((file-exists-p "/usr/ucblib/sendmail") "/usr/ucblib/sendmail") (t "sendmail"))) - "Program used to send messages." + "Program used to send messages. +If the program returns a non-zero error code, or outputs any +text, sending is considered \"failed\" by Emacs." :version "24.1" ; add executable-find, remove fakemail :type 'file) commit 8783700b23e70874c4996908bf02c010ae6f3fe1 Author: Stefan Monnier Date: Tue Aug 2 10:38:53 2022 -0400 * src/xdisp.c (redisplay_window): Use BEG rather than hard coding 1 diff --git a/src/marker.c b/src/marker.c index 3c8e628762..9727586f42 100644 --- a/src/marker.c +++ b/src/marker.c @@ -214,11 +214,12 @@ buf_charpos_to_bytepos (struct buffer *b, ptrdiff_t charpos) We have one known above and one known below. Scan, counting characters, from whichever one is closer. */ + eassert (best_below <= charpos && charpos <= best_above); if (charpos - best_below < best_above - charpos) { bool record = charpos - best_below > 5000; - while (best_below != charpos) + while (best_below < charpos) { best_below++; best_below_byte += buf_next_char_len (b, best_below_byte); @@ -243,7 +244,7 @@ buf_charpos_to_bytepos (struct buffer *b, ptrdiff_t charpos) { bool record = best_above - charpos > 5000; - while (best_above != charpos) + while (best_above > charpos) { best_above--; best_above_byte -= buf_prev_char_len (b, best_above_byte); diff --git a/src/xdisp.c b/src/xdisp.c index 65d9221a15..2bedf1c784 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -19449,7 +19449,7 @@ redisplay_window (Lisp_Object window, bool just_this_one_p) { ptrdiff_t cur, next, found, max = 0, threshold; threshold = XFIXNUM (Vlong_line_threshold); - for (cur = 1; cur < Z; cur = next) + for (cur = BEG; cur < Z; cur = next) { next = find_newline1 (cur, CHAR_TO_BYTE (cur), 0, -1, 1, &found, NULL, true); commit 344b48f490416cb1200e19b28d356e7fb5b04387 Author: Stefan Monnier Date: Tue Aug 2 10:22:00 2022 -0400 CEDET: Remove left-over uses of obsolete -child-p predicates Those predicates were still sometimes used in a few places, notably via `:type ... -child` which was never technically correct. * lisp/cedet/ede/config.el (ede-extra-config, ede-project-with-config): * lisp/cedet/ede/base.el (ede-project-placeholder): Avoid pseudo-type `-child`. * lisp/cedet/semantic/complete.el (semantic-displayer-focus-abstract): Move before use of `cl-typep` on it. (semantic-complete-current-match): * lisp/cedet/ede/speedbar.el (ede-speedbar-menu): Use `cl-typep` instead of `-child-p`. * lisp/cedet/semantic/db.el (semanticdb-get-buffer): Use `cl-defgeneric` for the main/default definition. (semantic-tag-parent-buffer): Add method. * lisp/cedet/semantic/tag-file.el (semantic-tag-parent-buffer): New generic function extracted from `semantic-go-to-tag`. This allows us to keep the semanticdb-table part in semantic/db and thus break a cyclic dependency. (semantic-go-to-tag): Use it. Demote to a plain `defun` since it's not overloaded anywhere. * lisp/cedet/semantic/util.el (semanticdb-abstract-table-child-p): Remove unused declaration. * lisp/cedet/srecode/compile.el (srecode-template-inserter-newline-child-p): Remove unused declaration. (srecord-compile-inserter-newline-p): New generic function, so we can move the `srecode-template-inserter-newline` case to `srecode/insert.el`, to avoid a cyclic dependency. * lisp/cedet/srecode/insert.el (srecord-compile-inserter-newline-p): New method. diff --git a/lisp/cedet/ede/base.el b/lisp/cedet/ede/base.el index 8f5db8db18..9182fcd5ac 100644 --- a/lisp/cedet/ede/base.el +++ b/lisp/cedet/ede/base.el @@ -141,7 +141,7 @@ For some project types, this will be the file that stores the project configurat In other projects types, this file is merely a unique identifier to this type of project.") (rootproject ; :initarg - no initarg, don't save this slot! :initform nil - :type (or null ede-project-placeholder-child) + :type (or null ede-project-placeholder) :documentation "Pointer to our root project.") ) "Placeholder object for projects not loaded into memory. diff --git a/lisp/cedet/ede/config.el b/lisp/cedet/ede/config.el index 529b96f2b0..8c4f52647b 100644 --- a/lisp/cedet/ede/config.el +++ b/lisp/cedet/ede/config.el @@ -65,7 +65,7 @@ (defclass ede-extra-config (eieio-persistent) ((extension :initform ".ede") (file-header-line :initform ";; EDE Project Configuration") - (project :type ede-project-with-config-child + (project :type ede-project-with-config :documentation "The project this config is bound to.") (ignored-file :initform nil @@ -102,7 +102,7 @@ initialize the :file slot of the persistent baseclass.") :documentation "The class of the configuration used by this project.") (config :initform nil - :type (or null ede-extra-config-child) + :type (or null ede-extra-config) :documentation "The configuration object for this project.") ) diff --git a/lisp/cedet/ede/speedbar.el b/lisp/cedet/ede/speedbar.el index f99a1d114b..604b660344 100644 --- a/lisp/cedet/ede/speedbar.el +++ b/lisp/cedet/ede/speedbar.el @@ -62,7 +62,7 @@ (defvar ede-speedbar-menu '([ "Compile" ede-speedbar-compile-line t] [ "Compile Project" ede-speedbar-compile-project - (ede-project-child-p (speedbar-line-token)) ] + (cl-typep (speedbar-line-token) 'ede-project) ] "---" [ "Edit File/Tag" speedbar-edit-line (not (eieio-object-p (speedbar-line-token)))] @@ -79,7 +79,7 @@ (eieio-object-p (speedbar-line-token)) ] [ "Edit Project File" ede-speedbar-edit-projectfile t] [ "Make Distribution" ede-speedbar-make-distribution - (ede-project-child-p (speedbar-line-token)) ] + (cl-typep (speedbar-line-token) 'ede-project) ] ) "Menu part in easymenu format used in speedbar while browsing objects.") diff --git a/lisp/cedet/semantic/complete.el b/lisp/cedet/semantic/complete.el index 436ad08c5f..2597a431e1 100644 --- a/lisp/cedet/semantic/complete.el +++ b/lisp/cedet/semantic/complete.el @@ -311,11 +311,27 @@ HISTORY is a symbol representing a variable to story the history in." (defvar semantic-complete-current-matched-tag nil "Variable used to pass the tags being matched to the prompt.") -;; semantic-displayer-focus-abstract-child-p is part of the -;; semantic-displayer-focus-abstract class, defined later in this -;; file. -(declare-function semantic-displayer-focus-abstract-child-p "semantic/complete" - t t) + + +;; Abstract baseclass for any displayer which supports focus +(defclass semantic-displayer-focus-abstract (semantic-displayer-abstract) + ((focus :type number + :protection :protected + :documentation "A tag index from `table' which has focus. +Multiple calls to the display function can choose to focus on a +given tag, by highlighting its location.") + (find-file-focus + :allocation :class + :initform nil + :documentation + "Non-nil if focusing requires a tag's buffer be in memory.") + ) + "Abstract displayer supporting `focus'. +A displayer which has the ability to focus in on one tag. +Focusing is a way of differentiating among multiple tags +which have the same name." + :abstract t) + (defun semantic-complete-current-match () "Calculate a match from the current completion environment. @@ -346,7 +362,7 @@ Return value can be: ((setq matchlist (semantic-collector-current-exact-match collector)) (if (= (semanticdb-find-result-length matchlist) 1) (setq answer (semanticdb-find-result-nth-in-buffer matchlist 0)) - (if (semantic-displayer-focus-abstract-child-p displayer) + (if (cl-typep displayer 'semantic-displayer-focus-abstract) ;; For focusing displayers, we can claim this is ;; not unique. Multiple focuses can choose the correct ;; one. @@ -1407,24 +1423,7 @@ to click on the items to aid in completion.") ) ) -;;; Abstract baseclass for any displayer which supports focus -(defclass semantic-displayer-focus-abstract (semantic-displayer-abstract) - ((focus :type number - :protection :protected - :documentation "A tag index from `table' which has focus. -Multiple calls to the display function can choose to focus on a -given tag, by highlighting its location.") - (find-file-focus - :allocation :class - :initform nil - :documentation - "Non-nil if focusing requires a tag's buffer be in memory.") - ) - "Abstract displayer supporting `focus'. -A displayer which has the ability to focus in on one tag. -Focusing is a way of differentiating among multiple tags -which have the same name." - :abstract t) +;;; Methods for any displayer which supports focus (define-obsolete-function-alias 'semantic-displayor-next-action #'semantic-displayer-next-action "27.1") diff --git a/lisp/cedet/semantic/db-typecache.el b/lisp/cedet/semantic/db-typecache.el index 38caac2292..efc1ab2c5f 100644 --- a/lisp/cedet/semantic/db-typecache.el +++ b/lisp/cedet/semantic/db-typecache.el @@ -362,7 +362,7 @@ a master list." ;; don't include ourselves in this crazy list. (when (and i (not (eq i table)) ;; @todo - This eieio fcn can be slow! Do I need it? - ;; (semanticdb-table-child-p i) + ;; (cl-typep i 'semanticdb-table) ) (setq incstream (semanticdb-typecache-merge-streams diff --git a/lisp/cedet/semantic/db.el b/lisp/cedet/semantic/db.el index 757e46677e..ff62f53d3c 100644 --- a/lisp/cedet/semantic/db.el +++ b/lisp/cedet/semantic/db.el @@ -115,11 +115,13 @@ for a new table not associated with a buffer." "Return a nil, meaning abstract table OBJ is not in a buffer." nil) -(cl-defmethod semanticdb-get-buffer ((_obj semanticdb-abstract-table)) - "Return a buffer associated with OBJ. +(cl-defgeneric semanticdb-get-buffer (_obj) + "Return a buffer associated with semanticdb table OBJ. If the buffer is not in memory, load it with `find-file-noselect'." nil) +;; FIXME: Should we merge `semanticdb-get-buffer' and +;; `semantic-tag-parent-buffer'? ;; This generic method allows for sloppier coding. Many ;; functions treat "table" as something that could be a buffer, ;; file name, or other. This makes use of table more robust. @@ -271,6 +273,9 @@ For C/C++, the C preprocessor macros can be saved here.") ) "A single table of tags derived from file.") +(cl-defmethod semantic-tag-parent-buffer ((parent semanticdb-table)) + (semanticdb-get-buffer parent)) ;FIXME: η-redex! + (cl-defmethod semanticdb-in-buffer-p ((obj semanticdb-table)) "Return a buffer associated with OBJ. If the buffer is in memory, return that buffer." diff --git a/lisp/cedet/semantic/tag-file.el b/lisp/cedet/semantic/tag-file.el index 7a80bccb53..a5220f622a 100644 --- a/lisp/cedet/semantic/tag-file.el +++ b/lisp/cedet/semantic/tag-file.el @@ -28,8 +28,6 @@ (require 'semantic/tag) (defvar ede-minor-mode) -(declare-function semanticdb-table-child-p "semantic/db" t t) -(declare-function semanticdb-get-buffer "semantic/db") (declare-function semantic-dependency-find-file-on-path "semantic/dep") (declare-function ede-toplevel "ede/base") @@ -37,68 +35,66 @@ ;;; Location a TAG came from. ;; + +(cl-defgeneric semantic-tag-parent-buffer (parent) + "Return the buffer in which a tag can be found, knowing its PARENT." + (cond ((and (semantic-tag-p parent) (semantic-tag-in-buffer-p parent)) + ;; We have a parent with a buffer, then go there. + (semantic-tag-buffer parent)) + ((and (semantic-tag-p parent) (semantic-tag-file-name parent)) + ;; The parent only has a file-name, then + ;; find that file, and switch to that buffer. + (find-file-noselect (semantic-tag-file-name parent))))) + ;;;###autoload -(define-overloadable-function semantic-go-to-tag (tag &optional parent) +(defun semantic-go-to-tag (tag &optional parent) "Go to the location of TAG. TAG may be a stripped element, in which case PARENT specifies a parent tag that has position information. PARENT can also be a `semanticdb-table' object." - (:override - (save-match-data + (save-match-data + (set-buffer (cond ((semantic-tag-in-buffer-p tag) ;; We have a linked tag, go to that buffer. - (set-buffer (semantic-tag-buffer tag))) + (semantic-tag-buffer tag)) ((semantic-tag-file-name tag) ;; If it didn't have a buffer, but does have a file ;; name, then we need to get to that file so the tag ;; location is made accurate. - (set-buffer (find-file-noselect (semantic-tag-file-name tag)))) - ((and parent (semantic-tag-p parent) (semantic-tag-in-buffer-p parent)) - ;; The tag had nothing useful, but we have a parent with - ;; a buffer, then go there. - (set-buffer (semantic-tag-buffer parent))) - ((and parent (semantic-tag-p parent) (semantic-tag-file-name parent)) - ;; Tag had nothing, and the parent only has a file-name, then - ;; find that file, and switch to that buffer. - (set-buffer (find-file-noselect (semantic-tag-file-name parent)))) - ((and parent (featurep 'semantic/db) - (semanticdb-table-child-p parent)) - (set-buffer (semanticdb-get-buffer parent))) - (t - ;; Well, just assume things are in the current buffer. - nil - ))) - ;; We should be in the correct buffer now, try and figure out - ;; where the tag is. - (cond ((semantic-tag-with-position-p tag) - ;; If it's a number, go there - (goto-char (semantic-tag-start tag))) - ((semantic-tag-with-position-p parent) - ;; Otherwise, it's a trimmed vector, such as a parameter, - ;; or a structure part. If there is a parent, we can use it - ;; as a bounds for searching. - (goto-char (semantic-tag-start parent)) - ;; Here we make an assumption that the text returned by - ;; the parser and concocted by us actually exists - ;; in the buffer. - (re-search-forward (semantic-tag-name tag) - (semantic-tag-end parent) - t)) - ((semantic-tag-get-attribute tag :line) - ;; The tag has a line number in it. Go there. - (goto-char (point-min)) - (forward-line (1- (semantic-tag-get-attribute tag :line)))) - ((and (semantic-tag-p parent) (semantic-tag-get-attribute parent :line)) - ;; The tag has a line number in it. Go there. - (goto-char (point-min)) - (forward-line (1- (semantic-tag-get-attribute parent :line))) - (re-search-forward (semantic-tag-name tag) nil t)) - (t - ;; Take a guess that the tag has a unique name, and just - ;; search for it from the beginning of the buffer. - (goto-char (point-min)) - (re-search-forward (semantic-tag-name tag) nil t))) - ) + (find-file-noselect (semantic-tag-file-name tag))) + ((and parent (semantic-tag-parent-buffer parent))) + ;; Well, just assume things are in the current buffer. + (t (current-buffer))))) + ;; We should be in the correct buffer now, try and figure out + ;; where the tag is. + (cond ((semantic-tag-with-position-p tag) + ;; If it's a number, go there + (goto-char (semantic-tag-start tag))) + ((semantic-tag-with-position-p parent) + ;; Otherwise, it's a trimmed vector, such as a parameter, + ;; or a structure part. If there is a parent, we can use it + ;; as a bounds for searching. + (goto-char (semantic-tag-start parent)) + ;; Here we make an assumption that the text returned by + ;; the parser and concocted by us actually exists + ;; in the buffer. + (re-search-forward (semantic-tag-name tag) + (semantic-tag-end parent) + t)) + ((semantic-tag-get-attribute tag :line) + ;; The tag has a line number in it. Go there. + (goto-char (point-min)) + (forward-line (1- (semantic-tag-get-attribute tag :line)))) + ((and (semantic-tag-p parent) (semantic-tag-get-attribute parent :line)) + ;; The tag has a line number in it. Go there. + (goto-char (point-min)) + (forward-line (1- (semantic-tag-get-attribute parent :line))) + (re-search-forward (semantic-tag-name tag) nil t)) + (t + ;; Take a guess that the tag has a unique name, and just + ;; search for it from the beginning of the buffer. + (goto-char (point-min)) + (re-search-forward (semantic-tag-name tag) nil t))) ) ;;; Dependencies diff --git a/lisp/cedet/semantic/util.el b/lisp/cedet/semantic/util.el index 69a7c8f59c..24f71a2dcc 100644 --- a/lisp/cedet/semantic/util.el +++ b/lisp/cedet/semantic/util.el @@ -77,7 +77,6 @@ If FILE is not loaded, and semanticdb is not available, find the file (with-current-buffer (find-file-noselect file) (semantic-fetch-tags)))))) -(declare-function semanticdb-abstract-table-child-p "semantic/db" (obj) t) (declare-function semanticdb-refresh-table "semantic/db") (declare-function semanticdb-get-tags "semantic/db" (arg &rest args) t) (declare-function semanticdb-find-results-p "semantic/db-find" (resultp)) @@ -115,8 +114,6 @@ buffer, or a filename. If SOMETHING is nil return nil." (require 'semantic/db-mode) (semanticdb-minor-mode-p) (progn - (declare-function semanticdb-abstract-table--eieio-childp - "semantic/db") (cl-typep something 'semanticdb-abstract-table))) (semanticdb-refresh-table something) (semanticdb-get-tags something)) diff --git a/lisp/cedet/srecode/compile.el b/lisp/cedet/srecode/compile.el index 37c83be811..bed74861ca 100644 --- a/lisp/cedet/srecode/compile.el +++ b/lisp/cedet/srecode/compile.el @@ -38,9 +38,6 @@ (require 'srecode/table) (require 'srecode/dictionary) -(declare-function srecode-template-inserter-newline-child-p "srecode/insert" - t t) - ;;; Code: ;;; Template Class @@ -378,8 +375,11 @@ It is hard if the previous inserter is a newline object." (while (and comp (stringp (car comp))) (setq comp (cdr comp))) (or (not comp) - (progn (require 'srecode/insert) - (srecode-template-inserter-newline-child-p (car comp))))) + (srecord-compile-inserter-newline-p (car comp)))) + +(cl-defgeneric srecord-compile-inserter-newline-p (_obj) + "Non-nil if OBJ is a newline inserter object." + nil) (defun srecode-compile-split-code (tag str STATE &optional end-name) diff --git a/lisp/cedet/srecode/insert.el b/lisp/cedet/srecode/insert.el index 8dd5d25157..c0260c62a9 100644 --- a/lisp/cedet/srecode/insert.el +++ b/lisp/cedet/srecode/insert.el @@ -319,6 +319,10 @@ by themselves.") Specify the :indent argument to enable automatic indentation when newlines occur in your template.") +(cl-defmethod srecord-compile-inserter-newline-p + ((_ srecode-template-inserter-newline)) + t) + (cl-defmethod srecode-insert-method ((sti srecode-template-inserter-newline) dictionary) "Insert the STI inserter." commit 2be7ed257b06539ad3a6180d8c9e57f475455ec8 Author: Stefan Kangas Date: Tue Aug 2 18:49:17 2022 +0200 ; * lisp/url/url-privacy.el (url-setup-privacy-info): Simplify. diff --git a/lisp/url/url-privacy.el b/lisp/url/url-privacy.el index f897248fe4..93a512c02e 100644 --- a/lisp/url/url-privacy.el +++ b/lisp/url/url-privacy.el @@ -43,7 +43,7 @@ ;; combinations ((eq system-type 'windows-nt) "Windows-NT; 32bit") ((eq system-type 'ms-dos) "MS-DOS; 32bit") - ((memq (or window-system 'tty) '(win32 w32)) "Windows; 32bit") + ((memq window-system '(win32 w32)) "Windows; 32bit") (t (pcase (or window-system 'tty) ('x "X11") commit 409b581b09e35e65a1cfee87968c2713e2d3b970 Author: Stefan Kangas Date: Sat Jul 16 09:54:59 2022 +0200 Delete obsolete variable nntp-authinfo-file * lisp/gnus/nntp.el (nntp-authinfo-file): Delete variable obsolete since 24.1. diff --git a/etc/NEWS b/etc/NEWS index be0e65ee15..b88fb63662 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2446,14 +2446,15 @@ but switching to `ash` is generally much preferable. 'meta-complete-symbol', 'meta-mode-map', 'minibuffer-completing-symbol', 'minibuffer-local-filename-must-match-map', 'mode25', 'mode4350', -'msb-after-load-hooks', 'nnimap-split-rule', 'ns-alternatives-map', -'ns-store-cut-buffer-internal', 'package-menu-view-commentary', -'pascal-last-completions', 'pascal-show-completions', -'pascal-toggle-completions', 'prolog-char-quote-workaround', -'read-filename-at-point', 'reftex-index-map', -'reftex-index-phrases-map', 'reftex-select-bib-map', -'reftex-select-label-map', 'reftex-toc-map', 'register-name-alist', -'register-value', 'report-emacs-bug-pretest-address', +'msb-after-load-hooks', 'nnimap-split-rule', 'nntp-authinfo-file', +'ns-alternatives-map', 'ns-store-cut-buffer-internal', +'package-menu-view-commentary', 'pascal-last-completions', +'pascal-show-completions', 'pascal-toggle-completions', +'prolog-char-quote-workaround', 'read-filename-at-point', +'reftex-index-map', 'reftex-index-phrases-map', +'reftex-select-bib-map', 'reftex-select-label-map', 'reftex-toc-map', +'register-name-alist', 'register-value', +'report-emacs-bug-pretest-address', 'rmail-default-dont-reply-to-names', 'rmail-dont-reply-to', 'rmail-dont-reply-to-names', 'rst-block-face', 'rst-comment-face', 'rst-definition-face', 'rst-directive-face', 'rst-emphasis1-face', diff --git a/lisp/gnus/nntp.el b/lisp/gnus/nntp.el index 9902a280d5..b26afe6e78 100644 --- a/lisp/gnus/nntp.el +++ b/lisp/gnus/nntp.el @@ -217,25 +217,6 @@ then use this hook to rsh to the remote machine and start a proxy NNTP server there that you can connect to. See also `nntp-open-connection-function'") -(defcustom nntp-authinfo-file "~/.authinfo" - ".netrc-like file that holds nntp authinfo passwords." - :type - '(choice file - (repeat :tag "Entries" - :menu-tag "Inline" - (list :format "%v" - :value ("" ("login" . "") ("password" . "")) - (string :tag "Host") - (checklist :inline t - (cons :format "%v" - (const :format "" "login") - (string :format "Login: %v")) - (cons :format "%v" - (const :format "" "password") - (string :format "Password: %v"))))))) - -(make-obsolete-variable 'nntp-authinfo-file 'netrc-file "24.1") - (defvoo nntp-connection-timeout nil @@ -1166,7 +1147,7 @@ and a password. If SEND-IF-FORCE, only send authinfo to the server if the .authinfo file has the FORCE token." (require 'netrc) - (let* ((list (netrc-parse nntp-authinfo-file)) + (let* ((list (netrc-parse)) (alist (netrc-machine list nntp-address "nntp")) (auth-info (nth 0 (auth-source-search commit 0443f3f660990cb0fb3a2a8a1a98d37b76edd04d Author: Stefan Kangas Date: Tue Aug 2 17:11:29 2022 +0200 * lisp/textmodes/sgml-mode.el (html-tag-alist): Add https. diff --git a/lisp/textmodes/sgml-mode.el b/lisp/textmodes/sgml-mode.el index ba0a94b4a1..7d691430ec 100644 --- a/lisp/textmodes/sgml-mode.el +++ b/lisp/textmodes/sgml-mode.el @@ -1913,7 +1913,7 @@ This takes effect when first loading the library.") (valign '(("top") ("middle") ("bottom") ("baseline"))) (rel '(("next") ("previous") ("parent") ("subdocument") ("made"))) (href '("href" ("ftp:") ("file:") ("finger:") ("gopher:") ("http:") - ("mailto:") ("news:") ("rlogin:") ("telnet:") ("tn3270:") + ("https:") ("mailto:") ("news:") ("rlogin:") ("telnet:") ("tn3270:") ("wais:") ("/cgi-bin/"))) (name '("name")) (link `(,href commit 7f59cadf6f7ddead4c350cfe9582d2d1607c73d4 Author: Eli Zaretskii Date: Tue Aug 2 16:24:00 2022 +0300 ; Clarify documentation of "locked narrowing" * src/editfns.c (Fwiden, Fnarrow_to_region): * doc/lispref/positions.texi (Narrowing): Explain when 'narrow-to-region' and 'widen' might have no effect. diff --git a/doc/lispref/positions.texi b/doc/lispref/positions.texi index e08ee76ed9..333c8e19a0 100644 --- a/doc/lispref/positions.texi +++ b/doc/lispref/positions.texi @@ -1005,7 +1005,9 @@ of the current region (point and the mark, with the smallest first). Note that, in rare circumstances, Emacs may decide to leave, for performance reasons, the accessible portion of the buffer unchanged -after a call to @code{narrow-to-region}. +after a call to @code{narrow-to-region}. This can happen when a Lisp +program is called via low-level hooks, such as +@code{jit-lock-functions}, @code{post-command-hook}, etc. @end deffn @deffn Command narrow-to-page &optional move-count @@ -1033,7 +1035,9 @@ It is equivalent to the following expression: Note that, in rare circumstances, Emacs may decide to leave, for performance reasons, the accessible portion of the buffer unchanged -after a call to @code{widen}. +after a call to @code{widen}. This can happen when a Lisp program is +called via low-level hooks, such as @code{jit-lock-functions}, +@code{post-command-hook}, etc. @defun buffer-narrowed-p This function returns non-@code{nil} if the buffer is narrowed, and diff --git a/src/editfns.c b/src/editfns.c index 35b2415e8b..07f5c0bbef 100644 --- a/src/editfns.c +++ b/src/editfns.c @@ -2663,7 +2663,8 @@ This allows the buffer's full text to be seen and edited. Note that, when the current buffer contains one or more lines whose length is above `long-line-threshold', Emacs may decide to leave, for performance reasons, the accessible portion of the buffer unchanged -after this function is called. */) +after this function is called from low-level hooks, such as +`jit-lock-functions' or `post-command-hook'. */) (void) { if (! NILP (Vrestrictions_locked)) @@ -2756,7 +2757,8 @@ remain visible. Note that, when the current buffer contains one or more lines whose length is above `long-line-threshold', Emacs may decide to leave, for performance reasons, the accessible portion of the buffer unchanged -after this function is called. */) +after this function is called from low-level hooks, such as +`jit-lock-functions' or `post-command-hook'. */) (Lisp_Object start, Lisp_Object end) { return narrow_to_region_internal (start, end, false); commit bf47851e0817abcf17eeb4a10d27cf18de2c68a2 Author: Robert Pluim Date: Tue Aug 2 14:22:32 2022 +0200 Signal error on duplicate key definitions * lisp/keymap.el (define-keymap, defvar-keymap): Signal error if the same key is specified twice. (Bug#56873) * doc/lispref/keymaps.texi (Creating Keymaps): Document error signaling behaviour. * test/src/keymap-tests.el (keymap-test-duplicate-definitions): Test duplicate definition detection. diff --git a/doc/lispref/keymaps.texi b/doc/lispref/keymaps.texi index 5cb5367bc0..2be31d63a6 100644 --- a/doc/lispref/keymaps.texi +++ b/doc/lispref/keymaps.texi @@ -374,7 +374,8 @@ number of keys. Here's a very basic example: @end lisp This function creates a new sparse keymap, defines the keystrokes in -@var{pairs}, and returns the new keymap. +@var{pairs}, and returns the new keymap. It signals an error if there +are duplicate key bindings in @var{pairs}. @var{pairs} is a list of alternating key bindings and key definitions, as accepted by @code{keymap-set}. In addition, the key can be the @@ -438,7 +439,8 @@ variable. This is what virtually all modes do---a mode called This macro defines @var{name} as a variable, passes @var{options} and @var{pairs} to @code{define-keymap}, and uses the result as the -default value for the variable. +default value for the variable. It signals an error if there are +duplicate key bindings in @var{pairs}. @var{options} is like the keywords in @code{define-keymap}, but there's an additional @code{:doc} keyword that provides the doc diff --git a/lisp/keymap.el b/lisp/keymap.el index 376a30f106..107565590c 100644 --- a/lisp/keymap.el +++ b/lisp/keymap.el @@ -530,7 +530,8 @@ should be a MENU form as accepted by `easy-menu-define'. (keymap keymap) (prefix (define-prefix-command prefix nil name)) (full (make-keymap name)) - (t (make-sparse-keymap name))))) + (t (make-sparse-keymap name)))) + seen-keys) (when suppress (suppress-keymap keymap (eq suppress 'nodigits))) (when parent @@ -544,6 +545,9 @@ should be a MENU form as accepted by `easy-menu-define'. (let ((def (pop definitions))) (if (eq key :menu) (easy-menu-define nil keymap "" def) + (if (member key seen-keys) + (error "Duplicate definition for key: %S %s" key keymap) + (push key seen-keys)) (keymap-set keymap key def))))) keymap))) @@ -571,6 +575,16 @@ as the variable documentation string. (push (pop defs) opts)))) (unless (zerop (% (length defs) 2)) (error "Uneven number of key/definition pairs: %s" defs)) + (let ((defs defs) + key seen-keys) + (while defs + (setq key (pop defs)) + (pop defs) + (when (not (eq key :menu)) + (if (member key seen-keys) + (error "Duplicate definition for key '%s' in keymap '%s'" + key variable-name) + (push key seen-keys))))) `(defvar ,variable-name (define-keymap ,@(nreverse opts) ,@defs) ,@(and doc (list doc))))) diff --git a/test/src/keymap-tests.el b/test/src/keymap-tests.el index b0876664ed..ce96be6869 100644 --- a/test/src/keymap-tests.el +++ b/test/src/keymap-tests.el @@ -430,6 +430,18 @@ g .. h foo (make-non-key-event 'keymap-tests-event) (should (equal (where-is-internal 'keymap-tests-command) '([3 103])))) +(ert-deftest keymap-test-duplicate-definitions () + "Check that defvar-keymap rejects duplicate key definitions." + (should-error + (defvar-keymap + ert-keymap-duplicate + "a" #'next-line + "a" #'previous-line)) + (should-error + (define-keymap + "a" #'next-line + "a" #'previous-line))) + (provide 'keymap-tests) ;;; keymap-tests.el ends here commit e5e840168c039f3daf9cce05e0b8ac4c49a450ec Author: Robert Pluim Date: Tue Aug 2 14:20:42 2022 +0200 Remove duplicate key definitions from keymaps * lisp/gnus/gnus-srvr.el (gnus-browse-mode-map): Remove binding for 'gnus-browse-prev-map'. * lisp/gnus/gnus-sum.el (gnus-summary-mode-map): Remove 'gnus-summary-down-thread' binding, and by symmetry 'gnus-summary-up-thread' (it's still available on "T-u"). * lisp/ibuffer.el (ibuffer-mode-map): Remove binding for 'ibuffer-mark-for-delete'. * lisp/wdired.el (wdired-perm-mode-map): Remove duplicate binding of "s" to 'wdired-set-bit'. * etc/NEWS: Announce 'gnus-summary-up-thread' change. diff --git a/etc/NEWS b/etc/NEWS index 475ceeb396..be0e65ee15 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1644,6 +1644,12 @@ Message, referred to as 'gnus-summary-tool-bar-retro', well as the icons used), and the "Gnome" tool bars are now the only pre-defined toolbars. +--- +*** 'gnus-summary-up-thread' and 'gnus-summary-down-thread' bindings removed. +The 'gnus-summary-down-thread' binding to "M-C-d" was shadowed by +'gnus-summary-read-document', and these commands are also available on +"T-u" and "T-d" respectively. + --- *** Gnus now uses a variable-pitch font in the headers by default. To get the monospace font back, you can put something like the diff --git a/lisp/gnus/gnus-srvr.el b/lisp/gnus/gnus-srvr.el index a520bfcd8b..54be0f8e6a 100644 --- a/lisp/gnus/gnus-srvr.el +++ b/lisp/gnus/gnus-srvr.el @@ -699,7 +699,6 @@ claim them." "n" #'gnus-browse-next-group "p" #'gnus-browse-prev-group "DEL" #'gnus-browse-prev-group - "" #'gnus-browse-prev-group "N" #'gnus-browse-next-group "P" #'gnus-browse-prev-group "M-n" #'gnus-browse-next-group diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el index bf2a083fec..90b57695c5 100644 --- a/lisp/gnus/gnus-sum.el +++ b/lisp/gnus/gnus-sum.el @@ -1958,8 +1958,6 @@ increase the score of each group you read." "C-M-b" #'gnus-summary-prev-thread "M-" #'gnus-summary-next-thread "M-" #'gnus-summary-prev-thread - "C-M-u" #'gnus-summary-up-thread - "C-M-d" #'gnus-summary-down-thread "&" #'gnus-summary-execute-command "c" #'gnus-summary-catchup-and-exit "C-w" #'gnus-summary-mark-region-as-read diff --git a/lisp/ibuffer.el b/lisp/ibuffer.el index 742d21d0b0..65430d7d11 100644 --- a/lisp/ibuffer.el +++ b/lisp/ibuffer.el @@ -447,7 +447,6 @@ directory, like `default-directory'." "d" #'ibuffer-mark-for-delete "C-d" #'ibuffer-mark-for-delete-backwards - "k" #'ibuffer-mark-for-delete "x" #'ibuffer-do-kill-on-deletion-marks ;; immediate operations diff --git a/lisp/wdired.el b/lisp/wdired.el index a5858ed190..106d57174d 100644 --- a/lisp/wdired.el +++ b/lisp/wdired.el @@ -902,7 +902,6 @@ Like original function but it skips read-only words." "x" #'wdired-set-bit "-" #'wdired-set-bit "S" #'wdired-set-bit - "s" #'wdired-set-bit "T" #'wdired-set-bit "t" #'wdired-set-bit "s" #'wdired-set-bit commit 74ff6acdd36bd005fd2b5585768122ef15d047ed Author: Stefan Kangas Date: Tue Aug 2 14:00:50 2022 +0200 url-about: Ignore missing directories in load-path * lisp/url/url-about.el (url-probe-protocols): Ignore missing directories in load-path. diff --git a/lisp/url/url-about.el b/lisp/url/url-about.el index 3943cae9e5..a50986d511 100644 --- a/lisp/url/url-about.el +++ b/lisp/url/url-about.el @@ -1,6 +1,6 @@ ;;; url-about.el --- Show internal URLs -*- lexical-binding: t; -*- -;; Copyright (C) 2001, 2004-2022 Free Software Foundation, Inc. +;; Copyright (C) 2001-2022 Free Software Foundation, Inc. ;; Keywords: comm, data, processes, hypermedia @@ -38,7 +38,7 @@ (if (string-match "url-\\(.*\\).el$" f) (push (match-string 1 f) schemes))) (directory-files d nil "\\`url-.*\\.el\\'"))) - load-path) + (seq-filter #'file-exists-p load-path)) (put 'url-extension-protocols 'schemes schemes) schemes))))) commit 6b14ef273a90d774116e90dedc31fe59d77ec520 Author: Lars Ingebrigtsen Date: Tue Aug 2 12:33:44 2022 +0200 Fix find-dired over tramp * lisp/find-dired.el (find-dired-with-command): Set the filter/sentinel immediately -- scheduling may make process output (and exit) happen before these are set otherwise (bug#56865). (find-dired-sort-by-filename): Don't bug out on error messages from find. diff --git a/lisp/find-dired.el b/lisp/find-dired.el index 63f2148e47..fba5126133 100644 --- a/lisp/find-dired.el +++ b/lisp/find-dired.el @@ -242,6 +242,11 @@ it finishes, type \\[kill-find]." (setq default-directory dir) ;; Start the find process. (shell-command (concat command "&") (current-buffer)) + (let ((proc (get-buffer-process (current-buffer)))) + ;; Initialize the process marker; it is used by the filter. + (move-marker (process-mark proc) (point) (current-buffer)) + (set-process-filter proc #'find-dired-filter) + (set-process-sentinel proc #'find-dired-sentinel)) (dired-mode dir (cdr find-ls-option)) (let ((map (make-sparse-keymap))) (set-keymap-parent map (current-local-map)) @@ -273,11 +278,6 @@ it finishes, type \\[kill-find]." (insert " " command "\n") (dired-insert-set-properties point (point))) (setq buffer-read-only t) - (let ((proc (get-buffer-process (current-buffer)))) - (set-process-filter proc #'find-dired-filter) - (set-process-sentinel proc #'find-dired-sentinel) - ;; Initialize the process marker; it is used by the filter. - (move-marker (process-mark proc) (point) (current-buffer))) (setq mode-line-process '(":%s")))) (defun find-dired--escaped-ls-option () @@ -419,10 +419,10 @@ specifies what to use in place of \"-ls\" as the final argument." "Sort entries in *Find* buffer by file name lexicographically." (sort-subr nil 'forward-line 'end-of-line (lambda () - (buffer-substring-no-properties - (next-single-property-change - (point) 'dired-filename) - (line-end-position))))) + (when-let ((start + (next-single-property-change + (point) 'dired-filename))) + (buffer-substring-no-properties start (line-end-position)))))) (provide 'find-dired) commit bd50df1efdb686ee22f4ec591839be3f3b21dd17 Author: Stefan Kangas Date: Tue Aug 2 11:55:16 2022 +0200 Delete function alias x-selection obsolete since 23.3 * lisp/select.el (x-selection): Delete function alias obsolete since 23.3. diff --git a/etc/NEWS b/etc/NEWS index 67183db278..475ceeb396 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2466,7 +2466,7 @@ but switching to `ash` is generally much preferable. 'find-emacs-lisp-shadows', 'newsticker-cache-filename', 'redisplay-end-trigger-functions', 'set-window-redisplay-end-trigger', 'unify-8859-on-decoding-mode', 'unify-8859-on-encoding-mode', -'vc-arch-command', 'window-redisplay-end-trigger'. +'vc-arch-command', 'window-redisplay-end-trigger', 'x-selection'. --- ** Some functions and variables obsolete since Emacs 21 or 22 have been removed: diff --git a/lisp/select.el b/lisp/select.el index 019be9cb23..e407c22436 100644 --- a/lisp/select.el +++ b/lisp/select.el @@ -85,9 +85,6 @@ other programs (X Windows clients or MS Windows programs). But, if this variable is set, it is used for the next communication only. After the communication, this variable is set to nil.") -;; Only declared obsolete in 23.3. -(define-obsolete-function-alias 'x-selection 'x-get-selection "at least 19.34") - (define-obsolete-variable-alias 'x-select-enable-clipboard 'select-enable-clipboard "25.1") (defcustom select-enable-clipboard t commit 146b3fb769bb3f1fcc339515e90c9970d3a8322f Author: Stefan Kangas Date: Tue Aug 2 11:39:56 2022 +0200 * lisp/mail/binhex.el: Improve commentary. diff --git a/lisp/mail/binhex.el b/lisp/mail/binhex.el index ad6ce19a95..93dd8697bd 100644 --- a/lisp/mail/binhex.el +++ b/lisp/mail/binhex.el @@ -23,9 +23,13 @@ ;;; Commentary: ;; BinHex is a binary-to-text encoding scheme similar to uuencode. +;; It was used on the classic Mac OS, last released in 2001. +;; ;; The command `binhex-decode-region' decodes BinHex-encoded text, via ;; the external program "hexbin" if that is available, or an Emacs ;; Lisp implementation if not. +;; +;; See also: https://en.wikipedia.org/wiki/BinHex ;;; Code: commit 50a192795ad64d2ea49274b402cb42530a5199ca Author: Matt Armstrong Date: Tue Aug 2 12:14:09 2022 +0200 Consider built-in packages to be installed * lisp/emacs-lisp/package.el (package-installed-p): Check for built-in packages before initialization. (bug#56877). diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index df70f908da..482de52f85 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -2085,7 +2085,10 @@ If PACKAGE is a `package-desc' object, MIN-VERSION is ignored." package-activated-list) ;; We used the quickstart: make it possible to use package-installed-p ;; even before package is fully initialized. - (memq package package-activated-list)) + (or + (memq package package-activated-list) + ;; Also check built-in packages. + (package-built-in-p package min-version))) (t (or (let ((pkg-descs (cdr (assq package (package--alist))))) diff --git a/test/lisp/emacs-lisp/package-tests.el b/test/lisp/emacs-lisp/package-tests.el index d7a55998c2..b903cd781b 100644 --- a/test/lisp/emacs-lisp/package-tests.el +++ b/test/lisp/emacs-lisp/package-tests.el @@ -638,6 +638,21 @@ but with a different end of line convention (bug#48137)." (package-refresh-contents) (should (equal (length package-archive-contents) 2))))) +(ert-deftest package-test-package-installed-p () + "Test package-installed-p before and after package initialization." + (with-package-test () + ;; Verify that `package-installed-p' evaluates true for a built-in + ;; package, in this case `project', before package initialization. + (should (not package--initialized)) + (should (package-installed-p 'project nil)) + (should (not (package-installed-p 'imaginary-package nil))) + + ;; The results don't change after package initialization. + (package-initialize) + (should package--initialized) + (should (package-installed-p 'project nil)) + (should (not (package-installed-p 'imaginary-package nil))))) + (ert-deftest package-test-describe-package () "Test displaying help for a package." commit 6fd1fb8a6837acde8e1c9ab26618ec0f36121c72 Author: Lars Ingebrigtsen Date: Tue Aug 2 11:56:55 2022 +0200 Don't disable eldoc when doing edebug * lisp/emacs-lisp/eldoc.el (eldoc-display-message-no-interference-p): Don't disable eldoc when edebugging (bug#56459). There should be no interference in that case, because edebug messaging is done after stepping, and eldoc messaging is done after other movements. diff --git a/lisp/emacs-lisp/eldoc.el b/lisp/emacs-lisp/eldoc.el index 8d7f182e0c..6fd89a690d 100644 --- a/lisp/emacs-lisp/eldoc.el +++ b/lisp/emacs-lisp/eldoc.el @@ -381,7 +381,6 @@ Also store it in `eldoc-last-message' and return that value." (defun eldoc-display-message-no-interference-p () "Return nil if displaying a message would cause interference." (not (or executing-kbd-macro - (bound-and-true-p edebug-active) ;; The following configuration shows "Matches..." in the ;; echo area when point is after a closing bracket, which ;; conflicts with eldoc. commit a306d9096ec8b6be1fefe58235a3c8933e9f6f2a Author: Lars Ingebrigtsen Date: Tue Aug 2 11:19:59 2022 +0200 Fix url-dired obsoletion warning * lisp/url/url-file.el (url-file): Don't use obsolete url-dired function. diff --git a/lisp/url/url-file.el b/lisp/url/url-file.el index 1d5a8f505f..a72b2e67a6 100644 --- a/lisp/url/url-file.el +++ b/lisp/url/url-file.el @@ -173,7 +173,7 @@ it up to them." (if (file-directory-p filename) ;; A directory is done the same whether we are local or remote - (url-find-file-dired filename) + (find-file filename) (with-current-buffer (setq buffer (generate-new-buffer " *url-file*")) (require 'mm-util) commit 101a5b574e55dcc5d6e03f1a1dc052b629fe0c8d Author: Stefan Kangas Date: Tue Aug 2 11:00:18 2022 +0200 ; * lisp/textmodes/texinfo.el: Remove stale comment. diff --git a/lisp/textmodes/texinfo.el b/lisp/textmodes/texinfo.el index 1ac59ddc5f..7a654f72ab 100644 --- a/lisp/textmodes/texinfo.el +++ b/lisp/textmodes/texinfo.el @@ -235,9 +235,6 @@ Subexpression 1 is what goes into the corresponding `@end' statement.") (define-key keymap "\C-c\C-t\C-r" #'texinfo-tex-region) (define-key keymap "\C-c\C-t\C-b" #'texinfo-tex-buffer)) -;; Mode documentation displays commands in reverse order -;; from how they are listed in the texinfo-mode-map. - (defvar texinfo-mode-map (let ((map (make-sparse-keymap))) commit 632b74efa3523683596a8efbc854824dc819bebf Author: Stefan Kangas Date: Mon Aug 1 11:35:55 2022 +0200 Make url-dired.el obsolete (part 2/2) * lisp/obsolete/url-dired.el: Add "Obsolete-since" header. (url-dired-minor-mode-map): Minor fix. * lisp/url/url-file.el (url-dired): Don't require. * etc/NEWS: Announce its obsoletion. diff --git a/etc/NEWS b/etc/NEWS index 7aff7921f9..67183db278 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -349,6 +349,9 @@ Use 'abbrev', 'skeleton' or 'tempo' instead. ** The rlogin.el library, and the 'rsh' command are now obsolete. Use something like 'M-x shell RET ssh RET' instead. +--- +** The url-dired.el library is now obsolete. + --- ** The fast-lock.el and lazy-lock.el library have been removed. They have been obsolete since Emacs 22.1. diff --git a/lisp/obsolete/url-dired.el b/lisp/obsolete/url-dired.el index e2c23a8b6d..40057fb174 100644 --- a/lisp/obsolete/url-dired.el +++ b/lisp/obsolete/url-dired.el @@ -3,6 +3,7 @@ ;; Copyright (C) 1996-1999, 2004-2022 Free Software Foundation, Inc. ;; Keywords: comm, files +;; Obsolete-since: 29.1 ;; This file is part of GNU Emacs. @@ -27,7 +28,7 @@ (defvar-keymap url-dired-minor-mode-map :doc "Keymap used when browsing directories." - "C-m" #'url-dired-find-file + "RET" #'url-dired-find-file "" #'url-dired-find-file-mouse) (defun url-dired-find-file () diff --git a/lisp/url/url-file.el b/lisp/url/url-file.el index 99e62d9b7a..1d5a8f505f 100644 --- a/lisp/url/url-file.el +++ b/lisp/url/url-file.el @@ -26,7 +26,6 @@ (require 'mailcap) (require 'url-vars) (require 'url-parse) -(require 'url-dired) (declare-function mm-disable-multibyte "mm-util" ()) (defvar url-allow-non-local-files nil commit 16c872409b953522b0e4221ed86dd67691125b71 Author: Stefan Kangas Date: Mon Aug 1 11:32:37 2022 +0200 Make url-dired.el obsolete (part 1/2) It doesn't have any real effect since 2007. Ref: https://lists.gnu.org/r/emacs-devel/2022-07/msg01156.html * lisp/url/url-dired.el: Move from here... * lisp/obsolete/url-dired.el: ...to here. diff --git a/lisp/url/url-dired.el b/lisp/obsolete/url-dired.el similarity index 100% rename from lisp/url/url-dired.el rename to lisp/obsolete/url-dired.el commit 5e010f0522fcfbb1f3340daef0dfc2a32fd05b2d Author: Stefan Kangas Date: Tue Aug 2 01:17:05 2022 +0200 Make gnus-url-unhex into alias for url-unhex * lisp/gnus/gnus-util.el (gnus-url-unhex): Make into obsolete function alias for url-unhex; they are identical. Update callers. diff --git a/lisp/gnus/gnus-util.el b/lisp/gnus/gnus-util.el index 9bf48b1f4c..2c10969ba0 100644 --- a/lisp/gnus/gnus-util.el +++ b/lisp/gnus/gnus-util.el @@ -1134,14 +1134,11 @@ sure of changing the value of `foo'." If you find some problem with the directory separator character, try \"[/\\\\]\" for some systems.") -(defun gnus-url-unhex (x) - (if (> x ?9) - (if (>= x ?a) - (+ 10 (- x ?a)) - (+ 10 (- x ?A))) - (- x ?0))) - -;; Fixme: Do it like QP. +(autoload 'url-unhex "url-util") +(define-obsolete-function-alias 'gnus-url-unhex #'url-unhex "29.1") + +;; FIXME: Make obsolete in favor of `url-unhex-string', which is +;; identical except for the call to `char-to-string'. (defun gnus-url-unhex-string (str &optional allow-newlines) "Remove %XX, embedded spaces, etc in a url. If optional second argument ALLOW-NEWLINES is non-nil, then allow the @@ -1151,9 +1148,9 @@ forbidden in URL encoding." (case-fold-search t)) (while (string-match "%[0-9a-f][0-9a-f]" str) (let* ((start (match-beginning 0)) - (ch1 (gnus-url-unhex (elt str (+ start 1)))) + (ch1 (url-unhex (elt str (+ start 1)))) (code (+ (* 16 ch1) - (gnus-url-unhex (elt str (+ start 2)))))) + (url-unhex (elt str (+ start 2)))))) (setq tmp (concat tmp (substring str 0 start) (cond commit 6c3bafbc2cf9853f3082fb643ee20c78a80bb69e Author: Stefan Kangas Date: Tue Aug 2 01:12:19 2022 +0200 Add tests for url-{hexify,unhex}-string * test/lisp/url/url-util-tests.el (url-unhex-string-tests) (url-hexify-string-tests): New tests. diff --git a/test/lisp/url/url-util-tests.el b/test/lisp/url/url-util-tests.el index 8c042c0135..cfc2d93c89 100644 --- a/test/lisp/url/url-util-tests.el +++ b/test/lisp/url/url-util-tests.el @@ -46,6 +46,26 @@ ("key2" "val2") ("key1" "val1"))))) +(ert-deftest url-unhex-string-tests () + (should (equal (url-unhex-string "foo%20bar") + "foo bar")) + (should (equal (decode-coding-string (url-unhex-string "Fran%C3%A7ois") 'utf-8) + "François")) + (should (equal (url-unhex-string "%20%21%23%24%25%26%27%28%29%2A") + " !#$%&'()*")) + (should (equal (url-unhex-string "%2B%2C%2F%3A%3B%3D%3F%40%5B%5D") + "+,/:;=?@[]"))) + +(ert-deftest url-hexify-string-tests () + (should (equal (url-hexify-string "foo bar") + "foo%20bar")) + (should (equal (url-hexify-string "François") + "Fran%C3%A7ois")) + (should (equal (url-hexify-string " !#$%&'()*") + "%20%21%23%24%25%26%27%28%29%2A")) + (should (equal (url-hexify-string "+,/:;=?@[]") + "%2B%2C%2F%3A%3B%3D%3F%40%5B%5D"))) + (ert-deftest url-domain-tests () (should (equal (url-domain (url-generic-parse-url "http://www.fsf.co.uk")) "fsf.co.uk")) commit c4807895363108cd6f4425f650a341cb5cefb90c Author: Stefan Kangas Date: Mon Aug 1 22:29:53 2022 +0200 Remove extraneous defvars from edmacro.el * lisp/edmacro.el (edmacro-fix-menu-commands): Remove extraneous defvars; they are already declared above. diff --git a/lisp/edmacro.el b/lisp/edmacro.el index bdc50c5885..efffab9b30 100644 --- a/lisp/edmacro.el +++ b/lisp/edmacro.el @@ -251,6 +251,7 @@ If VERBOSE is `1', put everything on one line. If VERBOSE is omitted or nil, use a compact 80-column format." (and macro (symbolp macro) (setq macro (symbol-function macro))) (edmacro-format-keys (or macro last-kbd-macro) verbose)) + ;;; Commands for *Edit Macro* buffer. @@ -446,6 +447,7 @@ doubt, use whitespace." (interactive) (error "This mode can be enabled only by `edit-kbd-macro'")) (put 'edmacro-mode 'mode-class 'special) + ;;; Formatting a keyboard macro as human-readable text. @@ -637,12 +639,8 @@ This function assumes that the events can be stored in a string." (defun edmacro-fix-menu-commands (macro &optional noerror) (if (vectorp macro) (let (result) - ;; Not preloaded in without-x builds. + ;; Not preloaded in a --without-x build. (require 'mwheel) - (defvar mouse-wheel-down-event) - (defvar mouse-wheel-left-event) - (defvar mouse-wheel-right-event) - (defvar mouse-wheel-up-event) ;; Make a list of the elements. (setq macro (append macro nil)) (dolist (ev macro) @@ -669,6 +667,7 @@ This function assumes that the events can be stored in a string." ;; Reverse them again and make them back into a vector. (vconcat (nreverse result))) macro)) + ;;; Parsing a human-readable keyboard macro. commit 0b233d3e5f9f39363511fb2e1859c3ea3b0e7170 Author: Po Lu Date: Tue Aug 2 15:15:03 2022 +0800 Further reduce monitor change event duplication * src/xterm.c (handle_one_xevent): Also don't store duplicate events for ConfigureNotify events bound for the root window. diff --git a/src/xterm.c b/src/xterm.c index 017e63d8b6..52d08e76a7 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -16499,8 +16499,6 @@ x_wait_for_cell_change (Lisp_Object cell, struct timespec timeout) } } -#if defined USE_GTK || defined HAVE_XRANDR - /* Find whether or not an undelivered MONITORS_CHANGED_EVENT is already on the event queue. DPYINFO is the display any such event must apply to. */ @@ -16524,8 +16522,6 @@ x_find_monitors_changed_event (struct x_display_info *dpyinfo) return false; } -#endif - #ifdef USE_GTK static void x_monitors_changed_cb (GdkScreen *gscr, gpointer user_data) @@ -18914,13 +18910,20 @@ handle_one_xevent (struct x_display_info *dpyinfo, if (configureEvent.xconfigure.width != dpyinfo->screen_width || configureEvent.xconfigure.height != dpyinfo->screen_height) { - inev.ie.kind = MONITORS_CHANGED_EVENT; - XSETTERMINAL (inev.ie.arg, dpyinfo->terminal); + /* Also avoid storing duplicate events here, since + Fx_display_monitor_attributes_list will return the + same information for both invocations of the + hook. */ + if (!x_find_monitors_changed_event (dpyinfo)) + { + inev.ie.kind = MONITORS_CHANGED_EVENT; + XSETTERMINAL (inev.ie.arg, dpyinfo->terminal); - /* Store this event now since inev.ie.type could be set to - MOVE_FRAME_EVENT later. */ - kbd_buffer_store_event (&inev.ie); - inev.ie.kind = NO_EVENT; + /* Store this event now since inev.ie.type could be set to + MOVE_FRAME_EVENT later. */ + kbd_buffer_store_event (&inev.ie); + inev.ie.kind = NO_EVENT; + } /* Also update the position of the drag-and-drop tooltip. */ commit 0381e90fe789bc14f9b597850dcbbc08d84d4084 Author: Gerd Möllmann Date: Tue Aug 2 09:12:47 2022 +0200 ; * etc/emacs_lldb.py: Don't print '->' in type summary diff --git a/etc/emacs_lldb.py b/etc/emacs_lldb.py index 64df137267..880a835341 100644 --- a/etc/emacs_lldb.py +++ b/etc/emacs_lldb.py @@ -202,7 +202,7 @@ def xdebug_print(debugger, command, result, internal_dict): ######################################################################## def type_summary_Lisp_Object(obj, internal_dict): - return "-> " + Lisp_Object(obj).summary() + return Lisp_Object(obj).summary() ########################################################################