commit a512940daa046cc529c679942431435175cd6903 (HEAD, refs/remotes/origin/master) Author: Lars Ingebrigtsen Date: Tue Feb 8 08:51:30 2022 +0100 Document pcase-lambda * doc/lispref/control.texi (Destructuring with pcase Patterns): Document pcase-lambda (bug#20268). diff --git a/doc/lispref/control.texi b/doc/lispref/control.texi index 634d46a785..2f1666ba77 100644 --- a/doc/lispref/control.texi +++ b/doc/lispref/control.texi @@ -1326,6 +1326,20 @@ Assign values to variables in a @code{setq} form, destructuring each @var{value} according to its respective @var{pattern}. @end defmac +@defmac pcase-lambda lambda-list &rest body +This is like @code{lambda}, but allows each argument to be a pattern. +For instance, here's a simple function that takes a cons cell as the +argument: + +@example +(setq fun + (pcase-lambda (`(,key . ,val)) + (vector key (* val 10)))) +(funcall fun '(foo . 2)) + @result{} [foo 20] +@end example +@end defmac + @node Iteration @section Iteration @cindex iteration commit d97e9d701d18c2033f07fd244497311cc4b4477c Author: Lars Ingebrigtsen Date: Tue Feb 8 08:24:30 2022 +0100 Fix some standard-output/help-buffer confusion in describe-function-1 * lisp/help-fns.el (describe-function-1): We're outputting to standard-output, so deconfuse slightly. diff --git a/lisp/help-fns.el b/lisp/help-fns.el index e6cc07b471..5da575aa8d 100644 --- a/lisp/help-fns.el +++ b/lisp/help-fns.el @@ -959,9 +959,9 @@ Returns a list of the form (REAL-FUNCTION DEF ALIASED REAL-DEF)." ;;;###autoload (defun describe-function-1 (function) - (let ((pt1 (with-current-buffer (help-buffer) (point)))) + (let ((pt1 (with-current-buffer standard-output (point)))) (help-fns-function-description-header function) - (with-current-buffer (help-buffer) + (with-current-buffer standard-output (let ((inhibit-read-only t)) (fill-region-as-paragraph (save-excursion commit d18764000f905523ec0c7703b7828463dc9b0a13 Author: Lars Ingebrigtsen Date: Tue Feb 8 08:15:08 2022 +0100 Fix describe-function-1 test failure from previous change * lisp/help-fns.el (describe-function-1): Fix test failure from previous patch. diff --git a/lisp/help-fns.el b/lisp/help-fns.el index a7f0c4437f..e6cc07b471 100644 --- a/lisp/help-fns.el +++ b/lisp/help-fns.el @@ -962,14 +962,15 @@ Returns a list of the form (REAL-FUNCTION DEF ALIASED REAL-DEF)." (let ((pt1 (with-current-buffer (help-buffer) (point)))) (help-fns-function-description-header function) (with-current-buffer (help-buffer) - (fill-region-as-paragraph - (save-excursion - (goto-char pt1) - (forward-line 0) - (point)) - (point) - nil t) - (ensure-empty-lines))) + (let ((inhibit-read-only t)) + (fill-region-as-paragraph + (save-excursion + (goto-char pt1) + (forward-line 0) + (point)) + (point) + nil t) + (ensure-empty-lines)))) (pcase-let* ((`(,real-function ,def ,_aliased ,real-def) (help-fns--analyze-function function)) diff --git a/test/lisp/help-fns-tests.el b/test/lisp/help-fns-tests.el index 4df8e3c9ef..e3fed60b4c 100644 --- a/test/lisp/help-fns-tests.el +++ b/test/lisp/help-fns-tests.el @@ -25,6 +25,7 @@ (require 'ert) (require 'help-fns) +(require 'subr-x) (autoload 'help-fns-test--macro "foo" nil nil t) commit 95a021fe5f009bb0198b6c1266d674b12092449b Author: Lars Ingebrigtsen Date: Tue Feb 8 08:02:52 2022 +0100 Minor fix to how describe-function-1 displays symbols with spaces * lisp/help-fns.el (describe-function-1): Ensure that symbols like `bar\ ' aren't rendered incorrectly (bug#23130). diff --git a/lisp/help-fns.el b/lisp/help-fns.el index 36c7966919..a7f0c4437f 100644 --- a/lisp/help-fns.el +++ b/lisp/help-fns.el @@ -962,9 +962,14 @@ Returns a list of the form (REAL-FUNCTION DEF ALIASED REAL-DEF)." (let ((pt1 (with-current-buffer (help-buffer) (point)))) (help-fns-function-description-header function) (with-current-buffer (help-buffer) - (fill-region-as-paragraph (save-excursion (goto-char pt1) (forward-line 0) (point)) - (point)))) - (terpri)(terpri) + (fill-region-as-paragraph + (save-excursion + (goto-char pt1) + (forward-line 0) + (point)) + (point) + nil t) + (ensure-empty-lines))) (pcase-let* ((`(,real-function ,def ,_aliased ,real-def) (help-fns--analyze-function function)) commit b13e311f0babd7ab30d555ad542249b1a2ad9e2e Author: martin rudalics Date: Tue Feb 8 07:38:25 2022 +0100 Improve handling of frame-inherited-parameters * lisp/frame.el (make-frame): Improve handling of frame-inherited-parameters (bug#24651). diff --git a/lisp/frame.el b/lisp/frame.el index 6bf4c6178b..e9c88adc7c 100644 --- a/lisp/frame.el +++ b/lisp/frame.el @@ -883,7 +883,6 @@ the new frame according to its own rules." (error "Don't know how to interpret display %S" display))) (t window-system))) - (oldframe (selected-frame)) (params parameters) frame child-frame) @@ -901,8 +900,12 @@ the new frame according to its own rules." (dolist (p default-frame-alist) (unless (assq (car p) params) (push p params))) - -;; (setq frame-size-history '(1000)) + ;; Add parameters from `frame-inherited-parameters' unless they are + ;; overridden by explicit parameters. + (dolist (param frame-inherited-parameters) + (unless (assq param parameters) + (let ((val (frame-parameter nil param))) + (when val (push (cons param val) params))))) (when (eq (cdr (or (assq 'minibuffer params) '(minibuffer . t))) 'child-frame) @@ -935,12 +938,6 @@ the new frame according to its own rules." frame 'minibuffer (frame-root-window child-frame)))) (normal-erase-is-backspace-setup-frame frame) - ;; Inherit original frame's parameters unless they are overridden - ;; by explicit parameters. - (dolist (param frame-inherited-parameters) - (unless (assq param parameters) - (let ((val (frame-parameter oldframe param))) - (when val (set-frame-parameter frame param val))))) ;; We can run `window-configuration-change-hook' for this frame now. (frame-after-make-frame frame t) commit a4d40a32ccea3ce95300797c8d5032fef5d1f82c Author: Lars Ingebrigtsen Date: Tue Feb 8 07:33:24 2022 +0100 Make exit from text-scale-adjust less confusing * lisp/face-remap.el (text-scale-adjust): Clear the prompt after exiting (bug#25978). diff --git a/lisp/face-remap.el b/lisp/face-remap.el index 3675ea14b4..34cd030652 100644 --- a/lisp/face-remap.el +++ b/lisp/face-remap.el @@ -395,7 +395,11 @@ a top-level keymap, `text-scale-increase' or (dolist (key '(?- ?+ ?= ?0)) ;; = is often unshifted +. (define-key map (vector (append mods (list key))) (lambda () (interactive) (text-scale-adjust (abs inc)))))) - map))))) ;; ) + map) + nil + ;; Clear the prompt after exiting. + (lambda () + (message "")))))) (defvar-local text-scale--pinch-start-scale 0 "The text scale at the start of a pinch sequence.") commit 9d1ae05442a710dd23053ef42a9c3c0f65813110 Author: Po Lu Date: Tue Feb 8 14:17:23 2022 +0800 Clear mouse highlight when mouse moves outside edit widget * src/xterm.c (handle_one_xevent): Clear mouse highlight when leaving the edit widget. Otherwise, it stays around on the toolbar after the mouse is moved onto the menu bar. diff --git a/src/xterm.c b/src/xterm.c index b49441ddb7..8bdb3c9ea1 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -10068,8 +10068,17 @@ handle_one_xevent (struct x_display_info *dpyinfo, if (x_top_window_to_frame (dpyinfo, event->xcrossing.window)) x_detect_focus_change (dpyinfo, any, event, &inev.ie); +#if defined USE_X_TOOLKIT + /* If the mouse leaves the edit widget, then any mouse highlight + should be cleared. */ + f = x_window_to_frame (dpyinfo, event->xcrossing.window); + + if (!f) + f = x_top_window_to_frame (dpyinfo, event->xcrossing.window); +#else f = x_top_window_to_frame (dpyinfo, event->xcrossing.window); -#if defined HAVE_X_TOOLKIT && defined HAVE_XINPUT2 +#endif +#if defined USE_X_TOOLKIT && defined HAVE_XINPUT2 /* The XI2 event mask is set on the frame widget, so this event likely originates from the shell widget, which we aren't interested in. */ @@ -10783,15 +10792,15 @@ handle_one_xevent (struct x_display_info *dpyinfo, if (any) x_detect_focus_change (dpyinfo, any, event, &inev.ie); - if (!any) - any = x_any_window_to_frame (dpyinfo, leave->event); - #ifndef USE_X_TOOLKIT f = x_top_window_to_frame (dpyinfo, leave->event); #else /* On Xt builds that have XI2, the enter and leave event masks are set on the frame widget's window. */ f = x_window_to_frame (dpyinfo, leave->event); + + if (!f) + f = x_top_window_to_frame (dpyinfo, leave->event); #endif if (f) { commit 58172cc28af1425c359f1c2a322b4062765aebae Author: Andrew G Cohen Date: Tue Feb 8 14:05:02 2022 +0800 nnselect.el: Speed up group info updating * lisp/gnus/nnselect.el (nnselect-request-update-info): Use a hash and other tricks to speed things up. (nnselect-request-group-scan): Make sure the artlist is uncompressed. diff --git a/lisp/gnus/nnselect.el b/lisp/gnus/nnselect.el index 85df0284ef..f8a0c33d4e 100644 --- a/lisp/gnus/nnselect.el +++ b/lisp/gnus/nnselect.el @@ -531,68 +531,65 @@ If this variable is nil, or if the provided function returns nil, (deffoo nnselect-request-update-info (group info &optional _server) (let* ((group (nnselect-add-prefix group)) - (gnus-newsgroup-selection - (or gnus-newsgroup-selection (nnselect-get-artlist group))) - newmarks) + (gnus-newsgroup-selection + (or gnus-newsgroup-selection (nnselect-get-artlist group))) + newmarks) (gnus-info-set-marks info nil) (setf (gnus-info-read info) nil) (pcase-dolist (`(,artgroup . ,nartids) - (ids-by-group - (number-sequence 1 (nnselect-artlist-length - gnus-newsgroup-selection)))) + (ids-by-group + (number-sequence 1 (nnselect-artlist-length + gnus-newsgroup-selection)))) (let* ((gnus-newsgroup-active nil) - (artids (cl-sort nartids #'< :key 'car)) - (group-info (gnus-get-info artgroup)) - (marks (gnus-info-marks group-info)) - (unread (gnus-uncompress-sequence - (range-difference (gnus-active artgroup) - (gnus-info-read group-info))))) + (idmap (make-hash-table :test 'eql)) + (gactive (sort (mapcar 'cdr nartids) '<)) + (group-info (gnus-get-info artgroup)) + (marks (gnus-info-marks group-info))) + (pcase-dolist (`(,val . ,key) nartids) + (puthash key val idmap)) (setf (gnus-info-read info) - (range-add-list - (gnus-info-read info) - (delq nil (mapcar - (lambda (art) - (unless (memq (cdr art) unread) (car art))) - artids)))) - (pcase-dolist (`(,type . ,mark-list) marks) - (let ((mark-type (gnus-article-mark-to-type type)) new) - (when - (setq new - (delq nil - (cond - ((eq mark-type 'tuple) - (mapcar - (lambda (id) - (let (mark) - (when - (setq mark (assq (cdr id) mark-list)) - (cons (car id) (cdr mark))))) - artids)) - (t - (setq mark-list - (range-uncompress mark-list)) - (mapcar - (lambda (id) - (when (memq (cdr id) mark-list) - (car id))) artids))))) - (let ((previous (alist-get type newmarks))) - (if previous - (nconc previous new) - (push (cons type new) newmarks)))))))) + (range-add-list + (gnus-info-read info) + (sort (mapcar (lambda (art) (gethash art idmap)) + (gnus-sorted-intersection + gactive + (range-uncompress (gnus-info-read group-info)))) + '<))) + (pcase-dolist (`(,type . ,mark-list) marks) + (let ((mark-type (gnus-article-mark-to-type type)) new) + (when + (setq new + (if (not mark-list) nil + (cond + ((eq mark-type 'tuple) + (delq nil + (mapcar + (lambda (mark) + (let ((id (gethash (car mark) idmap))) + (when id (cons id (cdr mark))))) + mark-list))) + (t + (mapcar (lambda (art) (gethash art idmap)) + (gnus-sorted-intersection + gactive (range-uncompress mark-list))))))) + (let ((previous (alist-get type newmarks))) + (if previous + (nconc previous new) + (push (cons type new) newmarks)))))))) ;; Clean up the marks: compress lists; (pcase-dolist (`(,type . ,mark-list) newmarks) (let ((mark-type (gnus-article-mark-to-type type))) - (unless (eq mark-type 'tuple) - (setf (alist-get type newmarks) - (gnus-compress-sequence mark-list))))) + (unless (eq mark-type 'tuple) + (setf (alist-get type newmarks) + (gnus-compress-sequence (sort mark-list '<)))))) ;; and ensure an unexist key. (unless (assq 'unexist newmarks) (push (cons 'unexist nil) newmarks)) (gnus-info-set-marks info newmarks) (gnus-set-active group (cons 1 (nnselect-artlist-length - gnus-newsgroup-selection))))) + gnus-newsgroup-selection))))) (deffoo nnselect-request-thread (header &optional group server) @@ -753,8 +750,8 @@ If this variable is nil, or if the provided function returns nil, (deffoo nnselect-request-group-scan (group &optional _server _info) (let* ((group (nnselect-add-prefix group)) - (artlist (nnselect-run - (gnus-group-get-parameter group 'nnselect-specs t)))) + (artlist (nnselect-uncompress-artlist (nnselect-run + (gnus-group-get-parameter group 'nnselect-specs t))))) (gnus-set-active group (cons 1 (nnselect-artlist-length artlist))) (gnus-group-set-parameter @@ -866,9 +863,6 @@ article came from is also searched." ;; When the backend can store marks we collect any ;; changes. Unlike a normal group the mark lists only ;; include marks for articles we retrieved. - (when (and (gnus-check-backend-function - 'request-set-mark artgroup) - (not (gnus-article-unpropagatable-p type))) (let* ((old (range-list-intersection artlist (alist-get type (gnus-info-marks group-info)))) @@ -880,7 +874,7 @@ article came from is also searched." ;; This shouldn't happen, but is a sanity check. (setq del (range-intersection (gnus-active artgroup) del)) - (push (list del 'del (list type)) delta-marks)))) + (push (list del 'del (list type)) delta-marks))) ;; Marked sets are of mark-type 'tuple, 'list, or ;; 'range. We merge the lists with what is already in commit 1e9eeed913a615e04a390702e3346418131ceeeb Merge: 7a1a56da0a 0d46ee2dde Author: Stefan Kangas Date: Tue Feb 8 06:30:53 2022 +0100 ; Merge from origin/emacs-28 The following commit was skipped: 0d46ee2dde Don't remove dummy.group from gnus-newsrc-alist on Gnus save commit 7a1a56da0aec15ef9202213f8a988783a7a59dab Author: Po Lu Date: Tue Feb 8 05:14:16 2022 +0000 Try harder to preserve cursor when mapping tooltip frames on Haiku * src/haikufns.c (haiku_set_cursor_color): Fix argument to `error'. (Fx_show_tip): Define cursors on both views. diff --git a/src/haikufns.c b/src/haikufns.c index 8aad2cbd7f..91e0d392ac 100644 --- a/src/haikufns.c +++ b/src/haikufns.c @@ -1408,7 +1408,7 @@ haiku_set_cursor_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval) { if (haiku_get_color (SSDATA (Vx_cursor_fore_pixel), &fore_pixel)) - error ("Bad color %s", Vx_cursor_fore_pixel); + error ("Bad color %s", SSDATA (Vx_cursor_fore_pixel)); FRAME_OUTPUT_DATA (f)->cursor_fg = fore_pixel.pixel; } else @@ -1932,7 +1932,7 @@ DEFUN ("x-show-tip", Fx_show_tip, Sx_show_tip, 1, 6, 0, (Lisp_Object string, Lisp_Object frame, Lisp_Object parms, Lisp_Object timeout, Lisp_Object dx, Lisp_Object dy) { - struct frame *tip_f; + struct frame *f, *tip_f; struct window *w; int root_x, root_y; struct buffer *old_buffer; @@ -1952,7 +1952,7 @@ DEFUN ("x-show-tip", Fx_show_tip, Sx_show_tip, 1, 6, 0, if (NILP (frame)) frame = selected_frame; - decode_window_system_frame (frame); + f = decode_window_system_frame (frame); if (NILP (timeout)) timeout = make_fixnum (5); @@ -2185,12 +2185,20 @@ DEFUN ("x-show-tip", Fx_show_tip, Sx_show_tip, 1, 6, 0, void *wnd = FRAME_HAIKU_WINDOW (tip_f); BWindow_resize (wnd, width, height); BView_resize_to (FRAME_HAIKU_VIEW (tip_f), width, height); + BView_set_view_cursor (FRAME_HAIKU_VIEW (tip_f), + FRAME_OUTPUT_DATA (f)->current_cursor); BWindow_set_offset (wnd, root_x, root_y); BWindow_set_visible (wnd, true); SET_FRAME_VISIBLE (tip_f, true); FRAME_PIXEL_WIDTH (tip_f) = width; FRAME_PIXEL_HEIGHT (tip_f) = height; BWindow_sync (wnd); + + /* This is needed because the app server resets the cursor whenever + a new window is mapped, so we won't see the cursor set on the + tooltip if the mouse pointer isn't actually over it. */ + BView_set_view_cursor (FRAME_HAIKU_VIEW (f), + FRAME_OUTPUT_DATA (f)->current_cursor); unblock_input (); w->must_be_updated_p = true; commit 65f07859172940b1f7c89e4a81c8bc1a28646f96 Author: Po Lu Date: Tue Feb 8 10:37:24 2022 +0800 Fix menu bar not opening after popup menu is dismissed on Lucid * lwlib/xlwmenu.c (XlwMenuDestroy): Only set submenu_destroyed if menu bar widget. diff --git a/lwlib/xlwmenu.c b/lwlib/xlwmenu.c index cf6a8b1387..ace5141cdb 100644 --- a/lwlib/xlwmenu.c +++ b/lwlib/xlwmenu.c @@ -2105,7 +2105,8 @@ XlwMenuDestroy (Widget w) ungrab_all ((Widget)w, CurrentTime); pointer_grabbed = 0; - submenu_destroyed = 1; + if (!XtIsShell (XtParent (w))) + submenu_destroyed = 1; release_drawing_gcs (mw); release_shadow_gcs (mw); commit 4592fb4046461ada4ad011adcd477196cc95d6b4 Author: Po Lu Date: Tue Feb 8 09:38:33 2022 +0800 * src/pgtkfns.c (Fx_create_frame): Realize frame widgets. (bug#53861) diff --git a/src/pgtkfns.c b/src/pgtkfns.c index 534f1dc2a9..1535ab9f73 100644 --- a/src/pgtkfns.c +++ b/src/pgtkfns.c @@ -1586,6 +1586,14 @@ This function is an internal primitive--use `make-frame' instead. */ ) xg_create_frame_widgets (f); pgtk_set_event_handler (f); + if (FRAME_GTK_OUTER_WIDGET (f)) + gtk_widget_realize (FRAME_GTK_OUTER_WIDGET (f)); + + /* Many callers (including the Lisp functions that call + FRAME_SCALE_FACTOR) expect the widget to be realized. */ + if (FRAME_GTK_WIDGET (f)) + gtk_widget_realize (FRAME_GTK_WIDGET (f)); + #define INSTALL_CURSOR(FIELD, NAME) \ FRAME_X_OUTPUT (f)->FIELD = gdk_cursor_new_for_display (FRAME_X_DISPLAY (f), GDK_ ## NAME) commit cdf7e2e02130d980c9e70f4d5a019b52d7914de6 Author: Po Lu Date: Tue Feb 8 09:25:24 2022 +0800 Don't allow tooltips to be transient for override redirect windows * src/xfns.c (Fx_show_tip): Delete WM_TRANSIENT_FOR if the child window is override-redirect. * src/xterm.c (x_term_init): Intern new atom. * src/xterm.h (struct x_display_info): New atom `Xatom_wm_transient_for'. diff --git a/src/xfns.c b/src/xfns.c index 7878ee62f5..2fd9ad6b05 100644 --- a/src/xfns.c +++ b/src/xfns.c @@ -7788,6 +7788,7 @@ Text larger than the specified size is clipped. */) ptrdiff_t count_1; Lisp_Object window, size, tip_buf; Window child; + XWindowAttributes child_attrs; int dest_x_return, dest_y_return; AUTO_STRING (tip, " *tip*"); @@ -8028,11 +8029,24 @@ Text larger than the specified size is clipped. */) FRAME_DISPLAY_INFO (f)->root_window, root_x, root_y, &dest_x_return, &dest_y_return, &child)) - XSetTransientForHint (FRAME_X_DISPLAY (tip_f), - FRAME_X_WINDOW (tip_f), child); + { + /* But only if the child is not override-redirect, which can + happen if the pointer is above a menu. */ + + if (XGetWindowAttributes (FRAME_X_DISPLAY (f), + child, &child_attrs) + || child_attrs.override_redirect) + XDeleteProperty (FRAME_X_DISPLAY (tip_f), + FRAME_X_WINDOW (tip_f), + FRAME_DISPLAY_INFO (tip_f)->Xatom_wm_transient_for); + else + XSetTransientForHint (FRAME_X_DISPLAY (tip_f), + FRAME_X_WINDOW (tip_f), child); + } else - XSetTransientForHint (FRAME_X_DISPLAY (tip_f), - FRAME_X_WINDOW (tip_f), None); + XDeleteProperty (FRAME_X_DISPLAY (tip_f), + FRAME_X_WINDOW (tip_f), + FRAME_DISPLAY_INFO (tip_f)->Xatom_wm_transient_for); #ifndef USE_XCB XMoveResizeWindow (FRAME_X_DISPLAY (tip_f), FRAME_X_WINDOW (tip_f), diff --git a/src/xterm.c b/src/xterm.c index 38f181e5df..b49441ddb7 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -15984,6 +15984,7 @@ x_term_init (Lisp_Object display_name, char *xrm_option, char *resource_name) ATOM_REFS_INIT ("WM_CONFIGURE_DENIED", Xatom_wm_configure_denied) ATOM_REFS_INIT ("WM_MOVED", Xatom_wm_window_moved) ATOM_REFS_INIT ("WM_CLIENT_LEADER", Xatom_wm_client_leader) + ATOM_REFS_INIT ("WM_TRANSIENT_FOR", Xatom_wm_transient_for) ATOM_REFS_INIT ("Editres", Xatom_editres) ATOM_REFS_INIT ("CLIPBOARD", Xatom_CLIPBOARD) ATOM_REFS_INIT ("TIMESTAMP", Xatom_TIMESTAMP) diff --git a/src/xterm.h b/src/xterm.h index 63956fd643..854d87c83c 100644 --- a/src/xterm.h +++ b/src/xterm.h @@ -364,6 +364,8 @@ struct x_display_info Atom Xatom_wm_configure_denied; /* When our config request is denied */ Atom Xatom_wm_window_moved; /* When the WM moves us. */ Atom Xatom_wm_client_leader; /* Id of client leader window. */ + Atom Xatom_wm_transient_for; /* Id of whatever window we are + transient for. */ /* EditRes protocol */ Atom Xatom_editres; commit 1f45d273884a648f47abea919a5246452f542aa9 Author: Po Lu Date: Tue Feb 8 08:46:31 2022 +0800 Make sure `update_wm_hints' finds the WMShell * src/widget.c (update_wm_hints): Accept frame separately from the shell widget. (widget_update_wm_size_hints): Require WM shell to be explictly specified. (EmacsFrameRealize): (EmacsFrameResize): Update callers to `update_wm_hints'. * src/widget.h: Update prototypes. * src/xterm.c (x_wm_set_size_hint): Pass frame widget (ApplicationShell) and the edit widget (EmacsFrame) to `widget_update_wm_size_hints'. (bug#53839) diff --git a/src/widget.c b/src/widget.c index c13ec50498..4231aa71b5 100644 --- a/src/widget.c +++ b/src/widget.c @@ -260,9 +260,8 @@ set_frame_size (EmacsFrame ew) } static void -update_wm_hints (EmacsFrame ew) +update_wm_hints (Widget wmshell, EmacsFrame ew) { - Widget wmshell = get_wm_shell ((Widget) ew); int cw; int ch; Dimension rounded_width; @@ -272,9 +271,6 @@ update_wm_hints (EmacsFrame ew) int base_width; int base_height; - /* This happens when the frame is just created. */ - if (! wmshell) return; - pixel_to_char_size (ew, ew->core.width, ew->core.height, &char_width, &char_height); char_to_pixel_size (ew, char_width, char_height, @@ -302,10 +298,9 @@ update_wm_hints (EmacsFrame ew) } void -widget_update_wm_size_hints (Widget widget) +widget_update_wm_size_hints (Widget widget, Widget frame) { - EmacsFrame ew = (EmacsFrame) widget; - update_wm_hints (ew); + update_wm_hints (widget, (EmacsFrame) frame); } static void @@ -386,7 +381,8 @@ EmacsFrameRealize (Widget widget, XtValueMask *mask, XSetWindowAttributes *attrs frame_size_history_plain (f, build_string ("EmacsFrameRealize")); - update_wm_hints (ew); + if (get_wm_shell (widget)) + update_wm_hints (get_wm_shell (widget), ew); } static void @@ -410,7 +406,8 @@ EmacsFrameResize (Widget widget) change_frame_size (f, ew->core.width, ew->core.height, false, true, false); - update_wm_hints (ew); + if (get_wm_shell (widget)) + update_wm_hints (get_wm_shell (widget), ew); update_various_frame_slots (ew); cancel_mouse_face (f); diff --git a/src/widget.h b/src/widget.h index dbf21a64cb..2906d5ff9e 100644 --- a/src/widget.h +++ b/src/widget.h @@ -97,6 +97,6 @@ extern struct _DisplayContext *display_context; /* Special entry points */ void EmacsFrameSetCharSize (Widget, int, int); void widget_store_internal_border (Widget widget); -void widget_update_wm_size_hints (Widget widget); +void widget_update_wm_size_hints (Widget widget, Widget frame); #endif /* _EmacsFrame_h */ diff --git a/src/xterm.c b/src/xterm.c index 940ee347d5..38f181e5df 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -14959,7 +14959,8 @@ x_wm_set_size_hint (struct frame *f, long flags, bool user_position) #ifdef USE_X_TOOLKIT if (f->output_data.x->widget) { - widget_update_wm_size_hints (f->output_data.x->widget); + widget_update_wm_size_hints (f->output_data.x->widget, + f->output_data.x->edit_widget); return; } #endif commit 77cbde6d09bbca0070bfc7765fb07b8a69f7c6f2 Author: Stefan Monnier Date: Mon Feb 7 16:51:18 2022 -0500 minibuffer.el: Try and fix bug#53053 * lisp/minibuffer.el (completion--sifn-requote): Special case for when `upos` is at the very end. diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index c9f5823940..36b8d80841 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -2932,26 +2932,30 @@ same as `substitute-in-file-name'." (let* ((ustr (substitute-in-file-name qstr)) (uprefix (substring ustr 0 upos)) qprefix) - ;; Main assumption: nothing after qpos should affect the text before upos, - ;; so we can work our way backward from the end of qstr, one character - ;; at a time. - ;; Second assumptions: If qpos is far from the end this can be a bit slow, - ;; so we speed it up by doing a first loop that skips a word at a time. - ;; This word-sized loop is careful not to cut in the middle of env-vars. - (while (let ((boundary (string-match "\\(\\$+{?\\)?\\w+\\W*\\'" qstr))) - (and boundary - (progn - (setq qprefix (substring qstr 0 boundary)) + (if (eq upos (length ustr)) + ;; Easy and common case. This not only speed things up in a very + ;; common case but it also avoids problems in some cases (bug#53053). + (cons (length qstr) #'minibuffer-maybe-quote-filename) + ;; Main assumption: nothing after qpos should affect the text before upos, + ;; so we can work our way backward from the end of qstr, one character + ;; at a time. + ;; Second assumptions: If qpos is far from the end this can be a bit slow, + ;; so we speed it up by doing a first loop that skips a word at a time. + ;; This word-sized loop is careful not to cut in the middle of env-vars. + (while (let ((boundary (string-match "\\(\\$+{?\\)?\\w+\\W*\\'" qstr))) + (and boundary + (progn + (setq qprefix (substring qstr 0 boundary)) + (string-prefix-p uprefix + (substitute-in-file-name qprefix))))) + (setq qstr qprefix)) + (let ((qpos (length qstr))) + (while (and (> qpos 0) (string-prefix-p uprefix - (substitute-in-file-name qprefix))))) - (setq qstr qprefix)) - (let ((qpos (length qstr))) - (while (and (> qpos 0) - (string-prefix-p uprefix - (substitute-in-file-name - (substring qstr 0 (1- qpos))))) - (setq qpos (1- qpos))) - (cons qpos #'minibuffer-maybe-quote-filename)))) + (substitute-in-file-name + (substring qstr 0 (1- qpos))))) + (setq qpos (1- qpos))) + (cons qpos #'minibuffer-maybe-quote-filename))))) (defalias 'completion--file-name-table (completion-table-with-quoting #'completion-file-name-table commit 919cbe2b7da2302a66a15a4611eef8a215bd5755 Author: Tassilo Horn Date: Mon Feb 7 21:03:53 2022 +0100 ; paren.el: fix comment speaking of an undefined variable diff --git a/lisp/paren.el b/lisp/paren.el index 6de4364b4f..221cad3f05 100644 --- a/lisp/paren.el +++ b/lisp/paren.el @@ -428,9 +428,9 @@ It is the default value of `show-paren-data-function'." (current-buffer)) (move-overlay show-paren--overlay there-beg there-end (current-buffer))) - ;; If `show-paren-open-line-when-offscreen' is t and point - ;; is at a close paren, show the line that contains the - ;; openparen in the echo area. + ;; If `show-paren-context-when-offscreen' is non-nil and + ;; point is at a closing paren, show the context around the + ;; opening paren. (let ((openparen (min here-beg there-beg))) (if (and show-paren-context-when-offscreen (< there-beg here-beg) commit 7a9b5e75045e38680ce0bbb0ec46ff1d7b1c0d5c Author: Stefan Monnier Date: Mon Feb 7 13:37:09 2022 -0500 * lisp/progmodes/xref.el (xref--marker-ring): Fix typo diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el index 4efa652084..6677b4f004 100644 --- a/lisp/progmodes/xref.el +++ b/lisp/progmodes/xref.el @@ -426,7 +426,7 @@ or earlier: it can break `dired-do-find-regexp-and-replace'." :version "28.1" :package-version '(xref . "1.2.0")) -(make-obsolete-variable 'xref-marker-ring nil "29.1") +(make-obsolete-variable 'xref--marker-ring 'xref--history "29.1") (defun xref-set-marker-ring-length (_var _val) (declare (obsolete nil "29.1")) commit 992908b09a4f95817bbd548fd577d7573ad9cd2d Author: Michael Albinus Date: Mon Feb 7 19:32:38 2022 +0100 Make connection-local variables user options * lisp/files-x.el (connection-local-profile-alist) (connection-local-criteria-alist): Make them user options. * doc/lispref/variables.texi (Connection Local Variables): * etc/NEWS: Document this. diff --git a/doc/lispref/variables.texi b/doc/lispref/variables.texi index 34c73e70b7..b9de92a29e 100644 --- a/doc/lispref/variables.texi +++ b/doc/lispref/variables.texi @@ -2263,11 +2263,11 @@ list in @var{variables} is an alist of the form @end example @end defun -@defvar connection-local-profile-alist +@deffn {User Option} connection-local-profile-alist This alist holds the connection profile symbols and the associated variable settings. It is updated by @code{connection-local-set-profile-variables}. -@end defvar +@end deffn @defun connection-local-set-profiles criteria &rest profiles This function assigns @var{profiles}, which are symbols, to all remote @@ -2321,11 +2321,11 @@ Therefore, the example above would be equivalent to defined by @code{connection-local-set-profile-variables}. @end defun -@defvar connection-local-criteria-alist +@deffn {User Option} connection-local-criteria-alist This alist contains connection criteria and their assigned profile names. The function @code{connection-local-set-profiles} updates this list. -@end defvar +@end deffn @defun hack-connection-local-variables criteria This function collects applicable connection-local variables diff --git a/etc/NEWS b/etc/NEWS index cd5bd8b71c..a8a270d57d 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -80,7 +80,7 @@ as was already the case for all the non-preloaded files. * Startup Changes in Emacs 29.1 +++ -** Emacs now support setting 'user-emacs-directory' via --init-directory. +** Emacs now supports setting 'user-emacs-directory' via '--init-directory'. +++ ** Emacs now has a '--fingerprint' option. @@ -130,14 +130,15 @@ delete the entire sequence, not just a single character at its beginning. ** 'load-history' does not treat autoloads specially any more. -An autoload definition appears just as a (defun . NAME) and the -(t . NAME) entries are not generated any more. +An autoload definition appears just as a '(defun . NAME)' and the +'(t . NAME)' entries are not generated any more. + * Changes in Emacs 29.1 --- ** New user option 'find-library-include-other-files'. -If set to nil, commands like 'M-x find-library' will only include library +If set to nil, commands like 'find-library' will only include library files in the completion candidates. The default is t, which preserves previous behavior, whereby non-library files could also be included. @@ -188,7 +189,7 @@ methods. 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 responive to input, you can turn it off by setting the X +is still responsive to input, you can turn it off by setting the X resource "synchronizeResize" to "off". +++ @@ -210,6 +211,12 @@ defaults to t, which makes Emacs use the toolkit tooltips. The existing GTK-specific option 'x-gtk-use-system-tooltips' is now an alias of this new option. ++++ +** Some connection-local variables are now user options. +The variables 'connection-local-profile-alist' and +'connection-local-criteria-alist' are now user options, in order to +make it more convenient to inspect and modify them. + --- ** New minor mode 'pixel-scroll-precision-mode'. When enabled, and if your mouse supports it, you can scroll the @@ -300,7 +307,7 @@ These will take you (respectively) to the next and previous "page". *** 'describe-char' now also outputs the name of emoji combinations. +++ -*** New key binding in *Help* buffers: 'I'. +*** New key binding in "*Help*" buffer: 'I'. This will take you to the Emacs Lisp manual entry for the item displayed, if any. @@ -478,7 +485,7 @@ the "*Completions*" buffer. *** New user option 'completions-sort'. This option controls the sorting of the completion candidates in -the *Completions* buffer. Available styles are no sorting, +the "*Completions*" buffer. Available styles are no sorting, alphabetical (the default), or a custom sort function. ** Isearch and Replace @@ -820,9 +827,9 @@ option to nil to disable this confirmation completely. --- *** Make 'image-dired-rotate-thumbnail-(left|right)' obsolete. -Instead, use 'M-x image-dired-refresh-thumb' to generate a new -thumbnail, or 'M-x image-rotate' to rotate the thumbnail without -updating the thumbnail file. +Instead, use commands 'image-dired-refresh-thumb' to generate a new +thumbnail, or 'image-rotate' to rotate the thumbnail without updating +the thumbnail file. ** Dired @@ -922,8 +929,9 @@ the Galeon web browser was released in September, 2008. Prefixing '|', '<' or '>' with an asterisk, i.e. '*|', '*<' or '*>', will cause the whole command to be passed to the operating system shell. This is particularly useful to bypass Eshell's own pipelining -support for pipelines which will move a lot of data. See "Running -Shell Pipelines Natively" in the Eshell manual. +support for pipelines which will move a lot of data. See section +"Running Shell Pipelines Natively" in the Eshell manual, node +"(eshell) Input/Output". ** Miscellaneous @@ -1098,7 +1106,7 @@ is, the alias chain is returned. +++ ** New facility for handling session state: 'multisession-value'. This can be used as a convenient way to store (simple) application -state, and 'M-x list-multisession-values' allows users to list +state, and the command 'list-multisession-values' allows users to list (and edit) this data. +++ @@ -1267,7 +1275,7 @@ inhibits 'isearch' matching the STRING parameter. It can be used to implement own regexp syntax for search/replace. --- -** New variables to customize defaults of FROM for query-replace commands. +** New variables to customize defaults of FROM for 'query-replace*' commands. The new variable 'query-replace-read-from-default' can be set to a function that returns the default value of FROM when 'query-replace' prompts for a string to be replaced. An example of such a function is diff --git a/lisp/files-x.el b/lisp/files-x.el index e86ba8f8d0..773339d748 100644 --- a/lisp/files-x.el +++ b/lisp/files-x.el @@ -579,15 +579,22 @@ changed by the user.") (setq ignored-local-variables (cons 'connection-local-variables-alist ignored-local-variables)) -(defvar connection-local-profile-alist nil +(defcustom connection-local-profile-alist nil "Alist mapping connection profiles to variable lists. Each element in this list has the form (PROFILE VARIABLES). PROFILE is the name of a connection profile (a symbol). VARIABLES is a list that declares connection-local variables for PROFILE. An element in VARIABLES is an alist whose elements are -of the form (VAR . VALUE).") - -(defvar connection-local-criteria-alist nil +of the form (VAR . VALUE)." + :type '(repeat (cons (symbol :tag "Profile") + (repeat :tag "Variables" + (cons (symbol :tag "Variable") + (sexp :tag "Value"))))) + :group 'files + :group 'tramp + :version "29.1") + +(defcustom connection-local-criteria-alist nil "Alist mapping connection criteria to connection profiles. Each element in this list has the form (CRITERIA PROFILES). CRITERIA is a plist identifying a connection and the application @@ -596,7 +603,19 @@ using this connection. Property names might be `:application', `:application' is a symbol, all other property values are strings. All properties are optional; if CRITERIA is nil, it always applies. -PROFILES is a list of connection profiles (symbols).") +PROFILES is a list of connection profiles (symbols)." + :type '(repeat (cons (plist :tag "Criteria" + ;; Give the most common options as checkboxes. + :options (((const :format "%v " :application) + symbol) + ((const :format "%v " :protocol) string) + ((const :format "%v " :user) string) + ((const :format "%v " :machine) string))) + (repeat :tag "Profiles" + (symbol :tag "Profile")))) + :group 'files + :group 'tramp + :version "29.1") (defsubst connection-local-normalize-criteria (criteria) "Normalize plist CRITERIA according to properties. commit 9338fbbc2803ec59cd24e08a02db800f2fc2aabf Author: Stefan Monnier Date: Mon Feb 7 12:59:27 2022 -0500 lisp-mnt, checkdoc: Reduce run-time dependencies * lisp/emacs-lisp/lisp-mnt.el: Don't require `mail-parse` at top-level. (lm-crack-address): Require it here instead. * lisp/emacs-lisp/checkdoc.el (dired): Don't load at run-time. (checkdoc-dired): Add corresponding `declare-function`. diff --git a/lisp/emacs-lisp/checkdoc.el b/lisp/emacs-lisp/checkdoc.el index 334988e713..72eb776b99 100644 --- a/lisp/emacs-lisp/checkdoc.el +++ b/lisp/emacs-lisp/checkdoc.el @@ -166,7 +166,7 @@ (require 'help-mode) ;; for help-xref-info-regexp (require 'thingatpt) ;; for handy thing-at-point-looking-at (require 'lisp-mode) ;; for lisp-mode-symbol-regexp -(require 'dired) ;; for dired-get-filename and dired-map-over-marks +(eval-when-compile (require 'dired)) ;; for dired-map-over-marks (require 'lisp-mnt) (defvar compilation-error-regexp-alist) @@ -1124,12 +1124,20 @@ Skip anything that doesn't have the Emacs Lisp library file extension (\".el\"). When called from Lisp, FILES is a list of filenames." (interactive - (list - (delq nil - (mapcar - ;; skip anything that doesn't look like an Emacs Lisp library - (lambda (f) (if (equal (file-name-extension f) "el") f nil)) - (nreverse (dired-map-over-marks (dired-get-filename) nil))))) + (progn + ;; These Dired functions must be defined since we're in a Dired buffer. + (declare-function dired-get-filename "dired" + (&optional localp no-error-if-not-filep bof)) + ;; These functions are used by the expansion of `dired-map-over-marks'. + (declare-function dired-move-to-filename "dired" + (&optional raise-error eol)) + (declare-function dired-marker-regexp "dired" ()) + (list + (delq nil + (mapcar + ;; skip anything that doesn't look like an Emacs Lisp library + (lambda (f) (if (equal (file-name-extension f) "el") f nil)) + (nreverse (dired-map-over-marks (dired-get-filename) nil)))))) dired-mode) (if (null files) (error "No files to run checkdoc on") @@ -1275,27 +1283,27 @@ TEXT, START, END and UNFIXABLE conform to (let ((map (make-sparse-keymap)) (pmap (make-sparse-keymap))) ;; Override some bindings - (define-key map "\C-\M-x" 'checkdoc-eval-defun) - (define-key map "\C-x`" 'checkdoc-continue) + (define-key map "\C-\M-x" #'checkdoc-eval-defun) + (define-key map "\C-x`" #'checkdoc-continue) (define-key map [menu-bar emacs-lisp eval-buffer] - 'checkdoc-eval-current-buffer) + #'checkdoc-eval-current-buffer) ;; Add some new bindings under C-c ? - (define-key pmap "x" 'checkdoc-defun) - (define-key pmap "X" 'checkdoc-ispell-defun) - (define-key pmap "`" 'checkdoc-continue) - (define-key pmap "~" 'checkdoc-ispell-continue) - (define-key pmap "s" 'checkdoc-start) - (define-key pmap "S" 'checkdoc-ispell-start) - (define-key pmap "d" 'checkdoc) - (define-key pmap "D" 'checkdoc-ispell) - (define-key pmap "b" 'checkdoc-current-buffer) - (define-key pmap "B" 'checkdoc-ispell-current-buffer) - (define-key pmap "e" 'checkdoc-eval-current-buffer) - (define-key pmap "m" 'checkdoc-message-text) - (define-key pmap "M" 'checkdoc-ispell-message-text) - (define-key pmap "c" 'checkdoc-comments) - (define-key pmap "C" 'checkdoc-ispell-comments) - (define-key pmap " " 'checkdoc-rogue-spaces) + (define-key pmap "x" #'checkdoc-defun) + (define-key pmap "X" #'checkdoc-ispell-defun) + (define-key pmap "`" #'checkdoc-continue) + (define-key pmap "~" #'checkdoc-ispell-continue) + (define-key pmap "s" #'checkdoc-start) + (define-key pmap "S" #'checkdoc-ispell-start) + (define-key pmap "d" #'checkdoc) + (define-key pmap "D" #'checkdoc-ispell) + (define-key pmap "b" #'checkdoc-current-buffer) + (define-key pmap "B" #'checkdoc-ispell-current-buffer) + (define-key pmap "e" #'checkdoc-eval-current-buffer) + (define-key pmap "m" #'checkdoc-message-text) + (define-key pmap "M" #'checkdoc-ispell-message-text) + (define-key pmap "c" #'checkdoc-comments) + (define-key pmap "C" #'checkdoc-ispell-comments) + (define-key pmap " " #'checkdoc-rogue-spaces) ;; bind our submap into map (define-key map "\C-c?" pmap) diff --git a/lisp/emacs-lisp/lisp-mnt.el b/lisp/emacs-lisp/lisp-mnt.el index b871a83246..7c6f89deb1 100644 --- a/lisp/emacs-lisp/lisp-mnt.el +++ b/lisp/emacs-lisp/lisp-mnt.el @@ -111,8 +111,6 @@ ;;; Code: -(require 'mail-parse) - ;;; Variables: (defgroup lisp-mnt nil @@ -361,6 +359,8 @@ Return argument is of the form (\"HOLDER\" \"YEAR1\" ... \"YEARN\")" (defun lm-crack-address (x) "Split up email address(es) X into full name and real email address. The value is a list of elements of the form (FULLNAME . ADDRESS)." + (require 'mail-parse) + (declare-function mail-header-parse-addresses-lax "mail-parse" (string)) (mapcar (lambda (elem) (cons (cdr elem) (car elem))) (mail-header-parse-addresses-lax x))) @@ -505,7 +505,7 @@ absent, return nil." (if (and page (string-match (rx bol "<" (+ nonl) ">" eol) page)) (substring page 1 -1) page))) -(defalias 'lm-homepage 'lm-website) ; for backwards-compatibility +(defalias 'lm-homepage #'lm-website) ; for backwards-compatibility ;;; Verification and synopses commit 6f3c62ff07e671dff1741ae580b9a761a3bfd361 Author: Mattias Engdegård Date: Mon Feb 7 17:36:11 2022 +0100 Pin lazily read bytecode (bug#53809) * src/eval.c (Ffetch_bytecode): Bytecode strings read lazily weren't pinned as they must be. Do so. Bug reported by Gregor Zattler. diff --git a/src/eval.c b/src/eval.c index c87b1bc704..ae9b18da0b 100644 --- a/src/eval.c +++ b/src/eval.c @@ -3495,6 +3495,7 @@ DEFUN ("fetch-bytecode", Ffetch_bytecode, Sfetch_bytecode, bytecode = Fstring_as_unibyte (bytecode); } + pin_string (bytecode); ASET (object, COMPILED_BYTECODE, bytecode); ASET (object, COMPILED_CONSTANTS, XCDR (tem)); } commit 6e403efc9bcf6e212d656bcc049a790dcebff451 Author: Po Lu Date: Mon Feb 7 21:39:19 2022 +0800 ; * doc/emacs/xresources.texi (Table of Resources): Fix typo. diff --git a/doc/emacs/xresources.texi b/doc/emacs/xresources.texi index 893fef16ed..2c2700bc15 100644 --- a/doc/emacs/xresources.texi +++ b/doc/emacs/xresources.texi @@ -375,7 +375,7 @@ displaying the preview text. @item @code{synchronizeResize} (class @code{SynchronizeResize}) If @samp{off} or @samp{false}, Emacs will not try to tell the window -manager when it has finished redrawing the display in response to a a +manager when it has finished redrawing the display in response to a frame being resized. Otherwise, the window manager will postpone drawing a frame that was just resized until its contents are updated, which prevents blank areas of a frame that have not yet been painted commit 90eb6a7fe470142241a7dbd3cd938806fa29c9e0 Author: Tassilo Horn Date: Mon Feb 7 13:37:14 2022 +0100 ; Set show-paren--context-child-frame to nil after deleting it diff --git a/lisp/paren.el b/lisp/paren.el index 398e51e1b8..6de4364b4f 100644 --- a/lisp/paren.el +++ b/lisp/paren.el @@ -337,7 +337,8 @@ It is the default value of `show-paren-data-function'." (defun show-paren--delete-context-child-frame () (when show-paren--context-child-frame - (delete-frame show-paren--context-child-frame)) + (delete-frame show-paren--context-child-frame) + (setq show-paren--context-child-frame nil)) (remove-hook 'post-command-hook #'show-paren--delete-context-child-frame)) commit 3eaaeed2d0ac1d4630772e4a95e8fdbbacfc08c7 Author: Po Lu Date: Mon Feb 7 19:59:43 2022 +0800 Improve contrast of `custom-button' in the leuven-dark theme * etc/themes/leuven-dark-theme.el (custom-button): Improve contrast of custom-button foreground. diff --git a/etc/themes/leuven-dark-theme.el b/etc/themes/leuven-dark-theme.el index 0f4c7920eb..d85f8f1aa9 100644 --- a/etc/themes/leuven-dark-theme.el +++ b/etc/themes/leuven-dark-theme.el @@ -459,7 +459,7 @@ more...") `(compilation-mode-line-run ((,class (:weight bold :foreground "#065aff")))) ; :run `(css-property ((,class (:foreground "#ff55ff")))) `(css-selector ((,class (:weight bold :foreground "#ffff0b")))) - `(custom-button ((,class (:box (:line-width 2 :style released-button) :foreground "#ffffff" :background "lightgrey")))) + `(custom-button ((,class (:box (:line-width 2 :style released-button) :foreground "gray20" :background "lightgrey")))) `(custom-button-mouse ((,class (:box (:line-width 2 :style released-button) :foreground "#ffffff" :background "#3d3842")))) `(custom-button-pressed ((,class (:box (:line-width 2 :style pressed-button) :foreground "#ffffff" :background "#312c36")))) `(custom-button-pressed-unraised ((,class (:underline t :foreground "#78ff7c")))) commit 0d46ee2ddebb74a5a6e1d55da3641d1cd2ba5beb Author: Eric Abrahamsen Date: Mon Jan 24 16:24:10 2022 -0800 Don't remove dummy.group from gnus-newsrc-alist on Gnus save bug#53352 * lisp/gnus/gnus-start.el (gnus-gnus-to-quick-newsrc-format): This function was removing dummy.group from the global value of `gnus-newsrc-alist' on save; we only wanted to remove it temporarily. diff --git a/lisp/gnus/gnus-start.el b/lisp/gnus/gnus-start.el index 0910df42ed..301120e4ee 100644 --- a/lisp/gnus/gnus-start.el +++ b/lisp/gnus/gnus-start.el @@ -2868,12 +2868,6 @@ SPECIFIC-VARIABLES, or those in `gnus-variable-list'." (princ "(setq gnus-newsrc-file-version ") (princ (gnus-prin1-to-string gnus-version)) (princ ")\n")) - ;; Sort `gnus-newsrc-alist' according to order in - ;; `gnus-group-list'. - (setq gnus-newsrc-alist - (mapcar (lambda (g) - (nth 1 (gethash g gnus-newsrc-hashtb))) - (delete "dummy.group" gnus-group-list))) (let* ((print-quoted t) (print-escape-multibyte nil) (print-escape-nonascii t) @@ -2892,17 +2886,20 @@ SPECIFIC-VARIABLES, or those in `gnus-variable-list'." ;; Remove the `gnus-killed-list' from the list of variables ;; to be saved, if required. (delq 'gnus-killed-list (copy-sequence gnus-variable-list))))) - ;; Encode group names in `gnus-newsrc-alist' and - ;; `gnus-topic-alist' in order to keep newsrc.eld files - ;; compatible with older versions of Gnus. At some point, - ;; if/when a new version of Gnus is released, stop doing - ;; this and move the corresponding decode in - ;; `gnus-read-newsrc-el-file' into a conversion routine. + ;; Sort `gnus-newsrc-alist' according to order in + ;; `gnus-group-list'. Encode group names in + ;; `gnus-newsrc-alist' and `gnus-topic-alist' in order to + ;; keep newsrc.eld files compatible with older versions of + ;; Gnus. At some point, if/when a new version of Gnus is + ;; released, stop doing this and move the corresponding + ;; decode in `gnus-read-newsrc-el-file' into a conversion + ;; routine. (gnus-newsrc-alist - (mapcar (lambda (info) - (cons (encode-coding-string (car info) 'utf-8-emacs) - (cdr info))) - gnus-newsrc-alist)) + (mapcar (lambda (group) + (cons (encode-coding-string group 'utf-8-emacs) + (cdadr (gethash group + gnus-newsrc-hashtb)))) + (remove "dummy.group" gnus-group-list))) (gnus-topic-alist (when (memq 'gnus-topic-alist variables) (mapcar (lambda (elt) commit a5e6a7c3bc59955346d91a095dc4ab533e82e849 Author: Po Lu Date: Mon Feb 7 17:48:00 2022 +0800 * lwlib/xlwmenu.c (pop_up_menu): Fix cast. diff --git a/lwlib/xlwmenu.c b/lwlib/xlwmenu.c index 8c5794c043..cf6a8b1387 100644 --- a/lwlib/xlwmenu.c +++ b/lwlib/xlwmenu.c @@ -2743,5 +2743,5 @@ pop_up_menu (XlwMenuWidget mw, XButtonPressedEvent *event) ((XMotionEvent*)event)->is_hint = 0; handle_motion_event (mw, (XMotionEvent*)event); - XlwMenuRedisplay ((XlwMenuWidget) mw, NULL, None); + XlwMenuRedisplay ((Widget) mw, NULL, None); } commit 30d92721ce6e7f65719e9dbefb496780a2db1a50 Author: Po Lu Date: Mon Feb 7 09:43:26 2022 +0000 Correct off-by-one errors with frame resizing on Haiku * src/haiku_support.cc (UnZoom): (MakeFullscreen): (BWindow_resize): Fix off-by-one errors in calls to `BWindow::ResizeTo'. diff --git a/src/haiku_support.cc b/src/haiku_support.cc index fad2b46654..0aeff104da 100644 --- a/src/haiku_support.cc +++ b/src/haiku_support.cc @@ -1047,8 +1047,8 @@ class EmacsWindow : public BWindow zoomed_p = 0; EmacsMoveTo (pre_zoom_rect.left, pre_zoom_rect.top); - ResizeTo (BE_RECT_WIDTH (pre_zoom_rect), - BE_RECT_HEIGHT (pre_zoom_rect)); + ResizeTo (BE_RECT_WIDTH (pre_zoom_rect) - 1, + BE_RECT_HEIGHT (pre_zoom_rect) - 1); } void @@ -1128,15 +1128,15 @@ class EmacsWindow : public BWindow int w, h; EmacsMoveTo (0, 0); GetParentWidthHeight (&w, &h); - ResizeTo (w, h); + ResizeTo (w - 1, h - 1); } else { flags &= ~(B_NOT_MOVABLE | B_NOT_ZOOMABLE); EmacsMoveTo (pre_fullscreen_rect.left, pre_fullscreen_rect.top); - ResizeTo (BE_RECT_WIDTH (pre_fullscreen_rect), - BE_RECT_HEIGHT (pre_fullscreen_rect)); + ResizeTo (BE_RECT_WIDTH (pre_fullscreen_rect) - 1, + BE_RECT_HEIGHT (pre_fullscreen_rect) - 1); } SetFlags (flags); } @@ -1959,7 +1959,7 @@ BWindow_retitle (void *window, const char *title) void BWindow_resize (void *window, int width, int height) { - ((BWindow *) window)->ResizeTo (width, height); + ((BWindow *) window)->ResizeTo (width - 1, height - 1); } /* Activate WINDOW, making it the subject of keyboard focus and commit b432fb6c86b922bf1e8bfa8ae59e0dc80cb37eb0 Author: Po Lu Date: Mon Feb 7 16:22:06 2022 +0800 Make menus work better on X toolkit builds with XInput 2 * src/xmenu.c (popup_get_selection): Translate some important XI2 events into events the toolkit can understand. (x_activate_menubar): (create_and_show_popup_menu): Clear grab regardless of reported status on Motif. * src/xterm.c (xi_device_from_id): Export function. * src/xterm.h: Update prototypes. diff --git a/src/xmenu.c b/src/xmenu.c index 9e4e6b62fc..745a80ade1 100644 --- a/src/xmenu.c +++ b/src/xmenu.c @@ -52,6 +52,7 @@ along with GNU Emacs. If not, see . */ #endif #ifdef HAVE_XINPUT2 +#include #include #endif @@ -240,18 +241,25 @@ popup_get_selection (XEvent *initial_event, struct x_display_info *dpyinfo, LWLIB_ID id, bool do_timers) { XEvent event; + XEvent copy; +#ifdef HAVE_XINPUT2 + bool cookie_claimed_p = false; + XIDeviceEvent *xev; + struct xi_device_t *device; +#endif while (popup_activated_flag) { if (initial_event) { - event = *initial_event; + copy = event = *initial_event; initial_event = 0; } else { if (do_timers) x_menu_wait_for_event (0); XtAppNextEvent (Xt_app_con, &event); + copy = event; } /* Make sure we don't consider buttons grabbed after menu goes. @@ -271,6 +279,7 @@ popup_get_selection (XEvent *initial_event, struct x_display_info *dpyinfo, so Motif thinks this is the case. */ event.xbutton.state = 0; #endif + copy = event; } /* Pop down on C-g and Escape. */ else if (event.type == KeyPress @@ -281,9 +290,110 @@ popup_get_selection (XEvent *initial_event, struct x_display_info *dpyinfo, if ((keysym == XK_g && (event.xkey.state & ControlMask) != 0) || keysym == XK_Escape) /* Any escape, ignore modifiers. */ popup_activated_flag = 0; + + copy = event; } +#ifdef HAVE_XINPUT2 + else if (event.type == GenericEvent + && dpyinfo->supports_xi2 + && event.xgeneric.display == dpyinfo->display + && event.xgeneric.extension == dpyinfo->xi2_opcode) + { + if (!event.xcookie.data + && XGetEventData (dpyinfo->display, &event.xcookie)) + cookie_claimed_p = true; + + if (event.xcookie.data) + { + switch (event.xgeneric.evtype) + { + case XI_ButtonRelease: + { + xev = (XIDeviceEvent *) event.xcookie.data; + device = xi_device_from_id (dpyinfo, xev->deviceid); + + dpyinfo->grabbed &= ~(1 << xev->detail); + device->grab &= ~(1 << xev->detail); + + copy.xbutton.type = ButtonRelease; + copy.xbutton.serial = xev->serial; + copy.xbutton.send_event = xev->send_event; + copy.xbutton.display = xev->display; + copy.xbutton.window = xev->event; + copy.xbutton.root = xev->root; + copy.xbutton.subwindow = xev->child; + copy.xbutton.time = xev->time; + copy.xbutton.x = lrint (xev->event_x); + copy.xbutton.y = lrint (xev->event_y); + copy.xbutton.x_root = lrint (xev->root_x); + copy.xbutton.y_root = lrint (xev->root_y); + copy.xbutton.state = xev->mods.effective; + copy.xbutton.button = xev->detail; + copy.xbutton.same_screen = True; + +#ifdef USE_MOTIF /* Pretending that the event came from a + Btn1Down seems the only way to convince Motif to + activate its callbacks; setting the XmNmenuPost + isn't working. --marcus@sysc.pdx.edu. */ + copy.xbutton.button = 1; + /* Motif only pops down menus when no Ctrl, Alt or Mod + key is pressed and the button is released. So reset key state + so Motif thinks this is the case. */ + copy.xbutton.state = 0; +#endif + + if (xev->buttons.mask_len) + { + if (XIMaskIsSet (xev->buttons.mask, 1)) + copy.xbutton.state |= Button1Mask; + if (XIMaskIsSet (xev->buttons.mask, 2)) + copy.xbutton.state |= Button2Mask; + if (XIMaskIsSet (xev->buttons.mask, 3)) + copy.xbutton.state |= Button3Mask; + } + + break; + } + case XI_KeyPress: + { + KeySym keysym; + + xev = (XIDeviceEvent *) event.xcookie.data; + + copy.xkey.type = KeyPress; + copy.xkey.serial = xev->serial; + copy.xkey.send_event = xev->send_event; + copy.xkey.display = xev->display; + copy.xkey.window = xev->event; + copy.xkey.root = xev->root; + copy.xkey.subwindow = xev->child; + copy.xkey.time = xev->time; + copy.xkey.x = lrint (xev->event_x); + copy.xkey.y = lrint (xev->event_y); + copy.xkey.x_root = lrint (xev->root_x); + copy.xkey.y_root = lrint (xev->root_y); + copy.xkey.state = xev->mods.effective; + copy.xkey.keycode = xev->detail; + copy.xkey.same_screen = True; + + keysym = XLookupKeysym (©.xkey, 0); + + if ((keysym == XK_g + && (copy.xkey.state & ControlMask) != 0) + || keysym == XK_Escape) /* Any escape, ignore modifiers. */ + popup_activated_flag = 0; + + break; + } + } + } + } - x_dispatch_event (&event, event.xany.display); + if (cookie_claimed_p) + XFreeEventData (dpyinfo->display, &event.xcookie); +#endif + + x_dispatch_event (©, copy.xany.display); } } @@ -458,7 +568,9 @@ x_activate_menubar (struct frame *f) { for (int i = 0; i < dpyinfo->num_devices; ++i) { +#ifndef USE_MOTIF if (dpyinfo->devices[i].grab) +#endif XIUngrabDevice (dpyinfo->display, dpyinfo->devices[i].device_id, CurrentTime); } @@ -1465,7 +1577,8 @@ create_and_show_popup_menu (struct frame *f, widget_value *first_wv, /* Don't allow any geometry request from the user. */ XtSetArg (av[ac], (char *) XtNgeometry, 0); ac++; XtSetValues (menu, av, ac); -#if defined HAVE_XINPUT2 && defined USE_LUCID + +#if defined HAVE_XINPUT2 && defined USE_X_TOOLKIT struct x_display_info *dpyinfo = FRAME_DISPLAY_INFO (f); /* Clear the XI2 grab so lwlib can set a core grab. */ @@ -1473,12 +1586,15 @@ create_and_show_popup_menu (struct frame *f, widget_value *first_wv, { for (int i = 0; i < dpyinfo->num_devices; ++i) { +#ifndef USE_MOTIF if (dpyinfo->devices[i].grab) +#endif XIUngrabDevice (dpyinfo->display, dpyinfo->devices[i].device_id, CurrentTime); } } #endif + /* Display the menu. */ lw_popup_menu (menu, &dummy); popup_activated_flag = 1; diff --git a/src/xterm.c b/src/xterm.c index 49fc2b1bb7..940ee347d5 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -698,7 +698,7 @@ x_get_scroll_valuator_delta (struct x_display_info *dpyinfo, int device_id, return DBL_MAX; } -static struct xi_device_t * +struct xi_device_t * xi_device_from_id (struct x_display_info *dpyinfo, int deviceid) { for (int i = 0; i < dpyinfo->num_devices; ++i) diff --git a/src/xterm.h b/src/xterm.h index d3678054a8..63956fd643 100644 --- a/src/xterm.h +++ b/src/xterm.h @@ -1444,6 +1444,10 @@ extern void x_session_close (void); extern struct input_event xg_pending_quit_event; #endif +#ifdef HAVE_XINPUT2 +struct xi_device_t *xi_device_from_id (struct x_display_info *, int); +#endif + /* Is the frame embedded into another application? */ #define FRAME_X_EMBEDDED_P(f) (FRAME_X_OUTPUT(f)->explicit_parent != 0) commit dfda7d14631c0c2225317b1c2e0317e2f1ba2630 Author: Michael Albinus Date: Mon Feb 7 10:07:15 2022 +0100 Sanitize ls switches in ange-ftp (bug#53360) * lisp/net/ange-ftp.el (ls-lisp--sanitize-switches): Declare. (ange-ftp-ls): Sanitize LSARGS. (Bug#53360) diff --git a/lisp/net/ange-ftp.el b/lisp/net/ange-ftp.el index a6904fc07e..ef8527fada 100644 --- a/lisp/net/ange-ftp.el +++ b/lisp/net/ange-ftp.el @@ -2547,13 +2547,16 @@ can parse the output from a DIR listing for a host of type TYPE.") (defvar ange-ftp-after-parse-ls-hook nil "Normal hook run after parsing the text of an FTP directory listing.") +(declare-function ls-lisp--sanitize-switches "ls-lisp" (switches)) + (defun ange-ftp-ls (file lsargs parse &optional no-error wildcard) "Return the output of a `DIR' or `ls' command done over FTP. FILE is the full name of the remote file, LSARGS is any args to pass to the `ls' command, and PARSE specifies that the output should be parsed and stored away in the internal cache." - (while (string-match "^--dired\\s-+" lsargs) - (setq lsargs (replace-match "" nil t lsargs))) + (when (string-match "--" lsargs) + (require 'ls-lisp) + (setq lsargs (ls-lisp--sanitize-switches lsargs))) ;; If parse is t, we assume that file is a directory. i.e. we only parse ;; full directory listings. (let* ((ange-ftp-this-file (ange-ftp-expand-file-name file)) commit 985e7148a7576327e30fe9c48414a5c033ca42b2 Author: Lars Ingebrigtsen Date: Mon Feb 7 09:13:46 2022 +0100 Improve indentation of some shell script forms * lisp/progmodes/sh-script.el (sh-smie--default-backward-token): Don't skip past things like "true;then" (bug#53817). diff --git a/lisp/progmodes/sh-script.el b/lisp/progmodes/sh-script.el index 0a2ec348c1..8dc5562143 100644 --- a/lisp/progmodes/sh-script.el +++ b/lisp/progmodes/sh-script.el @@ -1774,21 +1774,27 @@ Does not preserve point." (n (skip-syntax-backward "."))) (if (or (zerop n) (and (eq n -1) + ;; Skip past quoted white space. (let ((p (point))) (if (eq -1 (% (skip-syntax-backward "\\") 2)) t (goto-char p) nil)))) (while - (progn (skip-syntax-backward ".w_'") - (or (not (zerop (skip-syntax-backward "\\"))) - (when (eq ?\\ (char-before (1- (point)))) - (let ((p (point))) - (forward-char -1) - (if (eq -1 (% (skip-syntax-backward "\\") 2)) - t - (goto-char p) - nil)))))) + (progn + ;; Skip past words, but stop at semicolons. + (while (and (not (zerop (skip-syntax-backward "w_'"))) + (not (eq (char-before (point)) ?\;)) + (skip-syntax-backward "."))) + (or (not (zerop (skip-syntax-backward "\\"))) + ;; Skip past quoted white space. + (when (eq ?\\ (char-before (1- (point)))) + (let ((p (point))) + (forward-char -1) + (if (eq -1 (% (skip-syntax-backward "\\") 2)) + t + (goto-char p) + nil)))))) (goto-char (- (point) (% (skip-syntax-backward "\\") 2)))) (buffer-substring-no-properties (point) pos))) diff --git a/test/lisp/progmodes/sh-script-resources/sh-indents.erts b/test/lisp/progmodes/sh-script-resources/sh-indents.erts new file mode 100644 index 0000000000..1f92610b3a --- /dev/null +++ b/test/lisp/progmodes/sh-script-resources/sh-indents.erts @@ -0,0 +1,40 @@ +Code: + (lambda () + (shell-script-mode) + (indent-region (point-min) (point-max))) + +Name: sh-indents1 + +=-= +if test;then + something +fi +other +=-=-= + +Name: sh-indents2 + +=-= +if test; then + something +fi +other +=-=-= + +Name: sh-indents3 + +=-= +if test ; then + something +fi +other +=-=-= + +Name: sh-indents4 + +=-= +if test ;then + something +fi +other +=-=-= diff --git a/test/lisp/progmodes/sh-script-tests.el b/test/lisp/progmodes/sh-script-tests.el index ebd26ab429..5d01cc1c22 100644 --- a/test/lisp/progmodes/sh-script-tests.el +++ b/test/lisp/progmodes/sh-script-tests.el @@ -23,6 +23,7 @@ (require 'sh-script) (require 'ert) +(require 'ert-x) (ert-deftest test-sh-script-indentation () (with-temp-buffer @@ -48,4 +49,24 @@ } ")))) +(ert-deftest test-indentation () + (ert-test-erts-file (ert-resource-file "sh-indents.erts"))) + +(defun test-sh-back (string &optional pos) + (with-temp-buffer + (shell-script-mode) + (insert string) + (sh-smie--default-backward-token) + (= (point) (or pos 1)))) + +(ert-deftest test-backward-token () + (should (test-sh-back "foo")) + (should (test-sh-back "foo.bar")) + (should (test-sh-back "foo\\1bar")) + (should (test-sh-back "foo\\\nbar")) + (should (test-sh-back "foo\\\n\\\n\\\nbar")) + (should (test-sh-back "foo")) + (should-not (test-sh-back "foo;bar")) + (should (test-sh-back "foo#zot"))) + ;;; sh-script-tests.el ends here