commit e3b79c641e04a9e8681e7e27db3db3e4beec0fa4 (HEAD, refs/remotes/origin/master) Author: Gerd Möllmann Date: Thu Sep 15 15:50:12 2022 +0200 Fix crash in GC on macOS (bug#57751) * src/nsterm.m ([EmacsView windowDidMove:]): Initialize input_event. diff --git a/src/nsterm.m b/src/nsterm.m index b8b4e66cd1..44979c7c04 100644 --- a/src/nsterm.m +++ b/src/nsterm.m @@ -7901,7 +7901,6 @@ - (void)windowDidMove: sender NSRect r = [win frame]; NSArray *screens = [NSScreen screens]; NSScreen *screen = [screens objectAtIndex: 0]; - struct input_event ie; NSTRACE ("[EmacsView windowDidMove:]"); @@ -7917,6 +7916,8 @@ - (void)windowDidMove: sender if (emacs_event) { + struct input_event ie; + EVENT_INIT (ie); ie.kind = MOVE_FRAME_EVENT; XSETFRAME (ie.frame_or_window, emacsframe); XSETINT (ie.x, emacsframe->left_pos); commit 7ec31d32222cdad695bc8324414880be5ca20201 Author: Peter Münster Date: Fri Sep 16 02:21:22 2022 +0200 image-dired: Fix thumbnail options for gm * lisp/image/image-dired-external.el (image-dired-cmd-create-standard-thumbnail-options): Fix options for "gm" (GraphicsMagick). (Bug#52200) diff --git a/lisp/image/image-dired-external.el b/lisp/image/image-dired-external.el index 223d881bcf..3e3a9a4443 100644 --- a/lisp/image/image-dired-external.el +++ b/lisp/image/image-dired-external.el @@ -108,8 +108,8 @@ with the information required by the Thumbnail Managing Standard." "-text" "b" "Thumb::URI" "file://%f" "%q" "%t") "Arguments for `image-dired-cmd-pngcrush-program'. -Available format specifiers are the same as in -`image-dired-cmd-create-thumbnail-options', with %q for a +The available %-format specifiers are the same as in +`image-dired-cmd-create-thumbnail-options', with \"%q\" for a temporary file name (typically generated by pnqnq)." :version "26.1" :type '(repeat (string :tag "Argument"))) @@ -128,20 +128,20 @@ Available format specifiers are described in :link '(url-link "man:optipng(1)")) (defcustom image-dired-cmd-create-standard-thumbnail-options - (append '("-size" "%wx%h" "%f[0]") - (unless (or image-dired-cmd-pngcrush-program - image-dired-cmd-pngnq-program) - (list - "-set" "Thumb::MTime" "%m" - "-set" "Thumb::URI" "file://%f" - "-set" "Description" "Thumbnail of file://%f" - "-set" "Software" (emacs-version))) - '("-thumbnail" "%wx%h>" "png:%t")) + (let ((opts (list + "-size" "%wx%h" "%f[0]" + "-set" "Thumb::MTime" "%m" + "-set" "Thumb::URI" "file://%f" + "-set" "Description" "Thumbnail of file://%f" + "-set" "Software" (emacs-version) + "-thumbnail" "%wx%h>" "png:%t"))) + (if (executable-find "gm") (cons "convert" opts) opts)) "Options for creating thumbnails according to the Thumbnail Managing Standard. -Available format specifiers are the same as in -`image-dired-cmd-create-thumbnail-options', with %m for file modification time." - :version "26.1" - :type '(repeat (string :tag "Argument"))) +The available %-format specifiers are the same as in +`image-dired-cmd-create-thumbnail-options', with \"%m\" for file +modification time." + :type '(repeat (string :tag "Argument")) + :version "29.1") (defcustom image-dired-cmd-rotate-original-program "jpegtran" "Executable used to rotate original image. commit 45459fd73b6546bff9bfa6c840da672c45dc40c5 Author: Stefan Kangas Date: Fri Sep 16 00:22:27 2022 +0200 ; * etc/NEWS: Improve and re-arrange Image-Dired section. diff --git a/etc/NEWS b/etc/NEWS index e2b5f5fde3..dd63efb02d 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2009,49 +2009,37 @@ This is done via 'image-converter-add-handler'. This avoids converting images in the background, and makes Image-Dired noticeably faster. New keybindings from 'image-mode' are now available in the "*image-dired-display-image*" buffer; press '?' or -'h' in that buffer to see the full list. Finally, some commands and -user options that are no longer needed are now obsolete: -'image-dired-cmd-create-temp-image-options', -'image-dired-cmd-create-temp-image-program', -'image-dired-display-current-image-full', -'image-dired-display-current-image-sized', -'image-dired-display-window-height-correction', -'image-dired-display-window-width-correction', -'image-dired-temp-image-file'. +'h' in that buffer to see the full list. --- *** Navigation and marking commands now work in image display buffer. The following new bindings have been added: - - n or SPC image-dired-display-next-thumbnail-original - p or DEL image-dired-display-previous-thumbnail-original - m image-dired-mark-thumb-original-file - d image-dired-flag-thumb-original-file - u image-dired-unmark-thumb-original-file +- 'n', 'SPC' => 'image-dired-display-next-thumbnail-original' +- 'p', 'DEL' => 'image-dired-display-previous-thumbnail-original' +- 'm' => 'image-dired-mark-thumb-original-file' +- 'd' => 'image-dired-flag-thumb-original-file' +- 'u' => 'image-dired-unmark-thumb-original-file' --- -*** Reduce dependency on external "exiftool" command. -The 'image-dired-copy-with-exif-file-name' no longer requires an -external "exiftool" command to be available. The user options -'image-dired-cmd-read-exif-data-program' and -'image-dired-cmd-read-exif-data-options' are now obsolete. +*** New command 'image-dired-unmark-all-marks'. +It removes all marks from all files in the thumbnail and the +associated Dired buffer, and is bound to 'U' in the thumbnail and +display buffer. --- -*** New command for the thumbnail buffer. -The new command 'image-dired-unmark-all-marks' has been added. It is -bound to 'U' in the thumbnail and display buffer. +*** New command 'image-dired-wallpaper-set'. +This command sets the desktop background to the image at point in the +thumbnail buffer. It is bound to 'W' by default. --- -*** Support Thumbnail Managing Standard v0.9.0 (Dec 2020). -This standard allows sharing generated thumbnails across different -programs. Version 0.9.0 adds two larger thumbnail sizes: 512x512 and -1024x1024 pixels. See the user option 'image-dired-thumbnail-storage' -to use it; it is not enabled by default. +*** 'image-dired-slideshow-start' is now bound to 'S'. +It is bound in both the thumbnail and display buffer. --- -*** Support GraphicsMagick command line tools. -Support for the GraphicsMagick command line tool ("gm") has been -added, and is used instead of ImageMagick when it is available. +*** New user option 'image-dired-marking-shows-next'. +If this option is non-nil (the default), marking, unmarking or +flagging an image in either the thumbnail or display buffer shows the +next image. --- *** New face 'image-dired-thumb-flagged'. @@ -2060,21 +2048,28 @@ used for images that are flagged for deletion in the Dired buffer associated with Image-Dired. --- -*** New command 'image-dired-wallpaper-set'. -This command sets the desktop background to the image at point in the -thumbnail buffer. It is bound to 'W' by default. +*** Image information is now shown in the header line. +This replaces the message most navigation commands in the thumbnail +buffer used to show at the bottom of the screen. --- -*** 'image-dired-slideshow-start' is now bound to 'S'. -It is bound in both the thumbnail and display buffer. +*** Support GraphicsMagick command line tools. +Support for the GraphicsMagick command line tool ("gm") has been +added, and is used instead of ImageMagick when it is available. --- -*** The 'image-dired-slideshow-start' command no longer prompts. -It no longer inconveniently prompts for a number of images and a -delay: it runs indefinitely, but stops automatically on any command. -You can set the delay with a prefix argument, or a negative prefix -argument to prompt for a delay. Customize the user option -'image-dired-slideshow-delay' to change the default from 5 seconds. +*** Support Thumbnail Managing Standard v0.9.0 (Dec 2020). +This standard allows sharing generated thumbnails across different +programs. Version 0.9.0 adds two larger thumbnail sizes: 512x512 and +1024x1024 pixels. See the user option 'image-dired-thumbnail-storage' +to use it; it is not enabled by default. + +--- +*** Reduce dependency on external "exiftool" command. +The 'image-dired-copy-with-exif-file-name' no longer requires an +external "exiftool" command to be available. The user options +'image-dired-cmd-read-exif-data-program' and +'image-dired-cmd-read-exif-data-options' are now obsolete. --- *** Support for bookmark.el. @@ -2083,15 +2078,12 @@ the thumbnail view, and will create a bookmark that opens the current directory in Image-Dired. --- -*** New user option 'image-dired-marking-shows-next'. -If this option is non-nil (the default), marking, unmarking or -flagging an image in either the thumbnail or display buffer shows the -next image. - ---- -*** Image information is now shown in the header line. -This replaces the message most navigation commands in the thumbnail -buffer used to show at the bottom of the screen. +*** The 'image-dired-slideshow-start' command no longer prompts. +It no longer inconveniently prompts for a number of images and a +delay: it runs indefinitely, but stops automatically on any command. +You can set the delay with a prefix argument, or a negative prefix +argument to prompt for a delay. Customize the user option +'image-dired-slideshow-delay' to change the default from 5 seconds. --- *** 'image-dired-display-properties-format' default has changed. @@ -2107,12 +2099,6 @@ thumbnails in the background in recent versions, this is not as important as it used to be. You can now also customize this option to nil to disable this confirmation completely. ---- -*** 'image-dired-rotate-thumbnail-(left|right)' is now obsolete. -Instead, use commands 'image-dired-refresh-thumb' to generate a new -thumbnail, or 'image-rotate' to rotate the thumbnail without updating -the thumbnail file. - --- *** HTML image gallery generation is now obsolete. The 'image-dired-gallery-generate' command and these user options are @@ -2120,6 +2106,25 @@ now obsolete: 'image-dired-gallery-thumb-image-root-url', 'image-dired-gallery-hidden-tags', 'image-dired-gallery-dir', 'image-dired-gallery-image-root-url'. +--- +*** 'image-dired-rotate-thumbnail-(left|right)' is now obsolete. +Instead, use commands 'image-dired-refresh-thumb' to generate a new +thumbnail, or 'image-rotate' to rotate the thumbnail without updating +the thumbnail file. + ++++ +*** Some commands and user options are now obsolete. +Since Image-Dired no longer converts images in the background before +displaying them, some commands and user options that are no longer +needed are now obsolete: +'image-dired-cmd-create-temp-image-options', +'image-dired-cmd-create-temp-image-program', +'image-dired-display-current-image-full', +'image-dired-display-current-image-sized', +'image-dired-display-window-height-correction', +'image-dired-display-window-width-correction', +'image-dired-temp-image-file'. + ** Dired --- commit 89084a193ef5bef813d9f9f5640a83882371beb9 Author: Stefan Kangas Date: Thu Sep 15 23:56:11 2022 +0200 Improve image-dired-display-properties-format * lisp/image/image-dired.el (image-dired-display-properties-format): Change default format, improve docstring and add :safe property diff --git a/etc/NEWS b/etc/NEWS index 72c330f5f7..e2b5f5fde3 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2093,6 +2093,12 @@ next image. This replaces the message most navigation commands in the thumbnail buffer used to show at the bottom of the screen. +--- +*** 'image-dired-display-properties-format' default has changed. +If you prefer the old format, add this to your Init file: + + (setopt image-dired-display-properties-format "%b: %f (%t): %c") + +++ *** 'image-dired-show-all-from-dir-max-files' increased to 1000. This user option controls asking for confirmation when starting diff --git a/lisp/image/image-dired.el b/lisp/image/image-dired.el index a7ca60dd37..e25241274c 100644 --- a/lisp/image/image-dired.el +++ b/lisp/image/image-dired.el @@ -293,12 +293,21 @@ For more information, see the documentation for `image-dired-toggle-movement-tracking'." :type 'boolean) -(defcustom image-dired-display-properties-format "%b: %f (%t): %c" +(defcustom image-dired-display-properties-format "%-40f %b %t %c" "Display format for thumbnail properties. -%b is replaced with associated Dired buffer name, %f with file -name (without path) of original image file, %t with the list of -tags and %c with the comment." - :type 'string) +This is used for the header line in the Image-Dired buffer. + +The following %-specs are replaced by `format-spec' before +displaying: + + \"%b\" The associated Dired buffer name. + \"%f\" The file name (without a directory) of the + original image file. + \"%t\" The list of tags (from the Image-Dired database). + \"%c\" The comment (from the Image-Dired database)." + :type 'string + :safe #'stringp + :version "29.1") (defcustom image-dired-external-viewer ;; TODO: Use mailcap, dired-guess-shell-alist-default, commit c3828d47dd0f97bcb1eaef1a29b614a6ae463e52 Author: Stefan Kangas Date: Thu Sep 15 23:34:41 2022 +0200 image-dired: Show header line on start * lisp/image/image-dired.el (image-dired-show-all-from-dir): Update header line, to ensure that it is immediately visible on start. diff --git a/lisp/image/image-dired.el b/lisp/image/image-dired.el index 12a94974b1..a7ca60dd37 100644 --- a/lisp/image/image-dired.el +++ b/lisp/image/image-dired.el @@ -551,6 +551,7 @@ never ask for confirmation." (image-dired-display-thumbs) (pop-to-buffer image-dired-thumbnail-buffer) (setq default-directory dir) + (image-dired-update-header-line) (image-dired-unmark-all-marks)) (t (message "Image-Dired canceled"))))) commit c99815fffad7a320c35a516548fd67fedaf0e732 Author: Stefan Monnier Date: Thu Sep 15 16:31:00 2022 -0400 combine-change-calls-1: Fix case where `body` also changes other bufs * lisp/subr.el (combine-change-calls-1): Only set the current buffer's part of the `*-change-functions` hooks. diff --git a/lisp/subr.el b/lisp/subr.el index 8769fec2b9..bfc2e207b2 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -4823,16 +4823,26 @@ the function `undo--wrap-and-run-primitive-undo'." (let ((undo--combining-change-calls t)) (if (not inhibit-modification-hooks) (run-hook-with-args 'before-change-functions beg end)) - (let (;; (inhibit-modification-hooks t) - (before-change-functions - ;; Ugly Hack: if the body uses syntax-ppss/syntax-propertize - ;; (e.g. via a regexp-search or sexp-movement triggering - ;; on-the-fly syntax-propertize), make sure that this gets - ;; properly refreshed after subsequent changes. - (if (memq #'syntax-ppss-flush-cache before-change-functions) - '(syntax-ppss-flush-cache))) - after-change-functions) - (setq result (funcall body))) + (let ((bcf before-change-functions) + (acf after-change-functions) + (local-bcf (local-variable-p 'before-change-functions)) + (local-acf (local-variable-p 'after-change-functions))) + (unwind-protect + ;; FIXME: WIBNI we could just use `inhibit-modification-hooks'? + (progn + ;; Ugly Hack: if the body uses syntax-ppss/syntax-propertize + ;; (e.g. via a regexp-search or sexp-movement triggering + ;; on-the-fly syntax-propertize), make sure that this gets + ;; properly refreshed after subsequent changes. + (setq-local before-change-functions + (if (memq #'syntax-ppss-flush-cache bcf) + '(syntax-ppss-flush-cache))) + (setq-local after-change-functions nil) + (setq result (funcall body))) + (if local-bcf (setq before-change-functions bcf) + (kill-local-variable 'before-change-functions)) + (if local-acf (setq after-change-functions acf) + (kill-local-variable 'after-change-functions)))) (when (not (eq buffer-undo-list t)) (let ((ap-elt (list 'apply commit bb76ab015a247d2547a9e6778e50ffb38988f47e Author: Stefan Kangas Date: Thu Sep 15 22:19:00 2022 +0200 image-dired: Fix performance bug with mouse click * lisp/image/image-dired.el (image-dired--on-file-in-dired-buffer): Move call to 'image-dired-thumb-update-marks' from here... (image-dired--do-mark-command): ...to here. Add new optional argument UPDATE to control calling it. Update callers. (image-dired-mouse-toggle-mark-1): Fix performance bug by setting above new optional argument to nil. (Bug#53599) diff --git a/lisp/image/image-dired.el b/lisp/image/image-dired.el index df4ee07133..12a94974b1 100644 --- a/lisp/image/image-dired.el +++ b/lisp/image/image-dired.el @@ -750,18 +750,20 @@ Should be called from commands in `image-dired-thumbnail-mode'." (message "No image, or image with correct properties, at point") (with-current-buffer dired-buf (when (dired-goto-file file-name) - ,@body - (image-dired-thumb-update-marks)))))) + ,@body))))) -(defmacro image-dired--do-mark-command (maybe-next &rest body) +(defmacro image-dired--do-mark-command (maybe-next update &rest body) "Helper macro for the mark, unmark and flag commands. Run BODY in Dired buffer. -If optional argument MAYBE-NEXT is non-nil, show next image -according to `image-dired-marking-shows-next'." +If MAYBE-NEXT is non-nil, show next image according to +`image-dired-marking-shows-next'. +If UPDATE is non-nil, call `image-dired-thumb-update-marks' too." (declare (indent defun) (debug t)) `(image-dired--with-thumbnail-buffer (image-dired--on-file-in-dired-buffer ,@body) + ,(when update + '(image-dired-thumb-update-marks)) ,(when maybe-next '(if image-dired-marking-shows-next (image-dired-display-next-thumbnail-original) @@ -770,26 +772,26 @@ according to `image-dired-marking-shows-next'." (defun image-dired-mark-thumb-original-file () "Mark original image file in associated Dired buffer." (interactive nil image-dired-thumbnail-mode image-dired-display-image-mode) - (image-dired--do-mark-command t + (image-dired--do-mark-command t t (dired-mark 1))) (defun image-dired-unmark-thumb-original-file () "Unmark original image file in associated Dired buffer." (interactive nil image-dired-thumbnail-mode image-dired-display-image-mode) - (image-dired--do-mark-command t + (image-dired--do-mark-command t t (dired-unmark 1))) (defun image-dired-flag-thumb-original-file () "Flag original image file for deletion in associated Dired buffer." (interactive nil image-dired-thumbnail-mode image-dired-display-image-mode) - (image-dired--do-mark-command t + (image-dired--do-mark-command t t (dired-flag-file-deletion 1))) (defun image-dired-unmark-all-marks () "Remove all marks from all files in associated Dired buffer. Also update the marks in the thumbnail buffer." (interactive nil image-dired-thumbnail-mode image-dired-display-image-mode) - (image-dired--do-mark-command nil + (image-dired--do-mark-command nil t (dired-unmark-all-marks)) (image-dired--with-thumbnail-buffer (image-dired-thumb-update-marks))) @@ -1253,7 +1255,7 @@ Track this in associated Dired buffer if `image-dired-track-movement' is non-nil." (when image-dired-track-movement (image-dired-track-original-file)) - (image-dired--do-mark-command nil + (image-dired--do-mark-command nil nil (if (image-dired-dired-file-marked-p) (dired-unmark 1) (dired-mark 1)))) @@ -1371,7 +1373,7 @@ completely fit)." "Toggle mark on original image file in associated Dired buffer." (declare (obsolete nil "29.1")) (interactive nil image-dired-thumbnail-mode image-dired-display-image-mode) - (image-dired--do-mark-command nil + (image-dired--do-mark-command nil t (if (image-dired-dired-file-marked-p) (dired-unmark 1) (dired-mark 1)))) commit c6fc00f5d75a28fd4e99050ccc1af9ad82f66b2b Author: Stefan Kangas Date: Thu Sep 15 22:08:19 2022 +0200 Make image-dired-toggle-mark-thumb-original-file obsolete * lisp/image/image-dired.el (image-dired-toggle-mark-thumb-original-file): Make obsolete. (image-dired-mouse-toggle-mark-1): Don't use above obsolete function. diff --git a/lisp/image/image-dired.el b/lisp/image/image-dired.el index 75dcdd8cbc..df4ee07133 100644 --- a/lisp/image/image-dired.el +++ b/lisp/image/image-dired.el @@ -785,14 +785,6 @@ according to `image-dired-marking-shows-next'." (image-dired--do-mark-command t (dired-flag-file-deletion 1))) -(defun image-dired-toggle-mark-thumb-original-file () - "Toggle mark on original image file in associated Dired buffer." - (interactive nil image-dired-thumbnail-mode image-dired-display-image-mode) - (image-dired--do-mark-command nil - (if (image-dired-dired-file-marked-p) - (dired-unmark 1) - (dired-mark 1)))) - (defun image-dired-unmark-all-marks () "Remove all marks from all files in associated Dired buffer. Also update the marks in the thumbnail buffer." @@ -1261,7 +1253,10 @@ Track this in associated Dired buffer if `image-dired-track-movement' is non-nil." (when image-dired-track-movement (image-dired-track-original-file)) - (image-dired-toggle-mark-thumb-original-file)) + (image-dired--do-mark-command nil + (if (image-dired-dired-file-marked-p) + (dired-unmark 1) + (dired-mark 1)))) (defun image-dired-mouse-toggle-mark (event) "Use mouse EVENT to toggle Dired mark for thumbnail. @@ -1372,6 +1367,15 @@ completely fit)." (make-obsolete-variable 'image-dired-display-window-height-correction "no longer used." "29.1") +(defun image-dired-toggle-mark-thumb-original-file () + "Toggle mark on original image file in associated Dired buffer." + (declare (obsolete nil "29.1")) + (interactive nil image-dired-thumbnail-mode image-dired-display-image-mode) + (image-dired--do-mark-command nil + (if (image-dired-dired-file-marked-p) + (dired-unmark 1) + (dired-mark 1)))) + (defun image-dired-display-window-width (window) "Return width, in pixels, of WINDOW." (declare (obsolete nil "29.1")) commit bfc4393040037a3dd17531e6e9dcfa6990a3c33d Author: Mattias Engdegård Date: Thu Sep 15 21:59:16 2022 +0200 Include nil as valid wallpaper-commmand * lisp/image/wallpaper.el (wallpaper-command): Include nil in the type since that is a valid value for the variable, and may be the default value. This should fix test-custom-opts. diff --git a/lisp/image/wallpaper.el b/lisp/image/wallpaper.el index 16fc9d23ec..9572349c36 100644 --- a/lisp/image/wallpaper.el +++ b/lisp/image/wallpaper.el @@ -167,7 +167,8 @@ systems, where a native API is used instead." (const :tag "xloadimage (X Window System)" "xloadimage") (const :tag "xsetbg (X Window System)" "xsetbg") (const :tag "osascript (macOS)" "osascript")) - (const :tag "Other (specify)" string)) + (const :tag "Other (specify)" string) + (const :tag "None" nil)) :set #'wallpaper--set-wallpaper-command :group 'image :version "29.1") commit a057d41c7577c0e7089dd259fd8edf75f636c7a1 Author: Alan Mackenzie Date: Thu Sep 15 19:54:22 2022 +0000 CC Mode: Handle C++20 modules * lisp/progmodes/cc-engine.el (c-before-after-change-check-c++-modules): New function. (c-forward-<>-arglist): Add special handling for "import <...>". * lisp/progmodes/cc-fonts.el (c-preprocessor-face-name): Add extra "fallback" face after font-lock-reference-face, namely font-lock-constant-face. (c-cpp-matchers): Don't fontify the <> delimiters for XEmacs in #include <..>. (c-basic-matchers-before): Add c-font-lock-c++-modules to the C++ value. (c-forward-c++-module-name, c-forward-c++-module-partition-name) (c-font-lock-c++-modules): New functions. * lisp/progmodes/cc-langs.el (c-get-state-before-change-functions) (c-before-font-lock-functions): Include c-before-after-change-check-c++-modules in the C++ value of these variables. (c-module-name-re): New c-lang-const/var. (c-other-decl-kwds): Add a C++ value "export". (c-<>-sexp-kwds): Add a new component c-import-<>-kwds. (c-import-<>-kwds, c-module-kwds): New c-lang-consts. (c-module-key): New c-lang-const/var. diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el index 94225d6e3e..1127ffe249 100644 --- a/lisp/progmodes/cc-engine.el +++ b/lisp/progmodes/cc-engine.el @@ -8155,6 +8155,40 @@ multi-line strings (but not C++, for example)." (c-clear-char-property c-neutralize-pos 'syntax-table)) (c-truncate-lit-pos-cache c-neutralize-pos))) + +(defun c-before-after-change-check-c++-modules (beg end &optional _old_len) + ;; Extend the region (c-new-BEG c-new-END) as needed to enclose complete + ;; C++20 module statements. This function is called solely from + ;; `c-get-state-before-change-functions' and `c-before-font-lock-functions' + ;; as part of the before-change and after-change processing for C++. + ;; + ;; Point is undefined both on entry and exit, and the return value has no + ;; significance. + (c-save-buffer-state (res bos lit-start) + (goto-char end) + (if (setq lit-start (c-literal-start)) + (goto-char lit-start)) + (when (>= (point) beg) + (setq res (c-beginning-of-statement-1 nil t)) ; t is IGNORE-LABELS + (setq bos (point)) + (when (and (memq res '(same previous)) + (looking-at c-module-key)) + (setq c-new-BEG (min c-new-BEG (point))) + (if (c-syntactic-re-search-forward + ";" (min (+ (point) 500) (point-max)) t) + (setq c-new-END (max c-new-END (point)))))) + (when (or (not bos) (< beg bos)) + (goto-char beg) + (when (not (c-literal-start)) + (setq res (c-beginning-of-statement-1 nil t)) + (setq bos (point)) + (when (and (memq res '(same previous)) + (looking-at c-module-key)) + (setq c-new-BEG (min c-new-BEG (point))) + (if (c-syntactic-re-search-forward + ";" (min (+ (point) 500) (point-max)) t) + (setq c-new-END (max c-new-END (point))))))))) + ;; Handling of small scale constructs like types and names. @@ -8474,25 +8508,40 @@ multi-line strings (but not C++, for example)." ;; recording of any found types that constitute an argument in ;; the arglist. (c-record-found-types (if c-record-type-identifiers t))) - (if (catch 'angle-bracket-arglist-escape - (setq c-record-found-types - (c-forward-<>-arglist-recur all-types))) - (progn - (when (consp c-record-found-types) - (let ((cur c-record-found-types)) - (while (consp (car-safe cur)) - (c-fontify-new-found-type - (buffer-substring-no-properties (caar cur) (cdar cur))) - (setq cur (cdr cur)))) - (setq c-record-type-identifiers - ;; `nconc' doesn't mind that the tail of - ;; `c-record-found-types' is t. - (nconc c-record-found-types c-record-type-identifiers))) - t) - - (setq c-found-types old-found-types) - (goto-char start) - nil))) + ;; Special handling for C++20's "import <...>" operator. + (if (and (c-major-mode-is 'c++-mode) + (save-excursion + (and (zerop (c-backward-token-2)) + (looking-at "import\\>\\(?:[^_$]\\|$\\)")))) + (when (looking-at "<\\(?:\\\\.\\|[^\\\n\r\t>]\\)*\\(>\\)?") + (if (match-beginning 1) ; A terminated <..> + (progn + (when c-parse-and-markup-<>-arglists + (c-mark-<-as-paren (point)) + (c-mark->-as-paren (match-beginning 1)) + (c-truncate-lit-pos-cache (point))) + (goto-char (match-end 1)) + t) + nil)) + (if (catch 'angle-bracket-arglist-escape + (setq c-record-found-types + (c-forward-<>-arglist-recur all-types))) + (progn + (when (consp c-record-found-types) + (let ((cur c-record-found-types)) + (while (consp (car-safe cur)) + (c-fontify-new-found-type + (buffer-substring-no-properties (caar cur) (cdar cur))) + (setq cur (cdr cur)))) + (setq c-record-type-identifiers + ;; `nconc' doesn't mind that the tail of + ;; `c-record-found-types' is t. + (nconc c-record-found-types c-record-type-identifiers))) + t) + + (setq c-found-types old-found-types) + (goto-char start) + nil)))) (defun c-forward-<>-arglist-recur (all-types) ;; Recursive part of `c-forward-<>-arglist'. diff --git a/lisp/progmodes/cc-fonts.el b/lisp/progmodes/cc-fonts.el index f34f7f177d..c52f4a8416 100644 --- a/lisp/progmodes/cc-fonts.el +++ b/lisp/progmodes/cc-fonts.el @@ -112,8 +112,10 @@ ;; In Emacs font-lock-builtin-face has traditionally been ;; used for preprocessor directives. 'font-lock-builtin-face) - (t - 'font-lock-reference-face))) + ((and (c-face-name-p 'font-lock-reference-face) + (eq font-lock-reference-face 'font-lock-reference-face)) + 'font-lock-reference-face) + (t 'font-lock-constant-face))) (cc-bytecomp-defvar font-lock-constant-face) @@ -558,8 +560,10 @@ stuff. Used on level 1 and higher." (c-lang-const c-opt-cpp-prefix) re (c-lang-const c-syntactic-ws) - "\\(<[^>\n\r]*>?\\)") - `(,(+ ncle-depth re-depth sws-depth 1) + "\\(<\\([^>\n\r]*\\)>?\\)") + `(,(+ ncle-depth re-depth sws-depth + (if (featurep 'xemacs) 2 1) + ) font-lock-string-face t) `((let ((beg (match-beginning ,(+ ncle-depth re-depth sws-depth 1))) @@ -878,6 +882,10 @@ casts and declarations are fontified. Used on level 2 and higher." c-reference-face-name)) (goto-char (match-end 1)))))))))) + ;; Module declarations (e.g. in C++20). + ,@(when (c-major-mode-is 'c++-mode) + '(c-font-lock-c++-modules)) + ;; Fontify the special declarations in Objective-C. ,@(when (c-major-mode-is 'objc-mode) `(;; Fontify class names in the beginning of message expressions. @@ -1909,6 +1917,163 @@ casts and declarations are fontified. Used on level 2 and higher." (forward-char))))) ; over the terminating "]" or other close paren. nil) +(defun c-forward-c++-module-name (limit) + ;; Is there a C++20 module name at point? If so, return a cons of the start + ;; and end of that name, in which case point will be moved over the name and + ;; following whitespace. Otherwise nil will be returned and point will be + ;; unmoved. This function doesn't regard a partition as part of the name. + ;; The entire construct must end not after LIMIT. + (when (and + (looking-at c-module-name-re) + (<= (match-end 0) limit) + (not (looking-at c-keywords-regexp))) + (goto-char (match-end 0)) + (prog1 (cons (match-beginning 0) (match-end 0)) + (c-forward-syntactic-ws limit)))) + +(defun c-forward-c++-module-partition-name (limit) + ;; Is there a C++20 module partition name (starting with its colon) at + ;; point? If so return a cons of the start and end of the name, not + ;; including the colon, in which case point will be move to after the name + ;; and following whitespace. Otherwise nil will be returned and point not + ;; moved. The entire construct must end not after LIMIT. + (when (and + (eq (char-after) ?:) + (progn + (forward-char) + (c-forward-syntactic-ws limit) + (looking-at c-module-name-re)) + (<= (match-end 0) limit) + (not (looking-at c-keywords-regexp))) + (goto-char (match-end 0)) + (prog1 (cons (match-beginning 0) (match-end 0)) + (c-forward-syntactic-ws limit)))) + +(defun c-font-lock-c++-modules (limit) + ;; Fontify the C++20 module stanzas, characterised by the keywords `module', + ;; `export' and `import'. Note that this has to be done by a function (as + ;; opposed to regexps) due to the presence of optional C++ attributes. + ;; + ;; This function will be called from font-lock for a region bounded by POINT + ;; and LIMIT, as though it were to identify a keyword for + ;; font-lock-keyword-face. It always returns NIL to inhibit this and + ;; prevent a repeat invocation. See elisp/lispref page "Search-based + ;; Fontification". + (while (and (< (point) limit) + (re-search-forward + "\\<\\(module\\|export\\|import\\)\\>\\(?:[^_$]\\|$\\)" + limit t)) + (goto-char (match-end 1)) + (let (name-bounds pos beg end + module-names) ; A list of conses of start and end + ; of pertinent module names + (unless (c-skip-comments-and-strings limit) + (when + (cond + ;; module foo...; Note we don't handle module; or module + ;; :private; here, since they don't really need handling. + ((save-excursion + (when (equal (match-string-no-properties 1) "export") + (c-forward-syntactic-ws limit) + (re-search-forward "\\=\\(module\\)\\>\\(?:[^_$]\\|$\\)" + limit t)) + (and (equal (match-string-no-properties 1) "module") + (< (point) limit) + (progn (c-forward-syntactic-ws limit) + (setq name-bounds (c-forward-c++-module-name + limit))) + (setq pos (point)))) + (push name-bounds module-names) + (goto-char pos) + ;; Is there a partition name? + (when (setq name-bounds (c-forward-c++-module-partition-name + limit)) + (push name-bounds module-names)) + t) + + ;; import + ((save-excursion + (when (equal (match-string-no-properties 1) "export") + (c-forward-syntactic-ws limit) + (re-search-forward "\\=\\(import\\)\\>\\(?:[^_$]\\|$\\)" + limit t)) + (and (equal (match-string-no-properties 1) "import") + (< (point) limit) + (progn (c-forward-syntactic-ws limit) + (setq pos (point))))) + (goto-char pos) + (cond + ;; import foo; + ((setq name-bounds (c-forward-c++-module-name limit)) + (push name-bounds module-names) + t) + ;; import :foo; + ((setq name-bounds (c-forward-c++-module-partition-name limit)) + (push name-bounds module-names) + t) + ;; import "foo"; + ((and (eq (char-after) ?\") + (setq pos (point)) + (c-safe (c-forward-sexp) t)) ; Should already have string face. + (when (eq (char-before) ?\") + (setq beg pos + end (point))) + (c-forward-syntactic-ws limit) + t) + ;; import ; + ((and (looking-at "<\\(?:\\\\.\\|[^\\\n\r\t>]\\)*\\(>\\)?") + (< (match-end 0) limit)) + (setq beg (point)) + (goto-char (match-end 0)) + (when (match-end 1) + (setq end (point))) + (if (featurep 'xemacs) + (c-put-font-lock-face + (1+ beg) (if end (1- end) (point)) font-lock-string-face) + (c-put-font-lock-face + beg (or end (point)) font-lock-string-face)) + (c-forward-syntactic-ws limit) + t) + (t nil))) + + ;; export + ;; There is no fontification to be done here, but we need to + ;; skip over the declaration or declaration sequence. + ((save-excursion + (when (equal (match-string-no-properties 0) "export") + (c-forward-syntactic-ws limit) + (setq pos (point)))) + (goto-char (point)) + (if (eq (char-after) ?{) + ;; Declaration sequence. + (unless (and (c-go-list-forward nil limit) + (eq (char-before) ?})) + (goto-char limit) + nil) + ;; Single declaration + (unless (c-end-of-decl-1) + (goto-char limit) + nil)))) ; Nothing more to do, here. + + ;; Optional attributes? + (while (and (c-looking-at-c++-attribute) + (< (match-end 0) limit)) + (goto-char (match-end 0)) + (c-forward-syntactic-ws limit)) + ;; Finally, there must be a semicolon. + (if (and (< (point) limit) + (eq (char-after) ?\;)) + (progn + (forward-char) + ;; Fontify any module names we've encountered. + (dolist (name module-names) + (c-put-font-lock-face (car name) (cdr name) + c-reference-face-name))) + ;; No semicolon, so put warning faces on any delimiters. + (when beg + (c-put-font-lock-face beg (1+ beg) font-lock-warning-face)) + (when end + (c-put-font-lock-face (1- end) end font-lock-warning-face)))))))) (c-lang-defconst c-simple-decl-matchers "Simple font lock matchers for types and declarations. These are used diff --git a/lisp/progmodes/cc-langs.el b/lisp/progmodes/cc-langs.el index bf7eee2283..d33ed4bcda 100644 --- a/lisp/progmodes/cc-langs.el +++ b/lisp/progmodes/cc-langs.el @@ -456,6 +456,7 @@ so that all identifiers are recognized as words.") c-depropertize-CPP c-before-change-check-ml-strings c-before-change-check-<>-operators + c-before-after-change-check-c++-modules c-truncate-bs-cache c-before-change-check-unbalanced-strings c-parse-quotes-before-change @@ -516,6 +517,7 @@ parameters \(point-min) and \(point-max).") c-parse-quotes-after-change c-after-change-mark-abnormal-strings c-extend-font-lock-region-for-macros + c-before-after-change-check-c++-modules c-neutralize-syntax-in-CPP c-restore-<>-properties c-change-expand-fl-region) @@ -1018,6 +1020,16 @@ e.g. identifiers with template arguments such as \"A\" in C++." ""))) (c-lang-defvar c-identifier-key (c-lang-const c-identifier-key)) +(c-lang-defconst c-module-name-re + "This regexp matches (a component of) a module name. +Currently (2022-09) just C++ Mode uses this." + t nil + c++ (concat (c-lang-const c-symbol-key) + "\\(?:\\." + (c-lang-const c-symbol-key) + "\\)*")) +(c-lang-defvar c-module-name-re (c-lang-const c-module-name-re)) + (c-lang-defconst c-identifier-last-sym-match ;; This was a docstring constant in 5.30 but it's no longer used. ;; It's only kept to avoid breaking third party code. @@ -2624,6 +2636,7 @@ If any of these also are on `c-type-list-kwds', `c-ref-list-kwds', `c-<>-type-kwds', or `c-<>-arglist-kwds' then the associated clauses will be handled." t nil + c++ '("export") objc '("@class" "@defs" "@end" "@property" "@dynamic" "@synthesize" "@compatibility_alias") java '("import" "package") @@ -2937,7 +2950,8 @@ assumed to be set if this isn't nil." (c-lang-defconst c-<>-sexp-kwds ;; All keywords that can be followed by an angle bracket sexp. t (c--delete-duplicates (append (c-lang-const c-<>-type-kwds) - (c-lang-const c-<>-arglist-kwds)) + (c-lang-const c-<>-arglist-kwds) + (c-lang-const c-import-<>-kwds)) :test 'string-equal)) (c-lang-defconst c-opt-<>-sexp-key @@ -3099,6 +3113,25 @@ This construct is \" :\"." idl nil awk nil) +(c-lang-defconst c-import-<>-kwds + "Keywords which can start an expression like \"import <...>\" in C++20. +The <, and > operators are like those of #include <...>, they are +not really template operators." + t nil + c++ '("import")) + +(c-lang-defconst c-module-kwds + "The keywords which introduce module constructs in C++20 onwards." + t nil + c++ '("module" "import" "export")) + +(c-lang-defconst c-module-key + ;; Adorned regexp matching module declaration keywords, or nil if there are + ;; none. + t (if (c-lang-const c-module-kwds) + (c-make-keywords-re t (c-lang-const c-module-kwds)))) +(c-lang-defvar c-module-key (c-lang-const c-module-key)) + (c-lang-defconst c-constant-kwds "Keywords for constants." t nil commit 3c1579697ff03d3991b41ead503211cffac0998f Author: Stefan Kangas Date: Thu Sep 15 19:21:51 2022 +0200 ; Fix wallpaper-set on TTY * lisp/image/wallpaper.el (wallpaper-set): Don't check for 'display-graphic-p', to allow setting the wallpaper from a TTY. diff --git a/lisp/image/wallpaper.el b/lisp/image/wallpaper.el index 5622f9b8e8..16fc9d23ec 100644 --- a/lisp/image/wallpaper.el +++ b/lisp/image/wallpaper.el @@ -237,13 +237,11 @@ options `wallpaper-command' and `wallpaper-command-args'. On MS-Windows and Haiku systems, no external command is needed, so the value of `wallpaper-commands' is ignored." - (interactive (list (and - (display-graphic-p) - (read-file-name "Set desktop background to: " - default-directory nil t nil - (lambda (fn) - (or (file-directory-p fn) - (string-match (image-file-name-regexp) fn))))))) + (interactive (list (read-file-name "Set desktop background to: " + default-directory nil t nil + (lambda (fn) + (or (file-directory-p fn) + (string-match (image-file-name-regexp) fn)))))) (when (file-directory-p file) (error "Can't set wallpaper to a directory: %s" file)) (unless (file-exists-p file) commit 4907859ee039f0d707b21050c2dec7d49f571590 Author: Stefan Kangas Date: Thu Sep 15 19:12:10 2022 +0200 Document MS-Windows support in wallpaper.el * lisp/image/wallpaper.el: Add MS-Windows to Commentary. (wallpaper-command, wallpaper-command-args, wallpaper-set): Document MS-Windows support. diff --git a/etc/NEWS b/etc/NEWS index cc68cd82b8..72c330f5f7 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2467,8 +2467,8 @@ This package provides the command 'wallpaper-set', which sets the desktop background image. Depending on the system and the desktop, this may require an external program (such as 'swaybg', 'gm', 'display' or 'xloadimage'). If so, a suitable command should be -detected automatically in most cases, and can also be customized -manually if needed using the new user options 'wallpaper-command' and +detected automatically in most cases. It can also be customized +manually if needed, using the new user options 'wallpaper-command' and 'wallpaper-command-args'. +++ diff --git a/lisp/image/wallpaper.el b/lisp/image/wallpaper.el index fe6882a588..5622f9b8e8 100644 --- a/lisp/image/wallpaper.el +++ b/lisp/image/wallpaper.el @@ -28,19 +28,21 @@ ;; On GNU/Linux and other Unix-like systems, it uses an external ;; command to set the desktop background. ;; -;; On Haiku, it uses the `haiku-set-wallpaper' function, which does -;; not rely on any external commands. -;; -;; On macOS, the "osascript" command is used. You might need to -;; disable the option "Change picture" in the "Desktop & Screensaver" -;; preferences for this to work (this was seen with macOS 10.13). -;; ;; Finding an external command to use is obviously a bit tricky to get ;; right, as there is no lack of platforms, window managers, desktop ;; environments and tools. However, it should be detected ;; automatically in most cases. If it doesn't work in your ;; environment, customize the user options `wallpaper-command' and ;; `wallpaper-command-args'. +;; +;; On MS-Windows, it uses the `w32-set-wallpaper' function, and on +;; Haiku the `haiku-set-wallpaper' function, neither of which relies +;; on any external commands. The value of `wallpaper-command' and +;; `wallpaper-command-args' are ignored on such systems. +;; +;; On macOS, the "osascript" command is used. You might need to +;; disable the option "Change picture" in the "Desktop & Screensaver" +;; preferences for this to work (this was seen with macOS 10.13). ;;; Code: @@ -131,7 +133,7 @@ Used to set `wallpaper-command'." (wallpaper--find-command-arguments)))) (defcustom wallpaper-command (wallpaper--find-command) - "Executable used for setting the wallpaper. + "Executable used by `wallpaper-set' for setting the wallpaper. A suitable command for your environment should be detected automatically, so there is usually no need to customize this. @@ -147,8 +149,8 @@ hear about it! Please send an email to bug-gnu-emacs@gnu.org and tell us the command (and all options) that worked for you. You can also use \\[report-emacs-bug]. -The value of this variable is ignored on Haiku systems, where a -native API will be used instead (see `haiku-set-wallpaper')." +The value of this variable is ignored on MS-Windows and Haiku +systems, where a native API is used instead." :type '(choice (radio @@ -186,8 +188,8 @@ returned by `display-pixel-width'). If `wallpaper-set' is run from a TTY frame, it will prompt for a height and width for \"%h\" and \"%w\" instead. -The value of this variable is ignored on Haiku systems, where a -native API will be used instead (see `haiku-set-wallpaper')." +The value of this variable is ignored on MS-Windows and Haiku +systems, where a native API is used instead." :type '(repeat string) :group 'image :version "29.1") @@ -233,8 +235,8 @@ external command. Which command to use is automatically detected in most cases, but can be manually customized with the user options `wallpaper-command' and `wallpaper-command-args'. -On Haiku, no external command is needed, so the value of -`wallpaper-commands' is ignored." +On MS-Windows and Haiku systems, no external command is needed, +so the value of `wallpaper-commands' is ignored." (interactive (list (and (display-graphic-p) (read-file-name "Set desktop background to: " commit 3ba47a0782f7059062ca6743b22c40a410933f13 Author: Stefan Kangas Date: Thu Sep 15 18:48:41 2022 +0200 Improve error when wallpaper-command is nil * lisp/image/wallpaper.el (wallpaper-set): Improve the error message when 'wallpaper-command' is nil. diff --git a/lisp/image/wallpaper.el b/lisp/image/wallpaper.el index d024d6238c..fe6882a588 100644 --- a/lisp/image/wallpaper.el +++ b/lisp/image/wallpaper.el @@ -254,6 +254,8 @@ On Haiku, no external command is needed, so the value of ((featurep 'haiku) (haiku-set-wallpaper file)) (t + (unless wallpaper-command + (error "Couldn't find a command to set the wallpaper with")) (let* ((fmt-spec `((?f . ,(expand-file-name file)) (?h . ,(wallpaper--get-height-or-width "height" commit 2e0cde244a99b83b221dc5ecce24167bf4bc1a5d Author: Stefan Kangas Date: Thu Sep 15 18:27:48 2022 +0200 Support macOS in wallpaper.el * lisp/image/wallpaper.el (wallpaper--default-commands) (wallpaper-command): Support macOS using "osascript". (wallpaper-set): Display image name when wallpaper-debug is t. diff --git a/lisp/image/wallpaper.el b/lisp/image/wallpaper.el index b5ce7355cd..d024d6238c 100644 --- a/lisp/image/wallpaper.el +++ b/lisp/image/wallpaper.el @@ -31,6 +31,10 @@ ;; On Haiku, it uses the `haiku-set-wallpaper' function, which does ;; not rely on any external commands. ;; +;; On macOS, the "osascript" command is used. You might need to +;; disable the option "Change picture" in the "Desktop & Screensaver" +;; preferences for this to work (this was seen with macOS 10.13). +;; ;; Finding an external command to use is obviously a bit tricky to get ;; right, as there is no lack of platforms, window managers, desktop ;; environments and tools. However, it should be detected @@ -57,6 +61,8 @@ ("gsettings" "set" "org.gnome.desktop.background" "picture-uri" "file://%f") ;; KDE Plasma ("plasma-apply-wallpaperimage" "%f") + ;; macOS + ("osascript" "-e" "tell application \"Finder\" to set desktop picture to POSIX file \"%f\"") ;; Other / General X ("gm" "display" "-size" "%wx%h" "-window" "root" "%f") ("display" "-resize" "%wx%h" "-window" "root" "%f") @@ -157,7 +163,8 @@ native API will be used instead (see `haiku-set-wallpaper')." (const :tag "xwallpaper (X Window System)" "xwallpaper") (const :tag "hsetroot (X Window System)" "hsetroot") (const :tag "xloadimage (X Window System)" "xloadimage") - (const :tag "xsetbg (X Window System)" "xsetbg")) + (const :tag "xsetbg (X Window System)" "xsetbg") + (const :tag "osascript (macOS)" "osascript")) (const :tag "Other (specify)" string)) :set #'wallpaper--set-wallpaper-command :group 'image @@ -241,6 +248,7 @@ On Haiku, no external command is needed, so the value of (error "No such file: %s" file)) (unless (file-readable-p file) (error "File is not readable: %s" file)) + (wallpaper-debug "Using image %S:" file) (cond ((eq system-type 'windows-nt) (w32-set-wallpaper file)) ((featurep 'haiku) commit 471414fe6ba8e9c9d755a83e7feddcdd5a45456a Author: Juri Linkov Date: Thu Sep 15 19:30:17 2022 +0300 Fix outline image icon display (bug#57813) * lisp/outline.el (outline--make-button-overlay): Don't overwrite image display with string display when image exists. (outline--fix-up-all-buttons): Optimize. diff --git a/lisp/outline.el b/lisp/outline.el index b19e0cf811..c9d1a4ac64 100644 --- a/lisp/outline.el +++ b/lisp/outline.el @@ -1003,11 +1003,11 @@ If non-nil, EVENT should be a mouse event." ;; movement commands work more logically. (when (derived-mode-p 'special-mode) (put-text-property (point) (1+ (point)) 'face (plist-get icon 'face))) - (when-let ((image (plist-get icon 'image))) - (overlay-put o 'display image)) - (overlay-put o 'display (concat (plist-get icon 'string) - (string (char-after (point))))) - (overlay-put o 'face (plist-get icon 'face))) + (if-let ((image (plist-get icon 'image))) + (overlay-put o 'display image) + (overlay-put o 'display (concat (plist-get icon 'string) + (string (char-after (point))))) + (overlay-put o 'face (plist-get icon 'face)))) o)) (defun outline--insert-open-button () @@ -1041,11 +1041,11 @@ If non-nil, EVENT should be a mouse event." "" #'outline-show-subtree)))))) (defun outline--fix-up-all-buttons (&optional from to) - (when from - (save-excursion - (goto-char from) - (setq from (line-beginning-position)))) (when (outline--use-buttons-p) + (when from + (save-excursion + (goto-char from) + (setq from (line-beginning-position)))) (outline-map-region (lambda () ;; `outline--cycle-state' will fail if we're in a totally commit 99bb6de7e17286a97caa2716b1c301bcd838d371 Author: Stefan Kangas Date: Thu Sep 15 15:44:06 2022 +0200 ; Silence byte-compiler in wallpaper.el * lisp/image/wallpaper.el (w32-set-wallpaper): Declare. diff --git a/lisp/image/wallpaper.el b/lisp/image/wallpaper.el index ef2ad31eba..b5ce7355cd 100644 --- a/lisp/image/wallpaper.el +++ b/lisp/image/wallpaper.el @@ -215,6 +215,7 @@ See also `wallpaper-default-width'.") (funcall fun) (read-number (format "Wallpaper %s in pixels: " desc) default))) +(declare-function w32-set-wallpaper "w32fns.c") (declare-function haiku-set-wallpaper "term/haiku-win.el") (defun wallpaper-set (file) commit 6bcc7a2df733f86925780aed448dd38aa933507b Author: Eli Zaretskii Date: Thu Sep 15 14:59:50 2022 +0300 ; Fix last change in w32fns.c. diff --git a/src/w32fns.c b/src/w32fns.c index d9070675a2..5f652ae9e4 100644 --- a/src/w32fns.c +++ b/src/w32fns.c @@ -11240,8 +11240,10 @@ globals_of_w32fns (void) get_proc_addr (user32_lib, "EnumDisplayMonitors"); get_title_bar_info_fn = (GetTitleBarInfo_Proc) get_proc_addr (user32_lib, "GetTitleBarInfo"); +#ifndef CYGWIN system_parameters_info_w_fn = (SystemParametersInfoW_Proc) get_proc_addr (user32_lib, "SystemParametersInfoW"); +#endif { HMODULE imm32_lib = GetModuleHandle ("imm32.dll"); commit 09e93c4dafc6ffa3e556429757348adfa49a5a83 Author: Eli Zaretskii Date: Thu Sep 15 14:51:31 2022 +0300 Implement support for 'wallpaper-set' on MS-Windows * src/w32fns.c (Fw32_set_wallpaper): New primitive. (syms_of_w32fns): Defsubr it. (globals_of_w32fns): Attempt to load SystemParametersInfoW from its DLL at run time. * lisp/image/wallpaper.el (wallpaper-set): Support MS-Windows by calling 'w32-set-wallpaper'. * etc/NEWS: Update and simplify wording of the 'wallpaper-set' entry. diff --git a/etc/NEWS b/etc/NEWS index c88af4e90c..cc68cd82b8 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2463,17 +2463,13 @@ to optionally rotate images which have the :rotation property. --- ** New package 'wallpaper'. -This package provides the command `wallpaper-set', which sets the -desktop background. - -On GNU/Linux and other Unix-like systems, it uses an external command -(such as "swaybg", "gm", "display" or "xloadimage"). A suitable -command should be detected automatically in most cases, but can also -be customized manually with the new user options 'wallpaper-command' -and 'wallpaper-command-args' if needed. - -On Haiku, it uses the new function `haiku-set-wallpaper', which does -not rely on any external command. +This package provides the command 'wallpaper-set', which sets the +desktop background image. Depending on the system and the desktop, +this may require an external program (such as 'swaybg', 'gm', +'display' or 'xloadimage'). If so, a suitable command should be +detected automatically in most cases, and can also be customized +manually if needed using the new user options 'wallpaper-command' and +'wallpaper-command-args'. +++ ** New package 'oclosure'. diff --git a/lisp/image/wallpaper.el b/lisp/image/wallpaper.el index 2ebe5be033..ef2ad31eba 100644 --- a/lisp/image/wallpaper.el +++ b/lisp/image/wallpaper.el @@ -240,7 +240,9 @@ On Haiku, no external command is needed, so the value of (error "No such file: %s" file)) (unless (file-readable-p file) (error "File is not readable: %s" file)) - (cond ((featurep 'haiku) + (cond ((eq system-type 'windows-nt) + (w32-set-wallpaper file)) + ((featurep 'haiku) (haiku-set-wallpaper file)) (t (let* ((fmt-spec `((?f . ,(expand-file-name file)) diff --git a/src/w32fns.c b/src/w32fns.c index 745458d0a0..d9070675a2 100644 --- a/src/w32fns.c +++ b/src/w32fns.c @@ -10447,6 +10447,66 @@ w32_get_resource (const char *key, const char *name, LPDWORD lpdwtype) return (NULL); } +#ifdef WINDOWSNT + +/*********************************************************************** + Wallpaper + ***********************************************************************/ + +typedef BOOL (WINAPI * SystemParametersInfoW_Proc) (UINT,UINT,PVOID,UINT); +SystemParametersInfoW_Proc system_parameters_info_w_fn = NULL; + +DEFUN ("w32-set-wallpaper", Fw32_set_wallpaper, Sw32_set_wallpaper, 1, 1, 0, + doc: /* Set the desktop wallpaper image to IMAGE-FILE. */) + (Lisp_Object image_file) +{ + Lisp_Object encoded = ENCODE_FILE (Fexpand_file_name (image_file, Qnil)); + char *fname = SSDATA (encoded); + BOOL result = false; + DWORD err = 0; + + /* UNICOWS.DLL seems to have SystemParametersInfoW, but it doesn't + seem to be worth the hassle to support that on Windows 9X for the + benefit of this minor feature. Let them use on Windows 9X only + image file names that can be encoded by the system codepage. */ + if (w32_unicode_filenames && system_parameters_info_w_fn) + { + wchar_t fname_w[MAX_PATH]; + + if (filename_to_utf16 (fname, fname_w) != 0) + err = ERROR_FILE_NOT_FOUND; + else + result = SystemParametersInfoW (SPI_SETDESKWALLPAPER, 0, fname_w, + SPIF_SENDCHANGE); + } + else + { + char fname_a[MAX_PATH]; + + if (filename_to_ansi (fname, fname_a) != 0) + err = ERROR_FILE_NOT_FOUND; + else + result = SystemParametersInfoA (SPI_SETDESKWALLPAPER, 0, fname_a, + SPIF_SENDCHANGE); + } + if (!result) + { + if (err == ERROR_FILE_NOT_FOUND) + error ("Wallpaper file %s does not exist or cannot be accessed", fname); + else + { + err = GetLastError (); + if (err) + error ("Could not set desktop wallpaper: %s", w32_strerror (err)); + else + error ("Could not set desktop wallpaper (wrong image type?)"); + } + } + + return Qnil; +} +#endif + /*********************************************************************** Initialization ***********************************************************************/ @@ -10926,6 +10986,7 @@ keys when IME input is received. */); defsubr (&Sx_file_dialog); #ifdef WINDOWSNT defsubr (&Ssystem_move_file_to_trash); + defsubr (&Sw32_set_wallpaper); #endif } @@ -11179,6 +11240,8 @@ globals_of_w32fns (void) get_proc_addr (user32_lib, "EnumDisplayMonitors"); get_title_bar_info_fn = (GetTitleBarInfo_Proc) get_proc_addr (user32_lib, "GetTitleBarInfo"); + system_parameters_info_w_fn = (SystemParametersInfoW_Proc) + get_proc_addr (user32_lib, "SystemParametersInfoW"); { HMODULE imm32_lib = GetModuleHandle ("imm32.dll"); commit 6d61d6018c00fd952937966a8cadfd1e7c102efa Author: Stefan Kangas Date: Thu Sep 15 11:27:57 2022 +0200 Add rudimentary font-locking to edit-abbrevs-mode * lisp/abbrev.el (abbrev-table-name): New face. (edit-abbrevs-mode-font-lock-keywords): New defvar. (edit-abbrevs-mode): Support font-locking. diff --git a/etc/NEWS b/etc/NEWS index decaff7fe6..c88af4e90c 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2444,6 +2444,11 @@ remote host are shown. Alternatively, the user option *** 'outlineify-sticky' command is renamed to 'allout-outlinify-sticky'. The old name is still available as an obsolete function alias. +--- +*** 'edit-abbrevs' now uses font-locking. +The new face 'abbrev-table-name' is used to display the abbrev table +name. + * New Modes and Packages in Emacs 29.1 diff --git a/lisp/abbrev.el b/lisp/abbrev.el index 718938df0c..a4f0196a78 100644 --- a/lisp/abbrev.el +++ b/lisp/abbrev.el @@ -1,7 +1,6 @@ ;;; abbrev.el --- abbrev mode commands for Emacs -*- lexical-binding: t -*- -;; Copyright (C) 1985-1987, 1992, 2001-2022 Free Software Foundation, -;; Inc. +;; Copyright (C) 1985-2022 Free Software Foundation, Inc. ;; Maintainer: emacs-devel@gnu.org ;; Keywords: abbrev convenience @@ -1220,13 +1219,28 @@ SORTFUN is passed to `sort' to change the default ordering." (sort entries (lambda (x y) (funcall sortfun (nth 2 x) (nth 2 y))))))) +(defface abbrev-table-name + '((t :inherit font-lock-function-name-face)) + "Face used for displaying the abbrev table name in `edit-abbrev-mode'." + :version "29.1") + +(defvar edit-abbrevs-mode-font-lock-keywords + `((,(rx bol "(" + ;; lisp-mode-symbol-regexp + (regexp "\\(?:\\sw\\|\\s_\\|\\\\.\\)+") + ")" eol) + 0 'abbrev-table-name))) + ;; Keep it after define-abbrev-table, since define-derived-mode uses ;; define-abbrev-table. (define-derived-mode edit-abbrevs-mode fundamental-mode "Edit-Abbrevs" "Major mode for editing the list of abbrev definitions. This mode is for editing abbrevs in a buffer prepared by `edit-abbrevs', which see." - :interactive nil) + :interactive nil + (setq-local font-lock-defaults + '(edit-abbrevs-mode-font-lock-keywords nil nil ((?_ . "w")))) + (setq font-lock-multiline nil)) (defun abbrev--possibly-save (query &optional arg) ;; Query mode. commit 824ae5faeec9cfa5e14e750030d55800b08ad7f2 Author: Mattias Engdegård Date: Sat Aug 27 14:20:38 2022 +0200 Use `eql` or `eq` instead of `=` in some places For a switch op to be generated, comparisons must be made using `eq`, `eql` or `equal`, not `=`. * lisp/emacs-lisp/byte-opt.el (byte-optimize-lapcode): * lisp/files.el (file-modes-char-to-who, file-modes-char-to-right): * lisp/international/titdic-cnv.el (tit-process-header): * lisp/language/ethio-util.el (ethio-input-special-character) (ethio-fidel-to-tex-buffer): * lisp/language/lao.el (consonant): Use `eq` or `eql` instead of `=`. In these cases either `eq` or `eql` would do and the choice does not affect the resulting code. We compare numbers with `eql` and characters with `eq` as a matter of style. diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index 27b0d33d3e..0d5f8c26eb 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -1999,20 +1999,20 @@ If FOR-EFFECT is non-nil, the return value is assumed to be of no importance." (setq keep-going t) (setq tmp (aref byte-stack+-info (symbol-value (car lap0)))) (setq rest (cdr rest)) - (cond ((= tmp 1) + (cond ((eql tmp 1) (byte-compile-log-lap " %s discard\t-->\t" lap0) (setq lap (delq lap0 (delq lap1 lap)))) - ((= tmp 0) + ((eql tmp 0) (byte-compile-log-lap " %s discard\t-->\t discard" lap0) (setq lap (delq lap0 lap))) - ((= tmp -1) + ((eql tmp -1) (byte-compile-log-lap " %s discard\t-->\tdiscard discard" lap0) (setcar lap0 'byte-discard) (setcdr lap0 0)) - ((error "Optimizer error: too much on the stack")))) + (t (error "Optimizer error: too much on the stack")))) ;; ;; goto*-X X: --> X: ;; diff --git a/lisp/files.el b/lisp/files.el index 540bc2a6a8..0f2d3ca4b9 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -8271,10 +8271,10 @@ CHAR is in [ugoa] and represents the category of users (Owner, Group, Others, or All) for whom to produce the mask. The bit-mask that is returned extracts from mode bits the access rights for the specified category of users." - (cond ((= char ?u) #o4700) - ((= char ?g) #o2070) - ((= char ?o) #o1007) - ((= char ?a) #o7777) + (cond ((eq char ?u) #o4700) + ((eq char ?g) #o2070) + ((eq char ?o) #o1007) + ((eq char ?a) #o7777) (t (error "%c: Bad `who' character" char)))) (defun file-modes-char-to-right (char &optional from) @@ -8282,22 +8282,22 @@ for the specified category of users." CHAR is in [rwxXstugo] and represents symbolic access permissions. If CHAR is in [Xugo], the value is taken from FROM (or 0 if omitted)." (or from (setq from 0)) - (cond ((= char ?r) #o0444) - ((= char ?w) #o0222) - ((= char ?x) #o0111) - ((= char ?s) #o6000) - ((= char ?t) #o1000) + (cond ((eq char ?r) #o0444) + ((eq char ?w) #o0222) + ((eq char ?x) #o0111) + ((eq char ?s) #o6000) + ((eq char ?t) #o1000) ;; Rights relative to the previous file modes. - ((= char ?X) (if (= (logand from #o111) 0) 0 #o0111)) - ((= char ?u) (let ((uright (logand #o4700 from))) - ;; FIXME: These divisions/shifts seem to be right - ;; for the `7' part of the #o4700 mask, but not - ;; for the `4' part. Same below for `g' and `o'. - (+ uright (/ uright #o10) (/ uright #o100)))) - ((= char ?g) (let ((gright (logand #o2070 from))) - (+ gright (/ gright #o10) (* gright #o10)))) - ((= char ?o) (let ((oright (logand #o1007 from))) - (+ oright (* oright #o10) (* oright #o100)))) + ((eq char ?X) (if (= (logand from #o111) 0) 0 #o0111)) + ((eq char ?u) (let ((uright (logand #o4700 from))) + ;; FIXME: These divisions/shifts seem to be right + ;; for the `7' part of the #o4700 mask, but not + ;; for the `4' part. Same below for `g' and `o'. + (+ uright (/ uright #o10) (/ uright #o100)))) + ((eq char ?g) (let ((gright (logand #o2070 from))) + (+ gright (/ gright #o10) (* gright #o10)))) + ((eq char ?o) (let ((oright (logand #o1007 from))) + (+ oright (* oright #o10) (* oright #o100)))) (t (error "%c: Bad right character" char)))) (defun file-modes-rights-to-number (rights who-mask &optional from) diff --git a/lisp/international/titdic-cnv.el b/lisp/international/titdic-cnv.el index 080045e752..d2a6ee1e9d 100644 --- a/lisp/international/titdic-cnv.el +++ b/lisp/international/titdic-cnv.el @@ -281,7 +281,7 @@ SPC, 6, 3, 4, or 7 specifying a tone (SPC:陰平, 6:陽平, 3:上聲, 4:去聲, (while (not (eobp)) (let ((ch (following-char)) (pos (point))) - (cond ((= ch ?C) ; COMMENT + (cond ((eq ch ?C) ; COMMENT (cond ((looking-at "COMMENT") (let ((pos (match-end 0)) (to (progn (end-of-line) (point)))) @@ -295,7 +295,7 @@ SPC, 6, 3, 4, or 7 specifying a tone (SPC:陰平, 6:陽平, 3:上聲, 4:去聲, (setq tit-comments (cons (buffer-substring-no-properties pos (point)) tit-comments)))))) - ((= ch ?M) ; MULTICHOICE, MOVERIGHT, MOVELEFT + ((eq ch ?M) ; MULTICHOICE, MOVERIGHT, MOVELEFT (cond ((looking-at "MULTICHOICE:[ \t]*") (goto-char (match-end 0)) (setq tit-multichoice (looking-at "YES"))) @@ -305,7 +305,7 @@ SPC, 6, 3, 4, or 7 specifying a tone (SPC:陰平, 6:陽平, 3:上聲, 4:去聲, ((looking-at "MOVELEFT:[ \t]*") (goto-char (match-end 0)) (setq tit-moveleft (tit-read-key-value))))) - ((= ch ?P) ; PROMPT + ((eq ch ?P) ; PROMPT (cond ((looking-at "PROMPT:[ \t]*") (goto-char (match-end 0)) (setq tit-prompt (tit-read-key-value)) @@ -316,7 +316,7 @@ SPC, 6, 3, 4, or 7 specifying a tone (SPC:陰平, 6:陽平, 3:上聲, 4:去聲, (if (or (eq (nth 1 split) 32) (eq (nth 2 split) 32)) (setq tit-prompt (substring tit-prompt 0 -1))))))) - ((= ch ?B) ; BACKSPACE, BEGINDICTIONARY, + ((eq ch ?B) ; BACKSPACE, BEGINDICTIONARY, ; BEGINPHRASE (cond ((looking-at "BACKSPACE:[ \t]*") (goto-char (match-end 0)) @@ -325,7 +325,7 @@ SPC, 6, 3, 4, or 7 specifying a tone (SPC:陰平, 6:陽平, 3:上聲, 4:去聲, (setq tit-dictionary t)) ((looking-at "BEGINPHRASE") (setq tit-dictionary nil)))) - ((= ch ?K) ; KEYPROMPT + ((eq ch ?K) ; KEYPROMPT (cond ((looking-at "KEYPROMPT(\\(.*\\)):[ \t]*") (let ((key-char (match-string 1))) (goto-char (match-end 0)) diff --git a/lisp/language/ethio-util.el b/lisp/language/ethio-util.el index a0159679da..2f76acfe7c 100644 --- a/lisp/language/ethio-util.el +++ b/lisp/language/ethio-util.el @@ -794,15 +794,15 @@ The 2nd and 3rd arguments BEGIN and END specify the region." "This function is deprecated." (interactive "*cInput number: 1. 2. 3. 4. 5.") (cond - ((= arg ?1) + ((eq arg ?1) (insert "")) - ((= arg ?2) + ((eq arg ?2) (insert "")) - ((= arg ?3) + ((eq arg ?3) (insert "")) - ((= arg ?4) + ((eq arg ?4) (insert "")) - ((= arg ?5) + ((eq arg ?5) (insert "")) (t (error "")))) @@ -816,7 +816,7 @@ The 2nd and 3rd arguments BEGIN and END specify the region." "Convert each fidel characters in the current buffer into a fidel-tex command." (interactive) (let ((buffer-read-only nil) - comp ch) + comp) ;; Special treatment for geminated characters. ;; Geminated characters la", etc. change into \geminateG{\laG}, etc. @@ -835,21 +835,22 @@ The 2nd and 3rd arguments BEGIN and END specify the region." ;; Special Ethiopic punctuation. (goto-char (point-min)) (while (re-search-forward "\\ce[».?]\\|«\\ce" nil t) - (cond - ((= (setq ch (preceding-char)) ?\») - (delete-char -1) - (insert "\\rquoteG")) - ((= ch ?.) - (delete-char -1) - (insert "\\dotG")) - ((= ch ??) - (delete-char -1) - (insert "\\qmarkG")) - (t - (forward-char -1) - (delete-char -1) - (insert "\\lquoteG") - (forward-char 1)))) + (let ((ch (preceding-char))) + (cond + ((eq ch ?\») + (delete-char -1) + (insert "\\rquoteG")) + ((eq ch ?.) + (delete-char -1) + (insert "\\dotG")) + ((eq ch ??) + (delete-char -1) + (insert "\\qmarkG")) + (t + (forward-char -1) + (delete-char -1) + (insert "\\lquoteG") + (forward-char 1))))) ;; Ethiopic characters to TeX macros (robin-invert-region (point-min) (point-max) "ethiopic-tex") diff --git a/lisp/language/lao.el b/lisp/language/lao.el index 1861eff15e..0ad5b9f84e 100644 --- a/lisp/language/lao.el +++ b/lisp/language/lao.el @@ -60,9 +60,9 @@ (len (length chars)) ;; Replace `c', `t', `v' to consonant, tone, and vowel. (regexp (mapconcat (lambda (c) - (cond ((= c ?c) consonant) - ((= c ?t) tone) - ((= c ?v) vowel-upper-lower) + (cond ((eq c ?c) consonant) + ((eq c ?t) tone) + ((eq c ?v) vowel-upper-lower) (t (string c)))) (cdr l) "")) ;; Element of composition-function-table. commit 3ad2adc48c700a8c15459f623081c32420f0b726 Author: Mattias Engdegård Date: Wed Sep 14 19:19:08 2022 +0200 Simplify and shrink reader buffers A big on-stack buffer in a potentially long-running function can interact badly with the GC's conservative scanning of the C stack. It may make the scanning slower (since the stack frame is big) and risks accidental retention of objects from stack detritus (because the buffer isn't cleaned on entry). * src/lread.c (stackbufsize): Remove. (read_integer, read_string_literal, read_bool_vector): Use a local buffer instead of piggy-backing on that in read0. (read0): Reduce buffer to something suitable for most identifiers and numbers. diff --git a/src/lread.c b/src/lread.c index d64a4fad3a..51cbf811ba 100644 --- a/src/lread.c +++ b/src/lread.c @@ -2914,20 +2914,17 @@ invalid_radix_integer (EMACS_INT radix, Lisp_Object readcharfun) invalid_syntax (buf, readcharfun); } -/* Size of the fixed-size buffer used during reading. */ -enum { stackbufsize = 1024 }; - /* Read an integer in radix RADIX using READCHARFUN to read - characters. RADIX must be in the interval [2..36]. Use STACKBUF - for temporary storage as needed. Value is the integer read. + characters. RADIX must be in the interval [2..36]. + Value is the integer read. Signal an error if encountering invalid read syntax. */ static Lisp_Object -read_integer (Lisp_Object readcharfun, int radix, - char stackbuf[VLA_ELEMS (stackbufsize)]) +read_integer (Lisp_Object readcharfun, int radix) { + char stackbuf[20]; char *read_buffer = stackbuf; - ptrdiff_t read_buffer_size = stackbufsize; + ptrdiff_t read_buffer_size = sizeof stackbuf; char *p = read_buffer; char *heapbuf = NULL; int valid = -1; /* 1 if valid, 0 if not, -1 if incomplete. */ @@ -3028,11 +3025,11 @@ read_char_literal (Lisp_Object readcharfun) /* Read a string literal (preceded by '"'). */ static Lisp_Object -read_string_literal (char stackbuf[VLA_ELEMS (stackbufsize)], - Lisp_Object readcharfun) +read_string_literal (Lisp_Object readcharfun) { + char stackbuf[1024]; char *read_buffer = stackbuf; - ptrdiff_t read_buffer_size = stackbufsize; + ptrdiff_t read_buffer_size = sizeof stackbuf; specpdl_ref count = SPECPDL_INDEX (); char *heapbuf = NULL; char *p = read_buffer; @@ -3355,8 +3352,7 @@ string_props_from_rev_list (Lisp_Object elems, Lisp_Object readcharfun) /* Read a bool vector (preceded by "#&"). */ static Lisp_Object -read_bool_vector (char stackbuf[VLA_ELEMS (stackbufsize)], - Lisp_Object readcharfun) +read_bool_vector (Lisp_Object readcharfun) { ptrdiff_t length = 0; for (;;) @@ -3374,7 +3370,7 @@ read_bool_vector (char stackbuf[VLA_ELEMS (stackbufsize)], } ptrdiff_t size_in_chars = bool_vector_bytes (length); - Lisp_Object str = read_string_literal (stackbuf, readcharfun); + Lisp_Object str = read_string_literal (readcharfun); if (STRING_MULTIBYTE (str) || !(size_in_chars == SCHARS (str) /* We used to print 1 char too many when the number of bits @@ -3696,7 +3692,7 @@ read_stack_reset (intmax_t sp) static Lisp_Object read0 (Lisp_Object readcharfun, bool locate_syms) { - char stackbuf[stackbufsize]; + char stackbuf[64]; char *read_buffer = stackbuf; ptrdiff_t read_buffer_size = sizeof stackbuf; char *heapbuf = NULL; @@ -3893,7 +3889,7 @@ read0 (Lisp_Object readcharfun, bool locate_syms) case '&': /* #&N"..." -- bool-vector */ - obj = read_bool_vector (stackbuf, readcharfun); + obj = read_bool_vector (readcharfun); break; case '!': @@ -3909,17 +3905,17 @@ read0 (Lisp_Object readcharfun, bool locate_syms) case 'x': case 'X': - obj = read_integer (readcharfun, 16, stackbuf); + obj = read_integer (readcharfun, 16); break; case 'o': case 'O': - obj = read_integer (readcharfun, 8, stackbuf); + obj = read_integer (readcharfun, 8); break; case 'b': case 'B': - obj = read_integer (readcharfun, 2, stackbuf); + obj = read_integer (readcharfun, 2); break; case '@': @@ -3988,7 +3984,7 @@ read0 (Lisp_Object readcharfun, bool locate_syms) /* #NrDIGITS -- radix-N number */ if (n < 0 || n > 36) invalid_radix_integer (n, readcharfun); - obj = read_integer (readcharfun, n, stackbuf); + obj = read_integer (readcharfun, n); break; } else if (n <= MOST_POSITIVE_FIXNUM && !NILP (Vread_circle)) @@ -4043,7 +4039,7 @@ read0 (Lisp_Object readcharfun, bool locate_syms) break; case '"': - obj = read_string_literal (stackbuf, readcharfun); + obj = read_string_literal (readcharfun); break; case '\'': commit f941cc76df7476a055350b3b1b7e9e61d1ddb246 Author: Mattias Engdegård Date: Wed Sep 14 18:46:40 2022 +0200 mapconcat fast path with `identity` function argument This makes (mapconcat #'identity SEQ) slightly faster than (apply #'concat SEQ), which used to be much faster. Notably, `string-join` benefits from this change as it uses mapconcat. * src/fns.c (Fmapconcat): Speed up execution when the function argument is `identity`. diff --git a/src/fns.c b/src/fns.c index 2f4808be3d..9dd10fe443 100644 --- a/src/fns.c +++ b/src/fns.c @@ -2930,15 +2930,37 @@ FUNCTION must be a function of one argument, and must return a value return empty_unibyte_string; Lisp_Object *args; SAFE_ALLOCA_LISP (args, args_alloc); + if (EQ (function, Qidentity)) + { + /* Fast path when no function call is necessary. */ + if (CONSP (sequence)) + { + Lisp_Object src = sequence; + Lisp_Object *dst = args; + do + { + *dst++ = XCAR (src); + src = XCDR (src); + } + while (!NILP (src)); + goto concat; + } + else if (VECTORP (sequence)) + { + memcpy (args, XVECTOR (sequence)->contents, leni * sizeof *args); + goto concat; + } + } ptrdiff_t nmapped = mapcar1 (leni, args, function, sequence); - ptrdiff_t nargs = 2 * nmapped - 1; eassert (nmapped == leni); + concat: ; + ptrdiff_t nargs = args_alloc; if (NILP (separator) || (STRINGP (separator) && SCHARS (separator) == 0)) - nargs = nmapped; + nargs = leni; else { - for (ptrdiff_t i = nmapped - 1; i > 0; i--) + for (ptrdiff_t i = leni - 1; i > 0; i--) args[i + i] = args[i]; for (ptrdiff_t i = 1; i < nargs; i += 2) commit 429e61b130232e69531f7d44b2bc610d43c8217d Author: Po Lu Date: Thu Sep 15 15:30:32 2022 +0800 More fixes for XDND proxy support * src/xterm.c (handle_one_xevent): Check replies against toplevel, not proxy. diff --git a/src/xterm.c b/src/xterm.c index 96d25b2643..4c3b812817 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -17676,7 +17676,7 @@ handle_one_xevent (struct x_display_info *dpyinfo, if (x_dnd_last_protocol_version != -1 && x_dnd_in_progress - && target == x_dnd_last_seen_window + && target == x_dnd_last_seen_toplevel /* The XDND documentation is not very clearly worded. But this should be the correct behavior, since "kDNDStatusSendHereFlag" in the reference @@ -20377,7 +20377,7 @@ handle_one_xevent (struct x_display_info *dpyinfo, else if (x_dnd_last_seen_window != None && x_dnd_last_protocol_version != -1) { - x_dnd_pending_finish_target = x_dnd_last_seen_window; + x_dnd_pending_finish_target = x_dnd_last_seen_toplevel; x_dnd_waiting_for_finish_proto = x_dnd_last_protocol_version; x_dnd_waiting_for_finish @@ -21914,7 +21914,7 @@ handle_one_xevent (struct x_display_info *dpyinfo, else if (x_dnd_last_seen_window != None && x_dnd_last_protocol_version != -1) { - x_dnd_pending_finish_target = x_dnd_last_seen_window; + x_dnd_pending_finish_target = x_dnd_last_seen_toplevel; x_dnd_waiting_for_finish_proto = x_dnd_last_protocol_version; x_dnd_waiting_for_finish commit 1ccfd3bae2dffe5cf33202eb4479f4daf722b265 Author: Stefan Kangas Date: Thu Sep 15 09:17:30 2022 +0200 Use substitute-command-keys in proced-help * lisp/proced.el (proced-help-string, proced-help): Use substitute-command-keys. diff --git a/lisp/proced.el b/lisp/proced.el index c278cce9dc..0f0937cac8 100644 --- a/lisp/proced.el +++ b/lisp/proced.el @@ -426,7 +426,14 @@ Important: the match ends just after the marker.") "Name of Proced Log buffer.") (defconst proced-help-string - "(n)ext, (p)revious, (m)ark, (u)nmark, (k)ill, (q)uit (type ? for more help)" + (concat "\\ " + "\\[next-line] next, " + "\\[previous-line] previous, " + "\\[proced-mark] mark, " + "\\[proced-unmark] unmark, " + "\\[proced-send-signal] kill, " + "\\[quit-window] quit " + "(type \\[proced-help] for more help)") "Help string for Proced.") (defconst proced-header-help-echo @@ -1978,7 +1985,7 @@ STRING is an overall summary of the failures." (proced-why) (if (eq last-command 'proced-help) (describe-mode) - (message proced-help-string))) + (message (substitute-command-keys proced-help-string)))) (defun proced-undo () "Undo in a Proced buffer.