commit f56408a6f0152cd46d1ea8a0985fbfeeb839ea06 (HEAD, refs/remotes/origin/master) Author: Mattias Engdegård Date: Tue Oct 26 10:10:02 2021 +0200 * lisp/progmodes/xref.el (xref-pop-marker-stack): Don't obsolete. diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el index 26188bbdda..f2fc0479aa 100644 --- a/lisp/progmodes/xref.el +++ b/lisp/progmodes/xref.el @@ -432,7 +432,7 @@ The future stack is erased." (setcdr xref--history nil)) ;;;###autoload -(define-obsolete-function-alias 'xref-pop-marker-stack #'xref-go-back "29.1") +(defalias 'xref-pop-marker-stack #'xref-go-back) ;;;###autoload (defun xref-go-back () commit ef86025bcdeb9a96b36f876e35081e41bf32917c Author: Mattias Engdegård Date: Tue Oct 26 10:04:24 2021 +0200 ; * test/lisp/progmodes/elisp-mode-tests.el: repair test failure The test used an internal variable that has been renamed; use the new name. (Any variable would do here.) diff --git a/test/lisp/progmodes/elisp-mode-tests.el b/test/lisp/progmodes/elisp-mode-tests.el index 8a3669c427..9516687f5b 100644 --- a/test/lisp/progmodes/elisp-mode-tests.el +++ b/test/lisp/progmodes/elisp-mode-tests.el @@ -782,11 +782,11 @@ to (xref-elisp-test-descr-to-target xref)." )) (xref-elisp-deftest find-defs-defvar-el - (elisp--xref-find-definitions 'xref--marker-ring) + (elisp--xref-find-definitions 'xref--history) (list - (xref-make "(defvar xref--marker-ring)" + (xref-make "(defvar xref--history)" (xref-make-elisp-location - 'xref--marker-ring 'defvar + 'xref--history 'defvar (expand-file-name "../../../lisp/progmodes/xref.el" emacs-test-dir))) )) commit d8caa3d9fbd90de41efacfeb23c242df81c62bd0 Author: Mattias Engdegård Date: Mon Oct 25 20:38:31 2021 +0200 Rename `xref-pop-marker-stack` to `xref-go-back` (bug#38797) It is the natural name after the addition of `xref-go-forward`. The old name is retained as an alias. * lisp/progmodes/xref.el (xref-pop-marker-stack): Rename. (xref-go-forward, xref-quit-and-pop-marker-stack) (xref-find-definitions): * lisp/menu-bar.el (menu-bar-goto-menu): * lisp/progmodes/etags.el (find-tag-marker-ring, pop-tag-mark): * lisp/progmodes/prog-mode.el (prog-context-menu): * doc/emacs/maintaining.texi (Looking Up Identifiers): * etc/NEWS: Use the new name. diff --git a/doc/emacs/maintaining.texi b/doc/emacs/maintaining.texi index e28ec5fb43..9a90a0054d 100644 --- a/doc/emacs/maintaining.texi +++ b/doc/emacs/maintaining.texi @@ -2139,7 +2139,7 @@ Find definition of identifier, and display it in a new frame Find definition of identifier at mouse click. @item M-, Go back to where you previously invoked @kbd{M-.} and friends -(@code{xref-pop-marker-stack}). +(@code{xref-go-back}). @item C-M-, Go forward to where you previously invoked @kbd{M-,} (@code{xref-go-forward}). @@ -2207,9 +2207,9 @@ selects the window showing the first candidate. The default value is buffer, but doesn't select any of them. @kindex M-, -@findex xref-pop-marker-stack +@findex xref-go-back To go back to places @emph{from where} you've displayed the definition, -use @kbd{M-,} (@code{xref-pop-marker-stack}). It jumps back to the +use @kbd{M-,} (@code{xref-go-back}). It jumps back to the point of the last invocation of @kbd{M-.}. Thus you can find and examine the definition of something with @kbd{M-.} and then return to where you were with @kbd{M-,}. diff --git a/etc/NEWS b/etc/NEWS index 2d5276dbd6..6d3256959e 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -185,8 +185,8 @@ a prefix argument which is interpreted to mean "include all files". +++ *** New command 'xref-go-forward'. -It is bound to 'C-M-,' and jumps to the location where 'xref-pop-marker-stack' -was invoked previously. +It is bound to 'C-M-,' and jumps to the location where 'xref-go-back' +('M-,', also known as 'xref-pop-marker-stack') was invoked previously. ** File notifications diff --git a/lisp/menu-bar.el b/lisp/menu-bar.el index d986e3cc92..1a81f1a3d0 100644 --- a/lisp/menu-bar.el +++ b/lisp/menu-bar.el @@ -420,7 +420,7 @@ :help "Forward to the position gone Back from")) (bindings--define-key menu [xref-pop] - '(menu-item "Back" xref-pop-marker-stack + '(menu-item "Back" xref-go-back :visible (and (featurep 'xref) (not (xref-marker-stack-empty-p))) :help "Back to the position of the last search")) diff --git a/lisp/progmodes/etags.el b/lisp/progmodes/etags.el index 318121fbb5..d833612cd9 100644 --- a/lisp/progmodes/etags.el +++ b/lisp/progmodes/etags.el @@ -186,7 +186,7 @@ Example value: (defvar find-tag-marker-ring (make-ring 16)) (make-obsolete-variable 'find-tag-marker-ring - "use `xref-push-marker-stack' or `xref-pop-marker-stack' instead." + "use `xref-push-marker-stack' or `xref-go-back' instead." "25.1") (defvar default-tags-table-function nil @@ -1071,7 +1071,7 @@ See documentation of variable `tags-file-name'." regexp next-p t)) ;;;###autoload -(defalias 'pop-tag-mark 'xref-pop-marker-stack) +(defalias 'pop-tag-mark 'xref-go-back) (defvar tag-lines-already-matched nil diff --git a/lisp/progmodes/prog-mode.el b/lisp/progmodes/prog-mode.el index 4f15686dc8..e078c799fa 100644 --- a/lisp/progmodes/prog-mode.el +++ b/lisp/progmodes/prog-mode.el @@ -51,7 +51,7 @@ (unless (xref-marker-stack-empty-p) (define-key-after menu [xref-pop] - '(menu-item "Back Definition" xref-pop-marker-stack + '(menu-item "Back Definition" xref-go-back :help "Back to the position of the last search") 'prog-separator)) diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el index 66ac89e72f..26188bbdda 100644 --- a/lisp/progmodes/xref.el +++ b/lisp/progmodes/xref.el @@ -432,7 +432,10 @@ The future stack is erased." (setcdr xref--history nil)) ;;;###autoload -(defun xref-pop-marker-stack () +(define-obsolete-function-alias 'xref-pop-marker-stack #'xref-go-back "29.1") + +;;;###autoload +(defun xref-go-back () "Go back to the previous position in xref history. To undo, use \\[xref-go-forward]." (interactive) @@ -445,11 +448,10 @@ To undo, use \\[xref-go-forward]." (goto-char (marker-position marker)) (set-marker marker nil nil) (run-hooks 'xref-after-return-hook)))) -;; FIXME: rename to `xref-go-back'. ;;;###autoload (defun xref-go-forward () - "Got to the point where a previous \\[xref-pop-marker-stack] was invoked." + "Got to the point where a previous \\[xref-go-back] was invoked." (interactive) (if (null (cdr xref--history)) (user-error "At end of xref history") @@ -708,7 +710,7 @@ quit the *xref* buffer." "Quit *xref* buffer, then pop the xref marker stack." (interactive) (quit-window) - (xref-pop-marker-stack)) + (xref-go-back)) (defun xref-query-replace-in-results (from to) "Perform interactive replacement of FROM with TO in all displayed xrefs. @@ -1418,7 +1420,7 @@ definition for IDENTIFIER, display it in the selected window. Otherwise, display the list of the possible definitions in a buffer where the user can select from the list. -Use \\[xref-pop-marker-stack] to return back to where you invoked this command." +Use \\[xref-go-back] to return back to where you invoked this command." (interactive (list (xref--read-identifier "Find definitions of: "))) (xref--find-definitions identifier nil)) @@ -1509,10 +1511,10 @@ output of this command when the backend is etags." ;;; Key bindings ;;;###autoload (define-key esc-map "." #'xref-find-definitions) -;;;###autoload (define-key esc-map "," #'xref-pop-marker-stack) +;;;###autoload (define-key esc-map "," #'xref-go-back) +;;;###autoload (define-key esc-map [?\C-,] #'xref-go-forward) ;;;###autoload (define-key esc-map "?" #'xref-find-references) ;;;###autoload (define-key esc-map [?\C-.] #'xref-find-apropos) -;;;###autoload (define-key esc-map [?\C-,] #'xref-go-forward) ;;;###autoload (define-key ctl-x-4-map "." #'xref-find-definitions-other-window) ;;;###autoload (define-key ctl-x-5-map "." #'xref-find-definitions-other-frame) commit e97d4e4ab216acf2bf7395a0d5137dacd9b390f8 Author: Mattias Engdegård Date: Mon Oct 25 20:21:25 2021 +0200 ; * lisp/menu-bar.el (menu-bar-goto-menu): Adjust new item position diff --git a/lisp/menu-bar.el b/lisp/menu-bar.el index d1bb8d9677..d986e3cc92 100644 --- a/lisp/menu-bar.el +++ b/lisp/menu-bar.el @@ -413,18 +413,18 @@ (bindings--define-key menu [separator-tag-file] '(menu-item "--" nil :visible (menu-bar-goto-uses-etags-p))) - (bindings--define-key menu [xref-pop] - '(menu-item "Back" xref-pop-marker-stack - :visible (and (featurep 'xref) - (not (xref-marker-stack-empty-p))) - :help "Back to the position of the last search")) - (bindings--define-key menu [xref-forward] '(menu-item "Forward" xref-go-forward :visible (and (featurep 'xref) (not (xref-forward-history-empty-p))) :help "Forward to the position gone Back from")) + (bindings--define-key menu [xref-pop] + '(menu-item "Back" xref-pop-marker-stack + :visible (and (featurep 'xref) + (not (xref-marker-stack-empty-p))) + :help "Back to the position of the last search")) + (bindings--define-key menu [xref-apropos] '(menu-item "Find Apropos..." xref-find-apropos :help "Find function/variables whose names match regexp")) commit e73b8ae86f09b34a65086641d693aea78e42fb25 Author: Eric Abrahamsen Date: Mon Oct 25 09:39:52 2021 -0700 IMAP search should only use charset utf-8 with multibyte strings Background: Exchange servers cannot accept "charset utf-8" search strings. The code originally set that charset for any server with literal+ capability, borking all searches on an Exchange server. This code only sets utf-8 for multibyte search strings in particular, which would be borken for Exchange anyway. * lisp/gnus/gnus-search.el (gnus-search-imap-search-command): Ensure we're only doing the literal+ dance for multibyte strings (multibyte strings will have had newlines inserted in an earlier step). diff --git a/lisp/gnus/gnus-search.el b/lisp/gnus/gnus-search.el index 9c83d5fa37..3157358804 100644 --- a/lisp/gnus/gnus-search.el +++ b/lisp/gnus/gnus-search.el @@ -1084,7 +1084,8 @@ Responsible for handling and, or, and parenthetical expressions.") Currently takes into account support for the LITERAL+ capability. Other capabilities could be tested here." (with-slots (literal-plus) engine - (when literal-plus + (when (and literal-plus + (string-match-p "\n" query)) (setq query (split-string query "\n"))) (cond ((consp query) commit 33785495722f9f75cf50f7beabda8859399403d9 Merge: 8d0f7e717b a2c17e115e Author: Glenn Morris Date: Mon Oct 25 09:34:37 2021 -0700 Merge from origin/emacs-28 a2c17e115e (origin/emacs-28) Merge branch 'emacs-28' of git.savannah.... fde56eeb76 Revert "Fix a typo in emacs-lisp-intro.texi" 4779d3ba19 * doc/lispref/functions.texi (Mapping Functions): Use #' w... 85ea3f7f47 Fix issue with interpreting ANSI codes in eshell 50f9436146 image-dired: Doc fix to better explain thumbnail generation bb475e10b9 Clarify two image-dired docstrings f5b4bb4a6f Fix flymake example backend conditions in the manual 0771d8939a * etc/PROBLEMS: Mention problems with regexp matcher. (Bu... ee579033b9 * test/lisp/repeat-tests.el: New file. 7385a7667f * lisp/tab-bar.el (tab-bar-move-repeat-map): Fix alias bin... 56caf1c9b8 Use restrictive umask when creating image-dired data 3b5de7f991 ; lisp/transient.el: Revert some misguided stylistic fixes. commit 8d0f7e717b1491215917e8c46beae91d2849ada7 Merge: f2dfe1e780 3f763898aa Author: Glenn Morris Date: Mon Oct 25 09:34:37 2021 -0700 ; Merge from origin/emacs-28 The following commit was skipped: 3f763898aa Fix compilation errors with MinGW64 GCC 11 commit f2dfe1e780f0a779f50650fcf457b33031fa9584 Merge: d1e4d89b32 817c929eda Author: Glenn Morris Date: Mon Oct 25 09:34:37 2021 -0700 Merge from origin/emacs-28 817c929eda Doc fix for concat 3eca2ad2a1 * lisp/image-dired.el (image-dired-external-viewer): Suppo... commit d1e4d89b325af255644cb030ba9e5bdae7c2d69c Author: Glenn Morris Date: Mon Oct 25 17:33:11 2021 +0100 * doc/misc/cc-mode.texi (Font Locking): Fix menu. diff --git a/doc/misc/cc-mode.texi b/doc/misc/cc-mode.texi index c255d9870f..a2ff572a3f 100644 --- a/doc/misc/cc-mode.texi +++ b/doc/misc/cc-mode.texi @@ -1857,6 +1857,7 @@ sections apply to the other languages. * Faces:: * Doc Comments:: * Wrong Comment Style:: +* Found Types:: * Misc Font Locking:: * AWK Mode Font Locking:: @end menu commit a2c17e115eea1ac026e80bce023c1f8587228c90 Merge: fde56eeb76 4779d3ba19 Author: Eli Zaretskii Date: Mon Oct 25 19:19:55 2021 +0300 Merge branch 'emacs-28' of git.savannah.gnu.org:/srv/git/emacs into emacs-28 commit fde56eeb764dd20267187b225c2a0d27c795f0dd Author: Eli Zaretskii Date: Mon Oct 25 19:11:06 2021 +0300 Revert "Fix a typo in emacs-lisp-intro.texi" This reverts commit 98eb6d783a482cd7ebca7ec656b0775b82c68e57. I've consulted with Richard Stallman about this, and he says that the original wording, "kinds of atom", is both correct and more elegant writing. So I'm restoring the original text. * doc/lispintro/emacs-lisp-intro.texi (Lisp Atoms): Undo the fix of a "typo" that wasn't a typo. (Bug#51271) diff --git a/doc/lispintro/emacs-lisp-intro.texi b/doc/lispintro/emacs-lisp-intro.texi index 3897e5a062..6ecd552ebb 100644 --- a/doc/lispintro/emacs-lisp-intro.texi +++ b/doc/lispintro/emacs-lisp-intro.texi @@ -1177,7 +1177,7 @@ are different from the meaning the letters make as a word. For example, the word for the South American sloth, the @samp{ai}, is completely different from the two words, @samp{a}, and @samp{i}. -There are many kinds of atoms in nature but only a few in Lisp: for +There are many kinds of atom in nature but only a few in Lisp: for example, @dfn{numbers}, such as 37, 511, or 1729, and @dfn{symbols}, such as @samp{+}, @samp{foo}, or @samp{forward-line}. The words we have listed in the examples above are all symbols. In everyday Lisp commit d53bf7e5b4b0ba0ed5832cabf51e2d27b2e9af4d Author: Lars Ingebrigtsen Date: Mon Oct 25 17:41:52 2021 +0200 Add the "always" zsh builtin to zsh mode * lisp/progmodes/sh-script.el (sh-builtins): Add the "always" zsh keyword (bug#51387). diff --git a/lisp/progmodes/sh-script.el b/lisp/progmodes/sh-script.el index 0dd9f2b4fa..c6b6f83471 100644 --- a/lisp/progmodes/sh-script.el +++ b/lisp/progmodes/sh-script.el @@ -628,7 +628,8 @@ removed when closing the here document." (wksh sh-append ksh88) (zsh sh-append ksh88 - "autoload" "bindkey" "builtin" "chdir" "compctl" "declare" "dirs" + "autoload" "always" + "bindkey" "builtin" "chdir" "compctl" "declare" "dirs" "disable" "disown" "echotc" "enable" "functions" "getln" "hash" "history" "integer" "limit" "local" "log" "popd" "pushd" "r" "readonly" "rehash" "sched" "setopt" "source" "suspend" "true" commit 65b34f688c63649a0870dab603c569c1e20007cb Author: Mattias Engdegård Date: Tue Oct 19 13:26:19 2021 +0200 Add xref forward history (bug#38797) Make it possible to go forward as well as back in the Xref history. The new `xref-go-forward` is bound to `C-M-,`. * lisp/progmodes/etags.el (find-tag-marker-ring-length): Update. (tags-location-ring-length): New. (find-tag-marker-ring): Keep as dummy. (tags-location-ring, tags-reset-tags-tables): Use `tags-location-ring-length` instead of `xref-marker-ring-length`. * lisp/progmodes/xref.el (xref-marker-ring-length, xref-marker-ring) (xref-set-marker-ring-length): Make obsolete. (xref--history, xref-go-forward, xref-forward-history-empty-p): New. (xref-push-marker-stack, xref-pop-marker-stack) (xref-clear-marker-stack, xref-marker-stack-empty-p): Use `xref--history`. * lisp/menu-bar.el (menu-bar-goto-menu): Add Forward entry. * doc/emacs/maintaining.texi (Looking Up Identifiers): Document. * etc/NEWS: Announce. diff --git a/doc/emacs/maintaining.texi b/doc/emacs/maintaining.texi index 5b66031b8a..e28ec5fb43 100644 --- a/doc/emacs/maintaining.texi +++ b/doc/emacs/maintaining.texi @@ -2140,6 +2140,9 @@ Find definition of identifier at mouse click. @item M-, Go back to where you previously invoked @kbd{M-.} and friends (@code{xref-pop-marker-stack}). +@item C-M-, +Go forward to where you previously invoked @kbd{M-,} +(@code{xref-go-forward}). @item M-x xref-etags-mode Switch @code{xref} to use the @code{etags} backend. @end table @@ -2205,14 +2208,16 @@ buffer, but doesn't select any of them. @kindex M-, @findex xref-pop-marker-stack -@vindex xref-marker-ring-length To go back to places @emph{from where} you've displayed the definition, use @kbd{M-,} (@code{xref-pop-marker-stack}). It jumps back to the point of the last invocation of @kbd{M-.}. Thus you can find and examine the definition of something with @kbd{M-.} and then return to -where you were with @kbd{M-,}. @kbd{M-,} allows you to retrace your -steps to a depth determined by the variable -@code{xref-marker-ring-length}, which defaults to 16. +where you were with @kbd{M-,}. + +@kindex C-M-, +@findex xref-go-forward + Go forward to a place from where you previously went back using @kbd{M-,}. +This is useful if you find that you went back too far. @findex xref-etags-mode Some major modes install @code{xref} support facilities that might diff --git a/etc/NEWS b/etc/NEWS index 90ad8d3a46..2d5276dbd6 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -183,6 +183,11 @@ it with new 'term-{faint,italic,slow-blink,fast-blink}' faces. *** 'project-find-file' and 'project-or-external-find-file' now accept a prefix argument which is interpreted to mean "include all files". ++++ +*** New command 'xref-go-forward'. +It is bound to 'C-M-,' and jumps to the location where 'xref-pop-marker-stack' +was invoked previously. + ** File notifications +++ diff --git a/lisp/menu-bar.el b/lisp/menu-bar.el index fafc99eb95..d1bb8d9677 100644 --- a/lisp/menu-bar.el +++ b/lisp/menu-bar.el @@ -419,6 +419,12 @@ (not (xref-marker-stack-empty-p))) :help "Back to the position of the last search")) + (bindings--define-key menu [xref-forward] + '(menu-item "Forward" xref-go-forward + :visible (and (featurep 'xref) + (not (xref-forward-history-empty-p))) + :help "Forward to the position gone Back from")) + (bindings--define-key menu [xref-apropos] '(menu-item "Find Apropos..." xref-find-apropos :help "Find function/variables whose names match regexp")) diff --git a/lisp/progmodes/etags.el b/lisp/progmodes/etags.el index d2ce813daa..318121fbb5 100644 --- a/lisp/progmodes/etags.el +++ b/lisp/progmodes/etags.el @@ -145,7 +145,9 @@ Otherwise, `find-tag-default' is used." :type '(choice (const nil) function)) (define-obsolete-variable-alias 'find-tag-marker-ring-length - 'xref-marker-ring-length "25.1") + 'tags-location-ring-length "25.1") + +(defvar tags-location-ring-length 16) (defcustom tags-tag-face 'default "Face for tags in the output of `tags-apropos'." @@ -180,7 +182,8 @@ Example value: (sexp :tag "Tags to search"))) :version "21.1") -(defvaralias 'find-tag-marker-ring 'xref--marker-ring) +;; Obsolete variable kept for compatibility. We don't use it in any way. +(defvar find-tag-marker-ring (make-ring 16)) (make-obsolete-variable 'find-tag-marker-ring "use `xref-push-marker-stack' or `xref-pop-marker-stack' instead." @@ -191,7 +194,7 @@ Example value: This function receives no arguments and should return the default tags table file to use for the current buffer.") -(defvar tags-location-ring (make-ring xref-marker-ring-length) +(defvar tags-location-ring (make-ring tags-location-ring-length) "Ring of markers which are locations visited by \\[find-tag]. Pop back to the last location with \\[negative-argument] \\[find-tag].") @@ -731,13 +734,13 @@ Returns t if it visits a tags table, or nil if there are no more in the list." (interactive) ;; Clear out the markers we are throwing away. (let ((i 0)) - (while (< i xref-marker-ring-length) + (while (< i tags-location-ring-length) (if (aref (cddr tags-location-ring) i) (set-marker (aref (cddr tags-location-ring) i) nil)) (setq i (1+ i)))) (xref-clear-marker-stack) (setq tags-file-name nil - tags-location-ring (make-ring xref-marker-ring-length) + tags-location-ring (make-ring tags-location-ring-length) tags-table-list nil tags-table-computed-list nil tags-table-computed-list-for nil diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el index a198ae349e..66ac89e72f 100644 --- a/lisp/progmodes/xref.el +++ b/lisp/progmodes/xref.el @@ -341,15 +341,9 @@ backward." (t (goto-char start) nil)))) -;;; Marker stack (M-. pushes, M-, pops) - -(defcustom xref-marker-ring-length 16 - "Length of the xref marker ring. -If this variable is not set through Customize, you must call -`xref-set-marker-ring-length' for changes to take effect." - :type 'integer - :initialize #'custom-initialize-default - :set #'xref-set-marker-ring-length) +;; Dummy variable retained for compatibility. +(defvar xref-marker-ring-length 16) +(make-obsolete-variable 'xref-marker-ring-length nil "29.1") (defcustom xref-prompt-for-identifier '(not xref-find-definitions xref-find-definitions-other-window @@ -420,29 +414,47 @@ or earlier: it can break `dired-do-find-regexp-and-replace'." :version "28.1" :package-version '(xref . "1.2.0")) -(defvar xref--marker-ring (make-ring xref-marker-ring-length) - "Ring of markers to implement the marker stack.") +(defvar xref--history (cons nil nil) + "(BACKWARD-STACK . FORWARD-STACK) of markers to visited Xref locations.") + +(make-obsolete-variable 'xref-marker-ring nil "29.1") -(defun xref-set-marker-ring-length (var val) - "Set `xref-marker-ring-length'. -VAR is the symbol `xref-marker-ring-length' and VAL is the new -value." - (set-default var val) - (if (ring-p xref--marker-ring) - (ring-resize xref--marker-ring val))) +(defun xref-set-marker-ring-length (_var _val) + (declare (obsolete nil "29.1")) + nil) (defun xref-push-marker-stack (&optional m) - "Add point M (defaults to `point-marker') to the marker stack." - (ring-insert xref--marker-ring (or m (point-marker)))) + "Add point M (defaults to `point-marker') to the marker stack. +The future stack is erased." + (push (or m (point-marker)) (car xref--history)) + (dolist (mk (cdr xref--history)) + (set-marker mk nil nil)) + (setcdr xref--history nil)) ;;;###autoload (defun xref-pop-marker-stack () - "Pop back to where \\[xref-find-definitions] was last invoked." + "Go back to the previous position in xref history. +To undo, use \\[xref-go-forward]." (interactive) - (let ((ring xref--marker-ring)) - (when (ring-empty-p ring) - (user-error "Marker stack is empty")) - (let ((marker (ring-remove ring 0))) + (if (null (car xref--history)) + (user-error "At start of xref history") + (let ((marker (pop (car xref--history)))) + (push (point-marker) (cdr xref--history)) + (switch-to-buffer (or (marker-buffer marker) + (user-error "The marked buffer has been deleted"))) + (goto-char (marker-position marker)) + (set-marker marker nil nil) + (run-hooks 'xref-after-return-hook)))) +;; FIXME: rename to `xref-go-back'. + +;;;###autoload +(defun xref-go-forward () + "Got to the point where a previous \\[xref-pop-marker-stack] was invoked." + (interactive) + (if (null (cdr xref--history)) + (user-error "At end of xref history") + (let ((marker (pop (cdr xref--history)))) + (push (point-marker) (car xref--history)) (switch-to-buffer (or (marker-buffer marker) (user-error "The marked buffer has been deleted"))) (goto-char (marker-position marker)) @@ -465,17 +477,23 @@ value." ;; etags.el needs this (defun xref-clear-marker-stack () - "Discard all markers from the marker stack." - (let ((ring xref--marker-ring)) - (while (not (ring-empty-p ring)) - (let ((marker (ring-remove ring))) - (set-marker marker nil nil))))) + "Discard all markers from the xref history." + (dolist (l (list (car xref--history) (cdr xref--history))) + (dolist (m l) + (set-marker m nil nil))) + (setq xref--history (cons nil nil)) + nil) ;;;###autoload (defun xref-marker-stack-empty-p () - "Return t if the marker stack is empty; nil otherwise." - (ring-empty-p xref--marker-ring)) + "Whether the xref back-history is empty." + (null (car xref--history))) +;; FIXME: rename this to `xref-back-history-empty-p'. +;;;###autoload +(defun xref-forward-history-empty-p () + "Whether the xref forward-history is empty." + (null (cdr xref--history))) (defun xref--goto-char (pos) @@ -1494,6 +1512,7 @@ output of this command when the backend is etags." ;;;###autoload (define-key esc-map "," #'xref-pop-marker-stack) ;;;###autoload (define-key esc-map "?" #'xref-find-references) ;;;###autoload (define-key esc-map [?\C-.] #'xref-find-apropos) +;;;###autoload (define-key esc-map [?\C-,] #'xref-go-forward) ;;;###autoload (define-key ctl-x-4-map "." #'xref-find-definitions-other-window) ;;;###autoload (define-key ctl-x-5-map "." #'xref-find-definitions-other-frame) commit 46941bcc2a996dbc771fe4bf027ce1926126c3ce Author: Lars Ingebrigtsen Date: Mon Oct 25 17:19:32 2021 +0200 Allow viewing .heic images via image-convert * lisp/files.el (auto-mode-alist): Support the Apple .heic/HEIF image format (bug#51381). diff --git a/lisp/files.el b/lisp/files.el index f0cfa2e39b..1d2ef6fde7 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -2977,6 +2977,7 @@ ARC\\|ZIP\\|LZH\\|LHA\\|ZOO\\|[JEW]AR\\|XPI\\|RAR\\|CBR\\|7Z\\|SQUASHFS\\)\\'" . ("\\.dng\\'" . image-mode) ("\\.dpx\\'" . image-mode) ("\\.fax\\'" . image-mode) + ("\\.heic\\'" . image-mode) ("\\.hrz\\'" . image-mode) ("\\.icb\\'" . image-mode) ("\\.icc\\'" . image-mode) commit 9ce0008edd3be96bf1271d770b8e65c56a334b1c Author: Lars Ingebrigtsen Date: Mon Oct 25 17:10:34 2021 +0200 Change the with-delayed-message syntax to allow future extensibility * doc/lispref/display.texi (Progress): Document it. * lisp/subr.el (with-delayed-message): Change the syntax to allow future extensibility. * lisp/net/eww.el (eww-display-html): Use it. diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi index 6f95728e31..cc9ca28bf0 100644 --- a/doc/lispref/display.texi +++ b/doc/lispref/display.texi @@ -561,13 +561,13 @@ You can rewrite the previous example with this macro as follows: @end example @end defmac -@defmac with-delayed-message timeout message body@dots{} +@defmac with-delayed-message (timeout message) body@dots{} Sometimes it's unclear whether an operation will take a long time to execute or not, or it can be inconvenient to implement a progress reporter. This macro can be used in those situations. @lisp -(with-delayed-message 2 (format "Gathering data for %s" entry) +(with-delayed-message (2 (format "Gathering data for %s" entry)) (setq data (gather-data entry))) @end lisp diff --git a/lisp/net/eww.el b/lisp/net/eww.el index e0bc17b5a5..74d3788116 100644 --- a/lisp/net/eww.el +++ b/lisp/net/eww.el @@ -694,7 +694,7 @@ The renaming scheme is performed in accordance with (meta . eww-tag-meta) (a . eww-tag-a))))) (erase-buffer) - (with-delayed-message 2 "Rendering HTML..." + (with-delayed-message (2 "Rendering HTML...") (shr-insert-document document)) (cond (point diff --git a/lisp/subr.el b/lisp/subr.el index 9acc79923c..86460d9da6 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -6723,12 +6723,14 @@ as the variable documentation string. (define-keymap--define (list ,@(nreverse opts) ,@defs)) ,@(and doc (list doc))))) -(defmacro with-delayed-message (timeout message &rest body) +(defmacro with-delayed-message (args &rest body) "Like `progn', but display MESSAGE if BODY takes longer than TIMEOUT seconds. The MESSAGE form will be evaluated immediately, but the resulting -string will be displayed only if BODY takes longer than TIMEOUT seconds." - (declare (indent 2)) - `(funcall-with-delayed-message ,timeout ,message +string will be displayed only if BODY takes longer than TIMEOUT seconds. + +\(fn (timeout message) &rest body)" + (declare (indent 1)) + `(funcall-with-delayed-message ,(car args) ,(cadr args) (lambda () ,@body))) commit 8c73e6b0f9acd315a946e01ceb82f86a70b1aeac Author: Lars Ingebrigtsen Date: Mon Oct 25 16:49:48 2021 +0200 Heed the EMACS_IGNORE_TIMERFD environment variable * src/emacs.c (main): Call init_atimer after setting up the environment so that the EMACS_IGNORE_TIMERFD environment variable is actually heeded. diff --git a/src/emacs.c b/src/emacs.c index a24543a586..032b27fcf3 100644 --- a/src/emacs.c +++ b/src/emacs.c @@ -1872,7 +1872,6 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem init_bignum (); init_threads (); init_eval (); - init_atimer (); running_asynch_code = 0; init_random (); @@ -2034,6 +2033,9 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem if (!will_dump_p ()) set_initial_environment (); + /* Has to run after the environment is set up. */ + init_atimer (); + #ifdef WINDOWSNT globals_of_w32 (); #ifdef HAVE_W32NOTIFY commit 4779d3ba193174cac02ddae4daed621dac3fd782 Author: Robert Pluim Date: Mon Oct 25 15:34:48 2021 +0200 * doc/lispref/functions.texi (Mapping Functions): Use #' when mapping. diff --git a/doc/lispref/functions.texi b/doc/lispref/functions.texi index 91118b7ae0..cb14d02d44 100644 --- a/doc/lispref/functions.texi +++ b/doc/lispref/functions.texi @@ -910,11 +910,11 @@ length of @var{sequence}. For example: @example @group -(mapcar 'car '((a b) (c d) (e f))) +(mapcar #'car '((a b) (c d) (e f))) @result{} (a c e) -(mapcar '1+ [1 2 3]) +(mapcar #'1+ [1 2 3]) @result{} (2 3 4) -(mapcar 'string "abc") +(mapcar #'string "abc") @result{} ("a" "b" "c") @end group @@ -930,14 +930,14 @@ Return the list of results." ;; @r{If no list is exhausted,} (if (not (memq nil args)) ;; @r{apply function to @sc{car}s.} - (cons (apply function (mapcar 'car args)) - (apply 'mapcar* function + (cons (apply function (mapcar #'car args)) + (apply #'mapcar* function ;; @r{Recurse for rest of elements.} - (mapcar 'cdr args))))) + (mapcar #'cdr args))))) @end group @group -(mapcar* 'cons '(a b c) '(1 2 3 4)) +(mapcar* #'cons '(a b c) '(1 2 3 4)) @result{} ((a . 1) (b . 2) (c . 3)) @end group @end example @@ -954,10 +954,10 @@ the results (which must be lists), by altering the results (using @example @group ;; @r{Contrast this:} -(mapcar 'list '(a b c d)) +(mapcar #'list '(a b c d)) @result{} ((a) (b) (c) (d)) ;; @r{with this:} -(mapcan 'list '(a b c d)) +(mapcan #'list '(a b c d)) @result{} (a b c d) @end group @end example @@ -986,7 +986,7 @@ string. @example @group -(mapconcat 'symbol-name +(mapconcat #'symbol-name '(The cat in the hat) " ") @result{} "The cat in the hat" commit 85ea3f7f47ef1a767aa2954be896d4aaef3163c6 Author: Miha Rihtaršič Date: Mon Oct 25 15:24:29 2021 +0200 Fix issue with interpreting ANSI codes in eshell * lisp/eshell/esh-mode.el (eshell-mode): Make window point advance on insertion. (eshell-output-filter): Don't use insert-before-markers (bug#45380). diff --git a/lisp/eshell/esh-mode.el b/lisp/eshell/esh-mode.el index 98e89037f3..8e6506c301 100644 --- a/lisp/eshell/esh-mode.el +++ b/lisp/eshell/esh-mode.el @@ -315,6 +315,8 @@ and the hook `eshell-exit-hook'." (setq-local bookmark-make-record-function #'eshell-bookmark-make-record) (setq local-abbrev-table eshell-mode-abbrev-table) + (setq-local window-point-insertion-type t) + (setq-local list-buffers-directory (expand-file-name default-directory)) ;; always set the tab width to 8 in Eshell buffers, since external @@ -696,13 +698,10 @@ This is done after all necessary filtering has been done." (setq oend (+ oend nchars))) ;; Let the ansi-color overlay hooks run. (let ((inhibit-modification-hooks nil)) - (insert-before-markers string)) + (insert string)) (if (= (window-start) (point)) (set-window-start (selected-window) (- (point) nchars))) - (if (= (point) eshell-last-input-end) - (set-marker eshell-last-input-end - (- eshell-last-input-end nchars))) (set-marker eshell-last-output-start ostart) (set-marker eshell-last-output-end (point)) (force-mode-line-update)) commit 4143b1d630132bf72c91d33ae5c10e7930e51353 Author: Martin Rudalics Date: Mon Oct 25 11:26:33 2021 +0200 ; Fix mangled indentation in 'display-buffer' doc-string diff --git a/lisp/window.el b/lisp/window.el index 848e61811d..2582743679 100644 --- a/lisp/window.el +++ b/lisp/window.el @@ -7631,15 +7631,15 @@ Action alist entries are: preserve its height or (t . t) to preserve its height and width in future changes of the window configuration. `window-parameters' -- The value specifies an alist of window - parameters to give the chosen window. `allow-no-window' -- A - non-nil value means that `display-buffer' may not display the - buffer and return nil immediately. `body-function' -- A - function called with one argument - the displayed window. It - is called after the buffer is displayed, and before - `window-height', `window-width' and `preserve-size' are - applied. The function is supposed to fill the window body - with some contents that might depend on dimensions of the - displayed window. + parameters to give the chosen window. + `allow-no-window' -- A non-nil value means that `display-buffer' + may not display the buffer and return nil immediately. + `body-function' -- A function called with one argument - the + displayed window. It is called after the buffer is + displayed, and before `window-height', `window-width' + and `preserve-size' are applied. The function is supposed + to fill the window body with some contents that might depend + on dimensions of the displayed window. The entries `window-height', `window-width', `window-size' and `preserve-size' are applied only when the window used for commit beaddd87f79b69fe2723206c9cbb2efacf34620d Author: Martin Rudalics Date: Mon Oct 25 10:42:17 2021 +0200 Allow 'display-buffer' to set up body size of chosen window (Bug#17065) * doc/lispref/windows.texi (Buffer Display Action Alists): Describe new possible values for 'window-height', 'window-width' and 'window-size' action alist entries. * lisp/window.el (window--display-buffer): Handle new values for 'window-height', 'window-width' and 'window-size' ALIST entries. (display-buffer): Update doc-string for new values of some action alist entries. * etc/NEWS: Mention new values of some action alist entries. diff --git a/doc/lispref/windows.texi b/doc/lispref/windows.texi index 262516054a..9ce185a7a6 100644 --- a/doc/lispref/windows.texi +++ b/doc/lispref/windows.texi @@ -3035,6 +3035,11 @@ A floating-point number specifies the fraction of the chosen window's desired total height with respect to the total height of its frame's root window. +@item +A cons cell whose @sc{car} is @code{body-lines} and whose @sc{cdr} is an +integer that specifies the height of the chosen window's body in frame +lines. + @item If the value specifies a function, that function is called with one argument---the chosen window. The function is supposed to adjust the @@ -3068,6 +3073,11 @@ A floating-point number specifies the fraction of the chosen window's desired total width with respect to the total width of the frame's root window. +@item +A cons cell whose @sc{car} is @code{body-columns} and whose @sc{cdr} is +an integer that specifies the width of the chosen window's body in frame +columns. + @item If the value specifies a function, that function is called with one argument---the chosen window. The function is supposed to adjust the @@ -3077,8 +3087,8 @@ width of the window; its return value is ignored. @vindex window-size@r{, a buffer display action alist entry} @item window-size This entry is a combination of the two preceding ones and can be used to -adjust the chosen window's height and width. Since windows can be -resized in one direction only without affecting other windows, +adjust the chosen window's height @emph{and} width. Since windows can +be resized in one direction only without affecting other windows, @code{window-size} is effective only to set up the size of a window appearing alone on a frame. The value can be one of the following: @@ -3091,6 +3101,12 @@ A cons cell of two integers specifies the desired total width and height of the chosen window in lines and columns. It's effect is to adjust the size of the frame accordingly. +@item +A cons cell whose @sc{car} equals @code{body-chars} and whose @sc{cdr} +is a cons cell of two integers---the desired body width and height of +the chosen window in frame columns and lines. It's effect is to adjust +the size of the frame accordingly. + @item If the value specifies a function, that function is called with one argument---the chosen window. The function is supposed to adjust the diff --git a/etc/NEWS b/etc/NEWS index f6d36f1e91..90ad8d3a46 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -67,6 +67,12 @@ This support is built by default when the libwebp library is available. To disable it, use the '--without-webp' configure flag. Image specifiers can now use ':type webp'. +** Windows + ++++ +*** 'display-buffer' now can set up the body size of the chosen window. +For example, an alist entry as '(window-width . (body-columns . 40))' +will make the body of the chosen window 40 columns wide. * Editing Changes in Emacs 29.1 diff --git a/lisp/window.el b/lisp/window.el index 132f0930ce..848e61811d 100644 --- a/lisp/window.el +++ b/lisp/window.el @@ -7234,7 +7234,8 @@ Return WINDOW if BUFFER and WINDOW are live." (inhibit-modification-hooks t)) (funcall (cdr (assq 'body-function alist)) window))) - (let* ((quit-restore (window-parameter window 'quit-restore)) + (let* ((frame (window-frame window)) + (quit-restore (window-parameter window 'quit-restore)) (window-height (assq 'window-height alist)) (height (cdr window-height)) (window-width (assq 'window-width alist)) @@ -7256,29 +7257,35 @@ Return WINDOW if BUFFER and WINDOW are live." (when window-size (setq resize-temp-buffer-window-inhibit t))) ((consp size) - (let ((width (car size)) - (height (cdr size)) - (frame (window-frame window))) - (when (and (numberp width) (numberp height)) - ;; Modifying the parameters of a newly created frame might - ;; not work everywhere, but then `temp-buffer-resize-mode' - ;; will certainly fail in a similar fashion. + ;; Modifying the parameters of a newly created frame might + ;; not work everywhere, but then `temp-buffer-resize-mode' + ;; will certainly fail in a similar fashion. + (if (eq (car size) 'body-chars) + (let ((width (+ (frame-text-width frame) + (* (frame-char-width frame) (cadr size)) + (- (window-body-width window t)))) + (height (+ (frame-text-height frame) + (* (frame-char-height frame) (cddr size)) + (- (window-body-height window t))))) + (modify-frame-parameters + frame `((height . (text-pixels . ,height)) + (width . (text-pixels . ,width))))) + (let ((width (- (+ (frame-width frame) (car size)) + (window-total-width window))) + (height (- (+ (frame-height frame) (cdr size)) + (window-total-height window)))) (modify-frame-parameters - frame `((height . ,(+ (frame-height frame) - (- height (window-total-height window)))) - (width . ,(+ (frame-width frame) - (- width (window-total-width window)))))))) + frame `((height . ,height) (width . ,width))))) (setq resize-temp-buffer-window-inhibit t)) - ((functionp size) + ((functionp size) (ignore-errors (funcall size window)) (setq resize-temp-buffer-window-inhibit t)))) ((or (eq type 'window) (and (eq (car quit-restore) 'same) (eq (nth 1 quit-restore) 'window))) ;; A window that never showed another buffer but BUFFER ever - ;; since it was created on an existing frame. - ;; - ;; Adjust width and/or height of window if asked for. + ;; since it was created on an existing frame. Adjust its width + ;; and/or height if asked for. (cond ((not height) (when window-height @@ -7295,7 +7302,14 @@ Return WINDOW if BUFFER and WINDOW are live." (window-combined-p window)) (window-resize window delta nil 'safe))) (setq resize-temp-buffer-window-inhibit 'vertical)) - ((functionp height) + ((and (consp height) (eq (car height) 'body-lines)) + (let* ((delta (- (* (frame-char-height frame) (cdr height)) + (window-body-height window t)))) + (and (window--resizable-p window delta nil 'safe nil nil nil t) + (window-combined-p window) + (window-resize window delta nil 'safe t))) + (setq resize-temp-buffer-window-inhibit 'vertical)) + ((functionp height) (ignore-errors (funcall height window)) (setq resize-temp-buffer-window-inhibit 'vertical))) ;; Adjust width of window if asked for. @@ -7315,6 +7329,13 @@ Return WINDOW if BUFFER and WINDOW are live." (window-combined-p window t)) (window-resize window delta t 'safe))) (setq resize-temp-buffer-window-inhibit 'horizontal)) + ((and (consp width) (eq (car width) 'body-columns)) + (let* ((delta (- (* (frame-char-width frame) (cdr width)) + (window-body-width window t)))) + (and (window--resizable-p window delta t 'safe nil nil nil t) + (window-combined-p window t) + (window-resize window delta t 'safe t))) + (setq resize-temp-buffer-window-inhibit 'horizontal)) ((functionp width) (ignore-errors (funcall width window)) (setq resize-temp-buffer-window-inhibit 'horizontal))) @@ -7564,11 +7585,12 @@ perform. Action alist entries are: `inhibit-same-window' -- A non-nil value prevents the same window from being used for display. -`inhibit-switch-frame' -- A non-nil value prevents any frame used - for showing the buffer from being raised or selected. Note - that a window manager may still raise a new frame and give it - focus, effectively overriding the value specified here. -`reusable-frames' -- The value specifies the set of frames to + `inhibit-switch-frame' -- A non-nil value prevents any frame + used for showing the buffer from being raised or selected. + Note that a window manager may still raise a new frame and + give it focus, effectively overriding the value specified + here. + `reusable-frames' -- The value specifies the set of frames to search for a window that already displays the buffer. Possible values are nil (the selected frame), t (any live frame), visible (any visible frame), 0 (any visible or @@ -7577,45 +7599,51 @@ Action alist entries are: frame parameters to give a new frame, if one is created. `window-height' -- The value specifies the desired height of the window chosen and is either an integer (the total height of - the window), a floating point number (the fraction of its - total height with respect to the total height of the frame's - root window) or a function to be called with one argument - - the chosen window. The function is supposed to adjust the - height of the window; its return value is ignored. Suitable - functions are `shrink-window-if-larger-than-buffer' and - `fit-window-to-buffer'. + the window specified in frame lines), a floating point + number (the fraction of its total height with respect to the + total height of the frame's root window), a cons cell whose + car is 'body-lines' and whose cdr is an integer that + specifies the height of the window's body in frame lines, or + a function to be called with one argument - the chosen + window. That function is supposed to adjust the height of + the window. Suitable functions are `fit-window-to-buffer' + and `shrink-window-if-larger-than-buffer'. `window-width' -- The value specifies the desired width of the window chosen and is either an integer (the total width of - the window), a floating point number (the fraction of its - total width with respect to the width of the frame's root - window) or a function to be called with one argument - the - chosen window. The function is supposed to adjust the width - of the window; its return value is ignored. + the window specified in frame lines), a floating point + number (the fraction of its total width with respect to the + width of the frame's root window), a cons cell whose car is + 'body-columns' and whose cdr is an integer that specifies the + width of the window's body in frame columns, or a function to + be called with one argument - the chosen window. That + function is supposed to adjust the width of the window. `window-size' -- This entry is only useful for windows appearing alone on their frame and specifies the desired size of that window either as a cons of integers (the total width and - height of the window on that frame), or a function to be - called with one argument - the chosen window. The function - is supposed to adjust the size of the frame; its return value - is ignored. -`preserve-size' -- The value should be either (t . nil) to + height of the window on that frame), a cons cell whose car is + 'body-chars' and whose cdr is a cons of integers (the desired + width and height of the window's body in columns and lines of + its frame), or a function to be called with one argument - + the chosen window. That function is supposed to adjust the + size of the frame. + `preserve-size' -- The value should be either (t . nil) to preserve the width of the chosen window, (nil . t) to preserve its height or (t . t) to preserve its height and width in future changes of the window configuration. `window-parameters' -- The value specifies an alist of window - parameters to give the chosen window. - `allow-no-window' -- A non-nil value means that `display-buffer' - may not display the buffer and return nil immediately. - `body-function' -- A function called with one argument - the - displayed window. It is called after the buffer is - displayed, and before `window-height', `window-width' - and `preserve-size' are applied. The function is supposed - to fill the window body with some contents that might depend - on dimensions of the displayed window. - -The entries `window-height', `window-width' and `preserve-size' -are applied only when the window used for displaying the buffer -never showed another buffer before. + parameters to give the chosen window. `allow-no-window' -- A + non-nil value means that `display-buffer' may not display the + buffer and return nil immediately. `body-function' -- A + function called with one argument - the displayed window. It + is called after the buffer is displayed, and before + `window-height', `window-width' and `preserve-size' are + applied. The function is supposed to fill the window body + with some contents that might depend on dimensions of the + displayed window. + +The entries `window-height', `window-width', `window-size' and +`preserve-size' are applied only when the window used for +displaying the buffer never showed another buffer before. The ACTION argument can also have a non-nil and non-list value. This means to display the buffer in a window other than the commit 709e1e59f0f4db24580566f5ca661e730afbf9a2 Author: Stefan Kangas Date: Mon Oct 25 07:51:02 2021 +0200 New function xdg-state-home * lisp/xdg.el (xdg-state-home): New function. This returns $XDG_STATE_HOME according to the XDG Base Directory Specification version 0.8 (08th May 2021). diff --git a/etc/NEWS b/etc/NEWS index 73f9b2ae60..f6d36f1e91 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -296,6 +296,14 @@ Use 'exif-parse-file' and 'exif-field' instead. * Lisp Changes in Emacs 29.1 +** XDG support + +*** New function 'xdg-state-home' returns $XDG_STATE_HOME. +This new location, introduced in the XDG Base Directory Specification +version 0.8 (8th May 2021), "contains state data that should persist +between (application) restarts, but that is not important or portable +enough to the user that it should be stored in $XDG_DATA_HOME". + +++ ** New macro 'with-delayed-message'. This macro is like 'progn', but will output the specified message if diff --git a/lisp/xdg.el b/lisp/xdg.el index 1f9fa6795e..75c8bce37e 100644 --- a/lisp/xdg.el +++ b/lisp/xdg.el @@ -61,6 +61,23 @@ "Return the base directory for user specific data files." (xdg--dir-home "XDG_DATA_HOME" "~/.local/share")) +(defun xdg-state-home () + "Return the base directory for user-specific state data. + +According to the XDG Base Directory Specification version +0.8 (8th May 2021): + + \"The $XDG_STATE_HOME contains state data that should persist + between (application) restarts, but that is not important or + portable enough to the user that it should be stored in + $XDG_DATA_HOME. It may contain: + + * actions history (logs, history, recently used files, …) + + * current state of the application that can be reused on a + restart (view, layout, open files, undo history, …)\"" + (xdg--dir-home "XDG_STATE_HOME" "~/.local/state")) + (defun xdg-runtime-dir () "Return the value of $XDG_RUNTIME_DIR." (getenv "XDG_RUNTIME_DIR")) commit f8fed417a51fe4d572f4b5c6a7a591adf133e874 Author: Stefan Kangas Date: Mon Oct 25 06:44:30 2021 +0200 image-dired: Improve XDG compliance * lisp/image-dired.el (xdg): Require. (image-dired-main-image-directory): Prefer XDG_PICTURES_HOME. (image-dired-thumb-name): Simplify by using 'xdg-cache-home'. diff --git a/lisp/image-dired.el b/lisp/image-dired.el index 210361f603..77a35900e4 100644 --- a/lisp/image-dired.el +++ b/lisp/image-dired.el @@ -157,6 +157,7 @@ (require 'exif) (require 'image-mode) (require 'widget) +(require 'xdg) (eval-when-compile (require 'cl-lib) @@ -551,10 +552,12 @@ Including parameters. Used when displaying original image from :type '(choice string (const :tag "Not Set" nil))) -(defcustom image-dired-main-image-directory "~/pics/" +(defcustom image-dired-main-image-directory + (or (xdg-user-dir "PICTURES") "~/pics/") "Name of main image directory, if any. Used by `image-dired-copy-with-exif-file-name'." - :type 'string) + :type 'string + :version "29.1") (defcustom image-dired-show-all-from-dir-max-files 100 "Maximum number of files in directory before prompting. @@ -647,18 +650,15 @@ file name of the thumbnail will vary: See also `image-dired-thumbnail-storage'." (cond ((memq image-dired-thumbnail-storage image-dired--thumbnail-standard-sizes) - (let* ((xdg (getenv "XDG_CACHE_HOME")) - (dir (if (and xdg (file-name-absolute-p xdg)) - xdg "~/.cache")) - (thumbdir (cl-case image-dired-thumbnail-storage - (standard "thumbnails/normal") - (standard-large "thumbnails/large") - (standard-x-large "thumbnails/x-large") - (standard-xx-large "thumbnails/xx-large")))) + (let ((thumbdir (cl-case image-dired-thumbnail-storage + (standard "thumbnails/normal") + (standard-large "thumbnails/large") + (standard-x-large "thumbnails/x-large") + (standard-xx-large "thumbnails/xx-large")))) (expand-file-name ;; MD5 is mandated by the Thumbnail Managing Standard. (concat (md5 (concat "file://" (expand-file-name file))) ".png") - (expand-file-name thumbdir dir)))) + (expand-file-name thumbdir (xdg-cache-home))))) ((eq 'use-image-dired-dir image-dired-thumbnail-storage) (let* ((f (expand-file-name file)) (hash commit 5dd07e1ba1919aafe9df7cda79e2808c1984e0c3 Author: Stefan Kangas Date: Mon Oct 25 05:47:56 2021 +0200 Double value of image-dired-show-all-from-dir-max-files * lisp/image-dired.el (image-dired-show-all-from-dir-max-files): Double the amount of files in directory before prompting. This could be even higher, as the thumbnails are generated asynchronously and are small by default. diff --git a/lisp/image-dired.el b/lisp/image-dired.el index e2aba710c1..210361f603 100644 --- a/lisp/image-dired.el +++ b/lisp/image-dired.el @@ -556,10 +556,12 @@ Including parameters. Used when displaying original image from Used by `image-dired-copy-with-exif-file-name'." :type 'string) -(defcustom image-dired-show-all-from-dir-max-files 50 - "Maximum number of files to show using `image-dired-show-all-from-dir' -before warning." - :type 'integer) +(defcustom image-dired-show-all-from-dir-max-files 100 + "Maximum number of files in directory before prompting. +If there are more files than this in a selected directory, the +`image-dired-show-all-from-dir' command will show a prompt." + :type 'integer + :version "29.1") (defmacro image-dired--with-db-file (&rest body) "Run BODY in a temp buffer containing `image-dired-db-file'. commit 50f9436146ae1814d4f4c6670bccac7c76db292f Author: Stefan Kangas Date: Mon Oct 25 04:48:12 2021 +0200 image-dired: Doc fix to better explain thumbnail generation * doc/emacs/dired.texi (Image-Dired): Improve description by explaining that the generation of thumbnails is asynchronous. diff --git a/doc/emacs/dired.texi b/doc/emacs/dired.texi index 540abc3f3b..9cdd4b805e 100644 --- a/doc/emacs/dired.texi +++ b/doc/emacs/dired.texi @@ -1507,10 +1507,10 @@ buffer containing image-dired, corresponding to the marked files. You can also enter Image-Dired directly by typing @kbd{M-x image-dired}. This prompts for a directory; specify one that has image files. This creates thumbnails for all the images in that -directory, and displays them all in the thumbnail buffer. This -takes a long time if the directory contains many image files, and it -asks for confirmation if the number of image files exceeds -@code{image-dired-show-all-from-dir-max-files}. +directory, and displays them all in the thumbnail buffer. The +thumbnails are generated in the background and are loaded as they +become available. This command asks for confirmation if the number of +image files exceeds @code{image-dired-show-all-from-dir-max-files}. With point in the thumbnail buffer, you can type @key{RET} (@code{image-dired-display-thumbnail-original-image}) to display a commit 79f7e87da5037f22be07954bb8000ee88e18e515 Author: Stefan Kangas Date: Mon Oct 25 03:50:04 2021 +0200 image-dired: Add support for GraphicsMagick * lisp/image-dired.el (image-dired-cmd-create-thumbnail-program) (image-dired-cmd-create-thumbnail-options) (image-dired-cmd-create-temp-image-program) (image-dired-cmd-create-temp-image-options) (image-dired-cmd-rotate-thumbnail-program) (image-dired-cmd-rotate-thumbnail-options): Add support for the GraphicsMagick command line tool ("gm convert", "gm mogrify"). diff --git a/etc/NEWS b/etc/NEWS index 83899a3457..73f9b2ae60 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -211,6 +211,11 @@ 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. +--- +*** 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. + ** Dired --- diff --git a/lisp/image-dired.el b/lisp/image-dired.el index 9d4b762594..e2aba710c1 100644 --- a/lisp/image-dired.el +++ b/lisp/image-dired.el @@ -59,16 +59,22 @@ ;; PREREQUISITES ;; ============= ;; -;; * The ImageMagick package. Currently, `convert' and `mogrify' are -;; used. Find it here: https://www.imagemagick.org. +;; * The GraphicsMagick or ImageMagick package; Image-Dired uses +;; whichever is available. +;; +;; A) For GraphicsMagick, `gm' is used. +;; Find it here: http://www.graphicsmagick.org/ +;; +;; B) For ImageMagick, `convert' and `mogrify' are used. +;; Find it here: https://www.imagemagick.org. ;; ;; * For non-lossy rotation of JPEG images, the JpegTRAN program is -;; needed. +;; needed. ;; ;; * For `image-dired-set-exif-data' to work, the command line tool `exiftool' is -;; needed. It can be found here: https://exiftool.org/. This -;; function is, among other things, used for writing comments to -;; image files using `image-dired-thumbnail-set-image-description'. +;; needed. It can be found here: https://exiftool.org/. This +;; function is, among other things, used for writing comments to +;; image files using `image-dired-thumbnail-set-image-description'. ;; ;; ;; USAGE @@ -242,36 +248,45 @@ expects to find pictures in this directory." :type 'string) (defcustom image-dired-cmd-create-thumbnail-program - "convert" + (if (executable-find "gm") "gm" "convert") "Executable used to create thumbnail. Used together with `image-dired-cmd-create-thumbnail-options'." - :type 'file) + :type 'file + :version "29.1") (defcustom image-dired-cmd-create-thumbnail-options - '("-size" "%wx%h" "%f[0]" "-resize" "%wx%h>" "-strip" "jpeg:%t") + (let ((opts '("-size" "%wx%h" "%f[0]" + "-resize" "%wx%h>" + "-strip" "jpeg:%t"))) + (if (executable-find "gm") (cons "convert" opts) opts)) "Options of command used to create thumbnail image. Used with `image-dired-cmd-create-thumbnail-program'. Available format specifiers are: %w which is replaced by `image-dired-thumb-width', %h which is replaced by `image-dired-thumb-height', %f which is replaced by the file name of the original image and %t which is replaced by the file name of the thumbnail file." - :version "26.1" + :version "29.1" :type '(repeat (string :tag "Argument"))) -(defcustom image-dired-cmd-create-temp-image-program "convert" +(defcustom image-dired-cmd-create-temp-image-program + (if (executable-find "gm") "gm" "convert") "Executable used to create temporary image. Used together with `image-dired-cmd-create-temp-image-options'." - :type 'file) + :type 'file + :version "29.1") (defcustom image-dired-cmd-create-temp-image-options - '("-size" "%wx%h" "%f[0]" "-resize" "%wx%h>" "-strip" "jpeg:%t") + (let ((opts '("-size" "%wx%h" "%f[0]" + "-resize" "%wx%h>" + "-strip" "jpeg:%t"))) + (if (executable-find "gm") (cons "convert" opts) opts)) "Options of command used to create temporary image for display window. Used together with `image-dired-cmd-create-temp-image-program', Available format specifiers are: %w and %h which are replaced by the calculated max size for width and height in the image display window, %f which is replaced by the file name of the original image and %t which is replaced by the file name of the temporary file." - :version "26.1" + :version "29.1" :type '(repeat (string :tag "Argument"))) (defcustom image-dired-cmd-pngnq-program @@ -352,20 +367,22 @@ Available format specifiers are the same as in :type '(repeat (string :tag "Argument"))) (defcustom image-dired-cmd-rotate-thumbnail-program - "mogrify" + (if (executable-find "gm") "gm" "mogrify") "Executable used to rotate thumbnail. Used together with `image-dired-cmd-rotate-thumbnail-options'." - :type 'file) + :type 'file + :version "29.1") (defcustom image-dired-cmd-rotate-thumbnail-options - '("-rotate" "%d" "%t") + (let ((opts '("-rotate" "%d" "%t"))) + (if (executable-find "gm") (cons "mogrify" opts) opts)) "Arguments of command used to rotate thumbnail image. Used with `image-dired-cmd-rotate-thumbnail-program'. Available format specifiers are: %d which is replaced by the number of (positive) degrees to rotate the image, normally 90 or 270 \(for 90 degrees right and left), %t which is replaced by the file name of the thumbnail file." - :version "26.1" + :version "29.1" :type '(repeat (string :tag "Argument"))) (defcustom image-dired-cmd-rotate-original-program commit 83f1e4b3bcb9e651267adba79fed0a229263183e Author: Lars Ingebrigtsen Date: Mon Oct 25 02:19:39 2021 +0200 Fix issues with type casting in delayed message functions * src/eval.c (with_delayed_message_display) (with_delayed_message_cancel, Ffuncall_with_delayed_message): Fix some type confusion. diff --git a/src/eval.c b/src/eval.c index 110b67b587..94ad060773 100644 --- a/src/eval.c +++ b/src/eval.c @@ -1082,12 +1082,13 @@ usage: (while TEST BODY...) */) static void with_delayed_message_display (struct atimer *timer) { - message3 (timer->client_data); + message3 (build_string (timer->client_data)); } static void with_delayed_message_cancel (void *timer) { + xfree (((struct atimer *) timer)->client_data); cancel_atimer (timer); } @@ -1111,13 +1112,11 @@ is not displayed. */) struct timespec interval = dtotimespec (XFLOATINT (timeout)); struct atimer *timer = start_atimer (ATIMER_RELATIVE, interval, with_delayed_message_display, - message); + xstrdup (SSDATA (message))); record_unwind_protect_ptr (with_delayed_message_cancel, timer); Lisp_Object result = CALLN (Ffuncall, function); - cancel_atimer (timer); - return unbind_to (count, result); } commit 057f45abeced1c81bd9bb2782ab6a8fe472f38c8 Author: Stefan Kangas Date: Mon Oct 25 02:12:48 2021 +0200 Support new Thumbnail Managing Standard sizes in image-dired * lisp/image-dired.el (image-dired--thumbnail-managing-standard-sizes): New defconst. (image-dired-thumbnail-storage) (image-dired-thumb-name, image-dired-insert-thumbnail) (image-dired-thumb-size, image-dired-create-thumb-1): Support larger thumbnail sizes mandated by new version of the Thumbnail Managing Standard (December 2020, Version 0.9.0). diff --git a/etc/NEWS b/etc/NEWS index d47a91c31f..83899a3457 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -204,6 +204,13 @@ external "exiftool" command to be available. The user options The new command 'image-dired-unmark-all-marks' has been added with a binding in the menu. +--- +*** 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. + ** Dired --- diff --git a/lisp/image-dired.el b/lisp/image-dired.el index bca2dd117f..9d4b762594 100644 --- a/lisp/image-dired.el +++ b/lisp/image-dired.el @@ -88,8 +88,8 @@ ;; * Supports all image formats that Emacs and convert supports, but ;; the thumbnails are hard-coded to JPEG or PNG format. It uses ;; JPEG by default, but can optionally follow the Thumbnail Managing -;; Standard, which mandates PNG. See the user option -;; `image-dired-thumbnail-storage'. +;; Standard (v0.9.0, Dec 2020), which mandates PNG. See the user +;; option `image-dired-thumbnail-storage'. ;; ;; * WARNING: The "database" format used might be changed so keep a ;; backup of `image-dired-db-file' when testing new versions. @@ -180,22 +180,35 @@ values, they will be stored in the JPEG format: where the image file is. It can also use the \"Thumbnail Managing Standard\", which allows -sharing of thumbnails across different programs. This method -means that thumbnails are saved in the PNG format, and allows for -use the following file sizes: +sharing of thumbnails across different programs. Thumbnails will +be stored in \"$XDG_CACHE_HOME/thumbnails/\" instead of in +`image-dired-dir'. Thumbnails are saved in the PNG format, and +can be one of the following sizes: - `standard' means use thumbnails sized 128x128. - `standard-large' means use thumbnails sized 256x256. +- `standard-x-large' means use thumbnails sized 512x512. +- `standard-xx-large' means use thumbnails sized 1024x1024. -Note that with this method of storing thumbnails, they will be -saved in subdirectories of `image-dired-dir'. For more -information on the Thumbnail Managing Standard, see: +For more information on the Thumbnail Managing Standard, see: https://specifications.freedesktop.org/thumbnail-spec/thumbnail-spec-latest.html" :type '(choice :tag "How to store thumbnail files" (const :tag "Use image-dired-dir" use-image-dired-dir) - (const :tag "Thumbnail Managing Standard (normal 128x128)" standard) - (const :tag "Thumbnail Managing Standard (large 256x256)" standard-large) - (const :tag "Per-directory" per-directory))) + (const :tag "Thumbnail Managing Standard (normal 128x128)" + standard) + (const :tag "Thumbnail Managing Standard (large 256x256)" + standard-large) + (const :tag "Thumbnail Managing Standard (larger 512x512)" + standard-x-large) + (const :tag "Thumbnail Managing Standard (extra large 1024x1024)" + standard-xx-large) + (const :tag "Per-directory" per-directory)) + :version "29.1") + +(defconst image-dired--thumbnail-standard-sizes + '( standard standard-large + standard-x-large standard-xx-large) + "List of symbols representing thumbnail sizes in Thumbnail Managing Standard.") (defcustom image-dired-db-file (expand-file-name ".image-dired_db" image-dired-dir) @@ -410,6 +423,8 @@ Used by `image-dired-gallery-generate' to leave out \"hidden\" images." (cond ((eq 'standard image-dired-thumbnail-storage) 128) ((eq 'standard-large image-dired-thumbnail-storage) 256) + ((eq 'standard-x-large image-dired-thumbnail-storage) 512) + ((eq 'standard-xx-large image-dired-thumbnail-storage) 1024) (t 100)) "Size of thumbnails, in pixels. This is the default size for both `image-dired-thumb-width' @@ -583,7 +598,7 @@ Add text properties ORIGINAL-FILE-NAME and ASSOCIATED-DIRED-BUFFER." (or (and (file-exists-p file) (image-type-from-file-header file)) (and (memq image-dired-thumbnail-storage - '(standard standard-large)) + image-dired--thumbnail-standard-sizes) 'png) 'jpeg) image-dired-thumb-relief @@ -611,13 +626,16 @@ file name of the thumbnail will vary: of the image file's directory name will be added to the filename. See also `image-dired-thumbnail-storage'." - (cond ((memq image-dired-thumbnail-storage '(standard standard-large)) + (cond ((memq image-dired-thumbnail-storage + image-dired--thumbnail-standard-sizes) (let* ((xdg (getenv "XDG_CACHE_HOME")) (dir (if (and xdg (file-name-absolute-p xdg)) xdg "~/.cache")) (thumbdir (cl-case image-dired-thumbnail-storage (standard "thumbnails/normal") - (standard-large "thumbnails/large")))) + (standard-large "thumbnails/large") + (standard-x-large "thumbnails/x-large") + (standard-xx-large "thumbnails/xx-large")))) (expand-file-name ;; MD5 is mandated by the Thumbnail Managing Standard. (concat (md5 (concat "file://" (expand-file-name file))) ".png") @@ -650,6 +668,8 @@ DIMENSION should be either the symbol `width' or `height'." (cond ((eq 'standard image-dired-thumbnail-storage) 128) ((eq 'standard-large image-dired-thumbnail-storage) 256) + ((eq 'standard-x-large image-dired-thumbnail-storage) 512) + ((eq 'standard-xx-large image-dired-thumbnail-storage) 1024) (t (cl-ecase dimension (width image-dired-thumb-width) (height image-dired-thumb-height))))) @@ -764,7 +784,7 @@ Increase at own risk.") (mapcar (lambda (arg) (format-spec arg spec)) (if (memq image-dired-thumbnail-storage - '(standard standard-large)) + image-dired--thumbnail-standard-sizes) image-dired-cmd-create-standard-thumbnail-options image-dired-cmd-create-thumbnail-options)))) @@ -783,7 +803,7 @@ Increase at own risk.") ;; PNG thumbnail has been created since we are ;; following the XDG thumbnail spec, so try to optimize (when (memq image-dired-thumbnail-storage - '(standard standard-large)) + image-dired--thumbnail-standard-sizes) (cond ((and image-dired-cmd-pngnq-program (executable-find image-dired-cmd-pngnq-program)) commit bb475e10b9f0b1b76618dc6cb33237e36d30bbc3 Author: Stefan Kangas Date: Mon Oct 25 02:12:34 2021 +0200 Clarify two image-dired docstrings * lisp/image-dired.el (image-dired-dir): Doc fix; clarify that thumbnails will be saved in "$XDG_CACHE_HOME/thumbnails", as per the Thumbnail Managing Standard. (image-dired-thumb-size): Doc fix; clarify that this option will be ignored when using the Thumbnail Managing Standard. diff --git a/lisp/image-dired.el b/lisp/image-dired.el index e5fbfcf927..2c289646ed 100644 --- a/lisp/image-dired.el +++ b/lisp/image-dired.el @@ -163,7 +163,12 @@ :group 'multimedia) (defcustom image-dired-dir (locate-user-emacs-file "image-dired/") - "Directory where thumbnail images are stored." + "Directory where thumbnail images are stored. + +The value of this option will be ignored if Image Dired is +customized to use the Thumbnail Managing Standard; they will be +saved in \"$XDG_CACHE_HOME/thumbnails/\" instead. See +`image-dired-thumbnail-storage'." :type 'directory) (defcustom image-dired-thumbnail-storage 'use-image-dired-dir @@ -406,7 +411,11 @@ Used by `image-dired-gallery-generate' to leave out \"hidden\" images." (t 100)) "Size of thumbnails, in pixels. This is the default size for both `image-dired-thumb-width' -and `image-dired-thumb-height'." +and `image-dired-thumb-height'. + +The value of this option will be ignored if Image Dired is +customized to use the Thumbnail Managing Standard; the standard +sizes will be used instead. See `image-dired-thumbnail-storage'." :type 'integer) (defcustom image-dired-thumb-width image-dired-thumb-size commit f5b4bb4a6fa3adcb653cab5dc760745b896320bb Author: Lars Ingebrigtsen Date: Mon Oct 25 01:25:13 2021 +0200 Fix flymake example backend conditions in the manual * doc/misc/flymake.texi (An annotated example backend): Also react to `signal' process statuses (bug#51380). diff --git a/doc/misc/flymake.texi b/doc/misc/flymake.texi index cfe73439f3..309bed7760 100644 --- a/doc/misc/flymake.texi +++ b/doc/misc/flymake.texi @@ -774,7 +774,7 @@ Binding,,, elisp, The Emacs Lisp Reference Manual}) to be active. ;; Check that the process has indeed exited, as it might ;; be simply suspended. ;; - (when (eq 'exit (process-status proc)) + (when (memq (process-status proc) '(exit signal)) (unwind-protect ;; Only proceed if `proc' is the same as ;; `ruby--flymake-proc', which indicates that commit 0771d8939adaacf0b9b41150be9c53e6b9519b04 Author: Stefan Kangas Date: Sun Oct 24 23:56:46 2021 +0200 * etc/PROBLEMS: Mention problems with regexp matcher. (Bug#18577) diff --git a/etc/PROBLEMS b/etc/PROBLEMS index ede83a6e7c..daff102a0d 100644 --- a/etc/PROBLEMS +++ b/etc/PROBLEMS @@ -742,6 +742,18 @@ completed" message that tls.el relies upon, causing affected Emacs functions to hang. To work around the problem, use older or newer versions of gnutls-cli, or use Emacs's built-in gnutls support. +*** Stack overflow in regexp matcher. +Due to fundamental limitations in the way Emacs' regular expression +engine is designed, you might run into combinatorial explosions in +backtracking with certain regexps. + +Avoid "\(...\(...\)*...\)*" and "\(...\)*\(...\)*". Look for a way to +anchor your regular expression, to avoid matching the null string in +infinite ways. The latter is what creates backtrack points, and +eventual overflow in practice. + +(Also prefer "\(?:...\)" to "\(...\)" unless you need the latter.) + * Runtime problems related to font handling ** Characters are displayed as empty boxes or with wrong font under X. commit 608e694a30469392540043ce3ef627832b491f8c Author: Stefan Kangas Date: Sun Oct 24 23:25:07 2021 +0200 Use SHA1 when creating thumbnail file name * lisp/image-dired.el (image-dired-thumb-name): Improve docstring. Use SHA1 for hashing when creating file name. SHA1 is slightly faster than MD5, and has a few more bits. diff --git a/lisp/image-dired.el b/lisp/image-dired.el index 0a4db7a0e5..bca2dd117f 100644 --- a/lisp/image-dired.el +++ b/lisp/image-dired.el @@ -599,13 +599,18 @@ Add text properties ORIGINAL-FILE-NAME and ASSOCIATED-DIRED-BUFFER." 'comment (image-dired-get-comment original-file-name))))) (defun image-dired-thumb-name (file) - "Return thumbnail file name for FILE. -Depending on the value of `image-dired-thumbnail-storage', the file -name will vary. For central thumbnail file storage, make a -MD5-hash of the image file's directory name and add that to make -the thumbnail file name unique. For per-directory storage, just -add a subdirectory. For standard storage, produce the file name -according to the Thumbnail Managing Standard." + "Return absolute file name for thumbnail FILE. +Depending on the value of `image-dired-thumbnail-storage', the +file name of the thumbnail will vary: +- For `use-image-dired-dir', make a SHA1-hash of the image file's + directory name and add that to make the thumbnail file name + unique. +- For `per-directory' storage, just add a subdirectory. +- For `standard' storage, produce the file name according to the + Thumbnail Managing Standard. Among other things, an MD5-hash + of the image file's directory name will be added to the + filename. +See also `image-dired-thumbnail-storage'." (cond ((memq image-dired-thumbnail-storage '(standard standard-large)) (let* ((xdg (getenv "XDG_CACHE_HOME")) (dir (if (and xdg (file-name-absolute-p xdg)) @@ -614,20 +619,19 @@ according to the Thumbnail Managing Standard." (standard "thumbnails/normal") (standard-large "thumbnails/large")))) (expand-file-name + ;; MD5 is mandated by the Thumbnail Managing Standard. (concat (md5 (concat "file://" (expand-file-name file))) ".png") (expand-file-name thumbdir dir)))) ((eq 'use-image-dired-dir image-dired-thumbnail-storage) (let* ((f (expand-file-name file)) - (md5-hash - ;; Is MD5 hashes fast enough? The checksum of a - ;; thumbnail file name need not be that - ;; "cryptographically" good so a faster one could - ;; be used here. - (md5 (file-name-as-directory (file-name-directory f))))) + (hash + ;; SHA1 is slightly faster than MD5, so let's use it. + ;; (We don't need anything crytographically strong.) + (sha1 (file-name-as-directory (file-name-directory f))))) (format "%s%s%s.thumb.%s" (file-name-as-directory (expand-file-name (image-dired-dir))) (file-name-base f) - (if md5-hash (concat "_" md5-hash) "") + (if hash (concat "_" hash) "") (file-name-extension f)))) ((eq 'per-directory image-dired-thumbnail-storage) (let ((f (expand-file-name file))) commit ea036e6f8d218241015d3e4a06360957b4e30266 Author: Lars Ingebrigtsen Date: Sun Oct 24 23:04:31 2021 +0200 Remove debugging in with_delayed_message_display * src/eval.c (with_delayed_message_display): Remove debugging. diff --git a/src/eval.c b/src/eval.c index cd451ecff0..110b67b587 100644 --- a/src/eval.c +++ b/src/eval.c @@ -1082,7 +1082,6 @@ usage: (while TEST BODY...) */) static void with_delayed_message_display (struct atimer *timer) { - printf("Here: %s\n", SDATA (timer->client_data)); message3 (timer->client_data); } commit 57f3a1eb009e1127d3fe5739933c95c6fdb84d17 Author: Lars Ingebrigtsen Date: Sun Oct 24 22:21:04 2021 +0200 Display a message if HMTL rendering takes a long time * lisp/net/eww.el (eww-display-html): Display a message if HTML rendering takes a long time (bug#19776). diff --git a/lisp/net/eww.el b/lisp/net/eww.el index c24a2c52be..e0bc17b5a5 100644 --- a/lisp/net/eww.el +++ b/lisp/net/eww.el @@ -694,7 +694,8 @@ The renaming scheme is performed in accordance with (meta . eww-tag-meta) (a . eww-tag-a))))) (erase-buffer) - (shr-insert-document document) + (with-delayed-message 2 "Rendering HTML..." + (shr-insert-document document)) (cond (point (goto-char point)) commit c2055d41b4b145aa940ce940adc1a3fabfe87a6b Author: Lars Ingebrigtsen Date: Sun Oct 24 22:20:19 2021 +0200 Add new macro `with-delayed-message' * doc/lispref/display.texi (Progress): Document it. * lisp/subr.el (with-delayed-message): New macro. * src/eval.c (with_delayed_message_display) (with_delayed_message_cancel): Helper functions. (Ffuncall_with_delayed_message): New function (bug#19776). diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi index 9c378a3027..6f95728e31 100644 --- a/doc/lispref/display.texi +++ b/doc/lispref/display.texi @@ -561,6 +561,26 @@ You can rewrite the previous example with this macro as follows: @end example @end defmac +@defmac with-delayed-message timeout message body@dots{} +Sometimes it's unclear whether an operation will take a long time to +execute or not, or it can be inconvenient to implement a progress +reporter. This macro can be used in those situations. + +@lisp +(with-delayed-message 2 (format "Gathering data for %s" entry) + (setq data (gather-data entry))) +@end lisp + +In this example, if the body takes more than two seconds to execute, +the message will be displayed. If it takes a shorter time than that, +the message won't be displayed. In either case, the body is evaluated +as normally, and the return value of the final element in the body is +the return value of the macro. + +The @var{message} element is evaluated before @var{body}, and is +always evaluated, whether the message is displayed or not. +@end defmac + @node Logging Messages @subsection Logging Messages in @file{*Messages*} @cindex logging echo-area messages diff --git a/etc/NEWS b/etc/NEWS index 0714a4d61b..d47a91c31f 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -284,6 +284,16 @@ Use 'exif-parse-file' and 'exif-field' instead. * Lisp Changes in Emacs 29.1 ++++ +** New macro 'with-delayed-message'. +This macro is like 'progn', but will output the specified message if +the body takes longer to execute than the specified timeout. + +--- +** New function 'funcall-with-delayed-message'. +This function is like 'funcall', but will output the specified message +is the function take longer to execute that the specified timeout. + ** Locale --- diff --git a/lisp/subr.el b/lisp/subr.el index 91189787d5..9acc79923c 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -6723,4 +6723,14 @@ as the variable documentation string. (define-keymap--define (list ,@(nreverse opts) ,@defs)) ,@(and doc (list doc))))) +(defmacro with-delayed-message (timeout message &rest body) + "Like `progn', but display MESSAGE if BODY takes longer than TIMEOUT seconds. +The MESSAGE form will be evaluated immediately, but the resulting +string will be displayed only if BODY takes longer than TIMEOUT seconds." + (declare (indent 2)) + `(funcall-with-delayed-message ,timeout ,message + (lambda () + ,@body))) + + ;;; subr.el ends here diff --git a/src/eval.c b/src/eval.c index 0f792b487e..cd451ecff0 100644 --- a/src/eval.c +++ b/src/eval.c @@ -29,6 +29,7 @@ along with GNU Emacs. If not, see . */ #include "dispextern.h" #include "buffer.h" #include "pdumper.h" +#include "atimer.h" /* CACHEABLE is ordinarily nothing, except it is 'volatile' if necessary to cajole GCC into not warning incorrectly that a @@ -1078,6 +1079,49 @@ usage: (while TEST BODY...) */) return Qnil; } +static void +with_delayed_message_display (struct atimer *timer) +{ + printf("Here: %s\n", SDATA (timer->client_data)); + message3 (timer->client_data); +} + +static void +with_delayed_message_cancel (void *timer) +{ + cancel_atimer (timer); +} + +DEFUN ("funcall-with-delayed-message", + Ffuncall_with_delayed_message, Sfuncall_with_delayed_message, + 3, 3, 0, + doc: /* Like `funcall', but display MESSAGE if FUNCTION takes longer than TIMEOUT. +TIMEOUT is a number of seconds, and can be an integer or a floating +point number. + +If FUNCTION takes less time to execute than TIMEOUT seconds, MESSAGE +is not displayed. */) + (Lisp_Object timeout, Lisp_Object message, Lisp_Object function) +{ + ptrdiff_t count = SPECPDL_INDEX (); + + CHECK_NUMBER (timeout); + CHECK_STRING (message); + + /* Set up the atimer. */ + struct timespec interval = dtotimespec (XFLOATINT (timeout)); + struct atimer *timer = start_atimer (ATIMER_RELATIVE, interval, + with_delayed_message_display, + message); + record_unwind_protect_ptr (with_delayed_message_cancel, timer); + + Lisp_Object result = CALLN (Ffuncall, function); + + cancel_atimer (timer); + + return unbind_to (count, result); +} + DEFUN ("macroexpand", Fmacroexpand, Smacroexpand, 1, 2, 0, doc: /* Return result of expanding macros at top level of FORM. If FORM is not a macro call, it is returned unchanged. @@ -4511,6 +4555,7 @@ alist of active lexical bindings. */); defsubr (&Slet); defsubr (&SletX); defsubr (&Swhile); + defsubr (&Sfuncall_with_delayed_message); defsubr (&Smacroexpand); defsubr (&Scatch); defsubr (&Sthrow); commit 374f14fb9936d2b8fb30a123457ff4b12160f5f3 Author: Alan Mackenzie Date: Sun Oct 24 19:59:18 2021 +0000 CC Mode: Fontify "found types" which are recognized after being first scanned This aims to fix the scenario where on jit-lock's first scan of a type, it is not recognized as such, and only later does this happen. The fontification of such found types is now done by background scanning in short time slices immediately after initialising the mode. * lisp/progmodes/cc-engine.el (c-add-type-1): New function. (c-add-type): Extract c-add-type-1 from it, and reformulate the mechanism for protecting c-found-types from excessive partial identifiers. * lisp/progmodes/cc-fonts.el (c-font-lock-complex-decl-prepare): Remove the code which cleared c-found-types on fontification at BOB. (c-find-types-background): New function, based on c-font-lock-declarations). (c-type-finder-timer-func): New function. (c-re-redisplay-timer): New variable. (c-force-redisplay, c-fontify-new-found-type): New functions. * lisp/progmodes/cc-mode.el (c-type-finder-timer, c-inhibit-type-finder): New variables. (c-leave-cc-mode-mode): Nullify c-post-command-hook, c-post-gc-hook, and c-type-finder-timer when the last CC Mode buffer of a session is killed. (c-type-finder-pos): New variable. (c-basic-common-init): Initialize/Install c-post-command, c-c-type-finder-pos, c-type-finder-timer, and c-post-gc-hook. (c-new-id-start, c-new-id-end, c-new-id-is-type): New variables. (c-update-new-id): New function. (c-post-command): New post command hook function, used for checking moving away from partially typed identifiers, and making them full identifiers. (c-post-gc-hook): New hook to prevent CC Mode activity immediately following GC, thus allowing keyboard/mouse input to be registered. (c-before-change): Add code to clear c-found-types on a buffer change at BOB. (c-after-change): Call c-update-new-id to keep track of partially typed identifiers. * doc/misc/cc-mode.texi (Found Types): New @section in the @Chapter Font Locking. * lisp/progmodes/cc-vars.el (c-type-finder-time-slot) (c-type-finder-repeat-time, c-type-finder-chunk-size): New customizable options. diff --git a/doc/misc/cc-mode.texi b/doc/misc/cc-mode.texi index 98ded68e71..c255d9870f 100644 --- a/doc/misc/cc-mode.texi +++ b/doc/misc/cc-mode.texi @@ -283,6 +283,8 @@ Font Locking * Font Locking Preliminaries:: * Faces:: * Doc Comments:: +* Wrong Comment Style:: +* Found Types:: * Misc Font Locking:: * AWK Mode Font Locking:: @@ -2161,6 +2163,60 @@ which aren't of the default style will be fontified with @code{font-lock-warning-face}. @end defvar +@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +@node Found Types +@comment node-name, next, previous, up +@section ``Found Type'' handling. +@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +In most languages handled by CC Mode, @dfn{found types} are recognized +as types by their context in the source code. These contrast with +types which are basic to a language or are declared as types (e.g. by +@code{typedef} in C). + +In earlier versions of @ccmode{}, when @code{jit-lock-mode} was +enabled in Emacs (which it is by default), found types would +frequently fail to get fontified properly. This happened when the +fontification functions scanned a use of the found type before +scanning the code which caused it to be recognized. + +From @ccmode{} version 5.36, a timer mechanism scans the entire buffer +for found types in the seconds immediately after starting the major +mode. When a found type gets recognized, all its occurrences in the +buffer get marked for (re)fontification. This scanning happens in +short time slices interleaved with other processing, such as keyboard +handling, so that the responsiveness of Emacs should be barely +affected. This mechanism can be disabled (see below). It is only +active when @code{jit-lock-mode} is also active. + +@defvar c-type-finder-time-slot +@vindex type-finder-time-slot (c-) +The approximate time in seconds that CC Mode spends in scanning source +code before relinquishing control to other Emacs activities. The +default value is 0.05. To disable the scanning mechanism, set this +variable to @code{nil}. +@end defvar + +@defvar c-type-finder-repeat-time +@vindex type-finder-repeat-time (c-) +The approximate frequency (in seconds) with which the scanning +mechanism is triggered. This time must be greater than +@code{c-type-finder-time-slot}. Its default value is 0.1. If a less +powerful machine becomes sluggish due to the scanning, increase the +value of @code{c-type-finder-repeat-time} to compensate. +@end defvar + +@defvar c-type-finder-chunk-size +@vindex type-finder-chunk-size (c-) +The approximate size (in characters) of the buffer chunk processed as +a unit before the scanning mechanism checks whether +@code{c-type-finder-time-slot} seconds have passed. The default value +is 1000. A too small value here will cause inefficiencies due to the +initialization which happens for each chunk, whereas a too large value +will cause the processing to consume an excessive proportion of the +@code{c-type-finder-repeat-time}. +@end defvar + @comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @node Misc Font Locking @comment node-name, next, previous, up diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el index c42c95764a..ace6b1b686 100644 --- a/lisp/progmodes/cc-engine.el +++ b/lisp/progmodes/cc-engine.el @@ -165,6 +165,9 @@ (defvar c-doc-line-join-end-ch) (defvar c-syntactic-context) (defvar c-syntactic-element) +(defvar c-new-id-start) +(defvar c-new-id-end) +(defvar c-new-id-is-type) (cc-bytecomp-defvar c-min-syn-tab-mkr) (cc-bytecomp-defvar c-max-syn-tab-mkr) (cc-bytecomp-defun c-clear-syn-tab) @@ -6813,21 +6816,32 @@ comment at the start of cc-engine.el for more info." (setq c-found-types (make-hash-table :test #'equal :weakness nil))) -(defun c-add-type (from to) - ;; Add the given region as a type in `c-found-types'. If the region - ;; doesn't match an existing type but there is a type which is equal - ;; to the given one except that the last character is missing, then - ;; the shorter type is removed. That's done to avoid adding all - ;; prefixes of a type as it's being entered and font locked. This - ;; doesn't cover cases like when characters are removed from a type - ;; or added in the middle. We'd need the position of point when the - ;; font locking is invoked to solve this well. +(defun c-add-type-1 (from to) + ;; Add the given region as a type in `c-found-types'. Prepare occurrences + ;; of this new type for fontification throughout the buffer. ;; ;; This function might do hidden buffer changes. (let ((type (c-syntactic-content from to c-recognize-<>-arglists))) (unless (gethash type c-found-types) - (remhash (substring type 0 -1) c-found-types) - (puthash type t c-found-types)))) + (puthash type t c-found-types) + (when (and (eq (string-match c-symbol-key type) 0) + (eq (match-end 0) (length type))) + (c-fontify-new-found-type type))))) + +(defun c-add-type (from to) + ;; Add the given region as a type in `c-found-types'. Also perform the + ;; actions of `c-add-type-1'. If the region is or overlaps an identifier + ;; which might be being typed in, don't record it. This is tested by + ;; checking `c-new-id-start' and `c-new-id-end'. That's done to avoid + ;; adding all prefixes of a type as it's being entered and font locked. + ;; This is a bit rough and ready, but now covers adding characters into the + ;; middle of an identifer. + ;; + ;; This function might do hidden buffer changes. + (if (and c-new-id-start c-new-id-end + (<= from c-new-id-end) (>= to c-new-id-start)) + (setq c-new-id-is-type t) + (c-add-type-1 from to))) (defun c-unfind-type (name) ;; Remove the "NAME" from c-found-types, if present. diff --git a/lisp/progmodes/cc-fonts.el b/lisp/progmodes/cc-fonts.el index bc0ae6cc95..9355409b2a 100644 --- a/lisp/progmodes/cc-fonts.el +++ b/lisp/progmodes/cc-fonts.el @@ -93,10 +93,14 @@ (cc-bytecomp-defvar c-preprocessor-face-name) (cc-bytecomp-defvar c-reference-face-name) (cc-bytecomp-defvar c-block-comment-flag) +(cc-bytecomp-defvar c-type-finder-pos) +(cc-bytecomp-defvar c-inhibit-type-finder) +(cc-bytecomp-defvar c-type-finder-timer) (cc-bytecomp-defun c-fontify-recorded-types-and-refs) (cc-bytecomp-defun c-font-lock-declarators) (cc-bytecomp-defun c-font-lock-objc-method) (cc-bytecomp-defun c-font-lock-invalid-string) +(cc-bytecomp-defun c-before-context-fl-expand-region) ;; Note that font-lock in XEmacs doesn't expand face names as @@ -919,13 +923,6 @@ casts and declarations are fontified. Used on level 2 and higher." ;; This function does hidden buffer changes. ;;(message "c-font-lock-complex-decl-prepare %s %s" (point) limit) - - ;; Clear the list of found types if we start from the start of the - ;; buffer, to make it easier to get rid of misspelled types and - ;; variables that have gotten recognized as types in malformed code. - (when (bobp) - (c-clear-found-types)) - (c-skip-comments-and-strings limit) (when (< (point) limit) @@ -1605,6 +1602,175 @@ casts and declarations are fontified. Used on level 2 and higher." nil)))) +(defun c-find-types-background (start limit) + ;; Find any "found types" between START and LIMIT. Allow any such types to + ;; be entered into `c-found-types' by the action of `c-forward-name' or + ;; `c-forward-type' called from this function. This process also causes + ;; occurrences of the type to be prepared for fontification throughout the + ;; buffer. + ;; + ;; Return POINT at the end of the function. This should be at or after + ;; LIMIT, and not later than the next decl-spot after LIMIT. + ;; + ;; This function is called from the timer `c-type-finder-timer'. It may do + ;; hidden buffer changes. + (save-excursion + (save-restriction + (widen) + (goto-char start) + ;; If we're in a (possibly large) literal, skip over it. + (let ((lit-bounds (nth 2 (c-full-pp-to-literal (point))))) + (if lit-bounds + (goto-char (cdr lit-bounds)))) + (when (< (point) limit) + (let (;; o - 'decl if we're in an arglist containing declarations + ;; (but if `c-recognize-paren-inits' is set it might also be + ;; an initializer arglist); + ;; o - '<> if the arglist is of angle bracket type; + ;; o - 'arglist if it's some other arglist; + ;; o - nil, if not in an arglist at all. This includes the + ;; parenthesized condition which follows "if", "while", etc. + context + ;; A list of starting positions of possible type declarations, or of + ;; the typedef preceding one, if any. + last-cast-end + ;; The result from `c-forward-decl-or-cast-1'. + decl-or-cast + ;; The maximum of the end positions of all the checked type + ;; decl expressions in the successfully identified + ;; declarations. The position might be either before or + ;; after the syntactic whitespace following the last token + ;; in the type decl expression. + (max-type-decl-end 0) + ;; Same as `max-type-decl-*', but used when we're before + ;; `token-pos'. + (max-type-decl-end-before-token 0) + ) + (goto-char start) + (c-find-decl-spots + limit + c-decl-start-re + nil ; (eval c-maybe-decl-faces) + + (lambda (match-pos inside-macro &optional toplev) + ;; Note to maintainers: don't use `limit' inside this lambda form; + ;; c-find-decl-spots sometimes narrows to less than `limit'. + (if (and c-macro-with-semi-re + (looking-at c-macro-with-semi-re)) + ;; Don't do anything more if we're looking at something that + ;; can't start a declaration. + t + + ;; Set `context' and `c-restricted-<>-arglists'. Look for + ;; "<" for the sake of C++-style template arglists. + ;; "Ignore "(" when it's part of a control flow construct + ;; (e.g. "for ("). + (let ((got-context + (c-get-fontification-context + match-pos + (< match-pos (if inside-macro + max-type-decl-end-before-token + max-type-decl-end)) + toplev))) + (setq context (car got-context) + c-restricted-<>-arglists (cdr got-context))) + + ;; In QT, "more" is an irritating keyword that expands to nothing. + ;; We skip over it to prevent recognition of "more slots: " + ;; as a bitfield declaration. + (when (and (c-major-mode-is 'c++-mode) + (looking-at + (concat "\\(more\\)\\([^" c-symbol-chars "]\\|$\\)"))) + (goto-char (match-end 1)) + (c-forward-syntactic-ws)) + + ;; Now analyze the construct. This analysis will cause + ;; `c-forward-name' and `c-forward-type' to call `c-add-type', + ;; triggering the desired recognition and fontification of + ;; these found types. + (when (not (eq context 'not-decl)) + (setq decl-or-cast + (c-forward-decl-or-cast-1 + match-pos context last-cast-end)) + + (cond + ((eq decl-or-cast 'cast) + ;; Save the position after the previous cast so we can feed + ;; it to `c-forward-decl-or-cast-1' in the next round. That + ;; helps it discover cast chains like "(a) (b) c". + (setq last-cast-end (point)) + nil) + (decl-or-cast + ;; We've found a declaration. + + ;; Set `max-type-decl-end' or `max-type-decl-end-before-token' + ;; under the assumption that we're after the first type decl + ;; expression in the declaration now. That's not really true; + ;; we could also be after a parenthesized initializer + ;; expression in C++, but this is only used as a last resort + ;; to slant ambiguous expression/declarations, and overall + ;; it's worth the risk to occasionally fontify an expression + ;; as a declaration in an initializer expression compared to + ;; getting ambiguous things in normal function prototypes + ;; fontified as expressions. + (if inside-macro + (when (> (point) max-type-decl-end-before-token) + (setq max-type-decl-end-before-token (point))) + (when (> (point) max-type-decl-end) + (setq max-type-decl-end (point))))) + (t t)))))))) + (point)))) + +(defun c-type-finder-timer-func () + ;; A CC Mode idle timer function for finding "found types". It triggers + ;; every `c-type-finder-repeat-time' seconds and processes buffer chunks of + ;; size around `c-type-finder-chunk-size' characters, and runs for (a little + ;; over) `c-type-finder-time-slot' seconds. The types it finds are inserted + ;; into `c-found-types', and their occurrences throughout the buffer are + ;; prepared for fontification. + (when (and c-type-finder-time-slot + (boundp 'font-lock-support-mode) + (eq font-lock-support-mode 'jit-lock-mode)) + (if c-inhibit-type-finder ; No processing immediately after a GC operation. + (setq c-inhibit-type-finder nil) + (let* ((stop-time (+ (float-time) c-type-finder-time-slot)) + (buf-list (buffer-list))) + ;; One CC Mode buffer needing processing each time around this loop. + (while (and buf-list + (< (float-time) stop-time)) + ;; Cdr through BUF-LIST to find the next buffer needing processing. + (while (and buf-list + (not (with-current-buffer (car buf-list) c-type-finder-pos))) + (setq buf-list (cdr buf-list))) + (when buf-list + (with-current-buffer (car buf-list) + ;; (message "%s" (current-buffer)) ; Useful diagnostic. + (save-restriction + (widen) + ;; Process one `c-type-finder-chunk-size' chunk each time + ;; around this loop. + (while (and c-type-finder-pos + (< (float-time) stop-time)) + ;; Process one chunk per iteration. + (save-match-data + (c-save-buffer-state + (case-fold-search + (beg (marker-position c-type-finder-pos)) + (end (min (+ beg c-type-finder-chunk-size) (point-max))) + (region (c-before-context-fl-expand-region beg end))) + (setq beg (car region) + end (cdr region)) + (setq beg (max (c-find-types-background beg end) end)) + (move-marker c-type-finder-pos + (if (save-excursion (goto-char beg) (eobp)) + nil + beg)) + (when (not (marker-position c-type-finder-pos)) + (setq c-type-finder-pos nil)))))))))))) + ;; Set the timer to run again. + (setq c-type-finder-timer + (run-at-time c-type-finder-repeat-time nil #'c-type-finder-timer-func))) + (defun c-font-lock-enum-body (limit) ;; Fontify the identifiers of each enum we find by searching forward. ;; @@ -2255,6 +2421,46 @@ higher." ;; defvar will install its default value later on. (makunbound def-var))) +;; `c-re-redisplay-timer' is a timer which, when triggered, causes a +;; redisplay. +(defvar c-re-redisplay-timer nil) + +(defun c-force-redisplay (start end) + ;; Force redisplay immediately. This assumes `font-lock-support-mode' is + ;; 'jit-lock-mode. Set the variable `c-re-redisplay-timer' to nil. + (jit-lock-force-redisplay (copy-marker start) (copy-marker end)) + (setq c-re-redisplay-timer nil)) + +(defun c-fontify-new-found-type (type) + ;; Cause the fontification of TYPE, a string, wherever it occurs in the + ;; buffer. If TYPE is currently displayed in a window, cause redisplay to + ;; happen "instantaneously". These actions are done only when jit-lock-mode + ;; is active. + (when (and (boundp 'font-lock-support-mode) + (eq font-lock-support-mode 'jit-lock-mode)) + (c-save-buffer-state + ((window-boundaries + (mapcar (lambda (win) + (cons (window-start win) + (window-end win))) + (get-buffer-window-list (current-buffer) 'no-mini t))) + (target-re (concat "\\_<" type "\\_>"))) + (save-excursion + (save-restriction + (widen) + (goto-char (point-min)) + (while (re-search-forward target-re nil t) + (put-text-property (match-beginning 0) (match-end 0) + 'fontified nil) + (dolist (win-boundary window-boundaries) + (when (and (< (match-beginning 0) (cdr win-boundary)) + (> (match-end 0) (car win-boundary)) + (c-get-char-property (match-beginning 0) 'fontified) + (not c-re-redisplay-timer)) + (setq c-re-redisplay-timer + (run-with-timer 0 nil #'c-force-redisplay + (match-beginning 0) (match-end 0))))))))))) + ;;; C. diff --git a/lisp/progmodes/cc-mode.el b/lisp/progmodes/cc-mode.el index c9b7a95df6..ee5872d761 100644 --- a/lisp/progmodes/cc-mode.el +++ b/lisp/progmodes/cc-mode.el @@ -129,6 +129,16 @@ ; ' (require 'cc-fonts) ;) +(defvar c-type-finder-timer nil) +;; The variable which holds the repeating idle timer which triggers off the +;; background type finding search. + +(defvar c-inhibit-type-finder nil) +;; When non-nil (set by `c-post-gc-hook') don't perform the type finding +;; activities the next time `c-type-finder-timer' triggers. This ensures +;; keyboard/mouse input will be dealt with when garbage collection is taking a +;; large portion of CPU time. + ;; The following three really belong to cc-fonts.el, but they are required ;; even when cc-fonts.el hasn't been loaded (this happens in XEmacs when ;; font-lock-mode is nil). @@ -179,6 +189,18 @@ (when c-buffer-is-cc-mode (save-restriction (widen) + (let ((lst (buffer-list))) + (catch 'found + (dolist (b lst) + (if (and (not (eq b (current-buffer))) + (with-current-buffer b + c-buffer-is-cc-mode)) + (throw 'found nil))) + (remove-hook 'post-command-hook 'c-post-command) + (remove-hook 'post-gc-hook 'c-post-gc-hook) + (and c-type-finder-timer + (progn (cancel-timer c-type-finder-timer) + (setq c-type-finder-timer nil))))) (c-save-buffer-state () (c-clear-char-properties (point-min) (point-max) 'category) (c-clear-char-properties (point-min) (point-max) 'syntax-table) @@ -574,6 +596,12 @@ preferably use the `c-mode-menu' language constant directly." ;; currently no such text property. (make-variable-buffer-local 'c-max-syn-tab-mkr) +;; `c-type-finder-pos' is a marker marking the current place in a CC Mode +;; buffer which is due to be searched next for "found types", or nil if the +;; searching is complete. +(defvar c-type-finder-pos nil) +(make-variable-buffer-local 'c-type-finder-pos) + (defun c-basic-common-init (mode default-style) "Initialize the syntax handling routines and the line breaking/filling code. Intended to be used by other packages that embed CC Mode. @@ -745,6 +773,19 @@ that requires a literal mode spec at compile time." ;; would do since font-lock uses a(n implicit) depth of 0) so we don't need ;; c-after-font-lock-init. (add-hook 'after-change-functions 'c-after-change nil t) + (add-hook 'post-command-hook 'c-post-command) + (setq c-type-finder-pos + (save-restriction + (widen) + (move-marker (make-marker) (point-min)))) + + ;; Install the functionality for seeking "found types" at mode startup: + (or c-type-finder-timer + (setq c-type-finder-timer + (run-at-time + c-type-finder-repeat-time nil #'c-type-finder-timer-func))) + (add-hook 'post-gc-hook #'c-post-gc-hook) + (when (boundp 'font-lock-extend-after-change-region-function) (set (make-local-variable 'font-lock-extend-after-change-region-function) 'c-extend-after-change-region))) ; Currently (2009-05) used by all @@ -1950,6 +1991,46 @@ Note that this is a strict tail, so won't match, e.g. \"0x....\".") ;; confused by already processed single quotes. (narrow-to-region (point) (point-max)))))) +;; The next two variables record the bounds of an identifier currently being +;; typed in. These are used to prevent such a partial identifier being +;; recorded as a found type by c-add-type. +(defvar c-new-id-start nil) +(make-variable-buffer-local 'c-new-id-start) +(defvar c-new-id-end nil) +(make-variable-buffer-local 'c-new-id-end) +;; The next variable, when non-nil, records that the previous two variables +;; define a type. +(defvar c-new-id-is-type nil) +(make-variable-buffer-local 'c-new-id-is-type) + +(defun c-update-new-id (end) + ;; Note the bounds of any identifier that END is in or just after, in + ;; `c-new-id-start' and `c-new-id-end'. Otherwise set these variables to + ;; nil. + (save-excursion + (goto-char end) + (let ((id-beg (c-on-identifier))) + (setq c-new-id-start id-beg + c-new-id-end (and id-beg + (progn (c-end-of-current-token) (point))))))) + + +(defun c-post-command () + ;; If point was inside of a new identifier and no longer is, record that + ;; fact. + (when (and c-buffer-is-cc-mode + c-new-id-start c-new-id-end + (or (> (point) c-new-id-end) + (< (point) c-new-id-start))) + (when c-new-id-is-type + (c-add-type-1 c-new-id-start c-new-id-end)) + (setq c-new-id-start nil + c-new-id-end nil + c-new-id-is-type nil))) + +(defun c-post-gc-hook (&optional _stats) ; For XEmacs. + (setq c-inhibit-type-finder t)) + (defun c-before-change (beg end) ;; Function to be put on `before-change-functions'. Primarily, this calls ;; the language dependent `c-get-state-before-change-functions'. It is @@ -1969,11 +2050,16 @@ Note that this is a strict tail, so won't match, e.g. \"0x....\".") (unless (c-called-from-text-property-change-p) (save-restriction (widen) + ;; Clear the list of found types if we make a change at the start of the + ;; buffer, to make it easier to get rid of misspelled types and + ;; variables that have gotten recognized as types in malformed code. + (when (eq beg (point-min)) + (c-clear-found-types)) (if c-just-done-before-change - ;; We have two consecutive calls to `before-change-functions' without - ;; an intervening `after-change-functions'. An example of this is bug - ;; #38691. To protect CC Mode, assume that the entire buffer has - ;; changed. + ;; We have two consecutive calls to `before-change-functions' + ;; without an intervening `after-change-functions'. An example of + ;; this is bug #38691. To protect CC Mode, assume that the entire + ;; buffer has changed. (setq beg (point-min) end (point-max) c-just-done-before-change 'whole-buffer) @@ -2151,6 +2237,7 @@ Note that this is a strict tail, so won't match, e.g. \"0x....\".") c->-as-paren-syntax) (c-clear-char-property-with-value beg end 'syntax-table nil))) + (c-update-new-id end) (c-trim-found-types beg end old-len) ; maybe we don't ; need all of these. (c-invalidate-sws-region-after beg end old-len) diff --git a/lisp/progmodes/cc-vars.el b/lisp/progmodes/cc-vars.el index 83fd3da7c1..40a43c32ed 100644 --- a/lisp/progmodes/cc-vars.el +++ b/lisp/progmodes/cc-vars.el @@ -1524,6 +1524,39 @@ working due to this change." :type 'boolean :group 'c) +(defcustom c-type-finder-time-slot 0.05 + "The length in seconds of a background type search time slot. + +In CC Mode modes, \"found types\" wouldn't always get cleanly +fontified without the background searching for them which happens +in the seconds after starting Emacs or initializing the major +mode. + +This background searching can be disabled by setting this option +to nil." + :type '(choice (const :tag "disabled" nil) + number) + :group 'c) + +(defcustom c-type-finder-repeat-time 0.1 + "The interval, in seconds, at which background type searches occur. + +This interval must be greater than `c-type-finder-time-slot'." + :type 'number + :group 'c) + +(defcustom c-type-finder-chunk-size 1000 + "The size, in characters, of a chunk for background type search. + +Chunks of this size are searched atomically for \"found types\" +just after starting Emacs or initializing the major mode. + +This chunk size is a balance between efficiency (with larger +values) and responsiveness of the keyboard (with smaller values). +See also `c-type-finder-time-slot'." + :type 'integer + :group 'c) + (define-widget 'c-extra-types-widget 'radio "Internal CC Mode widget for the `*-font-lock-extra-types' variables." :args '((const :tag "none" nil) commit ee579033b9519f24296f1142d7cb1631f97cebcb Author: Juri Linkov Date: Sun Oct 24 22:21:31 2021 +0300 * test/lisp/repeat-tests.el: New file. diff --git a/test/lisp/repeat-tests.el b/test/lisp/repeat-tests.el new file mode 100644 index 0000000000..a1f9bbb173 --- /dev/null +++ b/test/lisp/repeat-tests.el @@ -0,0 +1,111 @@ +;;; repeat-tests.el --- Tests for repeat.el -*- lexical-binding: t; -*- + +;; Copyright (C) 2021 Free Software Foundation, Inc. + +;; Author: Juri Linkov + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Code: + +(require 'ert) +(require 'repeat) + +(defvar repeat-tests-calls nil) + +(defun repeat-tests-call-a (&optional arg) + (interactive "p") + (push `(,arg a) repeat-tests-calls)) + +(defun repeat-tests-call-b (&optional arg) + (interactive "p") + (push `(,arg b) repeat-tests-calls)) + +(defvar repeat-tests-map + (let ((map (make-sparse-keymap))) + (define-key map (kbd "C-x w a") 'repeat-tests-call-a) + map) + "Keymap for keys that initiate repeating sequences.") + +(defvar repeat-tests-repeat-map + (let ((map (make-sparse-keymap))) + (define-key map "a" 'repeat-tests-call-a) + (define-key map "b" 'repeat-tests-call-b) + map) + "Keymap for repeating sequences.") +(put 'repeat-tests-call-a 'repeat-map 'repeat-tests-repeat-map) +(put 'repeat-tests-call-b 'repeat-map 'repeat-tests-repeat-map) + +(defmacro with-repeat-mode (&rest body) + "Create environment for testing `repeat-mode'." + `(unwind-protect + (progn + (repeat-mode +1) + (with-temp-buffer + (save-window-excursion + ;; `execute-kbd-macro' applied to window only + (set-window-buffer nil (current-buffer)) + (use-local-map repeat-tests-map) + ,@body))) + (repeat-mode -1))) + +(defun repeat-tests--check (keys calls inserted) + (setq repeat-tests-calls nil) + (delete-region (point-min) (point-max)) + (execute-kbd-macro (kbd keys)) + (should (equal (nreverse repeat-tests-calls) calls)) + ;; Check for self-inserting keys + (should (equal (buffer-string) inserted))) + +(ert-deftest repeat-tests-exit-key () + (with-repeat-mode + (let ((repeat-echo-function 'ignore)) + (let ((repeat-exit-key nil)) + (repeat-tests--check + "C-x w a b a b RET c" + '((1 a) (1 b) (1 a) (1 b)) "\nc")) + (let ((repeat-exit-key [return])) + (repeat-tests--check + "C-x w a b a b c" + '((1 a) (1 b) (1 a) (1 b)) "c"))))) + +(ert-deftest repeat-tests-keep-prefix () + (with-repeat-mode + (let ((repeat-echo-function 'ignore)) + (repeat-tests--check + "C-x w a b a b c" + '((1 a) (1 b) (1 a) (1 b)) "c") + (let ((repeat-keep-prefix nil)) + (repeat-tests--check + "C-2 C-x w a b a b c" + '((2 a) (1 b) (1 a) (1 b)) "c") + (repeat-tests--check + "C-2 C-x w a C-3 c" + '((2 a)) "ccc")) + ;; TODO: fix and uncomment + ;; (let ((repeat-keep-prefix t)) + ;; (repeat-tests--check + ;; "C-2 C-x w a b a b c" + ;; '((2 a) (2 b) (2 a) (2 b)) "c") + ;; (repeat-tests--check + ;; "C-2 C-x w a C-1 C-2 b a C-3 C-4 b c" + ;; '((2 a) (12 b) (12 a) (34 b)) "c")) + ))) + +;; TODO: :tags '(:expensive-test) for repeat-exit-timeout + +(provide 'repeat-tests) +;;; repeat-tests.el ends here commit 7385a7667fda2bcc0df71def10c9e14c995ee8f9 Author: Juri Linkov Date: Sun Oct 24 22:20:15 2021 +0300 * lisp/tab-bar.el (tab-bar-move-repeat-map): Fix alias binding of tab-move. (tab-bar-move-tab-backward): Put 'repeat-map' symbol property. diff --git a/lisp/tab-bar.el b/lisp/tab-bar.el index 10ff57bfd0..10f26875db 100644 --- a/lisp/tab-bar.el +++ b/lisp/tab-bar.el @@ -2378,12 +2378,13 @@ Used in `repeat-mode'.") (defvar tab-bar-move-repeat-map (let ((map (make-sparse-keymap))) - (define-key map "m" 'tab-bar-move-tab) + (define-key map "m" 'tab-move) (define-key map "M" 'tab-bar-move-tab-backward) map) "Keymap to repeat tab move key sequences `C-x t m m M'. Used in `repeat-mode'.") (put 'tab-move 'repeat-map 'tab-bar-move-repeat-map) +(put 'tab-bar-move-tab-backward 'repeat-map 'tab-bar-move-repeat-map) (provide 'tab-bar) commit 89365d748f15f2fd789c3818480a16849ac05a94 Author: Lars Ingebrigtsen Date: Sun Oct 24 21:21:25 2021 +0200 Fix mouse buttons in dired--make-directory-clickable * lisp/dired.el (dired--make-directory-clickable): Adjust mouse clicks to conform to our standards. diff --git a/lisp/dired.el b/lisp/dired.el index ced18114c4..40dfc39b9a 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -1672,7 +1672,8 @@ see `dired-use-ls-dired' for more details.") (dired-goto-subdir current-dir) (dired current-dir))))) (define-keymap - [down-mouse-1] click + [mouse-2] click + [follow-link] 'mouse-face ["RET"] click)))) (setq segment-start (point))))))) commit 56caf1c9b887ccbb6d35a95ca257f633bb71d1d3 Author: Stefan Kangas Date: Sun Oct 24 21:20:16 2021 +0200 Use restrictive umask when creating image-dired data * lisp/image-dired.el (image-dired-dir) (image-dired-sane-db-file): Create thumbnail directory and .image-dired_db with umask 077. This avoids creating world readable copies of private data, and is in fact mandated by the Thumbnail Managing Standard that we aim to support. diff --git a/lisp/image-dired.el b/lisp/image-dired.el index 2af0c6654e..e5fbfcf927 100644 --- a/lisp/image-dired.el +++ b/lisp/image-dired.el @@ -538,7 +538,8 @@ Create the thumbnails directory if it does not exist." (let ((image-dired-dir (file-name-as-directory (expand-file-name image-dired-dir)))) (unless (file-directory-p image-dired-dir) - (make-directory image-dired-dir t) + (with-file-modes #o700 + (make-directory image-dired-dir t)) (message "Creating thumbnails directory")) image-dired-dir)) @@ -1070,10 +1071,12 @@ Signal error if there are problems creating it." (let (dir buf) (unless (file-directory-p (setq dir (file-name-directory image-dired-db-file))) - (make-directory dir t)) + (with-file-modes #o700 + (make-directory dir t))) (with-current-buffer (setq buf (create-file-buffer image-dired-db-file)) - (write-file image-dired-db-file)) + (with-file-modes #o600 + (write-file image-dired-db-file))) (kill-buffer buf) (file-exists-p image-dired-db-file)) (error "Could not create %s" image-dired-db-file))) @@ -2515,6 +2518,7 @@ when using per-directory thumbnail file storage")) (if (file-exists-p image-dired-gallery-dir) (if (not (file-directory-p image-dired-gallery-dir)) (error "Variable image-dired-gallery-dir is not a directory")) + ;; FIXME: Should we set umask to 077 here, as we do for thumbnails? (make-directory image-dired-gallery-dir)) ;; Open index file (with-temp-file index-file commit 3b5de7f9916c974bf3b2ae3bca90b9812c951eed Author: Jonas Bernoulli Date: Sun Oct 24 15:35:05 2021 +0200 ; lisp/transient.el: Revert some misguided stylistic fixes. These aren't actual modes. Set checkdoc-symbol-words to avoid false-positives. The first line of doc-strings of methods do not need to end with period. diff --git a/lisp/transient.el b/lisp/transient.el index c33a4c722a..77bf41deba 100644 --- a/lisp/transient.el +++ b/lisp/transient.el @@ -1289,8 +1289,8 @@ variable instead.") (defvar transient--exitp nil "Whether to exit the transient.") (defvar transient--showp nil "Whether the transient is show in a popup buffer.") -(defvar transient--helpp nil "Whether `help-mode' is active.") -(defvar transient--editp nil "Whether `edit-mode' is active.") +(defvar transient--helpp nil "Whether help-mode is active.") +(defvar transient--editp nil "Whether edit-mode is active.") (defvar transient--active-infix nil "The active infix awaiting user input.") @@ -3119,19 +3119,19 @@ and its value is returned to the caller." desc))) (cl-defmethod transient-format-description ((obj transient-group)) - "Format the description by calling the next method. -If the result doesn't use the `face' property at all, then apply -the face `transient-heading' to the complete string." + "Format the description by calling the next method. If the result +doesn't use the `face' property at all, then apply the face +`transient-heading' to the complete string." (when-let ((desc (cl-call-next-method obj))) (if (text-property-not-all 0 (length desc) 'face nil desc) desc (propertize desc 'face 'transient-heading)))) (cl-defmethod transient-format-description :around ((obj transient-suffix)) - "Format the description by calling the next method. -If the result is nil, then use \"(BUG: no description)\" as the -description. If the OBJ's `key' is currently unreachable, then -apply the face `transient-unreachable' to the complete string." + "Format the description by calling the next method. If the result +is nil, then use \"(BUG: no description)\" as the description. +If the OBJ's `key' is currently unreachable, then apply the face +`transient-unreachable' to the complete string." (let ((desc (or (cl-call-next-method obj) (and (slot-boundp transient--prefix 'suffix-description) (funcall (oref transient--prefix suffix-description) @@ -3672,5 +3672,6 @@ we stop there." (provide 'transient) ;; Local Variables: ;; indent-tabs-mode: nil +;; checkdoc-symbol-words: ("command-line" "edit-mode" "help-mode") ;; End: ;;; transient.el ends here commit 74846b8d3092466ee9e3dd1336b452a0eb50a5b3 Author: Lars Ingebrigtsen Date: Sun Oct 24 20:25:12 2021 +0200 Don't unhide first thread if entering without selecting article * lisp/gnus/gnus-sum.el (gnus-summary-first-unread-subject) (gnus-summary-first-unseen-subject) (gnus-summary-first-unseen-or-unread-subject): Use it. (gnus-summary--goto-and-possibly-unhide): New function -- don't unhide the first thread unless necessary (bug#51344). diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el index ab8c578c9c..f7385d19c8 100644 --- a/lisp/gnus/gnus-sum.el +++ b/lisp/gnus/gnus-sum.el @@ -8064,9 +8064,7 @@ Return nil if there are no unread articles." Return nil if there are no unread articles." (interactive nil gnus-summary-mode) (prog1 - (when (gnus-summary-first-subject t) - (gnus-summary-show-thread) - (gnus-summary-first-subject t)) + (gnus-summary--goto-and-possibly-unhide t) (gnus-summary-position-point))) (defun gnus-summary-next-unseen-article (&optional backward) @@ -8100,23 +8098,27 @@ Return nil if there are no unread articles." Return nil if there are no unseen articles." (interactive nil gnus-summary-mode) (prog1 - (when (gnus-summary-first-subject nil nil t) - (gnus-summary-show-thread) - (gnus-summary-first-subject nil nil t)) + (gnus-summary--goto-and-possibly-unhide) (gnus-summary-position-point))) +(defun gnus-summary--goto-and-possibly-unhide (&optional unread undownloaded + unseen) + (let ((first (gnus-summary-first-subject unread undownloaded unseen))) + (if (and first + (not (= first (gnus-summary-article-number)))) + (progn + (gnus-summary-show-thread) + (gnus-summary-first-subject unread undownloaded unseen)) + first))) + (defun gnus-summary-first-unseen-or-unread-subject () "Place the point on the subject line of the first unseen and unread article. If all articles have been seen, on the subject line of the first unread article." (interactive nil gnus-summary-mode) (prog1 - (unless (when (gnus-summary-first-subject nil nil t) - (gnus-summary-show-thread) - (gnus-summary-first-subject nil nil t)) - (when (gnus-summary-first-subject t) - (gnus-summary-show-thread) - (gnus-summary-first-subject t))) + (unless (gnus-summary--goto-and-possibly-unhide nil nil t) + (gnus-summary-first-subject t)) (gnus-summary-position-point))) (defun gnus-summary-first-article () commit e6946bf5f2c9cb23a7a569d0bf6154110df247c7 Author: Stefan Kangas Date: Sun Oct 24 18:36:09 2021 +0200 Improve documentation of image-dired thumbnails * lisp/image-dired.el: Fix documentation on thumbnail file format to correctly say that it can be either PNG or JPEG; not just JPEG. Also fix inconsistent formatting in comments. * lisp/image-dired.el (image-dired-thumbnail-storage): Improve docstring. diff --git a/lisp/image-dired.el b/lisp/image-dired.el index 13b2e5bc17..0a4db7a0e5 100644 --- a/lisp/image-dired.el +++ b/lisp/image-dired.el @@ -1,7 +1,7 @@ ;;; image-dired.el --- use dired to browse and manipulate your images -*- lexical-binding: t -*- -;; + ;; Copyright (C) 2005-2021 Free Software Foundation, Inc. -;; + ;; Version: 0.4.11 ;; Keywords: multimedia ;; Author: Mathias Dahl @@ -22,7 +22,7 @@ ;; along with GNU Emacs. If not, see . ;;; Commentary: -;; + ;; BACKGROUND ;; ========== ;; @@ -86,10 +86,13 @@ ;; =========== ;; ;; * Supports all image formats that Emacs and convert supports, but -;; the thumbnails are hard-coded to JPEG format. +;; the thumbnails are hard-coded to JPEG or PNG format. It uses +;; JPEG by default, but can optionally follow the Thumbnail Managing +;; Standard, which mandates PNG. See the user option +;; `image-dired-thumbnail-storage'. ;; ;; * WARNING: The "database" format used might be changed so keep a -;; backup of `image-dired-db-file' when testing new versions. +;; backup of `image-dired-db-file' when testing new versions. ;; ;; * `image-dired-display-image-mode' does not support animation ;; @@ -97,13 +100,13 @@ ;; ==== ;; ;; * Support gallery creation when using per-directory thumbnail -;; storage. +;; storage. ;; ;; * Some sort of auto-rotate function based on rotate info in the -;; EXIF data. +;; EXIF data. ;; ;; * Investigate if it is possible to also write the tags to the image -;; files. +;; files. ;; ;; * From thumbs.el: Add an option for clean-up/max-size functionality ;; for thumbnail directory. @@ -116,33 +119,32 @@ ;; * From thumbs.el: Add the "modify" commands (emboss, negate, ;; monochrome etc). ;; -;; * Add `image-dired-display-thumbs-ring' and functions to cycle that. Find -;; out which is best, saving old batch just before inserting new, or -;; saving the current batch in the ring when inserting it. Adding it -;; probably needs rewriting `image-dired-display-thumbs' to be more general. +;; * Add `image-dired-display-thumbs-ring' and functions to cycle that. Find out +;; which is best, saving old batch just before inserting new, or +;; saving the current batch in the ring when inserting it. Adding +;; it probably needs rewriting `image-dired-display-thumbs' to be more general. ;; ;; * Find some way of toggling on and off really nice keybindings in -;; dired (for example, using C-n or instead of C-S-n). Richard -;; suggested that we could keep C-t as prefix for image-dired commands -;; as it is currently not used in dired. He also suggested that -;; `dired-next-line' and `dired-previous-line' figure out if -;; image-dired is enabled in the current buffer and, if it is, call -;; `image-dired-dired-next-line' and -;; `image-dired-dired-previous-line', respectively. Update: This is -;; partly done; some bindings have now been added to dired. +;; dired (for example, using C-n or instead of C-S-n). +;; Richard suggested that we could keep C-t as prefix for +;; image-dired commands as it is currently not used in dired. He +;; also suggested that `dired-next-line' and `dired-previous-line' +;; figure out if image-dired is enabled in the current buffer and, +;; if it is, call `image-dired-dired-next-line' and `image-dired-dired-previous-line', +;; respectively. Update: This is partly done; some bindings have +;; now been added to dired. ;; ;; * Enhanced gallery creation with basic CSS-support and pagination -;; of tag pages with many pictures. +;; of tag pages with many pictures. ;; ;; * Rewrite `image-dired-modify-mark-on-thumb-original-file' to be -;; less ugly. +;; less ugly. ;; ;; * In some way keep track of buffers and windows and stuff so that -;; it works as the user expects. -;; -;; * More/better documentation -;; +;; it works as the user expects. ;; +;; * More/better documentation. + ;;; Code: (require 'dired) @@ -165,15 +167,30 @@ :type 'directory) (defcustom image-dired-thumbnail-storage 'use-image-dired-dir - "How to store image-dired's thumbnail files. -Image-Dired can store thumbnail files in one of two ways and this is -controlled by this variable. \"Use image-dired dir\" means that the -thumbnails are stored in a central directory. \"Per directory\" -means that each thumbnail is stored in a subdirectory called -\".image-dired\" in the same directory where the image file is. -\"Thumbnail Managing Standard\" means that the thumbnails are -stored and generated according to the Thumbnail Managing Standard -that allows sharing of thumbnails across different programs." + "How `image-dired' stores thumbnail files. +There are two ways that Image Dired can store and generate +thumbnails. If you set this variable to one of the two following +values, they will be stored in the JPEG format: + +- `use-image-dired-dir' means that the thumbnails are stored in a + central directory. + +- `per-directory' means that each thumbnail is stored in a + subdirectory called \".image-dired\" in the same directory + where the image file is. + +It can also use the \"Thumbnail Managing Standard\", which allows +sharing of thumbnails across different programs. This method +means that thumbnails are saved in the PNG format, and allows for +use the following file sizes: + +- `standard' means use thumbnails sized 128x128. +- `standard-large' means use thumbnails sized 256x256. + +Note that with this method of storing thumbnails, they will be +saved in subdirectories of `image-dired-dir'. For more +information on the Thumbnail Managing Standard, see: +https://specifications.freedesktop.org/thumbnail-spec/thumbnail-spec-latest.html" :type '(choice :tag "How to store thumbnail files" (const :tag "Use image-dired-dir" use-image-dired-dir) (const :tag "Thumbnail Managing Standard (normal 128x128)" standard) commit 6498a1a3ad82c52045c07a4b2009a1ffd641dce6 Author: Stefan Kangas Date: Sun Oct 24 18:28:20 2021 +0200 Add support for pngquant to image-dired * lisp/image-dired.el (image-dired-cmd-pngnq-program) (image-dired-cmd-pngnq-options): Add support for pngquant. Prefer, in this order: pngquant, pngnq-s9, pngnq-s for reasons of speed and how actively maintained the projects seem to be. diff --git a/lisp/image-dired.el b/lisp/image-dired.el index 6d94624a0a..13b2e5bc17 100644 --- a/lisp/image-dired.el +++ b/lisp/image-dired.el @@ -245,16 +245,23 @@ is replaced by the file name of the temporary file." :type '(repeat (string :tag "Argument"))) (defcustom image-dired-cmd-pngnq-program - (or (executable-find "pngnq") - (executable-find "pngnq-s9")) - "The file name of the `pngnq' program. + ;; Prefer pngquant to pngnq-s9 as it is faster on my machine. + ;; The project also seems more active than the alternatives. + ;; Prefer pngnq-s9 to pngnq as it fixes bugs in pngnq. + ;; The pngnq project seems dead (?) since 2011 or so. + (or (executable-find "pngquant") + (executable-find "pngnq-s9") + (executable-find "pngnq")) + "The file name of the `pngquant' or `pngnq' program. It quantizes colors of PNG images down to 256 colors or fewer using the NeuQuant algorithm." - :version "26.1" + :version "29.1" :type '(choice (const :tag "Not Set" nil) file)) (defcustom image-dired-cmd-pngnq-options - '("-f" "%t") + (if (executable-find "pngquant") + '("--ext" "-nq8.png" "%t") ; same extension as "pngnq" + '("-f" "%t")) "Arguments to pass `image-dired-cmd-pngnq-program'. Available format specifiers are the same as in `image-dired-cmd-create-thumbnail-options'." commit 3bad61e1ac5244efb4fff6062763ea759e0aafec Author: Eli Zaretskii Date: Sun Oct 24 20:45:56 2021 +0300 Fix compilation errors with MinGW64 GCC 11 * lib-src/ntlib.c (IS_DIRECTORY_SEP): Remove redundant macro. * lib-src/ntlib.c (DEFER_MS_W32_H): * nt/addpm.c (DEFER_MS_W32_H): * nt/cmdproxy.c (DEFER_MS_W32_H): * nt/ddeclient.c (DEFER_MS_W32_H): * nt/preprep.c (DEFER_MS_W32_H): * nt/runemacs.c (DEFER_MS_W32_H): Fix a typo. * nt/Makefile.in (BASE_CFLAGS): Add -I switches to pick up config.h and lib/attribute.h. diff --git a/lib-src/ntlib.c b/lib-src/ntlib.c index f1c68cb1b2..c8bcf742fe 100644 --- a/lib-src/ntlib.c +++ b/lib-src/ntlib.c @@ -20,7 +20,7 @@ GNU General Public License for more details. You should have received a copy of the GNU General Public License along with GNU Emacs. If not, see . */ -#define DEFER_MS_W3_H +#define DEFER_MS_W32_H #include #include @@ -290,9 +290,6 @@ is_exec (const char * name) stricmp (p, ".cmd") == 0)); } -/* FIXME? This is in configure.ac now - is this still needed? */ -#define IS_DIRECTORY_SEP(x) ((x) == '/' || (x) == '\\') - /* We need stat/fsfat below because nt/inc/sys/stat.h defines struct stat that is incompatible with the MS run-time libraries. */ int diff --git a/nt/Makefile.in b/nt/Makefile.in index 3274ff924f..811680da85 100644 --- a/nt/Makefile.in +++ b/nt/Makefile.in @@ -144,6 +144,7 @@ LIBS_ADDPM = -lole32 -luuid ## Compilation and linking flags BASE_CFLAGS = $(C_SWITCH_SYSTEM) $(C_SWITCH_MACHINE) \ $(WARN_CFLAGS) $(WERROR_CFLAGS) \ + -I../src -I${srcdir}/../src -I../lib -I${srcdir}/../lib \ -I. -I${srcdir} ALL_CFLAGS = ${BASE_CFLAGS} ${PROFILING_CFLAGS} ${LDFLAGS} ${CPPFLAGS} ${CFLAGS} diff --git a/nt/addpm.c b/nt/addpm.c index f07e4c2c5a..4fbcf6c05e 100644 --- a/nt/addpm.c +++ b/nt/addpm.c @@ -35,7 +35,7 @@ along with GNU Emacs. If not, see . */ progman way will be used instead, but that is prone to lockups caused by other applications not servicing their message queues. */ -#define DEFER_MS_W3_H +#define DEFER_MS_W32_H #include #include diff --git a/nt/cmdproxy.c b/nt/cmdproxy.c index 2bc03673d5..f5a0550aa9 100644 --- a/nt/cmdproxy.c +++ b/nt/cmdproxy.c @@ -27,7 +27,7 @@ GNU General Public License for more details. You should have received a copy of the GNU General Public License along with GNU Emacs. If not, see . */ -#define DEFER_MS_W3_H +#define DEFER_MS_W32_H #include #include diff --git a/nt/ddeclient.c b/nt/ddeclient.c index 1c1f7679ea..0a44cbfd77 100644 --- a/nt/ddeclient.c +++ b/nt/ddeclient.c @@ -16,7 +16,7 @@ GNU General Public License for more details. You should have received a copy of the GNU General Public License along with GNU Emacs. If not, see . */ -#define DEFER_MS_W3_H +#define DEFER_MS_W32_H #include #include diff --git a/nt/preprep.c b/nt/preprep.c index 48c55ef221..8b054b19a7 100644 --- a/nt/preprep.c +++ b/nt/preprep.c @@ -21,7 +21,7 @@ along with GNU Emacs. If not, see . based on code from addsection.c */ -#define DEFER_MS_W3_H +#define DEFER_MS_W32_H #include #include diff --git a/nt/runemacs.c b/nt/runemacs.c index cce4904d88..b4ed9fb156 100644 --- a/nt/runemacs.c +++ b/nt/runemacs.c @@ -40,7 +40,7 @@ along with GNU Emacs. If not, see . */ /* #define CHOOSE_NEWEST_EXE */ -#define DEFER_MS_W3_H +#define DEFER_MS_W32_H #include #include commit beb265450c01b3e3188f844ff0fb961d9df79071 Author: Paul Eggert Date: Sat Oct 23 20:35:18 2021 -0700 Include first in MS-Windows source diff --git a/lib-src/ntlib.c b/lib-src/ntlib.c index bcbc006431..f1c68cb1b2 100644 --- a/lib-src/ntlib.c +++ b/lib-src/ntlib.c @@ -20,6 +20,9 @@ GNU General Public License for more details. You should have received a copy of the GNU General Public License along with GNU Emacs. If not, see . */ +#define DEFER_MS_W3_H +#include + #include #include #include diff --git a/nt/addpm.c b/nt/addpm.c index f54a6ea9f7..f07e4c2c5a 100644 --- a/nt/addpm.c +++ b/nt/addpm.c @@ -34,6 +34,10 @@ along with GNU Emacs. If not, see . */ installed, then the DDE fallback for creating icons the Windows 3.1 progman way will be used instead, but that is prone to lockups caused by other applications not servicing their message queues. */ + +#define DEFER_MS_W3_H +#include + #include #include #include diff --git a/nt/cmdproxy.c b/nt/cmdproxy.c index 224f68b1e8..2bc03673d5 100644 --- a/nt/cmdproxy.c +++ b/nt/cmdproxy.c @@ -27,6 +27,9 @@ GNU General Public License for more details. You should have received a copy of the GNU General Public License along with GNU Emacs. If not, see . */ +#define DEFER_MS_W3_H +#include + #include #include /* va_args */ diff --git a/nt/ddeclient.c b/nt/ddeclient.c index c577bfcfa9..1c1f7679ea 100644 --- a/nt/ddeclient.c +++ b/nt/ddeclient.c @@ -16,6 +16,9 @@ GNU General Public License for more details. You should have received a copy of the GNU General Public License along with GNU Emacs. If not, see . */ +#define DEFER_MS_W3_H +#include + #include #include #include diff --git a/nt/preprep.c b/nt/preprep.c index 78ed1c3238..48c55ef221 100644 --- a/nt/preprep.c +++ b/nt/preprep.c @@ -21,6 +21,9 @@ along with GNU Emacs. If not, see . based on code from addsection.c */ +#define DEFER_MS_W3_H +#include + #include #include #include diff --git a/nt/runemacs.c b/nt/runemacs.c index 308e856be2..cce4904d88 100644 --- a/nt/runemacs.c +++ b/nt/runemacs.c @@ -40,6 +40,9 @@ along with GNU Emacs. If not, see . */ /* #define CHOOSE_NEWEST_EXE */ +#define DEFER_MS_W3_H +#include + #include #include #include commit 3f763898aaafa547a2a991eed99d2694670b07e4 Author: Eli Zaretskii Date: Sun Oct 24 20:19:47 2021 +0300 Fix compilation errors with MinGW64 GCC 11 * lib-src/ntlib.c (_GL_ATTRIBUTE_MALLOC) (_GL_ATTRIBUTE_DEALLOC_FREE): Define to avoid compilation errors with MinGW64 GCC 11. Suggested by Andy Moreton . Do not merge to master. diff --git a/lib-src/ntlib.c b/lib-src/ntlib.c index bcbc006431..ccf827cf52 100644 --- a/lib-src/ntlib.c +++ b/lib-src/ntlib.c @@ -20,6 +20,15 @@ GNU General Public License for more details. You should have received a copy of the GNU General Public License along with GNU Emacs. If not, see . */ +/* Temporary workaround for compilation problems with MinGW64 GCC 11. + The funky #ifdef's are to avoid warnings about unused macros. */ +#define _GL_ATTRIBUTE_MALLOC +#define _GL_ATTRIBUTE_DEALLOC_FREE +#ifdef _GL_ATTRIBUTE_MALLOC +#endif +#ifdef _GL_ATTRIBUTE_DEALLOC_FREE +#endif + #include #include #include commit d64936d8f6dfb7abbf5d6700b040be8937b7f22a Author: Lars Ingebrigtsen Date: Sun Oct 24 18:54:27 2021 +0200 Fix define-erc-response-handler indentation * lisp/erc/erc-backend.el (define-erc-response-handler): Add proper indentation. diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el index 140755fab5..a26cb740a7 100644 --- a/lisp/erc/erc-backend.el +++ b/lisp/erc/erc-backend.el @@ -1169,7 +1169,8 @@ Would expand to: \(fn (NAME &rest ALIASES) &optional EXTRA-FN-DOC EXTRA-VAR-DOC &rest FN-BODY)" (declare (debug (&define [&name "erc-response-handler@" (symbolp &rest symbolp)] - &optional sexp sexp def-body))) + &optional sexp sexp def-body)) + (indent defun)) (if (numberp name) (setq name (intern (format "%03i" name)))) (setq aliases (mapcar (lambda (a) (if (numberp a) commit c0ea1c8863ea8d9b39a3810435eb4b67e91c2f91 Author: Stefan Kangas Date: Sun Oct 24 18:18:43 2021 +0200 ; Unbreak creating thumbnails in image-dired * lisp/image-dired.el (image-dired-insert-thumbnail): Unbreak creating thumbnails after my previous commit. diff --git a/lisp/image-dired.el b/lisp/image-dired.el index 19bd97192d..6d94624a0a 100644 --- a/lisp/image-dired.el +++ b/lisp/image-dired.el @@ -551,10 +551,19 @@ Create the thumbnails directory if it does not exist." Add text properties ORIGINAL-FILE-NAME and ASSOCIATED-DIRED-BUFFER." (let (beg end) (setq beg (point)) - (image-dired-insert-image file - (image-type-from-file-header file) - image-dired-thumb-relief - image-dired-thumb-margin) + (image-dired-insert-image + file + ;; Thumbnails are created asynchronously, so we might not yet + ;; have a file. But if it exists, it might have been cached from + ;; before and we should use it instead of our current settings. + (or (and (file-exists-p file) + (image-type-from-file-header file)) + (and (memq image-dired-thumbnail-storage + '(standard standard-large)) + 'png) + 'jpeg) + image-dired-thumb-relief + image-dired-thumb-margin) (setq end (point)) (add-text-properties beg end commit 3dd19f2af0830e9bc4fef485ccb4498e54397c06 Author: Michael Albinus Date: Sun Oct 24 17:46:23 2021 +0200 ; * etc/NEWS: Fix typos. diff --git a/etc/NEWS b/etc/NEWS index 35bc9611a3..0714a4d61b 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -139,10 +139,10 @@ default, no automatic renaming is performed. ** Help *** New user option 'help-link-key-to-documentation'. -When this option is non-nil, key bindings displayed in the *Help* +When this option is non-nil, key bindings displayed in the "*Help*" buffer will be linked to the documentation for the command they are bound to. This does not affect listings of key bindings and -functions (such as `C-h b'). +functions (such as 'C-h b'). ** info-look @@ -194,10 +194,10 @@ as opposed to via the command-line. --- *** Reduce dependency on external "exiftool" command. -The `image-dired-copy-with-exif-file-name' no longer requires an +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. +'image-dired-cmd-read-exif-data-program' and +'image-dired-cmd-read-exif-data-options' are now obsolete. --- *** New command for the thumbnail buffer. @@ -217,7 +217,7 @@ the buffer will take you to that directory. *** New function 'exif-field'. This is a convenience function to extract the field data from -`exif-parse-file' and `exif-parse-buffer'. +'exif-parse-file' and 'exif-parse-buffer'. * New Modes and Packages in Emacs 29.1 @@ -278,8 +278,8 @@ MozRepl was removed from Firefox in 2017, so this code doesn't work with recent versions of Firefox. --- -** The function `image-dired-get-exif-data' is now obsolete. -Use `exif-parse-file' and `exif-field' instead. +** The function 'image-dired-get-exif-data' is now obsolete. +Use 'exif-parse-file' and 'exif-field' instead. * Lisp Changes in Emacs 29.1 commit 68d11cc248524750c008a418faca4a9182d51758 Author: Stefan Kangas Date: Sun Oct 24 16:47:22 2021 +0200 Add new option help-link-key-to-documentation * lisp/help.el (help-link-key-to-documentation): New user option. (substitute-command-keys): Add a link from keys to the command they are bound to, if the above new option is non-nil. (Bug#8951) * etc/NEWS: Announce the new option. diff --git a/etc/NEWS b/etc/NEWS index 602d13eefa..35bc9611a3 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -136,6 +136,14 @@ function which returns a string. For the first two cases, the length of the resulting name is controlled by 'eww-buffer-name-length'. By default, no automatic renaming is performed. +** Help + +*** New user option 'help-link-key-to-documentation'. +When this option is non-nil, key bindings displayed in the *Help* +buffer will be linked to the documentation for the command they are +bound to. This does not affect listings of key bindings and +functions (such as `C-h b'). + ** info-look --- diff --git a/lisp/help-mode.el b/lisp/help-mode.el index d61b1bdc62..53acbf97e7 100644 --- a/lisp/help-mode.el +++ b/lisp/help-mode.el @@ -376,6 +376,13 @@ The format is (FUNCTION ARGS...).") (view-buffer-other-window (find-file-noselect file)) (goto-char pos)) 'help-echo (purecopy "mouse-2, RET: show corresponding NEWS announcement")) + +;;;###autoload +(defun help-mode--add-function-link (str fun) + (make-text-button (copy-sequence str) nil + 'type 'help-function + 'help-args (list fun))) + (defvar bookmark-make-record-function) (defvar help-mode--current-data nil) diff --git a/lisp/help.el b/lisp/help.el index a5d5037bfe..510dee7f7a 100644 --- a/lisp/help.el +++ b/lisp/help.el @@ -1058,6 +1058,14 @@ is currently activated with completion." result)) +(defcustom help-link-key-to-documentation t + "Non-nil means link keys to their command in *Help* buffers. +This affects \\\\=\\[command] substitutions in documentation +strings done by `substitute-command-keys'." + :type 'boolean + :version "29.1" + :group 'help) + (defun substitute-command-keys (string) "Substitute key descriptions for command names in STRING. Each substring of the form \\\\=[COMMAND] is replaced by either a @@ -1145,7 +1153,14 @@ Otherwise, return a new string." (delete-char 1)) ;; Function is on a key. (delete-char (- end-point (point))) - (insert (help--key-description-fontified key))))) + (let ((key (help--key-description-fontified key))) + (insert (if (and help-link-key-to-documentation + (functionp fun)) + ;; The `fboundp' fixes bootstrap. + (if (fboundp 'help-mode--add-function-link) + (help-mode--add-function-link key fun) + key) + key)))))) ;; 1D. \{foo} is replaced with a summary of the keymap ;; (symbol-value foo). ;; \ just sets the keymap used for \[cmd]. commit 860e8c524bc1695b67fe1001412529da47b11138 Author: William Xu Date: Sun Oct 24 16:15:12 2021 +0200 Make dired directory components clickable * lisp/dired.el (dired-readin): Use it. * lisp/dired.el (dired-make-directory-clickable): New user option. * lisp/dired.el (dired--make-directory-clickable): New function (bug#21973). diff --git a/etc/NEWS b/etc/NEWS index 294181635e..602d13eefa 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -136,13 +136,6 @@ function which returns a string. For the first two cases, the length of the resulting name is controlled by 'eww-buffer-name-length'. By default, no automatic renaming is performed. -** image-dired - ---- -*** New command for the thumbnail buffer. -The new command 'image-dired-unmark-all-marks' has been added with a -binding in the menu. - ** info-look --- @@ -198,6 +191,20 @@ 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 for the thumbnail buffer. +The new command 'image-dired-unmark-all-marks' has been added with a +binding in the menu. + +** Dired + +--- +*** New user option 'dired-make-directory-clickable'. +If non-nil (which is the default), hitting 'RET' or 'mouse-1' on +the directory components at the directory displayed at the start of +the buffer will take you to that directory. + + ** Exif *** New function 'exif-field'. diff --git a/lisp/dired.el b/lisp/dired.el index 4652589122..ced18114c4 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -35,6 +35,7 @@ ;;; Code: (eval-when-compile (require 'subr-x)) +(eval-when-compile (require 'cl-lib)) ;; When bootstrapping dired-loaddefs has not been generated. (require 'dired-loaddefs nil t) @@ -281,6 +282,11 @@ with the buffer narrowed to the listing." ;; Note this can't simply be run inside function `dired-ls' as the hook ;; functions probably depend on the dired-subdir-alist to be OK. +(defcustom dired-make-directory-clickable t + "When non-nil, make the directory at the start of the dired buffer clickable." + :version "29.1" + :type 'boolean) + (defcustom dired-initial-position-hook nil "This hook is used to position the point. It is run by the function `dired-initial-position'." @@ -1326,6 +1332,8 @@ wildcards, erases the buffer, and builds the subdir-alist anew (set-visited-file-modtime (file-attribute-modification-time attributes)))) (set-buffer-modified-p nil) + (when dired-make-directory-clickable + (dired--make-directory-clickable)) ;; No need to narrow since the whole buffer contains just ;; dired-readin's output, nothing else. The hook can ;; successfully use dired functions (e.g. dired-get-filename) @@ -1643,6 +1651,31 @@ see `dired-use-ls-dired' for more details.") 'invisible 'dired-hide-details-link)))) (forward-line 1)))) +(defun dired--make-directory-clickable () + (save-excursion + (goto-char (point-min)) + (while (re-search-forward "^ /" nil t 1) + (let ((bound (line-end-position)) + (segment-start (point)) + (inhibit-read-only t) + (dir "/")) + (while (search-forward "/" bound t 1) + (setq dir (concat dir (buffer-substring segment-start (point)))) + (add-text-properties + segment-start (1- (point)) + `( mouse-face highlight + help-echo "mouse-1: goto this directory" + keymap ,(let* ((current-dir dir) + (click (lambda () + (interactive) + (if (assoc current-dir dired-subdir-alist) + (dired-goto-subdir current-dir) + (dired current-dir))))) + (define-keymap + [down-mouse-1] click + ["RET"] click)))) + (setq segment-start (point))))))) + ;;; Reverting a dired buffer commit 03d7dcb4610b0f8edf53427c2354cf52fa506edd Author: Mattias Engdegård Date: Sun Oct 24 12:15:31 2021 +0200 Don't use obsolete variable `find-tag-marker-ring` * lisp/progmodes/js.el (js-find-symbol): * lisp/progmodes/octave.el (octave-find-definition): Call `xref-push-marker-stack` instead of manipulating the obsolete variable `find-tag-marker-ring`. diff --git a/lisp/progmodes/js.el b/lisp/progmodes/js.el index f6603f86d5..f11995127d 100644 --- a/lisp/progmodes/js.el +++ b/lisp/progmodes/js.el @@ -3290,10 +3290,7 @@ marker." (setf (car bounds) (point)))) (buffer-substring (car bounds) (cdr bounds))))) -(defvar find-tag-marker-ring) ; etags - -;; etags loads ring. -(declare-function ring-insert "ring" (ring item)) +(declare-function xref-push-marker-stack "xref" (&optional m)) (defun js-find-symbol (&optional arg) "Read a JavaScript symbol and jump to it. @@ -3301,7 +3298,7 @@ With a prefix argument, restrict symbols to those from the current buffer. Pushes a mark onto the tag ring just like `find-tag'." (interactive "P") - (require 'etags) + (require 'xref) (let (symbols marker) (if (not arg) (setq symbols (js--get-all-known-symbols)) @@ -3313,7 +3310,7 @@ current buffer. Pushes a mark onto the tag ring just like symbols "Jump to: " (js--guess-symbol-at-point)))) - (ring-insert find-tag-marker-ring (point-marker)) + (xref-push-marker-stack) (switch-to-buffer (marker-buffer marker)) (push-mark) (goto-char marker))) diff --git a/lisp/progmodes/octave.el b/lisp/progmodes/octave.el index 6bf070cf9e..79530f8167 100644 --- a/lisp/progmodes/octave.el +++ b/lisp/progmodes/octave.el @@ -1814,18 +1814,18 @@ If the environment variable OCTAVE_SRCDIR is set, it is searched first." (user-error "Aborted"))) (_ name))) -(defvar find-tag-marker-ring) +(declare-function xref-push-marker-stack "xref" (&optional m)) (defun octave-find-definition (fn) "Find the definition of FN. Functions implemented in C++ can be found if variable `octave-source-directories' is set correctly." (interactive (list (octave-completing-read))) - (require 'etags) + (require 'xref) (let ((orig (point))) (if (and (derived-mode-p 'octave-mode) (octave-goto-function-definition fn)) - (ring-insert find-tag-marker-ring (copy-marker orig)) + (xref-push-marker-stack (copy-marker orig)) (inferior-octave-send-list-and-digest ;; help NAME is more verbose (list (format "\ @@ -1840,7 +1840,7 @@ if iskeyword('%s') disp('`%s'' is a keyword') else which('%s') endif\n" (setq file (match-string 1 line)))) (if (not file) (user-error "%s" (or line (format-message "`%s' not found" fn))) - (ring-insert find-tag-marker-ring (point-marker)) + (xref-push-marker-stack) (setq file (funcall octave-find-definition-filename-function file)) (when file (find-file file) commit 082e080c301380496b7a1d5a9c4636b19e9e3662 Author: Lars Ingebrigtsen Date: Sun Oct 24 15:18:33 2021 +0200 Tweak bug-reference-tests * test/lisp/progmodes/bug-reference-tests.el: Tweak tests a bit. diff --git a/test/lisp/progmodes/bug-reference-tests.el b/test/lisp/progmodes/bug-reference-tests.el index 803a1dd75a..7a355509a1 100644 --- a/test/lisp/progmodes/bug-reference-tests.el +++ b/test/lisp/progmodes/bug-reference-tests.el @@ -44,19 +44,19 @@ "larsmagne/csid")) (should (equal - (test--get-github-entry "https://github.com/emacs-mirror/emacs.git") - "emacs-mirror/emacs")) + (test--get-github-entry "https://github.com/magit/magit.git") + "magit/magit")) (should (equal - (test--get-github-entry "https://github.com/emacs-mirror/emacs.git/") - "emacs-mirror/emacs")) + (test--get-github-entry "https://github.com/magit/magit.git/") + "magit/magit")) (should (equal - (test--get-github-entry "https://github.com/emacs-mirror/emacs") - "emacs-mirror/emacs")) + (test--get-github-entry "https://github.com/magit/magit") + "magit/magit")) (should (equal - (test--get-github-entry "https://github.com/emacs-mirror/emacs/") - "emacs-mirror/emacs"))) + (test--get-github-entry "https://github.com/magit/magit/") + "magit/magit"))) ;;; bug-reference-tests.el ends here commit c1a71ea77419065d13f8a0bd8f488c27bd749610 Author: Lars Ingebrigtsen Date: Sun Oct 24 15:07:32 2021 +0200 Clean up duplicated setting in scheme-mode-variables * lisp/progmodes/scheme.el (scheme-mode-variables): Remove repeated setting. diff --git a/lisp/progmodes/scheme.el b/lisp/progmodes/scheme.el index 57351a7308..abcdcb3349 100644 --- a/lisp/progmodes/scheme.el +++ b/lisp/progmodes/scheme.el @@ -143,7 +143,6 @@ (setq-local comment-start-skip ";+[ \t]*") (setq-local comment-use-syntax t) (setq-local comment-column 40) - (setq-local parse-sexp-ignore-comments t) (setq-local lisp-indent-function 'scheme-indent-function) (setq mode-line-process '("" scheme-mode-line-process)) (setq-local imenu-case-fold-search t) commit 559fb593d777c4e24012b918bbab9f430006be3e Author: Lars Ingebrigtsen Date: Sun Oct 24 14:14:42 2021 +0200 Allow matching non-.git URLs in bug-reference * lisp/progmodes/bug-reference.el (bug-reference--build-forge-setup-entry): Allow matching non-.git URLs, with and without slashes (bug#51316). diff --git a/lisp/progmodes/bug-reference.el b/lisp/progmodes/bug-reference.el index 150dfac0d2..993d670917 100644 --- a/lisp/progmodes/bug-reference.el +++ b/lisp/progmodes/bug-reference.el @@ -271,7 +271,7 @@ via the internet it might also be http.") (cl-defmethod bug-reference--build-forge-setup-entry (host-domain (_forge-type (eql 'github)) protocol) `(,(concat "[/@]" (regexp-quote host-domain) - "[/:]\\([.A-Za-z0-9_/-]+\\)\\.git") + "[/:]\\([.A-Za-z0-9_/-]+?\\)\\(?:\\.git\\)?/?\\'") "\\(\\([.A-Za-z0-9_/-]+\\)?\\(?:#\\)\\([0-9]+\\)\\)\\>" ,(lambda (groups) (let ((ns-project (nth 1 groups))) diff --git a/test/lisp/progmodes/bug-reference-tests.el b/test/lisp/progmodes/bug-reference-tests.el new file mode 100644 index 0000000000..803a1dd75a --- /dev/null +++ b/test/lisp/progmodes/bug-reference-tests.el @@ -0,0 +1,62 @@ +;;; bug-reference-tests.el --- Tests for bug-reference.el -*- lexical-binding: t; -*- + +;; Copyright (C) 2021 Free Software Foundation, Inc. + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Commentary: + +;; + +;;; Code: + +(require 'bug-reference) +(require 'ert) + +(defun test--get-github-entry (protocol) + (and (string-match + (car (bug-reference--build-forge-setup-entry + "github.com" 'github protocol)) + protocol) + (match-string 1 protocol))) + +(ert-deftest test-github-entry () + (should + (equal + (test--get-github-entry "git@github.com:larsmagne/csid.git") + "larsmagne/csid")) + (should + (equal + (test--get-github-entry "git@github.com:larsmagne/csid") + "larsmagne/csid")) + (should + (equal + (test--get-github-entry "https://github.com/emacs-mirror/emacs.git") + "emacs-mirror/emacs")) + (should + (equal + (test--get-github-entry "https://github.com/emacs-mirror/emacs.git/") + "emacs-mirror/emacs")) + (should + (equal + (test--get-github-entry "https://github.com/emacs-mirror/emacs") + "emacs-mirror/emacs")) + (should + (equal + (test--get-github-entry "https://github.com/emacs-mirror/emacs/") + "emacs-mirror/emacs"))) + +;;; bug-reference-tests.el ends here commit 817c929edaf77dbdcd2ce7b9e6bbd3a5c57604f1 Author: Ihor Radchenko Date: Thu Jun 24 22:33:08 2021 +0800 Doc fix for concat * src/fns.c (Fconcat): Note that composition values may not remain eq in return value of concat. (Bug#48740) diff --git a/src/fns.c b/src/fns.c index a72e41aee5..6f358dd1ba 100644 --- a/src/fns.c +++ b/src/fns.c @@ -672,6 +672,9 @@ DEFUN ("concat", Fconcat, Sconcat, 0, MANY, 0, doc: /* Concatenate all the arguments and make the result a string. The result is a string whose elements are the elements of all the arguments. Each argument may be a string or a list or vector of characters (integers). + +Values of the `composition' property of the result are not guaranteed +to be `eq'. usage: (concat &rest SEQUENCES) */) (ptrdiff_t nargs, Lisp_Object *args) { commit 6b0a1b4fdf4331eb302b6af310989e2981dcd1c5 Author: Stefan Kangas Date: Sun Oct 24 12:26:39 2021 +0200 Don't hard-code image-dired thumbnail type * lisp/image-dired.el (image-dired-insert-thumbnail): Detect thumbnail image type instead of hard-coding it. diff --git a/lisp/image-dired.el b/lisp/image-dired.el index 863cd0fde2..19bd97192d 100644 --- a/lisp/image-dired.el +++ b/lisp/image-dired.el @@ -543,11 +543,7 @@ Create the thumbnails directory if it does not exist." (file-attribute-modification-time (file-attributes file)))) (image-dired-create-thumb file thumb-file)) - (create-image thumb-file) -;; (list 'image :type 'jpeg -;; :file thumb-file -;; :relief image-dired-thumb-relief :margin image-dired-thumb-margin) - )) + (create-image thumb-file))) (defun image-dired-insert-thumbnail (file original-file-name associated-dired-buffer) @@ -556,10 +552,7 @@ Add text properties ORIGINAL-FILE-NAME and ASSOCIATED-DIRED-BUFFER." (let (beg end) (setq beg (point)) (image-dired-insert-image file - ;; TODO: this should depend on the real file type - (if (memq image-dired-thumbnail-storage - '(standard standard-large)) - 'png 'jpeg) + (image-type-from-file-header file) image-dired-thumb-relief image-dired-thumb-margin) (setq end (point)) commit 3eca2ad2a10224aed82c2d32fb3056507cd9eacb Author: Stefan Kangas Date: Sun Oct 24 12:20:35 2021 +0200 * lisp/image-dired.el (image-dired-external-viewer): Support feh. diff --git a/lisp/image-dired.el b/lisp/image-dired.el index 4e6a410c11..2af0c6654e 100644 --- a/lisp/image-dired.el +++ b/lisp/image-dired.el @@ -504,11 +504,12 @@ with the comment." ;; dired-view-command-alist. (cond ((executable-find "display")) ((executable-find "xli")) - ((executable-find "qiv") "qiv -t")) + ((executable-find "qiv") "qiv -t") + ((executable-find "feh") "feh")) "Name of external viewer. Including parameters. Used when displaying original image from `image-dired-thumbnail-mode'." - :version "27.1" + :version "28.1" :type '(choice string (const :tag "Not Set" nil))) commit 418b54e49217f43d72e3d0cc3cfb583c791328a8 Author: Stefan Kangas Date: Sun Oct 24 12:07:48 2021 +0200 Expand tests for image-type-from-file-header * test/lisp/image-tests.el (image-tests--files): New defconst. (image-tests--type-from-file-header): New defun. (image-type-from-file-header-test/jpeg) (image-type-from-file-header-test/pbm) (image-type-from-file-header-test/png) (image-type-from-file-header-test/svg) (image-type-from-file-header-test/tiff) (image-type-from-file-header-test/webp) (image-type-from-file-header-test/xbm) (image-type-from-file-header-test/xpm): New tests. (image-type-from-file-header-test): Delete test. diff --git a/test/lisp/image-tests.el b/test/lisp/image-tests.el index c34c152cc9..79b0014f60 100644 --- a/test/lisp/image-tests.el +++ b/test/lisp/image-tests.el @@ -28,6 +28,27 @@ (expand-file-name "images" data-directory) "Directory containing Emacs images.") +(defconst image-tests--files + `((gif . ,(expand-file-name "test/data/image/black.gif" + source-directory)) + (jpeg . ,(expand-file-name "test/data/image/black.jpg" + source-directory)) + (pbm . ,(expand-file-name "splash.pbm" + image-tests--emacs-images-directory)) + (png . ,(expand-file-name "splash.png" + image-tests--emacs-images-directory)) + (svg . ,(expand-file-name "splash.svg" + image-tests--emacs-images-directory)) + (tiff . ,(expand-file-name + "nextstep/GNUstep/Emacs.base/Resources/emacs.tiff" + source-directory)) + (webp . ,(expand-file-name "test/data/image/black.webp" + source-directory)) + (xbm . ,(expand-file-name "gnus/gnus.xbm" + image-tests--emacs-images-directory)) + (xpm . ,(expand-file-name "splash.xpm" + image-tests--emacs-images-directory)))) + (ert-deftest image--set-property () "Test `image--set-property' behavior." (let ((image (list 'image))) @@ -64,12 +85,37 @@ (bound-and-true-p image-load-path))) (should (eq (image-type "foo.jpg") 'jpeg))) -(ert-deftest image-type-from-file-header-test () +(defun image-tests--type-from-file-header (type) "Test image-type-from-file-header." - (should (eq (if (image-type-available-p 'svg) 'svg) - (image-type-from-file-header - (expand-file-name "splash.svg" - image-tests--emacs-images-directory))))) + (should (eq (if (image-type-available-p type) type) + (image-type-from-file-header (cdr (assq type image-tests--files)))))) + +(ert-deftest image-type-from-file-header-test/gif () + (image-tests--type-from-file-header 'gif)) + +(ert-deftest image-type-from-file-header-test/jpeg () + (image-tests--type-from-file-header 'jpeg)) + +(ert-deftest image-type-from-file-header-test/pbm () + (image-tests--type-from-file-header 'pbm)) + +(ert-deftest image-type-from-file-header-test/png () + (image-tests--type-from-file-header 'png)) + +(ert-deftest image-type-from-file-header-test/svg () + (image-tests--type-from-file-header 'svg)) + +(ert-deftest image-type-from-file-header-test/tiff () + (image-tests--type-from-file-header 'tiff)) + +(ert-deftest image-type-from-file-header-test/webp () + (image-tests--type-from-file-header 'webp)) + +(ert-deftest image-type-from-file-header-test/xbm () + (image-tests--type-from-file-header 'xbm)) + +(ert-deftest image-type-from-file-header-test/xpm () + (image-tests--type-from-file-header 'xpm)) (ert-deftest image-rotate () "Test `image-rotate'." commit b2bfdd9658be87d34438f1a9ecd38242be6f6064 Author: Stefan Kangas Date: Sun Oct 24 12:05:37 2021 +0200 Add tests for gif to src/image-tests.el * test/src/image-tests.el (image-tests--images): Rename from image-tests-files. Add gif. (image-tests-image-size/gif) (image-tests-image-mask-p/gif) (image-tests-image-metadata/gif): New tests. * test/data/image/black.gif: New file. diff --git a/test/data/image/black.gif b/test/data/image/black.gif new file mode 100644 index 0000000000..6ab623e367 Binary files /dev/null and b/test/data/image/black.gif differ diff --git a/test/src/image-tests.el b/test/src/image-tests.el index b921739a05..2b236086b6 100644 --- a/test/src/image-tests.el +++ b/test/src/image-tests.el @@ -35,8 +35,10 @@ ;;;; Images -(defconst image-tests--files - `((jpeg . ,(expand-file-name "test/data/image/black.jpg" +(defconst image-tests--images + `((gif . ,(expand-file-name "test/data/image/black.gif" + source-directory)) + (jpeg . ,(expand-file-name "test/data/image/black.jpg" source-directory)) (pbm . ,(find-image '((:file "splash.svg" :type svg)))) (png . ,(find-image '((:file "splash.png" :type png)))) @@ -47,64 +49,69 @@ (webp . ,(expand-file-name "test/data/image/black.webp" source-directory)) (xbm . ,(find-image '((:file "gnus/gnus.xbm" :type xbm)))) - (xpm . ,(find-image '((:file "splash.xpm" :type xpm)))) - ;; TODO: gif - )) + (xpm . ,(find-image '((:file "splash.xpm" :type xpm)))))) ;;;; image-test-size +(ert-deftest image-tests-image-size/gif () + (image-skip-unless 'gif) + (pcase (image-size (create-image (cdr (assq 'gif image-tests--images)))) + (`(,a . ,b) + (should (floatp a)) + (should (floatp b))))) + (ert-deftest image-tests-image-size/jpeg () (image-skip-unless 'jpeg) - (pcase (image-size (create-image (cdr (assq 'jpeg image-tests--files)))) + (pcase (image-size (create-image (cdr (assq 'jpeg image-tests--images)))) (`(,a . ,b) (should (floatp a)) (should (floatp b))))) (ert-deftest image-tests-image-size/pbm () (image-skip-unless 'pbm) - (pcase (image-size (cdr (assq 'pbm image-tests--files))) + (pcase (image-size (cdr (assq 'pbm image-tests--images))) (`(,a . ,b) (should (floatp a)) (should (floatp b))))) (ert-deftest image-tests-image-size/png () (image-skip-unless 'png) - (pcase (image-size (cdr (assq 'png image-tests--files))) + (pcase (image-size (cdr (assq 'png image-tests--images))) (`(,a . ,b) (should (floatp a)) (should (floatp b))))) (ert-deftest image-tests-image-size/svg () (image-skip-unless 'svg) - (pcase (image-size (cdr (assq 'svg image-tests--files))) + (pcase (image-size (cdr (assq 'svg image-tests--images))) (`(,a . ,b) (should (floatp a)) (should (floatp b))))) (ert-deftest image-tests-image-size/tiff () (image-skip-unless 'tiff) - (pcase (image-size (create-image (cdr (assq 'tiff image-tests--files)))) + (pcase (image-size (create-image (cdr (assq 'tiff image-tests--images)))) (`(,a . ,b) (should (floatp a)) (should (floatp b))))) (ert-deftest image-tests-image-size/webp () (image-skip-unless 'webp) - (pcase (image-size (create-image (cdr (assq 'webp image-tests--files)))) + (pcase (image-size (create-image (cdr (assq 'webp image-tests--images)))) (`(,a . ,b) (should (floatp a)) (should (floatp b))))) (ert-deftest image-tests-image-size/xbm () (image-skip-unless 'xbm) - (pcase (image-size (cdr (assq 'xbm image-tests--files))) + (pcase (image-size (cdr (assq 'xbm image-tests--images))) (`(,a . ,b) (should (floatp a)) (should (floatp b))))) (ert-deftest image-tests-image-size/xpm () (image-skip-unless 'xpm) - (pcase (image-size (cdr (assq 'xpm image-tests--files))) + (pcase (image-size (cdr (assq 'xpm image-tests--images))) (`(,a . ,b) (should (floatp a)) (should (floatp b))))) @@ -119,40 +126,45 @@ ;;;; image-mask-p +(ert-deftest image-tests-image-mask-p/gif () + (image-skip-unless 'gif) + (should-not (image-mask-p (create-image + (cdr (assq 'gif image-tests--images)))))) + (ert-deftest image-tests-image-mask-p/jpeg () (image-skip-unless 'jpeg) (should-not (image-mask-p (create-image - (cdr (assq 'jpeg image-tests--files)))))) + (cdr (assq 'jpeg image-tests--images)))))) (ert-deftest image-tests-image-mask-p/pbm () (image-skip-unless 'pbm) - (should-not (image-mask-p (cdr (assq 'pbm image-tests--files))))) + (should-not (image-mask-p (cdr (assq 'pbm image-tests--images))))) (ert-deftest image-tests-image-mask-p/png () (image-skip-unless 'png) - (should-not (image-mask-p (cdr (assq 'png image-tests--files))))) + (should-not (image-mask-p (cdr (assq 'png image-tests--images))))) (ert-deftest image-tests-image-mask-p/svg () (image-skip-unless 'svg) - (should-not (image-mask-p (cdr (assq 'svg image-tests--files))))) + (should-not (image-mask-p (cdr (assq 'svg image-tests--images))))) (ert-deftest image-tests-image-mask-p/tiff () (image-skip-unless 'tiff) (should-not (image-mask-p (create-image - (cdr (assq 'tiff image-tests--files)))))) + (cdr (assq 'tiff image-tests--images)))))) (ert-deftest image-tests-image-mask-p/webp () (image-skip-unless 'webp) (should-not (image-mask-p (create-image - (cdr (assq 'webp image-tests--files)))))) + (cdr (assq 'webp image-tests--images)))))) (ert-deftest image-tests-image-mask-p/xbm () (image-skip-unless 'xbm) - (should-not (image-mask-p (cdr (assq 'xbm image-tests--files))))) + (should-not (image-mask-p (cdr (assq 'xbm image-tests--images))))) (ert-deftest image-tests-image-mask-p/xpm () (image-skip-unless 'xpm) - (should-not (image-mask-p (cdr (assq 'xpm image-tests--files))))) + (should-not (image-mask-p (cdr (assq 'xpm image-tests--images))))) (ert-deftest image-tests-image-mask-p/error-on-invalid-spec () (skip-unless (display-images-p)) @@ -160,47 +172,52 @@ (ert-deftest image-tests-image-mask-p/error-on-nongraphical-display () (skip-unless (not (display-images-p))) - (should-error (image-mask-p (cdr (assq 'xpm image-tests--files))))) + (should-error (image-mask-p (cdr (assq 'xpm image-tests--images))))) ;;;; image-metadata ;; TODO: These tests could be expanded with files that actually ;; contain metadata. +(ert-deftest image-tests-image-metadata/gif () + (image-skip-unless 'gif) + (should-not (image-metadata + (create-image (cdr (assq 'gif image-tests--images)))))) + (ert-deftest image-tests-image-metadata/jpeg () (image-skip-unless 'jpeg) (should-not (image-metadata - (create-image (cdr (assq 'jpeg image-tests--files)))))) + (create-image (cdr (assq 'jpeg image-tests--images)))))) (ert-deftest image-tests-image-metadata/pbm () (image-skip-unless 'pbm) - (should-not (image-metadata (cdr (assq 'pbm image-tests--files))))) + (should-not (image-metadata (cdr (assq 'pbm image-tests--images))))) (ert-deftest image-tests-image-metadata/png () (image-skip-unless 'png) - (should-not (image-metadata (cdr (assq 'png image-tests--files))))) + (should-not (image-metadata (cdr (assq 'png image-tests--images))))) (ert-deftest image-tests-image-metadata/svg () (image-skip-unless 'svg) - (should-not (image-metadata (cdr (assq 'svg image-tests--files))))) + (should-not (image-metadata (cdr (assq 'svg image-tests--images))))) (ert-deftest image-tests-image-metadata/tiff () (image-skip-unless 'tiff) (should-not (image-metadata - (create-image (cdr (assq 'tiff image-tests--files)))))) + (create-image (cdr (assq 'tiff image-tests--images)))))) (ert-deftest image-tests-image-metadata/webp () (image-skip-unless 'webp) (should-not (image-metadata - (create-image (cdr (assq 'webp image-tests--files)))))) + (create-image (cdr (assq 'webp image-tests--images)))))) (ert-deftest image-tests-image-metadata/xbm () (image-skip-unless 'xbm) - (should-not (image-metadata (cdr (assq 'xbm image-tests--files))))) + (should-not (image-metadata (cdr (assq 'xbm image-tests--images))))) (ert-deftest image-tests-image-metadata/xpm () (image-skip-unless 'xpm) - (should-not (image-metadata (cdr (assq 'xpm image-tests--files))))) + (should-not (image-metadata (cdr (assq 'xpm image-tests--images))))) (ert-deftest image-tests-image-metadata/nil-on-invalid-spec () (skip-unless (display-images-p)) @@ -208,7 +225,7 @@ (ert-deftest image-tests-image-metadata/error-on-nongraphical-display () (skip-unless (not (display-images-p))) - (should-error (image-metadata (cdr (assq 'xpm image-tests--files))))) + (should-error (image-metadata (cdr (assq 'xpm image-tests--images))))) ;;;; ImageMagick commit b931e11a03fdb44e378133b10f312e38b1b3d712 Merge: aea4af5119 c7f53824a8 Author: Glenn Morris Date: Sun Oct 24 01:55:45 2021 -0700 Merge from origin/emacs-28 c7f53824a8 (origin/emacs-28) Update publicsuffix.txt from upstream 9a50f760e9 ; * doc/lispref/modes.texi (Hooks): Clarify wording. (Bug... e154fd9119 Refer to the info node on keymaps in map-keymap docstring 4fd5c8df67 Clarify abnormal hook documentation 6fa5206770 Update to Org 9.5-59-g52e6f1 39413a45bf ; * doc/lispref/functions.texi (Calling Functions): Fix la... 43914ab01f Improve documentation of cl-reduce ef37a86cac Improve documentation of apply-partially 1e8be48738 Fix typos 8c5fbd712b Revert commit 225ca617b7, and apply another fix cdbd03345d Fix documentation of posn-at-x-y 598732c899 ; * src/vm-limit.c (get_lim_data): Fix a typo. (Bug#18238) efdffd86c5 ; * etc/refcards/README: Prefer HTTPS in link. # Conflicts: # etc/NEWS commit c7f53824a8d4d9be26fad61893a0a4db9e2ed8e7 Author: Stefan Kangas Date: Sun Oct 24 10:37:57 2021 +0200 Update publicsuffix.txt from upstream * etc/publicsuffix.txt: Update from https://publicsuffix.org/list/public_suffix_list.dat dated 2021-10-16 16:33:47 GMT. diff --git a/etc/publicsuffix.txt b/etc/publicsuffix.txt index 986f110b04..5cc95b9000 100644 --- a/etc/publicsuffix.txt +++ b/etc/publicsuffix.txt @@ -175,17 +175,21 @@ it.ao // aq : https://en.wikipedia.org/wiki/.aq aq -// ar : https://nic.ar/nic-argentina/normativa-vigente +// ar : https://nic.ar/es/nic-argentina/normativa ar +bet.ar com.ar +coop.ar edu.ar gob.ar gov.ar int.ar mil.ar musica.ar +mutual.ar net.ar org.ar +senasa.ar tur.ar // arpa : https://en.wikipedia.org/wiki/.arpa @@ -838,7 +842,13 @@ gov.cu inf.cu // cv : https://en.wikipedia.org/wiki/.cv +// cv : http://www.dns.cv/tldcv_portal/do?com=DS;5446457100;111;+PAGE(4000018)+K-CAT-CODIGO(RDOM)+RCNT(100); <- registration rules cv +com.cv +edu.cv +int.cv +nome.cv +org.cv // cw : http://www.una.cw/cw_registry/ // Confirmed by registry 2013-03-26 @@ -1175,6 +1185,7 @@ org.gu web.gu // gw : https://en.wikipedia.org/wiki/.gw +// gw : https://nic.gw/regras/ gw // gy : https://en.wikipedia.org/wiki/.gy @@ -5849,7 +5860,7 @@ com.ps org.ps net.ps -// pt : http://online.dns.pt/dns/start_dns +// pt : https://www.dns.pt/en/domain/pt-terms-and-conditions-registration-rules/ pt net.pt gov.pt @@ -6202,29 +6213,22 @@ gov.tm mil.tm edu.tm -// tn : https://en.wikipedia.org/wiki/.tn -// http://whois.ati.tn/ +// tn : http://www.registre.tn/fr/ +// https://whois.ati.tn/ tn com.tn ens.tn fin.tn gov.tn ind.tn +info.tn intl.tn +mincom.tn nat.tn net.tn org.tn -info.tn perso.tn tourism.tn -edunet.tn -rnrt.tn -rns.tn -rnu.tn -mincom.tn -agrinet.tn -defense.tn -turen.tn // to : https://en.wikipedia.org/wiki/.to // Submitted by registry @@ -7128,7 +7132,7 @@ org.zw // newGTLDs -// List of new gTLDs imported from https://www.icann.org/resources/registries/gtlds/v2/gtlds.json on 2021-08-19T15:13:52Z +// List of new gTLDs imported from https://www.icann.org/resources/registries/gtlds/v2/gtlds.json on 2021-10-08T15:12:46Z // This list is auto-generated, don't edit it manually. // aaa : 2015-02-26 American Automobile Association, Inc. aaa @@ -8018,7 +8022,7 @@ duck // dunlop : 2015-07-02 The Goodyear Tire & Rubber Company dunlop -// dupont : 2015-06-25 E. I. du Pont de Nemours and Company +// dupont : 2015-06-25 DuPont Specialty Products USA, LLC dupont // durban : 2014-03-24 ZA Central Registry NPC trading as ZA Central Registry @@ -9452,9 +9456,6 @@ quebec // quest : 2015-03-26 XYZ.COM LLC quest -// qvc : 2015-07-30 QVC, Inc. -qvc - // racing : 2014-12-04 Premier Registry Limited racing @@ -9554,9 +9555,6 @@ rio // rip : 2014-07-10 Dog Beach, LLC rip -// rmit : 2015-11-19 Royal Melbourne Institute of Technology -rmit - // rocher : 2014-12-18 Ferrero Trading Lux S.A. rocher @@ -9902,9 +9900,6 @@ suzuki // swatch : 2015-01-08 The Swatch Group Ltd swatch -// swiftcover : 2015-07-23 Swiftcover Insurance Services Limited -swiftcover - // swiss : 2014-10-16 Swiss Confederation swiss @@ -10334,7 +10329,7 @@ xin // xn--45q11c : 2013-11-21 Zodiac Gemini Ltd 八卦 -// xn--4gbrim : 2013-10-04 Fans TLD Limited +// xn--4gbrim : 2013-10-04 Helium TLDs Ltd موقع // xn--55qw42g : 2013-11-08 China Organizational Name Administration Center @@ -10803,6 +10798,10 @@ tele.amune.org // Submitted by Apigee Security Team apigee.io +// Apphud : https://apphud.com +// Submitted by Alexander Selivanov +siiites.com + // Appspace : https://www.appspace.com // Submitted by Appspace Security Team appspacehosted.com @@ -11054,10 +11053,6 @@ clerkstage.app *.stg.dev *.stgstage.dev -// Clic2000 : https://clic2000.fr -// Submitted by Mathilde Blanchemanche -clic2000.net - // ClickRising : https://clickrising.com/ // Submitted by Umut Gumeli clickrising.net @@ -11611,10 +11606,14 @@ ddnss.org definima.net definima.io -// DigitalOcean : https://digitalocean.com/ -// Submitted by Braxton Huggins +// DigitalOcean App Platform : https://www.digitalocean.com/products/app-platform/ +// Submitted by Braxton Huggins ondigitalocean.app +// DigitalOcean Spaces : https://www.digitalocean.com/products/spaces/ +// Submitted by Robin H. Johnson +*.digitaloceanspaces.com + // dnstrace.pro : https://dnstrace.pro/ // Submitted by Chris Partridge bci.dnstrace.pro @@ -11677,10 +11676,6 @@ tuleap-partners.com onred.one staging.onred.one -// One.com: https://www.one.com/ -// Submitted by Jacob Bunk Nielsen -service.one - // EU.org https://eu.org/ // Submitted by Pierre Beyssac eu.org @@ -12079,6 +12074,7 @@ withyoutube.com *.gateway.dev cloud.goog translate.goog +*.usercontent.goog cloudfunctions.net blogspot.ae blogspot.al @@ -12521,6 +12517,7 @@ linkyard-cloud.ch members.linode.com *.nodebalancer.linode.com *.linodeobjects.com +ip.linodeusercontent.com // LiquidNet Ltd : http://www.liquidnetlimited.com/ // Submitted by Victor Velchev @@ -12730,10 +12727,6 @@ that.win from.work to.work -// NCTU.ME : https://nctu.me/ -// Submitted by Tocknicsu -nctu.me - // Netlify : https://www.netlify.com // Submitted by Jessica Parsons netlify.app @@ -12926,6 +12919,10 @@ cloudycluster.net // Submitted by Vicary Archangel omniwe.site +// One.com: https://www.one.com/ +// Submitted by Jacob Bunk Nielsen +service.one + // One Fold Media : http://www.onefoldmedia.com/ // Submitted by Eddie Jones nid.io @@ -13066,6 +13063,10 @@ pstmn.io mock.pstmn.io httpbin.org +//prequalifyme.today : https://prequalifyme.today +//Submitted by DeepakTiwari deepak@ivylead.io +prequalifyme.today + // prgmr.com : https://prgmr.com/ // Submitted by Sarah Newman xen.prgmr.com @@ -13116,6 +13117,10 @@ qbuser.com // Submitted by Scott Claeys cloudsite.builders +// Redgate Software: https://red-gate.com +// Submitted by Andrew Farries +instances.spawn.cc + // Redstar Consultants : https://www.redstarconsultants.com/ // Submitted by Jons Slemmer instantcloud.cn @@ -13472,6 +13477,11 @@ tabitorder.co.il // Submitted by Bjoern Henke taifun-dns.de +// Tailscale Inc. : https://www.tailscale.com +// Submitted by David Anderson +beta.tailscale.net +ts.net + // TASK geographical domains (www.task.gda.pl/uslugi/dns) gda.pl gdansk.pl @@ -13507,6 +13517,10 @@ reservd.dev.thingdust.io reservd.disrec.thingdust.io reservd.testing.thingdust.io +// ticket i/O GmbH : https://ticket.io +// Submitted by Christian Franke +tickets.io + // Tlon.io : https://tlon.io // Submitted by Mark Staarink arvo.network @@ -13592,6 +13606,10 @@ inc.hk virtualuser.de virtual-user.de +// Upli : https://upli.io +// Submitted by Lenny Bakkalian +upli.io + // urown.net : https://urown.net // Submitted by Hostmaster urown.cloud @@ -13740,7 +13758,7 @@ wpenginepowered.com js.wpenginepowered.com // Wix.com, Inc. : https://www.wix.com -// Submitted by Shahar Talmi +// Submitted by Shahar Talmi wixsite.com editorx.io commit 9a50f760e94d4676f2fa643939cdc3561577a1b9 Author: Eli Zaretskii Date: Sun Oct 24 09:44:18 2021 +0300 ; * doc/lispref/modes.texi (Hooks): Clarify wording. (Bug#34588) diff --git a/doc/lispref/modes.texi b/doc/lispref/modes.texi index ed0c535867..5df3a74e78 100644 --- a/doc/lispref/modes.texi +++ b/doc/lispref/modes.texi @@ -59,12 +59,13 @@ runs just before Emacs suspends itself (@pxref{Suspending Emacs}). @cindex abnormal hook If the hook variable's name does not end with @samp{-hook}, that -indicates it is probably an @dfn{abnormal hook}. That means one of -two things: either that the hook functions are called with arguments, -or that their return values are used in some way. The hook's -documentation says how the functions are called. Any functions added -to an abnormal hook must follow the hook's calling convention. By -convention, abnormal hook names end in @samp{-functions}. +indicates it is probably an @dfn{abnormal hook}. These differ from +normal hooks in two ways: they can be called with one or more +arguments, and their return values can be used in some way. The +hook's documentation says how the functions are called and how their +return values are used. Any functions added to an abnormal hook must +follow the hook's calling convention. By convention, abnormal hook +names end in @samp{-functions}. @cindex single-function hook If the name of the variable ends in @samp{-predicate} or commit aea4af5119fdf130f1df7190478a23c6777f92a2 Author: Stefan Kangas Date: Sun Oct 24 08:34:52 2021 +0200 Make dired-x-guess-file-name-at-point obsolete * lisp/dired-x.el (dired-x-guess-file-name-at-point): Make obsolete in favour of 'thing-at-point'. (dired-x-read-filename-at-point): Use 'thing-at-point' instead of above obsolete function. diff --git a/lisp/dired-x.el b/lisp/dired-x.el index 7f889a2bfd..fc626aa76b 100644 --- a/lisp/dired-x.el +++ b/lisp/dired-x.el @@ -1478,12 +1478,12 @@ a prefix argument, when it offers the filename near point as a default." ;;; Internal functions -;; Fixme: This should probably use `thing-at-point'. -- fx (define-obsolete-function-alias 'dired-filename-at-point #'dired-x-guess-file-name-at-point "28.1") (defun dired-x-guess-file-name-at-point () "Return the filename closest to point, expanded. Point should be in or after a filename." + (declare (obsolete "use (thing-at-point 'filename) instead." "29.1")) (save-excursion ;; First see if just past a filename. (or (eobp) ; why? @@ -1515,7 +1515,7 @@ Point should be in or after a filename." "Return filename prompting with PROMPT with completion. If `current-prefix-arg' is non-nil, uses name at point as guess." (if current-prefix-arg - (let ((guess (dired-x-guess-file-name-at-point))) + (let ((guess (thing-at-point 'filename))) (read-file-name prompt (file-name-directory guess) guess commit e154fd9119dc36dd1249ea9e372bcf8b3cae8546 Author: Stefan Kangas Date: Sun Oct 24 08:08:09 2021 +0200 Refer to the info node on keymaps in map-keymap docstring * src/keymap.c (Fmap_keymap): Doc fix; add a reference to the Info node '(elisp) Keymaps'. (Bug#30958) diff --git a/src/keymap.c b/src/keymap.c index be45d2be1e..940a6f492e 100644 --- a/src/keymap.c +++ b/src/keymap.c @@ -629,6 +629,9 @@ the definition it is bound to. The event may be a character range. If KEYMAP has a parent, the parent's bindings are included as well. This works recursively: if the parent has itself a parent, then the grandparent's bindings are also included and so on. + +For more information, see Info node `(elisp) Keymaps'. + usage: (map-keymap FUNCTION KEYMAP) */) (Lisp_Object function, Lisp_Object keymap, Lisp_Object sort_first) { commit 4fd5c8df67e2eb41dd0ea6d95586bbd8d09cc482 Author: Stefan Kangas Date: Sat Oct 23 20:03:34 2021 +0200 Clarify abnormal hook documentation * doc/lispref/hooks.texi (Standard Hooks): * doc/lispref/modes.texi (Hooks): Clarify wording of "abnormal hook" documentation. (Bug#34588) diff --git a/doc/lispref/hooks.texi b/doc/lispref/hooks.texi index feec8b24f4..e9d1e270d8 100644 --- a/doc/lispref/hooks.texi +++ b/doc/lispref/hooks.texi @@ -18,11 +18,13 @@ arguments and their values are completely ignored. The recommended way to put a new function on such a hook is to call @code{add-hook}. @xref{Hooks}, for more information about using hooks. -The variables whose names end in @samp{-functions} are usually @dfn{abnormal -hooks} (some old code may also use the deprecated @samp{-hooks} suffix); their -values are lists of functions, but these functions are called in a special way -(they are passed arguments, or their return values are used). The variables -whose names end in @samp{-function} have single functions as their values. +The variables whose names end in @samp{-functions} are usually +@dfn{abnormal hooks} (some old code may also use the deprecated +@samp{-hooks} suffix). Their values are lists of functions, but these +functions are called in a special way: they are either passed +arguments, or their return values are used in some way. The variables +whose names end in @samp{-function} have single functions as their +values. This is not an exhaustive list, it only covers the more general hooks. For example, every major mode defines a hook named diff --git a/doc/lispref/modes.texi b/doc/lispref/modes.texi index ee55f982d0..ed0c535867 100644 --- a/doc/lispref/modes.texi +++ b/doc/lispref/modes.texi @@ -59,12 +59,12 @@ runs just before Emacs suspends itself (@pxref{Suspending Emacs}). @cindex abnormal hook If the hook variable's name does not end with @samp{-hook}, that -indicates it is probably an @dfn{abnormal hook}. That means the hook -functions are called with arguments, or their return values are used -in some way. The hook's documentation says how the functions are -called. Any functions added to an abnormal hook must follow the -hook's calling convention. By convention, abnormal hook names end in -@samp{-functions}. +indicates it is probably an @dfn{abnormal hook}. That means one of +two things: either that the hook functions are called with arguments, +or that their return values are used in some way. The hook's +documentation says how the functions are called. Any functions added +to an abnormal hook must follow the hook's calling convention. By +convention, abnormal hook names end in @samp{-functions}. @cindex single-function hook If the name of the variable ends in @samp{-predicate} or commit 6fa520677095c5872f1d448f6f1001ee22e42276 Author: Kyle Meyer Date: Sat Oct 23 13:34:28 2021 -0400 Update to Org 9.5-59-g52e6f1 diff --git a/doc/misc/org.org b/doc/misc/org.org index 5977f09161..788e5efedf 100644 --- a/doc/misc/org.org +++ b/doc/misc/org.org @@ -16543,7 +16543,7 @@ more "bibliography" keywords. #+bibliography: "/some/file/with spaces/in its name.bib" #+end_example -#+kindex: C-c C-x @ +#+kindex: C-c C-x @@ #+findex: org-cite-insert One can then insert and edit citations using ~org-cite-insert~, called with {{{kbd(C-c C-x @)}}}. diff --git a/lisp/org/org-macro.el b/lisp/org/org-macro.el index b8d3373418..1259430ae4 100644 --- a/lisp/org/org-macro.el +++ b/lisp/org/org-macro.el @@ -125,7 +125,7 @@ previous one, unless VALUE is nil. Return the updated list." "Collect macro definitions in current buffer and setup files. Return an alist containing all macro templates found." (let ((templates - `(("author" . ,(org-macro--find-keyword-value "AUTHOR")) + `(("author" . ,(org-macro--find-keyword-value "AUTHOR" t)) ("email" . ,(org-macro--find-keyword-value "EMAIL")) ("title" . ,(org-macro--find-keyword-value "TITLE" t)) ("date" . ,(org-macro--find-date))))) diff --git a/lisp/org/org-version.el b/lisp/org/org-version.el index 4464459695..55f186b471 100644 --- a/lisp/org/org-version.el +++ b/lisp/org/org-version.el @@ -11,7 +11,7 @@ Inserted by installing Org mode or when a release is made." (defun org-git-version () "The Git version of Org mode. Inserted by installing Org or when a release is made." - (let ((org-git-version "release_9.5-57-g9bc3a2")) + (let ((org-git-version "release_9.5-59-g52e6f1")) org-git-version)) (provide 'org-version) commit 39413a45bf497a5225ef7babf5001d0b0ce682e3 Author: Eli Zaretskii Date: Sat Oct 23 20:44:26 2021 +0300 ; * doc/lispref/functions.texi (Calling Functions): Fix last change. diff --git a/doc/lispref/functions.texi b/doc/lispref/functions.texi index f95c6d3656..91118b7ae0 100644 --- a/doc/lispref/functions.texi +++ b/doc/lispref/functions.texi @@ -827,12 +827,19 @@ This function returns a new function which, when called, will call additional arguments specified at the time of the call. If @var{func} accepts @var{n} arguments, then a call to @code{apply-partially} with @w{@code{@var{m} <= @var{n}}} arguments will produce a new function of -@w{@code{@var{n} - @var{m}}} arguments. +@w{@code{@var{n} - @var{m}}} arguments@footnote{ +If the number of arguments that @var{func} can accept is unlimited, +then the new function will also accept an unlimited number of +arguments, so in that case @code{apply-partially} doesn't reduce the +number of arguments that the new function could accept. +}. Here's how we could define the built-in function @code{1+}, if it didn't exist, using @code{apply-partially} and @code{+}, another -built-in function:@footnote{Note that unlike the built-in function -this version accepts any number of arguments.} +built-in function@footnote{ +Note that unlike the built-in function, this version accepts any +number of arguments. +}: @example @group commit 43914ab01fc83466c701de7b350dd957a21c1c6c Author: Stefan Kangas Date: Sat Oct 23 19:20:31 2021 +0200 Improve documentation of cl-reduce * doc/misc/cl.texi (Mapping over Sequences): Change the explanation of 'cl-reduce' so you don't need to have a major in mathematics to understand it. (Bug#24014) diff --git a/doc/misc/cl.texi b/doc/misc/cl.texi index a6c3c32c0e..0ec02495d5 100644 --- a/doc/misc/cl.texi +++ b/doc/misc/cl.texi @@ -3364,9 +3364,13 @@ true for all elements. @end defun @defun cl-reduce function seq @t{&key :from-end :start :end :initial-value :key} -This function combines the elements of @var{seq} using an associative -binary operation. Suppose @var{function} is @code{*} and @var{seq} is -the list @code{(2 3 4 5)}. The first two elements of the list are +This function returns the result of calling @var{function} on the +first and second element of @var{seq}, then calling @var{function} +with that result and the third element of @var{seq}, then with that +result and the third element of @var{seq}, etc. + +Here is an example. Suppose @var{function} is @code{*} and @var{seq} +is the list @code{(2 3 4 5)}. The first two elements of the list are combined with @code{(* 2 3) = 6}; this is combined with the next element, @code{(* 6 4) = 24}, and that is combined with the final element: @code{(* 24 5) = 120}. Note that the @code{*} function happens commit ef37a86cacab221aa26fc8c2f746626e6e81ebc6 Author: Stefan Kangas Date: Sat Oct 23 18:42:14 2021 +0200 Improve documentation of apply-partially * doc/lispref/functions.texi (Calling Functions): Improve documentation of 'apply-partially' to be slightly more clear with regards to function arity. (Bug#17623) diff --git a/doc/lispref/functions.texi b/doc/lispref/functions.texi index c856557c3c..f95c6d3656 100644 --- a/doc/lispref/functions.texi +++ b/doc/lispref/functions.texi @@ -826,12 +826,13 @@ This function returns a new function which, when called, will call @var{func} with the list of arguments composed from @var{args} and additional arguments specified at the time of the call. If @var{func} accepts @var{n} arguments, then a call to @code{apply-partially} with -@w{@code{@var{m} < @var{n}}} arguments will produce a new function of +@w{@code{@var{m} <= @var{n}}} arguments will produce a new function of @w{@code{@var{n} - @var{m}}} arguments. Here's how we could define the built-in function @code{1+}, if it didn't exist, using @code{apply-partially} and @code{+}, another -built-in function: +built-in function:@footnote{Note that unlike the built-in function +this version accepts any number of arguments.} @example @group commit 5f61b38b406f849f4e6f681da11549aa1096727f Author: Michael Albinus Date: Sat Oct 23 17:47:27 2021 +0200 Check for image library in image-dired-tests.el * test/lisp/image-dired-tests.el (image-dired-tests-get-exif-file-name): Check for jpeg library. diff --git a/test/lisp/image-dired-tests.el b/test/lisp/image-dired-tests.el index 0f1dbe54dc..3f0304ee40 100644 --- a/test/lisp/image-dired-tests.el +++ b/test/lisp/image-dired-tests.el @@ -29,6 +29,7 @@ "../")))) (ert-deftest image-dired-tests-get-exif-file-name () + (skip-unless (image-type-available-p 'jpeg)) (let ((img (image-dired-test-image-file "black.jpg"))) (should (equal (image-dired-get-exif-file-name img) "2019_09_21_16_22_13_black.jpg")))) commit 6958bd0252bded425d4cce0b27884c99921252ed Author: Dmitry Gutov Date: Sat Oct 23 16:28:53 2021 +0300 Support :company-deprecated completion property * lisp/progmodes/elisp-mode.el (elisp--company-deprecated): New function. (elisp-completion-at-point): Use it. diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el index 9522055670..7da93a351a 100644 --- a/lisp/progmodes/elisp-mode.el +++ b/lisp/progmodes/elisp-mode.el @@ -636,7 +636,8 @@ functions are annotated with \"\" via the :company-kind #'elisp--company-kind :company-doc-buffer #'elisp--company-doc-buffer :company-docsig #'elisp--company-doc-string - :company-location #'elisp--company-location)) + :company-location #'elisp--company-location + :company-deprecated #'elisp--company-deprecated)) (quoted (list nil (elisp--completion-local-symbols) ;; Don't include all symbols (bug#16646). @@ -652,7 +653,8 @@ functions are annotated with \"\" via the :company-kind #'elisp--company-kind :company-doc-buffer #'elisp--company-doc-buffer :company-docsig #'elisp--company-doc-string - :company-location #'elisp--company-location)) + :company-location #'elisp--company-location + :company-deprecated #'elisp--company-deprecated)) (t (list nil (completion-table-merge elisp--local-variables-completion-table @@ -667,7 +669,8 @@ functions are annotated with \"\" via the 'variable)) :company-doc-buffer #'elisp--company-doc-buffer :company-docsig #'elisp--company-doc-string - :company-location #'elisp--company-location))) + :company-location #'elisp--company-location + :company-deprecated #'elisp--company-deprecated))) ;; Looks like a funcall position. Let's double check. (save-excursion (goto-char (1- beg)) @@ -714,13 +717,15 @@ functions are annotated with \"\" via the :company-kind (lambda (_) 'variable) :company-doc-buffer #'elisp--company-doc-buffer :company-docsig #'elisp--company-doc-string - :company-location #'elisp--company-location)) + :company-location #'elisp--company-location + :company-deprecated #'elisp--company-deprecated)) (_ (list nil (elisp--completion-local-symbols) :predicate #'elisp--shorthand-aware-fboundp :company-kind #'elisp--company-kind :company-doc-buffer #'elisp--company-doc-buffer :company-docsig #'elisp--company-doc-string :company-location #'elisp--company-location + :company-deprecated #'elisp--company-deprecated )))))))) (nconc (list beg end) (if (null (car table-etc)) @@ -743,6 +748,11 @@ functions are annotated with \"\" via the ((facep sym) 'color) (t 'text)))) +(defun elisp--company-deprecated (str) + (let ((sym (intern-soft str))) + (or (get sym 'byte-obsolete-variable) + (get sym 'byte-obsolete-info)))) + (defun lisp-completion-at-point (&optional _predicate) (declare (obsolete elisp-completion-at-point "25.1")) (elisp-completion-at-point)) commit 1e8be48738e1324edb9891ff6f7077bd1306cdd7 Author: Michael Albinus Date: Sat Oct 23 15:21:33 2021 +0200 Fix typos * doc/emacs/cmdargs.texi: * etc/DEBUG: * etc/NEWS: Fix typos. diff --git a/doc/emacs/cmdargs.texi b/doc/emacs/cmdargs.texi index d5177faea9..687a5caf71 100644 --- a/doc/emacs/cmdargs.texi +++ b/doc/emacs/cmdargs.texi @@ -268,7 +268,7 @@ system call unless otherwise requested. @vindex backtrace-on-error-noninteractive Errors that occur when running a @samp{--batch} Emacs will result in -an Emacs Lisp backtrace being printed. To disable this behaviour, set +an Emacs Lisp backtrace being printed. To disable this behavior, set @code{backtrace-on-error-noninteractive} to @code{nil}. @item --script @var{file} diff --git a/etc/DEBUG b/etc/DEBUG index a1c0634260..555370588f 100644 --- a/etc/DEBUG +++ b/etc/DEBUG @@ -590,7 +590,7 @@ recommend to follow the procedure below to try to identify the cause: If you cannot figure out the cause for the problem using the above, native-compile the problematic file after setting the variable 'comp-libgccjit-reproducer' to a non-nil value. That should produce a -file names ELNFILENAME_libgccjit_repro.c, where ELNFILENAME is the +file named ELNFILENAME_libgccjit_repro.c, where ELNFILENAME is the name of the problematic .eln file, in the same directory where the .eln file is produced. Then attach that reproducer C file to your bug report. diff --git a/etc/NEWS b/etc/NEWS index 4942a35b7b..7f9797e1fa 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -3239,7 +3239,7 @@ batch mode. +++ ** New mode 'repeat-mode' to allow shorter key sequences. -Type 'M-x repeat-mode RET' to enable this mode. You can then type +Type 'M-x repeat-mode' to enable this mode. You can then type 'C-x u u' instead of 'C-x u C-x u' to undo many changes, 'C-x o o' instead of 'C-x o C-x o' to switch windows, 'C-x { { } } ^ ^ v v' to resize the selected window interactively, 'M-g n n p p' to navigate commit 8c5fbd712be0cfc6ec9683ba1fb30c3b8ef007f8 Author: Michael Albinus Date: Sat Oct 23 15:21:14 2021 +0200 Revert commit 225ca617b7, and apply another fix * lisp/minibuffer.el (read-file-name-default): Revert commit 225ca617b7. (Bug#50976). * lisp/shell.el (shell): Remove volume letter for remote shell file name. (Bug#49229) diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index 13da7f99a3..bc21f027b6 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -3214,7 +3214,6 @@ See `read-file-name' for the meaning of the arguments." (unless val (error "No file name specified")) (if (and default-filename - (not (file-remote-p dir)) (string-equal val (if (consp insdef) (car insdef) insdef))) (setq val default-filename)) (setq val (substitute-in-file-name val)) diff --git a/lisp/shell.el b/lisp/shell.el index b575024e01..cb4afe6dea 100644 --- a/lisp/shell.el +++ b/lisp/shell.el @@ -766,12 +766,16 @@ Make the shell buffer the current buffer, and return it. (called-interactively-p 'any) (null explicit-shell-file-name) (null (getenv "ESHELL"))) + ;; `expand-file-name' shall not add the MS Windows volume letter + ;; (Bug#49229). (setq-local explicit-shell-file-name - (file-local-name - (expand-file-name - (read-file-name "Remote shell path: " default-directory - shell-file-name t shell-file-name - #'file-remote-p))))) + (replace-regexp-in-string + "^[[:alpha:]]:" "" + (file-local-name + (expand-file-name + (read-file-name "Remote shell path: " default-directory + shell-file-name t shell-file-name + #'file-remote-p)))))) ;; Rain or shine, BUFFER must be current by now. (unless (comint-check-proc buffer) commit b2eb228b8dbd4178a445508fd61045e565be596e Author: Michael Albinus Date: Sat Oct 23 13:23:25 2021 +0200 * test/infra/gitlab-ci.yml (variables, default): Increase timeout to 4 hours. diff --git a/test/infra/gitlab-ci.yml b/test/infra/gitlab-ci.yml index 5ff3694a0e..57f90b15ef 100644 --- a/test/infra/gitlab-ci.yml +++ b/test/infra/gitlab-ci.yml @@ -44,8 +44,8 @@ workflow: variables: GIT_STRATEGY: fetch EMACS_EMBA_CI: 1 - # Three hours, see below. - EMACS_TEST_TIMEOUT: 10800 + # Four hours, see below. + EMACS_TEST_TIMEOUT: 14400 EMACS_TEST_VERBOSE: 1 # # Use TLS https://docs.gitlab.com/ee/ci/docker/using_docker_build.html#tls-enabled # DOCKER_HOST: tcp://docker:2376 @@ -60,7 +60,7 @@ variables: default: image: docker:19.03.12 - timeout: 3 hours + timeout: 4 hours before_script: - docker info - echo "docker registry is ${CI_REGISTRY}" commit 32d8a4870926b0b3d0f6f075d231102288b5b28c Author: Alan Mackenzie Date: Sat Oct 23 09:29:26 2021 +0000 Revert "CC Mode: Fontify "found types" which are recognized after being ..." This reverts commit 51719617eb19833056618ebac403cdcaf711551a. The commit caused a hang at start-up with a big desktop. diff --git a/doc/misc/cc-mode.texi b/doc/misc/cc-mode.texi index c255d9870f..98ded68e71 100644 --- a/doc/misc/cc-mode.texi +++ b/doc/misc/cc-mode.texi @@ -283,8 +283,6 @@ Font Locking * Font Locking Preliminaries:: * Faces:: * Doc Comments:: -* Wrong Comment Style:: -* Found Types:: * Misc Font Locking:: * AWK Mode Font Locking:: @@ -2163,60 +2161,6 @@ which aren't of the default style will be fontified with @code{font-lock-warning-face}. @end defvar -@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -@node Found Types -@comment node-name, next, previous, up -@section ``Found Type'' handling. -@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -In most languages handled by CC Mode, @dfn{found types} are recognized -as types by their context in the source code. These contrast with -types which are basic to a language or are declared as types (e.g. by -@code{typedef} in C). - -In earlier versions of @ccmode{}, when @code{jit-lock-mode} was -enabled in Emacs (which it is by default), found types would -frequently fail to get fontified properly. This happened when the -fontification functions scanned a use of the found type before -scanning the code which caused it to be recognized. - -From @ccmode{} version 5.36, a timer mechanism scans the entire buffer -for found types in the seconds immediately after starting the major -mode. When a found type gets recognized, all its occurrences in the -buffer get marked for (re)fontification. This scanning happens in -short time slices interleaved with other processing, such as keyboard -handling, so that the responsiveness of Emacs should be barely -affected. This mechanism can be disabled (see below). It is only -active when @code{jit-lock-mode} is also active. - -@defvar c-type-finder-time-slot -@vindex type-finder-time-slot (c-) -The approximate time in seconds that CC Mode spends in scanning source -code before relinquishing control to other Emacs activities. The -default value is 0.05. To disable the scanning mechanism, set this -variable to @code{nil}. -@end defvar - -@defvar c-type-finder-repeat-time -@vindex type-finder-repeat-time (c-) -The approximate frequency (in seconds) with which the scanning -mechanism is triggered. This time must be greater than -@code{c-type-finder-time-slot}. Its default value is 0.1. If a less -powerful machine becomes sluggish due to the scanning, increase the -value of @code{c-type-finder-repeat-time} to compensate. -@end defvar - -@defvar c-type-finder-chunk-size -@vindex type-finder-chunk-size (c-) -The approximate size (in characters) of the buffer chunk processed as -a unit before the scanning mechanism checks whether -@code{c-type-finder-time-slot} seconds have passed. The default value -is 1000. A too small value here will cause inefficiencies due to the -initialization which happens for each chunk, whereas a too large value -will cause the processing to consume an excessive proportion of the -@code{c-type-finder-repeat-time}. -@end defvar - @comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @node Misc Font Locking @comment node-name, next, previous, up diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el index ace6b1b686..c42c95764a 100644 --- a/lisp/progmodes/cc-engine.el +++ b/lisp/progmodes/cc-engine.el @@ -165,9 +165,6 @@ (defvar c-doc-line-join-end-ch) (defvar c-syntactic-context) (defvar c-syntactic-element) -(defvar c-new-id-start) -(defvar c-new-id-end) -(defvar c-new-id-is-type) (cc-bytecomp-defvar c-min-syn-tab-mkr) (cc-bytecomp-defvar c-max-syn-tab-mkr) (cc-bytecomp-defun c-clear-syn-tab) @@ -6816,32 +6813,21 @@ comment at the start of cc-engine.el for more info." (setq c-found-types (make-hash-table :test #'equal :weakness nil))) -(defun c-add-type-1 (from to) - ;; Add the given region as a type in `c-found-types'. Prepare occurrences - ;; of this new type for fontification throughout the buffer. +(defun c-add-type (from to) + ;; Add the given region as a type in `c-found-types'. If the region + ;; doesn't match an existing type but there is a type which is equal + ;; to the given one except that the last character is missing, then + ;; the shorter type is removed. That's done to avoid adding all + ;; prefixes of a type as it's being entered and font locked. This + ;; doesn't cover cases like when characters are removed from a type + ;; or added in the middle. We'd need the position of point when the + ;; font locking is invoked to solve this well. ;; ;; This function might do hidden buffer changes. (let ((type (c-syntactic-content from to c-recognize-<>-arglists))) (unless (gethash type c-found-types) - (puthash type t c-found-types) - (when (and (eq (string-match c-symbol-key type) 0) - (eq (match-end 0) (length type))) - (c-fontify-new-found-type type))))) - -(defun c-add-type (from to) - ;; Add the given region as a type in `c-found-types'. Also perform the - ;; actions of `c-add-type-1'. If the region is or overlaps an identifier - ;; which might be being typed in, don't record it. This is tested by - ;; checking `c-new-id-start' and `c-new-id-end'. That's done to avoid - ;; adding all prefixes of a type as it's being entered and font locked. - ;; This is a bit rough and ready, but now covers adding characters into the - ;; middle of an identifer. - ;; - ;; This function might do hidden buffer changes. - (if (and c-new-id-start c-new-id-end - (<= from c-new-id-end) (>= to c-new-id-start)) - (setq c-new-id-is-type t) - (c-add-type-1 from to))) + (remhash (substring type 0 -1) c-found-types) + (puthash type t c-found-types)))) (defun c-unfind-type (name) ;; Remove the "NAME" from c-found-types, if present. diff --git a/lisp/progmodes/cc-fonts.el b/lisp/progmodes/cc-fonts.el index 588674464a..bc0ae6cc95 100644 --- a/lisp/progmodes/cc-fonts.el +++ b/lisp/progmodes/cc-fonts.el @@ -93,12 +93,10 @@ (cc-bytecomp-defvar c-preprocessor-face-name) (cc-bytecomp-defvar c-reference-face-name) (cc-bytecomp-defvar c-block-comment-flag) -(cc-bytecomp-defvar c-type-finder-pos) (cc-bytecomp-defun c-fontify-recorded-types-and-refs) (cc-bytecomp-defun c-font-lock-declarators) (cc-bytecomp-defun c-font-lock-objc-method) (cc-bytecomp-defun c-font-lock-invalid-string) -(cc-bytecomp-defun c-before-context-fl-expand-region) ;; Note that font-lock in XEmacs doesn't expand face names as @@ -921,6 +919,13 @@ casts and declarations are fontified. Used on level 2 and higher." ;; This function does hidden buffer changes. ;;(message "c-font-lock-complex-decl-prepare %s %s" (point) limit) + + ;; Clear the list of found types if we start from the start of the + ;; buffer, to make it easier to get rid of misspelled types and + ;; variables that have gotten recognized as types in malformed code. + (when (bobp) + (c-clear-found-types)) + (c-skip-comments-and-strings limit) (when (< (point) limit) @@ -1600,158 +1605,6 @@ casts and declarations are fontified. Used on level 2 and higher." nil)))) -(defun c-find-types-background (start limit) - ;; Find any "found types" between START and LIMIT. Allow any such types to - ;; be entered into `c-found-types' by the action of `c-forward-name' or - ;; `c-forward-type' called from this function. This process also causes - ;; occurrences of the type to be prepared for fontification throughout the - ;; buffer. - ;; - ;; This function is called from the timer `c-type-finder-timer'. It may do - ;; hidden buffer changes. - (save-excursion - (save-restriction - (widen) - (goto-char start) - (c-skip-comments-and-strings limit) - (when (< (point) limit) - (let ( - ;; o - 'decl if we're in an arglist containing declarations - ;; (but if `c-recognize-paren-inits' is set it might also be - ;; an initializer arglist); - ;; o - '<> if the arglist is of angle bracket type; - ;; o - 'arglist if it's some other arglist; - ;; o - nil, if not in an arglist at all. This includes the - ;; parenthesized condition which follows "if", "while", etc. - context - ;; A list of starting positions of possible type declarations, or of - ;; the typedef preceding one, if any. - last-cast-end - ;; The result from `c-forward-decl-or-cast-1'. - decl-or-cast - ;; The maximum of the end positions of all the checked type - ;; decl expressions in the successfully identified - ;; declarations. The position might be either before or - ;; after the syntactic whitespace following the last token - ;; in the type decl expression. - (max-type-decl-end 0) - ;; Same as `max-type-decl-*', but used when we're before - ;; `token-pos'. - (max-type-decl-end-before-token 0) - ) - (goto-char start) - (c-find-decl-spots - limit - c-decl-start-re - nil ; (eval c-maybe-decl-faces) - - (lambda (match-pos inside-macro &optional toplev) - ;; Note to maintainers: don't use `limit' inside this lambda form; - ;; c-find-decl-spots sometimes narrows to less than `limit'. - (if (and c-macro-with-semi-re - (looking-at c-macro-with-semi-re)) - ;; Don't do anything more if we're looking at something that - ;; can't start a declaration. - t - - ;; Set `context' and `c-restricted-<>-arglists'. Look for - ;; "<" for the sake of C++-style template arglists. - ;; "Ignore "(" when it's part of a control flow construct - ;; (e.g. "for ("). - (let ((got-context - (c-get-fontification-context - match-pos - (< match-pos (if inside-macro - max-type-decl-end-before-token - max-type-decl-end)) - toplev))) - (setq context (car got-context) - c-restricted-<>-arglists (cdr got-context))) - - ;; In QT, "more" is an irritating keyword that expands to nothing. - ;; We skip over it to prevent recognition of "more slots: " - ;; as a bitfield declaration. - (when (and (c-major-mode-is 'c++-mode) - (looking-at - (concat "\\(more\\)\\([^" c-symbol-chars "]\\|$\\)"))) - (goto-char (match-end 1)) - (c-forward-syntactic-ws)) - - ;; Now analyze the construct. This analysis will cause - ;; `c-forward-name' and `c-forward-type' to call `c-add-type', - ;; triggering the desired recognition and fontification of - ;; these found types. - (when (not (eq context 'not-decl)) - (setq decl-or-cast - (c-forward-decl-or-cast-1 - match-pos context last-cast-end)) - - (cond - ((eq decl-or-cast 'cast) - ;; Save the position after the previous cast so we can feed - ;; it to `c-forward-decl-or-cast-1' in the next round. That - ;; helps it discover cast chains like "(a) (b) c". - (setq last-cast-end (point)) - nil) - (decl-or-cast - ;; We've found a declaration. - - ;; Set `max-type-decl-end' or `max-type-decl-end-before-token' - ;; under the assumption that we're after the first type decl - ;; expression in the declaration now. That's not really true; - ;; we could also be after a parenthesized initializer - ;; expression in C++, but this is only used as a last resort - ;; to slant ambiguous expression/declarations, and overall - ;; it's worth the risk to occasionally fontify an expression - ;; as a declaration in an initializer expression compared to - ;; getting ambiguous things in normal function prototypes - ;; fontified as expressions. - (if inside-macro - (when (> (point) max-type-decl-end-before-token) - (setq max-type-decl-end-before-token (point))) - (when (> (point) max-type-decl-end) - (setq max-type-decl-end (point))))) - (t t))))))))))) - -(defun c-types-finder-timer-func () - ;; A CC Mode idle timer function for finding "found types". It triggers - ;; every `c-type-finder-repeat-time' seconds and processes buffer chunks of - ;; size around `c-type-finder-chunk-size' characters, and runs for (a little - ;; over) `c-type-finder-time-slot' seconds. The types it finds are inserted - ;; into `c-found-types', and their occurrences throughout the buffer are - ;; prepared for fontification. - (let* ((stop-time (+ (float-time) c-type-finder-time-slot)) - (buf-list (buffer-list))) - ;; One CC Mode buffer needing processing each time around this loop. - (while buf-list - ;; Cdr through BUF-LIST to find the next buffer needing processing. - (while (and buf-list - (not (with-current-buffer (car buf-list) c-type-finder-pos))) - (setq buf-list (cdr buf-list))) - (when buf-list - (with-current-buffer (car buf-list) - (save-restriction - (widen) - ;; Process one `c-type-finder-chunk-size' chunk each time around - ;; this loop. - (while (and c-type-finder-pos - (< (float-time) stop-time)) - ;; Process one chunk per iteration. - (c-save-buffer-state - ((beg (marker-position c-type-finder-pos)) - (end (min (+ beg c-type-finder-chunk-size) (point-max))) - (region (c-before-context-fl-expand-region beg end))) - (setq beg (car region) - end (cdr region)) - (c-find-types-background beg end) - (move-marker c-type-finder-pos - (if (save-excursion (goto-char end) (eobp)) - nil - end)) - (when (not (marker-position c-type-finder-pos)) - (setq c-type-finder-pos nil)))))) - (setq buf-list (cdr buf-list)))))) - (defun c-font-lock-enum-body (limit) ;; Fontify the identifiers of each enum we find by searching forward. ;; @@ -2402,46 +2255,6 @@ higher." ;; defvar will install its default value later on. (makunbound def-var))) -;; `c-re-redisplay-timer' is a timer which, when triggered, causes a -;; redisplay. -(defvar c-re-redisplay-timer nil) - -(defun c-force-redisplay (start end) - ;; Force redisplay immediately. This assumes `font-lock-support-mode' is - ;; 'jit-lock-mode. Set the variable `c-re-redisplay-timer' to nil. - (jit-lock-force-redisplay (copy-marker start) (copy-marker end)) - (setq c-re-redisplay-timer nil)) - -(defun c-fontify-new-found-type (type) - ;; Cause the fontification of TYPE, a string, wherever it occurs in the - ;; buffer. If TYPE is currently displayed in a window, cause redisplay to - ;; happen "instantaneously". These actions are done only when jit-lock-mode - ;; is active. - (when (and (boundp 'font-lock-support-mode) - (eq font-lock-support-mode 'jit-lock-mode)) - (c-save-buffer-state - ((window-boundaries - (mapcar (lambda (win) - (cons (window-start win) - (window-end win))) - (get-buffer-window-list (current-buffer) 'no-mini t))) - (target-re (concat "\\_<" type "\\_>"))) - (save-excursion - (save-restriction - (widen) - (goto-char (point-min)) - (while (re-search-forward target-re nil t) - (put-text-property (match-beginning 0) (match-end 0) - 'fontified nil) - (dolist (win-boundary window-boundaries) - (when (and (< (match-beginning 0) (cdr win-boundary)) - (> (match-end 0) (car win-boundary)) - (c-get-char-property (match-beginning 0) 'fontified) - (not c-re-redisplay-timer)) - (setq c-re-redisplay-timer - (run-with-timer 0 nil #'c-force-redisplay - (match-beginning 0) (match-end 0))))))))))) - ;;; C. diff --git a/lisp/progmodes/cc-mode.el b/lisp/progmodes/cc-mode.el index 80909380eb..c9b7a95df6 100644 --- a/lisp/progmodes/cc-mode.el +++ b/lisp/progmodes/cc-mode.el @@ -129,10 +129,6 @@ ; ' (require 'cc-fonts) ;) -(defvar c-type-finder-timer nil) -;; The variable which holds the repeating idle timer which triggers off the -;; background type finding search. - ;; The following three really belong to cc-fonts.el, but they are required ;; even when cc-fonts.el hasn't been loaded (this happens in XEmacs when ;; font-lock-mode is nil). @@ -183,17 +179,6 @@ (when c-buffer-is-cc-mode (save-restriction (widen) - (let ((lst (buffer-list))) - (catch 'found - (dolist (b lst) - (if (and (not (eq b (current-buffer))) - (with-current-buffer b - c-buffer-is-cc-mode)) - (throw 'found nil))) - (remove-hook 'post-command-hook 'c-post-command) - (and c-type-finder-timer - (progn (cancel-timer c-type-finder-timer) - (setq c-type-finder-timer nil))))) (c-save-buffer-state () (c-clear-char-properties (point-min) (point-max) 'category) (c-clear-char-properties (point-min) (point-max) 'syntax-table) @@ -589,12 +574,6 @@ preferably use the `c-mode-menu' language constant directly." ;; currently no such text property. (make-variable-buffer-local 'c-max-syn-tab-mkr) -;; `c-type-finder-pos' is a marker marking the current place in a CC Mode -;; buffer which is due to be searched next for "found types", or nil if the -;; searching is complete. -(defvar c-type-finder-pos nil) -(make-variable-buffer-local 'c-type-finder-pos) - (defun c-basic-common-init (mode default-style) "Initialize the syntax handling routines and the line breaking/filling code. Intended to be used by other packages that embed CC Mode. @@ -766,15 +745,6 @@ that requires a literal mode spec at compile time." ;; would do since font-lock uses a(n implicit) depth of 0) so we don't need ;; c-after-font-lock-init. (add-hook 'after-change-functions 'c-after-change nil t) - (add-hook 'post-command-hook 'c-post-command) - (setq c-type-finder-pos - (save-restriction - (widen) - (move-marker (make-marker) (point-min)))) - (or c-type-finder-timer - (setq c-type-finder-timer - (run-at-time - t c-type-finder-repeat-time #'c-types-finder-timer-func))) (when (boundp 'font-lock-extend-after-change-region-function) (set (make-local-variable 'font-lock-extend-after-change-region-function) 'c-extend-after-change-region))) ; Currently (2009-05) used by all @@ -1980,43 +1950,6 @@ Note that this is a strict tail, so won't match, e.g. \"0x....\".") ;; confused by already processed single quotes. (narrow-to-region (point) (point-max)))))) -;; The next two variables record the bounds of an identifier currently being -;; typed in. These are used to prevent such a partial identifier being -;; recorded as a found type by c-add-type. -(defvar c-new-id-start nil) -(make-variable-buffer-local 'c-new-id-start) -(defvar c-new-id-end nil) -(make-variable-buffer-local 'c-new-id-end) -;; The next variable, when non-nil, records that the previous two variables -;; define a type. -(defvar c-new-id-is-type nil) -(make-variable-buffer-local 'c-new-id-is-type) - -(defun c-update-new-id (end) - ;; Note the bounds of any identifier that END is in or just after, in - ;; `c-new-id-start' and `c-new-id-end'. Otherwise set these variables to - ;; nil. - (save-excursion - (goto-char end) - (let ((id-beg (c-on-identifier))) - (setq c-new-id-start id-beg - c-new-id-end (and id-beg - (progn (c-end-of-current-token) (point))))))) - - -(defun c-post-command () - ;; If point was inside of a new identifier and no longer is, record that - ;; fact. - (when (and c-buffer-is-cc-mode - c-new-id-start c-new-id-end - (or (> (point) c-new-id-end) - (< (point) c-new-id-start))) - (when c-new-id-is-type - (c-add-type-1 c-new-id-start c-new-id-end)) - (setq c-new-id-start nil - c-new-id-end nil - c-new-id-is-type nil))) - (defun c-before-change (beg end) ;; Function to be put on `before-change-functions'. Primarily, this calls ;; the language dependent `c-get-state-before-change-functions'. It is @@ -2036,16 +1969,11 @@ Note that this is a strict tail, so won't match, e.g. \"0x....\".") (unless (c-called-from-text-property-change-p) (save-restriction (widen) - ;; Clear the list of found types if we make a change at the start of the - ;; buffer, to make it easier to get rid of misspelled types and - ;; variables that have gotten recognized as types in malformed code. - (when (eq beg (point-min)) - (c-clear-found-types)) (if c-just-done-before-change - ;; We have two consecutive calls to `before-change-functions' - ;; without an intervening `after-change-functions'. An example of - ;; this is bug #38691. To protect CC Mode, assume that the entire - ;; buffer has changed. + ;; We have two consecutive calls to `before-change-functions' without + ;; an intervening `after-change-functions'. An example of this is bug + ;; #38691. To protect CC Mode, assume that the entire buffer has + ;; changed. (setq beg (point-min) end (point-max) c-just-done-before-change 'whole-buffer) @@ -2223,7 +2151,6 @@ Note that this is a strict tail, so won't match, e.g. \"0x....\".") c->-as-paren-syntax) (c-clear-char-property-with-value beg end 'syntax-table nil))) - (c-update-new-id end) (c-trim-found-types beg end old-len) ; maybe we don't ; need all of these. (c-invalidate-sws-region-after beg end old-len) diff --git a/lisp/progmodes/cc-vars.el b/lisp/progmodes/cc-vars.el index 40a43c32ed..83fd3da7c1 100644 --- a/lisp/progmodes/cc-vars.el +++ b/lisp/progmodes/cc-vars.el @@ -1524,39 +1524,6 @@ working due to this change." :type 'boolean :group 'c) -(defcustom c-type-finder-time-slot 0.05 - "The length in seconds of a background type search time slot. - -In CC Mode modes, \"found types\" wouldn't always get cleanly -fontified without the background searching for them which happens -in the seconds after starting Emacs or initializing the major -mode. - -This background searching can be disabled by setting this option -to nil." - :type '(choice (const :tag "disabled" nil) - number) - :group 'c) - -(defcustom c-type-finder-repeat-time 0.1 - "The interval, in seconds, at which background type searches occur. - -This interval must be greater than `c-type-finder-time-slot'." - :type 'number - :group 'c) - -(defcustom c-type-finder-chunk-size 1000 - "The size, in characters, of a chunk for background type search. - -Chunks of this size are searched atomically for \"found types\" -just after starting Emacs or initializing the major mode. - -This chunk size is a balance between efficiency (with larger -values) and responsiveness of the keyboard (with smaller values). -See also `c-type-finder-time-slot'." - :type 'integer - :group 'c) - (define-widget 'c-extra-types-widget 'radio "Internal CC Mode widget for the `*-font-lock-extra-types' variables." :args '((const :tag "none" nil) commit cdbd03345d57339cce5709cc08fdcd3a96c79ce7 Author: Stefan Kangas Date: Sat Oct 23 09:45:23 2021 +0200 Fix documentation of posn-at-x-y * doc/lispref/commands.texi (Accessing Mouse): Fix documentation of 'posn-at-x-y' to match docstring. (Bug#15783) diff --git a/doc/lispref/commands.texi b/doc/lispref/commands.texi index 3425880fec..6e1d09ebb4 100644 --- a/doc/lispref/commands.texi +++ b/doc/lispref/commands.texi @@ -2354,10 +2354,9 @@ This function returns position information corresponding to pixel coordinates @var{x} and @var{y} in a specified frame or window, @var{frame-or-window}, which defaults to the selected window. The coordinates @var{x} and @var{y} are relative to the -frame or window used. -If @var{whole} is @code{nil}, the coordinates are relative -to the window text area, otherwise they are relative to -the entire window area including scroll bars, margins and fringes. +text area of the selected window. +If @var{whole} is @code{non-nil}, the @var{x} coordinate is relative +to the entire window area including scroll bars, margins and fringes. @end defun @node Accessing Scroll commit ad7fd3cb47fbc8406504a13e8e4d64f650b514ce Author: Stefan Kangas Date: Sat Oct 23 06:49:09 2021 +0200 Partially remove exiftool dependency from image-dired.el * lisp/image-dired.el (exif): Require. (image-dired-cmd-read-exif-data-program) (image-dired-cmd-read-exif-data-options) (image-dired-get-exif-data): Make obsolete in favour of using exif.el. This removes a dependency on external exiftool for some operations. (image-dired-get-exif-file-name) (image-dired-thumbnail-set-image-description): Use exif.el functions instead of exiftool. * lisp/image/exif.el (exif-tag-alist): Add description and copyright fields. * test/lisp/image-dired-tests.el: New file. diff --git a/etc/NEWS b/etc/NEWS index 7f61cf952a..294181635e 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -189,6 +189,15 @@ To improve security, if an sql product has ':password-in-comint' set to t, a password supplied via the minibuffer will be sent in-process, as opposed to via the command-line. +** Image Dired + +--- +*** 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. + ** Exif *** New function 'exif-field'. @@ -253,6 +262,10 @@ Use 'define-keymap' instead. MozRepl was removed from Firefox in 2017, so this code doesn't work with recent versions of Firefox. +--- +** The function `image-dired-get-exif-data' is now obsolete. +Use `exif-parse-file' and `exif-field' instead. + * Lisp Changes in Emacs 29.1 diff --git a/lisp/image-dired.el b/lisp/image-dired.el index 921215c603..863cd0fde2 100644 --- a/lisp/image-dired.el +++ b/lisp/image-dired.el @@ -65,13 +65,10 @@ ;; * For non-lossy rotation of JPEG images, the JpegTRAN program is ;; needed. ;; -;; * For `image-dired-get-exif-data' and `image-dired-set-exif-data' to work, -;; the command line tool `exiftool' is needed. It can be found here: -;; https://exiftool.org/. These two functions are, among other -;; things, used for writing comments to image files using -;; `image-dired-thumbnail-set-image-description' and to create -;; "unique" file names using `image-dired-get-exif-file-name' (used by -;; `image-dired-copy-with-exif-file-name'). +;; * For `image-dired-set-exif-data' to work, the command line tool `exiftool' is +;; needed. It can be found here: https://exiftool.org/. This +;; function is, among other things, used for writing comments to +;; image files using `image-dired-thumbnail-set-image-description'. ;; ;; ;; USAGE @@ -149,6 +146,7 @@ ;;; Code: (require 'dired) +(require 'exif) (require 'image-mode) (require 'widget) @@ -378,21 +376,6 @@ which is replaced by the tag value." :version "26.1" :type '(repeat (string :tag "Argument"))) -(defcustom image-dired-cmd-read-exif-data-program - "exiftool" - "Program used to read EXIF data to image. -Used together with `image-dired-cmd-read-exif-data-options'." - :type 'file) - -(defcustom image-dired-cmd-read-exif-data-options - '("-s" "-s" "-s" "-%t" "%f") - "Arguments of command used to read EXIF data. -Used with `image-dired-cmd-read-exif-data-program'. -Available format specifiers are: %f which is replaced -by the image file name and %t which is replaced by the tag name." - :version "26.1" - :type '(repeat (string :tag "Argument"))) - (defcustom image-dired-gallery-hidden-tags (list "private" "hidden" "pending") "List of \"hidden\" tags. @@ -2063,8 +2046,8 @@ YYYY_MM_DD_HH_MM_DD_ORIG_FILE_NAME.jpg. Used from "%Y:%m:%d %H:%M:%S" (file-attribute-modification-time (file-attributes (expand-file-name file))))) - (setq data (image-dired-get-exif-data (expand-file-name file) - "DateTimeOriginal"))) + (setq data (exif-field 'date-time (exif-parse-file + (expand-file-name file))))) (while (string-match "[ :]" data) (setq data (replace-match "_" nil nil data))) (format "%s%s%s" data @@ -2081,7 +2064,7 @@ default value at the prompt." (if (not (image-dired-image-at-point-p)) (message "No thumbnail at point") (let* ((file (image-dired-original-file-name)) - (old-value (image-dired-get-exif-data file "ImageDescription"))) + (old-value (or (exif-field 'description (exif-parse-file file)) ""))) (if (eq 0 (image-dired-set-exif-data file "ImageDescription" (read-string "Value of ImageDescription: " @@ -2102,30 +2085,6 @@ default value at the prompt." (mapcar (lambda (arg) (format-spec arg spec)) image-dired-cmd-write-exif-data-options)))) -(defun image-dired-get-exif-data (file tag-name) - "From FILE, return EXIF tag TAG-NAME." - (image-dired--check-executable-exists - 'image-dired-cmd-read-exif-data-program) - (let ((buf (get-buffer-create "*image-dired-get-exif-data*")) - (spec (list (cons ?f file) (cons ?t tag-name))) - tag-value) - (with-current-buffer buf - (delete-region (point-min) (point-max)) - (if (not (eq (apply #'call-process image-dired-cmd-read-exif-data-program - nil t nil - (mapcar - (lambda (arg) (format-spec arg spec)) - image-dired-cmd-read-exif-data-options)) - 0)) - (error "Could not get EXIF tag") - (goto-char (point-min)) - ;; Clean buffer from newlines and carriage returns before - ;; getting final info - (while (search-forward-regexp "[\n\r]" nil t) - (replace-match "" nil t)) - (setq tag-value (buffer-substring (point-min) (point-max))))) - tag-value)) - (defun image-dired-copy-with-exif-file-name () "Copy file with unique name to main image directory. Copy current or all marked files in dired to a new file in your @@ -2696,6 +2655,50 @@ tags to their respective image file. Internal function used by (dolist (tag tag-list) (push (cons file tag) lst)))))) +;;;; Obsolete + +(defcustom image-dired-cmd-read-exif-data-program "exiftool" + "Program used to read EXIF data to image. +Used together with `image-dired-cmd-read-exif-data-options'." + :type 'file) +(make-obsolete-variable 'image-dired-cmd-read-exif-data-program + "use `exif-parse-file' and `exif-field' instead." "29.1") + +(defcustom image-dired-cmd-read-exif-data-options '("-s" "-s" "-s" "-%t" "%f") + "Arguments of command used to read EXIF data. +Used with `image-dired-cmd-read-exif-data-program'. +Available format specifiers are: %f which is replaced +by the image file name and %t which is replaced by the tag name." + :version "26.1" + :type '(repeat (string :tag "Argument"))) +(make-obsolete-variable 'image-dired-cmd-read-exif-data-options + "use `exif-parse-file' and `exif-field' instead." "29.1") + +(defun image-dired-get-exif-data (file tag-name) + "From FILE, return EXIF tag TAG-NAME." + (declare (obsolete "use `exif-parse-file' and `exif-field' instead." "29.1")) + (image-dired--check-executable-exists + 'image-dired-cmd-read-exif-data-program) + (let ((buf (get-buffer-create "*image-dired-get-exif-data*")) + (spec (list (cons ?f file) (cons ?t tag-name))) + tag-value) + (with-current-buffer buf + (delete-region (point-min) (point-max)) + (if (not (eq (apply #'call-process image-dired-cmd-read-exif-data-program + nil t nil + (mapcar + (lambda (arg) (format-spec arg spec)) + image-dired-cmd-read-exif-data-options)) + 0)) + (error "Could not get EXIF tag") + (goto-char (point-min)) + ;; Clean buffer from newlines and carriage returns before + ;; getting final info + (while (search-forward-regexp "[\n\r]" nil t) + (replace-match "" nil t)) + (setq tag-value (buffer-substring (point-min) (point-max))))) + tag-value)) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;; TEST-SECTION ;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; diff --git a/lisp/image/exif.el b/lisp/image/exif.el index 67b00844d3..372e2d2555 100644 --- a/lisp/image/exif.el +++ b/lisp/image/exif.el @@ -68,6 +68,7 @@ (defvar exif-tag-alist '((11 processing-software) + (270 description) (271 make) (272 model) (274 orientation) @@ -76,7 +77,8 @@ (296 resolution-unit) (305 software) (306 date-time) - (315 artist)) + (315 artist) + (33432 copyright)) "Alist of tag values and their names.") (defconst exif--orientation diff --git a/test/lisp/image-dired-tests.el b/test/lisp/image-dired-tests.el new file mode 100644 index 0000000000..0f1dbe54dc --- /dev/null +++ b/test/lisp/image-dired-tests.el @@ -0,0 +1,36 @@ +;;; image-dired-tests.el --- Tests for image-dired.el -*- lexical-binding: t -*- + +;; Copyright (C) 2021 Free Software Foundation, Inc. + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Code: + +(require 'ert) +(require 'image-dired) + +(defun image-dired-test-image-file (name) + (expand-file-name + name (expand-file-name "data/image" + (or (getenv "EMACS_TEST_DIRECTORY") + "../")))) + +(ert-deftest image-dired-tests-get-exif-file-name () + (let ((img (image-dired-test-image-file "black.jpg"))) + (should (equal (image-dired-get-exif-file-name img) + "2019_09_21_16_22_13_black.jpg")))) + +;;; image-dired-tests.el ends here commit 598732c89907e4f257d383126cb7f80962b35458 Author: Eli Zaretskii Date: Sat Oct 23 09:15:40 2021 +0300 ; * src/vm-limit.c (get_lim_data): Fix a typo. (Bug#18238) diff --git a/src/vm-limit.c b/src/vm-limit.c index b9058d0435..e0547651bb 100644 --- a/src/vm-limit.c +++ b/src/vm-limit.c @@ -126,7 +126,7 @@ get_lim_data (void) dos_memory_info (&totalram, &freeram, &totalswap, &freeswap); lim_data = freeram; - /* Don't believe they will give us more that 0.5 GB. */ + /* Don't believe they will give us more than 0.5 GB. */ if (lim_data > 512U * 1024U * 1024U) lim_data = 512U * 1024U * 1024U; } commit bb06d5648eac297e5574b15c7723903c8c922d03 Author: Stefan Kangas Date: Sat Oct 23 06:12:35 2021 +0200 Add new function exif-field * test/lisp/image/exif-tests.el (exif-elem): Move function from here... * lisp/image/exif.el (exif-field): ...to here, and rename. (exif-orientation): * test/lisp/image/exif-tests.el (test-exif-parse) (test-exif-parse-short): Use above new function. diff --git a/etc/NEWS b/etc/NEWS index 36d04aa2d8..7f61cf952a 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -189,6 +189,12 @@ To improve security, if an sql product has ':password-in-comint' set to t, a password supplied via the minibuffer will be sent in-process, as opposed to via the command-line. +** Exif + +*** New function 'exif-field'. +This is a convenience function to extract the field data from +`exif-parse-file' and `exif-parse-buffer'. + * New Modes and Packages in Emacs 29.1 diff --git a/lisp/image/exif.el b/lisp/image/exif.el index c2cf234640..67b00844d3 100644 --- a/lisp/image/exif.el +++ b/lisp/image/exif.el @@ -58,6 +58,9 @@ ;; (:tag 306 :tag-name date-time :format 2 :format-type ascii ;; :value "2019:09:21 16:22:13") ;; ...) +;; +;; (exif-field 'date-time (exif-parse-file "test.jpg")) => +;; "2022:09:14 18:46:19" ;;; Code: @@ -122,13 +125,20 @@ If the data is invalid, an `exif-error' is signaled." (when-let ((app1 (cdr (assq #xffe1 (exif--parse-jpeg))))) (exif--parse-exif-chunk app1)))))) +(defun exif-field (field data) + "Return raw FIELD from EXIF. +If FIELD is not present in the data, return nil. +FIELD is a symbol in the cdr of `exif-tag-alist'. +DATA is the result of calling `exif-parse-file'." + (plist-get (seq-find (lambda (e) + (eq field (plist-get e :tag-name))) + data) + :value)) + (defun exif-orientation (exif) "Return the orientation (in degrees) in EXIF. If the orientation isn't present in the data, return nil." - (let ((code (plist-get (cl-find 'orientation exif - :key (lambda (e) - (plist-get e :tag-name))) - :value))) + (let ((code (exif-field 'orientation exif))) (cadr (assq code exif--orientation)))) (defun exif--parse-jpeg () diff --git a/test/lisp/image/exif-tests.el b/test/lisp/image/exif-tests.el index ddbee75467..2357113f63 100644 --- a/test/lisp/image/exif-tests.el +++ b/test/lisp/image/exif-tests.el @@ -28,24 +28,19 @@ (or (getenv "EMACS_TEST_DIRECTORY") "../../")))) -(defun exif-elem (exif elem) - (plist-get (seq-find (lambda (e) - (eq elem (plist-get e :tag-name))) - exif) - :value)) - (ert-deftest test-exif-parse () (let ((exif (exif-parse-file (test-image-file "black.jpg")))) - (should (equal (exif-elem exif 'make) "Panasonic")) - (should (equal (exif-elem exif 'orientation) 1)) - (should (equal (exif-elem exif 'x-resolution) '(180 . 1))))) + (should (equal (exif-field 'make exif) "Panasonic")) + (should (equal (exif-field 'orientation exif) 1)) + (should (equal (exif-field 'x-resolution exif) '(180 . 1))) + (should (equal (exif-field 'date-time exif) "2019:09:21 16:22:13")))) (ert-deftest test-exif-parse-short () (let ((exif (exif-parse-file (test-image-file "black-short.jpg")))) - (should (equal (exif-elem exif 'make) "thr")) - (should (equal (exif-elem exif 'model) "four")) - (should (equal (exif-elem exif 'software) "em")) - (should (equal (exif-elem exif 'artist) "z")))) + (should (equal (exif-field 'make exif) "thr")) + (should (equal (exif-field 'model exif) "four")) + (should (equal (exif-field 'software exif) "em")) + (should (equal (exif-field 'artist exif) "z")))) (ert-deftest test-exit-direct-ascii-value () (should (equal (exif--direct-ascii-value 28005 2 t) (string ?e ?m 0))) commit 241574375df80a136624ea622d76b426e1437617 Author: Stefan Kangas Date: Sat Oct 23 05:25:37 2021 +0200 Add links to commentary reached with finder-list-keywords * lisp/finder.el (finder-goto-xref): Move from here... * lisp/emacs-lisp/package.el (package--finder-goto-xref): ...to here. Make the old name into an obsolete function alias. (package--finder-xref): New button type. (package--describe-add-library-links): Factor out new function... * lisp/finder.el (finder-commentary): ...from here. (describe-package-1): Call above new function. This fixes an issue where commentaries reached via 'finder-list-keywords' did not have links. (Bug#10814) diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index 40318dcb65..fcbcdc79d8 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -2488,6 +2488,15 @@ The description is read from the installed package files." (format "%s.el" (package-desc-name desc)) srcdir)) ""))) +(defun package--describe-add-library-links () + "Add links to library names in package description." + (while (re-search-forward "\\<\\([-[:alnum:]]+\\.el\\)\\>" nil t) + (if (locate-library (match-string 1)) + (make-text-button (match-beginning 1) (match-end 1) + 'xref (match-string-no-properties 1) + 'help-echo "Read this file's commentary" + :type 'package--finder-xref)))) + (defun describe-package-1 (pkg) "Insert the package description for PKG. Helper function for `describe-package'." @@ -2714,6 +2723,9 @@ Helper function for `describe-package'." t) (insert (or readme-string "This package does not provide a description."))))) + ;; Make library descriptions into links. + (goto-char start-of-description) + (package--describe-add-library-links) ;; Make URLs in the description into links. (goto-char start-of-description) (browse-url-add-buttons)))) @@ -2759,6 +2771,15 @@ function is a convenience wrapper used by `describe-package-1'." (apply #'insert-text-button button-text 'face button-face 'follow-link t properties))) +(defun package--finder-goto-xref (button) + "Jump to a Lisp file for the BUTTON at point." + (let* ((file (button-get button 'xref)) + (lib (locate-library file))) + (if lib (finder-commentary lib) + (message "Unable to locate `%s'" file)))) + +(define-button-type 'package--finder-xref 'action #'package--finder-goto-xref) + (defun package--print-email-button (recipient) "Insert a button whose action will send an email to RECIPIENT. NAME should have the form (FULLNAME . EMAIL) where FULLNAME is diff --git a/lisp/finder.el b/lisp/finder.el index c2b9a6d0ef..00f321b802 100644 --- a/lisp/finder.el +++ b/lisp/finder.el @@ -362,19 +362,13 @@ not `finder-known-keywords'." (let ((package-list-unversioned t)) (package-show-package-list packages)))) -(define-button-type 'finder-xref 'action #'finder-goto-xref) - -(defun finder-goto-xref (button) - "Jump to a Lisp file for the BUTTON at point." - (let* ((file (button-get button 'xref)) - (lib (locate-library file))) - (if lib (finder-commentary lib) - (message "Unable to locate `%s'" file)))) - ;;;###autoload (defun finder-commentary (file) "Display FILE's commentary section. FILE should be in a form suitable for passing to `locate-library'." + ;; FIXME: Merge this function into `describe-package', which is + ;; strictly better as it has links to URL's and is in a proper help + ;; buffer with navigation forward and backward, etc. (interactive (list (completing-read "Library name: " @@ -391,12 +385,7 @@ FILE should be in a form suitable for passing to `locate-library'." (erase-buffer) (insert str) (goto-char (point-min)) - (while (re-search-forward "\\<\\([-[:alnum:]]+\\.el\\)\\>" nil t) - (if (locate-library (match-string 1)) - (make-text-button (match-beginning 1) (match-end 1) - 'xref (match-string-no-properties 1) - 'help-echo "Read this file's commentary" - :type 'finder-xref))) + (package--describe-add-library-links) (goto-char (point-min)) (setq buffer-read-only t) (set-buffer-modified-p nil) @@ -469,6 +458,9 @@ Quit the window and kill all Finder-related buffers." ;; continue standard unloading nil) +(define-obsolete-function-alias 'finder-goto-xref + #'package--finder-goto-xref "29.1") + (provide 'finder) commit 0170e6d0e876e897cf98e1e1767523dcf058090e Author: Stefan Kangas Date: Sat Oct 23 02:46:06 2021 +0200 * src/image.c (webp_load): Fix thinkos. diff --git a/src/image.c b/src/image.c index 308dc68726..f78ad044ab 100644 --- a/src/image.c +++ b/src/image.c @@ -8888,7 +8888,7 @@ webp_load (struct frame *f, struct image *img) /* Validate the WebP image header. */ if (!WebPGetInfo (contents, size, NULL, NULL)) { - if (!NILP (specified_data)) + if (NILP (specified_data)) image_error ("Not a WebP file: `%s'", file); else image_error ("Invalid header in WebP image data"); @@ -8911,7 +8911,7 @@ webp_load (struct frame *f, struct image *img) case VP8_STATUS_USER_ABORT: default: /* Error out in all other cases. */ - if (!NILP (specified_data)) + if (NILP (specified_data)) image_error ("Error when interpreting WebP image data: `%s'", file); else image_error ("Error when interpreting WebP image data"); commit efdffd86c5833756bb14e266dc11e053e721c7a9 Author: Stefan Kangas Date: Sat Oct 23 01:19:04 2021 +0200 ; * etc/refcards/README: Prefer HTTPS in link. diff --git a/etc/refcards/README b/etc/refcards/README index 94bf7b1f0b..4102c85ba1 100644 --- a/etc/refcards/README +++ b/etc/refcards/README @@ -5,7 +5,7 @@ See the end of the file for license conditions. REFERENCE CARDS FOR GNU EMACS To generate these refcards, you need to install the TeX document -production system. For example, . +production system. For example, . All modern GNU/Linux distributions provide TeX packages, so the easiest way is just to install those. Your distribution may have commit 51719617eb19833056618ebac403cdcaf711551a Author: Alan Mackenzie Date: Fri Oct 22 19:55:01 2021 +0000 CC Mode: Fontify "found types" which are recognized after being first scanned This aims to fix the scenario where on jit-lock's first scan of a type, it is not recognized as such, and only later does this happen. The fontification of such found types is now done by background scanning in short time slices immediately after initialising the mode. * lisp/progmodes/cc-engine.el (c-add-type-1): New function. (c-add-type): Extract c-add-type-1 from it, and reformulate the mechanism for protecting c-found-types from excessive partial identifiers. * lisp/progmodes/cc-fonts.el (c-font-lock-complex-decl-prepare): Remove the code which cleared c-found-types on fontification at BOB. (c-find-types-background): New function, based on c-font-lock-declarations). (c-types-finder-timer-func): New function. (c-re-redisplay-timer): New variable. (c-force-redisplay, c-fontify-new-found-type): New functions. * lisp/progmodes/cc-mode.el (c-type-finder-timer): New variable. (c-leave-cc-mode-mode): Nullify c-post-command-hook and c-type-finder-timer when the last CC Mode buffer of a session is killed. (c-type-finder-pos): New variable. (c-basic-common-init): Initialize c-type-finder-pos and c-type-finder-timer. (c-new-id-start, c-new-id-end, c-new-id-is-type): New variables. (c-update-new-id): New function. (c-post-command): New post command hook function, used for checking moving away from partially typed identifiers, and making them full identifiers. (c-before-change): Add code to clear c-found-types on a buffer change at BOB. (c-after-change): Call c-update-new-id to keep track of partially typed identifiers. * doc/misc/cc-mode.texi (Found Types): New @section in the @Chapter Font Locking. * lisp/progmodes/cc-vars.el (c-type-finder-time-slot) (c-type-finder-repeat-time, c-type-finder-chunk-size): New customizable options. diff --git a/doc/misc/cc-mode.texi b/doc/misc/cc-mode.texi index 98ded68e71..c255d9870f 100644 --- a/doc/misc/cc-mode.texi +++ b/doc/misc/cc-mode.texi @@ -283,6 +283,8 @@ Font Locking * Font Locking Preliminaries:: * Faces:: * Doc Comments:: +* Wrong Comment Style:: +* Found Types:: * Misc Font Locking:: * AWK Mode Font Locking:: @@ -2161,6 +2163,60 @@ which aren't of the default style will be fontified with @code{font-lock-warning-face}. @end defvar +@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +@node Found Types +@comment node-name, next, previous, up +@section ``Found Type'' handling. +@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +In most languages handled by CC Mode, @dfn{found types} are recognized +as types by their context in the source code. These contrast with +types which are basic to a language or are declared as types (e.g. by +@code{typedef} in C). + +In earlier versions of @ccmode{}, when @code{jit-lock-mode} was +enabled in Emacs (which it is by default), found types would +frequently fail to get fontified properly. This happened when the +fontification functions scanned a use of the found type before +scanning the code which caused it to be recognized. + +From @ccmode{} version 5.36, a timer mechanism scans the entire buffer +for found types in the seconds immediately after starting the major +mode. When a found type gets recognized, all its occurrences in the +buffer get marked for (re)fontification. This scanning happens in +short time slices interleaved with other processing, such as keyboard +handling, so that the responsiveness of Emacs should be barely +affected. This mechanism can be disabled (see below). It is only +active when @code{jit-lock-mode} is also active. + +@defvar c-type-finder-time-slot +@vindex type-finder-time-slot (c-) +The approximate time in seconds that CC Mode spends in scanning source +code before relinquishing control to other Emacs activities. The +default value is 0.05. To disable the scanning mechanism, set this +variable to @code{nil}. +@end defvar + +@defvar c-type-finder-repeat-time +@vindex type-finder-repeat-time (c-) +The approximate frequency (in seconds) with which the scanning +mechanism is triggered. This time must be greater than +@code{c-type-finder-time-slot}. Its default value is 0.1. If a less +powerful machine becomes sluggish due to the scanning, increase the +value of @code{c-type-finder-repeat-time} to compensate. +@end defvar + +@defvar c-type-finder-chunk-size +@vindex type-finder-chunk-size (c-) +The approximate size (in characters) of the buffer chunk processed as +a unit before the scanning mechanism checks whether +@code{c-type-finder-time-slot} seconds have passed. The default value +is 1000. A too small value here will cause inefficiencies due to the +initialization which happens for each chunk, whereas a too large value +will cause the processing to consume an excessive proportion of the +@code{c-type-finder-repeat-time}. +@end defvar + @comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @node Misc Font Locking @comment node-name, next, previous, up diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el index c42c95764a..ace6b1b686 100644 --- a/lisp/progmodes/cc-engine.el +++ b/lisp/progmodes/cc-engine.el @@ -165,6 +165,9 @@ (defvar c-doc-line-join-end-ch) (defvar c-syntactic-context) (defvar c-syntactic-element) +(defvar c-new-id-start) +(defvar c-new-id-end) +(defvar c-new-id-is-type) (cc-bytecomp-defvar c-min-syn-tab-mkr) (cc-bytecomp-defvar c-max-syn-tab-mkr) (cc-bytecomp-defun c-clear-syn-tab) @@ -6813,21 +6816,32 @@ comment at the start of cc-engine.el for more info." (setq c-found-types (make-hash-table :test #'equal :weakness nil))) -(defun c-add-type (from to) - ;; Add the given region as a type in `c-found-types'. If the region - ;; doesn't match an existing type but there is a type which is equal - ;; to the given one except that the last character is missing, then - ;; the shorter type is removed. That's done to avoid adding all - ;; prefixes of a type as it's being entered and font locked. This - ;; doesn't cover cases like when characters are removed from a type - ;; or added in the middle. We'd need the position of point when the - ;; font locking is invoked to solve this well. +(defun c-add-type-1 (from to) + ;; Add the given region as a type in `c-found-types'. Prepare occurrences + ;; of this new type for fontification throughout the buffer. ;; ;; This function might do hidden buffer changes. (let ((type (c-syntactic-content from to c-recognize-<>-arglists))) (unless (gethash type c-found-types) - (remhash (substring type 0 -1) c-found-types) - (puthash type t c-found-types)))) + (puthash type t c-found-types) + (when (and (eq (string-match c-symbol-key type) 0) + (eq (match-end 0) (length type))) + (c-fontify-new-found-type type))))) + +(defun c-add-type (from to) + ;; Add the given region as a type in `c-found-types'. Also perform the + ;; actions of `c-add-type-1'. If the region is or overlaps an identifier + ;; which might be being typed in, don't record it. This is tested by + ;; checking `c-new-id-start' and `c-new-id-end'. That's done to avoid + ;; adding all prefixes of a type as it's being entered and font locked. + ;; This is a bit rough and ready, but now covers adding characters into the + ;; middle of an identifer. + ;; + ;; This function might do hidden buffer changes. + (if (and c-new-id-start c-new-id-end + (<= from c-new-id-end) (>= to c-new-id-start)) + (setq c-new-id-is-type t) + (c-add-type-1 from to))) (defun c-unfind-type (name) ;; Remove the "NAME" from c-found-types, if present. diff --git a/lisp/progmodes/cc-fonts.el b/lisp/progmodes/cc-fonts.el index bc0ae6cc95..588674464a 100644 --- a/lisp/progmodes/cc-fonts.el +++ b/lisp/progmodes/cc-fonts.el @@ -93,10 +93,12 @@ (cc-bytecomp-defvar c-preprocessor-face-name) (cc-bytecomp-defvar c-reference-face-name) (cc-bytecomp-defvar c-block-comment-flag) +(cc-bytecomp-defvar c-type-finder-pos) (cc-bytecomp-defun c-fontify-recorded-types-and-refs) (cc-bytecomp-defun c-font-lock-declarators) (cc-bytecomp-defun c-font-lock-objc-method) (cc-bytecomp-defun c-font-lock-invalid-string) +(cc-bytecomp-defun c-before-context-fl-expand-region) ;; Note that font-lock in XEmacs doesn't expand face names as @@ -919,13 +921,6 @@ casts and declarations are fontified. Used on level 2 and higher." ;; This function does hidden buffer changes. ;;(message "c-font-lock-complex-decl-prepare %s %s" (point) limit) - - ;; Clear the list of found types if we start from the start of the - ;; buffer, to make it easier to get rid of misspelled types and - ;; variables that have gotten recognized as types in malformed code. - (when (bobp) - (c-clear-found-types)) - (c-skip-comments-and-strings limit) (when (< (point) limit) @@ -1605,6 +1600,158 @@ casts and declarations are fontified. Used on level 2 and higher." nil)))) +(defun c-find-types-background (start limit) + ;; Find any "found types" between START and LIMIT. Allow any such types to + ;; be entered into `c-found-types' by the action of `c-forward-name' or + ;; `c-forward-type' called from this function. This process also causes + ;; occurrences of the type to be prepared for fontification throughout the + ;; buffer. + ;; + ;; This function is called from the timer `c-type-finder-timer'. It may do + ;; hidden buffer changes. + (save-excursion + (save-restriction + (widen) + (goto-char start) + (c-skip-comments-and-strings limit) + (when (< (point) limit) + (let ( + ;; o - 'decl if we're in an arglist containing declarations + ;; (but if `c-recognize-paren-inits' is set it might also be + ;; an initializer arglist); + ;; o - '<> if the arglist is of angle bracket type; + ;; o - 'arglist if it's some other arglist; + ;; o - nil, if not in an arglist at all. This includes the + ;; parenthesized condition which follows "if", "while", etc. + context + ;; A list of starting positions of possible type declarations, or of + ;; the typedef preceding one, if any. + last-cast-end + ;; The result from `c-forward-decl-or-cast-1'. + decl-or-cast + ;; The maximum of the end positions of all the checked type + ;; decl expressions in the successfully identified + ;; declarations. The position might be either before or + ;; after the syntactic whitespace following the last token + ;; in the type decl expression. + (max-type-decl-end 0) + ;; Same as `max-type-decl-*', but used when we're before + ;; `token-pos'. + (max-type-decl-end-before-token 0) + ) + (goto-char start) + (c-find-decl-spots + limit + c-decl-start-re + nil ; (eval c-maybe-decl-faces) + + (lambda (match-pos inside-macro &optional toplev) + ;; Note to maintainers: don't use `limit' inside this lambda form; + ;; c-find-decl-spots sometimes narrows to less than `limit'. + (if (and c-macro-with-semi-re + (looking-at c-macro-with-semi-re)) + ;; Don't do anything more if we're looking at something that + ;; can't start a declaration. + t + + ;; Set `context' and `c-restricted-<>-arglists'. Look for + ;; "<" for the sake of C++-style template arglists. + ;; "Ignore "(" when it's part of a control flow construct + ;; (e.g. "for ("). + (let ((got-context + (c-get-fontification-context + match-pos + (< match-pos (if inside-macro + max-type-decl-end-before-token + max-type-decl-end)) + toplev))) + (setq context (car got-context) + c-restricted-<>-arglists (cdr got-context))) + + ;; In QT, "more" is an irritating keyword that expands to nothing. + ;; We skip over it to prevent recognition of "more slots: " + ;; as a bitfield declaration. + (when (and (c-major-mode-is 'c++-mode) + (looking-at + (concat "\\(more\\)\\([^" c-symbol-chars "]\\|$\\)"))) + (goto-char (match-end 1)) + (c-forward-syntactic-ws)) + + ;; Now analyze the construct. This analysis will cause + ;; `c-forward-name' and `c-forward-type' to call `c-add-type', + ;; triggering the desired recognition and fontification of + ;; these found types. + (when (not (eq context 'not-decl)) + (setq decl-or-cast + (c-forward-decl-or-cast-1 + match-pos context last-cast-end)) + + (cond + ((eq decl-or-cast 'cast) + ;; Save the position after the previous cast so we can feed + ;; it to `c-forward-decl-or-cast-1' in the next round. That + ;; helps it discover cast chains like "(a) (b) c". + (setq last-cast-end (point)) + nil) + (decl-or-cast + ;; We've found a declaration. + + ;; Set `max-type-decl-end' or `max-type-decl-end-before-token' + ;; under the assumption that we're after the first type decl + ;; expression in the declaration now. That's not really true; + ;; we could also be after a parenthesized initializer + ;; expression in C++, but this is only used as a last resort + ;; to slant ambiguous expression/declarations, and overall + ;; it's worth the risk to occasionally fontify an expression + ;; as a declaration in an initializer expression compared to + ;; getting ambiguous things in normal function prototypes + ;; fontified as expressions. + (if inside-macro + (when (> (point) max-type-decl-end-before-token) + (setq max-type-decl-end-before-token (point))) + (when (> (point) max-type-decl-end) + (setq max-type-decl-end (point))))) + (t t))))))))))) + +(defun c-types-finder-timer-func () + ;; A CC Mode idle timer function for finding "found types". It triggers + ;; every `c-type-finder-repeat-time' seconds and processes buffer chunks of + ;; size around `c-type-finder-chunk-size' characters, and runs for (a little + ;; over) `c-type-finder-time-slot' seconds. The types it finds are inserted + ;; into `c-found-types', and their occurrences throughout the buffer are + ;; prepared for fontification. + (let* ((stop-time (+ (float-time) c-type-finder-time-slot)) + (buf-list (buffer-list))) + ;; One CC Mode buffer needing processing each time around this loop. + (while buf-list + ;; Cdr through BUF-LIST to find the next buffer needing processing. + (while (and buf-list + (not (with-current-buffer (car buf-list) c-type-finder-pos))) + (setq buf-list (cdr buf-list))) + (when buf-list + (with-current-buffer (car buf-list) + (save-restriction + (widen) + ;; Process one `c-type-finder-chunk-size' chunk each time around + ;; this loop. + (while (and c-type-finder-pos + (< (float-time) stop-time)) + ;; Process one chunk per iteration. + (c-save-buffer-state + ((beg (marker-position c-type-finder-pos)) + (end (min (+ beg c-type-finder-chunk-size) (point-max))) + (region (c-before-context-fl-expand-region beg end))) + (setq beg (car region) + end (cdr region)) + (c-find-types-background beg end) + (move-marker c-type-finder-pos + (if (save-excursion (goto-char end) (eobp)) + nil + end)) + (when (not (marker-position c-type-finder-pos)) + (setq c-type-finder-pos nil)))))) + (setq buf-list (cdr buf-list)))))) + (defun c-font-lock-enum-body (limit) ;; Fontify the identifiers of each enum we find by searching forward. ;; @@ -2255,6 +2402,46 @@ higher." ;; defvar will install its default value later on. (makunbound def-var))) +;; `c-re-redisplay-timer' is a timer which, when triggered, causes a +;; redisplay. +(defvar c-re-redisplay-timer nil) + +(defun c-force-redisplay (start end) + ;; Force redisplay immediately. This assumes `font-lock-support-mode' is + ;; 'jit-lock-mode. Set the variable `c-re-redisplay-timer' to nil. + (jit-lock-force-redisplay (copy-marker start) (copy-marker end)) + (setq c-re-redisplay-timer nil)) + +(defun c-fontify-new-found-type (type) + ;; Cause the fontification of TYPE, a string, wherever it occurs in the + ;; buffer. If TYPE is currently displayed in a window, cause redisplay to + ;; happen "instantaneously". These actions are done only when jit-lock-mode + ;; is active. + (when (and (boundp 'font-lock-support-mode) + (eq font-lock-support-mode 'jit-lock-mode)) + (c-save-buffer-state + ((window-boundaries + (mapcar (lambda (win) + (cons (window-start win) + (window-end win))) + (get-buffer-window-list (current-buffer) 'no-mini t))) + (target-re (concat "\\_<" type "\\_>"))) + (save-excursion + (save-restriction + (widen) + (goto-char (point-min)) + (while (re-search-forward target-re nil t) + (put-text-property (match-beginning 0) (match-end 0) + 'fontified nil) + (dolist (win-boundary window-boundaries) + (when (and (< (match-beginning 0) (cdr win-boundary)) + (> (match-end 0) (car win-boundary)) + (c-get-char-property (match-beginning 0) 'fontified) + (not c-re-redisplay-timer)) + (setq c-re-redisplay-timer + (run-with-timer 0 nil #'c-force-redisplay + (match-beginning 0) (match-end 0))))))))))) + ;;; C. diff --git a/lisp/progmodes/cc-mode.el b/lisp/progmodes/cc-mode.el index c9b7a95df6..80909380eb 100644 --- a/lisp/progmodes/cc-mode.el +++ b/lisp/progmodes/cc-mode.el @@ -129,6 +129,10 @@ ; ' (require 'cc-fonts) ;) +(defvar c-type-finder-timer nil) +;; The variable which holds the repeating idle timer which triggers off the +;; background type finding search. + ;; The following three really belong to cc-fonts.el, but they are required ;; even when cc-fonts.el hasn't been loaded (this happens in XEmacs when ;; font-lock-mode is nil). @@ -179,6 +183,17 @@ (when c-buffer-is-cc-mode (save-restriction (widen) + (let ((lst (buffer-list))) + (catch 'found + (dolist (b lst) + (if (and (not (eq b (current-buffer))) + (with-current-buffer b + c-buffer-is-cc-mode)) + (throw 'found nil))) + (remove-hook 'post-command-hook 'c-post-command) + (and c-type-finder-timer + (progn (cancel-timer c-type-finder-timer) + (setq c-type-finder-timer nil))))) (c-save-buffer-state () (c-clear-char-properties (point-min) (point-max) 'category) (c-clear-char-properties (point-min) (point-max) 'syntax-table) @@ -574,6 +589,12 @@ preferably use the `c-mode-menu' language constant directly." ;; currently no such text property. (make-variable-buffer-local 'c-max-syn-tab-mkr) +;; `c-type-finder-pos' is a marker marking the current place in a CC Mode +;; buffer which is due to be searched next for "found types", or nil if the +;; searching is complete. +(defvar c-type-finder-pos nil) +(make-variable-buffer-local 'c-type-finder-pos) + (defun c-basic-common-init (mode default-style) "Initialize the syntax handling routines and the line breaking/filling code. Intended to be used by other packages that embed CC Mode. @@ -745,6 +766,15 @@ that requires a literal mode spec at compile time." ;; would do since font-lock uses a(n implicit) depth of 0) so we don't need ;; c-after-font-lock-init. (add-hook 'after-change-functions 'c-after-change nil t) + (add-hook 'post-command-hook 'c-post-command) + (setq c-type-finder-pos + (save-restriction + (widen) + (move-marker (make-marker) (point-min)))) + (or c-type-finder-timer + (setq c-type-finder-timer + (run-at-time + t c-type-finder-repeat-time #'c-types-finder-timer-func))) (when (boundp 'font-lock-extend-after-change-region-function) (set (make-local-variable 'font-lock-extend-after-change-region-function) 'c-extend-after-change-region))) ; Currently (2009-05) used by all @@ -1950,6 +1980,43 @@ Note that this is a strict tail, so won't match, e.g. \"0x....\".") ;; confused by already processed single quotes. (narrow-to-region (point) (point-max)))))) +;; The next two variables record the bounds of an identifier currently being +;; typed in. These are used to prevent such a partial identifier being +;; recorded as a found type by c-add-type. +(defvar c-new-id-start nil) +(make-variable-buffer-local 'c-new-id-start) +(defvar c-new-id-end nil) +(make-variable-buffer-local 'c-new-id-end) +;; The next variable, when non-nil, records that the previous two variables +;; define a type. +(defvar c-new-id-is-type nil) +(make-variable-buffer-local 'c-new-id-is-type) + +(defun c-update-new-id (end) + ;; Note the bounds of any identifier that END is in or just after, in + ;; `c-new-id-start' and `c-new-id-end'. Otherwise set these variables to + ;; nil. + (save-excursion + (goto-char end) + (let ((id-beg (c-on-identifier))) + (setq c-new-id-start id-beg + c-new-id-end (and id-beg + (progn (c-end-of-current-token) (point))))))) + + +(defun c-post-command () + ;; If point was inside of a new identifier and no longer is, record that + ;; fact. + (when (and c-buffer-is-cc-mode + c-new-id-start c-new-id-end + (or (> (point) c-new-id-end) + (< (point) c-new-id-start))) + (when c-new-id-is-type + (c-add-type-1 c-new-id-start c-new-id-end)) + (setq c-new-id-start nil + c-new-id-end nil + c-new-id-is-type nil))) + (defun c-before-change (beg end) ;; Function to be put on `before-change-functions'. Primarily, this calls ;; the language dependent `c-get-state-before-change-functions'. It is @@ -1969,11 +2036,16 @@ Note that this is a strict tail, so won't match, e.g. \"0x....\".") (unless (c-called-from-text-property-change-p) (save-restriction (widen) + ;; Clear the list of found types if we make a change at the start of the + ;; buffer, to make it easier to get rid of misspelled types and + ;; variables that have gotten recognized as types in malformed code. + (when (eq beg (point-min)) + (c-clear-found-types)) (if c-just-done-before-change - ;; We have two consecutive calls to `before-change-functions' without - ;; an intervening `after-change-functions'. An example of this is bug - ;; #38691. To protect CC Mode, assume that the entire buffer has - ;; changed. + ;; We have two consecutive calls to `before-change-functions' + ;; without an intervening `after-change-functions'. An example of + ;; this is bug #38691. To protect CC Mode, assume that the entire + ;; buffer has changed. (setq beg (point-min) end (point-max) c-just-done-before-change 'whole-buffer) @@ -2151,6 +2223,7 @@ Note that this is a strict tail, so won't match, e.g. \"0x....\".") c->-as-paren-syntax) (c-clear-char-property-with-value beg end 'syntax-table nil))) + (c-update-new-id end) (c-trim-found-types beg end old-len) ; maybe we don't ; need all of these. (c-invalidate-sws-region-after beg end old-len) diff --git a/lisp/progmodes/cc-vars.el b/lisp/progmodes/cc-vars.el index 83fd3da7c1..40a43c32ed 100644 --- a/lisp/progmodes/cc-vars.el +++ b/lisp/progmodes/cc-vars.el @@ -1524,6 +1524,39 @@ working due to this change." :type 'boolean :group 'c) +(defcustom c-type-finder-time-slot 0.05 + "The length in seconds of a background type search time slot. + +In CC Mode modes, \"found types\" wouldn't always get cleanly +fontified without the background searching for them which happens +in the seconds after starting Emacs or initializing the major +mode. + +This background searching can be disabled by setting this option +to nil." + :type '(choice (const :tag "disabled" nil) + number) + :group 'c) + +(defcustom c-type-finder-repeat-time 0.1 + "The interval, in seconds, at which background type searches occur. + +This interval must be greater than `c-type-finder-time-slot'." + :type 'number + :group 'c) + +(defcustom c-type-finder-chunk-size 1000 + "The size, in characters, of a chunk for background type search. + +Chunks of this size are searched atomically for \"found types\" +just after starting Emacs or initializing the major mode. + +This chunk size is a balance between efficiency (with larger +values) and responsiveness of the keyboard (with smaller values). +See also `c-type-finder-time-slot'." + :type 'integer + :group 'c) + (define-widget 'c-extra-types-widget 'radio "Internal CC Mode widget for the `*-font-lock-extra-types' variables." :args '((const :tag "none" nil) commit 4cf06bb751c75dd2ae82c6e845c194107f93ee14 Merge: f7a2ff3bf5 b0d64be0bc Author: Glenn Morris Date: Fri Oct 22 09:39:39 2021 -0700 Merge from origin/emacs-28 b0d64be0bc (origin/emacs-28) Improve some NEWS entries 7fde84e881 Improve documentation of syntax-ppss-context slightly 5ecbed01b2 ; * test/lisp/mh-e/mh-utils-tests.el: Update macro declara... 168665da59 Move some xwidget entries efde024361 time-stamp-tests: improvements to test macros 06c944cff1 Fix rfc6068-parse-mailto-url autoload 9b6b5e37ef Regexp-quote github domains in bug-reference 1f6cdeb12c Ensure valid end/beginning lines in message-mark-inserted-... 9b46150ab0 * etc/NEWS: Improve 'repeat-mode' entry. 9c37b812da ; * lisp/repeat.el (repeat-mode): Fix docstring typo. caf87d80fa * lisp/repeat.el (repeat-keep-prefix): Expand description. 24083c8d13 * lisp/net/eww.el (eww-retrieve-command): Add :tag. cf7d8fb1d7 Add description of cards to etc/refcards/README d2849cc645 Fix 'calculate-lisp-indent' when "[" starts containing sex... 2a0a368ddc Fix typo in doc/emacs/anti.texi 9529e1d2fb Update doc of Edebug specification for macros 5bc522b4f4 ; * lisp/simple.el (kill-region): A better fix for bug#51320. ee6bdd6eef Fix non-interactive behavior of 'kill-region' 2b7655ca0e ; More accurate doc string for 'tab-bar-format' 2841e26744 * test/lisp/dabbrev-tests.el: Use 'kbd' for readable keys. 1cdb4d2077 * lisp/menu-bar.el (menu-bar-keymap): Add optional arg KEY... # Conflicts: # etc/NEWS # lisp/progmodes/bug-reference.el commit b0d64be0bc581958bf3a74152a2cd10172916b03 Author: Robert Pluim Date: Fri Oct 22 18:03:00 2021 +0200 Improve some NEWS entries * etc/NEWS: Improve some NEWS entries. diff --git a/etc/NEWS b/etc/NEWS index 6a296fd880..4942a35b7b 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -80,12 +80,13 @@ This was only ever relevant when building from a repository checkout. This now requires makeinfo, which is part of the texinfo package. --- -** There is a new configure option '--disable-year2038' to cause -Emacs to use only 32-bit time_t on platforms that have both 32- and -64-bit time_t. This may help link Emacs to a library with ABI -requiring traditional 32-bit time_t. This option currently affects -only 32-bit ARM and x86 running GNU/Linux with glibc 2.34 and later. -Emacs now defaults to 64-bit time_t on these platforms. +** New configure option '--disable-year2038'. +This causes Emacs to use only 32-bit time_t on platforms that have +both 32- and 64-bit time_t. This may help when linking Emacs with a +library with an ABI requiring traditional 32-bit time_t. This option +currently affects only 32-bit ARM and x86 running GNU/Linux with glibc +2.34 and later. Emacs now defaults to 64-bit time_t on these +platforms. --- ** Support for building with '-fcheck-pointer-bounds' has been removed. @@ -273,9 +274,9 @@ whether the function 'read-answer' accepts short answers. +++ ** New user option 'kill-buffer-delete-auto-save-files'. If non-nil, killing a buffer that has an auto-save file will prompt -the user for whether that file should be deleted. (Note that -'delete-auto-save-files', if non-nil, was previously documented to -result in deletion of auto-save files when killing a buffer without +the user for whether that auto-save file should be deleted. (Note +that 'delete-auto-save-files', if non-nil, was previously documented +to result in deletion of auto-save files when killing a buffer without unsaved changes, but this has apparently not worked for several decades, so the documented semantics of this variable has been changed to match the behavior.) @@ -354,6 +355,8 @@ of the next command to be displayed in a new frame. *** New command 'clone-frame' (bound to 'C-x 5 c'). This is like 'C-x 5 2', but uses the window configuration and frame parameters of the current frame instead of 'default-frame-alist'. +When called interactively with a prefix arg, the window configuration +is not cloned. --- *** Default values of 'frame-title-format' and 'icon-title-format' have changed. @@ -393,12 +396,13 @@ of the next command to be displayed in a new window. +++ *** New command 'recenter-other-window', bound to 'S-M-C-l'. -Like 'recenter-top-bottom' acting on the other window. +Like 'recenter-top-bottom', but acting on the other window. +++ *** New user option 'delete-window-choose-selected'. -This allows to choose a window that will be the frame's selected -window after deleting the currently selected one. +This allows specifying how Emacs chooses which window will be the +frame's selected window after the currently selected window is +deleted. +++ *** New argument NO-OTHER for some window functions. @@ -496,7 +500,7 @@ on each frame compared to the numerical value of 'tab-bar-show'. *** New command 'toggle-frame-tab-bar'. It can be used to enable/disable the tab bar on the currently selected frame regardless of the values of 'tab-bar-mode' and 'tab-bar-show'. -This allows to enable/disable the tab bar independently on different +This allows enabling/disabling the tab bar independently on different frames. --- @@ -510,10 +514,10 @@ the tab bar displays tab groups. --- *** New optional key binding for 'tab-last'. -If you customize the user option 'tab-bar-select-tab-modifiers' for -selecting tabs using its index numbers, the '-9' key is -bound to 'tab-last', and switches to the last tab. Here is -any of the modifiers in the list that is the value of +If you customize the user option 'tab-bar-select-tab-modifiers' to +allow selecting tabs using their index numbers, the '-9' key +is bound to 'tab-last', and switches to the last tab. Here +is any of the modifiers in the list that is the value of 'tab-bar-select-tab-modifiers'. You can also use negative indices, which count from the last tab: -1 is the last tab, -2 the one before that, etc. @@ -700,6 +704,7 @@ the same syntax as 'auto-save-file-name-transforms'. +++ *** New user option 'remote-file-name-inhibit-locks'. When non-nil, this option suppresses lock files for remote files. +Default is nil. +++ *** New minor mode 'lock-file-mode'. @@ -944,8 +949,8 @@ having those two commands on the 'M-o' keymap; see the next section. ** The 'M-o M-s' and 'M-o M-S' global bindings have been removed. Use 'M-x center-line' and 'M-x center-paragraph' instead. See the previous section for how to get back the old bindings. Alternatively, -if you only want these two commands to have global bindings they had -before, you can add the following to your init file: +if you only want these two commands to have the global bindings they +had before, you can add the following to your init file: (define-key global-map "\M-o\M-s" 'center-line) (define-key global-map "\M-o\M-S" 'center-paragraph) @@ -1003,10 +1008,10 @@ file: ** Xref migrated from EIEIO to cl-defstruct for its core objects. This means that 'oref' and 'with-slots' no longer works on them, and 'make-instance' can no longer be used to create those instances (which -wasn't recommended anyway). Packages should keep to using the -functions like 'xref-make', 'xref-make-match', 'xref-make-*-location', -as well as accessor functions 'xref-item-summary' and -'xref-item-location'. +wasn't recommended anyway). Packages should restrict themselves to +using functions like 'xref-make', 'xref-make-match', +'xref-make-*-location', as well as accessor functions +'xref-item-summary' and 'xref-item-location'. Among the benefits are better performance (noticeable when there are a lot of matches) and improved flexibility: 'xref-match-item' instances @@ -1143,7 +1148,8 @@ less. +++ ** New user option 'revert-buffer-quick-short-answers'. This controls how the new 'revert-buffer-quick' ('C-x x g') command -prompts. +prompts. A non-nil value will make it use 'y-or-n-p' rather than +'yes-or-no-p'. Defaults to nil. +++ ** New user option 'query-about-changed-file'. @@ -1197,7 +1203,7 @@ buffer to be able to move point to the inaccessible portion. When called interactively, 'goto-char' now offers the position at point as the default. -** Autosaving via 'auto-save-visited-mode' can now be inhibited. +** Auto-saving via 'auto-save-visited-mode' can now be inhibited. Set the variable 'auto-save-visited-mode' buffer-locally to nil to achieve that. @@ -1211,7 +1217,7 @@ It used to be enabled when Emacs is started in GUI mode but not when started in text mode. The cursor still only actually blinks in GUI frames. ** 'show-paren-mode' is now enabled by default. -To go back to the previous behavior, customize the user option by the +To go back to the previous behavior, customize the user option of the same name to nil. +++ @@ -1305,8 +1311,8 @@ displaying "by name" or "by date" sort order. +++ *** New user option 'dired-compress-directory-default-suffix'. -This user option controls default suffix for compressing a directory. -If it's nil, ".tar.gz" will be used. Refer to +This user option controls the default suffix for compressing a +directory. If it's nil, ".tar.gz" will be used. Refer to 'dired-compress-files-alist' for a list of supported suffixes. +++ @@ -1327,7 +1333,7 @@ select a different backup file instead. +++ *** New user option 'dired-maybe-use-globstar'. If set, enables globstar (recursive globbing) in shells that support -this feature, but turn it off by default. This allows producing +this feature, but have it turned off by default. This allows producing directory listings with files matching a wildcard in all the subdirectories of a given directory. The new variable 'dired-enable-globstar-in-shell' lists which shells can have globstar @@ -1419,7 +1425,7 @@ major mode. +++ *** 'ispell-comments-and-strings' now accepts START and END arguments. -These arguments default to active region when used interactively. +These arguments default to the active region when used interactively. +++ *** New command 'ispell-comment-or-string-at-point'. @@ -2061,7 +2067,7 @@ consistency, the 'M-s M-r' key binding has been added for the 'gnus-summary-search-article-backward' command.) --- -*** The value of "all" in the 'large-newsgroup-initial' group parameter changes. +*** The value for "all" in the 'large-newsgroup-initial' group parameter has changed. It was previously nil, which didn't work, because nil is indistinguishable from not being present. The new value for "all" is the symbol 'all'. @@ -2358,14 +2364,6 @@ current environment. Its default value matches localized abbreviations of the "reply" prefix on the Subject line in various languages. ---- -*** New user option 'shr-offer-extend-specpdl'. -If this is nil, rendering of HTML in the email message body that -requires to enlarge 'max-specpdl-size', the number of Lisp variable -bindings, will be aborted, and Emacs will not ask you whether to -enlarge 'max-specpdl-size' to complete the rendering. The default is -t, which preserves the original behavior. - --- *** New user option 'rmail-show-message-set-modified'. If set non-nil, showing an unseen message will set the Rmail buffer's @@ -2520,10 +2518,10 @@ However, if "~/Downloads/" already exists, that will continue to be used. --- -*** The command 'eww-follow-link' now supports custom mailto handlers. +*** The command 'eww-follow-link' now supports custom mailto: handlers. The function that is invoked when clicking on or otherwise following a 'mailto:' link in an EWW buffer can now be customized. For more -information, see the related entry about 'shr-browse-url' above. +information, see the related entry about 'shr-browse-url' below. --- *** Support for bookmark.el. @@ -2540,6 +2538,14 @@ This is still the case by default, but if you customize 'browse-url-mailto-function' or 'browse-url-handlers' to call some other function, it will now be called instead of the default. +--- +*** New user option 'shr-offer-extend-specpdl'. +If this is nil, rendering of HTML that requires enlarging +'max-specpdl-size', the number of Lisp variable bindings, will be +aborted, and Emacs will not ask you whether to enlarge +'max-specpdl-size' to complete the rendering. The default is t, which +preserves the original behavior. + +++ *** New user option 'shr-max-width'. If this user option is non-nil, and 'shr-width' is nil, then SHR will @@ -2615,7 +2621,8 @@ sub-directory. +++ *** 'project-find-file' doesn't use the string at point as default input. -Now it's only suggested as part of the "future history". +Now it's only suggested as part of the "future history", accessible +via 'M-n'. +++ *** New command 'project-find-dir' runs Dired in a directory inside project. @@ -3204,7 +3211,7 @@ effect. --- *** The width of the buffer-name column in 'list-buffers' is now dynamic. -The width now depends of the width of the window, but will never be +The width now depends on the width of the window, but will never be wider than the length of the longest buffer name, except that it will never be narrower than 19 characters. @@ -3703,7 +3710,7 @@ user option has been renamed to 'find-library-source-path', and ** The 'interactive' syntax has been extended to allow listing applicable modes. Forms like '(interactive "p" dired-mode)' can be used to annotate the commands as being applicable for modes derived from 'dired-mode', -or if the mode is a minor mode, that the current buffer has that +or if the mode is a minor mode, when the current buffer has that minor mode activated. Note that using this form will create byte code that is not compatible with byte code in previous Emacs versions. @@ -3714,7 +3721,7 @@ to say whether the command should be present when completing with 'M-x TAB'. '(declare (modes MODE...))' can be used as a short-hand way of saying that the command should be present when completing from buffers in major modes derived from MODE..., or, if it's a minor mode, -whether that minor mode is enabled in the current buffer. +when that minor mode is enabled in the current buffer. +++ ** 'define-minor-mode' now takes an ':interactive' argument. @@ -4446,7 +4453,7 @@ also keep the type information of their arguments. Use the +++ *** New minor mode 'button-mode'. -This minor mode does nothing else than install 'button-buffer-map' as +This minor mode does nothing except install 'button-buffer-map' as a minor mode map (which binds the 'TAB' / 'S-TAB' key bindings to navigate to buttons), and can be used in any view-mode-like buffer that has buttons in it. @@ -4464,7 +4471,8 @@ line when displaying that buffer. This is useful for major modes that arrange their display in a tabular form below the header line. It is enabled by default in -'tabulated-list-mode' and its derived modes. +'tabulated-list-mode' and its derived modes, and disabled by default +elsewhere. --- ** 'ascii' is now a coding system alias for 'us-ascii'. commit 7fde84e881b98f6f06d659acbb739bf185f8d764 Author: Robert Pluim Date: Fri Oct 22 17:51:56 2021 +0200 Improve documentation of syntax-ppss-context slightly * doc/lispref/syntax.texi (Parser State): Document all possible return values from 'syntax-ppss-context'. diff --git a/doc/lispref/syntax.texi b/doc/lispref/syntax.texi index deec3f44c0..87ade73c2a 100644 --- a/doc/lispref/syntax.texi +++ b/doc/lispref/syntax.texi @@ -900,6 +900,7 @@ arrived at a top level position. @defun syntax-ppss-context state Return @code{string} if the end position of the scan returning @var{state} is in a string, and @code{comment} if it's in a comment. +Otherwise return @code{nil}. @end defun @node Low-Level Parsing commit 5ecbed01b2a53d10d11996003896c685f8e5f41b Author: Stephen Gildea Date: Fri Oct 22 08:45:57 2021 -0700 ; * test/lisp/mh-e/mh-utils-tests.el: Update macro declarations. diff --git a/test/lisp/mh-e/mh-utils-tests.el b/test/lisp/mh-e/mh-utils-tests.el index a10c29fcf7..ed979232a4 100644 --- a/test/lisp/mh-e/mh-utils-tests.el +++ b/test/lisp/mh-e/mh-utils-tests.el @@ -110,7 +110,7 @@ can log the choice only once, which makes the batch log easier to read.") Functions that touch the file system or run MH programs are either mocked out or pointed at a test tree. Uses `mh-test-utils-setup' to select which." - (declare (indent defun)) + (declare (indent 0) (debug t)) `(cl-letf ((temp-home-dir nil) ;; make local bindings for things we will modify for test env (mh-user-path) @@ -374,6 +374,7 @@ values for the FLAG argument of `mh-folder-completion-function'. NIL-EXPECTED is the expected value with FLAG nil. T-EXPECTED is the expected value with FLAG t. LAMBDA-EXPECTED is the expected value with FLAG lambda." + (declare (debug t)) `(with-mh-test-env (mh-test-folder-completion-2 ,nil-expected ;case "a" (mh-folder-completion-function ,name nil nil)) @@ -388,6 +389,7 @@ LAMBDA-EXPECTED is the expected value with FLAG lambda." ACTUAL should evaluate to either EXPECTED or to a list containing EXPECTED. ACTUAL may be evaluated twice, but this gives a clearer error on failure, and the `should' macro requires idempotent evaluation anyway." + (declare (debug t)) `(if (and (not (consp ,expected)) (consp ,actual)) (should (member ,expected ,actual)) (should (equal ,expected ,actual)))) commit 168665da59e657a7b1826d745d16a08930d5b7e2 Author: Robert Pluim Date: Fri Oct 22 17:42:57 2021 +0200 Move some xwidget entries * etc/NEWS: Move xwidget entries to correct location. diff --git a/etc/NEWS b/etc/NEWS index 5b6e2676c8..6a296fd880 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2970,6 +2970,18 @@ user-visible changes in ERC. (return the current title), and 'xwidget-webkit-goto-history' (goto a point in history). +--- +*** Downloading files from xwidget-webkit is now supported. +The new user option 'xwidget-webkit-download-dir' says where to download to. + +--- +*** New command 'xwidget-webkit-clone-and-split-below'. +Open a new window below displaying the current URL. + +--- +*** New command 'xwidget-webkit-clone-and-split-right'. +Open a new window to the right displaying the current URL. + --- *** Pixel-based scrolling. The 'xwidget-webkit-scroll-up', 'xwidget-webkit-scroll-down' commands @@ -4519,18 +4531,6 @@ If Emacs was built with xwidget support, you can access the embedded webkit browser with 'M-x xwidget-webkit-browse-url'. Viewing two instances of xwidget webkit is not supported. ---- -*** Downloading files from xwidget-webkit is now supported. -The new user option 'xwidget-webkit-download-dir' says where to download to. - ---- -*** New command 'xwidget-webkit-clone-and-split-below'. -Open a new window below displaying the current URL. - ---- -*** New command 'xwidget-webkit-clone-and-split-right'. -Open a new window to the right displaying the current URL. - --- *** New user option 'xwidget-webkit-enable-plugins'. If non-nil, enable plugins in xwidget. (This is only available on commit efde024361456b97277120b29d663d79ea5b287c Author: Stephen Gildea Date: Fri Oct 22 08:38:17 2021 -0700 time-stamp-tests: improvements to test macros test/lisp/time-stamp-tests.el: Update macro declarations. (formatz-generate-tests): Don't nconc onto a constant list. Tests now run 12% faster in batch mode. diff --git a/test/lisp/time-stamp-tests.el b/test/lisp/time-stamp-tests.el index 0449704b41..fa9edcbd40 100644 --- a/test/lisp/time-stamp-tests.el +++ b/test/lisp/time-stamp-tests.el @@ -26,7 +26,7 @@ (defmacro with-time-stamp-test-env (&rest body) "Evaluate BODY with some standard time-stamp test variables bound." - (declare (indent defun)) + (declare (indent 0) (debug t)) `(let ((user-login-name "test-logname") (user-full-name "100%d Tester") ;verify "%" passed unchanged (buffer-file-name "/emacs/test/time-stamped-file") @@ -46,7 +46,7 @@ (defmacro with-time-stamp-test-time (reference-time &rest body) "Force any contained time-stamp call to use time REFERENCE-TIME." - (declare (indent defun)) + (declare (indent 1) (debug t)) `(cl-letf* ((orig-time-stamp-string-fn (symbol-function 'time-stamp-string)) ((symbol-function 'time-stamp-string) @@ -56,13 +56,14 @@ (defmacro with-time-stamp-system-name (name &rest body) "Force (system-name) to return NAME while evaluating BODY." - (declare (indent defun)) + (declare (indent 1) (debug t)) `(cl-letf (((symbol-function 'system-name) (lambda () ,name))) ,@body)) (defmacro time-stamp-should-warn (form) "Similar to `should' but verifies that a format warning is generated." + (declare (debug t)) `(let ((warning-count 0)) (cl-letf (((symbol-function 'time-stamp-conv-warn) (lambda (_old _new) @@ -761,6 +762,7 @@ and is used for testing." "Formats ZONE and compares it to EXPECT. Uses the free variables `form-string' and `pattern-mod'. The functions in `pattern-mod' are composed left to right." + (declare (debug t)) `(let ((result ,expect)) (dolist (fn pattern-mod) (setq result (funcall fn result))) @@ -895,10 +897,11 @@ BIG-MOD is the result for offset +100 hours and modifiers for the other expected results for hours greater than 99 with a whole number of minutes. SECBIG-MOD is the result for offset +100 hours 30 seconds and modifiers for the other expected results for hours greater than 99 with non-zero seconds." - (declare (indent 1)) + (declare (indent 1) (debug (&rest sexp))) ;; Generate a form to create a list of tests to define. When this ;; macro is called, the form is evaluated, thus defining the tests. - (let ((ert-test-list '(list))) + ;; We will modify this list, so start with a list consed at runtime. + (let ((ert-test-list (list 'list))) (dolist (form-string form-strings ert-test-list) (nconc ert-test-list commit 06c944cff1a8a348b9c01a92891bd12576c0896d Author: Itai Y. Efrat Date: Fri Oct 22 17:07:56 2021 +0200 Fix rfc6068-parse-mailto-url autoload * lisp/net/browse-url.el (rfc6068-parse-mailto-url): Fix autoload cookie (bug#51333). diff --git a/lisp/net/browse-url.el b/lisp/net/browse-url.el index b21c66ef14..3af37e412d 100644 --- a/lisp/net/browse-url.el +++ b/lisp/net/browse-url.el @@ -1600,7 +1600,7 @@ used instead of `browse-url-new-window-flag'." ;; --- mailto --- -(autoload 'rfc6068-parse-mailto-url "rfc2368") +(autoload 'rfc6068-parse-mailto-url "rfc6068") ;;;###autoload (defun browse-url-mail (url &optional new-window) commit 9b6b5e37ef9106d9d77cf4785dc61feef531b8cf Author: Lars Ingebrigtsen Date: Fri Oct 22 16:57:04 2021 +0200 Regexp-quote github domains in bug-reference * lisp/progmodes/bug-reference.el (bug-reference--build-forge-setup-entry): Regexp-quote the domain (bug#51316). diff --git a/lisp/progmodes/bug-reference.el b/lisp/progmodes/bug-reference.el index fd435eadfe..d7b12db221 100644 --- a/lisp/progmodes/bug-reference.el +++ b/lisp/progmodes/bug-reference.el @@ -270,7 +270,8 @@ via the internet it might also be http.") ;; possibly different projects are also supported. (cl-defmethod bug-reference--build-forge-setup-entry (host-domain (_forge-type (eql github)) protocol) - `(,(concat "[/@]" host-domain "[/:]\\([.A-Za-z0-9_/-]+\\)\\.git") + `(,(concat "[/@]" (regexp-quote host-domain) + "[/:]\\([.A-Za-z0-9_/-]+\\)\\.git") "\\(\\([.A-Za-z0-9_/-]+\\)?\\(?:#\\)\\([0-9]+\\)\\)\\>" ,(lambda (groups) (let ((ns-project (nth 1 groups))) commit 1f6cdeb12c3cb8a86159cae9bfd638d8139c123e Author: Lars Ingebrigtsen Date: Fri Oct 22 16:38:11 2021 +0200 Ensure valid end/beginning lines in message-mark-inserted-region * lisp/gnus/message.el (message-mark-inserted-region): Ensure there's a newline before inserting the end line (bug#51324). diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el index d460f9bd92..bbf1c78a01 100644 --- a/lisp/gnus/message.el +++ b/lisp/gnus/message.el @@ -2395,6 +2395,8 @@ If VERBATIM, use slrn style verbatim marks (\"#v+\" and \"#v-\")." (save-excursion ;; add to the end of the region first, otherwise end would be invalid (goto-char end) + (unless (bolp) + (insert "\n")) (insert (if verbatim "#v-\n" message-mark-insert-end)) (goto-char beg) (insert (if verbatim "#v+\n" message-mark-insert-begin)))) commit f7a2ff3bf59a6cd85bc5c2d172398f89cfebe3f2 Author: Michael Albinus Date: Fri Oct 22 15:02:34 2021 +0200 Adapt some emba parameters * test/infra/Dockerfile.emba (emacs-inotify): Reduce debug options. * test/infra/gitlab-ci.yml (test-native-comp-speed0): Adapt make_params. diff --git a/test/infra/Dockerfile.emba b/test/infra/Dockerfile.emba index a031fc1685..cca0979a9e 100644 --- a/test/infra/Dockerfile.emba +++ b/test/infra/Dockerfile.emba @@ -42,8 +42,7 @@ RUN apt-get update && \ COPY . /checkout WORKDIR /checkout RUN ./autogen.sh autoconf -RUN ./configure --enable-checking='yes,glyphs' --enable-check-lisp-object-type \ - CFLAGS='-O0 -g3' +RUN ./configure CFLAGS='-O0 -g3' # 'make -j4 bootstrap' does not work reliably. RUN make bootstrap diff --git a/test/infra/gitlab-ci.yml b/test/infra/gitlab-ci.yml index d4b7ee99d8..5ff3694a0e 100644 --- a/test/infra/gitlab-ci.yml +++ b/test/infra/gitlab-ci.yml @@ -300,7 +300,8 @@ test-native-comp-speed0: extends: [.job-template, .test-template, .native-comp-template] variables: target: emacs-native-comp-speed0 - make_params: "-C test comp-tests.log" + make_params: >- + "-C test check SELECTOR='(and (not (tag :unstable)) (tag :nativecomp)))'" test-all-inotify: # This tests also file monitor libraries inotify and inotifywatch. commit 6883403719e204bd652b26323cfbab8fbb5bd871 Author: Eli Zaretskii Date: Fri Oct 22 15:42:27 2021 +0300 ; * nt/INSTALL: Fix a typo. diff --git a/nt/INSTALL b/nt/INSTALL index 5a76f5bded..c324fb4ae7 100644 --- a/nt/INSTALL +++ b/nt/INSTALL @@ -745,7 +745,7 @@ build will run on Windows 9X and newer systems). https://developers.google.com/speed/webp/ - were compiled by MSVC, and include only static libraries, no DLLs. + was compiled by MSVC, and includes only static libraries, no DLLs. So you cannot use that to build Emacs with WebP support on MS-Windows, as that needs libwebp as a DLL. commit 2bffa0189dec332f0026c144f081493e2b7fe94b Author: Eli Zaretskii Date: Fri Oct 22 15:41:00 2021 +0300 Fix WebP support on MS-Windows * src/image.c (WebPDecodeRGBA, WebPDecodeRGB, WebPFree): Use correct names and argument lists in DEF_DLL_FN; fix typos. (WebPGetFeaturesInternal): Load this instead of WebPGetFeatures, which is a static inline function in webp/decode.h. (WebPGetFeatures): Redirect to call WebPGetFeaturesInternal. * lisp/term/w32-win.el (dynamic-library-alist): Fix the name of the WebP symbol. * configure.ac (HAVE_WEBP): Fix detection of libwebp on MinGW. * nt/INSTALL.W64: * nt/INSTALL: Update information about libwebp availability. diff --git a/configure.ac b/configure.ac index d091866b87..86928c8393 100644 --- a/configure.ac +++ b/configure.ac @@ -2590,23 +2590,23 @@ if test "${HAVE_X11}" = "yes" || test "${HAVE_NS}" = "yes" || test "${opsys}" = fi ### Use -lwebp if available, unless '--with-webp=no' -### mingw32 doesn't use -lwebp, since it loads the library dynamically. HAVE_WEBP=no if test "${with_webp}" != "no"; then - if test "$opsys" = mingw32; then - AC_CHECK_HEADER([webp/decode.h], [HAVE_WEBP=yes]) - elif test "${HAVE_X11}" = "yes" || test "${HAVE_W32}" = "yes" \ - || test "${HAVE_NS}" = "yes"; then + if test "${HAVE_X11}" = "yes" || test "${opsys}" = "mingw32" \ + || test "${HAVE_W32}" = "yes" || test "${HAVE_NS}" = "yes"; then WEBP_REQUIRED=0.6.0 WEBP_MODULE="libwebp >= $WEBP_REQUIRED" EMACS_CHECK_MODULES([WEBP], [$WEBP_MODULE]) AC_SUBST(WEBP_CFLAGS) AC_SUBST(WEBP_LIBS) - - if test $HAVE_WEBP = yes; then - AC_DEFINE(HAVE_WEBP, 1, [Define to 1 if using libwebp.]) - CFLAGS="$CFLAGS $WEBP_CFLAGS" + fi + if test $HAVE_WEBP = yes; then + AC_DEFINE(HAVE_WEBP, 1, [Define to 1 if using libwebp.]) + CFLAGS="$CFLAGS $WEBP_CFLAGS" + # Windows loads libwebp dynamically + if test "${opsys}" = "mingw32"; then + WEBP_LIBS= fi fi fi diff --git a/lisp/term/w32-win.el b/lisp/term/w32-win.el index 366992cbbf..8b745c495d 100644 --- a/lisp/term/w32-win.el +++ b/lisp/term/w32-win.el @@ -274,7 +274,7 @@ See the documentation of `create-fontset-from-fontset-spec' for the format.") '(gif "libgif-6.dll" "giflib5.dll" "gif.dll") '(gif "libgif-5.dll" "giflib4.dll" "libungif4.dll" "libungif.dll"))) '(svg "librsvg-2-2.dll") - '(libwebp "libwebp-7.dll" "libwebp.dll") + '(webp "libwebp-7.dll" "libwebp.dll") '(gdk-pixbuf "libgdk_pixbuf-2.0-0.dll") '(glib "libglib-2.0-0.dll") '(gio "libgio-2.0-0.dll") diff --git a/nt/INSTALL b/nt/INSTALL index a39057c66c..5a76f5bded 100644 --- a/nt/INSTALL +++ b/nt/INSTALL @@ -737,10 +737,18 @@ build will run on Windows 9X and newer systems). without it by specifying the --without-rsvg switch to the configure script. - For WebP images you will need libwebp: + For WebP images you will need libwebp. You can find it here: + + http://sourceforge.net/projects/ezwinports/files/ + + Note: the MS-Windows binary distribution on the Google site: https://developers.google.com/speed/webp/ + were compiled by MSVC, and include only static libraries, no DLLs. + So you cannot use that to build Emacs with WebP support on + MS-Windows, as that needs libwebp as a DLL. + Binaries for the other image libraries can be found on the ezwinports site or at the GnuWin32 project (the latter are generally very old, so not recommended). Note specifically that, due to some diff --git a/nt/INSTALL.W64 b/nt/INSTALL.W64 index 8f0d0c9528..c3845d5b17 100644 --- a/nt/INSTALL.W64 +++ b/nt/INSTALL.W64 @@ -51,6 +51,7 @@ packages (you can copy and paste it into the shell with Shift + Insert): mingw-w64-x86_64-libpng \ mingw-w64-x86_64-libjpeg-turbo \ mingw-w64-x86_64-librsvg \ + mingw-w64-x86_64-libwebp \ mingw-w64-x86_64-lcms2 \ mingw-w64-x86_64-jansson \ mingw-w64-x86_64-libxml2 \ diff --git a/src/image.c b/src/image.c index fe0bb509c5..308dc68726 100644 --- a/src/image.c +++ b/src/image.c @@ -8802,10 +8802,15 @@ webp_image_p (Lisp_Object object) /* WebP library details. */ DEF_DLL_FN (int, WebPGetInfo, (const uint8_t *, size_t, int *, int *)); -DEF_DLL_FN (VP8StatusCode, WebPGetFeatures, (const uint8_t *, size_t, WebPBitstreamFeatures *)); +/* WebPGetFeatures is a static inline function defined in WebP's + decode.h. Since we cannot use that with dynamically-loaded libwebp + DLL, we instead load the internal function it calls and redirect to + that through a macro. */ +DEF_DLL_FN (VP8StatusCode, WebPGetFeaturesInternal, + (const uint8_t *, size_t, WebPBitstreamFeatures *, int)); +DEF_DLL_FN (uint8_t *, WebPDecodeRGBA, (const uint8_t *, size_t, int *, int *)); DEF_DLL_FN (uint8_t *, WebPDecodeRGB, (const uint8_t *, size_t, int *, int *)); -DEF_DLL_FN (uint8_t *, WebPDecodeBGR, (const uint8_t *, size_t, int *, int *)); -DEF_DLL_FN (void, WebPFreeDecBuffer (WebPDecBuffer *)); +DEF_DLL_FN (void, WebPFree, (void *)); static bool init_webp_functions (void) @@ -8816,7 +8821,7 @@ init_webp_functions (void) return false; LOAD_DLL_FN (library, WebPGetInfo); - LOAD_DLL_FN (library, WebPGetFeatures); + LOAD_DLL_FN (library, WebPGetFeaturesInternal); LOAD_DLL_FN (library, WebPDecodeRGBA); LOAD_DLL_FN (library, WebPDecodeRGB); LOAD_DLL_FN (library, WebPFree); @@ -8830,7 +8835,8 @@ init_webp_functions (void) #undef WebPFree #define WebPGetInfo fn_WebPGetInfo -#define WebPGetFeatures fn_WebPGetFeatures +#define WebPGetFeatures(d,s,f) \ + fn_WebPGetFeaturesInternal(d,s,f,WEBP_DECODER_ABI_VERSION) #define WebPDecodeRGBA fn_WebPDecodeRGBA #define WebPDecodeRGB fn_WebPDecodeRGB #define WebPFree fn_WebPFree commit 9b46150ab04f33514561d0589f9c37eae58bea23 Author: Robert Pluim Date: Fri Oct 22 12:16:34 2021 +0200 * etc/NEWS: Improve 'repeat-mode' entry. diff --git a/etc/NEWS b/etc/NEWS index 4caf81d168..5b6e2676c8 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -3225,16 +3225,24 @@ Type 'M-x repeat-mode RET' to enable this mode. You can then type instead of 'C-x o C-x o' to switch windows, 'C-x { { } } ^ ^ v v' to resize the selected window interactively, 'M-g n n p p' to navigate next-error matches. Any other key exits this temporarily enabled -transient mode that supports shorter keys, and then after exiting -from this mode the default key binding is used for the last typed key. -'repeat-exit-key' defines an additional key to exit mode like -'isearch-exit' ('RET'). The user option 'repeat-exit-timeout' -specifies the number of seconds of idle time to break the repetition -chain automatically. With 'repeat-keep-prefix' you can keep the -prefix arg of the previous command. For example, this can help to -reverse the window navigation direction with e.g. 'C-x o M-- o o'. -Also it can help to set a new step with e.g. 'C-x { C-5 { { {', -which will set the window resizing step to 5 columns. +transient mode that supports shorter keys, and then after exiting from +this mode the default key binding is used for the last typed key. + +The user option 'repeat-exit-key' defines an additional key usable to +exit the mode like 'isearch-exit' ('RET'). + +The user option 'repeat-exit-timeout' (default nil, which means +forever) specifies the number of seconds of idle time after which to +break the repetition chain automatically. + +When user option 'repeat-keep-prefix' is non-nil (the default), the +prefix arg of the previous command is kept. This can be used to +e.g. reverse the window navigation direction with 'C-x o M-- o o' or +to set a new step with 'C-x { C-5 { { {', which will set the window +resizing step to 5 columns. + +'M-x describe-repeat-maps' will display a buffer showing +which commands are repeatable in 'repeat-mode'. --- ** New themes 'modus-vivendi' and 'modus-operandi'. commit 9c37b812da17078f218d8f6351333108020114a3 Author: Robert Pluim Date: Fri Oct 22 12:15:06 2021 +0200 ; * lisp/repeat.el (repeat-mode): Fix docstring typo. diff --git a/lisp/repeat.el b/lisp/repeat.el index b875b749b6..ac08952eaa 100644 --- a/lisp/repeat.el +++ b/lisp/repeat.el @@ -387,7 +387,7 @@ the map can't be set on the command symbol property `repeat-map'.") "Toggle Repeat mode. When Repeat mode is enabled, and the command symbol has the property named `repeat-map', this map is activated temporarily for the next command. -See `describe-repeat-maps' for a list of all repeatable command." +See `describe-repeat-maps' for a list of all repeatable commands." :global t :group 'convenience (if (not repeat-mode) (remove-hook 'post-command-hook 'repeat-post-hook) commit caf87d80fa07234d96cb747eb4d415f8a223db43 Author: Robert Pluim Date: Thu Oct 21 16:22:48 2021 +0200 * lisp/repeat.el (repeat-keep-prefix): Expand description. diff --git a/lisp/repeat.el b/lisp/repeat.el index 42590b7e6d..b875b749b6 100644 --- a/lisp/repeat.el +++ b/lisp/repeat.el @@ -355,7 +355,7 @@ of the specified number of seconds." "Timer activated after the last key typed in the repeating key sequence.") (defcustom repeat-keep-prefix t - "Keep the prefix arg of the previous command." + "Whether to keep the prefix arg of the previous command when repeating." :type 'boolean :group 'convenience :version "28.1") commit 24083c8d1330baf9ceda16b79ee3d285b7156023 Author: Robert Pluim Date: Thu Oct 21 15:53:35 2021 +0200 * lisp/net/eww.el (eww-retrieve-command): Add :tag. diff --git a/lisp/net/eww.el b/lisp/net/eww.el index bb6583c2a9..238900db0c 100644 --- a/lisp/net/eww.el +++ b/lisp/net/eww.el @@ -145,12 +145,12 @@ The string will be passed through `substitute-command-keys'." "Command to retrieve an URL via an external program. If nil, `url-retrieve' is used to download the data. If `sync', `url-retrieve-synchronously' is used. -For other non-nil values, this should be a list where the first item -is the program, and the rest are the arguments." +For other non-nil values, this should be a list of strings where +the first item is the program, and the rest are the arguments." :version "28.1" :type '(choice (const :tag "Use `url-retrieve'" nil) (const :tag "Use `url-retrieve-synchronously'" sync) - (repeat string))) + (repeat :tag "Command/args" string ))) (defcustom eww-use-external-browser-for-content-type "\\`\\(video/\\|audio/\\|application/ogg\\)" @@ -1901,7 +1901,7 @@ Use link at point if there is one, else the current page's URL." (defun eww-set-character-encoding (charset) "Set character encoding to CHARSET. If CHARSET is nil then use UTF-8." - (interactive "zUse character set (default utf-8): " eww-mode) + (interactive "zUse character set (default `utf-8'): " eww-mode) (if (null charset) (eww-reload nil 'utf-8) (eww-reload nil charset))) commit bc2a5c112796ea9f072984b471f980e4321263b3 Author: Stefan Kangas Date: Fri Oct 22 10:59:01 2021 +0200 Add WebP image format support (Bug#51296) * configure.ac (--with-webp): New option. (HAVE_WEBP): New variable. (emacs_config_features): Add webp. * src/image.c (enum webp_keyword_index) [HAVE_WEBP]: New enum. (webp_format) [HAVE_WEBP]: New variable. (webp_image_p, init_webp_functions, webp_load) [HAVE_WEBP]: New functions for WebP support. (image_types) [HAVE_WEBP]: Define WebP format. (syms_of_image) [HAVE_WEBP]: New DEFSYM. Add image type Qwebp. * src/Makefile.in (LIBIMAGE): Add WEBP_LIBS. * lisp/files.el (auto-mode-alist): * lisp/image-file.el (image-file-name-extensions): * lisp/image.el (image-type-header-regexps) (image-type-file-name-regexps, image-type-auto-detectable): Add WebP support. * lisp/term/w32-win.el (dynamic-library-alist): Add the libwebp DLL. * INSTALL: * admin/CPP-DEFINES: * doc/lispref/display.texi (Image Formats, Other Image Types): * nt/INSTALL: Document WebP support. * test/lisp/image-tests.el (image-find-image) (image-type-from-file-name): Expand tests. * test/src/image-tests.el (image-tests--files): Add WebP. (image-tests-image-size/webp, image-tests-image-mask-p/webp) (image-tests-image-metadata/webp): New tests. * test/data/image/black.webp: New file. diff --git a/INSTALL b/INSTALL index 6207f43cec..21298422af 100644 --- a/INSTALL +++ b/INSTALL @@ -187,6 +187,7 @@ X11 is being used. X libtiff for TIFF: http://www.simplesystems.org/libtiff/ X libgif for GIF: http://giflib.sourceforge.net/ librsvg2 for SVG: https://wiki.gnome.org/Projects/LibRsvg + libwebp for WebP: https://developers.google.com/speed/webp/ If you supply the appropriate --without-LIB option, 'configure' will omit the corresponding library from Emacs, even if that makes for a @@ -313,6 +314,7 @@ or more of these options: --without-gif for GIF image support --without-png for PNG image support --without-rsvg for SVG image support + --without-webp for WebP image support Although ImageMagick support is disabled by default due to security and stability concerns, you can enable it with --with-imagemagick. diff --git a/admin/CPP-DEFINES b/admin/CPP-DEFINES index 68c12438f5..634d6f3f3b 100644 --- a/admin/CPP-DEFINES +++ b/admin/CPP-DEFINES @@ -287,6 +287,7 @@ HAVE_UTIMENSAT HAVE_UTMP_H HAVE_VFORK HAVE_VFORK_H +HAVE_WEBP HAVE_WCHAR_H HAVE_WCHAR_T HAVE_WINDOW_SYSTEM diff --git a/configure.ac b/configure.ac index 9ab0314428..d091866b87 100644 --- a/configure.ac +++ b/configure.ac @@ -447,6 +447,7 @@ OPTION_DEFAULT_ON([tiff],[don't compile with TIFF image support]) OPTION_DEFAULT_ON([gif],[don't compile with GIF image support]) OPTION_DEFAULT_ON([png],[don't compile with PNG image support]) OPTION_DEFAULT_ON([rsvg],[don't compile with SVG image support]) +OPTION_DEFAULT_ON([webp],[don't compile with WebP image support]) OPTION_DEFAULT_ON([lcms2],[don't compile with Little CMS support]) OPTION_DEFAULT_ON([libsystemd],[don't compile with libsystemd support]) OPTION_DEFAULT_ON([cairo],[don't compile with Cairo drawing]) @@ -2588,6 +2589,28 @@ if test "${HAVE_X11}" = "yes" || test "${HAVE_NS}" = "yes" || test "${opsys}" = fi fi +### Use -lwebp if available, unless '--with-webp=no' +### mingw32 doesn't use -lwebp, since it loads the library dynamically. +HAVE_WEBP=no +if test "${with_webp}" != "no"; then + if test "$opsys" = mingw32; then + AC_CHECK_HEADER([webp/decode.h], [HAVE_WEBP=yes]) + elif test "${HAVE_X11}" = "yes" || test "${HAVE_W32}" = "yes" \ + || test "${HAVE_NS}" = "yes"; then + WEBP_REQUIRED=0.6.0 + WEBP_MODULE="libwebp >= $WEBP_REQUIRED" + + EMACS_CHECK_MODULES([WEBP], [$WEBP_MODULE]) + AC_SUBST(WEBP_CFLAGS) + AC_SUBST(WEBP_LIBS) + + if test $HAVE_WEBP = yes; then + AC_DEFINE(HAVE_WEBP, 1, [Define to 1 if using libwebp.]) + CFLAGS="$CFLAGS $WEBP_CFLAGS" + fi + fi +fi + HAVE_IMAGEMAGICK=no if test "${HAVE_X11}" = "yes" || test "${HAVE_NS}" = "yes" || test "${HAVE_W32}" = "yes"; then if test "${with_imagemagick}" != "no"; then @@ -5882,8 +5905,8 @@ emacs_config_features= for opt in ACL CAIRO DBUS FREETYPE GCONF GIF GLIB GMP GNUTLS GPM GSETTINGS \ HARFBUZZ IMAGEMAGICK JPEG JSON LCMS2 LIBOTF LIBSELINUX LIBSYSTEMD LIBXML2 \ M17N_FLT MODULES NATIVE_COMP NOTIFY NS OLDXMENU PDUMPER PNG RSVG SECCOMP \ - SOUND THREADS TIFF \ - TOOLKIT_SCROLL_BARS UNEXEC X11 XAW3D XDBE XFT XIM XPM XWIDGETS X_TOOLKIT \ + SOUND THREADS TIFF TOOLKIT_SCROLL_BARS \ + UNEXEC WEBP X11 XAW3D XDBE XFT XIM XPM XWIDGETS X_TOOLKIT \ ZLIB; do case $opt in @@ -5928,6 +5951,7 @@ AS_ECHO([" Does Emacs use -lXaw3d? ${HAVE_XAW3D Does Emacs use a gif library? ${HAVE_GIF} $LIBGIF Does Emacs use a png library? ${HAVE_PNG} $LIBPNG Does Emacs use -lrsvg-2? ${HAVE_RSVG} + Does Emacs use -lwebp? ${HAVE_WEBP} Does Emacs use cairo? ${HAVE_CAIRO} Does Emacs use -llcms2? ${HAVE_LCMS2} Does Emacs use imagemagick? ${HAVE_IMAGEMAGICK} diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi index 16577d13c1..9c378a3027 100644 --- a/doc/lispref/display.texi +++ b/doc/lispref/display.texi @@ -5264,13 +5264,13 @@ to modify the set of known names for these dynamic libraries. Supported image formats (and the required support libraries) include PBM and XBM (which do not depend on support libraries and are always available), XPM (@code{libXpm}), GIF (@code{libgif} or -@code{libungif}), JPEG (@code{libjpeg}), TIFF -(@code{libtiff}), PNG (@code{libpng}), and SVG (@code{librsvg}). +@code{libungif}), JPEG (@code{libjpeg}), TIFF (@code{libtiff}), PNG +(@code{libpng}), SVG (@code{librsvg}), and WebP (@code{libwebp}). Each of these image formats is associated with an @dfn{image type symbol}. The symbols for the above formats are, respectively, -@code{pbm}, @code{xbm}, @code{xpm}, @code{gif}, -@code{jpeg}, @code{tiff}, @code{png}, and @code{svg}. +@code{pbm}, @code{xbm}, @code{xpm}, @code{gif}, @code{jpeg}, +@code{tiff}, @code{png}, @code{svg}, and @code{webp}. Furthermore, if you build Emacs with ImageMagick (@code{libMagickWand}) support, Emacs can display any image format @@ -6274,6 +6274,9 @@ Image type @code{png}. @item TIFF Image type @code{tiff}. Supports the @code{:index} property. @xref{Multi-Frame Images}. + +@item WebP +Image type @code{webp}. @end table @node Defining Images diff --git a/etc/NEWS b/etc/NEWS index c1b8adc511..36d04aa2d8 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -61,6 +61,12 @@ Emacs previously didn't distinguish between the "regular" weight and the "medium" weight, but it now also supports the (heavier) "medium" weight. ++++ +** Support for the WebP image format. +This support is built by default when the libwebp library is +available. To disable it, use the '--without-webp' configure flag. +Image specifiers can now use ':type webp'. + * Editing Changes in Emacs 29.1 diff --git a/lisp/files.el b/lisp/files.el index 99bff296f1..f0cfa2e39b 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -2758,6 +2758,7 @@ since only a single case-insensitive search through the alist is made." ("\\.gif\\'" . image-mode) ("\\.png\\'" . image-mode) ("\\.jpe?g\\'" . image-mode) + ("\\.webp\\'" . image-mode) ("\\.te?xt\\'" . text-mode) ("\\.[tT]e[xX]\\'" . tex-mode) ("\\.ins\\'" . tex-mode) ;Installation files for TeX packages. diff --git a/lisp/image-file.el b/lisp/image-file.el index fbc9eaaf94..6df43f737d 100644 --- a/lisp/image-file.el +++ b/lisp/image-file.el @@ -37,7 +37,7 @@ ;;;###autoload (defcustom image-file-name-extensions - (purecopy '("png" "jpeg" "jpg" "gif" "tiff" "tif" "xbm" "xpm" "pbm" "pgm" "ppm" "pnm" "svg")) + (purecopy '("png" "jpeg" "jpg" "gif" "tiff" "tif" "xbm" "xpm" "pbm" "pgm" "ppm" "pnm" "svg" "webp")) "A list of image-file filename extensions. Filenames having one of these extensions are considered image files, in addition to those matching `image-file-name-regexps'. diff --git a/lisp/image.el b/lisp/image.el index 2022b41d1f..5343e26d03 100644 --- a/lisp/image.el +++ b/lisp/image.el @@ -48,6 +48,7 @@ static \\(unsigned \\)?char \\1_bits" . xbm) ("\\`\\(?:MM\0\\*\\|II\\*\0\\)" . tiff) ("\\`[\t\n\r ]*%!PS" . postscript) ("\\`\xff\xd8" . jpeg) ; used to be (image-jpeg-p . jpeg) + ("\\`RIFF....WEBPVP8" . webp) (,(let* ((incomment-re "\\(?:[^-]\\|-[^-]\\)") (comment-re (concat "\\(?:!--" incomment-re "*-->[ \t\r\n]*<\\)"))) (concat "\\(?:<\\?xml[ \t\r\n]+[^>]*>\\)?[ \t\r\n]*<" @@ -67,6 +68,7 @@ a non-nil value, TYPE is the image's type.") '(("\\.png\\'" . png) ("\\.gif\\'" . gif) ("\\.jpe?g\\'" . jpeg) + ("\\.webp\\'" . webp) ("\\.bmp\\'" . bmp) ("\\.xpm\\'" . xpm) ("\\.pbm\\'" . pbm) @@ -92,6 +94,7 @@ be of image type IMAGE-TYPE.") (jpeg . maybe) (tiff . maybe) (svg . maybe) + (webp . maybe) (postscript . nil)) "Alist of (IMAGE-TYPE . AUTODETECT) pairs used to auto-detect image files. \(See `image-type-auto-detected-p'). diff --git a/lisp/term/w32-win.el b/lisp/term/w32-win.el index 5d1dc60667..366992cbbf 100644 --- a/lisp/term/w32-win.el +++ b/lisp/term/w32-win.el @@ -274,6 +274,7 @@ See the documentation of `create-fontset-from-fontset-spec' for the format.") '(gif "libgif-6.dll" "giflib5.dll" "gif.dll") '(gif "libgif-5.dll" "giflib4.dll" "libungif4.dll" "libungif.dll"))) '(svg "librsvg-2-2.dll") + '(libwebp "libwebp-7.dll" "libwebp.dll") '(gdk-pixbuf "libgdk_pixbuf-2.0-0.dll") '(glib "libglib-2.0-0.dll") '(gio "libgio-2.0-0.dll") diff --git a/nt/INSTALL b/nt/INSTALL index 9f543151a9..a39057c66c 100644 --- a/nt/INSTALL +++ b/nt/INSTALL @@ -488,6 +488,7 @@ build will run on Windows 9X and newer systems). Does Emacs use a gif library? yes Does Emacs use a png library? yes Does Emacs use -lrsvg-2? yes + Does Emacs use -lwebp? yes Does Emacs use cairo? no Does Emacs use -llcms2? yes Does Emacs use imagemagick? no @@ -597,8 +598,8 @@ build will run on Windows 9X and newer systems). * Optional image library support In addition to its "native" image formats (pbm and xbm), Emacs can - handle other image types: xpm, tiff, gif, png, jpeg and experimental - support for svg. + handle other image types: xpm, tiff, gif, png, jpeg, webp and + experimental support for svg. To build Emacs with support for them, the corresponding headers must be in the include path and libraries should be where the linker @@ -736,6 +737,10 @@ build will run on Windows 9X and newer systems). without it by specifying the --without-rsvg switch to the configure script. + For WebP images you will need libwebp: + + https://developers.google.com/speed/webp/ + Binaries for the other image libraries can be found on the ezwinports site or at the GnuWin32 project (the latter are generally very old, so not recommended). Note specifically that, due to some diff --git a/src/Makefile.in b/src/Makefile.in index 6d75e3537a..7c977e34ea 100644 --- a/src/Makefile.in +++ b/src/Makefile.in @@ -124,7 +124,7 @@ LIB_MATH=@LIB_MATH@ ## -lpthread, or empty. LIB_PTHREAD=@LIB_PTHREAD@ -LIBIMAGE=@LIBTIFF@ @LIBJPEG@ @LIBPNG@ @LIBGIF@ @LIBXPM@ +LIBIMAGE=@LIBTIFF@ @LIBJPEG@ @LIBPNG@ @LIBGIF@ @LIBXPM@ @WEBP_LIBS@ XCB_LIBS=@XCB_LIBS@ XFT_LIBS=@XFT_LIBS@ diff --git a/src/image.c b/src/image.c index ff05741b2c..fe0bb509c5 100644 --- a/src/image.c +++ b/src/image.c @@ -8739,8 +8739,280 @@ gif_load (struct frame *f, struct image *img) #endif /* HAVE_GIF */ +#ifdef HAVE_WEBP + + +/*********************************************************************** + WebP + ***********************************************************************/ + +#include "webp/decode.h" + +/* Indices of image specification fields in webp_format, below. */ + +enum webp_keyword_index +{ + WEBP_TYPE, + WEBP_DATA, + WEBP_FILE, + WEBP_ASCENT, + WEBP_MARGIN, + WEBP_RELIEF, + WEBP_ALGORITHM, + WEBP_HEURISTIC_MASK, + WEBP_MASK, + WEBP_BACKGROUND, + WEBP_LAST +}; + +/* Vector of image_keyword structures describing the format + of valid user-defined image specifications. */ + +static const struct image_keyword webp_format[WEBP_LAST] = +{ + {":type", IMAGE_SYMBOL_VALUE, 1}, + {":data", IMAGE_STRING_VALUE, 0}, + {":file", IMAGE_STRING_VALUE, 0}, + {":ascent", IMAGE_ASCENT_VALUE, 0}, + {":margin", IMAGE_NON_NEGATIVE_INTEGER_VALUE_OR_PAIR, 0}, + {":relief", IMAGE_INTEGER_VALUE, 0}, + {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE, 0}, + {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0}, + {":mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0}, + {":background", IMAGE_STRING_OR_NIL_VALUE, 0} +}; + +/* Return true if OBJECT is a valid WebP image specification. */ + +static bool +webp_image_p (Lisp_Object object) +{ + struct image_keyword fmt[WEBP_LAST]; + memcpy (fmt, webp_format, sizeof fmt); + + if (!parse_image_spec (object, fmt, WEBP_LAST, Qwebp)) + return false; + + /* Must specify either the :data or :file keyword. */ + return fmt[WEBP_FILE].count + fmt[WEBP_DATA].count == 1; +} + +#ifdef WINDOWSNT + +/* WebP library details. */ + +DEF_DLL_FN (int, WebPGetInfo, (const uint8_t *, size_t, int *, int *)); +DEF_DLL_FN (VP8StatusCode, WebPGetFeatures, (const uint8_t *, size_t, WebPBitstreamFeatures *)); +DEF_DLL_FN (uint8_t *, WebPDecodeRGB, (const uint8_t *, size_t, int *, int *)); +DEF_DLL_FN (uint8_t *, WebPDecodeBGR, (const uint8_t *, size_t, int *, int *)); +DEF_DLL_FN (void, WebPFreeDecBuffer (WebPDecBuffer *)); + +static bool +init_webp_functions (void) +{ + HMODULE library; + + if (!(library = w32_delayed_load (Qwebp))) + return false; + + LOAD_DLL_FN (library, WebPGetInfo); + LOAD_DLL_FN (library, WebPGetFeatures); + LOAD_DLL_FN (library, WebPDecodeRGBA); + LOAD_DLL_FN (library, WebPDecodeRGB); + LOAD_DLL_FN (library, WebPFree); + return true; +} + +#undef WebPGetInfo +#undef WebPGetFeatures +#undef WebPDecodeRGBA +#undef WebPDecodeRGB +#undef WebPFree + +#define WebPGetInfo fn_WebPGetInfo +#define WebPGetFeatures fn_WebPGetFeatures +#define WebPDecodeRGBA fn_WebPDecodeRGBA +#define WebPDecodeRGB fn_WebPDecodeRGB +#define WebPFree fn_WebPFree + +#endif /* WINDOWSNT */ + +/* Load WebP image IMG for use on frame F. Value is true if + successful. */ + +static bool +webp_load (struct frame *f, struct image *img) +{ + ptrdiff_t size = 0; + uint8_t *contents; + Lisp_Object file; + + /* Open the WebP file. */ + Lisp_Object specified_file = image_spec_value (img->spec, QCfile, NULL); + Lisp_Object specified_data = image_spec_value (img->spec, QCdata, NULL); + + if (NILP (specified_data)) + { + int fd; + file = image_find_image_fd (specified_file, &fd); + if (!STRINGP (file)) + { + image_error ("Cannot find image file `%s'", specified_file); + return false; + } + + contents = (uint8_t *) slurp_file (fd, &size); + if (contents == NULL) + { + image_error ("Error loading WebP image `%s'", file); + return false; + } + } + else + { + if (!STRINGP (specified_data)) + { + image_error ("Invalid image data `%s'", specified_data); + return false; + } + contents = SDATA (specified_data); + size = SBYTES (specified_data); + } + + /* Validate the WebP image header. */ + if (!WebPGetInfo (contents, size, NULL, NULL)) + { + if (!NILP (specified_data)) + image_error ("Not a WebP file: `%s'", file); + else + image_error ("Invalid header in WebP image data"); + goto webp_error1; + } + + /* Get WebP features. */ + WebPBitstreamFeatures features; + VP8StatusCode result = WebPGetFeatures (contents, size, &features); + switch (result) + { + case VP8_STATUS_OK: + break; + case VP8_STATUS_NOT_ENOUGH_DATA: + case VP8_STATUS_OUT_OF_MEMORY: + case VP8_STATUS_INVALID_PARAM: + case VP8_STATUS_BITSTREAM_ERROR: + case VP8_STATUS_UNSUPPORTED_FEATURE: + case VP8_STATUS_SUSPENDED: + case VP8_STATUS_USER_ABORT: + default: + /* Error out in all other cases. */ + if (!NILP (specified_data)) + image_error ("Error when interpreting WebP image data: `%s'", file); + else + image_error ("Error when interpreting WebP image data"); + goto webp_error1; + } + + /* Decode WebP data. */ + uint8_t *decoded; + int width, height; + if (features.has_alpha) + /* Linear [r0, g0, b0, a0, r1, g1, b1, a1, ...] order. */ + decoded = WebPDecodeRGBA (contents, size, &width, &height); + else + /* Linear [r0, g0, b0, r1, g1, b1, ...] order. */ + decoded = WebPDecodeRGB (contents, size, &width, &height); + + if (!(width <= INT_MAX && height <= INT_MAX + && check_image_size (f, width, height))) + { + image_size_error (); + goto webp_error2; + } + + /* Create the x image and pixmap. */ + Emacs_Pix_Container ximg, mask_img; + if (!image_create_x_image_and_pixmap (f, img, width, height, 0, &ximg, false)) + goto webp_error2; + + /* Create an image and pixmap serving as mask if the WebP image + contains an alpha channel. */ + if (features.has_alpha + && !image_create_x_image_and_pixmap (f, img, width, height, 1, &mask_img, true)) + { + image_destroy_x_image (ximg); + image_clear_image_1 (f, img, CLEAR_IMAGE_PIXMAP); + goto webp_error2; + } + + /* Fill the X image and mask from WebP data. */ + init_color_table (); + + uint8_t *p = decoded; + for (int y = 0; y < height; ++y) + { + for (int x = 0; x < width; ++x) + { + int r = *p++ << 8; + int g = *p++ << 8; + int b = *p++ << 8; + PUT_PIXEL (ximg, x, y, lookup_rgb_color (f, r, g, b)); + + /* An alpha channel associates variable transparency with an + image. WebP allows up to 256 levels of partial transparency. + We handle this like with PNG (which see), using the frame's + background color to combine the image with. */ + if (features.has_alpha) + { + if (mask_img) + PUT_PIXEL (mask_img, x, y, *p > 0 ? PIX_MASK_DRAW : PIX_MASK_RETAIN); + ++p; + } + } + } + +#ifdef COLOR_TABLE_SUPPORT + /* Remember colors allocated for this image. */ + img->colors = colors_in_color_table (&img->ncolors); + free_color_table (); +#endif /* COLOR_TABLE_SUPPORT */ + + /* Put ximg into the image. */ + image_put_x_image (f, img, ximg, 0); + + /* Same for the mask. */ + if (mask_img) + { + /* Fill in the background_transparent field while we have the + mask handy. Casting avoids a GCC warning. */ + image_background_transparent (img, f, (Emacs_Pix_Context)mask_img); + + image_put_x_image (f, img, mask_img, 1); + } + + img->width = width; + img->height = height; + + /* Clean up. */ + WebPFree (decoded); + if (NILP (specified_data)) + xfree (contents); + return true; + + webp_error2: + WebPFree (decoded); + + webp_error1: + if (NILP (specified_data)) + xfree (contents); + return false; +} + +#endif /* HAVE_WEBP */ + + #ifdef HAVE_IMAGEMAGICK + /*********************************************************************** ImageMagick ***********************************************************************/ @@ -10725,6 +10997,10 @@ static struct image_type const image_types[] = #if defined HAVE_XPM || defined HAVE_NS { SYMBOL_INDEX (Qxpm), xpm_image_p, xpm_load, image_clear_image, IMAGE_TYPE_INIT (init_xpm_functions) }, +#endif +#if defined HAVE_WEBP + { SYMBOL_INDEX (Qwebp), webp_image_p, webp_load, image_clear_image, + IMAGE_TYPE_INIT (init_webp_functions) }, #endif { SYMBOL_INDEX (Qxbm), xbm_image_p, xbm_load, image_clear_image }, { SYMBOL_INDEX (Qpbm), pbm_image_p, pbm_load, image_clear_image }, @@ -10891,6 +11167,11 @@ non-numeric, there is no explicit limit on the size of images. */); add_image_type (Qpng); #endif +#if defined (HAVE_WEBP) + DEFSYM (Qwebp, "webp"); + add_image_type (Qwebp); +#endif + #if defined (HAVE_IMAGEMAGICK) DEFSYM (Qimagemagick, "imagemagick"); add_image_type (Qimagemagick); diff --git a/test/data/image/black.webp b/test/data/image/black.webp new file mode 100644 index 0000000000..5dbe716415 Binary files /dev/null and b/test/data/image/black.webp differ diff --git a/test/lisp/image-tests.el b/test/lisp/image-tests.el index aa8600609c..c34c152cc9 100644 --- a/test/lisp/image-tests.el +++ b/test/lisp/image-tests.el @@ -49,12 +49,14 @@ (should (equal image '(image))))) (ert-deftest image-find-image () - (find-image '((:type xpm :file "undo.xpm"))) - (find-image '((:type png :file "newsticker/rss-feed.png" :ascent center)))) + (should (listp (find-image '((:type xpm :file "undo.xpm"))))) + (should (listp (find-image '((:type png :file "newsticker/rss-feed.png" :ascent center))))) + (should-not (find-image '((:type png :file "does-not-exist-foo-bar.png"))))) (ert-deftest image-type-from-file-name () (should (eq (image-type-from-file-name "foo.jpg") 'jpeg)) - (should (eq (image-type-from-file-name "foo.png") 'png))) + (should (eq (image-type-from-file-name "foo.png") 'png)) + (should (eq (image-type-from-file-name "foo.webp") 'webp))) (ert-deftest image-type/from-filename () ;; On emba, `image-types' and `image-load-path' do not exist. diff --git a/test/src/image-tests.el b/test/src/image-tests.el index d5e3a7cc5c..b921739a05 100644 --- a/test/src/image-tests.el +++ b/test/src/image-tests.el @@ -44,6 +44,8 @@ (tiff . ,(expand-file-name "nextstep/GNUstep/Emacs.base/Resources/emacs.tiff" source-directory)) + (webp . ,(expand-file-name "test/data/image/black.webp" + source-directory)) (xbm . ,(find-image '((:file "gnus/gnus.xbm" :type xbm)))) (xpm . ,(find-image '((:file "splash.xpm" :type xpm)))) ;; TODO: gif @@ -86,6 +88,13 @@ (should (floatp a)) (should (floatp b))))) +(ert-deftest image-tests-image-size/webp () + (image-skip-unless 'webp) + (pcase (image-size (create-image (cdr (assq 'webp image-tests--files)))) + (`(,a . ,b) + (should (floatp a)) + (should (floatp b))))) + (ert-deftest image-tests-image-size/xbm () (image-skip-unless 'xbm) (pcase (image-size (cdr (assq 'xbm image-tests--files))) @@ -130,7 +139,12 @@ (ert-deftest image-tests-image-mask-p/tiff () (image-skip-unless 'tiff) (should-not (image-mask-p (create-image - (cdr (assq 'tiff image-tests--files)))))) + (cdr (assq 'tiff image-tests--files)))))) + +(ert-deftest image-tests-image-mask-p/webp () + (image-skip-unless 'webp) + (should-not (image-mask-p (create-image + (cdr (assq 'webp image-tests--files)))))) (ert-deftest image-tests-image-mask-p/xbm () (image-skip-unless 'xbm) @@ -173,7 +187,12 @@ (ert-deftest image-tests-image-metadata/tiff () (image-skip-unless 'tiff) (should-not (image-metadata - (create-image (cdr (assq 'tiff image-tests--files)))))) + (create-image (cdr (assq 'tiff image-tests--files)))))) + +(ert-deftest image-tests-image-metadata/webp () + (image-skip-unless 'webp) + (should-not (image-metadata + (create-image (cdr (assq 'webp image-tests--files)))))) (ert-deftest image-tests-image-metadata/xbm () (image-skip-unless 'xbm) commit 938f10c601e87154b697cdb73b44e0d44851303b Author: Martin Rudalics Date: Fri Oct 22 10:34:49 2021 +0200 In 'window-text-pixel-size' use actual mode line heights if wanted (Bug#38181) * src/xdisp.c (Fwindow_text_pixel_size): Run display_mode_line when MODE_LINES wants it to take actual mode line heights into account (Bug#38181). diff --git a/src/xdisp.c b/src/xdisp.c index 8eb5b2e4bd..bbe7e2701b 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -10847,17 +10847,42 @@ include the height of any of these, if present, in the return value. */) if (y > max_y) y = max_y; - if (EQ (mode_lines, Qtab_line) || EQ (mode_lines, Qt)) - /* Re-add height of tab-line as requested. */ - y = y + WINDOW_TAB_LINE_HEIGHT (w); + if ((EQ (mode_lines, Qtab_line) || EQ (mode_lines, Qt)) + && window_wants_tab_line (w)) + /* Add height of tab-line as requested. */ + { + Lisp_Object window_tab_line_format + = window_parameter (w, Qtab_line_format); + + y = y + display_mode_line (w, TAB_LINE_FACE_ID, + NILP (window_tab_line_format) + ? BVAR (current_buffer, tab_line_format) + : window_tab_line_format); + } - if (EQ (mode_lines, Qheader_line) || EQ (mode_lines, Qt)) - /* Re-add height of header-line as requested. */ - y = y + WINDOW_HEADER_LINE_HEIGHT (w); + if ((EQ (mode_lines, Qheader_line) || EQ (mode_lines, Qt)) + && window_wants_header_line (w)) + { + Lisp_Object window_header_line_format + = window_parameter (w, Qheader_line_format); - if (EQ (mode_lines, Qmode_line) || EQ (mode_lines, Qt)) - /* Add height of mode-line as requested. */ - y = y + WINDOW_MODE_LINE_HEIGHT (w); + y = y + display_mode_line (w, HEADER_LINE_FACE_ID, + NILP (window_header_line_format) + ? BVAR (current_buffer, header_line_format) + : window_header_line_format); + } + + if ((EQ (mode_lines, Qmode_line) || EQ (mode_lines, Qt)) + && window_wants_mode_line (w)) + { + Lisp_Object window_mode_line_format + = window_parameter (w, Qmode_line_format); + + y = y + display_mode_line (w, CURRENT_MODE_LINE_FACE_ID (w), + NILP (window_mode_line_format) + ? BVAR (current_buffer, mode_line_format) + : window_mode_line_format); + } bidi_unshelve_cache (itdata, false); commit cf7d8fb1d77807ef4d77cfb0089fe371da454717 Author: Stefan Kangas Date: Fri Oct 22 10:22:08 2021 +0200 Add description of cards to etc/refcards/README * etc/refcards/README: List all the generated reference cards, including their translations. (Bug#8932) diff --git a/etc/refcards/README b/etc/refcards/README index 30c82bc714..94bf7b1f0b 100644 --- a/etc/refcards/README +++ b/etc/refcards/README @@ -23,6 +23,51 @@ PDF and PS copies of these cards are also available at . The FSF online store sometimes has printed copies for sale. +List of generated cards: + + calccard.pdf Calc Reference Card + dired-ref.pdf Dired Reference Card + gnus-booklet.pdf Gnus Reference Booklet + gnus-refcard.pdf Gnus Reference Card + orgcard.pdf Org-Mode Reference Card + refcard.pdf Emacs Reference Card + survival.pdf Emacs Survival Card + vipcard.pdf VIP Quick Reference Card + viperCard.pdf ViperCard: Viper Reference Pal + +Brazilian Portuguese + + pt-br-refcard.pdf Reference Card (pt-br) + +Czech + + cs-dired-ref.pdf Dired Reference Card (cs) + cs-refcard.pdf Emacs Reference Card (cs) + cs-survival.pdf Emacs Survival Card (cs) + +French + + fr-dired-ref.pdf Dired Reference Card (fr) + fr-refcard.pdf Emacs Reference Card (fr) + fr-survival.pdf Emacs Survival Card (fr) + +German + + de-refcard.pdf Emacs Reference Card (de) + +Polish + + pl-refcard.pdf Emacs Reference Card (pl) + +Russian + + ru-refcard.pdf Emacs Reference Card (ru) + +Slovak + + sk-dired-ref.pdf Dired Reference Card (sk) + sk-refcard.pdf Emacs Reference Card (sk) + sk-survival.pdf Emacs Survival Card (sk) COPYRIGHT AND LICENSE INFORMATION FOR IMAGE FILES commit d2849cc645f349080fd74ffbe082178bc12cd02b Author: Martin Rudalics Date: Fri Oct 22 10:16:17 2021 +0200 Fix 'calculate-lisp-indent' when "[" starts containing sexp (Bug#51312) * lisp/emacs-lisp/lisp-mode.el (calculate-lisp-indent): Handle arbitrary paren syntax after skipping whitespace backwards within containing sexp (Bug#51312). diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el index fc7a7362cd..bb00a97f8e 100644 --- a/lisp/emacs-lisp/lisp-mode.el +++ b/lisp/emacs-lisp/lisp-mode.el @@ -1075,10 +1075,11 @@ is the buffer position of the start of the containing expression." ;; Handle prefix characters and whitespace ;; following an open paren. (Bug#1012) (backward-prefix-chars) - (while (not (or (looking-back "^[ \t]*\\|([ \t]+" - (line-beginning-position)) - (and containing-sexp - (>= (1+ containing-sexp) (point))))) + (while (not (save-excursion + (skip-chars-backward " \t") + (or (= (point) (line-beginning-position)) + (and containing-sexp + (= (point) (1+ containing-sexp)))))) (forward-sexp -1) (backward-prefix-chars)) (setq calculate-lisp-indent-last-sexp (point))) commit 885448d1e66ba70faf3559e4028552fbb090aef5 Author: Stefan Kangas Date: Fri Oct 22 07:41:55 2021 +0200 ; Revert parts of previous commit * admin/unidata/unidata-gen.el (unidata-gen-table) (unidata-gen-table-symbol, unidata-gen-table-integer) (unidata-gen-table-numeric, unidata-gen-table-word-list) (unidata-describe-decomposition): * lisp/composite.el (unicode-category-table): * lisp/files.el (recover-file): * lisp/frame.el (frames-on-display-list, frame-background-mode): * lisp/language/indian.el (script-regexp-alist): Revert parts of previous commit; it seemed innocent but caused issues. diff --git a/admin/unidata/unidata-gen.el b/admin/unidata/unidata-gen.el index fc397a9a6c..abd41e34a4 100644 --- a/admin/unidata/unidata-gen.el +++ b/admin/unidata/unidata-gen.el @@ -583,17 +583,17 @@ Property value is a symbol `o' (Open), `c' (Close), or `n' (None)." (aset vec (- range start) val-code)) (setq tail (cdr tail))) (setq str "\002" val-code -1 count 0) - (mapc (lambda (x) - (if (= val-code x) - (setq count (1+ count)) - (if (> count 2) - (setq str (concat str (string val-code - (+ count 128)))) - (if (= count 2) - (setq str (concat str (string val-code val-code))) - (if (= count 1) - (setq str (concat str (string val-code)))))) - (setq val-code x count 1))) + (mapc #'(lambda (x) + (if (= val-code x) + (setq count (1+ count)) + (if (> count 2) + (setq str (concat str (string val-code + (+ count 128)))) + (if (= count 2) + (setq str (concat str (string val-code val-code))) + (if (= count 1) + (setq str (concat str (string val-code)))))) + (setq val-code x count 1))) vec) (if (= count 128) (if val @@ -613,8 +613,8 @@ Property value is a symbol `o' (Open), `c' (Close), or `n' (None)." (defun unidata-gen-table-symbol (prop index default-value val-list) (let ((table (unidata-gen-table prop index - (lambda (x) (and (> (length x) 0) - (intern x))) + #'(lambda (x) (and (> (length x) 0) + (intern x))) default-value val-list))) (set-char-table-extra-slot table 1 0) (set-char-table-extra-slot table 2 1) @@ -622,8 +622,8 @@ Property value is a symbol `o' (Open), `c' (Close), or `n' (None)." (defun unidata-gen-table-integer (prop index default-value val-list) (let ((table (unidata-gen-table prop index - (lambda (x) (and (> (length x) 0) - (string-to-number x))) + #'(lambda (x) (and (> (length x) 0) + (string-to-number x))) default-value val-list))) (set-char-table-extra-slot table 1 0) (set-char-table-extra-slot table 2 1) @@ -631,13 +631,13 @@ Property value is a symbol `o' (Open), `c' (Close), or `n' (None)." (defun unidata-gen-table-numeric (prop index default-value val-list) (let ((table (unidata-gen-table prop index - (lambda (x) - (if (string-match "/" x) - (/ (float (string-to-number x)) - (string-to-number - (substring x (match-end 0)))) - (if (> (length x) 0) - (string-to-number x)))) + #'(lambda (x) + (if (string-match "/" x) + (/ (float (string-to-number x)) + (string-to-number + (substring x (match-end 0)))) + (if (> (length x) 0) + (string-to-number x)))) default-value val-list))) (set-char-table-extra-slot table 1 0) (set-char-table-extra-slot table 2 2) @@ -1000,7 +1000,7 @@ Property value is a symbol `o' (Open), `c' (Close), or `n' (None)." (cl-incf (alist-get elt (cdr word-list) 0))))) (set-char-table-range table (cons start limit) vec)))))) (setq word-list (sort (cdr word-list) - (lambda (x y) (> (cdr x) (cdr y))))) + #'(lambda (x y) (> (cdr x) (cdr y))))) (setq tail word-list idx 0) (while tail (setcdr (car tail) (unidata-encode-word idx)) @@ -1266,11 +1266,11 @@ Property value is a symbol `o' (Open), `c' (Close), or `n' (None)." (defun unidata-describe-decomposition (val) (mapconcat - (lambda (x) - (if (symbolp x) (symbol-name x) - (concat (string ?') - (compose-string (string x) 0 1 (string ?\t x ?\t)) - (string ?')))) + #'(lambda (x) + (if (symbolp x) (symbol-name x) + (concat (string ?') + (compose-string (string x) 0 1 (string ?\t x ?\t)) + (string ?')))) val " ")) (defun unidata-describe-bidi-bracket-type (val) diff --git a/lisp/composite.el b/lisp/composite.el index b5072de5a4..c2289e8998 100644 --- a/lisp/composite.el +++ b/lisp/composite.el @@ -739,9 +739,9 @@ All non-spacing characters have this function in (let ((elt `([,(purecopy "\\c.\\c^+") 1 compose-gstring-for-graphic] [nil 0 compose-gstring-for-graphic]))) (map-char-table - (lambda (key val) - (if (memq val '(Mn Mc Me)) - (set-char-table-range composition-function-table key elt))) + #'(lambda (key val) + (if (memq val '(Mn Mc Me)) + (set-char-table-range composition-function-table key elt))) unicode-category-table)) ;; for dotted-circle (aset composition-function-table #x25CC diff --git a/lisp/files.el b/lisp/files.el index d498e5b7d2..99bff296f1 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -6682,12 +6682,12 @@ auto-save file, if that is more recent than the visited file." (abbreviate-file-name file-name))) ((with-temp-buffer-window "*Directory*" nil - (lambda (window _value) - (with-selected-window window - (unwind-protect - (yes-or-no-p (format "Recover auto save file %s? " file-name)) - (when (window-live-p window) - (quit-restore-window window 'kill))))) + #'(lambda (window _value) + (with-selected-window window + (unwind-protect + (yes-or-no-p (format "Recover auto save file %s? " file-name)) + (when (window-live-p window) + (quit-restore-window window 'kill))))) (with-current-buffer standard-output (let ((switches dired-listing-switches)) (if (file-symlink-p file) diff --git a/lisp/frame.el b/lisp/frame.el index dfbd751201..2c73737a54 100644 --- a/lisp/frame.el +++ b/lisp/frame.el @@ -987,8 +987,8 @@ HOST:SERVER.SCREEN). If DEVICE is omitted or nil, it defaults to the selected frame's terminal device." (let* ((terminal (get-device-terminal device)) - (func (lambda (frame) - (eq (frame-terminal frame) terminal)))) + (func #'(lambda (frame) + (eq (frame-terminal frame) terminal)))) (filtered-frame-list func))) (defun framep-on-display (&optional terminal) @@ -1165,9 +1165,9 @@ If you change this without using customize, you should use `frame-set-background-mode' to update existing frames; e.g. (mapc \\='frame-set-background-mode (frame-list))." :group 'faces - :set (lambda (var value) - (set-default var value) - (mapc #'frame-set-background-mode (frame-list))) + :set #'(lambda (var value) + (set-default var value) + (mapc #'frame-set-background-mode (frame-list))) :initialize #'custom-initialize-changed :type '(choice (const dark) (const light) diff --git a/lisp/language/indian.el b/lisp/language/indian.el index d373c82fee..6f9d270384 100644 --- a/lisp/language/indian.el +++ b/lisp/language/indian.el @@ -376,12 +376,12 @@ South Indian language Malayalam is supported in this language environment.")) (kannada . ,kannada-composable-pattern) (malayalam . ,malayalam-composable-pattern)))) (map-char-table - (lambda (key val) - (let ((slot (assq val script-regexp-alist))) - (if slot - (set-char-table-range - composition-function-table key - (list (vector (cdr slot) 0 #'font-shape-gstring)))))) + #'(lambda (key val) + (let ((slot (assq val script-regexp-alist))) + (if slot + (set-char-table-range + composition-function-table key + (list (vector (cdr slot) 0 #'font-shape-gstring)))))) char-script-table)) (provide 'indian) commit 2a0a368ddcd9b4eed067ddc114f3fb18b13bbe14 Author: Stefan Kangas Date: Fri Oct 22 05:28:21 2021 +0200 Fix typo in doc/emacs/anti.texi * doc/emacs/anti.texi (Antinews): Fix typo. (Bug#51325) Reported by Po Lu . diff --git a/doc/emacs/anti.texi b/doc/emacs/anti.texi index 354f20e757..3b02187b5c 100644 --- a/doc/emacs/anti.texi +++ b/doc/emacs/anti.texi @@ -35,8 +35,8 @@ As Motif becomes more and more important with moving farther into the past, we've reinstated the code which supports Motif in Emacs. @item -Emacs once again supports versions 5.3 and older OpenBSD system, which -will be needed as you move back in time. +Emacs once again supports versions 5.3 and older OpenBSD systems, +which will be needed as you move back in time. @item We've dropped support for Secure Computing filter on GNU/Linux. The commit 9529e1d2fbec706dad9d126a8678bbfc6063ba79 Author: Stephen Gildea Date: Thu Oct 21 20:10:53 2021 -0700 Update doc of Edebug specification for macros doc/lispref/edebug.texi: Update documentation of Edebug specification: - Do not document "0" as a recommended shortcut for non-instrumented arguments; nobody knows about nor uses this, so don't encourage it. - Add an example equivalent to (declare (debug (&rest sexp))). diff --git a/doc/lispref/edebug.texi b/doc/lispref/edebug.texi index 323130f237..7d67cc3af1 100644 --- a/doc/lispref/edebug.texi +++ b/doc/lispref/edebug.texi @@ -1216,9 +1216,7 @@ directs processing of arguments. @table @asis @item @code{t} All arguments are instrumented for evaluation. - -@item @code{0} -None of the arguments is instrumented. +This is short for @code{(body)}. @item a symbol The symbol must have an Edebug specification, which is used instead. @@ -1528,6 +1526,16 @@ example of the @code{let} specification. It may be easier to understand Edebug specifications by studying the examples provided here. +Consider a hypothetical macro @code{my-test-generator} that runs +tests on supplied lists of data. Although it is Edebug's default +behavior to not instrument arguments as code, as controlled by +@code{edebug-eval-macro-args} (@pxref{Instrumenting Macro Calls}), +it can be useful to explicitly document that the arguments are data: + +@example +(def-edebug-spec my-test-generator (&rest sexp)) +@end example + A @code{let} special form has a sequence of bindings and a body. Each of the bindings is either a symbol or a sublist with a symbol and optional expression. In the specification below, notice the @code{gate} commit 357d273d2e312fca7b187dca45585cbdbf4c6469 Author: Stefan Kangas Date: Thu Oct 21 23:35:07 2021 +0200 Remove redundant #' before lambda * admin/unidata/unidata-gen.el (unidata-gen-table) (unidata-gen-table-symbol, unidata-gen-table-integer) (unidata-gen-table-numeric, unidata-gen-table-word-list) (unidata-describe-decomposition): * lisp/apropos.el (apropos-user-option): * lisp/bookmark.el (bookmark-bmenu-search): * lisp/composite.el (unicode-category-table): * lisp/elec-pair.el (electric-pair--balance-info): * lisp/electric.el (electric-quote-chars): * lisp/emulation/cua-base.el (cua-rectangle-mark-key): * lisp/epa-hook.el (epa-file-encrypt-to): * lisp/faces.el (face-font-selection-order) (face-font-family-alternatives, face-font-registry-alternatives) (face-valid-attribute-values, tty-run-terminal-initialization): * lisp/files.el (recover-file, file-expand-wildcards): * lisp/frame.el (frames-on-display-list): * lisp/help-at-pt.el (help-at-pt-display-when-idle): * lisp/help-fns.el (help-fns--face-attributes): * lisp/ido.el (ido-mode, ido-unc-hosts): * lisp/isearch.el (isearch-highlight-regexp) (isearch-highlight-lines-matching-regexp): * lisp/language/indian.el (script-regexp-alist): * lisp/language/lao.el: * lisp/leim/quail/ipa.el (ipa-x-sampa-prepend-to-keymap-entry): * lisp/mh-e/mh-folder.el (mh-process-commands): * lisp/mh-e/mh-mime.el (mh-display-with-external-viewer): * lisp/ps-mule.el (ps-mule-end-job): * lisp/ps-print.el (ps-color-scale, ps-background-pages) (ps-background-text, ps-background-image, ps-background) (ps-begin-job, ps-print-translation-table): * lisp/recentf.el (recentf-sort-ascending) (recentf-sort-descending, recentf-sort-basenames-ascending) (recentf-sort-basenames-descending) (recentf-sort-directories-ascending) (recentf-sort-directories-descending): * lisp/replace.el (occur-engine-add-prefix): * lisp/select.el (xselect--encode-string): * lisp/server.el (server-use-tcp): * lisp/ses.el (ses-sort-column): * lisp/sort.el (sort-columns): * lisp/term/ns-win.el (window-system-initialization): * lisp/tree-widget.el (tree-widget-image-formats): * lisp/whitespace.el (whitespace-report-region): Remove redundant #' before lambda. diff --git a/admin/unidata/unidata-gen.el b/admin/unidata/unidata-gen.el index abd41e34a4..fc397a9a6c 100644 --- a/admin/unidata/unidata-gen.el +++ b/admin/unidata/unidata-gen.el @@ -583,17 +583,17 @@ Property value is a symbol `o' (Open), `c' (Close), or `n' (None)." (aset vec (- range start) val-code)) (setq tail (cdr tail))) (setq str "\002" val-code -1 count 0) - (mapc #'(lambda (x) - (if (= val-code x) - (setq count (1+ count)) - (if (> count 2) - (setq str (concat str (string val-code - (+ count 128)))) - (if (= count 2) - (setq str (concat str (string val-code val-code))) - (if (= count 1) - (setq str (concat str (string val-code)))))) - (setq val-code x count 1))) + (mapc (lambda (x) + (if (= val-code x) + (setq count (1+ count)) + (if (> count 2) + (setq str (concat str (string val-code + (+ count 128)))) + (if (= count 2) + (setq str (concat str (string val-code val-code))) + (if (= count 1) + (setq str (concat str (string val-code)))))) + (setq val-code x count 1))) vec) (if (= count 128) (if val @@ -613,8 +613,8 @@ Property value is a symbol `o' (Open), `c' (Close), or `n' (None)." (defun unidata-gen-table-symbol (prop index default-value val-list) (let ((table (unidata-gen-table prop index - #'(lambda (x) (and (> (length x) 0) - (intern x))) + (lambda (x) (and (> (length x) 0) + (intern x))) default-value val-list))) (set-char-table-extra-slot table 1 0) (set-char-table-extra-slot table 2 1) @@ -622,8 +622,8 @@ Property value is a symbol `o' (Open), `c' (Close), or `n' (None)." (defun unidata-gen-table-integer (prop index default-value val-list) (let ((table (unidata-gen-table prop index - #'(lambda (x) (and (> (length x) 0) - (string-to-number x))) + (lambda (x) (and (> (length x) 0) + (string-to-number x))) default-value val-list))) (set-char-table-extra-slot table 1 0) (set-char-table-extra-slot table 2 1) @@ -631,13 +631,13 @@ Property value is a symbol `o' (Open), `c' (Close), or `n' (None)." (defun unidata-gen-table-numeric (prop index default-value val-list) (let ((table (unidata-gen-table prop index - #'(lambda (x) - (if (string-match "/" x) - (/ (float (string-to-number x)) - (string-to-number - (substring x (match-end 0)))) - (if (> (length x) 0) - (string-to-number x)))) + (lambda (x) + (if (string-match "/" x) + (/ (float (string-to-number x)) + (string-to-number + (substring x (match-end 0)))) + (if (> (length x) 0) + (string-to-number x)))) default-value val-list))) (set-char-table-extra-slot table 1 0) (set-char-table-extra-slot table 2 2) @@ -1000,7 +1000,7 @@ Property value is a symbol `o' (Open), `c' (Close), or `n' (None)." (cl-incf (alist-get elt (cdr word-list) 0))))) (set-char-table-range table (cons start limit) vec)))))) (setq word-list (sort (cdr word-list) - #'(lambda (x y) (> (cdr x) (cdr y))))) + (lambda (x y) (> (cdr x) (cdr y))))) (setq tail word-list idx 0) (while tail (setcdr (car tail) (unidata-encode-word idx)) @@ -1266,11 +1266,11 @@ Property value is a symbol `o' (Open), `c' (Close), or `n' (None)." (defun unidata-describe-decomposition (val) (mapconcat - #'(lambda (x) - (if (symbolp x) (symbol-name x) - (concat (string ?') - (compose-string (string x) 0 1 (string ?\t x ?\t)) - (string ?')))) + (lambda (x) + (if (symbolp x) (symbol-name x) + (concat (string ?') + (compose-string (string x) 0 1 (string ?\t x ?\t)) + (string ?')))) val " ")) (defun unidata-describe-bidi-bracket-type (val) diff --git a/lisp/apropos.el b/lisp/apropos.el index fc15cd3e01..00919ed91b 100644 --- a/lisp/apropos.el +++ b/lisp/apropos.el @@ -515,9 +515,9 @@ variables, not just user options." current-prefix-arg)) (apropos-command pattern nil (if (or do-all apropos-do-all) - #'(lambda (symbol) - (and (boundp symbol) - (get symbol 'variable-documentation))) + (lambda (symbol) + (and (boundp symbol) + (get symbol 'variable-documentation))) #'custom-variable-p))) ;;;###autoload diff --git a/lisp/bookmark.el b/lisp/bookmark.el index 22520ebb7a..a4c28e751c 100644 --- a/lisp/bookmark.el +++ b/lisp/bookmark.el @@ -2314,10 +2314,10 @@ Prompt with completion for the new path." (lambda () (setq timer (run-with-idle-timer bookmark-search-delay 'repeat - #'(lambda (buf) - (with-current-buffer buf - (bookmark-bmenu-filter-alist-by-regexp - (minibuffer-contents)))) + (lambda (buf) + (with-current-buffer buf + (bookmark-bmenu-filter-alist-by-regexp + (minibuffer-contents)))) (current-buffer)))) (read-string "Pattern: ") (when timer (cancel-timer timer) (setq timer nil))) diff --git a/lisp/composite.el b/lisp/composite.el index 99f528a077..b5072de5a4 100644 --- a/lisp/composite.el +++ b/lisp/composite.el @@ -739,9 +739,9 @@ All non-spacing characters have this function in (let ((elt `([,(purecopy "\\c.\\c^+") 1 compose-gstring-for-graphic] [nil 0 compose-gstring-for-graphic]))) (map-char-table - #'(lambda (key val) - (if (memq val '(Mn Mc Me)) - (set-char-table-range composition-function-table key elt))) + (lambda (key val) + (if (memq val '(Mn Mc Me)) + (set-char-table-range composition-function-table key elt))) unicode-category-table)) ;; for dotted-circle (aset composition-function-table #x25CC @@ -901,6 +901,4 @@ For more information on Auto Composition mode, see (provide 'composite) - - ;;; composite.el ends here diff --git a/lisp/elec-pair.el b/lisp/elec-pair.el index ba88c81913..f907bba4c6 100644 --- a/lisp/elec-pair.el +++ b/lisp/elec-pair.el @@ -308,51 +308,51 @@ If point is not enclosed by any lists, return ((t) . (t))." ;; called when `scan-sexps' ran perfectly, when it found ;; a parenthesis pointing in the direction of travel. ;; Also when travel started inside a comment and exited it. - #'(lambda () - (setq outermost (list t)) - (unless innermost - (setq innermost (list t))))) + (lambda () + (setq outermost (list t)) + (unless innermost + (setq innermost (list t))))) (ended-prematurely-fn ;; called when `scan-sexps' crashed against a parenthesis ;; pointing opposite the direction of travel. After ;; traversing that character, the idea is to travel one sexp ;; in the opposite direction looking for a matching ;; delimiter. - #'(lambda () - (let* ((pos (point)) - (matched - (save-excursion - (cond ((< direction 0) - (condition-case nil - (eq (char-after pos) - (electric-pair--with-uncached-syntax - (table) - (matching-paren - (char-before - (scan-sexps (point) 1))))) - (scan-error nil))) - (t - ;; In this case, no need to use - ;; `scan-sexps', we can use some - ;; `electric-pair--syntax-ppss' in this - ;; case (which uses the quicker - ;; `syntax-ppss' in some cases) - (let* ((ppss (electric-pair--syntax-ppss - (1- (point)))) - (start (car (last (nth 9 ppss)))) - (opener (char-after start))) - (and start - (eq (char-before pos) - (or (with-syntax-table table - (matching-paren opener)) - opener)))))))) - (actual-pair (if (> direction 0) - (char-before (point)) - (char-after (point))))) - (unless innermost - (setq innermost (cons matched actual-pair))) - (unless matched - (setq outermost (cons matched actual-pair))))))) + (lambda () + (let* ((pos (point)) + (matched + (save-excursion + (cond ((< direction 0) + (condition-case nil + (eq (char-after pos) + (electric-pair--with-uncached-syntax + (table) + (matching-paren + (char-before + (scan-sexps (point) 1))))) + (scan-error nil))) + (t + ;; In this case, no need to use + ;; `scan-sexps', we can use some + ;; `electric-pair--syntax-ppss' in this + ;; case (which uses the quicker + ;; `syntax-ppss' in some cases) + (let* ((ppss (electric-pair--syntax-ppss + (1- (point)))) + (start (car (last (nth 9 ppss)))) + (opener (char-after start))) + (and start + (eq (char-before pos) + (or (with-syntax-table table + (matching-paren opener)) + opener)))))))) + (actual-pair (if (> direction 0) + (char-before (point)) + (char-after (point))))) + (unless innermost + (setq innermost (cons matched actual-pair))) + (unless matched + (setq outermost (cons matched actual-pair))))))) (save-excursion (while (not outermost) (condition-case err diff --git a/lisp/electric.el b/lisp/electric.el index 4394fae436..a2f24ca05c 100644 --- a/lisp/electric.el +++ b/lisp/electric.el @@ -506,11 +506,11 @@ This list's members correspond to left single quote, right single quote, left double quote, and right double quote, respectively." :version "26.1" :type '(list character character character character) - :safe #'(lambda (x) - (pcase x - (`(,(pred characterp) ,(pred characterp) - ,(pred characterp) ,(pred characterp)) - t))) + :safe (lambda (x) + (pcase x + (`(,(pred characterp) ,(pred characterp) + ,(pred characterp) ,(pred characterp)) + t))) :group 'electricity) (defcustom electric-quote-paragraph t diff --git a/lisp/emulation/cua-base.el b/lisp/emulation/cua-base.el index a98393fa2e..befcb42382 100644 --- a/lisp/emulation/cua-base.el +++ b/lisp/emulation/cua-base.el @@ -396,17 +396,17 @@ and after the region marked by the rectangle to search." (defcustom cua-rectangle-mark-key [(control return)] "Global key used to toggle the cua rectangle mark." - :set #'(lambda (symbol value) - (set symbol value) - (when (and (boundp 'cua--keymaps-initialized) - cua--keymaps-initialized) - (define-key cua-global-keymap value - #'cua-set-rectangle-mark) - (when (boundp 'cua--rectangle-keymap) - (define-key cua--rectangle-keymap value - #'cua-clear-rectangle-mark) - (define-key cua--region-keymap value - #'cua-toggle-rectangle-mark)))) + :set (lambda (symbol value) + (set symbol value) + (when (and (boundp 'cua--keymaps-initialized) + cua--keymaps-initialized) + (define-key cua-global-keymap value + #'cua-set-rectangle-mark) + (when (boundp 'cua--rectangle-keymap) + (define-key cua--rectangle-keymap value + #'cua-clear-rectangle-mark) + (define-key cua--region-keymap value + #'cua-toggle-rectangle-mark)))) :type 'key-sequence) (defcustom cua-rectangle-modifier-key 'meta diff --git a/lisp/epa-hook.el b/lisp/epa-hook.el index aa196851d4..5b250af6d7 100644 --- a/lisp/epa-hook.el +++ b/lisp/epa-hook.el @@ -56,15 +56,15 @@ through Custom does that automatically." May either be a string or a list of strings.") (put 'epa-file-encrypt-to 'safe-local-variable - #'(lambda (val) - (or (stringp val) - (and (listp val) - (catch 'safe - (mapc (lambda (elt) - (unless (stringp elt) - (throw 'safe nil))) - val) - t))))) + (lambda (val) + (or (stringp val) + (and (listp val) + (catch 'safe + (mapc (lambda (elt) + (unless (stringp elt) + (throw 'safe nil))) + val) + t))))) (put 'epa-file-encrypt-to 'permanent-local t) diff --git a/lisp/faces.el b/lisp/faces.el index 58c57143d4..83c6b69532 100644 --- a/lisp/faces.el +++ b/lisp/faces.el @@ -88,9 +88,9 @@ a font height that isn't optimal." :tag "Font selection order" :type '(list symbol symbol symbol symbol) :group 'font-selection - :set #'(lambda (symbol value) - (set-default symbol value) - (internal-set-font-selection-order value))) + :set (lambda (symbol value) + (set-default symbol value) + (internal-set-font-selection-order value))) ;; In the absence of Fontconfig support, Monospace and Sans Serif are @@ -140,9 +140,9 @@ ALTERNATIVE2 etc." :tag "Alternative font families to try" :type '(repeat (repeat string)) :group 'font-selection - :set #'(lambda (symbol value) - (set-default symbol value) - (internal-set-alternative-font-family-alist value))) + :set (lambda (symbol value) + (set-default symbol value) + (internal-set-alternative-font-family-alist value))) ;; This is defined originally in xfaces.c. @@ -167,9 +167,9 @@ REGISTRY, ALTERNATIVE1, ALTERNATIVE2, and etc." :type '(repeat (repeat string)) :version "21.1" :group 'font-selection - :set #'(lambda (symbol value) - (set-default symbol value) - (internal-set-alternative-font-registry-alist value))) + :set (lambda (symbol value) + (set-default symbol value) + (internal-set-alternative-font-registry-alist value))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -1147,27 +1147,27 @@ an integer value." (:foundry (list nil)) (:width - (mapcar #'(lambda (x) (cons (symbol-name (aref x 1)) (aref x 1))) + (mapcar (lambda (x) (cons (symbol-name (aref x 1)) (aref x 1))) font-width-table)) (:weight - (mapcar #'(lambda (x) (cons (symbol-name (aref x 1)) (aref x 1))) + (mapcar (lambda (x) (cons (symbol-name (aref x 1)) (aref x 1))) font-weight-table)) (:slant - (mapcar #'(lambda (x) (cons (symbol-name (aref x 1)) (aref x 1))) + (mapcar (lambda (x) (cons (symbol-name (aref x 1)) (aref x 1))) font-slant-table)) ((or :inverse-video :extend) - (mapcar #'(lambda (x) (cons (symbol-name x) x)) + (mapcar (lambda (x) (cons (symbol-name x) x)) (internal-lisp-face-attribute-values attribute))) ((or :underline :overline :strike-through :box) (if (window-system frame) - (nconc (mapcar #'(lambda (x) (cons (symbol-name x) x)) + (nconc (mapcar (lambda (x) (cons (symbol-name x) x)) (internal-lisp-face-attribute-values attribute)) - (mapcar #'(lambda (c) (cons c c)) + (mapcar (lambda (c) (cons c c)) (defined-colors frame))) - (mapcar #'(lambda (x) (cons (symbol-name x) x)) + (mapcar (lambda (x) (cons (symbol-name x) x)) (internal-lisp-face-attribute-values attribute)))) ((or :foreground :background) - (mapcar #'(lambda (c) (cons c c)) + (mapcar (lambda (c) (cons c c)) (defined-colors frame))) (:height 'integerp) @@ -1182,7 +1182,7 @@ an integer value." x-bitmap-file-path))))) (:inherit (cons '("none" . nil) - (mapcar #'(lambda (c) (cons (symbol-name c) c)) + (mapcar (lambda (c) (cons (symbol-name c) c)) (face-list)))) (_ (error "Internal error"))))) @@ -2286,19 +2286,19 @@ If you set `term-file-prefix' to nil, this function does nothing." (let* (term-init-func) ;; First, load the terminal initialization file, if it is ;; available and it hasn't been loaded already. - (tty-find-type #'(lambda (type) - (let ((file (locate-library (concat term-file-prefix type)))) - (and file - (or (assoc file load-history) - (load (replace-regexp-in-string - "\\.el\\(\\.gz\\)?\\'" "" - file) - t t))))) - type) + (tty-find-type (lambda (type) + (let ((file (locate-library (concat term-file-prefix type)))) + (and file + (or (assoc file load-history) + (load (replace-regexp-in-string + "\\.el\\(\\.gz\\)?\\'" "" + file) + t t))))) + type) ;; Next, try to find a matching initialization function, and call it. - (tty-find-type #'(lambda (type) - (fboundp (setq term-init-func - (intern (concat "terminal-init-" type))))) + (tty-find-type (lambda (type) + (fboundp (setq term-init-func + (intern (concat "terminal-init-" type))))) type) (when (fboundp term-init-func) (funcall term-init-func)) diff --git a/lisp/files.el b/lisp/files.el index 5a6a33721b..d498e5b7d2 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -6682,12 +6682,12 @@ auto-save file, if that is more recent than the visited file." (abbreviate-file-name file-name))) ((with-temp-buffer-window "*Directory*" nil - #'(lambda (window _value) - (with-selected-window window - (unwind-protect - (yes-or-no-p (format "Recover auto save file %s? " file-name)) - (when (window-live-p window) - (quit-restore-window window 'kill))))) + (lambda (window _value) + (with-selected-window window + (unwind-protect + (yes-or-no-p (format "Recover auto save file %s? " file-name)) + (when (window-live-p window) + (quit-restore-window window 'kill))))) (with-current-buffer standard-output (let ((switches dired-listing-switches)) (if (file-symlink-p file) @@ -7130,16 +7130,16 @@ default directory. However, if FULL is non-nil, they are absolute." (let ((this-dir-contents ;; Filter out "." and ".." (delq nil - (mapcar #'(lambda (name) - (unless (string-match "\\`\\.\\.?\\'" - (file-name-nondirectory name)) - name)) + (mapcar (lambda (name) + (unless (string-match "\\`\\.\\.?\\'" + (file-name-nondirectory name)) + name)) (directory-files (or dir ".") full (wildcard-to-regexp nondir)))))) (setq contents (nconc (if (and dir (not full)) - (mapcar #'(lambda (name) (concat dir name)) + (mapcar (lambda (name) (concat dir name)) this-dir-contents) this-dir-contents) contents))))) diff --git a/lisp/frame.el b/lisp/frame.el index 2c73737a54..dfbd751201 100644 --- a/lisp/frame.el +++ b/lisp/frame.el @@ -987,8 +987,8 @@ HOST:SERVER.SCREEN). If DEVICE is omitted or nil, it defaults to the selected frame's terminal device." (let* ((terminal (get-device-terminal device)) - (func #'(lambda (frame) - (eq (frame-terminal frame) terminal)))) + (func (lambda (frame) + (eq (frame-terminal frame) terminal)))) (filtered-frame-list func))) (defun framep-on-display (&optional terminal) @@ -1165,9 +1165,9 @@ If you change this without using customize, you should use `frame-set-background-mode' to update existing frames; e.g. (mapc \\='frame-set-background-mode (frame-list))." :group 'faces - :set #'(lambda (var value) - (set-default var value) - (mapc #'frame-set-background-mode (frame-list))) + :set (lambda (var value) + (set-default var value) + (mapc #'frame-set-background-mode (frame-list))) :initialize #'custom-initialize-changed :type '(choice (const dark) (const light) diff --git a/lisp/help-at-pt.el b/lisp/help-at-pt.el index 233c50504b..8eb397bc82 100644 --- a/lisp/help-at-pt.el +++ b/lisp/help-at-pt.el @@ -229,11 +229,11 @@ this option, or use \"In certain situations\" and specify no text properties, to enable buffer local values." never)) :initialize 'custom-initialize-default - :set #'(lambda (variable value) - (set-default variable value) - (if (eq value 'never) - (help-at-pt-cancel-timer) - (help-at-pt-set-timer))) + :set (lambda (variable value) + (set-default variable value) + (if (eq value 'never) + (help-at-pt-cancel-timer) + (help-at-pt-set-timer))) :set-after '(help-at-pt-timer-delay) :require 'help-at-pt) diff --git a/lisp/help-fns.el b/lisp/help-fns.el index 2b759a5a5c..17fabe4f63 100644 --- a/lisp/help-fns.el +++ b/lisp/help-fns.el @@ -1561,7 +1561,7 @@ If FRAME is omitted or nil, use the selected frame." (:fontset . "Fontset") (:extend . "Extend") (:inherit . "Inherit"))) - (max-width (apply #'max (mapcar #'(lambda (x) (length (cdr x))) + (max-width (apply #'max (mapcar (lambda (x) (length (cdr x))) attrs)))) (dolist (a attrs) (let ((attr (face-attribute face (car a) frame))) diff --git a/lisp/ido.el b/lisp/ido.el index 7c2d2eb0d7..6767d66988 100644 --- a/lisp/ido.el +++ b/lisp/ido.el @@ -354,8 +354,8 @@ The following values are possible: Setting this variable directly does not take effect; use either \\[customize] or the function `ido-mode'." - :set #'(lambda (_symbol value) - (ido-mode (or value 0))) + :set (lambda (_symbol value) + (ido-mode (or value 0))) :initialize #'custom-initialize-default :require 'ido :link '(emacs-commentary-link "ido.el") @@ -620,9 +620,9 @@ hosts on first use of UNC path." (function-item :tag "Use `NET VIEW'" :value ido-unc-hosts-net-view) (function :tag "Your own function")) - :set #'(lambda (symbol value) - (set symbol value) - (setq ido-unc-hosts-cache t))) + :set (lambda (symbol value) + (set symbol value) + (setq ido-unc-hosts-cache t))) (defcustom ido-downcase-unc-hosts t "Non-nil if UNC host names should be downcased." diff --git a/lisp/isearch.el b/lisp/isearch.el index d9a48cfcf2..52e4a39ba5 100644 --- a/lisp/isearch.el +++ b/lisp/isearch.el @@ -2478,8 +2478,8 @@ The arguments passed to `highlight-regexp' are the regexp from the last search and the face from `hi-lock-read-face-name'." (interactive) (isearch--highlight-regexp-or-lines - #'(lambda (regexp face lighter) - (highlight-regexp regexp face nil lighter)))) + (lambda (regexp face lighter) + (highlight-regexp regexp face nil lighter)))) (defun isearch-highlight-lines-matching-regexp () "Exit Isearch mode and call `highlight-lines-matching-regexp'. @@ -2487,8 +2487,8 @@ The arguments passed to `highlight-lines-matching-regexp' are the regexp from the last search and the face from `hi-lock-read-face-name'." (interactive) (isearch--highlight-regexp-or-lines - #'(lambda (regexp face _lighter) - (highlight-lines-matching-regexp regexp face)))) + (lambda (regexp face _lighter) + (highlight-lines-matching-regexp regexp face)))) (defun isearch-delete-char () diff --git a/lisp/language/indian.el b/lisp/language/indian.el index 6f9d270384..d373c82fee 100644 --- a/lisp/language/indian.el +++ b/lisp/language/indian.el @@ -376,12 +376,12 @@ South Indian language Malayalam is supported in this language environment.")) (kannada . ,kannada-composable-pattern) (malayalam . ,malayalam-composable-pattern)))) (map-char-table - #'(lambda (key val) - (let ((slot (assq val script-regexp-alist))) - (if slot - (set-char-table-range - composition-function-table key - (list (vector (cdr slot) 0 #'font-shape-gstring)))))) + (lambda (key val) + (let ((slot (assq val script-regexp-alist))) + (if slot + (set-char-table-range + composition-function-table key + (list (vector (cdr slot) 0 #'font-shape-gstring)))))) char-script-table)) (provide 'indian) diff --git a/lisp/language/lao.el b/lisp/language/lao.el index c699d57c15..93849461ea 100644 --- a/lisp/language/lao.el +++ b/lisp/language/lao.el @@ -59,11 +59,11 @@ (let* ((chars (car l)) (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) - (t (string c)))) + (regexp (mapconcat (lambda (c) + (cond ((= c ?c) consonant) + ((= c ?t) tone) + ((= c ?v) vowel-upper-lower) + (t (string c)))) (cdr l) "")) ;; Element of composition-function-table. (elt (list (vector regexp 1 #'lao-composition-function) diff --git a/lisp/leim/quail/ipa.el b/lisp/leim/quail/ipa.el index c25687574e..ba6ea93842 100644 --- a/lisp/leim/quail/ipa.el +++ b/lisp/leim/quail/ipa.el @@ -278,10 +278,10 @@ string." (list (apply #'vector (mapcar - #'(lambda (entry) - (cl-assert (char-or-string-p entry) t) - (format "%s%s" to-prepend - (if (integerp entry) (string entry) entry))) + (lambda (entry) + (cl-assert (char-or-string-p entry) t) + (format "%s%s" to-prepend + (if (integerp entry) (string entry) entry))) quail-keymap)))) (defun ipa-x-sampa-underscore-implosive (input-string length) diff --git a/lisp/mh-e/mh-folder.el b/lisp/mh-e/mh-folder.el index e6c295764b..c700b3348d 100644 --- a/lisp/mh-e/mh-folder.el +++ b/lisp/mh-e/mh-folder.el @@ -1543,34 +1543,34 @@ after the commands are processed." (append folders-changed (mh-index-execute-commands)))) ;; Then refile messages - (mapc #'(lambda (folder-msg-list) - (let* ((dest-folder (symbol-name (car folder-msg-list))) - (last (car (mh-translate-range dest-folder "last"))) - (msgs (cdr folder-msg-list))) - (push dest-folder folders-changed) - (setq redraw-needed-flag t) - (apply #'mh-exec-cmd - "refile" "-src" folder dest-folder - (mh-coalesce-msg-list msgs)) - (mh-delete-scan-msgs msgs) - ;; Preserve sequences in destination folder... - (when mh-refile-preserves-sequences-flag - (clrhash dest-map) - (cl-loop - for i from (1+ (or last 0)) - for msg in (sort (copy-sequence msgs) #'<) - do (cl-loop for seq-name in (gethash msg seq-map) - do (push i (gethash seq-name dest-map)))) - (maphash - #'(lambda (seq msgs) - ;; Can't be run in the background, since the - ;; current folder is changed by mark this could - ;; lead to a race condition with the next refile. - (apply #'mh-exec-cmd "mark" - "-sequence" (symbol-name seq) dest-folder - "-add" (mapcar #'(lambda (x) (format "%s" x)) - (mh-coalesce-msg-list msgs)))) - dest-map)))) + (mapc (lambda (folder-msg-list) + (let* ((dest-folder (symbol-name (car folder-msg-list))) + (last (car (mh-translate-range dest-folder "last"))) + (msgs (cdr folder-msg-list))) + (push dest-folder folders-changed) + (setq redraw-needed-flag t) + (apply #'mh-exec-cmd + "refile" "-src" folder dest-folder + (mh-coalesce-msg-list msgs)) + (mh-delete-scan-msgs msgs) + ;; Preserve sequences in destination folder... + (when mh-refile-preserves-sequences-flag + (clrhash dest-map) + (cl-loop + for i from (1+ (or last 0)) + for msg in (sort (copy-sequence msgs) #'<) + do (cl-loop for seq-name in (gethash msg seq-map) + do (push i (gethash seq-name dest-map)))) + (maphash + #'(lambda (seq msgs) + ;; Can't be run in the background, since the + ;; current folder is changed by mark this could + ;; lead to a race condition with the next refile. + (apply #'mh-exec-cmd "mark" + "-sequence" (symbol-name seq) dest-folder + "-add" (mapcar #'(lambda (x) (format "%s" x)) + (mh-coalesce-msg-list msgs)))) + dest-map)))) mh-refile-list) (setq mh-refile-list ()) @@ -1614,14 +1614,14 @@ after the commands are processed." do (cl-loop for seq-name in (gethash msg seq-map) do (push i (gethash seq-name allow-map)))) (maphash - #'(lambda (seq msgs) - ;; Can't be run in background, since the current - ;; folder is changed by mark this could lead to a - ;; race condition with the next refile/allowlist. - (apply #'mh-exec-cmd "mark" - "-sequence" (symbol-name seq) mh-inbox - "-add" (mapcar #'(lambda(x) (format "%s" x)) - (mh-coalesce-msg-list msgs)))) + (lambda (seq msgs) + ;; Can't be run in background, since the current + ;; folder is changed by mark this could lead to a + ;; race condition with the next refile/allowlist. + (apply #'mh-exec-cmd "mark" + "-sequence" (symbol-name seq) mh-inbox + "-add" (mapcar #'(lambda(x) (format "%s" x)) + (mh-coalesce-msg-list msgs)))) allow-map)) (setq mh-allowlist nil))) diff --git a/lisp/mh-e/mh-mime.el b/lisp/mh-e/mh-mime.el index 3d9128c15a..0b58d7ba1f 100644 --- a/lisp/mh-e/mh-mime.el +++ b/lisp/mh-e/mh-mime.el @@ -238,24 +238,24 @@ usually reads the file \"/etc/mailcap\"." (when (consp part-index) (setq part-index (car part-index))) (mh-folder-mime-action part-index - #'(lambda () - (let* ((part (get-text-property (point) 'mh-data)) - (type (mm-handle-media-type part)) - (methods (mapcar (lambda (x) (list (cdr (assoc 'viewer x)))) - (mailcap-mime-info type 'all))) - (def (caar methods)) - (prompt (format-prompt "Viewer" def)) - (method (completing-read prompt methods nil nil nil nil def)) - (folder mh-show-folder-buffer) - (buffer-read-only nil)) - (when (string-match "^[^% \t]+$" method) - (setq method (concat method " %s"))) - (mh-flet - ((mm-handle-set-external-undisplayer - (handle function) - (mh-handle-set-external-undisplayer folder handle function))) - (unwind-protect (mm-display-external part method) - (set-buffer-modified-p nil))))) + (lambda () + (let* ((part (get-text-property (point) 'mh-data)) + (type (mm-handle-media-type part)) + (methods (mapcar (lambda (x) (list (cdr (assoc 'viewer x)))) + (mailcap-mime-info type 'all))) + (def (caar methods)) + (prompt (format-prompt "Viewer" def)) + (method (completing-read prompt methods nil nil nil nil def)) + (folder mh-show-folder-buffer) + (buffer-read-only nil)) + (when (string-match "^[^% \t]+$" method) + (setq method (concat method " %s"))) + (mh-flet + ((mm-handle-set-external-undisplayer + (handle function) + (mh-handle-set-external-undisplayer folder handle function))) + (unwind-protect (mm-display-external part method) + (set-buffer-modified-p nil))))) nil)) ;;;###mh-autoload diff --git a/lisp/ps-mule.el b/lisp/ps-mule.el index ab8af40628..2d1dcd2b68 100644 --- a/lisp/ps-mule.el +++ b/lisp/ps-mule.el @@ -1209,8 +1209,8 @@ V%s 0 /%s-latin1 /%s Latin1Encoding put\n" (ps-output-prologue (format "ETOP%d %d %d put\n" i (car font) index)) (setq index (1+ index)))) (ps-output-prologue (format "/VTOP%d [%s] def\n" i - (mapconcat #'(lambda (x) - (format "F%02X" (cdr x))) + (mapconcat (lambda (x) + (format "F%02X" (cdr x))) font-list " "))))) ;; Redefine fonts f0, f1, f2, f3, h0, h1, H0. diff --git a/lisp/ps-print.el b/lisp/ps-print.el index b1d03fda1d..0fc9554679 100644 --- a/lisp/ps-print.el +++ b/lisp/ps-print.el @@ -3855,7 +3855,7 @@ It can be retrieved with `(ps-get ALIST-SYM KEY)'." (defun ps-color-scale (color) ;; Scale 16-bit X-COLOR-VALUE to PostScript color value in [0, 1] interval. - (mapcar #'(lambda (value) (/ value ps-print-color-scale)) + (mapcar (lambda (value) (/ value ps-print-color-scale)) (color-values color))) @@ -4747,11 +4747,11 @@ page-height == ((floor print-height ((th + ls) * zh)) * ((th + ls) * zh)) - th (defun ps-background-pages (page-list func) (if page-list (mapcar - #'(lambda (pages) - (let ((start (if (consp pages) (car pages) pages)) - (end (if (consp pages) (cdr pages) pages))) - (and (integerp start) (integerp end) (<= start end) - (add-to-list 'ps-background-pages (vector start end func))))) + (lambda (pages) + (let ((start (if (consp pages) (car pages) pages)) + (end (if (consp pages) (cdr pages) pages))) + (and (integerp start) (integerp end) (<= start end) + (add-to-list 'ps-background-pages (vector start end func))))) page-list) (setq ps-background-all-pages (cons func ps-background-all-pages)))) @@ -4789,76 +4789,76 @@ page-height == ((floor print-height ((th + ls) * zh)) * ((th + ls) * zh)) - th (defun ps-background-text () (mapcar - #'(lambda (text) - (setq ps-background-text-count (1+ ps-background-text-count)) - (ps-output (format "/ShowBackText-%d{\n" ps-background-text-count)) - (ps-output-string (nth 0 text)) ; text - (ps-output - "\n" - (ps-float-format (nth 4 text) 200.0) ; font size - (format "/%s " (or (nth 3 text) "Times-Roman")) ; font name - (ps-float-format (nth 6 text) - "PrintHeight PrintPageWidth atan") ; rotation - (ps-float-format (nth 5 text) 0.85) ; gray - (ps-float-format (nth 1 text) "0") ; x position - (ps-float-format (nth 2 text) "0") ; y position - "\nShowBackText}def\n") - (ps-background-pages (nthcdr 7 text) ; page list - (format "ShowBackText-%d\n" - ps-background-text-count))) + (lambda (text) + (setq ps-background-text-count (1+ ps-background-text-count)) + (ps-output (format "/ShowBackText-%d{\n" ps-background-text-count)) + (ps-output-string (nth 0 text)) ; text + (ps-output + "\n" + (ps-float-format (nth 4 text) 200.0) ; font size + (format "/%s " (or (nth 3 text) "Times-Roman")) ; font name + (ps-float-format (nth 6 text) + "PrintHeight PrintPageWidth atan") ; rotation + (ps-float-format (nth 5 text) 0.85) ; gray + (ps-float-format (nth 1 text) "0") ; x position + (ps-float-format (nth 2 text) "0") ; y position + "\nShowBackText}def\n") + (ps-background-pages (nthcdr 7 text) ; page list + (format "ShowBackText-%d\n" + ps-background-text-count))) ps-print-background-text)) (defun ps-background-image () (mapcar - #'(lambda (image) - (let ((image-file (expand-file-name (nth 0 image)))) - (when (file-readable-p image-file) - (setq ps-background-image-count (1+ ps-background-image-count)) - (ps-output - (format "/ShowBackImage-%d{\n--back-- " - ps-background-image-count) - (ps-float-format (nth 5 image) 0.0) ; rotation - (ps-float-format (nth 3 image) 1.0) ; x scale - (ps-float-format (nth 4 image) 1.0) ; y scale - (ps-float-format (nth 1 image) ; x position - "PrintPageWidth 2 div") - (ps-float-format (nth 2 image) ; y position - "PrintHeight 2 div BottomMargin add") - "\nBeginBackImage\n") - (ps-insert-file image-file) - ;; coordinate adjustment to center image - ;; around x and y position - (let ((box (ps-get-boundingbox))) - (with-current-buffer ps-spool-buffer - (save-excursion - (if (re-search-backward "^--back--" nil t) - (replace-match - (format "%s %s" - (ps-float-format - (- (+ (/ (- (aref box 2) (aref box 0)) 2.0) - (aref box 0)))) - (ps-float-format - (- (+ (/ (- (aref box 3) (aref box 1)) 2.0) - (aref box 1))))) - t))))) - (ps-output "\nEndBackImage}def\n") - (ps-background-pages (nthcdr 6 image) ; page list - (format "ShowBackImage-%d\n" - ps-background-image-count))))) + (lambda (image) + (let ((image-file (expand-file-name (nth 0 image)))) + (when (file-readable-p image-file) + (setq ps-background-image-count (1+ ps-background-image-count)) + (ps-output + (format "/ShowBackImage-%d{\n--back-- " + ps-background-image-count) + (ps-float-format (nth 5 image) 0.0) ; rotation + (ps-float-format (nth 3 image) 1.0) ; x scale + (ps-float-format (nth 4 image) 1.0) ; y scale + (ps-float-format (nth 1 image) ; x position + "PrintPageWidth 2 div") + (ps-float-format (nth 2 image) ; y position + "PrintHeight 2 div BottomMargin add") + "\nBeginBackImage\n") + (ps-insert-file image-file) + ;; coordinate adjustment to center image + ;; around x and y position + (let ((box (ps-get-boundingbox))) + (with-current-buffer ps-spool-buffer + (save-excursion + (if (re-search-backward "^--back--" nil t) + (replace-match + (format "%s %s" + (ps-float-format + (- (+ (/ (- (aref box 2) (aref box 0)) 2.0) + (aref box 0)))) + (ps-float-format + (- (+ (/ (- (aref box 3) (aref box 1)) 2.0) + (aref box 1))))) + t))))) + (ps-output "\nEndBackImage}def\n") + (ps-background-pages (nthcdr 6 image) ; page list + (format "ShowBackImage-%d\n" + ps-background-image-count))))) ps-print-background-image)) (defun ps-background (page-number) (let (has-local-background) - (mapc #'(lambda (range) - (and (<= (aref range 0) page-number) - (<= page-number (aref range 1)) - (if has-local-background - (ps-output (aref range 2)) - (setq has-local-background t) - (ps-output "/printLocalBackground{\n" - (aref range 2))))) + (mapc (lambda (range) + (and (<= (aref range 0) page-number) + (<= page-number (aref range 1)) + (if has-local-background + (ps-output (aref range 2)) + (setq has-local-background t) + (ps-output "/printLocalBackground{\n" + (aref range 2))))) ps-background-pages) (and has-local-background (ps-output "}def\n")))) @@ -5697,8 +5697,8 @@ XSTART YSTART are the relative position for the first page in a sheet.") (> (car page) 0) (<= (car page) (cdr page)) (setq new (cons page new)))))) - (setq ps-selected-pages (sort new #'(lambda (one other) - (< (car one) (car other)))) + (setq ps-selected-pages (sort new (lambda (one other) + (< (car one) (car other)))) ps-last-selected-pages ps-selected-pages ps-first-page nil ps-last-page nil)) @@ -5782,8 +5782,8 @@ XSTART YSTART are the relative position for the first page in a sheet.") "unspecified-fg" 0.0) ps-foreground-list (mapcar - #'(lambda (arg) - (ps-rgb-color arg "unspecified-fg" 0.0)) + (lambda (arg) + (ps-rgb-color arg "unspecified-fg" 0.0)) (append (and (not (member ps-print-color-p '(nil black-white))) ps-fg-list) @@ -6012,9 +6012,9 @@ XSTART YSTART are the relative position for the first page in a sheet.") (if (and (boundp 'ucs-mule-8859-to-mule-unicode) (char-table-p ucs-mule-8859-to-mule-unicode)) (map-char-table - #'(lambda (k v) - (if (and v (eq (char-charset v) 'latin-iso8859-1) (/= k v)) - (aset tbl k v))) + (lambda (k v) + (if (and v (eq (char-charset v) 'latin-iso8859-1) (/= k v)) + (aset tbl k v))) ucs-mule-8859-to-mule-unicode)) tbl) "Translation table for PostScript printing. diff --git a/lisp/recentf.el b/lisp/recentf.el index 57cbaf0deb..6b5a47c66f 100644 --- a/lisp/recentf.el +++ b/lisp/recentf.el @@ -674,55 +674,55 @@ Return nil if file NAME is not one of the ten more recent." "Sort the list of menu elements L in ascending order. The MENU-ITEM part of each menu element is compared." (sort (copy-sequence l) - #'(lambda (e1 e2) - (recentf-string-lessp - (recentf-menu-element-item e1) - (recentf-menu-element-item e2))))) + (lambda (e1 e2) + (recentf-string-lessp + (recentf-menu-element-item e1) + (recentf-menu-element-item e2))))) (defsubst recentf-sort-descending (l) "Sort the list of menu elements L in descending order. The MENU-ITEM part of each menu element is compared." (sort (copy-sequence l) - #'(lambda (e1 e2) - (recentf-string-lessp - (recentf-menu-element-item e2) - (recentf-menu-element-item e1))))) + (lambda (e1 e2) + (recentf-string-lessp + (recentf-menu-element-item e2) + (recentf-menu-element-item e1))))) (defsubst recentf-sort-basenames-ascending (l) "Sort the list of menu elements L in ascending order. Only filenames sans directory are compared." (sort (copy-sequence l) - #'(lambda (e1 e2) - (recentf-string-lessp - (file-name-nondirectory (recentf-menu-element-value e1)) - (file-name-nondirectory (recentf-menu-element-value e2)))))) + (lambda (e1 e2) + (recentf-string-lessp + (file-name-nondirectory (recentf-menu-element-value e1)) + (file-name-nondirectory (recentf-menu-element-value e2)))))) (defsubst recentf-sort-basenames-descending (l) "Sort the list of menu elements L in descending order. Only filenames sans directory are compared." (sort (copy-sequence l) - #'(lambda (e1 e2) - (recentf-string-lessp - (file-name-nondirectory (recentf-menu-element-value e2)) - (file-name-nondirectory (recentf-menu-element-value e1)))))) + (lambda (e1 e2) + (recentf-string-lessp + (file-name-nondirectory (recentf-menu-element-value e2)) + (file-name-nondirectory (recentf-menu-element-value e1)))))) (defsubst recentf-sort-directories-ascending (l) "Sort the list of menu elements L in ascending order. Compares directories then filenames to order the list." (sort (copy-sequence l) - #'(lambda (e1 e2) - (recentf-directory-compare - (recentf-menu-element-value e1) - (recentf-menu-element-value e2))))) + (lambda (e1 e2) + (recentf-directory-compare + (recentf-menu-element-value e1) + (recentf-menu-element-value e2))))) (defsubst recentf-sort-directories-descending (l) "Sort the list of menu elements L in descending order. Compares directories then filenames to order the list." (sort (copy-sequence l) - #'(lambda (e1 e2) - (recentf-directory-compare - (recentf-menu-element-value e2) - (recentf-menu-element-value e1))))) + (lambda (e1 e2) + (recentf-directory-compare + (recentf-menu-element-value e2) + (recentf-menu-element-value e1))))) (defun recentf-show-basenames (l &optional no-dir) "Filter the list of menu elements L to show filenames sans directory. @@ -1382,5 +1382,5 @@ buffers you switch to a lot, you can say something like the following: (provide 'recentf) (run-hooks 'recentf-load-hook) - + ;;; recentf.el ends here diff --git a/lisp/replace.el b/lisp/replace.el index 84ec042f45..5287be2c52 100644 --- a/lisp/replace.el +++ b/lisp/replace.el @@ -2263,11 +2263,11 @@ See also `multi-occur'." (defun occur-engine-add-prefix (lines &optional prefix-face) (mapcar - #'(lambda (line) - (concat (if prefix-face - (propertize " :" 'font-lock-face prefix-face) - " :") - line "\n")) + (lambda (line) + (concat (if prefix-face + (propertize " :" 'font-lock-face prefix-face) + " :") + line "\n")) lines)) (defun occur-accumulate-lines (count &optional keep-props pt) diff --git a/lisp/select.el b/lisp/select.el index 15e171c13f..3c9f961f6d 100644 --- a/lisp/select.el +++ b/lisp/select.el @@ -440,13 +440,13 @@ two markers or an overlay. Otherwise, it is nil." (setq type 'C_STRING)) (t (let (non-latin-1 non-unicode eight-bit) - (mapc #'(lambda (x) - (if (>= x #x100) - (if (< x #x110000) - (setq non-latin-1 t) - (if (< x #x3FFF80) - (setq non-unicode t) - (setq eight-bit t))))) + (mapc (lambda (x) + (if (>= x #x100) + (if (< x #x110000) + (setq non-latin-1 t) + (if (< x #x3FFF80) + (setq non-unicode t) + (setq eight-bit t))))) str) (setq type (if (or non-unicode (and diff --git a/lisp/server.el b/lisp/server.el index 6359a76199..5306a54776 100644 --- a/lisp/server.el +++ b/lisp/server.el @@ -90,12 +90,12 @@ (defcustom server-use-tcp nil "If non-nil, use TCP sockets instead of local sockets." - :set #'(lambda (sym val) - (unless (featurep 'make-network-process '(:family local)) - (setq val t) - (unless load-in-progress - (message "Local sockets unsupported, using TCP sockets"))) - (set-default sym val)) + :set (lambda (sym val) + (unless (featurep 'make-network-process '(:family local)) + (setq val t) + (unless load-in-progress + (message "Local sockets unsupported, using TCP sockets"))) + (set-default sym val)) :type 'boolean :version "22.1") diff --git a/lisp/ses.el b/lisp/ses.el index 51843eab03..5e2d254881 100644 --- a/lisp/ses.el +++ b/lisp/ses.el @@ -3554,7 +3554,7 @@ With prefix, sorts in REVERSE order." (push (cons (buffer-substring-no-properties (point) end) (+ minrow x)) keys)) - (setq keys (sort keys #'(lambda (x y) (string< (car x) (car y))))) + (setq keys (sort keys (lambda (x y) (string< (car x) (car y))))) ;;Extract the lines in reverse sorted order (or reverse (setq keys (nreverse keys))) diff --git a/lisp/sort.el b/lisp/sort.el index d6767ed509..0925980541 100644 --- a/lisp/sort.el +++ b/lisp/sort.el @@ -540,8 +540,8 @@ Use \\[untabify] to convert tabs to spaces before sorting." (narrow-to-region beg1 end1) (goto-char beg1) (sort-subr reverse 'forward-line 'end-of-line - #'(lambda () (move-to-column col-start) nil) - #'(lambda () (move-to-column col-end) nil)))))))) + (lambda () (move-to-column col-start) nil) + (lambda () (move-to-column col-end) nil)))))))) ;;;###autoload (defun reverse-region (beg end) diff --git a/lisp/term/ns-win.el b/lisp/term/ns-win.el index 1a3811a37c..67a417c116 100644 --- a/lisp/term/ns-win.el +++ b/lisp/term/ns-win.el @@ -867,10 +867,10 @@ See the documentation of `create-fontset-from-fontset-spec' for the format.") ;; For Darwin nothing except UTF-8 makes sense. (when (eq system-type 'darwin) (add-hook 'before-init-hook - #'(lambda () - (setq locale-coding-system 'utf-8-unix) - (setq default-process-coding-system - '(utf-8-unix . utf-8-unix))))) + (lambda () + (setq locale-coding-system 'utf-8-unix) + (setq default-process-coding-system + '(utf-8-unix . utf-8-unix))))) ;; Mac OS X Lion introduces PressAndHold, which is unsupported by this port. ;; See this thread for more details: diff --git a/lisp/tree-widget.el b/lisp/tree-widget.el index d40a628b99..8691f03f86 100644 --- a/lisp/tree-widget.el +++ b/lisp/tree-widget.el @@ -214,8 +214,8 @@ Give the image the specified properties PROPS." See also the option `widget-image-conversion'." (delq nil (mapcar - #'(lambda (fmt) - (and (image-type-available-p (car fmt)) fmt)) + (lambda (fmt) + (and (image-type-available-p (car fmt)) fmt)) widget-image-conversion))) ;; Buffer local cache of theme data. diff --git a/lisp/whitespace.el b/lisp/whitespace.el index 017409d6a4..5a482c5253 100644 --- a/lisp/whitespace.el +++ b/lisp/whitespace.el @@ -1687,32 +1687,32 @@ cleaning up these problems." (or whitespace-active-style whitespace-style))) (bogus-list (mapcar - #'(lambda (option) - (when force - (push (car option) style)) - (goto-char rstart) - (let ((regexp - (cond - ((eq (car option) 'indentation) - (whitespace-indentation-regexp)) - ((eq (car option) 'indentation::tab) - (whitespace-indentation-regexp 'tab)) - ((eq (car option) 'indentation::space) - (whitespace-indentation-regexp 'space)) - ((eq (car option) 'space-after-tab) - (whitespace-space-after-tab-regexp)) - ((eq (car option) 'space-after-tab::tab) - (whitespace-space-after-tab-regexp 'tab)) - ((eq (car option) 'space-after-tab::space) - (whitespace-space-after-tab-regexp 'space)) - ((eq (car option) 'missing-newline-at-eof) - "[^\n]\\'") - (t - (cdr option))))) - (when (re-search-forward regexp rend t) - (unless has-bogus - (setq has-bogus (memq (car option) style))) - t))) + (lambda (option) + (when force + (push (car option) style)) + (goto-char rstart) + (let ((regexp + (cond + ((eq (car option) 'indentation) + (whitespace-indentation-regexp)) + ((eq (car option) 'indentation::tab) + (whitespace-indentation-regexp 'tab)) + ((eq (car option) 'indentation::space) + (whitespace-indentation-regexp 'space)) + ((eq (car option) 'space-after-tab) + (whitespace-space-after-tab-regexp)) + ((eq (car option) 'space-after-tab::tab) + (whitespace-space-after-tab-regexp 'tab)) + ((eq (car option) 'space-after-tab::space) + (whitespace-space-after-tab-regexp 'space)) + ((eq (car option) 'missing-newline-at-eof) + "[^\n]\\'") + (t + (cdr option))))) + (when (re-search-forward regexp rend t) + (unless has-bogus + (setq has-bogus (memq (car option) style))) + t))) whitespace-report-list))) (when (pcase report-if-bogus ('nil t) ('never nil) (_ has-bogus)) (whitespace-kill-buffer whitespace-report-buffer-name) @@ -2463,5 +2463,4 @@ It should be added buffer-locally to `write-file-functions'." "use `with-eval-after-load' instead." "28.1") (run-hooks 'whitespace-load-hook) - ;;; whitespace.el ends here commit 5bc522b4f45f17c44449a05df562d8f0ae00bcb4 Author: Eli Zaretskii Date: Thu Oct 21 22:29:37 2021 +0300 ; * lisp/simple.el (kill-region): A better fix for bug#51320. diff --git a/lisp/simple.el b/lisp/simple.el index 4aa373d670..e3657cc079 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -5289,9 +5289,12 @@ Supply two arguments, character positions BEG and END indicating the this command always kills the current region." ;; Pass mark first, then point, because the order matters when ;; calling `kill-append'. - (interactive (list (mark) (point) 'region)) - (unless (or region (and beg end)) - (user-error "The mark is not set now, so there is no region")) + (interactive (progn + (let ((beg (mark)) + (end (point))) + (unless (and beg end) + (user-error "The mark is not set now, so there is no region")) + (list beg end 'region)))) (condition-case nil (let ((string (if region (funcall region-extract-function 'delete) commit 6352e0a55587e15fa3bef878a329c1a148749cfe Author: Stefan Kangas Date: Thu Oct 21 21:22:51 2021 +0200 Add comment on reworking a section in emacs-lisp-intro.texi * doc/lispintro/emacs-lisp-intro.texi (Body of mark-whole-buffer): Add comment about how one could rework this section. diff --git a/doc/lispintro/emacs-lisp-intro.texi b/doc/lispintro/emacs-lisp-intro.texi index 2a990ca9ce..5ce46ea0f7 100644 --- a/doc/lispintro/emacs-lisp-intro.texi +++ b/doc/lispintro/emacs-lisp-intro.texi @@ -4893,6 +4893,23 @@ region. @c FIXME: the definition of append-to-buffer has been changed (in @c 2010-03-30). +@c In Bug#8275, Stefan Monner writes: +@c >> Do you want to fix this, or shall I try? The problem is that +@c >> append-to-buffer now uses let* and with-current-buffer, so this might +@c >> break the flow of the text. At this point in the book, let* and +@c >> with-current-buffer are not yet introduced. +@c > +@c > Here are some thoughts: +@c > - I don't think it's of any importance that the example code be +@c > identical to the currently used code. +@c > - append-to-buffer might not be the best example since AFAICT copying +@c > text from one buffer to another is not a common operation and in most +@c > cases this is done via buffer-substring + insert (often with some +@c > processing on the string between the two) rather than with +@c > insert-buffer-substring which is a rarely used function. +@c > - yes, I think the text would benefit from some rethink to try and present +@c > with-current-buffer in preference to set-buffer, but it's not +@c > a simple fix. @node append-to-buffer @section The Definition of @code{append-to-buffer} @findex append-to-buffer commit ee6bdd6eef329434427c6a7b22613bd33249d00a Author: Eli Zaretskii Date: Thu Oct 21 22:13:09 2021 +0300 Fix non-interactive behavior of 'kill-region' * lisp/simple.el (kill-region): Actually ignore BEG and END when REGION is non-nil. Doc fix. (Bug#51320) diff --git a/lisp/simple.el b/lisp/simple.el index bec4aa4738..4aa373d670 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -5285,11 +5285,12 @@ Lisp programs should use this function for killing text. Supply two arguments, character positions BEG and END indicating the stretch of text to be killed. If the optional argument REGION is non-nil, the function ignores BEG and END, and kills the current - region instead." + region instead. Interactively, REGION is always non-nil, and so + this command always kills the current region." ;; Pass mark first, then point, because the order matters when ;; calling `kill-append'. (interactive (list (mark) (point) 'region)) - (unless (and beg end) + (unless (or region (and beg end)) (user-error "The mark is not set now, so there is no region")) (condition-case nil (let ((string (if region commit 2b7655ca0e36a3de40c0a94eed701277a12ba146 Author: Eli Zaretskii Date: Thu Oct 21 21:09:03 2021 +0300 ; More accurate doc string for 'tab-bar-format' * lisp/tab-bar.el (tab-bar-format): Make the doc string more accurate. (Bug#51247) diff --git a/lisp/tab-bar.el b/lisp/tab-bar.el index a3316bf449..10ff57bfd0 100644 --- a/lisp/tab-bar.el +++ b/lisp/tab-bar.el @@ -706,8 +706,13 @@ the formatted tab name to display in the tab bar." Every item in the list is a function that returns a string, or a list of menu-item elements, or nil. Adding a function to the list causes the tab bar to show -that string, or display a menu with those menu items when -you click on the tab bar. +that string, or display a tab button which, when clicked, +will invoke the command that is the binding of the menu item. +The menu-item binding of nil will produce a tab clicking +on which will select that tab. The menu-item's title is +displayed as the label of the tab. +If a function returns nil, it doesn't directly affect the +tab bar appearance, but can do that by some side-effect. If the list ends with `tab-bar-format-align-right' and `tab-bar-format-global', then after enabling `display-time-mode' (or any other mode that uses `global-mode-string'), commit f3960bffd07332db4c728771ddb20e50f0c1436f Author: Michael Albinus Date: Thu Oct 21 20:04:51 2021 +0200 Configure Emacs on emba with debug options * test/infra/Dockerfile.emba (emacs-base): Install gdb. (emacs-inotify): Configure debug options. diff --git a/test/infra/Dockerfile.emba b/test/infra/Dockerfile.emba index c129bc8be8..a031fc1685 100644 --- a/test/infra/Dockerfile.emba +++ b/test/infra/Dockerfile.emba @@ -29,7 +29,7 @@ FROM debian:stretch as emacs-base RUN apt-get update && \ apt-get install -y --no-install-recommends -o=Dpkg::Use-Pty=0 \ libc-dev gcc g++ make autoconf automake libncurses-dev gnutls-dev \ - libdbus-1-dev libacl1-dev acl git texinfo \ + libdbus-1-dev libacl1-dev acl git texinfo gdb \ && rm -rf /var/lib/apt/lists/* FROM emacs-base as emacs-inotify @@ -42,7 +42,8 @@ RUN apt-get update && \ COPY . /checkout WORKDIR /checkout RUN ./autogen.sh autoconf -RUN ./configure +RUN ./configure --enable-checking='yes,glyphs' --enable-check-lisp-object-type \ + CFLAGS='-O0 -g3' # 'make -j4 bootstrap' does not work reliably. RUN make bootstrap commit 2841e26744d6f5f055ad37e7b104dbfb92afca69 Author: Juri Linkov Date: Thu Oct 21 20:22:15 2021 +0300 * test/lisp/dabbrev-tests.el: Use 'kbd' for readable keys. (dabbrev-expand-test, dabbrev-completion-test) (dabbrev-completion-test-with-argument): Use 'kbd' to format keys for 'execute-kbd-macro'. (dabbrev-expand-test): Fix docstring. diff --git a/test/lisp/dabbrev-tests.el b/test/lisp/dabbrev-tests.el index e4b7837391..d3fe78b618 100644 --- a/test/lisp/dabbrev-tests.el +++ b/test/lisp/dabbrev-tests.el @@ -29,16 +29,15 @@ (ert-deftest dabbrev-expand-test () "Test for bug#1948. -When DABBREV-ELIMINATE-NEWLINES is non-nil (the default), -repeated calls to DABBREV-EXPAND can result in the source of +When `dabbrev-eliminate-newlines' is non-nil (the default), +repeated calls to `dabbrev-expand' can result in the source of first expansion being replaced rather than the destination." (with-temp-buffer (insert "ab x\na\nab y") (goto-char 8) (save-window-excursion (set-window-buffer nil (current-buffer)) - ;; M-/ SPC M-/ M-/ - (execute-kbd-macro "\257 \257\257")) + (execute-kbd-macro (kbd "M-/ SPC M-/ M-/"))) (should (string= (buffer-string) "ab x\nab y\nab y")))) (ert-deftest dabbrev-completion-test () @@ -52,8 +51,7 @@ buffers unless a prefix argument is used." (goto-char 6) (save-window-excursion (set-window-buffer nil (current-buffer)) - ;; C-M-/ - (execute-kbd-macro [201326639])) + (execute-kbd-macro (kbd "C-M-/"))) (should (string= (buffer-string) "abc\nabc"))))) (ert-deftest dabbrev-completion-test-with-argument () @@ -67,8 +65,7 @@ multiple expansions." (goto-char 6) (save-window-excursion (set-window-buffer nil (current-buffer)) - ;; C-u C-u C-M-/ - (execute-kbd-macro [21 21 201326639])) + (execute-kbd-macro (kbd "C-u C-u C-M-/"))) (should (string= (buffer-string) "abc\na"))))) ;;; dabbrev-tests.el ends here diff --git a/test/lisp/emacs-lisp/find-func-tests.el b/test/lisp/emacs-lisp/find-func-tests.el index 28a9a7ecda..987e4047d3 100644 --- a/test/lisp/emacs-lisp/find-func-tests.el +++ b/test/lisp/emacs-lisp/find-func-tests.el @@ -26,7 +26,7 @@ ;;; Code: -(require 'ert-x) ;For `ert-run-keys'. +(require 'ert-x) ;For `ert-simulate-keys'. (require 'find-func) (ert-deftest find-func-tests--library-completion () ;bug#43393 diff --git a/test/lisp/international/mule-tests.el b/test/lisp/international/mule-tests.el index 7727c118b2..8ca1ade771 100644 --- a/test/lisp/international/mule-tests.el +++ b/test/lisp/international/mule-tests.el @@ -23,7 +23,7 @@ ;;; Code: -(require 'ert-x) ;For `ert-run-keys'. +(require 'ert-x) ;For `ert-simulate-keys'. (ert-deftest find-auto-coding--bug27391 () "Check that Bug#27391 is fixed." commit 1cdb4d2077c4e402bf2b2991e8395f0ccdedd1d1 Author: Juri Linkov Date: Thu Oct 21 19:55:24 2021 +0300 * lisp/menu-bar.el (menu-bar-keymap): Add optional arg KEYMAP (bug#50067). * lisp/mouse.el (context-menu-global): Use 'menu-bar-keymap' with its arg KEYMAP set to 'global-map'. diff --git a/lisp/menu-bar.el b/lisp/menu-bar.el index 1cc126b501..f19dc9e7c9 100644 --- a/lisp/menu-bar.el +++ b/lisp/menu-bar.el @@ -2696,10 +2696,13 @@ This command is to be used when you click the mouse in the menubar." (cdr menu-bar-item-cons) 0)))) -(defun menu-bar-keymap () +(defun menu-bar-keymap (&optional keymap) "Return the current menu-bar keymap. +The ordering of the return value respects `menu-bar-final-items'. -The ordering of the return value respects `menu-bar-final-items'." +It's possible to use the KEYMAP argument to override the default keymap +that is the currently active maps. For example, the argument KEYMAP +could provide `global-map' where items are limited to the global map only." (let ((menu-bar '()) (menu-end '())) (map-keymap @@ -2712,7 +2715,7 @@ The ordering of the return value respects `menu-bar-final-items'." ;; sorting. (push (cons pos menu-item) menu-end) (push menu-item menu-bar)))) - (lookup-key (menu-bar-current-active-maps) [menu-bar])) + (lookup-key (or keymap (menu-bar-current-active-maps)) [menu-bar])) `(keymap ,@(nreverse menu-bar) ,@(mapcar #'cdr (sort menu-end (lambda (a b) diff --git a/lisp/mouse.el b/lisp/mouse.el index bcb58d153a..7bac6dd07b 100644 --- a/lisp/mouse.el +++ b/lisp/mouse.el @@ -364,7 +364,7 @@ Some context functions add menu items below the separator." (when (consp binding) (define-key-after menu (vector key) (copy-sequence binding)))) - (lookup-key global-map [menu-bar])) + (menu-bar-keymap global-map)) menu) (defun context-menu-local (menu _click) commit 2260d01f4d214783e61dbf4d4cf22396576a346a Author: Lars Ingebrigtsen Date: Thu Oct 21 17:23:46 2021 +0200 Actually fix the Pango build problem * src/gtkutil.c (xg_weight_to_symbol): Don't break the build on older systems. diff --git a/src/gtkutil.c b/src/gtkutil.c index 873f7f2d68..a9eabf47d8 100644 --- a/src/gtkutil.c +++ b/src/gtkutil.c @@ -2244,7 +2244,7 @@ Lisp_Object xg_weight_to_symbol (PangoWeight w) (w <= PANGO_WEIGHT_THIN ? Qthin /* 100 */ : w <= PANGO_WEIGHT_ULTRALIGHT ? Qultra_light /* 200 */ : w <= PANGO_WEIGHT_LIGHT ? Qlight /* 300 */ -#ifdef PANGO_WEIGHT_SEMILIGHT /* New in 1.36.7 */ +#if PANGO_VERSION_CHECK(1, 36, 7) : w <= PANGO_WEIGHT_SEMILIGHT ? Qsemi_light /* 350 */ #endif : w <= PANGO_WEIGHT_BOOK ? Qbook /* 380 */ commit bd7b5f72a96a3e80a7c06625e058ead88ee832cf Merge: a4c232effc 0545c70c16 Author: Glenn Morris Date: Thu Oct 21 08:02:57 2021 -0700 Merge from origin/emacs-28 0545c70c16 (origin/emacs-28) ; * src/keyboard.c (readable_events): Ad... 805ed8d318 Fix todo-mode AOT test failures (bug#51308) 8f42ff31f6 Fix hi-lock AOT test failures (bug#51308) 8002fcd4b9 Fix socks test 4540130312 ; Fix typo 59df93e2dd * lisp/help.el (help--analyze-key): Add new arg BUFFER (bu... cb8b12b56d Improve docstrings and NEWS item of 'repeat-mode' 06fe499614 * lisp/tab-bar.el (tab-bar-menu-bar): New command (bug#512... 8358da9c4c Display a tab bar item as sunken when appropriate 29fdc65860 Fix tab bar item highlight when a mouse click is dropped 7236592668 Refer to mouse-highlight from make-pointer-invisible docst... cf4394a397 * etc/PROBLEMS: Add hex codepoint for NO-BREAK SPACE 2d647e88fa Describe how to debug fontconfig issues c916040921 Adapt Tramp tests 1bb14f93f1 Convert ANSI color definitions in themes to use faces (e.g... 8e7cd29712 Revert "Revert back to using ESC as viper-ESC-key again" 91d71b38a3 Fix inset rectangle corners when sides aren't drawn (bug#5... 5c1a575ef4 Don't use color escape sequences in vc-git-expanded-log-entry d7f595cc89 Code cleanup in tramp-tests.el 548a5db611 ; etc/NEWS fix wording # Conflicts: # etc/NEWS commit a4c232effce74028e9a904e15c9616fba33a4143 Author: Lars Ingebrigtsen Date: Thu Oct 21 15:07:08 2021 +0200 Fix build on systems with older Pango versions * src/gtkutil.c (xg_weight_to_symbol): Don't break the build on older systems. diff --git a/src/gtkutil.c b/src/gtkutil.c index 9a2850dea8..873f7f2d68 100644 --- a/src/gtkutil.c +++ b/src/gtkutil.c @@ -2244,7 +2244,9 @@ Lisp_Object xg_weight_to_symbol (PangoWeight w) (w <= PANGO_WEIGHT_THIN ? Qthin /* 100 */ : w <= PANGO_WEIGHT_ULTRALIGHT ? Qultra_light /* 200 */ : w <= PANGO_WEIGHT_LIGHT ? Qlight /* 300 */ +#ifdef PANGO_WEIGHT_SEMILIGHT /* New in 1.36.7 */ : w <= PANGO_WEIGHT_SEMILIGHT ? Qsemi_light /* 350 */ +#endif : w <= PANGO_WEIGHT_BOOK ? Qbook /* 380 */ : w <= PANGO_WEIGHT_NORMAL ? Qnormal /* 400 */ : w <= PANGO_WEIGHT_MEDIUM ? Qmedium /* 500 */ commit aa9bbf5446cb689c2e0f42dc38aecb00d8628fa6 Author: Lars Ingebrigtsen Date: Thu Oct 21 14:36:50 2021 +0200 Fix bold/black in w32_to_fc_weight * src/w32font.c (w32_to_fc_weight): Use symbols. diff --git a/src/w32font.c b/src/w32font.c index 885daf930b..4ceb4302ce 100644 --- a/src/w32font.c +++ b/src/w32font.c @@ -2000,7 +2000,7 @@ w32_encode_weight (int n) static Lisp_Object w32_to_fc_weight (int n) { - if (n >= FW_HEAVY) return Qbold; + if (n >= FW_HEAVY) return Qblack; if (n >= FW_EXTRABOLD) return Qextra_bold; if (n >= FW_BOLD) return Qbold; if (n >= FW_SEMIBOLD) return intern ("demibold"); commit 0545c70c168d2cc3f4fa794312b23f2616f67327 Author: Eli Zaretskii Date: Thu Oct 21 10:53:20 2021 +0300 ; * src/keyboard.c (readable_events): Add a comment. diff --git a/src/keyboard.c b/src/keyboard.c index 6895a249f2..a99d14cb4c 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -3462,6 +3462,8 @@ readable_events (int flags) READABLE_EVENTS_FILTER_EVENTS is set, report it as empty. */ if (kbd_fetch_ptr != kbd_store_ptr) { + /* See https://lists.gnu.org/r/emacs-devel/2005-05/msg00297.html + for why we treat toolkit scroll-bar events specially here. */ if (flags & (READABLE_EVENTS_FILTER_EVENTS #ifdef USE_TOOLKIT_SCROLL_BARS | READABLE_EVENTS_IGNORE_SQUEEZABLES commit 805ed8d3188d11750b6f1612dde14f845d894679 Author: Lars Ingebrigtsen Date: Thu Oct 21 06:26:30 2021 +0200 Fix todo-mode AOT test failures (bug#51308) diff --git a/test/lisp/calendar/todo-mode-tests.el b/test/lisp/calendar/todo-mode-tests.el index 0538368fc8..9b5d990b9b 100644 --- a/test/lisp/calendar/todo-mode-tests.el +++ b/test/lisp/calendar/todo-mode-tests.el @@ -567,7 +567,7 @@ The remaining arguments (except _ARG, which is ignored) specify item insertion parameters. This provides a noninteractive API for todo-insert-item for use in automatic testing." (cl-letf (((symbol-function 'read-from-minibuffer) - (lambda (_prompt) item)) + (lambda (_prompt &rest _) item)) ((symbol-function 'read-number) ; For todo-set-item-priority (lambda (_prompt &optional _default) (or priority 1)))) (todo-insert-item--basic nil diary-type date-type time where))) commit 8f42ff31f66afa03f7d16857ca588d95549b9cf4 Author: Lars Ingebrigtsen Date: Thu Oct 21 06:24:35 2021 +0200 Fix hi-lock AOT test failures (bug#51308) diff --git a/test/lisp/hi-lock-tests.el b/test/lisp/hi-lock-tests.el index 199512fe7d..200caa7e1a 100644 --- a/test/lisp/hi-lock-tests.el +++ b/test/lisp/hi-lock-tests.el @@ -31,7 +31,8 @@ (with-temp-buffer (insert "a A b B\n") (cl-letf (((symbol-function 'completing-read) - (lambda (_prompt _coll _x _y _z _hist defaults) + (lambda (_prompt _coll + &optional _x _y _z _hist defaults _inherit) (car defaults)))) (dotimes (_ 2) (let ((face (hi-lock-read-face-name))) @@ -43,7 +44,8 @@ (with-temp-buffer (insert "foo bar") (cl-letf (((symbol-function 'completing-read) - (lambda (_prompt _coll _x _y _z _hist defaults) + (lambda (_prompt _coll + &optional _x _y _z _hist defaults _inherit) (car defaults)))) (hi-lock-set-pattern "9999" (hi-lock-read-face-name)) ; No match (hi-lock-set-pattern "foo" (hi-lock-read-face-name))) @@ -89,7 +91,8 @@ (let ((search-spaces-regexp search-whitespace-regexp)) (highlight-regexp "a a")) (should (= (length (overlays-in (point-min) (point-max))) 1)) (cl-letf (((symbol-function 'completing-read) - (lambda (_prompt _coll _x _y _z _hist defaults) + (lambda (_prompt _coll + &optional _x _y _z _hist defaults _inherit) (car defaults)))) (call-interactively 'unhighlight-regexp)) (should (= (length (overlays-in (point-min) (point-max))) 0)) @@ -142,7 +145,8 @@ (font-lock-ensure) (should (memq 'hi-yellow (get-text-property 1 'face))) (cl-letf (((symbol-function 'completing-read) - (lambda (_prompt _coll _x _y _z _hist defaults) + (lambda (_prompt _coll + &optional _x _y _z _hist defaults _inherit) (car defaults))) (font-lock-fontified t)) (call-interactively 'unhighlight-regexp)) @@ -155,7 +159,8 @@ (insert "aAbB\n") (cl-letf (((symbol-function 'completing-read) - (lambda (_prompt _coll _x _y _z _hist defaults) + (lambda (_prompt _coll + &optional _x _y _z _hist defaults _inherit) (car defaults)))) (highlight-regexp "a") commit 8002fcd4b9678cbd732c92f26e01751687211911 Author: Lars Ingebrigtsen Date: Thu Oct 21 06:06:13 2021 +0200 Fix socks test * test/lisp/net/socks-tests.el (socks-tests-v4-basic): Fix failure under native-comp (bug#51308). diff --git a/test/lisp/net/socks-tests.el b/test/lisp/net/socks-tests.el index 9079c1bef2..7fb885235c 100644 --- a/test/lisp/net/socks-tests.el +++ b/test/lisp/net/socks-tests.el @@ -203,7 +203,7 @@ Vectors must match verbatim. Strings are considered regex patterns.") (should (equal host "example.com")) (list 93 184 216 34))) ((symbol-function 'user-full-name) - (lambda () "foo"))) + (lambda (&optional _) "foo"))) (socks-tests-perform-hello-world-http-request))))) ;; Replace first pattern below with ([5 3 0 1 2] . [5 2]) to validate commit 14121345adc1bc1cdf00f246f5d2c221aa89f55e Author: Lars Ingebrigtsen Date: Thu Oct 21 04:41:35 2021 +0200 Add a comment to the Turkish casefiddle test diff --git a/test/src/casefiddle-tests.el b/test/src/casefiddle-tests.el index 164adbc19e..dbbe9f3092 100644 --- a/test/src/casefiddle-tests.el +++ b/test/src/casefiddle-tests.el @@ -280,6 +280,9 @@ (ert-deftest casefiddle-turkish () (skip-unless (member "tr_TR.utf8" (get-locale-names))) + ;; See bug#50752. The point is that unibyte and multibyte strings + ;; are upcased differently in the "dotless i" case in Turkish, + ;; turning ASCII into non-ASCII, which is very unusual. (with-locale-environment "tr_TR.utf8" (should (string-equal (downcase "I ı") "ı ı")) (should (string-equal (downcase "İ i") "i̇ i")) commit 65fd3ca84f75aee0dfebb87fa793dae57c1caf35 Author: Lars Ingebrigtsen Date: Thu Oct 21 04:30:02 2021 +0200 Support the "medium" font weight * lisp/faces.el (set-face-attribute): Mention new font weights in doc string. * src/font.c (struct table_entry): Allow more synonyms. (weight_table): Expand to support separating medium and normal weights. Also add heavy/ultra-heavy and some other variants. (font_parse_fcname): Support more names. * src/gtkutil.c (xg_weight_to_symbol): Support all the Pango weights. (xg_style_to_symbol): Make into functions. (xg_get_font): Adjust. * src/w32font.c (w32_to_fc_weight): Use symbols. * src/xfaces.c (syms_of_xfaces): Add the new symbols. diff --git a/etc/NEWS b/etc/NEWS index f9fe72e91f..c1b8adc511 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -53,6 +53,14 @@ time. Jumping to source from "*Help*" buffer moves the point when the source buffer is already open. Now, the old point is pushed to mark ring. +** Fonts + +--- +*** Emacs now supports "medium" fonts. +Emacs previously didn't distinguish between the "regular" weight and +the "medium" weight, but it now also supports the (heavier) "medium" +weight. + * Editing Changes in Emacs 29.1 diff --git a/lisp/faces.el b/lisp/faces.el index 47f7f3f0f3..58c57143d4 100644 --- a/lisp/faces.el +++ b/lisp/faces.el @@ -702,9 +702,10 @@ for it to be relative to). `:weight' -VALUE specifies the weight of the font to use. It must be one of the -symbols `ultra-bold', `extra-bold', `bold', `semi-bold', `normal', -`semi-light', `light', `extra-light', `ultra-light'. +VALUE specifies the weight of the font to use. It must be one of +the symbols `ultra-heavy', `heavy', `ultra-bold', `extra-bold', +`bold', `semi-bold', `medium', `normal', `book', `semi-light', +`light', `extra-light', `ultra-light', or `thin'. `:slant' diff --git a/src/font.c b/src/font.c index 6cd4a6b5c1..5e761abc5e 100644 --- a/src/font.c +++ b/src/font.c @@ -57,24 +57,26 @@ struct table_entry int numeric; /* The first one is a valid name as a face attribute. The second one (if any) is a typical name in XLFD field. */ - const char *names[5]; + const char *names[6]; }; /* Table of weight numeric values and their names. This table must be - sorted by numeric values in ascending order. */ + sorted by numeric values in ascending order and the numeric values + must approximately match the weights in the font files. */ static const struct table_entry weight_table[] = { { 0, { "thin" }}, - { 20, { "ultra-light", "ultralight" }}, - { 40, { "extra-light", "extralight" }}, + { 40, { "ultra-light", "ultralight", "extra-light", "extralight" }}, { 50, { "light" }}, - { 75, { "semi-light", "semilight", "demilight", "book" }}, - { 100, { "normal", "medium", "regular", "unspecified" }}, - { 180, { "semi-bold", "semibold", "demibold", "demi" }}, + { 55, { "semi-light", "semilight", "demilight" }}, + { 80, { "regular", "normal", "unspecified", "book" }}, + { 100, { "medium" }}, + { 180, { "semi-bold", "semibold", "demibold", "demi-bold", "demi" }}, { 200, { "bold" }}, - { 205, { "extra-bold", "extrabold" }}, - { 210, { "ultra-bold", "ultrabold", "black" }} + { 205, { "extra-bold", "extrabold", "ultra-bold", "ultrabold" }}, + { 210, { "black", "heavy" }}, + { 250, { "ultra-heavy", "ultraheavy" }} }; /* Table of slant numeric values and their names. This table must be @@ -1484,11 +1486,20 @@ font_parse_fcname (char *name, ptrdiff_t len, Lisp_Object font) #define PROP_MATCH(STR) (word_len == strlen (STR) \ && memcmp (p, STR, strlen (STR)) == 0) - if (PROP_MATCH ("light") + if (PROP_MATCH ("thin") + || PROP_MATCH ("ultra-light") + || PROP_MATCH ("light") + || PROP_MATCH ("semi-light") + || PROP_MATCH ("book") || PROP_MATCH ("medium") + || PROP_MATCH ("normal") + || PROP_MATCH ("semibold") || PROP_MATCH ("demibold") || PROP_MATCH ("bold") - || PROP_MATCH ("black")) + || PROP_MATCH ("ultra-bold") + || PROP_MATCH ("black") + || PROP_MATCH ("heavy") + || PROP_MATCH ("ultra-heavy")) FONT_SET_STYLE (font, FONT_WEIGHT_INDEX, val); else if (PROP_MATCH ("roman") || PROP_MATCH ("italic") diff --git a/src/gtkutil.c b/src/gtkutil.c index e87845caf7..9a2850dea8 100644 --- a/src/gtkutil.c +++ b/src/gtkutil.c @@ -2237,20 +2237,32 @@ xg_get_file_name (struct frame *f, #ifdef HAVE_GTK3 -#define XG_WEIGHT_TO_SYMBOL(w) \ - (w <= PANGO_WEIGHT_THIN ? Qextra_light \ - : w <= PANGO_WEIGHT_ULTRALIGHT ? Qlight \ - : w <= PANGO_WEIGHT_LIGHT ? Qsemi_light \ - : w < PANGO_WEIGHT_MEDIUM ? Qnormal \ - : w <= PANGO_WEIGHT_SEMIBOLD ? Qsemi_bold \ - : w <= PANGO_WEIGHT_BOLD ? Qbold \ - : w <= PANGO_WEIGHT_HEAVY ? Qextra_bold \ - : Qultra_bold) - -#define XG_STYLE_TO_SYMBOL(s) \ - (s == PANGO_STYLE_OBLIQUE ? Qoblique \ - : s == PANGO_STYLE_ITALIC ? Qitalic \ - : Qnormal) +static +Lisp_Object xg_weight_to_symbol (PangoWeight w) +{ + return + (w <= PANGO_WEIGHT_THIN ? Qthin /* 100 */ + : w <= PANGO_WEIGHT_ULTRALIGHT ? Qultra_light /* 200 */ + : w <= PANGO_WEIGHT_LIGHT ? Qlight /* 300 */ + : w <= PANGO_WEIGHT_SEMILIGHT ? Qsemi_light /* 350 */ + : w <= PANGO_WEIGHT_BOOK ? Qbook /* 380 */ + : w <= PANGO_WEIGHT_NORMAL ? Qnormal /* 400 */ + : w <= PANGO_WEIGHT_MEDIUM ? Qmedium /* 500 */ + : w <= PANGO_WEIGHT_SEMIBOLD ? Qsemi_bold /* 600 */ + : w <= PANGO_WEIGHT_BOLD ? Qbold /* 700 */ + : w <= PANGO_WEIGHT_ULTRABOLD ? Qultra_bold /* 800 */ + : w <= PANGO_WEIGHT_HEAVY ? Qblack /* 900 */ + : Qultra_heavy); /* 1000 */ +} + +static +Lisp_Object xg_style_to_symbol (PangoStyle s) +{ + return + (s == PANGO_STYLE_OBLIQUE ? Qoblique + : s == PANGO_STYLE_ITALIC ? Qitalic + : Qnormal); +} #endif /* HAVE_GTK3 */ @@ -2341,8 +2353,8 @@ xg_get_font (struct frame *f, const char *default_name) font = CALLN (Ffont_spec, QCfamily, build_string (family), QCsize, make_float (pango_units_to_double (size)), - QCweight, XG_WEIGHT_TO_SYMBOL (weight), - QCslant, XG_STYLE_TO_SYMBOL (style)); + QCweight, xg_weight_to_symbol (weight), + QCslant, xg_style_to_symbol (style)); char *font_desc_str = pango_font_description_to_string (desc); dupstring (&x_last_font_name, font_desc_str); diff --git a/src/w32font.c b/src/w32font.c index 6b9ab0468c..885daf930b 100644 --- a/src/w32font.c +++ b/src/w32font.c @@ -2000,11 +2000,11 @@ w32_encode_weight (int n) static Lisp_Object w32_to_fc_weight (int n) { - if (n >= FW_HEAVY) return intern ("black"); + if (n >= FW_HEAVY) return Qbold; if (n >= FW_EXTRABOLD) return Qextra_bold; if (n >= FW_BOLD) return Qbold; if (n >= FW_SEMIBOLD) return intern ("demibold"); - if (n >= FW_NORMAL) return intern ("medium"); + if (n >= FW_NORMAL) return Qmedium; if (n >= FW_LIGHT) return Qlight; if (n >= FW_EXTRALIGHT) return Qextra_light; return intern ("thin"); diff --git a/src/xfaces.c b/src/xfaces.c index 5e63e87d75..22f37222c3 100644 --- a/src/xfaces.c +++ b/src/xfaces.c @@ -6933,13 +6933,20 @@ syms_of_xfaces (void) DEFSYM (Qpressed_button, "pressed-button"); DEFSYM (Qflat_button, "flat-button"); DEFSYM (Qnormal, "normal"); + DEFSYM (Qthin, "thin"); DEFSYM (Qextra_light, "extra-light"); + DEFSYM (Qultra_light, "ultra-light"); DEFSYM (Qlight, "light"); DEFSYM (Qsemi_light, "semi-light"); + DEFSYM (Qmedium, "medium"); DEFSYM (Qsemi_bold, "semi-bold"); + DEFSYM (Qbook, "book"); DEFSYM (Qbold, "bold"); DEFSYM (Qextra_bold, "extra-bold"); DEFSYM (Qultra_bold, "ultra-bold"); + DEFSYM (Qheavy, "heavy"); + DEFSYM (Qultra_heavy, "ultra-heavy"); + DEFSYM (Qblack, "black"); DEFSYM (Qoblique, "oblique"); DEFSYM (Qitalic, "italic"); commit 4e9764e6a155aa403d69d38fa06f4a774140f63c Author: Stefan Kangas Date: Wed Oct 20 20:03:34 2021 +0200 Add some tests for floatfns.c * test/src/floatfns-tests.el (floatfns-tests-cos) (floatfns-tests-sin, floatfns-tests-tan, floatfns-tests-isnan) (floatfns-tests-exp, floatfns-tests-expt, floatfns-tests-log) (floatfns-tests-sqrt, floatfns-tests-abs, floatfns-tests-logb) (floatfns-tests-ceiling, floatfns-tests-floor) (floatfns-tests-round, floatfns-tests-truncate) (floatfns-tests-fceiling, floatfns-tests-ffloor) (floatfns-tests-fround, floatfns-tests-ftruncate) (divide-extreme-sign): New tests. diff --git a/test/src/floatfns-tests.el b/test/src/floatfns-tests.el index 47fa194162..a066d2e15e 100644 --- a/test/src/floatfns-tests.el +++ b/test/src/floatfns-tests.el @@ -21,6 +21,68 @@ (require 'ert) +(ert-deftest floatfns-tests-cos () + (should (= (cos 0) 1.0)) + (should (= (cos float-pi) -1.0))) + +(ert-deftest floatfns-tests-sin () + (should (= (sin 0) 0.0))) + +(ert-deftest floatfns-tests-tan () + (should (= (tan 0) 0.0))) + +(ert-deftest floatfns-tests-isnan () + (should (isnan 0.0e+NaN)) + (should (isnan -0.0e+NaN)) + (should-error (isnan "foo") :type 'wrong-type-argument)) + +(ert-deftest floatfns-tests-exp () + (should (= (exp 0) 1.0))) + +(ert-deftest floatfns-tests-expt () + (should (= (expt 2 8) 256))) + +(ert-deftest floatfns-tests-log () + (should (= (log 1000 10) 3.0))) + +(ert-deftest floatfns-tests-sqrt () + (should (= (sqrt 25) 5))) + +(ert-deftest floatfns-tests-abs () + (should (= (abs 10) 10)) + (should (= (abs -10) 10))) + +(ert-deftest floatfns-tests-logb () + (should (= (logb 10000) 13))) + +(ert-deftest floatfns-tests-ceiling () + (should (= (ceiling 0.5) 1))) + +(ert-deftest floatfns-tests-floor () + (should (= (floor 1.5) 1))) + +(ert-deftest floatfns-tests-round () + (should (= (round 1.49999999999) 1)) + (should (= (round 1.50000000000) 2)) + (should (= (round 1.50000000001) 2))) + +(ert-deftest floatfns-tests-truncate () + (should (= (truncate float-pi) 3))) + +(ert-deftest floatfns-tests-fceiling () + (should (= (fceiling 0.5) 1.0))) + +(ert-deftest floatfns-tests-ffloor () + (should (= (ffloor 1.5) 1.0))) + +(ert-deftest floatfns-tests-fround () + (should (= (fround 1.49999999999) 1.0)) + (should (= (fround 1.50000000000) 2.0)) + (should (= (fround 1.50000000001) 2.0))) + +(ert-deftest floatfns-tests-ftruncate () + (should (= (ftruncate float-pi) 3.0))) + (ert-deftest divide-extreme-sign () (should (= (ceiling most-negative-fixnum -1.0) (- most-negative-fixnum))) (should (= (floor most-negative-fixnum -1.0) (- most-negative-fixnum))) commit 4540130312b8e9dbbe930ba2ffb32e5e51560514 Author: Stefan Kangas Date: Wed Oct 20 20:52:43 2021 +0200 ; Fix typo diff --git a/test/src/data-tests.el b/test/src/data-tests.el index 03dfae8cc3..756c41b6ff 100644 --- a/test/src/data-tests.el +++ b/test/src/data-tests.el @@ -757,7 +757,7 @@ comparing the subr with a much slower Lisp implementation." ;; forwarding, but this needs to happen before the var is accessed ;; from the Lisp side and before we switch to another buffer. ;; The trigger in bug#34318 doesn't exist any more because the C code has - ;; changes. Instead I found the trigger below. + ;; changed. Instead I found the trigger below. (with-temp-buffer (setq last-coding-system-used 'bug34318) (make-local-variable 'last-coding-system-used) commit 59df93e2dda0c64ad36d21b600e56857003eed78 Author: Juri Linkov Date: Wed Oct 20 20:54:57 2021 +0300 * lisp/help.el (help--analyze-key): Add new arg BUFFER (bug#51173). * lisp/help.el (describe-key): Use BUFFER as arg for help--analyze-key. (describe-key-briefly): Change arg UNTRANSLATED deprecated in 27.1 to BUFFER. * lisp/gnus/gnus-art.el (gnus-article-describe-key) (gnus-article-describe-key-briefly): Call describe-key and describe-key-briefly with first arg as a cons with raw keys, and the BUFFER arg set to the current buffer. diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el index 7b6e15d6f8..cdef73135c 100644 --- a/lisp/gnus/gnus-art.el +++ b/lisp/gnus/gnus-art.el @@ -6866,7 +6866,9 @@ KEY is a string or a vector." unread-command-events)) (let ((cursor-in-echo-area t) gnus-pick-mode) - (describe-key (read-key-sequence nil t)))) + (describe-key (cons (read-key-sequence nil t) + (this-single-command-raw-keys)) + (current-buffer)))) (describe-key key))) (defun gnus-article-describe-key-briefly (key &optional insert) @@ -6889,7 +6891,9 @@ KEY is a string or a vector." unread-command-events)) (let ((cursor-in-echo-area t) gnus-pick-mode) - (describe-key-briefly (read-key-sequence nil t) insert))) + (describe-key-briefly (cons (read-key-sequence nil t) + (this-single-command-raw-keys)) + insert (current-buffer)))) (describe-key-briefly key insert))) ;;`gnus-agent-mode' in gnus-agent.el will define it. diff --git a/lisp/help.el b/lisp/help.el index 7e2e492a36..92e22aecb5 100644 --- a/lisp/help.el +++ b/lisp/help.el @@ -677,9 +677,11 @@ If INSERT (the prefix arg) is non-nil, insert the message in the buffer." (defun help--binding-undefined-p (defn) (or (null defn) (integerp defn) (equal defn 'undefined))) -(defun help--analyze-key (key untranslated) +(defun help--analyze-key (key untranslated &optional buffer) "Get information about KEY its corresponding UNTRANSLATED events. -Returns a list of the form (BRIEF-DESC DEFN EVENT MOUSE-MSG)." +Returns a list of the form (BRIEF-DESC DEFN EVENT MOUSE-MSG). +When BUFFER is nil, it defaults to the buffer displayed +in the selected window." (if (numberp untranslated) (error "Missing `untranslated'!")) (let* ((event (when (> (length key) 0) @@ -699,9 +701,8 @@ Returns a list of the form (BRIEF-DESC DEFN EVENT MOUSE-MSG)." ;; is selected from the context menu that should describe KEY ;; at the position of mouse click that opened the context menu. ;; When no mouse was involved, don't use `mouse-set-point'. - (defn (if (consp event) - (save-excursion (mouse-set-point event) (key-binding key t)) - (key-binding key t)))) + (defn (if buffer (key-binding key t) + (save-excursion (mouse-set-point event) (key-binding key t))))) ;; Handle the case where we faked an entry in "Select and Paste" menu. (when (and (eq defn nil) (stringp (aref key (1- (length key)))) @@ -731,7 +732,7 @@ Returns a list of the form (BRIEF-DESC DEFN EVENT MOUSE-MSG)." ;; If nothing left, then keep one (the last one). (last info-list))) -(defun describe-key-briefly (&optional key-list insert untranslated) +(defun describe-key-briefly (&optional key-list insert buffer) "Print the name of the functions KEY-LIST invokes. KEY-LIST is a list of pairs (SEQ . RAW-SEQ) of key sequences, where RAW-SEQ is the untranslated form of the key sequence SEQ. @@ -739,8 +740,10 @@ If INSERT (the prefix arg) is non-nil, insert the message in the buffer. While reading KEY-LIST interactively, this command temporarily enables menu items or tool-bar buttons that are disabled to allow getting help -on them." - (declare (advertised-calling-convention (key-list &optional insert) "27.1")) +on them. + +BUFFER is the buffer in which to lookup those keys; it defaults to the +current buffer." (interactive ;; Ignore mouse movement events because it's too easy to miss the ;; message while moving the mouse. @@ -748,15 +751,13 @@ on them." `(,key-list ,current-prefix-arg))) (when (arrayp key-list) ;; Old calling convention, changed - (setq key-list (list (cons key-list - (if (numberp untranslated) - (this-single-command-raw-keys) - untranslated))))) - (let* ((info-list (mapcar (lambda (kr) - (help--analyze-key (car kr) (cdr kr))) - key-list)) - (msg (mapconcat #'car (help--filter-info-list info-list 1) "\n"))) - (if insert (insert msg) (message "%s" msg)))) + (setq key-list (list (cons key-list nil)))) + (with-current-buffer (if (buffer-live-p buffer) buffer (current-buffer)) + (let* ((info-list (mapcar (lambda (kr) + (help--analyze-key (car kr) (cdr kr) buffer)) + key-list)) + (msg (mapconcat #'car (help--filter-info-list info-list 1) "\n"))) + (if insert (insert msg) (message "%s" msg))))) (defun help--key-binding-keymap (key &optional accept-default no-remap position) "Return a keymap holding a binding for KEY within current keymaps. @@ -916,7 +917,7 @@ current buffer." (mapcar (lambda (x) (pcase-let* ((`(,seq . ,raw-seq) x) (`(,brief-desc ,defn ,event ,_mouse-msg) - (help--analyze-key seq raw-seq)) + (help--analyze-key seq raw-seq buffer)) (locus (help--binding-locus seq (event-start event)))) commit cb8b12b56d174e1a7b6e940debb8a9467285ab9e Author: Juri Linkov Date: Wed Oct 20 20:16:57 2021 +0300 Improve docstrings and NEWS item of 'repeat-mode' * lisp/repeat.el (repeat-exit-timeout, repeat-echo-function) (repeat-in-progress, repeat-map): Update docstrings. diff --git a/etc/NEWS b/etc/NEWS index 7031be311e..4caf81d168 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -3219,21 +3219,22 @@ batch mode. * New Modes and Packages in Emacs 28.1 +++ -** New transient mode 'repeat-mode' to allow shorter key sequences. +** New mode 'repeat-mode' to allow shorter key sequences. Type 'M-x repeat-mode RET' to enable this mode. You can then type 'C-x u u' instead of 'C-x u C-x u' to undo many changes, 'C-x o o' instead of 'C-x o C-x o' to switch windows, 'C-x { { } } ^ ^ v v' to resize the selected window interactively, 'M-g n n p p' to navigate -next-error matches. Any other key exits repeat mode and then is -executed normally. 'repeat-exit-key' defines an additional key to -exit mode like 'isearch-exit' ('RET'). The user option -'repeat-exit-timeout' specifies the number of seconds of idle time to -break the repetition chain automatically. With 'repeat-keep-prefix' -you can keep the prefix arg of the previous command. For example, -this can help to reverse the window navigation direction with -e.g. 'C-x o M-- o o'. Also it can help to set a new step with -e.g. 'C-x { C-5 { { {', which will set the window resizing step to 5 -columns. +next-error matches. Any other key exits this temporarily enabled +transient mode that supports shorter keys, and then after exiting +from this mode the default key binding is used for the last typed key. +'repeat-exit-key' defines an additional key to exit mode like +'isearch-exit' ('RET'). The user option 'repeat-exit-timeout' +specifies the number of seconds of idle time to break the repetition +chain automatically. With 'repeat-keep-prefix' you can keep the +prefix arg of the previous command. For example, this can help to +reverse the window navigation direction with e.g. 'C-x o M-- o o'. +Also it can help to set a new step with e.g. 'C-x { C-5 { { {', +which will set the window resizing step to 5 columns. --- ** New themes 'modus-vivendi' and 'modus-operandi'. diff --git a/lisp/repeat.el b/lisp/repeat.el index ee9e14b515..42590b7e6d 100644 --- a/lisp/repeat.el +++ b/lisp/repeat.el @@ -344,8 +344,8 @@ For example, you can set it to like `isearch-exit'." (defcustom repeat-exit-timeout nil "Break the repetition chain of keys after specified timeout. -When a number, exit the repeat mode after idle time of the specified -number of seconds." +When a number, exit the transient repeating mode after idle time +of the specified number of seconds." :type '(choice (const :tag "No timeout to exit repeating sequence" nil) (number :tag "Timeout in seconds to exit repeating")) :group 'convenience @@ -363,7 +363,7 @@ number of seconds." (defcustom repeat-echo-function #'repeat-echo-message "Function to display a hint about available keys. Function is called after every repeatable command with one argument: -a repeating map, or nil after deactivating the repeat mode." +a repeating map, or nil after deactivating the transient repeating mode." :type '(choice (const :tag "Show hints in the echo area" repeat-echo-message) (const :tag "Show indicator in the mode line" @@ -374,11 +374,11 @@ a repeating map, or nil after deactivating the repeat mode." :version "28.1") (defvar repeat-in-progress nil - "Non-nil when the repeating map is active.") + "Non-nil when the repeating transient map is active.") ;;;###autoload (defvar repeat-map nil - "The value of the repeating map for the next command. + "The value of the repeating transient map for the next command. A command called from the map can set it again to the same map when the map can't be set on the command symbol property `repeat-map'.") commit 06fe499614dcb3e13ee795b5aa80ebc8687f2fe2 Author: Juri Linkov Date: Wed Oct 20 19:50:29 2021 +0300 * lisp/tab-bar.el (tab-bar-menu-bar): New command (bug#51247). (tab-bar-format): Rename option 'tab-bar-format-menu-global' to 'tab-bar-format-menu-bar'. (tab-bar-format-menu-bar): Rename from 'tab-bar-format-menu-global'. diff --git a/lisp/tab-bar.el b/lisp/tab-bar.el index 03556919b2..a3316bf449 100644 --- a/lisp/tab-bar.el +++ b/lisp/tab-bar.el @@ -715,7 +715,7 @@ it will display time aligned to the right on the tab bar instead of the mode line. Replacing `tab-bar-format-tabs' with `tab-bar-format-tabs-groups' will group tabs on the tab bar." :type 'hook - :options '(tab-bar-format-menu-global + :options '(tab-bar-format-menu-bar tab-bar-format-history tab-bar-format-tabs tab-bar-format-tabs-groups @@ -730,22 +730,23 @@ of the mode line. Replacing `tab-bar-format-tabs' with :group 'tab-bar :version "28.1") -(defun tab-bar-format-menu-global () - "Produce the Menu button for the tab bar that shows a global menu." - `((add-tab menu-item (propertize "Menu" 'face 'tab-bar-tab-inactive) - (lambda (event) (interactive "e") - (let ((menu (make-sparse-keymap - (propertize "Global Menu" 'hide t)))) - - (run-hooks 'activate-menubar-hook 'menu-bar-update-hook) - (map-keymap (lambda (key binding) - (when (consp binding) - (define-key-after menu (vector key) - (copy-sequence binding)))) - (lookup-key global-map [menu-bar])) - - (popup-menu menu event))) - :help "Global Menu"))) +(defun tab-bar-menu-bar (event) + "Pop up the same menu as displayed by the menu bar. +Used by `tab-bar-format-menu-bar'." + (interactive "e") + (let ((menu (make-sparse-keymap (propertize "Menu Bar" 'hide t)))) + (run-hooks 'activate-menubar-hook 'menu-bar-update-hook) + (map-keymap (lambda (key binding) + (when (consp binding) + (define-key-after menu (vector key) + (copy-sequence binding)))) + (menu-bar-keymap)) + (popup-menu menu event))) + +(defun tab-bar-format-menu-bar () + "Produce the Menu button for the tab bar that shows the menu bar." + `((menu-bar menu-item (propertize "Menu" 'face 'tab-bar-tab-inactive) + tab-bar-menu-bar :help "Menu Bar"))) (defun tab-bar-format-history () "Produce back and forward buttons for the tab bar. commit 8358da9c4c9079b93daffc1aebf3ea5e52b98593 Author: Po Lu Date: Wed Oct 20 15:55:10 2021 +0800 Display a tab bar item as sunken when appropriate When the mouse pointer is pressed on the tab bar, moved out of the tab bar, and moved back in, it would be more appropriate to behave like other programs by displaying the item as sunken. * src/xdisp.c (note_tab_bar_highlight): Display item as sunken if the mouse pointer returns to the tab bar down. diff --git a/src/xdisp.c b/src/xdisp.c index 97ba672178..436153b2ba 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -13861,12 +13861,17 @@ note_tab_bar_highlight (struct frame *f, int x, int y) bool mouse_down_p = false; #ifndef HAVE_NS - /* Mouse is down, but on different tab-bar item? */ + /* Mouse is down, but on different tab-bar item? Or alternatively, + the mouse might've been pressed somewhere we don't know about, + and then have moved onto the tab bar. In this case, + last_tab_bar_item is -1, so we DTRT and behave like other + programs by displaying the item as sunken. */ Display_Info *dpyinfo = FRAME_DISPLAY_INFO (f); mouse_down_p = (gui_mouse_grabbed (dpyinfo) && f == dpyinfo->last_mouse_frame); - if (mouse_down_p && f->last_tab_bar_item != prop_idx) + if (mouse_down_p && f->last_tab_bar_item != prop_idx + && f->last_tab_bar_item != -1) return; #endif draw = mouse_down_p ? DRAW_IMAGE_SUNKEN : DRAW_IMAGE_RAISED; commit 29fdc65860e95a6e1c74147a3d310878080f6118 Author: Po Lu Date: Wed Oct 20 15:36:59 2021 +0800 Fix tab bar item highlight when a mouse click is dropped * src/xdisp.c (note_mouse_highlight): Clear last_tab_bar_item if the movement wasn't made on top of the tab bar. diff --git a/src/xdisp.c b/src/xdisp.c index 67946a56b4..97ba672178 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -33652,6 +33652,14 @@ note_mouse_highlight (struct frame *f, int x, int y) else return; } + else + { + /* The mouse might have pressed into the tab bar, but might + also have been released outside the tab bar, so + f->last_tab_bar_item must be reset, in order to make sure the + item can be still highlighted again in the future. */ + f->last_tab_bar_item = -1; + } #endif #if defined (HAVE_WINDOW_SYSTEM) && ! defined (HAVE_EXT_TOOL_BAR) commit 72365926685089791f97968b63b3632807abbdff Author: Stefan Kangas Date: Wed Oct 20 16:53:44 2021 +0200 Refer to mouse-highlight from make-pointer-invisible docstring * src/frame.c (syms_of_frame) : Doc fix; add reference to 'mouse-highlight'. (Bug#42889) diff --git a/src/frame.c b/src/frame.c index f95566818a..2b1cb452ef 100644 --- a/src/frame.c +++ b/src/frame.c @@ -6238,7 +6238,10 @@ when the mouse is over clickable text. */); DEFVAR_LISP ("make-pointer-invisible", Vmake_pointer_invisible, doc: /* If non-nil, make mouse pointer invisible while typing. -The pointer becomes visible again when the mouse is moved. */); +The pointer becomes visible again when the mouse is moved. + +When using this, you might also want to disable highlighting of +clickable text. See `mouse-highlight'. */); Vmake_pointer_invisible = Qt; DEFVAR_LISP ("move-frame-functions", Vmove_frame_functions, commit cf4394a397827ce7c21e47b872f0cd82408d555e Author: Robert Pluim Date: Wed Oct 20 18:27:36 2021 +0200 * etc/PROBLEMS: Add hex codepoint for NO-BREAK SPACE diff --git a/etc/PROBLEMS b/etc/PROBLEMS index 2d3bc0c940..ede83a6e7c 100644 --- a/etc/PROBLEMS +++ b/etc/PROBLEMS @@ -775,7 +775,7 @@ same version of FontConfig as the rest of the system uses. For KDE, it is sufficient to recompile Qt. *** Some fonts have a missing glyph and no default character. This is -known to occur for character number 160 (no-break space) in some +known to occur for character number 160 (no-break space, U+A0) in some fonts, such as Lucida but Emacs sets the display table for the unibyte and Latin-1 version of this character to display a space. commit 2d647e88faeb53c15d00e2198da480dbd540a4ec Author: Robert Pluim Date: Wed Oct 20 18:22:40 2021 +0200 Describe how to debug fontconfig issues * etc/PROBLEMS: Add FC_DEBUG usage pointers. diff --git a/etc/PROBLEMS b/etc/PROBLEMS index f396dc3a00..2d3bc0c940 100644 --- a/etc/PROBLEMS +++ b/etc/PROBLEMS @@ -751,6 +751,18 @@ Try removing or moving aside "$XDG_CONFIG_HOME/fontconfig/conf.d" and "$XDG_CONFIG_HOME/fontconfig/fonts.conf" ($XDG_CONFIG_HOME is treated as "~/.config" if not set) +Running Emacs as + + FC_DEBUG=1024 emacs + +will cause fontconfig to output information about which configuration +files it is reading. Running Emacs as + + FC_DEBUG=1 emacs + +will result in information about the results of fontconfig's font +matching (including the filename(s) of the resulting fonts). + *** This can occur when two different versions of FontConfig are used. For example, XFree86 4.3.0 has one version and Gnome usually comes with a newer version. Emacs compiled with Gtk+ will then use the commit c9160409218bd8d96b8d5180719b77708917e315 Author: Michael Albinus Date: Wed Oct 20 18:14:00 2021 +0200 Adapt Tramp tests * test/lisp/net/tramp-archive-tests.el (tramp-archive-test45-auto-load): Adapt code snippet. * test/lisp/net/tramp-tests.el (tramp-test29-start-file-process) (tramp-test30-make-process): Adapt tests. (tramp--test-supports-set-file-modes-p): Renamed from `tramp--test-supports-file-modes-p'. Adapt all callees. (tramp-test35-exec-path): Use it. diff --git a/test/lisp/net/tramp-archive-tests.el b/test/lisp/net/tramp-archive-tests.el index aac1b13bd0..98012f4e90 100644 --- a/test/lisp/net/tramp-archive-tests.el +++ b/test/lisp/net/tramp-archive-tests.el @@ -923,9 +923,10 @@ This tests also `file-executable-p', `file-writable-p' and `set-file-modes'." "(progn \ (message \"tramp-archive loaded: %%s\" \ (featurep 'tramp-archive)) \ - (file-attributes %S \"/\") \ + (let ((inhibit-message t)) \ + (file-attributes %S \"/\")) \ (message \"tramp-archive loaded: %%s\" \ - (featurep 'tramp-archive)))")) + (featurep 'tramp-archive))))")) (dolist (default-directory `(,temporary-file-directory ;; Starting Emacs in a directory which has diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 0ad50144dc..d50111d404 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -2786,7 +2786,7 @@ This tests also `file-directory-p' and `file-accessible-directory-p'." :type 'file-already-exists) (should (file-directory-p tmp-name1)) (should (file-accessible-directory-p tmp-name1)) - (when (tramp--test-supports-file-modes-p) + (when (tramp--test-supports-set-file-modes-p) (should (equal (format "%#o" unusual-file-mode-1) (format "%#o" (file-modes tmp-name1))))) (should-error @@ -2796,7 +2796,7 @@ This tests also `file-directory-p' and `file-accessible-directory-p'." (make-directory tmp-name2 'parents)) (should (file-directory-p tmp-name2)) (should (file-accessible-directory-p tmp-name2)) - (when (tramp--test-supports-file-modes-p) + (when (tramp--test-supports-set-file-modes-p) (should (equal (format "%#o" unusual-file-mode-2) (format "%#o" (file-modes tmp-name2))))) ;; If PARENTS is non-nil, `make-directory' shall not @@ -3160,7 +3160,7 @@ This tests also `file-directory-p' and `file-accessible-directory-p'." (length (directory-files tmp-name1))))))) ;; Check error cases. - (when (and (tramp--test-supports-file-modes-p) + (when (and (tramp--test-supports-set-file-modes-p) ;; With "sshfs", directories with zero file ;; modes are still "accessible". (not (tramp--test-sshfs-p)) @@ -3385,7 +3385,7 @@ This tests also `access-file', `file-readable-p', (tramp-get-remote-gid tramp-test-vec 'integer))) (delete-file tmp-name1)) - (when (and (tramp--test-supports-file-modes-p) + (when (and (tramp--test-supports-set-file-modes-p) ;; A file is always accessible for user "root". (not (zerop (tramp-compat-file-attribute-user-id (file-attributes @@ -3628,7 +3628,8 @@ They might differ only in time attributes or directory size." "Check `file-modes'. This tests also `file-executable-p', `file-writable-p' and `set-file-modes'." (skip-unless (tramp--test-enabled)) - (skip-unless (tramp--test-supports-file-modes-p)) + (skip-unless (tramp--test-supports-set-file-modes-p)) + (dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil))) (let ((tmp-name1 (tramp--test-make-temp-name nil quoted)) (tmp-name2 (tramp--test-make-temp-name nil quoted))) @@ -3963,7 +3964,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (make-symbolic-link tmp-name2 tmp-name1) (should (file-symlink-p tmp-name1)) (if (tramp--test-smb-p) - ;; The symlink command of `smbclient' detects the + ;; The symlink command of "smbclient" detects the ;; cycle already. (should-error (make-symbolic-link tmp-name1 tmp-name2) @@ -4074,6 +4075,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (ert-deftest tramp-test24-file-acl () "Check that `file-acl' and `set-file-acl' work proper." (skip-unless (tramp--test-enabled)) + ;; The following test checks also whether `set-file-modes' will work. (skip-unless (file-acl tramp-test-temporary-file-directory)) (skip-unless (not (tramp--test-crypt-p))) @@ -4484,7 +4486,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (write-region "foo" nil tmp-name) (should (file-exists-p tmp-name)) (should (zerop (process-file "ls" nil t nil fnnd))) - ;; `ls' could produce colorized output. + ;; "ls" could produce colorized output. (goto-char (point-min)) (while (re-search-forward tramp-display-escape-sequence-regexp nil t) @@ -4495,7 +4497,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." ;; Second run. The output must be appended. (goto-char (point-max)) (should (zerop (process-file "ls" nil t t fnnd))) - ;; `ls' could produce colorized output. + ;; "ls" could produce colorized output. (goto-char (point-min)) (while (re-search-forward tramp-display-escape-sequence-regexp nil t) @@ -4508,7 +4510,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." ;; Cleanup. (ignore-errors (delete-file tmp-name)))))) -;; Must be a command, because used as `sigusr' handler. +;; Must be a command, because used as `sigusr1' handler. (defun tramp--test-timeout-handler (&rest _ignore) "Timeout handler, reporting a failed test." (interactive) @@ -4588,8 +4590,8 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." ;; Cleanup. (ignore-errors (delete-process proc))) - ;; `telnet' does not cooperate with disabled filter. - (unless (tramp--test-telnet-p) + ;; "telnet" and "sshfs" do not cooperate with disabled filter. + (unless (or (tramp--test-telnet-p) (tramp--test-sshfs-p)) (unwind-protect (with-temp-buffer (setq proc (start-file-process "test3" (current-buffer) "cat")) @@ -4638,7 +4640,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (if (and (memq process-connection-type '(nil pipe)) (not (tramp--test-macos-p))) ;; On macOS, there is always newline conversion. - ;; `telnet' converts \r to if `crlf' + ;; "telnet" converts \r to if `crlf' ;; flag is FALSE. See telnet(1) man page. "66\n6F\n6F\n0D\\(\n00\\)?\n0A\n" "66\n6F\n6F\n0A\\(\n00\\)?\n0A\n") @@ -4781,8 +4783,8 @@ If UNSTABLE is non-nil, the test is tagged as `:unstable'." ;; Cleanup. (ignore-errors (delete-process proc))) - ;; `telnet' does not cooperate with disabled filter. - (unless (tramp--test-telnet-p) + ;; "telnet" and "sshfs" do not cooperate with disabled filter. + (unless (or (tramp--test-telnet-p) (tramp--test-sshfs-p)) (unwind-protect (with-temp-buffer (setq proc @@ -4830,7 +4832,7 @@ If UNSTABLE is non-nil, the test is tagged as `:unstable'." ;; Cleanup. (ignore-errors (delete-process proc))) - ;; Process with stderr buffer. `telnet' does not cooperate with + ;; Process with stderr buffer. "telnet" does not cooperate with ;; three processes. (unless (or (tramp--test-telnet-p) (tramp-direct-async-process-p)) (let ((stderr (generate-new-buffer "*stderr*"))) @@ -4930,7 +4932,7 @@ If UNSTABLE is non-nil, the test is tagged as `:unstable'." '(nil pipe)) (not (tramp--test-macos-p))) ;; On macOS, there is always newline conversion. - ;; `telnet' converts \r to if `crlf' + ;; "telnet" converts \r to if `crlf' ;; flag is FALSE. See telnet(1) man page. "66\n6F\n6F\n0D\\(\n00\\)?\n0A\n" "66\n6F\n6F\n0A\\(\n00\\)?\n0A\n") @@ -5034,7 +5036,7 @@ INPUT, if non-nil, is a string sent to the process." this-shell-command (format "ls %s" (file-name-nondirectory tmp-name)) (current-buffer)) - ;; `ls' could produce colorized output. + ;; "ls" could produce colorized output. (goto-char (point-min)) (while (re-search-forward tramp-display-escape-sequence-regexp nil t) @@ -5489,8 +5491,7 @@ Use direct async.") (ert-deftest tramp-test35-exec-path () "Check `exec-path' and `executable-find'." (skip-unless (tramp--test-enabled)) - (skip-unless (or (tramp--test-adb-p) (tramp--test-sh-p) (tramp--test-sshfs-p))) - (skip-unless (not (tramp--test-crypt-p))) + (skip-unless (tramp--test-supports-set-file-modes-p)) ;; Since Emacs 27.1. (skip-unless (fboundp 'exec-path)) @@ -5511,6 +5512,7 @@ Use direct async.") ;; found. (write-region "foo" nil tmp-name) (should (file-exists-p tmp-name)) + (set-file-modes tmp-name #o777) (should (file-executable-p tmp-name)) (should @@ -6268,8 +6270,8 @@ This requires restrictions of file name syntax." This requires restrictions of file name syntax." (tramp-smb-file-name-p tramp-test-temporary-file-directory)) -(defun tramp--test-supports-file-modes-p () - "Return whether the method under test supports file modes." +(defun tramp--test-supports-set-file-modes-p () + "Return whether the method under test supports setting file modes." ;; "smb" does not unless the SMB server supports "posix" extensions. ;; "adb" does not unless the Android device is rooted. (or (tramp--test-sh-p) (tramp--test-sshfs-p) (tramp--test-sudoedit-p) @@ -6372,9 +6374,9 @@ This requires restrictions of file name syntax." (kill-buffer buffer) ;; `substitute-in-file-name' could return different - ;; values. For `adb', there could be strange file + ;; values. For "adb", there could be strange file ;; permissions preventing overwriting a file. We don't - ;; care in this testcase. + ;; care in this test case. (dolist (elt files) (let ((file1 (substitute-in-file-name (expand-file-name elt tmp-name1))) @@ -6540,7 +6542,7 @@ This requires restrictions of file name syntax." (ert-deftest tramp-test41-special-characters-with-stat () "Check special characters in file names. -Use the `stat' command." +Use the \"stat\" command." :tags '(:expensive-test) (skip-unless (not (getenv "EMACS_HYDRA_CI"))) ; SLOW ~ 287s (skip-unless (tramp--test-enabled)) @@ -6559,7 +6561,7 @@ Use the `stat' command." (ert-deftest tramp-test41-special-characters-with-perl () "Check special characters in file names. -Use the `perl' command." +Use the \"perl\" command." :tags '(:expensive-test) (skip-unless (not (getenv "EMACS_HYDRA_CI"))) ; SLOW ~ 266s (skip-unless (tramp--test-enabled)) @@ -6581,7 +6583,7 @@ Use the `perl' command." (ert-deftest tramp-test41-special-characters-with-ls () "Check special characters in file names. -Use the `ls' command." +Use the \"ls\" command." :tags '(:expensive-test) (skip-unless (not (getenv "EMACS_HYDRA_CI"))) ; SLOW ~ 287s (skip-unless (tramp--test-enabled)) @@ -6663,7 +6665,7 @@ Use the `ls' command." (ert-deftest tramp-test42-utf8-with-stat () "Check UTF8 encoding in file names and file contents. -Use the `stat' command." +Use the \"stat\" command." :tags '(:expensive-test) (skip-unless (not (getenv "EMACS_HYDRA_CI"))) ; SLOW ~ 595s (skip-unless (tramp--test-enabled)) @@ -6686,7 +6688,7 @@ Use the `stat' command." (ert-deftest tramp-test42-utf8-with-perl () "Check UTF8 encoding in file names and file contents. -Use the `perl' command." +Use the \"perl\" command." :tags '(:expensive-test) (skip-unless (not (getenv "EMACS_HYDRA_CI"))) ; SLOW ~ 620s (skip-unless (tramp--test-enabled)) @@ -6712,7 +6714,7 @@ Use the `perl' command." (ert-deftest tramp-test42-utf8-with-ls () "Check UTF8 encoding in file names and file contents. -Use the `ls' command." +Use the \"ls\" command." :tags '(:expensive-test) (skip-unless (not (getenv "EMACS_HYDRA_CI"))) ; SLOW ~ 690s (skip-unless (tramp--test-enabled)) @@ -7185,8 +7187,8 @@ If INTERACTIVE is non-nil, the tests are run interactively." ;; * Work on skipped tests. Make a comment, when it is impossible. ;; * Revisit expensive tests, once problems in `tramp-error' are solved. -;; * Fix `tramp-test06-directory-file-name' for `ftp'. -;; * Implement `tramp-test31-interrupt-process' for `adb', `sshfs' and +;; * Fix `tramp-test06-directory-file-name' for "ftp". +;; * Implement `tramp-test31-interrupt-process' for "adb", "sshfs" and ;; for direct async processes. ;; * Check, why direct async processes do not work for ;; `tramp-test44-asynchronous-requests'. commit 5f5189e9be6c70c4db99e8057287d16955b9c620 Author: Robert Pluim Date: Wed Oct 20 11:58:07 2021 +0200 ; * etc/NEWS: fix typos diff --git a/etc/NEWS b/etc/NEWS index 84e2121086..f9fe72e91f 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -107,10 +107,10 @@ delimiter in the echo area. --- *** Alignment in 'text-mode' has changed. -Previously, 'M-x align' didn't do anything, and you have to say 'C-u +Previously, 'M-x align' didn't do anything, and you had to say 'C-u M-x align' for it to work. This has now been changed. The default -for regexp for 'C-u M-x align-regexp' has also been changed to be -easier for inexperienced users to use. +regexp for 'C-u M-x align-regexp' has also been changed to be easier +for inexperienced users to use. ** eww commit c1359abc96df3df245361645a3550e6c5ba46b6e Author: Lars Ingebrigtsen Date: Wed Oct 20 11:49:22 2021 +0200 Fix typo in previous smerge-mode-map change * lisp/vc/smerge-mode.el (smerge-mode-map): Fix typo (bug#51303). diff --git a/lisp/vc/smerge-mode.el b/lisp/vc/smerge-mode.el index 0be1a03c65..2cc5ee739f 100644 --- a/lisp/vc/smerge-mode.el +++ b/lisp/vc/smerge-mode.el @@ -170,7 +170,7 @@ Used in `smerge-diff-base-upper' and related functions." string)) (defvar-keymap smerge-mode-map - smerge-command-prefix 'smerge-basic-map) + smerge-command-prefix smerge-basic-map) (defvar-local smerge-check-cache nil) (defun smerge-check (n) commit 1bb14f93f128b0e70e84b142d1b9a8ae1532a3ed Author: Jim Porter Date: Tue Oct 19 16:01:15 2021 -0700 Convert ANSI color definitions in themes to use faces (e.g. 'ansi-color-red') * etc/themes/dichromacy-theme.el: * etc/themes/leuven-theme.el: * etc/themes/misterioso-theme.el: * etc/themes/tango-theme.el: * etc/themes/tango-dark-theme.el: * etc/themes/wombat-theme.el: Convert ANSI color definitions to use faces. diff --git a/etc/themes/dichromacy-theme.el b/etc/themes/dichromacy-theme.el index 09f4454f9b..c59b24bef5 100644 --- a/etc/themes/dichromacy-theme.el +++ b/etc/themes/dichromacy-theme.el @@ -113,12 +113,34 @@ Ansi-Color faces are included.") `(flyspell-duplicate ((,class (:weight unspecified :foreground unspecified :slant unspecified :underline ,orange)))) `(flyspell-incorrect ((,class (:weight unspecified :foreground unspecified - :slant unspecified :underline ,redpurple))))) - - (custom-theme-set-variables - 'dichromacy - `(ansi-color-names-vector ["black" ,vermillion ,bluegreen ,yellow - ,blue ,redpurple ,skyblue "white"]))) + :slant unspecified :underline ,redpurple)))) + ;; ANSI color + `(ansi-color-black ((,class (:background "black" :foreground "black")))) + `(ansi-color-red ((,class (:background ,vermillion + :foreground ,vermillion)))) + `(ansi-color-green ((,class (:background ,bluegreen + :foreground ,bluegreen)))) + `(ansi-color-yellow ((,class (:background ,yellow :foreground ,yellow)))) + `(ansi-color-blue ((,class (:background ,blue :foreground ,blue)))) + `(ansi-color-magenta ((,class (:background ,redpurple + :foreground ,redpurple)))) + `(ansi-color-cyan ((,class (:background ,skyblue :foreground ,skyblue)))) + `(ansi-color-white ((,class (:background "gray90" :foreground "gray90")))) + `(ansi-color-bright-black ((,class (:background "black" + :foreground "black")))) + `(ansi-color-bright-red ((,class (:background ,vermillion + :foreground ,vermillion)))) + `(ansi-color-bright-green ((,class (:background ,bluegreen + :foreground ,bluegreen)))) + `(ansi-color-bright-yellow ((,class (:background ,yellow + :foreground ,yellow)))) + `(ansi-color-bright-blue ((,class (:background ,blue :foreground ,blue)))) + `(ansi-color-bright-magenta ((,class (:background ,redpurple + :foreground ,redpurple)))) + `(ansi-color-bright-cyan ((,class (:background ,skyblue + :foreground ,skyblue)))) + `(ansi-color-bright-white ((,class (:background "gray90" + :foreground "gray90")))))) (provide-theme 'dichromacy) diff --git a/etc/themes/leuven-theme.el b/etc/themes/leuven-theme.el index f643dd560c..95ec303f70 100644 --- a/etc/themes/leuven-theme.el +++ b/etc/themes/leuven-theme.el @@ -287,6 +287,25 @@ more...") `(message-header-xheader ((,class ,mail-header-other))) `(message-mml ((,class (:foreground "forest green")))) + ;; ANSI colors. + `(ansi-color-bold ((,class (:weight bold)))) + `(ansi-color-black ((,class (:foreground "black" :background "black")))) + `(ansi-color-red ((,class (:foreground "red3" :background "red3")))) + `(ansi-color-green ((,class (:foreground "forest green" :background "forest green")))) + `(ansi-color-yellow ((,class (:foreground "yellow3" :background "yellow3")))) + `(ansi-color-blue ((,class (:foreground "blue" :background "blue")))) + `(ansi-color-magenta ((,class (:foreground "magenta3" :background "magenta3")))) + `(ansi-color-cyan ((,class (:foreground "deep sky blue" :background "deep sky blue")))) + `(ansi-color-white ((,class (:foreground "gray60" :background "gray60")))) + `(ansi-color-bright-black ((,class (:foreground "gray30" :background "gray30")))) + `(ansi-color-bright-red ((,class (:foreground "red1" :background "red1")))) + `(ansi-color-bright-green ((,class (:foreground "lime green" :background "lime green")))) + `(ansi-color-bright-yellow ((,class (:foreground "yellow2" :background "yellow2")))) + `(ansi-color-bright-blue ((,class (:foreground "dodger blue" :background "dodger blue")))) + `(ansi-color-bright-magenta ((,class (:foreground "magenta" :background "magenta")))) + `(ansi-color-bright-cyan ((,class (:foreground "sky blue" :background "sky blue")))) + `(ansi-color-bright-white ((,class (:foreground "gray80" :background "gray80")))) + ;; Diff. `(diff-added ((,class ,diff-added))) `(diff-changed ((,class ,diff-changed))) @@ -1035,12 +1054,6 @@ more...") ;; highlight-sexp-mode. '(hl-sexp-background-color "#efebe9") - '(ansi-color-faces-vector - [default default default italic underline success warning error]) - - ;; Colors used in Shell mode. - '(ansi-color-names-vector - ["black" "red3" "ForestGreen" "yellow3" "blue" "magenta3" "DeepSkyBlue" "gray50"]) ) ;;;###autoload diff --git a/etc/themes/misterioso-theme.el b/etc/themes/misterioso-theme.el index e7a66c5650..26a5946d30 100644 --- a/etc/themes/misterioso-theme.el +++ b/etc/themes/misterioso-theme.el @@ -101,12 +101,33 @@ `(message-header-subject ((,class (:foreground "#dbdb95")))) `(message-header-to ((,class (:foreground "#00ede1")))) `(message-cited-text ((,class (:foreground "#74af68")))) - `(message-separator ((,class (:foreground "#23d7d7")))))) - -(custom-theme-set-variables - 'misterioso - '(ansi-color-names-vector ["#2d3743" "#ff4242" "#74af68" "#dbdb95" - "#34cae2" "#008b8b" "#00ede1" "#e1e1e0"])) + `(message-separator ((,class (:foreground "#23d7d7")))) + ;; ANSI colors + `(ansi-color-black ((,class (:background "#2d3743" :foreground "#2d3743")))) + `(ansi-color-red ((,class (:background "#da3938" :foreground "#da3938")))) + `(ansi-color-green ((,class (:background "#74af68" :foreground "#74af68")))) + `(ansi-color-yellow ((,class (:background "#dbdb95" :foreground "#dbdb95")))) + `(ansi-color-blue ((,class (:background "#34cae2" :foreground "#34cae2")))) + `(ansi-color-magenta ((,class (:background "#b33c97" + :foreground "#b33c97")))) + `(ansi-color-cyan ((,class (:background "#008b8b" :foreground "#008b8b")))) + `(ansi-color-white ((,class (:background "#e1e1e0" :foreground "#e1e1e0")))) + `(ansi-color-bright-black ((,class (:background "#415160" + :foreground "#415160")))) + `(ansi-color-bright-red ((,class (:background "#ff4242" + :foreground "#ff4242")))) + `(ansi-color-bright-green ((,class (:background "#74cd65" + :foreground "#74cd65")))) + `(ansi-color-bright-yellow ((,class (:background "#ffad29" + :foreground "#ffad29")))) + `(ansi-color-bright-blue ((,class (:background "#59e9ff" + :foreground "#59e9ff")))) + `(ansi-color-bright-magenta ((,class (:background "#ed74cd" + :foreground "#ed74cd")))) + `(ansi-color-bright-cyan ((,class (:background "#00ede1" + :foreground "#00ede1")))) + `(ansi-color-bright-white ((,class (:background "#eeeeec" + :foreground "#eeeeec")))))) (provide-theme 'misterioso) diff --git a/etc/themes/tango-dark-theme.el b/etc/themes/tango-dark-theme.el index 1a33676eba..fe4a24746e 100644 --- a/etc/themes/tango-dark-theme.el +++ b/etc/themes/tango-dark-theme.el @@ -45,7 +45,9 @@ Semantic, and Ansi-Color faces are included.") (alum-4 "#888a85") (alum-5 "#555753") (alum-6 "#2e3436") ;; Not in Tango palette; used for better contrast. (cham-0 "#b4fa70") (blue-0 "#8cc4ff") (plum-0 "#e9b2e3") - (red-0 "#ff4b4b") (alum-5.5 "#41423f") (alum-7 "#212526")) + (red-0 "#ff4b4b") (alum-5.5 "#41423f") (alum-7 "#212526") + ;; Not in Tango palette; used for ANSI cyan. + (cyan-1 "#34e2e2") (cyan-2 "#06989a")) (custom-theme-set-faces 'tango-dark @@ -162,12 +164,31 @@ Semantic, and Ansi-Color faces are included.") `(semantic-decoration-on-unparsed-includes ((,class (:background ,alum-5.5)))) `(semantic-tag-boundary-face ((,class (:overline ,blue-1)))) - `(semantic-unmatched-syntax-face ((,class (:underline ,red-1))))) - - (custom-theme-set-variables - 'tango-dark - `(ansi-color-names-vector [,alum-7 ,red-0 ,cham-0 ,butter-1 - ,blue-1 ,plum-1 ,blue-0 ,alum-1]))) + `(semantic-unmatched-syntax-face ((,class (:underline ,red-1)))) + ;; ANSI colors + `(ansi-color-black ((,class (:background ,alum-7 :foreground ,alum-7)))) + `(ansi-color-red ((,class (:background ,red-1 :foreground ,red-1)))) + `(ansi-color-green ((,class (:background ,cham-2 :foreground ,cham-2)))) + `(ansi-color-yellow ((,class (:background ,butter-2 :foreground ,butter-2)))) + `(ansi-color-blue ((,class (:background ,blue-2 :foreground ,blue-2)))) + `(ansi-color-magenta ((,class (:background ,plum-1 :foreground ,plum-1)))) + `(ansi-color-cyan ((,class (:background ,cyan-2 :foreground ,cyan-2)))) + `(ansi-color-white ((,class (:background ,alum-2 :foreground ,alum-2)))) + `(ansi-color-bright-black ((,class (:background ,alum-5 + :foreground ,alum-5)))) + `(ansi-color-bright-red ((,class (:background ,red-0 :foreground ,red-0)))) + `(ansi-color-bright-green ((,class (:background ,cham-1 + :foreground ,cham-1)))) + `(ansi-color-bright-yellow ((,class (:background ,butter-1 + :foreground ,butter-1)))) + `(ansi-color-bright-blue ((,class (:background ,blue-0 + :foreground ,blue-0)))) + `(ansi-color-bright-magenta ((,class (:background ,plum-0 + :foreground ,plum-0)))) + `(ansi-color-bright-cyan ((,class (:background ,cyan-1 + :foreground ,cyan-1)))) + `(ansi-color-bright-white ((,class (:background ,alum-1 + :foreground ,alum-1)))))) (provide-theme 'tango-dark) diff --git a/etc/themes/tango-theme.el b/etc/themes/tango-theme.el index 9ee2619ce2..5c429b0b70 100644 --- a/etc/themes/tango-theme.el +++ b/etc/themes/tango-theme.el @@ -44,7 +44,9 @@ Semantic, and Ansi-Color faces are included.") (alum-1 "#eeeeec") (alum-2 "#d3d7cf") (alum-3 "#babdb6") (alum-4 "#888a85") (alum-5 "#5f615c") (alum-6 "#2e3436") ;; Not in Tango palette; used for better contrast. - (cham-4 "#346604") (blue-0 "#8cc4ff") (orange-4 "#b35000")) + (cham-4 "#346604") (blue-0 "#8cc4ff") (orange-4 "#b35000") + ;; Not in Tango palette; used for ANSI cyan. + (cyan-1 "#34e2e2") (cyan-2 "#06989a")) (custom-theme-set-faces 'tango @@ -145,12 +147,31 @@ Semantic, and Ansi-Color faces are included.") `(semantic-decoration-on-unparsed-includes ((,class (:underline ,orange-3)))) `(semantic-tag-boundary-face ((,class (:overline ,blue-1)))) - `(semantic-unmatched-syntax-face ((,class (:underline ,red-1))))) - - (custom-theme-set-variables - 'tango - `(ansi-color-names-vector [,alum-6 ,red-3 ,cham-3 ,butter-3 - ,blue-3 ,plum-3 ,blue-1 ,alum-1]))) + `(semantic-unmatched-syntax-face ((,class (:underline ,red-1)))) + ;; ANSI colors + `(ansi-color-black ((,class (:background ,alum-6 :foreground ,alum-6)))) + `(ansi-color-red ((,class (:background ,red-2 :foreground ,red-2)))) + `(ansi-color-green ((,class (:background ,cham-3 :foreground ,cham-3)))) + `(ansi-color-yellow ((,class (:background ,butter-3 :foreground ,butter-3)))) + `(ansi-color-blue ((,class (:background ,blue-2 :foreground ,blue-2)))) + `(ansi-color-magenta ((,class (:background ,plum-2 :foreground ,plum-2)))) + `(ansi-color-cyan ((,class (:background ,cyan-2 :foreground ,cyan-2)))) + `(ansi-color-white ((,class (:background ,alum-2 :foreground ,alum-2)))) + `(ansi-color-bright-black ((,class (:background ,alum-5 + :foreground ,alum-5)))) + `(ansi-color-bright-red ((,class (:background ,red-1 :foreground ,red-1)))) + `(ansi-color-bright-green ((,class (:background ,cham-1 + :foreground ,cham-1)))) + `(ansi-color-bright-yellow ((,class (:background ,butter-1 + :foreground ,butter-1)))) + `(ansi-color-bright-blue ((,class (:background ,blue-1 + :foreground ,blue-1)))) + `(ansi-color-bright-magenta ((,class (:background ,plum-1 + :foreground ,plum-1)))) + `(ansi-color-bright-cyan ((,class (:background ,cyan-1 + :foreground ,cyan-1)))) + `(ansi-color-bright-white ((,class (:background ,alum-1 + :foreground ,alum-1)))))) (provide-theme 'tango) diff --git a/etc/themes/wombat-theme.el b/etc/themes/wombat-theme.el index 922114fb64..d769c33721 100644 --- a/etc/themes/wombat-theme.el +++ b/etc/themes/wombat-theme.el @@ -95,12 +95,24 @@ are included.") `(message-header-subject ((,class (:foreground "#cae682")))) `(message-header-to ((,class (:foreground "#cae682")))) `(message-cited-text ((,class (:foreground "#99968b")))) - `(message-separator ((,class (:foreground "#e5786d" :weight bold)))))) - -(custom-theme-set-variables - 'wombat - '(ansi-color-names-vector ["#242424" "#e5786d" "#95e454" "#cae682" - "#8ac6f2" "#333366" "#ccaa8f" "#f6f3e8"])) + `(message-separator ((,class (:foreground "#e5786d" :weight bold)))) + ;; ANSI colors + `(ansi-color-black ((,class (:background "#242424" :foreground "#242424")))) + `(ansi-color-red ((,class (:background "#b85149" :foreground "#b85149")))) + `(ansi-color-green ((,class (:background "#92a65e" :foreground "#92a65e")))) + `(ansi-color-yellow ((,class (:background "#ccaa8f" :foreground "#ccaa8f")))) + `(ansi-color-blue ((,class (:background "#5b98c2" :foreground "#5b98c2")))) + `(ansi-color-magenta ((,class (:background "#64619a" :foreground "#64619a")))) + `(ansi-color-cyan ((,class (:background "#3f9f9e" :foreground "#3f9f9e")))) + `(ansi-color-white ((,class (:background "#f6f3e8" :foreground "#f6f3e8")))) + `(ansi-color-bright-black ((,class (:background "#444444" :foreground "#444444")))) + `(ansi-color-bright-red ((,class (:background "#e5786d" :foreground "#e5786d")))) + `(ansi-color-bright-green ((,class (:background "#95e454" :foreground "#95e454")))) + `(ansi-color-bright-yellow ((,class (:background "#edc4a3" :foreground "#edc4a3")))) + `(ansi-color-bright-blue ((,class (:background "#8ac6f2" :foreground "#8ac6f2")))) + `(ansi-color-bright-magenta ((,class (:background "#a6a1de" :foreground "#a6a1de")))) + `(ansi-color-bright-cyan ((,class (:background "#70cecc" :foreground "#70cecc")))) + `(ansi-color-bright-white ((,class (:background "#ffffff" :foreground "#ffffff")))))) (provide-theme 'wombat) commit 7a6cc97f3c2fe8c01ac71e39514a73c0674b9061 Author: Miha Rihtaršič Date: Tue Oct 19 18:41:13 2021 +0200 Avoid excessive specbinding in all-completions * src/minibuf.c (match_regexps): (Ftry_completion): (Fall_completions): (Ftest_completion): Use fast_string_match_internal to match against regexps in completion-regexp-list without having to bind case-fold-search. diff --git a/src/minibuf.c b/src/minibuf.c index 0dc340e967..6c0cd358c5 100644 --- a/src/minibuf.c +++ b/src/minibuf.c @@ -1545,6 +1545,27 @@ minibuf_conform_representation (Lisp_Object string, Lisp_Object basis) return Fstring_make_multibyte (string); } +static bool +match_regexps (Lisp_Object string, Lisp_Object regexps, + bool ignore_case) +{ + ptrdiff_t val; + for (; CONSP (regexps); regexps = XCDR (regexps)) + { + CHECK_STRING (XCAR (regexps)); + + val = fast_string_match_internal + (XCAR (regexps), string, + (ignore_case ? BVAR (current_buffer, case_canon_table) : Qnil)); + + if (val == -2) + error ("Stack overflow in regexp matcher"); + if (val < 0) + return false; + } + return true; +} + DEFUN ("try-completion", Ftry_completion, Stry_completion, 2, 3, 0, doc: /* Return common substring of all completions of STRING in COLLECTION. Test each possible completion specified by COLLECTION @@ -1578,6 +1599,7 @@ Additionally to this predicate, `completion-regexp-list' is used to further constrain the set of candidates. */) (Lisp_Object string, Lisp_Object collection, Lisp_Object predicate) { + Lisp_Object bestmatch, tail, elt, eltstring; /* Size in bytes of BESTMATCH. */ ptrdiff_t bestmatchsize = 0; @@ -1591,7 +1613,6 @@ is used to further constrain the set of candidates. */) ? list_table : function_table)); ptrdiff_t idx = 0, obsize = 0; int matchcount = 0; - ptrdiff_t bindcount = -1; Lisp_Object bucket, zero, end, tem; CHECK_STRING (string); @@ -1670,27 +1691,10 @@ is used to further constrain the set of candidates. */) completion_ignore_case ? Qt : Qnil), EQ (Qt, tem))) { - /* Yes. */ - Lisp_Object regexps; - /* Ignore this element if it fails to match all the regexps. */ - { - for (regexps = Vcompletion_regexp_list; CONSP (regexps); - regexps = XCDR (regexps)) - { - if (bindcount < 0) - { - bindcount = SPECPDL_INDEX (); - specbind (Qcase_fold_search, - completion_ignore_case ? Qt : Qnil); - } - tem = Fstring_match (XCAR (regexps), eltstring, zero, Qnil); - if (NILP (tem)) - break; - } - if (CONSP (regexps)) - continue; - } + if (!match_regexps (eltstring, Vcompletion_regexp_list, + completion_ignore_case)) + continue; /* Ignore this element if there is a predicate and the predicate doesn't like it. */ @@ -1701,11 +1705,6 @@ is used to further constrain the set of candidates. */) tem = Fcommandp (elt, Qnil); else { - if (bindcount >= 0) - { - unbind_to (bindcount, Qnil); - bindcount = -1; - } tem = (type == hash_table ? call2 (predicate, elt, HASH_VALUE (XHASH_TABLE (collection), @@ -1787,9 +1786,6 @@ is used to further constrain the set of candidates. */) } } - if (bindcount >= 0) - unbind_to (bindcount, Qnil); - if (NILP (bestmatch)) return Qnil; /* No completions found. */ /* If we are ignoring case, and there is no exact match, @@ -1849,7 +1845,6 @@ with a space are ignored unless STRING itself starts with a space. */) : VECTORP (collection) ? 2 : NILP (collection) || (CONSP (collection) && !FUNCTIONP (collection)); ptrdiff_t idx = 0, obsize = 0; - ptrdiff_t bindcount = -1; Lisp_Object bucket, tem, zero; CHECK_STRING (string); @@ -1934,27 +1929,10 @@ with a space are ignored unless STRING itself starts with a space. */) completion_ignore_case ? Qt : Qnil), EQ (Qt, tem))) { - /* Yes. */ - Lisp_Object regexps; - /* Ignore this element if it fails to match all the regexps. */ - { - for (regexps = Vcompletion_regexp_list; CONSP (regexps); - regexps = XCDR (regexps)) - { - if (bindcount < 0) - { - bindcount = SPECPDL_INDEX (); - specbind (Qcase_fold_search, - completion_ignore_case ? Qt : Qnil); - } - tem = Fstring_match (XCAR (regexps), eltstring, zero, Qnil); - if (NILP (tem)) - break; - } - if (CONSP (regexps)) - continue; - } + if (!match_regexps (eltstring, Vcompletion_regexp_list, + completion_ignore_case)) + continue; /* Ignore this element if there is a predicate and the predicate doesn't like it. */ @@ -1965,11 +1943,6 @@ with a space are ignored unless STRING itself starts with a space. */) tem = Fcommandp (elt, Qnil); else { - if (bindcount >= 0) - { - unbind_to (bindcount, Qnil); - bindcount = -1; - } tem = type == 3 ? call2 (predicate, elt, HASH_VALUE (XHASH_TABLE (collection), idx - 1)) @@ -1982,9 +1955,6 @@ with a space are ignored unless STRING itself starts with a space. */) } } - if (bindcount >= 0) - unbind_to (bindcount, Qnil); - return Fnreverse (allmatches); } @@ -2068,7 +2038,7 @@ If COLLECTION is a function, it is called with three arguments: the values STRING, PREDICATE and `lambda'. */) (Lisp_Object string, Lisp_Object collection, Lisp_Object predicate) { - Lisp_Object regexps, tail, tem = Qnil; + Lisp_Object tail, tem = Qnil; ptrdiff_t i = 0; CHECK_STRING (string); @@ -2154,20 +2124,9 @@ the values STRING, PREDICATE and `lambda'. */) return call3 (collection, string, predicate, Qlambda); /* Reject this element if it fails to match all the regexps. */ - if (CONSP (Vcompletion_regexp_list)) - { - ptrdiff_t count = SPECPDL_INDEX (); - specbind (Qcase_fold_search, completion_ignore_case ? Qt : Qnil); - for (regexps = Vcompletion_regexp_list; CONSP (regexps); - regexps = XCDR (regexps)) - { - /* We can test against STRING, because if we got here, then - the element is equivalent to it. */ - if (NILP (Fstring_match (XCAR (regexps), string, Qnil, Qnil))) - return unbind_to (count, Qnil); - } - unbind_to (count, Qnil); - } + if (!match_regexps (string, Vcompletion_regexp_list, + completion_ignore_case)) + return Qnil; /* Finally, check the predicate. */ if (!NILP (predicate)) commit 8e7cd29712996a97a698ac666bdcf2aa8474e464 Author: Lars Ingebrigtsen Date: Wed Oct 20 10:05:04 2021 +0200 Revert "Revert back to using ESC as viper-ESC-key again" This reverts commit 5d522b430bd5ecfb8f082906cd634883dbb68f3e. The change led to M-x not working in non-gui Emacsen (bug#51253). diff --git a/lisp/emulation/viper-keym.el b/lisp/emulation/viper-keym.el index 2bb24f662f..2f7d17351d 100644 --- a/lisp/emulation/viper-keym.el +++ b/lisp/emulation/viper-keym.el @@ -182,7 +182,7 @@ In insert mode, this key also functions as Meta." :type 'string :group 'viper) -(defconst viper-ESC-key (kbd "ESC") +(defconst viper-ESC-key [escape] "Key used to ESC.") commit 1fb8a1569dab5a5cb99afad9678b3bebae1733c5 Author: Lars Ingebrigtsen Date: Wed Oct 20 09:38:31 2021 +0200 Further fixes for Turkish case changes in unibyte strings * src/casefiddle.c (struct casing_context): Add new slot to keep track of what the previous operation was. (case_character_impl): Set it. (do_casify_unibyte_string): Use it to handle Turkish correctly. diff --git a/src/casefiddle.c b/src/casefiddle.c index e41ada868d..81e9ed153f 100644 --- a/src/casefiddle.c +++ b/src/casefiddle.c @@ -54,6 +54,9 @@ struct casing_context /* Whether the context is within a word. */ bool inword; + + /* What the last operation was. */ + bool downcase_last; }; /* Initialize CTX structure for casing characters. */ @@ -143,10 +146,14 @@ case_character_impl (struct casing_str_buf *buf, /* Handle simple, one-to-one case. */ if (flag == CASE_DOWN) - cased = downcase (ch); + { + cased = downcase (ch); + ctx->downcase_last = true; + } else { bool cased_is_set = false; + ctx->downcase_last = false; if (!NILP (ctx->titlecase_char_table)) { prop = CHAR_TABLE_REF (ctx->titlecase_char_table, ch); @@ -324,7 +331,7 @@ do_casify_unibyte_string (struct casing_context *ctx, Lisp_Object obj) character (this can happen in some locales, like the Turkish "I"), downcase using the ASCII char table. */ if (ASCII_CHAR_P (ch) && !SINGLE_BYTE_CHAR_P (cased)) - cased = ascii_casify_character (ctx->flag == CASE_DOWN, ch); + cased = ascii_casify_character (ctx->downcase_last, ch); SSET (obj, i, make_char_unibyte (cased)); } return obj; diff --git a/test/src/casefiddle-tests.el b/test/src/casefiddle-tests.el index 9fa54dcaf4..164adbc19e 100644 --- a/test/src/casefiddle-tests.el +++ b/test/src/casefiddle-tests.el @@ -278,4 +278,17 @@ (with-temp-buffer (should-error (upcase-region nil nil t))))) +(ert-deftest casefiddle-turkish () + (skip-unless (member "tr_TR.utf8" (get-locale-names))) + (with-locale-environment "tr_TR.utf8" + (should (string-equal (downcase "I ı") "ı ı")) + (should (string-equal (downcase "İ i") "i̇ i")) + (should (string-equal (downcase "I") "i")) + (should (string-equal (capitalize "bIte") "Bite")) + (should (string-equal (capitalize "bIté") "Bıté")) + (should (string-equal (capitalize "indIa") "India")) + ;; This does not work -- it produces "Indıa". + ;;(should (string-equal (capitalize "indIá") "İndıa")) + )) + ;;; casefiddle-tests.el ends here commit 442101433c6459202e325264e3bbf97790f512e6 Author: Lars Ingebrigtsen Date: Wed Oct 20 09:36:25 2021 +0200 Add new macro with-locale-environment * lisp/international/mule-cmds.el (with-locale-environment): New macro. (current-locale-environment): New variable. diff --git a/etc/NEWS b/etc/NEWS index 20696afb61..84e2121086 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -236,6 +236,17 @@ with recent versions of Firefox. * Lisp Changes in Emacs 29.1 +** Locale + +--- +*** New variable 'current-locale-environment'. +This holds the value of the previous call to 'set-locale-environment'. + +--- +*** New macro 'with-locale-environment'. +This macro can be used to change the locale temporarily while +executing code. + +++ ** 'define-key' now understands a new strict 'kbd' representation for keys. The '(define-key map ["C-c M-f"] #'some-command)' syntax is now diff --git a/lisp/international/mule-cmds.el b/lisp/international/mule-cmds.el index 94d2f82e8c..be4a4eb0cb 100644 --- a/lisp/international/mule-cmds.el +++ b/lisp/international/mule-cmds.el @@ -2665,6 +2665,20 @@ For example, translate \"swedish\" into \"sv_SE.ISO8859-1\"." locale)) locale)) +(defvar current-locale-environment nil + "The currently set locale environment.") + +(defmacro with-locale-environment (locale-name &rest body) + "Execute BODY with the locale set to LOCALE-NAME." + (declare (indent 1) (debug (sexp def-body))) + (let ((current (gensym))) + `(let ((,current current-locale-environment)) + (unwind-protect + (progn + (set-locale-environment ,locale-name) + ,@body) + (set-locale-environment ,current))))) + (defun set-locale-environment (&optional locale-name frame) "Set up multilingual environment for using LOCALE-NAME. This sets the language environment, the coding system priority, @@ -2690,6 +2704,10 @@ If FRAME is non-nil, only set the keyboard coding system and the terminal coding system for the terminal of that frame, and don't touch session-global parameters like the language environment. +This function sets the `current-locale-environment' variable. To +change the locale temporarily, `with-locale-environment' can be +used. + See also `locale-charset-language-names', `locale-language-names', `locale-preferred-coding-systems' and `locale-coding-system'." (interactive (list (completing-read "Set environment for locale: " @@ -2723,6 +2741,7 @@ See also `locale-charset-language-names', `locale-language-names', (when locale (setq locale (locale-translate locale)) + (setq current-locale-environment locale) ;; Leave the system locales alone if the caller did not specify ;; an explicit locale name, as their defaults are set from commit 62591c164cd6d0b0555e11b160ffa81bd3bb010f Author: Stefan Kangas Date: Wed Oct 20 03:23:28 2021 +0200 Add some tests for fns.c * test/src/fns-tests.el (fns-tests-identity, fns-tests-random) (fns-tests-length, fns-tests-safe-length) (fns-tests-string-bytes): New tests. diff --git a/test/src/fns-tests.el b/test/src/fns-tests.el index 2d641cc311..3dc2e7b3ec 100644 --- a/test/src/fns-tests.el +++ b/test/src/fns-tests.el @@ -23,6 +23,29 @@ (require 'cl-lib) +(ert-deftest fns-tests-identity () + (let ((num 12345)) (should (eq (identity num) num))) + (let ((str "foo")) (should (eq (identity str) str))) + (let ((lst '(11))) (should (eq (identity lst) lst)))) + +(ert-deftest fns-tests-random () + (should (integerp (random))) + (should (>= (random 10) 0)) + (should (< (random 10) 10))) + +(ert-deftest fns-tests-length () + (should (= (length nil) 0)) + (should (= (length '(1 2 3)) 3)) + (should (= (length '[1 2 3]) 3)) + (should (= (length "foo") 3)) + (should-error (length t))) + +(ert-deftest fns-tests-safe-length () + (should (= (safe-length '(1 2 3)) 3))) + +(ert-deftest fns-tests-string-bytes () + (should (= (string-bytes "abc") 3))) + ;; Test that equality predicates work correctly on NaNs when combined ;; with hash tables based on those predicates. This was not the case ;; for eql in Emacs 26. commit a4a35305101f24279d02d620a51b94b3e4682435 Author: Stefan Kangas Date: Wed Oct 20 01:52:26 2021 +0200 Remove some XEmacs compat code from custom.el * lisp/custom.el (deftheme, custom-declare-theme): Remove XEmacs compat code. diff --git a/lisp/custom.el b/lisp/custom.el index a04af9abaa..d4f617d170 100644 --- a/lisp/custom.el +++ b/lisp/custom.el @@ -1132,30 +1132,24 @@ list, in which A occurs before B if B was defined with a ;; (provide-theme 'THEME) -;; The IGNORED arguments to deftheme come from the XEmacs theme code, where -;; they were used to supply keyword-value pairs like `:immediate', -;; `:variable-reset-string', etc. We don't use any of these, so ignore them. - -(defmacro deftheme (theme &optional doc &rest _ignored) +(defmacro deftheme (theme &optional doc) "Declare THEME to be a Custom theme. The optional argument DOC is a doc string describing the theme. Any theme `foo' should be defined in a file called `foo-theme.el'; see `custom-make-theme-feature' for more information." (declare (doc-string 2) - (indent 1) - (advertised-calling-convention (theme &optional doc) "22.1")) + (indent 1)) (let ((feature (custom-make-theme-feature theme))) ;; It is better not to use backquote in this file, ;; because that makes a bootstrapping problem ;; if you need to recompile all the Lisp files using interpreted code. (list 'custom-declare-theme (list 'quote theme) (list 'quote feature) doc))) -(defun custom-declare-theme (theme feature &optional doc &rest _ignored) +(defun custom-declare-theme (theme feature &optional doc) "Like `deftheme', but THEME is evaluated as a normal argument. FEATURE is the feature this theme provides. Normally, this is a symbol created from THEME by `custom-make-theme-feature'." - (declare (advertised-calling-convention (theme feature &optional doc) "22.1")) (unless (custom-theme-name-valid-p theme) (error "Custom theme cannot be named %S" theme)) (unless (memq theme custom-known-themes) commit 766108f48db29f766908c728969f78d8e896171e Author: Dmitry Gutov Date: Wed Oct 20 01:03:52 2021 +0300 xref.el: Better compatibility with outdated Emacs 28 builds * lisp/progmodes/xref.el: Ensure better compatibility with outdated Emacs 28 builds as well (like the pgtk branch). Bump the version. diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el index 58347603c1..a198ae349e 100644 --- a/lisp/progmodes/xref.el +++ b/lisp/progmodes/xref.el @@ -1,7 +1,7 @@ ;;; xref.el --- Cross-referencing commands -*-lexical-binding:t-*- ;; Copyright (C) 2014-2021 Free Software Foundation, Inc. -;; Version: 1.3.1 +;; Version: 1.3.2 ;; Package-Requires: ((emacs "26.1")) ;; This is a GNU ELPA :core package. Avoid functionality that is not @@ -75,7 +75,7 @@ (require 'project) (eval-and-compile - (when (version< emacs-version "28") + (when (version< emacs-version "28.0.60") ;; etags.el in Emacs 26 and 27 uses EIEIO, and its location type ;; inherits from `xref-location'. (require 'eieio) commit 9b70b1aad9fb817f914d8643118c4d5b47a1378c Author: Stefan Monnier Date: Tue Oct 19 17:18:05 2021 -0400 * doc/lispref/files.texi (File Name Components): Mention GNU "path" convention diff --git a/doc/lispref/files.texi b/doc/lispref/files.texi index 1e05153f3c..59e18b32c2 100644 --- a/doc/lispref/files.texi +++ b/doc/lispref/files.texi @@ -2083,6 +2083,9 @@ directory. Therefore, Emacs considers a file name as having two main parts: the @dfn{directory name} part, and the @dfn{nondirectory} part (or @dfn{file name within the directory}). Either part may be empty. Concatenating these two parts reproduces the original file name. +@footnote{Emacs follows the GNU convention to use the term @emph{file name} +instead of the term @emph{pathname}. We use the term @emph{path} only for +search paths, which are lists of directory names.} On most systems, the directory part is everything up to and including the last slash (backslash is also allowed in input on MS-DOS or commit 5580d7e7635caa3e4ef3e43b73596e211703c678 Author: Lars Ingebrigtsen Date: Tue Oct 19 23:10:46 2021 +0200 Make image-tests work in a no-x build * test/src/image-tests.el: Make the tests work in a no-x build (bug#51291). diff --git a/test/src/image-tests.el b/test/src/image-tests.el index 4437d7941e..d5e3a7cc5c 100644 --- a/test/src/image-tests.el +++ b/test/src/image-tests.el @@ -36,15 +36,14 @@ ;;;; Images (defconst image-tests--files - `((jpeg . ,(create-image (expand-file-name - "test/data/image/black.jpg" - source-directory))) + `((jpeg . ,(expand-file-name "test/data/image/black.jpg" + source-directory)) (pbm . ,(find-image '((:file "splash.svg" :type svg)))) (png . ,(find-image '((:file "splash.png" :type png)))) (svg . ,(find-image '((:file "splash.pbm" :type pbm)))) - (tiff . ,(create-image (expand-file-name - "nextstep/GNUstep/Emacs.base/Resources/emacs.tiff" - source-directory))) + (tiff . ,(expand-file-name + "nextstep/GNUstep/Emacs.base/Resources/emacs.tiff" + source-directory)) (xbm . ,(find-image '((:file "gnus/gnus.xbm" :type xbm)))) (xpm . ,(find-image '((:file "splash.xpm" :type xpm)))) ;; TODO: gif @@ -54,7 +53,7 @@ (ert-deftest image-tests-image-size/jpeg () (image-skip-unless 'jpeg) - (pcase (image-size (cdr (assq 'jpeg image-tests--files))) + (pcase (image-size (create-image (cdr (assq 'jpeg image-tests--files)))) (`(,a . ,b) (should (floatp a)) (should (floatp b))))) @@ -82,7 +81,7 @@ (ert-deftest image-tests-image-size/tiff () (image-skip-unless 'tiff) - (pcase (image-size (cdr (assq 'tiff image-tests--files))) + (pcase (image-size (create-image (cdr (assq 'tiff image-tests--files)))) (`(,a . ,b) (should (floatp a)) (should (floatp b))))) @@ -113,7 +112,8 @@ (ert-deftest image-tests-image-mask-p/jpeg () (image-skip-unless 'jpeg) - (should-not (image-mask-p (cdr (assq 'jpeg image-tests--files))))) + (should-not (image-mask-p (create-image + (cdr (assq 'jpeg image-tests--files)))))) (ert-deftest image-tests-image-mask-p/pbm () (image-skip-unless 'pbm) @@ -129,7 +129,8 @@ (ert-deftest image-tests-image-mask-p/tiff () (image-skip-unless 'tiff) - (should-not (image-mask-p (cdr (assq 'tiff image-tests--files))))) + (should-not (image-mask-p (create-image + (cdr (assq 'tiff image-tests--files)))))) (ert-deftest image-tests-image-mask-p/xbm () (image-skip-unless 'xbm) @@ -154,7 +155,8 @@ (ert-deftest image-tests-image-metadata/jpeg () (image-skip-unless 'jpeg) - (should-not (image-metadata (cdr (assq 'jpeg image-tests--files))))) + (should-not (image-metadata + (create-image (cdr (assq 'jpeg image-tests--files)))))) (ert-deftest image-tests-image-metadata/pbm () (image-skip-unless 'pbm) @@ -170,7 +172,8 @@ (ert-deftest image-tests-image-metadata/tiff () (image-skip-unless 'tiff) - (should-not (image-metadata (cdr (assq 'tiff image-tests--files))))) + (should-not (image-metadata + (create-image (cdr (assq 'tiff image-tests--files)))))) (ert-deftest image-tests-image-metadata/xbm () (image-skip-unless 'xbm) @@ -198,6 +201,7 @@ ;;;; Initialization (ert-deftest image-tests-init-image-library () + (skip-unless (fboundp 'init-image-library)) (should (init-image-library 'pbm)) ; built-in (should (init-image-library 'xpm)) ; built-in (should-not (init-image-library 'invalid-image-type))) commit 90266b8356dc5e7e6e437fb37b49970205b01408 Author: Lars Ingebrigtsen Date: Tue Oct 19 22:39:00 2021 +0200 Tweak how 'align' and 'align-regexp' align text * lisp/align.el (align-rules-list): Change to work without `C-u'. (align): Doc clarification. (align-regexp): Ditto, and change default `C-u' regexp from "\\(\\s-*\\)" to "\\(\\s-*\\)" so that it'll make things columnar if the user just hits RET through all the defaults. diff --git a/etc/NEWS b/etc/NEWS index 98c710ae57..20696afb61 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -103,6 +103,15 @@ delimiter in the echo area. * Changes in Specialized Modes and Packages in Emacs 29.1 +** align + +--- +*** Alignment in 'text-mode' has changed. +Previously, 'M-x align' didn't do anything, and you have to say 'C-u +M-x align' for it to work. This has now been changed. The default +for regexp for 'C-u M-x align-regexp' has also been changed to be +easier for inexperienced users to use. + ** eww +++ diff --git a/lisp/align.el b/lisp/align.el index 7ced7b7044..2fd6dcda6d 100644 --- a/lisp/align.el +++ b/lisp/align.el @@ -553,8 +553,7 @@ The possible settings for `align-region-separate' are: (modes . align-text-modes) (repeat . t) (run-if . ,(lambda () - (and current-prefix-arg - (not (eq '- current-prefix-arg)))))) + (not (eq '- current-prefix-arg))))) ;; With a negative prefix argument, lists of dollar figures will ;; be aligned. @@ -836,11 +835,22 @@ See the variable `align-exclude-rules-list' for more details.") ;;;###autoload (defun align (beg end &optional separate rules exclude-rules) "Attempt to align a region based on a set of alignment rules. -BEG and END mark the region. If BEG and END are specifically set to -nil (this can only be done programmatically), the beginning and end of -the current alignment section will be calculated based on the location -of point, and the value of `align-region-separate' (or possibly each -rule's `separate' attribute). +Interactively, BEG and END are the mark/point of the current region. + +Many modes define specific alignment rules, and some of these +rules in some modes react to the current prefix argument. For +instance, in `text-mode', `M-x align' will align into columns +based on space delimiters, while `C-u - M-x align' will align +into columns based on the \"$\" character. See the +`align-rules-list' variable definition for the specific rules. + +Also see `align-regexp', which will guide you through various +parameters for aligning text. + +Non-interactively, if BEG and END are nil, the beginning and end +of the current alignment section will be calculated based on the +location of point, and the value of `align-region-separate' (or +possibly each rule's `separate' attribute). If SEPARATE is non-nil, it overrides the value of `align-region-separate' for all rules, except those that have their @@ -889,6 +899,15 @@ on the format of these lists." BEG and END mark the limits of the region. Interactively, this function prompts for the regular expression REGEXP to align with. +Interactively, if you specify a prefix argument, the function +will guide you through entering the full regular expression, and +then prompts for which subexpression parenthesis GROUP (default +1) within REGEXP to modify, the amount of SPACING (default +`align-default-spacing') to use, and whether or not to REPEAT the +rule throughout the line. + +See `align-rules-list' for more information about these options. + For example, let's say you had a list of phone numbers, and wanted to align them so that the opening parentheses would line up: @@ -908,15 +927,8 @@ regular expression after you enter it. Interactively, you only need to supply the characters to be lined up, and any preceding whitespace is replaced. -Non-interactively (or if you specify a prefix argument), you must -enter the full regular expression, including the subexpression. -Interactively, the function also then prompts for which -subexpression parenthesis GROUP (default 1) within REGEXP to -modify, the amount of SPACING (default `align-default-spacing') -to use, and whether or not to REPEAT the rule throughout the -line. - -See `align-rules-list' for more information about these options. +Non-interactively, you must enter the full regular expression, +including the subexpression. The non-interactive form of the previous example would look something like: (align-regexp (point-min) (point-max) \"\\\\(\\\\s-*\\\\)(\") @@ -928,7 +940,7 @@ construct a rule to pass to `align-region', which does the real work." (list (region-beginning) (region-end)) (if current-prefix-arg (list (read-string "Complex align using regexp: " - "\\(\\s-*\\)" 'align-regexp-history) + "\\(\\s-*\\) " 'align-regexp-history) (string-to-number (read-string "Parenthesis group to modify (justify if negative): " "1")) commit 91d71b38a333c9b3dc411547c1ad61f0ee63d4e6 Author: Alan Third Date: Sun Oct 17 19:30:59 2021 +0100 Fix inset rectangle corners when sides aren't drawn (bug#51251) * src/nsterm.m (ns_draw_relief): Make the inner rectangle line up with the outer rectangle's edges where the edges aren't drawn. diff --git a/src/nsterm.m b/src/nsterm.m index c6f80f8035..aa29c13eb2 100644 --- a/src/nsterm.m +++ b/src/nsterm.m @@ -3512,7 +3512,12 @@ larger if there are taller display elements (e.g., characters } /* Calculate the inner rectangle. */ - inner = NSInsetRect (outer, hthickness, vthickness); + inner = NSMakeRect (NSMinX (outer) + (left_p ? hthickness : 0), + NSMinY (outer) + (top_p ? vthickness : 0), + NSWidth (outer) - (left_p ? hthickness : 0) + - (right_p ? hthickness : 0), + NSHeight (outer) - (top_p ? vthickness : 0) + - (bottom_p ? vthickness : 0)); [(raised_p ? lightCol : darkCol) set]; commit 0bb0fbee68498be1a74e03fe97ea3ad9297f8bfe Author: Mattias Engdegård Date: Tue Oct 19 12:03:15 2021 +0200 Improve TCO test coverage * test/lisp/emacs-lisp/cl-macs-tests.el (cl-macs--labels): Exercise `cond` in tail position in two different ways. diff --git a/test/lisp/emacs-lisp/cl-macs-tests.el b/test/lisp/emacs-lisp/cl-macs-tests.el index f4e2e46a01..033764a7f9 100644 --- a/test/lisp/emacs-lisp/cl-macs-tests.el +++ b/test/lisp/emacs-lisp/cl-macs-tests.el @@ -637,17 +637,26 @@ collection clause." (/ 1 (logand n 1)) (arith-error (len3 (cdr xs) (1+ n))) (:success (len3 (cdr xs) (+ n k)))) - n))) + n)) + + ;; Tail calls in `cond'. + (len4 (xs n) + (cond (xs (cond (nil 'nevertrue) + ((len4 (cdr xs) (1+ n))))) + (t n)))) (should (equal (len nil 0) 0)) (should (equal (len2 nil 0) 0)) (should (equal (len3 nil 0) 0)) + (should (equal (len4 nil 0) 0)) (should (equal (len list-42 0) 42)) (should (equal (len2 list-42 0) 42)) (should (equal (len3 list-42 0) 42)) + (should (equal (len4 list-42 0) 42)) ;; Should not bump into stack depth limits. (should (equal (len list-42k 0) 42000)) (should (equal (len2 list-42k 0) 42000)) - (should (equal (len3 list-42k 0) 42000)))) + (should (equal (len3 list-42k 0) 42000)) + (should (equal (len4 list-42k 0) 42000)))) ;; Check that non-recursive functions are handled more efficiently. (should (pcase (macroexpand '(cl-labels ((f (x) (+ x 1))) (f 5))) commit 53bea8796d52d90d09c29780070442d59e1883b7 Author: Lars Ingebrigtsen Date: Tue Oct 19 20:36:48 2021 +0200 Make downcasing unibyte strings in Turkish less wrong * src/casefiddle.c (ascii_casify_character): New function. (do_casify_unibyte_string): Use it to make downcasing tr_TR.UTF-8 "I" less wrong. (Fdowncase): Mention caveats. (Fupcase): (Fcapitalize): (Fupcase_initials): Refer to details in `downcase'. (syms_of_casefiddle): Define more symbols. diff --git a/etc/NEWS b/etc/NEWS index 9f0a4ac4ce..98c710ae57 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -178,6 +178,18 @@ Emacs buffers, like indentation and the like. The new ert function * Incompatible Lisp Changes in Emacs 29.1 +--- +** 'downcase' details have changed slightly. +In certain locales, changing the case of an ASCII-range character may +turn it into a multibyte character, most notably with "I" in Turkish +(the lowercase is "ı", 0x0131). Previously, 'downcase' on a unibyte +string was buggy, and would mistakenly just return the lower byte of +this, 0x31 (the digit "1"). 'downcase' on a unibyte string has now +been changed to downcase such characters as if they were ASCII. To +get proper locale-dependent downcasing, the string has to be converted +to multibyte first. (This goes for the other case-changing functions, +too.) + --- ** 'def' indentation changes. In 'emacs-lisp-mode', forms with a symbol with a name that start with diff --git a/src/casefiddle.c b/src/casefiddle.c index a7a2541490..e41ada868d 100644 --- a/src/casefiddle.c +++ b/src/casefiddle.c @@ -297,6 +297,16 @@ do_casify_multibyte_string (struct casing_context *ctx, Lisp_Object obj) return obj; } +static int +ascii_casify_character (bool downcase, int c) +{ + Lisp_Object cased = CHAR_TABLE_REF (downcase? + uniprop_table (Qlowercase) : + uniprop_table (Quppercase), + c); + return FIXNATP (cased) ? XFIXNAT (cased) : c; +} + static Lisp_Object do_casify_unibyte_string (struct casing_context *ctx, Lisp_Object obj) { @@ -310,11 +320,12 @@ do_casify_unibyte_string (struct casing_context *ctx, Lisp_Object obj) cased = case_single_character (ctx, ch); if (ch == cased) continue; - cased = make_char_unibyte (cased); - /* If the char can't be converted to a valid byte, just don't - change it. */ - if (SINGLE_BYTE_CHAR_P (cased)) - SSET (obj, i, cased); + /* If down/upcasing changed an ASCII character into a non-ASCII + character (this can happen in some locales, like the Turkish + "I"), downcase using the ASCII char table. */ + if (ASCII_CHAR_P (ch) && !SINGLE_BYTE_CHAR_P (cased)) + cased = ascii_casify_character (ctx->flag == CASE_DOWN, ch); + SSET (obj, i, make_char_unibyte (cased)); } return obj; } @@ -339,10 +350,13 @@ casify_object (enum case_action flag, Lisp_Object obj) DEFUN ("upcase", Fupcase, Supcase, 1, 1, 0, doc: /* Convert argument to upper case and return that. -The argument may be a character or string. The result has the same type. +The argument may be a character or string. The result has the same +type. (See `downcase' for further details about the type.) + The argument object is not altered--the value is a copy. If argument is a character, characters which map to multiple code points when cased, e.g. fi, are returned unchanged. + See also `capitalize', `downcase' and `upcase-initials'. */) (Lisp_Object obj) { @@ -351,7 +365,15 @@ See also `capitalize', `downcase' and `upcase-initials'. */) DEFUN ("downcase", Fdowncase, Sdowncase, 1, 1, 0, doc: /* Convert argument to lower case and return that. -The argument may be a character or string. The result has the same type. +The argument may be a character or string. The result has the same type, +including the multibyteness of the string. + +This means that if this function is called with a unibyte string +argument, and downcasing it would turn it into a multibyte string +(according to the current locale), the downcasing is done using ASCII +\"C\" rules instead. To accurately downcase according to the current +locale, the string must be converted into multibyte first. + The argument object is not altered--the value is a copy. */) (Lisp_Object obj) { @@ -362,7 +384,10 @@ DEFUN ("capitalize", Fcapitalize, Scapitalize, 1, 1, 0, doc: /* Convert argument to capitalized form and return that. This means that each word's first character is converted to either title case or upper case, and the rest to lower case. -The argument may be a character or string. The result has the same type. + +The argument may be a character or string. The result has the same +type. (See `downcase' for further details about the type.) + The argument object is not altered--the value is a copy. If argument is a character, characters which map to multiple code points when cased, e.g. fi, are returned unchanged. */) @@ -377,7 +402,10 @@ DEFUN ("upcase-initials", Fupcase_initials, Supcase_initials, 1, 1, 0, doc: /* Convert the initial of each word in the argument to upper case. This means that each word's first character is converted to either title case or upper case, and the rest are left unchanged. -The argument may be a character or string. The result has the same type. + +The argument may be a character or string. The result has the same +type. (See `downcase' for further details about the type.) + The argument object is not altered--the value is a copy. If argument is a character, characters which map to multiple code points when cased, e.g. fi, are returned unchanged. */) @@ -651,6 +679,8 @@ syms_of_casefiddle (void) DEFSYM (Qbounds, "bounds"); DEFSYM (Qidentity, "identity"); DEFSYM (Qtitlecase, "titlecase"); + DEFSYM (Qlowercase, "lowercase"); + DEFSYM (Quppercase, "uppercase"); DEFSYM (Qspecial_uppercase, "special-uppercase"); DEFSYM (Qspecial_lowercase, "special-lowercase"); DEFSYM (Qspecial_titlecase, "special-titlecase"); commit 5c1a575ef49f3548eb0fa164360b58c1fd28fbb8 Author: Jan Synacek Date: Mon Oct 18 12:34:38 2021 +0200 Don't use color escape sequences in vc-git-expanded-log-entry * lisp/vc/vc-git.el (vc-git-expanded-log-entry): Use '--no-color' flag in git invocation. (Bug#51262) Copyright-paperwork-exempt: yes diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el index 35c0838dd6..3f89fad235 100644 --- a/lisp/vc/vc-git.el +++ b/lisp/vc/vc-git.el @@ -1323,7 +1323,7 @@ or BRANCH^ (where \"^\" can be repeated)." (defun vc-git-expanded-log-entry (revision) (with-temp-buffer - (apply #'vc-git-command t nil nil (list "log" revision "-1" "--")) + (apply #'vc-git-command t nil nil (list "log" revision "-1" "--no-color" "--")) (goto-char (point-min)) (unless (eobp) ;; Indent the expanded log entry. commit d7f595cc89b813b2bc3f2696a39562c64b225cb4 Author: Michael Albinus Date: Tue Oct 19 18:50:12 2021 +0200 Code cleanup in tramp-tests.el * test/lisp/net/tramp-tests.el (tramp-test29-start-file-process) (tramp-test30-make-process): Extend tests. (tramp--test-out-of-band-p): New defun. (tramp--test-windows-nt-and-out-of-band-p) (tramp-test42-utf8-with-stat, tramp-test42-utf8-with-perl) (tramp-test42-utf8-with-ls): Use it. (tramp--test-windows-nt-or-smb-p): Use `tramp--test-windows-nt-p'. diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 8c7fc48848..0ad50144dc 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -4588,23 +4588,25 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." ;; Cleanup. (ignore-errors (delete-process proc))) - (unwind-protect - (with-temp-buffer - (setq proc (start-file-process "test3" (current-buffer) "cat")) - (should (processp proc)) - (should (equal (process-status proc) 'run)) - (set-process-filter proc t) - (process-send-string proc "foo\n") - (process-send-eof proc) - ;; Read output. - (with-timeout (10 (tramp--test-timeout-handler)) - (while (process-live-p proc) - (while (accept-process-output proc 0 nil t)))) - ;; No output due to process filter. - (should (= (point-min) (point-max)))) + ;; `telnet' does not cooperate with disabled filter. + (unless (tramp--test-telnet-p) + (unwind-protect + (with-temp-buffer + (setq proc (start-file-process "test3" (current-buffer) "cat")) + (should (processp proc)) + (should (equal (process-status proc) 'run)) + (set-process-filter proc t) + (process-send-string proc "foo\n") + (process-send-eof proc) + ;; Read output. + (with-timeout (10 (tramp--test-timeout-handler)) + (while (process-live-p proc) + (while (accept-process-output proc 0 nil t)))) + ;; No output due to process filter. + (should (= (point-min) (point-max)))) - ;; Cleanup. - (ignore-errors (delete-process proc))) + ;; Cleanup. + (ignore-errors (delete-process proc)))) ;; Process connection type. (when (and (tramp--test-sh-p) @@ -4779,27 +4781,29 @@ If UNSTABLE is non-nil, the test is tagged as `:unstable'." ;; Cleanup. (ignore-errors (delete-process proc))) - (unwind-protect - (with-temp-buffer - (setq proc - (with-no-warnings - (make-process - :name "test3" :buffer (current-buffer) :command '("cat") - :filter t - :file-handler t))) - (should (processp proc)) - (should (equal (process-status proc) 'run)) - (process-send-string proc "foo\n") - (process-send-eof proc) - ;; Read output. - (with-timeout (10 (tramp--test-timeout-handler)) - (while (process-live-p proc) - (while (accept-process-output proc 0 nil t)))) - ;; No output due to process filter. - (should (= (point-min) (point-max)))) + ;; `telnet' does not cooperate with disabled filter. + (unless (tramp--test-telnet-p) + (unwind-protect + (with-temp-buffer + (setq proc + (with-no-warnings + (make-process + :name "test3" :buffer (current-buffer) :command '("cat") + :filter t + :file-handler t))) + (should (processp proc)) + (should (equal (process-status proc) 'run)) + (process-send-string proc "foo\n") + (process-send-eof proc) + ;; Read output. + (with-timeout (10 (tramp--test-timeout-handler)) + (while (process-live-p proc) + (while (accept-process-output proc 0 nil t)))) + ;; No output due to process filter. + (should (= (point-min) (point-max)))) - ;; Cleanup. - (ignore-errors (delete-process proc))) + ;; Cleanup. + (ignore-errors (delete-process proc)))) ;; Process sentinel. (unwind-protect @@ -6191,6 +6195,10 @@ This does not support external Emacs calls." (string-equal "mock" (file-remote-p tramp-test-temporary-file-directory 'method))) +(defun tramp--test-out-of-band-p () + "Check, whether an out-of-band method is used." + (tramp-method-out-of-band-p tramp-test-vec 1)) + (defun tramp--test-rclone-p () "Check, whether the remote host is offered by rclone. This requires restrictions of file name syntax." @@ -6246,13 +6254,13 @@ This does not support special file names." (defun tramp--test-windows-nt-and-out-of-band-p () "Check, whether the locale host runs MS Windows and an out-of-band method. This does not support utf8 based file transfer." - (and (eq system-type 'windows-nt) - (tramp-method-out-of-band-p tramp-test-vec 1))) + (and (tramp--test-windows-nt-p) + (tramp--test-out-of-band-p))) (defun tramp--test-windows-nt-or-smb-p () "Check, whether the locale or remote host runs MS Windows. This requires restrictions of file name syntax." - (or (eq system-type 'windows-nt) + (or (tramp--test-windows-nt-p) (tramp--test-smb-p))) (defun tramp--test-smb-p () @@ -6662,7 +6670,7 @@ Use the `stat' command." (skip-unless (tramp--test-sh-p)) (skip-unless (not (tramp--test-docker-p))) (skip-unless (not (tramp--test-rsync-p))) - (skip-unless (not (tramp--test-windows-nt-and-out-of-band-p))) + (skip-unless (not (tramp--test-out-of-band-p))) ; SLOW (skip-unless (not (tramp--test-ksh-p))) (skip-unless (not (tramp--test-crypt-p))) ;; We cannot use `tramp-test-vec', because this fails during compilation. @@ -6685,7 +6693,7 @@ Use the `perl' command." (skip-unless (tramp--test-sh-p)) (skip-unless (not (tramp--test-docker-p))) (skip-unless (not (tramp--test-rsync-p))) - (skip-unless (not (tramp--test-windows-nt-and-out-of-band-p))) + (skip-unless (not (tramp--test-out-of-band-p))) ; SLOW (skip-unless (not (tramp--test-ksh-p))) (skip-unless (not (tramp--test-crypt-p))) ;; We cannot use `tramp-test-vec', because this fails during compilation. @@ -6711,7 +6719,7 @@ Use the `ls' command." (skip-unless (tramp--test-sh-p)) (skip-unless (not (tramp--test-docker-p))) (skip-unless (not (tramp--test-rsync-p))) - (skip-unless (not (tramp--test-windows-nt-and-out-of-band-p))) + (skip-unless (not (tramp--test-out-of-band-p))) ; SLOW (skip-unless (not (tramp--test-ksh-p))) (skip-unless (not (tramp--test-crypt-p))) commit 548a5db61160ceb996b0b4fd65d0427143184852 Author: Michael Albinus Date: Tue Oct 19 18:49:38 2021 +0200 ; etc/NEWS fix wording diff --git a/etc/NEWS b/etc/NEWS index b410ef77cf..7031be311e 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -3224,7 +3224,7 @@ Type 'M-x repeat-mode RET' to enable this mode. You can then type 'C-x u u' instead of 'C-x u C-x u' to undo many changes, 'C-x o o' instead of 'C-x o C-x o' to switch windows, 'C-x { { } } ^ ^ v v' to resize the selected window interactively, 'M-g n n p p' to navigate -next-error matches. Any other key exits transient mode and then is +next-error matches. Any other key exits repeat mode and then is executed normally. 'repeat-exit-key' defines an additional key to exit mode like 'isearch-exit' ('RET'). The user option 'repeat-exit-timeout' specifies the number of seconds of idle time to commit 4d4b4017591c7fb4e37b7d1e0d6b2db565a56c66 Merge: 41c262af32 d742cc3c20 Author: Glenn Morris Date: Tue Oct 19 07:50:35 2021 -0700 Merge from origin/emacs-28 d742cc3c20 (origin/emacs-28) ; etc/NEWS: Fix typos 28db29590f * admin/notes/unicode: Refer to Unicode's emoji-style.txt 9bd2f59db6 Handle VS-16 correctly for non-emoji codepoints e55e2d4a11 ; * etc/NEWS: Minor copyedit about 'repeat-mode'. 380981ddb5 Adjust bug-reference-bug-regexp default values to match on... c1cf95a0e1 ; * doc/emacs/windows.texi: Doc fix. 98eb6d783a Fix a typo in emacs-lisp-intro.texi f5b8f626e3 Fix some Tramp problems fc988a7113 Adapt Tramp manual 0c241043a8 Further fixes to Elisp manual 8e8a920246 * lisp/progmodes/cc-engine.el (c-forward-decl-or-cast-1): ... 5a3242301d Rename tab-bar-drag-maybe to tab-bar--dragging-in-progress bb4209a5a5 Fix xref elisp identifier namespace mistake # Conflicts: # etc/NEWS commit 41c262af322eab6c35a94d747dcaf776b0975f35 Author: Dmitry Gutov Date: Tue Oct 19 17:42:25 2021 +0300 * lisp/progmodes/xref.el: Bump version. diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el index 8c8687c0d6..58347603c1 100644 --- a/lisp/progmodes/xref.el +++ b/lisp/progmodes/xref.el @@ -1,7 +1,7 @@ ;;; xref.el --- Cross-referencing commands -*-lexical-binding:t-*- ;; Copyright (C) 2014-2021 Free Software Foundation, Inc. -;; Version: 1.3.0 +;; Version: 1.3.1 ;; Package-Requires: ((emacs "26.1")) ;; This is a GNU ELPA :core package. Avoid functionality that is not commit cd4bb985406e66e9cd1a5424b49d48818a99311d Author: Dmitry Gutov Date: Tue Oct 19 17:32:35 2021 +0300 Fix Emacs 26 support in xref.el * lisp/progmodes/xref.el (xref--defstruct): New macro. (xref-item, xref-match-item): Use it in definitions. diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el index 52a4e0c543..8c8687c0d6 100644 --- a/lisp/progmodes/xref.el +++ b/lisp/progmodes/xref.el @@ -195,16 +195,23 @@ is not known." ;;; Cross-reference -(cl-defstruct (xref-item - (:constructor xref-make (summary location)) - (:noinline t)) +(defmacro xref--defstruct (name &rest fields) + (declare (indent 1)) + `(cl-defstruct ,(if (>= emacs-major-version 27) + name + (remq (assq :noinline name) name)) + ,@fields)) + +(xref--defstruct (xref-item + (:constructor xref-make (summary location)) + (:noinline t)) "An xref item describes a reference to a location somewhere." summary location) -(cl-defstruct (xref-match-item - (:include xref-item) - (:constructor xref-make-match (summary location length)) - (:noinline t)) +(xref--defstruct (xref-match-item + (:include xref-item) + (:constructor xref-make-match (summary location length)) + (:noinline t)) "A match xref item describes a search result." length) commit d742cc3c204ba0adeb9600d236a0e454e35a42ff Author: Michael Albinus Date: Tue Oct 19 15:06:30 2021 +0200 ; etc/NEWS: Fix typos diff --git a/etc/NEWS b/etc/NEWS index a847a88c91..b410ef77cf 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2567,7 +2567,7 @@ that prompt for a project directory. +++ *** New prefix keymap 'project-prefix-map'. Key sequences that invoke project-related commands start with the -prefix 'C-x p'. Type "C-x p C-h" to show the full list. +prefix 'C-x p'. Type 'C-x p C-h' to show the full list. +++ *** New commands 'project-dired', 'project-vc-dir', 'project-shell', @@ -3220,7 +3220,7 @@ batch mode. +++ ** New transient mode 'repeat-mode' to allow shorter key sequences. -Type "M-x repeat-mode RET" to enable this mode. You can then type +Type 'M-x repeat-mode RET' to enable this mode. You can then type 'C-x u u' instead of 'C-x u C-x u' to undo many changes, 'C-x o o' instead of 'C-x o C-x o' to switch windows, 'C-x { { } } ^ ^ v v' to resize the selected window interactively, 'M-g n n p p' to navigate commit 28db29590f27f8b5f376e4588aca62809fb61077 Author: Robert Pluim Date: Mon Oct 18 14:52:49 2021 +0200 * admin/notes/unicode: Refer to Unicode's emoji-style.txt diff --git a/admin/notes/unicode b/admin/notes/unicode index 21233ac281..c41b9a6d26 100644 --- a/admin/notes/unicode +++ b/admin/notes/unicode @@ -116,8 +116,12 @@ FONT-NAME-REGEXP is checked using `string-match'." Visit "emoji-zwj-sequences.txt" and "emoji-sequences.txt" with the rebuilt Emacs, and check that the sample sequences are composed -properly. Note that your emoji font might not have glyphs for the -newest codepoints yet. +properly. Also check the Unicode style chart file available at +https://unicode.org/emoji/charts/emoji-style.txt for any issues +involving VS-15 and VS-16, if so you may need to update the value +generated for auto-composition-emoji-eligible-codepoints by +admin/unidata/emoji-zwj.awk. Note that your emoji font might not have +glyphs for the newest codepoints yet. Finally, etc/NEWS should be updated to announce the support for the new Unicode version. commit 9bd2f59db608def1b588b03eff846d3fe8a7fa00 Author: Robert Pluim Date: Mon Oct 18 11:51:10 2021 +0200 Handle VS-16 correctly for non-emoji codepoints * admin/unidata/blocks.awk: Remove emoji overrides for codepoints with Emoji_Presentation = No, they're no longer necessary. * lisp/composite.el: Remove #xFE0F (VS-16) from the range handled by `compose-gstring-for-variation-glyph' so it can be handled by `font_range'. * src/composite.c (syms_of_composite): New variable `auto-composition-emoji-eligible-codepoints'. * admin/unidata/emoji-zwj.awk: Generate value for `auto-composition-emoji-eligible-codepoints'. Add `composition-function-table' entries for 'codepoint + U+FE0F' for them. * src/font.c (codepoint_is_emoji_eligible): New function to check if we should try to use the emoji font for a codepoint. (font_range): Use it. diff --git a/admin/unidata/blocks.awk b/admin/unidata/blocks.awk index 96b0413875..314ac3e939 100755 --- a/admin/unidata/blocks.awk +++ b/admin/unidata/blocks.awk @@ -221,31 +221,9 @@ FILENAME ~ "emoji-data.txt" && /^[0-9A-F].*; Emoji_Presentation / { } END { - ## These codepoints have Emoji_Presentation = No, but they are - ## used in emoji-sequences.txt and emoji-zwj-sequences.txt (with a - ## Variation Selector), so force them into the emoji script so - ## they will get composed correctly. FIXME: delete this when we - ## can change the font used for a codepoint based on whether it's - ## followed by a VS (usually VS-16) idx = 0 - override_start[idx] = "1F3CB" - override_end[idx] = "1F3CC" - idx++ - override_start[idx] = "1F3F3" - override_end[idx] = "1F3F4" - idx++ - override_start[idx] = "1F441" - override_end[idx] = "1F441" - idx++ - override_start[idx] = "1F574" - override_end[idx] = "1F575" - idx++ - override_start[idx] = "1F590" - override_end[idx] = "1F590" - - ## These are here so that font_range can choose Emoji presentation - ## for the preceding codepoint when it encounters a VS - idx++ + # ## These are here so that font_range can choose Emoji presentation + # ## for the preceding codepoint when it encounters a VS override_start[idx] = "FE00" override_end[idx] = "FE0F" diff --git a/admin/unidata/emoji-zwj.awk b/admin/unidata/emoji-zwj.awk index 5aca157cbd..d4e2944ca3 100644 --- a/admin/unidata/emoji-zwj.awk +++ b/admin/unidata/emoji-zwj.awk @@ -64,6 +64,44 @@ END { print ";;; emoji-zwj.el --- emoji zwj character composition table -*- lexical-binding:t -*-" print ";;; Automatically generated from admin/unidata/emoji-{zwj-,}sequences.txt" print "(eval-when-compile (require 'regexp-opt))" + + # The following codepoints are not emoji, but they are part of + # emoji sequences. We have code in font.c:font_range that will + # try to display them with the emoji font anyway. + + trigger_codepoints[1] = "261D" + trigger_codepoints[2] = "26F9" + trigger_codepoints[3] = "270C" + trigger_codepoints[4] = "270D" + trigger_codepoints[5] = "2764" + trigger_codepoints[6] = "1F3CB" + trigger_codepoints[7] = "1F3CC" + trigger_codepoints[8] = "1F3F3" + trigger_codepoints[9] = "1F3F4" + trigger_codepoints[10] = "1F441" + trigger_codepoints[11] = "1F574" + trigger_codepoints[12] = "1F575" + trigger_codepoints[13] = "1F590" + + printf "(setq auto-composition-emoji-eligible-codepoints\n" + printf "'(" + + for (trig in trigger_codepoints) + { + printf("\n?\\N{U+%s}", trigger_codepoints[trig]) + } + printf "\n))\n\n" + + # We add entries for 'codepoint U+FE0F' here to ensure that the + # code in font_range is triggered. + + for (trig in trigger_codepoints) + { + codepoint = trigger_codepoints[trig] + c = sprintf("\\N{U+%s}", codepoint) + vec[codepoint] = vec[codepoint] "\n\"" c "\\N{U+FE0F}\"" + } + print "(dolist (elt `(" for (elt in ch) @@ -98,6 +136,5 @@ END { print " 0" print " 'compose-gstring-for-graphic))))" - print "\n" - print "(provide 'emoji-zwj)" + printf "\n(provide 'emoji-zwj)" } diff --git a/lisp/composite.el b/lisp/composite.el index 859253ec7e..99f528a077 100644 --- a/lisp/composite.el +++ b/lisp/composite.el @@ -834,8 +834,15 @@ and the second is a glyph for a variation selector." (lgstring-set-glyph gstring 1 nil) (throw 'tag gstring))))))) +;; We explicitly don't handle #xFE0F (VS-16) here, because that's +;; taken care of by font_range in font.c, which will check for an +;; emoji font for codepoints used in compositions even if they're not +;; emoji themselves, and thus choose the Emoji presentation for them +;; when followed by VS-16. VS-15 *is* handled here, because if it's +;; handled in font_range, we end up choosing the Emoji presentation +;; rather than the Text presentation. (let ((elt '([".." 1 compose-gstring-for-variation-glyph]))) - (set-char-table-range composition-function-table '(#xFE00 . #xFE0F) elt) + (set-char-table-range composition-function-table '(#xFE00 . #xFE0E) elt) (set-char-table-range composition-function-table '(#xE0100 . #xE01EF) elt)) (defun auto-compose-chars (func from to font-object string direction) diff --git a/src/composite.c b/src/composite.c index f456e7a835..c170805d9d 100644 --- a/src/composite.c +++ b/src/composite.c @@ -2124,6 +2124,17 @@ GSTRING, or modify GSTRING itself and return it. See also the documentation of `auto-composition-mode'. */); Vcomposition_function_table = Fmake_char_table (Qnil, Qnil); + DEFVAR_LISP ("auto-composition-emoji-eligible-codepoints", Vauto_composition_emoji_eligible_codepoints, + doc: /* List of codepoints for which auto-composition will check for an emoji font. + +These are codepoints which have Emoji_Presentation = No, and thus by +default are not displayed as emoji. In certain circumstances, such as +when followed by U+FE0F (VS-16) the emoji font should be used for +them anyway. + +This list is auto-generated, you should not need to modify it. */); + Vauto_composition_emoji_eligible_codepoints = Qnil; + defsubr (&Scompose_region_internal); defsubr (&Scompose_string_internal); defsubr (&Sfind_composition_internal); diff --git a/src/font.c b/src/font.c index 83f0f8296a..6cd4a6b5c1 100644 --- a/src/font.c +++ b/src/font.c @@ -3860,6 +3860,23 @@ font_at (int c, ptrdiff_t pos, struct face *face, struct window *w, #ifdef HAVE_WINDOW_SYSTEM +/* Check if CH is a codepoint for which we should attempt to use the + emoji font, even if the codepoint itself has Emoji_Presentation = + No. Vauto_composition_emoji_eligible_codepoints is filled in for + us by admin/unidata/emoji-zwj.awk. */ +static bool +codepoint_is_emoji_eligible (int ch) +{ + if (EQ (CHAR_TABLE_REF (Vchar_script_table, ch), Qemoji)) + return true; + + if (! NILP (Fmemq (make_fixnum (ch), + Vauto_composition_emoji_eligible_codepoints))) + return true; + + return false; +} + /* Check how many characters after character/byte position POS/POS_BYTE (at most to *LIMIT) can be displayed by the same font in the window W. FACE, if non-NULL, is the face selected for the character at POS. @@ -3907,8 +3924,7 @@ font_range (ptrdiff_t pos, ptrdiff_t pos_byte, ptrdiff_t *limit, /* If the composition was triggered by an emoji, use a character from 'script-representative-chars', rather than the first character in the string, to determine the font to use. */ - if (EQ (CHAR_TABLE_REF (Vchar_script_table, ch), - Qemoji)) + if (codepoint_is_emoji_eligible (ch)) { Lisp_Object val = assq_no_quit (Qemoji, Vscript_representative_chars); if (CONSP (val)) commit e55e2d4a110447540db6bbdb9cb1c12313b4b8ad Author: Eli Zaretskii Date: Tue Oct 19 15:12:43 2021 +0300 ; * etc/NEWS: Minor copyedit about 'repeat-mode'. diff --git a/etc/NEWS b/etc/NEWS index b7c4346db9..a847a88c91 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -3220,19 +3220,20 @@ batch mode. +++ ** New transient mode 'repeat-mode' to allow shorter key sequences. -You can type 'C-x u u' instead of 'C-x u C-x u' to undo many changes, -'C-x o o' instead of 'C-x o C-x o' to switch several windows, -'C-x { { } } ^ ^ v v' to resize the selected window interactively, -'M-g n n p p' to navigate next-error matches. Any other key exits -transient mode and then is executed normally. 'repeat-exit-key' -defines an additional key to exit mode like 'isearch-exit' ('RET'). -The user option 'repeat-exit-timeout' specifies the number of -seconds of idle time to break the repetition chain automatically. -With 'repeat-keep-prefix' you can keep the prefix arg of the previous -command. For example, this can help to reverse the window navigation -direction with e.g. 'C-x o M-- o o'. Also it can help to set a new -step with e.g. 'C-x { C-5 { { {', which will set the window resizing -step to 5 columns. +Type "M-x repeat-mode RET" to enable this mode. You can then type +'C-x u u' instead of 'C-x u C-x u' to undo many changes, 'C-x o o' +instead of 'C-x o C-x o' to switch windows, 'C-x { { } } ^ ^ v v' to +resize the selected window interactively, 'M-g n n p p' to navigate +next-error matches. Any other key exits transient mode and then is +executed normally. 'repeat-exit-key' defines an additional key to +exit mode like 'isearch-exit' ('RET'). The user option +'repeat-exit-timeout' specifies the number of seconds of idle time to +break the repetition chain automatically. With 'repeat-keep-prefix' +you can keep the prefix arg of the previous command. For example, +this can help to reverse the window navigation direction with +e.g. 'C-x o M-- o o'. Also it can help to set a new step with +e.g. 'C-x { C-5 { { {', which will set the window resizing step to 5 +columns. --- ** New themes 'modus-vivendi' and 'modus-operandi'. commit f6826800ea1b2176a7166044d9f769c22a0c9330 Author: Michael Albinus Date: Tue Oct 19 09:43:34 2021 +0200 * etc/NEWS: Move sql entry up. Fix typos. diff --git a/etc/NEWS b/etc/NEWS index 68168b4bbe..9f0a4ac4ce 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -24,9 +24,9 @@ applies, and please also update docstrings as needed. * Installation Changes in Emacs 29.1 -** Emacs now installs the .pdmp file using a unique fingerprint in the name. +** Emacs now installs the ".pdmp" file using a unique fingerprint in the name. The file is typically installed using a file name akin to -...dir/libexec/emacs/29.0.50/x86_64-pc-linux-gnu/emacs-.pdmp +"...dir/libexec/emacs/29.1/x86_64-pc-linux-gnu/emacs-.pdmp". If a constant file name is required, the file can be renamed to "emacs.pdmp", and Emacs will find it during startup anyway. @@ -158,6 +158,14 @@ a prefix argument which is interpreted to mean "include all files". +++ *** The new command 'file-notify-rm-all-watches' removes all file notifications. +** Sql + +--- +*** Sql now supports sending of passwords in-process. +To improve security, if an sql product has ':password-in-comint' set +to t, a password supplied via the minibuffer will be sent in-process, +as opposed to via the command-line. + * New Modes and Packages in Emacs 29.1 @@ -176,19 +184,19 @@ In 'emacs-lisp-mode', forms with a symbol with a name that start with "def" have been automatically indented as if they were 'defun'-like forms, for instance: - (defzot 1 - 2 3) + (defzot 1 + 2 3) This heuristic has now been removed, and all functions/macros that want to be indented this way have to be marked with - (declare (indent defun)) + (declare (indent defun)) or the like. If the function/macro definition itself can't be changed, the indentation can also be adjusted by saying something like: - (put 'defzot 'lisp-indent-function 'defun) + (put 'defzot 'lisp-indent-function 'defun) --- ** The 'inhibit-changing-match-data' variable is now obsolete. @@ -209,7 +217,7 @@ with recent versions of Firefox. +++ ** 'define-key' now understands a new strict 'kbd' representation for keys. -The (define-key map ["C-c M-f"] #'some-command) syntax is now +The '(define-key map ["C-c M-f"] #'some-command)' syntax is now supported, and is like the 'kbd' representation, but is stricter. If the string doesn't represent a valid key sequence, an error is signalled (both when evaluating and byte compiling). @@ -246,12 +254,6 @@ This function allows defining a number of keystrokes with one form. ** New macro 'defvar-keymap'. This macro allows defining keymap variables more conveniently. ---- -**** sql now supports sending of passwords in-process. -To improve security, if a sql product has ':password-in-comint' set to -true, a password supplied via the minibuffer will be sent in-process, -as opposed to via the command-line. - --- ** 'kbd' can now be used in built-in, preloaded libraries. It no longer depends on edmacro.el and cl-lib.el. commit 380981ddb5dac675dafd9edb3d636d24e745c91c Author: Tassilo Horn Date: Tue Oct 19 07:05:18 2021 +0200 Adjust bug-reference-bug-regexp default values to match only at beg of word Previously, the "bug 1" in "(debug 1)" has also been highlighted. * lisp/progmodes/bug-reference.el (bug-reference-bug-regexp) (bug-reference--setup-from-vc-alist,bug-reference-setup-from-mail-alist) (bug-reference-setup-from-irc-alist): Adjust bug-reference-bug-regexp default values to match only at the beginning of a word. diff --git a/lisp/progmodes/bug-reference.el b/lisp/progmodes/bug-reference.el index fd014a38d9..fd435eadfe 100644 --- a/lisp/progmodes/bug-reference.el +++ b/lisp/progmodes/bug-reference.el @@ -72,7 +72,7 @@ so that it is considered safe, see `enable-local-variables'.") (get s 'bug-reference-url-format))))) (defcustom bug-reference-bug-regexp - "\\(\\(?:[Bb]ug ?#?\\|[Pp]atch ?#\\|RFE ?#\\|PR [a-z+-]+/\\)\\([0-9]+\\(?:#[0-9]+\\)?\\)\\)" + "\\(\\b\\(?:[Bb]ug ?#?\\|[Pp]atch ?#\\|RFE ?#\\|PR [a-z+-]+/\\)\\([0-9]+\\(?:#[0-9]+\\)?\\)\\)" "Regular expression matching bug references. The first subexpression defines the region of the bug-reference overlay, i.e., the region being fontified and made clickable in @@ -350,7 +350,7 @@ generated from `bug-reference-forge-alist'." ;; `bug-reference-url-format' and ;; `bug-reference-bug-regexp' aren't set already. ("git\\.\\(?:sv\\|savannah\\)\\.gnu\\.org:" - "\\<\\(\\(?:[Bb]ug ?#?\\)\\([0-9]+\\(?:#[0-9]+\\)?\\)\\)\\>" + "\\(\\b\\(?:[Bb]ug ?#?\\)\\([0-9]+\\(?:#[0-9]+\\)?\\)\\)\\>" ,(lambda (_) "https://debbugs.gnu.org/%s")) ;; Entries for the software forges of @@ -395,7 +395,7 @@ applicable." ,(regexp-opt '("@debbugs.gnu.org" "-devel@gnu.org" ;; List-Id of Gnus devel mailing list. "ding.gnus.org")) - "\\([Bb]ug ?#?\\([0-9]+\\(?:#[0-9]+\\)?\\)\\)" + "\\(\\b[Bb]ug ?#?\\([0-9]+\\(?:#[0-9]+\\)?\\)\\)" "https://debbugs.gnu.org/%s")) "An alist for setting up `bug-reference-mode' in mail modes. @@ -526,7 +526,7 @@ From, and Cc against HEADER-REGEXP in `((,(concat "#" (regexp-opt '("emacs" "gnus" "org-mode" "rcirc" "erc") 'words)) "Libera.Chat" - "\\([Bb]ug ?#?\\([0-9]+\\(?:#[0-9]+\\)?\\)\\)" + "\\(\\b[Bb]ug ?#?\\([0-9]+\\(?:#[0-9]+\\)?\\)\\)" "https://debbugs.gnu.org/%s")) "An alist for setting up `bug-reference-mode' in IRC modes. commit 0be85f22176730b951e9ec18e298c9e1e039d8fb Author: Michael R. Mauger Date: Tue Oct 19 00:18:17 2021 -0400 SQL mode supports sending passwords in process diff --git a/etc/NEWS b/etc/NEWS index 80d4ca9bb2..68168b4bbe 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -246,6 +246,12 @@ This function allows defining a number of keystrokes with one form. ** New macro 'defvar-keymap'. This macro allows defining keymap variables more conveniently. +--- +**** sql now supports sending of passwords in-process. +To improve security, if a sql product has ':password-in-comint' set to +true, a password supplied via the minibuffer will be sent in-process, +as opposed to via the command-line. + --- ** 'kbd' can now be used in built-in, preloaded libraries. It no longer depends on edmacro.el and cl-lib.el. diff --git a/lisp/progmodes/sql.el b/lisp/progmodes/sql.el index 0789c95e87..f5888a0ce7 100644 --- a/lisp/progmodes/sql.el +++ b/lisp/progmodes/sql.el @@ -4659,6 +4659,14 @@ the call to \\[sql-product-interactive] with (get-buffer new-sqli-buffer))))) (user-error "No default SQL product defined: set `sql-product'"))) +(defun sql-comint-automatic-password (_) + "Intercept password prompts when we know the password. +This must also do the job of detecting password prompts." + (when (and + sql-password + (not (string= "" sql-password))) + sql-password)) + (defun sql-comint (product params &optional buf-name) "Set up a comint buffer to run the SQL processor. @@ -4683,6 +4691,13 @@ buffer. If nil, a name is chosen for it." (setq buf-name (sql-generate-unique-sqli-buffer-name product nil))) (set-text-properties 0 (length buf-name) nil buf-name) + ;; Create the buffer first, because we want to set it up before + ;; comint starts to run. + (set-buffer (get-buffer-create buf-name)) + ;; Set up the automatic population of passwords, if supported. + (when (sql-get-product-feature product :password-in-comint) + (setq comint-password-function #'sql-comint-automatic-password)) + ;; Start the command interpreter in the buffer ;; PROC-NAME is BUF-NAME without enclosing asterisks (let ((proc-name (replace-regexp-in-string "\\`[*]\\(.*\\)[*]\\'" "\\1" buf-name))) diff --git a/test/lisp/progmodes/sql-tests.el b/test/lisp/progmodes/sql-tests.el index 99b79b61d6..aed82b1882 100644 --- a/test/lisp/progmodes/sql-tests.el +++ b/test/lisp/progmodes/sql-tests.el @@ -416,6 +416,16 @@ The ACTION will be tested after set-up of PRODUCT." (kill-buffer "*SQL: exist*"))) +(ert-deftest sql-tests-comint-automatic-password () + (let ((sql-password nil)) + (should-not (sql-comint-automatic-password "Password: "))) + (let ((sql-password "")) + (should-not (sql-comint-automatic-password "Password: "))) + (let ((sql-password "password")) + (should (equal "password" (sql-comint-automatic-password "Password: ")))) + ;; Also, we shouldn't care what the password is - we rely on comint for that. + (let ((sql-password "password")) + (should (equal "password" (sql-comint-automatic-password ""))))) (provide 'sql-tests) ;;; sql-tests.el ends here commit dcb815ac8a5d52a269fbb45b78235b81c6aa11b5 Author: Michael R. Mauger Date: Mon Oct 11 20:04:46 2021 -0400 Added sql-add-connection * lisp/progmodes/sql.el (sql-add-connection): Added. diff --git a/lisp/progmodes/sql.el b/lisp/progmodes/sql.el index f55115e902..0789c95e87 100644 --- a/lisp/progmodes/sql.el +++ b/lisp/progmodes/sql.el @@ -481,9 +481,9 @@ file. Since that is a plaintext file, this could be dangerous." :list-all ("\\d+" . "\\dS+") :list-table ("\\d+ %s" . "\\dS+ %s") :completion-object sql-postgres-completion-object - :prompt-regexp "^[[:alnum:]_]*=[#>] " + :prompt-regexp "^[-[:alnum:]_]*[-=][#>] " :prompt-length 5 - :prompt-cont-regexp "^[[:alnum:]_]*[-(][#>] " + :prompt-cont-regexp "^[-[:alnum:]_]*[-'(][#>] " :statement sql-postgres-statement-starters :input-filter sql-remove-tabs-filter :terminator ("\\(^\\s-*\\\\g\\|;\\)" . "\\g")) @@ -700,8 +700,17 @@ making new SQLi sessions." (sexp :tag "Value Expression"))))) :version "24.1") -(defvaralias 'sql-dialect 'sql-product) +(defun sql-add-connection (connection params) + "Add a new connection to `sql-connection-alist'. +If CONNECTION already exists, it is replaced with PARAMS." + (setq sql-connection-alist + (assoc-delete-all connection sql-connection-alist)) + (push + (cons connection params) + sql-connection-alist)) + +(defvaralias 'sql-dialect 'sql-product) (defcustom sql-product 'ansi "Select the SQL database product used. This allows highlighting buffers properly when you open them." commit c1cf95a0e1b9104aa4bea022b98371fdf36e5467 Author: Pedro Mauro Date: Tue Oct 19 05:14:07 2021 +0200 ; * doc/emacs/windows.texi: Doc fix. * doc/emacs/windows.texi (Window Choice): Make example a valid alist (bug#51274). diff --git a/doc/emacs/windows.texi b/doc/emacs/windows.texi index facbc7f3ed..8cb88a2095 100644 --- a/doc/emacs/windows.texi +++ b/doc/emacs/windows.texi @@ -444,7 +444,7 @@ selected window write: @group (customize-set-variable 'display-buffer-alist - '("\\*scratch\\*" (display-buffer-same-window))) + '(("\\*scratch\\*" (display-buffer-same-window)))) @end group @end example commit f3aa648093a70c8ed15e764863a16fdf7126cdc4 Author: Lars Ingebrigtsen Date: Tue Oct 19 05:07:51 2021 +0200 Make `lookup-key' understand the new key sequence syntax * src/keymap.c (possibly_translate_key_sequence): Factored out into own function. (Fdefine_key): (Flookup_key): Use it. diff --git a/src/keymap.c b/src/keymap.c index 60e736efc7..ca1dbe368e 100644 --- a/src/keymap.c +++ b/src/keymap.c @@ -1024,6 +1024,28 @@ is not copied. */) /* Simple Keymap mutators and accessors. */ +static Lisp_Object +possibly_translate_key_sequence (Lisp_Object key, ptrdiff_t *length) +{ + if (VECTORP (key) && ASIZE (key) == 1 && STRINGP (AREF (key, 0))) + { + /* KEY is on the ["C-c"] format, so translate to internal + format. */ + if (NILP (Ffboundp (Qkbd_valid_p))) + xsignal2 (Qerror, + build_string ("`kbd-valid-p' is not defined, so this syntax can't be used: %s"), + key); + if (NILP (call1 (Qkbd_valid_p, AREF (key, 0)))) + xsignal2 (Qerror, build_string ("Invalid `kbd' syntax: %S"), key); + key = call1 (Qkbd, AREF (key, 0)); + *length = CHECK_VECTOR_OR_STRING (key); + if (*length == 0) + xsignal2 (Qerror, build_string ("Invalid `kbd' syntax: %S"), key); + } + + return key; +} + /* GC is possible in this function if it autoloads a keymap. */ DEFUN ("define-key", Fdefine_key, Sdefine_key, 3, 3, 0, @@ -1084,21 +1106,7 @@ binding KEY to DEF is added at the front of KEYMAP. */) def = tmp; } - if (VECTORP (key) && ASIZE (key) == 1 && STRINGP (AREF (key, 0))) - { - /* KEY is on the ["C-c"] format, so translate to internal - format. */ - if (NILP (Ffboundp (Qkbd_valid_p))) - xsignal2 (Qerror, - build_string ("`kbd-valid-p' is not defined, so this syntax can't be used: %s"), - key); - if (NILP (call1 (Qkbd_valid_p, AREF (key, 0)))) - xsignal2 (Qerror, build_string ("Invalid `kbd' syntax: %S"), key); - key = call1 (Qkbd, AREF (key, 0)); - length = CHECK_VECTOR_OR_STRING (key); - if (length == 0) - xsignal2 (Qerror, build_string ("Invalid `kbd' syntax: %S"), key); - } + key = possibly_translate_key_sequence (key, &length); ptrdiff_t idx = 0; while (1) @@ -1229,6 +1237,8 @@ recognize the default bindings, just as `read-key-sequence' does. */) if (length == 0) return keymap; + key = possibly_translate_key_sequence (key, &length); + ptrdiff_t idx = 0; while (1) { diff --git a/test/src/keymap-tests.el b/test/src/keymap-tests.el index 68b42c346c..13f47b45f8 100644 --- a/test/src/keymap-tests.el +++ b/test/src/keymap-tests.el @@ -317,6 +317,13 @@ g .. h foo (should (equal (single-key-description 'C-s-home) "C-s-"))) +(ert-deftest keymap-test-lookups () + (should (eq (lookup-key (current-global-map) "\C-x\C-f") 'find-file)) + (should (eq (lookup-key (current-global-map) [(control x) (control f)]) + 'find-file)) + (should (eq (lookup-key (current-global-map) ["C-x C-f"]) 'find-file)) + (should (eq (lookup-key (current-global-map) [?\C-x ?\C-f]) 'find-file))) + (provide 'keymap-tests) ;;; keymap-tests.el ends here commit 5c996471babfca2ac54591f7182d31fe7df151f0 Author: Lars Ingebrigtsen Date: Tue Oct 19 04:50:59 2021 +0200 Error out on invalid `define-keymap' keywords * lisp/subr.el (define-keymap--define): Error out on invalid keywords (bug#51268). * lisp/emacs-lisp/byte-opt.el (byte-optimize-define-keymap): Check keywords at compile time. * lisp/vc/cvs-status.el (cvs-status-mode-map): Fix keyword. diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index abfc9b3b31..9b3b2e5ce1 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -1211,6 +1211,9 @@ See Info node `(elisp) Integer Basics'." (while (and form (keywordp (car form)) (not (eq (car form) :menu))) + (unless (memq (car form) + '(:full :keymap :parent :suppress :name :prefix)) + (error "Invalid keyword: %s" (car form))) (push (pop form) result) (when (null form) (error "Uneven number of keywords in %S" form)) diff --git a/lisp/subr.el b/lisp/subr.el index 78709b7fa9..91189787d5 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -6664,7 +6664,8 @@ should be a MENU form as accepted by `easy-menu-define'. (:parent (setq parent value)) (:suppress (setq suppress value)) (:name (setq name value)) - (:prefix (setq prefix value)))))) + (:prefix (setq prefix value)) + (_ (error "Invalid keyword: %s" keyword)))))) (when (and prefix (or full parent suppress keymap)) diff --git a/lisp/vc/cvs-status.el b/lisp/vc/cvs-status.el index 723f277e07..86b62eb1ce 100644 --- a/lisp/vc/cvs-status.el +++ b/lisp/vc/cvs-status.el @@ -35,7 +35,7 @@ ;;; (defvar-keymap cvs-status-mode-map - :inherit 'cvs-mode-map + :parent 'cvs-mode-map "n" #'next-line "p" #'previous-line "N" #'cvs-status-next commit fbf7dd3ccecda778f6ea70d0ad6778b138e73e1d Author: Lars Ingebrigtsen Date: Mon Oct 18 18:55:48 2021 +0200 Fix diff-mode-shared-map * lisp/vc/diff-mode.el (diff-mode-shared-map): Fix syntax error in `defvar-keymap' change. diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el index da70ff00dd..ae1a8b254f 100644 --- a/lisp/vc/diff-mode.el +++ b/lisp/vc/diff-mode.el @@ -164,7 +164,7 @@ and hunk-based syntax highlighting otherwise as a fallback." ;;;; (defvar-keymap diff-mode-shared-map - :inherit special-mode-map + :parent special-mode-map "n" #'diff-hunk-next "N" #'diff-file-next "p" #'diff-hunk-prev commit 98eb6d783a482cd7ebca7ec656b0775b82c68e57 Author: Stefan Kangas Date: Tue Oct 19 02:36:06 2021 +0200 Fix a typo in emacs-lisp-intro.texi * doc/lispintro/emacs-lisp-intro.texi (Lisp Atoms): Fix typo. Reported by Mor Zahavi . (Bug#51271) diff --git a/doc/lispintro/emacs-lisp-intro.texi b/doc/lispintro/emacs-lisp-intro.texi index 6ecd552ebb..3897e5a062 100644 --- a/doc/lispintro/emacs-lisp-intro.texi +++ b/doc/lispintro/emacs-lisp-intro.texi @@ -1177,7 +1177,7 @@ are different from the meaning the letters make as a word. For example, the word for the South American sloth, the @samp{ai}, is completely different from the two words, @samp{a}, and @samp{i}. -There are many kinds of atom in nature but only a few in Lisp: for +There are many kinds of atoms in nature but only a few in Lisp: for example, @dfn{numbers}, such as 37, 511, or 1729, and @dfn{symbols}, such as @samp{+}, @samp{foo}, or @samp{forward-line}. The words we have listed in the examples above are all symbols. In everyday Lisp commit 34d4aca4d991c6c4483991852ebc30057b41a9fc Author: Stefan Kangas Date: Mon Oct 18 22:35:40 2021 +0200 Add tests for image.c * test/src/image-tests.el: New file. diff --git a/test/src/image-tests.el b/test/src/image-tests.el new file mode 100644 index 0000000000..4437d7941e --- /dev/null +++ b/test/src/image-tests.el @@ -0,0 +1,205 @@ +;;; image-tests.el --- Tests for image.c -*- lexical-binding: t -*- + +;; Copyright (C) 2021 Free Software Foundation, Inc. + +;; Author: Stefan Kangas + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Commentary: + +;; Most of these tests will only run in a GUI session, and not with +;; "make check". Run them manually in an interactive session with +;; `M-x eval-buffer' followed by `M-x ert'. + +;;; Code: + +(require 'ert) + +(defmacro image-skip-unless (format) + `(skip-unless (and (display-images-p) + (image-type-available-p ,format)))) + +;;;; Images + +(defconst image-tests--files + `((jpeg . ,(create-image (expand-file-name + "test/data/image/black.jpg" + source-directory))) + (pbm . ,(find-image '((:file "splash.svg" :type svg)))) + (png . ,(find-image '((:file "splash.png" :type png)))) + (svg . ,(find-image '((:file "splash.pbm" :type pbm)))) + (tiff . ,(create-image (expand-file-name + "nextstep/GNUstep/Emacs.base/Resources/emacs.tiff" + source-directory))) + (xbm . ,(find-image '((:file "gnus/gnus.xbm" :type xbm)))) + (xpm . ,(find-image '((:file "splash.xpm" :type xpm)))) + ;; TODO: gif + )) + +;;;; image-test-size + +(ert-deftest image-tests-image-size/jpeg () + (image-skip-unless 'jpeg) + (pcase (image-size (cdr (assq 'jpeg image-tests--files))) + (`(,a . ,b) + (should (floatp a)) + (should (floatp b))))) + +(ert-deftest image-tests-image-size/pbm () + (image-skip-unless 'pbm) + (pcase (image-size (cdr (assq 'pbm image-tests--files))) + (`(,a . ,b) + (should (floatp a)) + (should (floatp b))))) + +(ert-deftest image-tests-image-size/png () + (image-skip-unless 'png) + (pcase (image-size (cdr (assq 'png image-tests--files))) + (`(,a . ,b) + (should (floatp a)) + (should (floatp b))))) + +(ert-deftest image-tests-image-size/svg () + (image-skip-unless 'svg) + (pcase (image-size (cdr (assq 'svg image-tests--files))) + (`(,a . ,b) + (should (floatp a)) + (should (floatp b))))) + +(ert-deftest image-tests-image-size/tiff () + (image-skip-unless 'tiff) + (pcase (image-size (cdr (assq 'tiff image-tests--files))) + (`(,a . ,b) + (should (floatp a)) + (should (floatp b))))) + +(ert-deftest image-tests-image-size/xbm () + (image-skip-unless 'xbm) + (pcase (image-size (cdr (assq 'xbm image-tests--files))) + (`(,a . ,b) + (should (floatp a)) + (should (floatp b))))) + +(ert-deftest image-tests-image-size/xpm () + (image-skip-unless 'xpm) + (pcase (image-size (cdr (assq 'xpm image-tests--files))) + (`(,a . ,b) + (should (floatp a)) + (should (floatp b))))) + +(ert-deftest image-tests-image-size/error-on-invalid-spec () + (skip-unless (display-images-p)) + (should-error (image-size 'invalid-spec))) + +(ert-deftest image-tests-image-size/error-on-nongraphical-display () + (skip-unless (not (display-images-p))) + (should-error (image-size 'invalid-spec))) + +;;;; image-mask-p + +(ert-deftest image-tests-image-mask-p/jpeg () + (image-skip-unless 'jpeg) + (should-not (image-mask-p (cdr (assq 'jpeg image-tests--files))))) + +(ert-deftest image-tests-image-mask-p/pbm () + (image-skip-unless 'pbm) + (should-not (image-mask-p (cdr (assq 'pbm image-tests--files))))) + +(ert-deftest image-tests-image-mask-p/png () + (image-skip-unless 'png) + (should-not (image-mask-p (cdr (assq 'png image-tests--files))))) + +(ert-deftest image-tests-image-mask-p/svg () + (image-skip-unless 'svg) + (should-not (image-mask-p (cdr (assq 'svg image-tests--files))))) + +(ert-deftest image-tests-image-mask-p/tiff () + (image-skip-unless 'tiff) + (should-not (image-mask-p (cdr (assq 'tiff image-tests--files))))) + +(ert-deftest image-tests-image-mask-p/xbm () + (image-skip-unless 'xbm) + (should-not (image-mask-p (cdr (assq 'xbm image-tests--files))))) + +(ert-deftest image-tests-image-mask-p/xpm () + (image-skip-unless 'xpm) + (should-not (image-mask-p (cdr (assq 'xpm image-tests--files))))) + +(ert-deftest image-tests-image-mask-p/error-on-invalid-spec () + (skip-unless (display-images-p)) + (should-error (image-mask-p 'invalid-spec))) + +(ert-deftest image-tests-image-mask-p/error-on-nongraphical-display () + (skip-unless (not (display-images-p))) + (should-error (image-mask-p (cdr (assq 'xpm image-tests--files))))) + +;;;; image-metadata + +;; TODO: These tests could be expanded with files that actually +;; contain metadata. + +(ert-deftest image-tests-image-metadata/jpeg () + (image-skip-unless 'jpeg) + (should-not (image-metadata (cdr (assq 'jpeg image-tests--files))))) + +(ert-deftest image-tests-image-metadata/pbm () + (image-skip-unless 'pbm) + (should-not (image-metadata (cdr (assq 'pbm image-tests--files))))) + +(ert-deftest image-tests-image-metadata/png () + (image-skip-unless 'png) + (should-not (image-metadata (cdr (assq 'png image-tests--files))))) + +(ert-deftest image-tests-image-metadata/svg () + (image-skip-unless 'svg) + (should-not (image-metadata (cdr (assq 'svg image-tests--files))))) + +(ert-deftest image-tests-image-metadata/tiff () + (image-skip-unless 'tiff) + (should-not (image-metadata (cdr (assq 'tiff image-tests--files))))) + +(ert-deftest image-tests-image-metadata/xbm () + (image-skip-unless 'xbm) + (should-not (image-metadata (cdr (assq 'xbm image-tests--files))))) + +(ert-deftest image-tests-image-metadata/xpm () + (image-skip-unless 'xpm) + (should-not (image-metadata (cdr (assq 'xpm image-tests--files))))) + +(ert-deftest image-tests-image-metadata/nil-on-invalid-spec () + (skip-unless (display-images-p)) + (should-not (image-metadata 'invalid-spec))) + +(ert-deftest image-tests-image-metadata/error-on-nongraphical-display () + (skip-unless (not (display-images-p))) + (should-error (image-metadata (cdr (assq 'xpm image-tests--files))))) + +;;;; ImageMagick + +(ert-deftest image-tests-imagemagick-types () + (skip-unless (fboundp 'imagemagick-types)) + (when (fboundp 'imagemagick-types) + (should (listp (imagemagick-types))))) + +;;;; Initialization + +(ert-deftest image-tests-init-image-library () + (should (init-image-library 'pbm)) ; built-in + (should (init-image-library 'xpm)) ; built-in + (should-not (init-image-library 'invalid-image-type))) + +;;; image-tests.el ends here commit f5b8f626e3d7233a935e67ffc5ffee0de9069ae5 Author: Michael Albinus Date: Mon Oct 18 19:54:13 2021 +0200 Fix some Tramp problems * lisp/net/tramp-adb.el (tramp-adb-file-name-handler-alist): Use `tramp-adb-handle-file-executable-p' and `tramp-adb-handle-file-readable-p'. (tramp-adb-handle-file-executable-p) (tramp-adb-handle-file-readable-p): New defuns. (tramp-adb-handle-file-writable-p): Simplify. (tramp-adb-handle-make-process): Handle :filter being t. (tramp-adb-find-test-command): Remove. * lisp/net/tramp-sh.el (tramp-sh-handle-file-readable-p): * lisp/net/tramp-sudoedit.el (tramp-sudoedit-handle-file-readable-p): * lisp/net/tramp-gvfs.el (tramp-gvfs-file-name-handler-alist): Use `tramp-handle-file-readable-p'. (tramp-gvfs-handle-file-executable-p): Do not check whether file exists, this is done in `tramp-check-cached-permissions'. (tramp-gvfs-handle-file-readable-p): Remove. * lisp/net/tramp.el (tramp-error): Move binding of `inhibit-message' ... (tramp-signal-hook-function): ... here. (tramp-handle-access-file): Rewrite. (tramp-handle-file-readable-p): New defun. (tramp-handle-make-process): Setting :filter to t works since Emacs 29.1 only. * test/lisp/net/tramp-tests.el (tramp-test17-insert-directory) (tramp-test18-file-attributes): Extend tests. diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el index 6d8bed1d78..362a258f43 100644 --- a/lisp/net/tramp-adb.el +++ b/lisp/net/tramp-adb.el @@ -128,8 +128,7 @@ It is used for TCP/IP devices." (file-attributes . tramp-adb-handle-file-attributes) (file-directory-p . tramp-handle-file-directory-p) (file-equal-p . tramp-handle-file-equal-p) - ;; FIXME: This is too sloppy. - (file-executable-p . tramp-handle-file-exists-p) + (file-executable-p . tramp-adb-handle-file-executable-p) (file-exists-p . tramp-handle-file-exists-p) (file-in-directory-p . tramp-handle-file-in-directory-p) (file-local-copy . tramp-adb-handle-file-local-copy) @@ -147,7 +146,7 @@ It is used for TCP/IP devices." (file-notify-rm-watch . tramp-handle-file-notify-rm-watch) (file-notify-valid-p . tramp-handle-file-notify-valid-p) (file-ownership-preserved-p . ignore) - (file-readable-p . tramp-handle-file-exists-p) + (file-readable-p . tramp-adb-handle-file-readable-p) (file-regular-p . tramp-handle-file-regular-p) (file-remote-p . tramp-handle-file-remote-p) (file-selinux-context . tramp-handle-file-selinux-context) @@ -515,28 +514,31 @@ Emacs dired can't find files." (set-file-modes tmpfile (logior (or (file-modes filename) 0) #o0400))) tmpfile))) +(defun tramp-adb-handle-file-executable-p (filename) + "Like `file-executable-p' for Tramp files." + (with-parsed-tramp-file-name filename nil + (with-tramp-file-property v localname "file-executable-p" + (tramp-adb-send-command-and-check + v (format "test -x %s" (tramp-shell-quote-argument localname)))))) + +(defun tramp-adb-handle-file-readable-p (filename) + "Like `file-readable-p' for Tramp files." + (with-parsed-tramp-file-name filename nil + (with-tramp-file-property v localname "file-readable-p" + (or (tramp-handle-file-readable-p filename) + (tramp-adb-send-command-and-check + v (format "test -r %s" (tramp-shell-quote-argument localname))))))) + (defun tramp-adb-handle-file-writable-p (filename) - "Like `file-writable-p' for Tramp files. -But handle the case, if the \"test\" command is not available." + "Like `file-writable-p' for Tramp files." (with-parsed-tramp-file-name filename nil (with-tramp-file-property v localname "file-writable-p" - (if (tramp-adb-find-test-command v) - (if (file-exists-p filename) - (tramp-adb-send-command-and-check - v (format "test -w %s" (tramp-shell-quote-argument localname))) - (and - (file-directory-p (file-name-directory filename)) - (file-writable-p (file-name-directory filename)))) - - ;; Missing "test" command on Android < 4. - (let ((rw-path "/data/data")) - (tramp-message - v 5 - "Not implemented yet (assuming \"/data/data\" is writable): %s" - localname) - (and (>= (length localname) (length rw-path)) - (string= (substring localname 0 (length rw-path)) - rw-path))))))) + (if (file-exists-p filename) + (tramp-adb-send-command-and-check + v (format "test -w %s" (tramp-shell-quote-argument localname))) + (and + (file-directory-p (file-name-directory filename)) + (file-writable-p (file-name-directory filename))))))) (defun tramp-adb-handle-write-region (start end filename &optional append visit lockname mustbenew) @@ -1043,12 +1045,13 @@ implementation will be used." (rename-file remote-tmpstderr stderr)))) ;; Read initial output. Remove the first ;; line, which is the command echo. - (while - (progn - (goto-char (point-min)) - (not (re-search-forward "[\n]" nil t))) - (tramp-accept-process-output p 0)) - (delete-region (point-min) (point)) + (unless (eq filter t) + (while + (progn + (goto-char (point-min)) + (not (re-search-forward "[\n]" nil t))) + (tramp-accept-process-output p 0)) + (delete-region (point-min) (point))) ;; Provide error buffer. This shows only ;; initial error messages; messages arriving ;; later on will be inserted when the @@ -1141,12 +1144,6 @@ error and non-nil on success." (let ((inhibit-read-only t)) (delete-region (point-min) (point-max))) (zerop (apply #'tramp-call-process vec tramp-adb-program nil t nil args)))) -(defun tramp-adb-find-test-command (vec) - "Check whether the ash has a builtin \"test\" command. -This happens for Android >= 4.0." - (with-tramp-connection-property vec "test" - (tramp-adb-send-command-and-check vec "type test"))) - ;; Connection functions (defun tramp-adb-send-command (vec command &optional neveropen nooutput) diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el index 115d005c0c..ebe57a8bce 100644 --- a/lisp/net/tramp-gvfs.el +++ b/lisp/net/tramp-gvfs.el @@ -788,7 +788,7 @@ It has been changed in GVFS 1.14.") (file-notify-rm-watch . tramp-handle-file-notify-rm-watch) (file-notify-valid-p . tramp-handle-file-notify-valid-p) (file-ownership-preserved-p . ignore) - (file-readable-p . tramp-gvfs-handle-file-readable-p) + (file-readable-p . tramp-handle-file-readable-p) (file-regular-p . tramp-handle-file-regular-p) (file-remote-p . tramp-handle-file-remote-p) (file-selinux-context . tramp-handle-file-selinux-context) @@ -1396,8 +1396,7 @@ If FILE-SYSTEM is non-nil, return file system attributes." "Like `file-executable-p' for Tramp files." (with-parsed-tramp-file-name filename nil (with-tramp-file-property v localname "file-executable-p" - (and (file-exists-p filename) - (tramp-check-cached-permissions v ?x))))) + (tramp-check-cached-permissions v ?x)))) (defun tramp-gvfs-handle-file-name-all-completions (filename directory) "Like `file-name-all-completions' for Tramp files." @@ -1519,31 +1518,6 @@ If FILE-SYSTEM is non-nil, return file system attributes." (when string (tramp-message proc 10 "Rest string:\n%s" string)) (process-put proc 'rest-string string))) -(defun tramp-gvfs-handle-file-readable-p (filename) - "Like `file-readable-p' for Tramp files." - (with-parsed-tramp-file-name filename nil - (with-tramp-file-property v localname "file-readable-p" - (and (file-exists-p filename) - (or (tramp-check-cached-permissions v ?r) - ;; `tramp-check-cached-permissions' doesn't handle - ;; symbolic links. - (and (stringp (file-symlink-p filename)) - (file-readable-p - (concat - (file-remote-p filename) (file-symlink-p filename)))) - ;; If the user is different from what we guess to be - ;; the user, we don't know. Let's check, whether - ;; access is restricted explicitly. - (and (/= (tramp-get-remote-uid v 'integer) - (tramp-compat-file-attribute-user-id - (file-attributes filename 'integer))) - (not - (string-equal - "FALSE" - (cdr (assoc - "access::can-read" - (tramp-gvfs-get-file-attributes filename))))))))))) - (defun tramp-gvfs-handle-file-system-info (filename) "Like `file-system-info' for Tramp files." (setq filename (directory-file-name (expand-file-name filename))) diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 6984dd8b42..6f3b324522 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -1580,9 +1580,7 @@ ID-FORMAT valid values are `string' and `integer'." "Like `file-readable-p' for Tramp files." (with-parsed-tramp-file-name filename nil (with-tramp-file-property v localname "file-readable-p" - ;; Examine `file-attributes' cache to see if request can be - ;; satisfied without remote operation. - (or (tramp-check-cached-permissions v ?r) + (or (tramp-handle-file-readable-p filename) (tramp-run-test "-r" filename))))) ;; Functions implemented using the basic functions above. diff --git a/lisp/net/tramp-sudoedit.el b/lisp/net/tramp-sudoedit.el index 516d46da37..845f31d09b 100644 --- a/lisp/net/tramp-sudoedit.el +++ b/lisp/net/tramp-sudoedit.el @@ -464,8 +464,9 @@ the result will be a local, non-Tramp, file name." "Like `file-readable-p' for Tramp files." (with-parsed-tramp-file-name filename nil (with-tramp-file-property v localname "file-readable-p" - (tramp-sudoedit-send-command - v "test" "-r" (tramp-compat-file-name-unquote localname))))) + (or (tramp-handle-file-readable-p filename) + (tramp-sudoedit-send-command + v "test" "-r" (tramp-compat-file-name-unquote localname)))))) (defun tramp-sudoedit-handle-set-file-modes (filename mode &optional flag) "Like `set-file-modes' for Tramp files." diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 318b4e454d..372e0a2cb7 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -2087,8 +2087,7 @@ VEC-OR-PROC identifies the connection to use, SIGNAL is the signal identifier to be raised, remaining arguments passed to `tramp-message'. Finally, signal SIGNAL is raised with FMT-STRING and ARGUMENTS." - (let ((inhibit-message t) - signal-hook-function) + (let (signal-hook-function) (tramp-backtrace vec-or-proc) (unless arguments ;; FMT-STRING could be just a file name, as in @@ -2198,9 +2197,10 @@ the resulting error message." ;; `custom-initialize-*' functions provoke `void-variable' errors. ;; We don't want to see them in the backtrace. (unless (eq error-symbol 'void-variable) - (tramp-error - (car tramp-current-connection) error-symbol - (mapconcat (lambda (x) (format "%s" x)) data " ")))) + (let ((inhibit-message t)) + (tramp-error + (car tramp-current-connection) error-symbol + (mapconcat (lambda (x) (format "%s" x)) data " "))))) (put #'tramp-signal-hook-function 'tramp-suppress-trace t) @@ -3275,10 +3275,18 @@ User is always nil." (defun tramp-handle-access-file (filename string) "Like `access-file' for Tramp files." - (unless (file-readable-p (file-truename filename)) - (tramp-compat-file-missing - (tramp-dissect-file-name filename) - (format "%s: %s" string filename)))) + (setq filename (file-truename filename)) + (with-parsed-tramp-file-name filename v + (if (file-exists-p filename) + (unless + (funcall + (if (file-directory-p filename) + #'file-accessible-directory-p #'file-readable-p) + filename) + (tramp-error + v 'file-error (format "%s: Permission denied, %s" string filename))) + (tramp-compat-file-missing + v (format "%s: No such file or directory, %s" string filename))))) (defun tramp-handle-add-name-to-file (filename newname &optional ok-if-already-exists) @@ -3568,6 +3576,17 @@ User is always nil." (tramp-compat-file-attribute-modification-time (file-attributes file1)))))) +(defun tramp-handle-file-readable-p (filename) + "Like `file-readable-p' for Tramp files." + (with-parsed-tramp-file-name filename nil + (with-tramp-file-property v localname "file-readable-p" + (or (tramp-check-cached-permissions v ?r) + ;; `tramp-check-cached-permissions' doesn't handle symbolic + ;; links. + (when-let ((symlink (file-symlink-p filename))) + (and (stringp symlink) + (file-readable-p (concat (file-remote-p filename) symlink)))))))) + (defun tramp-handle-file-regular-p (filename) "Like `file-regular-p' for Tramp files." (and (file-exists-p filename) @@ -4220,7 +4239,12 @@ substitution. SPEC-LIST is a list of char/value pairs used for :name name :buffer buffer :command (append `(,login-program) login-args command) :coding coding :noquery noquery :connection-type connection-type - :filter filter :sentinel sentinel :stderr stderr)) + :sentinel sentinel :stderr stderr)) + ;; Set filter. Prior Emacs 29.1, it doesn't work reliable + ;; to provide it as `make-process' argument when filter is + ;; t. See Bug#51177. + (when filter + (set-process-filter p filter)) (tramp-message v 6 "%s" (string-join (process-command p) " ")) p)))))) diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index da15401be0..8c7fc48848 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -3159,7 +3159,20 @@ This tests also `file-directory-p' and `file-accessible-directory-p'." (regexp-opt (directory-files tmp-name1)) (length (directory-files tmp-name1))))))) - ;; Check error case. + ;; Check error cases. + (when (and (tramp--test-supports-file-modes-p) + ;; With "sshfs", directories with zero file + ;; modes are still "accessible". + (not (tramp--test-sshfs-p)) + ;; A directory is always accessible for user "root". + (not (zerop (tramp-compat-file-attribute-user-id + (file-attributes tmp-name1))))) + (set-file-modes tmp-name1 0) + (with-temp-buffer + (should-error + (insert-directory tmp-name1 nil) + :type 'file-error)) + (set-file-modes tmp-name1 #o777)) (delete-directory tmp-name1 'recursive) (with-temp-buffer (should-error @@ -3372,9 +3385,22 @@ This tests also `access-file', `file-readable-p', (tramp-get-remote-gid tramp-test-vec 'integer))) (delete-file tmp-name1)) + (when (and (tramp--test-supports-file-modes-p) + ;; A file is always accessible for user "root". + (not (zerop (tramp-compat-file-attribute-user-id + (file-attributes + tramp-test-temporary-file-directory))))) + (write-region "foo" nil tmp-name1) + (set-file-modes tmp-name1 0) + (should-error + (access-file tmp-name1 "error") + :type 'file-error) + (set-file-modes tmp-name1 #o777) + (delete-file tmp-name1)) (should-error (access-file tmp-name1 "error") :type tramp-file-missing) + ;; `file-ownership-preserved-p' should return t for ;; non-existing files. (when test-file-ownership-preserved-p commit fc988a71136b6f875823e0dc03a7c1cba102dc59 Author: Michael Albinus Date: Mon Oct 18 19:53:34 2021 +0200 Adapt Tramp manual * doc/misc/tramp.texi: Use @uref instead of @url. (Frequently Asked Questions): Adapt ELPA references. diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi index 8cc3eafc87..4e95b1211f 100644 --- a/doc/misc/tramp.texi +++ b/doc/misc/tramp.texi @@ -1071,7 +1071,7 @@ capable of servicing requests from @value{tramp}. This non-native @value{tramp} method connects via the Server Message Block (SMB) networking protocol to hosts running file servers that are -typically based on @url{https://www.samba.org/,,Samba} or MS Windows. +typically based on @uref{https://www.samba.org/,,Samba} or MS Windows. Using @command{smbclient} requires a few tweaks when working with @value{tramp}: @@ -1323,7 +1323,7 @@ possible, @value{tramp} emulates those operations otherwise. @vindex tramp-rclone-program The program @command{rclone} allows to access different system -storages in the cloud, see @url{https://rclone.org/} for a list of +storages in the cloud, see @uref{https://rclone.org/} for a list of supported systems. If the @command{rclone} program isn't found in your @env{PATH} environment variable, you can tell @value{tramp} its absolute path via the user option @code{tramp-rclone-program}. @@ -1362,7 +1362,7 @@ for accessing the system storage, you should use it. On local hosts which have installed the @command{sshfs} client for mounting a file system based on @command{sftp}, this method can be used, see -@url{https://github.com/libfuse/sshfs/blob/master/README.rst/}. If +@uref{https://github.com/libfuse/sshfs/blob/master/README.rst/}. If the @command{sshfs} program isn't found in your @env{PATH} environment variable, you can tell @value{tramp} its absolute path via the user option @code{tramp-sshfs-program}. @@ -5192,13 +5192,14 @@ tramp-compat-with-mutex} @value{tramp} comes with compatibility code for different Emacs versions. When you see such a message (the text might differ), you -don't use the Emacs built-in version of @value{tramp}. In case you -have installed @value{tramp} from GNU ELPA, +don't use the Emacs built-in version of @value{tramp}, and you must +recompile it. In case you have installed @value{tramp} from GNU ELPA, @ifset installchapter -@xref{ELPA Installation}. +@xref{ELPA Installation}. Otherwise, @xref{Recompilation}. @end ifset @ifclear installchapter -see the package README file for instructions how to recompile it. +see @uref{@value{trampurl}#ELPA-Installation}. Otherwise, see +@uref{@value{trampurl}#Recompilation}. @end ifclear commit 0c241043a88e0c93ad752cfefd581dcc4a273509 Author: Martin Rudalics Date: Mon Oct 18 19:18:42 2021 +0200 Further fixes to Elisp manual * doc/lispref/frames.texi (Frame Layout): Index "tab bar" instead of "internal tab bar". (Implied Frame Resizing): Remove irritating hyphens. * doc/lispref/windows.texi (Windows and Frames): Remove paragraph relating 'minibuffer-window' to 'window-list'. diff --git a/doc/lispref/frames.texi b/doc/lispref/frames.texi index f851d12c08..56ac711813 100644 --- a/doc/lispref/frames.texi +++ b/doc/lispref/frames.texi @@ -642,7 +642,7 @@ automatically increase the outer width of a frame in order to accommodate an overlong tool bar. @item Tab Bar -@cindex internal tab bar +@cindex tab bar The tab bar (@pxref{Tab Bars,,,emacs, The GNU Emacs Manual}) is always drawn by Emacs itself. The tab bar appears above the tool bar in Emacs built with an internal tool bar, and below the tool bar in @@ -1218,10 +1218,10 @@ width of one scroll bar provided this option is @code{nil} and keep it unchanged if this option is @code{t} or a list containing @code{vertical-scroll-bars}. -The default value is @code{'(tab-bar-lines tool-bar-lines)} for Lucid, +The default value is @code{(tab-bar-lines tool-bar-lines)} for Lucid, Motif and MS-Windows (which means that adding/removing a tool or tab bar there does not change the outer frame height), -@code{'(tab-bar-lines)} on all other window systems including GTK+ +@code{(tab-bar-lines)} on all other window systems including GTK+ (which means that changing any of the parameters listed above with the exception of @code{tab-bar-lines} may change the size of the outer frame), and @code{t} otherwise (which means the outer frame size never diff --git a/doc/lispref/windows.texi b/doc/lispref/windows.texi index c66ae173e4..0ae26b2f58 100644 --- a/doc/lispref/windows.texi +++ b/doc/lispref/windows.texi @@ -213,7 +213,8 @@ window} which is used for displaying a tooltip in a tooltip frame Each window belongs to exactly one frame (@pxref{Frames}). For all windows belonging to a specific frame, we sometimes also say that these -windows are @dfn{owned} by that frame or simply that they are on that frame. +windows are @dfn{owned} by that frame or simply that they are on that +frame. @defun window-frame &optional window This function returns the specified @var{window}'s frame---the frame @@ -233,12 +234,6 @@ minibuffer window (@pxref{Minibuffer Windows}) in that list. If active. If @var{minibuffer} is neither @code{nil} nor @code{t}, the minibuffer window is never included. -Note that the window returned by @code{minibuffer-window} called with -the argument @var{frame} is returned by @code{window-list} called with -the same argument if and only if that window actually belongs to -@var{frame}. If the minibuffer window is owned by another frame, it is -not returned by this invocation. - The optional argument @var{window}, if non-@code{nil}, must be a live window on the specified frame; then @var{window} will be the first element in the returned list. If @var{window} is omitted or @code{nil}, commit 8e8a9202469d568b18ea97319e5627fefd833c0b Author: Alan Mackenzie Date: Mon Oct 18 16:49:19 2021 +0000 * lisp/progmodes/cc-engine.el (c-forward-decl-or-cast-1): check type-start Check type-start is non-nil at L659 of the function. diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el index 20cdb72ccf..c42c95764a 100644 --- a/lisp/progmodes/cc-engine.el +++ b/lisp/progmodes/cc-engine.el @@ -10409,6 +10409,7 @@ This function might do hidden buffer changes." ;; are directly inside a class (etc.) called "bar". (save-excursion (and + type-start (progn (goto-char name-start) (not (memq (c-forward-type) '(nil maybe)))) commit 5a3242301d9f1517592656b2643c5c1ab8e8af37 Author: Juri Linkov Date: Mon Oct 18 19:52:29 2021 +0300 Rename tab-bar-drag-maybe to tab-bar--dragging-in-progress * lisp/tab-bar.el (tab-bar--event-to-item, tab-bar-mouse-down-1) (tab-bar-mouse-move-tab): Rename tab-bar-drag-maybe to tab-bar--dragging-in-progress. * src/xdisp.c (note_mouse_highlight): Rename tab_bar_drag_maybe to tab_bar__dragging_in_progress. diff --git a/lisp/tab-bar.el b/lisp/tab-bar.el index 3dc95c9169..03556919b2 100644 --- a/lisp/tab-bar.el +++ b/lisp/tab-bar.el @@ -239,7 +239,7 @@ For any other value of KEY, the value is t." (string-to-number (string-replace "tab-" "" key-name))))) (t t))) -(defvar tab-bar-drag-maybe) +(defvar tab-bar--dragging-in-progress) (defun tab-bar--event-to-item (posn) "This function extracts extra info from the mouse event at position POSN. @@ -248,7 +248,7 @@ It returns a list of the form (KEY KEY-BINDING CLOSE-P), where: KEY-BINDING is the binding of KEY; CLOSE-P is non-nil if the mouse event was a click on the close button \"x\", nil otherwise." - (setq tab-bar-drag-maybe nil) + (setq tab-bar--dragging-in-progress nil) (if (posn-window posn) (let ((caption (car (posn-string posn)))) (when caption @@ -280,7 +280,7 @@ existing tab." (interactive "e") (let* ((item (tab-bar--event-to-item (event-start event))) (tab-number (tab-bar--key-to-number (nth 0 item)))) - (setq tab-bar-drag-maybe t) + (setq tab-bar--dragging-in-progress t) ;; Don't close the tab when clicked on the close button. Also ;; don't add new tab on down-mouse. Let `tab-bar-mouse-1' do this. (unless (or (eq (car item) 'add-tab) (nth 2 item)) @@ -357,7 +357,7 @@ only when you click on its \"x\" close button." This command should be bound to a drag event. It moves the tab at the mouse-down event to the position at mouse-up event." (interactive "e") - (setq tab-bar-drag-maybe nil) + (setq tab-bar--dragging-in-progress nil) (let ((from (tab-bar--key-to-number (nth 0 (tab-bar--event-to-item (event-start event))))) diff --git a/src/xdisp.c b/src/xdisp.c index dc927253ef..67946a56b4 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -33644,7 +33644,7 @@ note_mouse_highlight (struct frame *f, int x, int y) if (EQ (window, f->tab_bar_window)) { note_tab_bar_highlight (f, x, y); - if (tab_bar_drag_maybe) + if (tab_bar__dragging_in_progress) { cursor = FRAME_OUTPUT_DATA (f)->hand_cursor; goto set_cursor; @@ -35780,9 +35780,9 @@ When nil, mouse-movement events will not be generated as long as the mouse stays within the extent of a single glyph (except for images). */); mouse_fine_grained_tracking = false; - DEFVAR_BOOL ("tab-bar-drag-maybe", tab_bar_drag_maybe, + DEFVAR_BOOL ("tab-bar--dragging-in-progress", tab_bar__dragging_in_progress, doc: /* Non-nil when maybe dragging tab bar item. */); - tab_bar_drag_maybe = false; + tab_bar__dragging_in_progress = false; DEFVAR_BOOL ("redisplay-skip-initial-frame", redisplay_skip_initial_frame, doc: /* Non-nil to skip redisplay in initial frame. commit bb4209a5a5337f9c09c4ebb2a65415a41361d8da Author: Mattias Engdegård Date: Mon Oct 18 17:06:22 2021 +0200 Fix xref elisp identifier namespace mistake Pressing `M-.` on ALPHA in (let ((ALPHA BETA)) ...) would incorrectly search for ALPHA as a function rather than a variable. * lisp/progmodes/elisp-mode.el (elisp--xref-infer-namespace): Fix logic. * test/lisp/progmodes/elisp-mode-tests.el (elisp-mode-infer-namespace): Add test case. diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el index 10a3794257..9522055670 100644 --- a/lisp/progmodes/elisp-mode.el +++ b/lisp/progmodes/elisp-mode.el @@ -877,17 +877,17 @@ namespace but with lower confidence." ;; ^ index K ^ index J ^ index I (let* ((i (elisp--xref-list-index)) (i-head (looking-at-sym)) - (i-paren (and i-head (eq (char-before) ?\() + (i-paren (and i (eq (char-before) ?\() (progn (backward-char) t))) (i-quoted (and i-paren (memq (char-before) '(?\' ?`)))) (j (and i-paren (elisp--xref-list-index))) (j-head (and j (looking-at-sym))) - (j-paren (and j-head (eq (char-before) ?\() + (j-paren (and j (eq (char-before) ?\() (progn (backward-char) t))) (j-quoted (and j-paren (memq (char-before) '(?\' ?`)))) (k (and j-paren (elisp--xref-list-index))) (k-head (and k (looking-at-sym))) - (k-paren (and k-head (eq (char-before) ?\() + (k-paren (and k (eq (char-before) ?\() (progn (backward-char) t))) (k-quoted (and k-paren (memq (char-before) '(?\' ?`))))) (cond diff --git a/test/lisp/progmodes/elisp-mode-tests.el b/test/lisp/progmodes/elisp-mode-tests.el index 400c76c187..f887bb1dca 100644 --- a/test/lisp/progmodes/elisp-mode-tests.el +++ b/test/lisp/progmodes/elisp-mode-tests.el @@ -976,6 +976,17 @@ evaluation of BODY." (should (equal (elisp--xref-infer-namespace p6) 'maybe-variable)) (should (equal (elisp--xref-infer-namespace p7) 'variable))) + (elisp-mode-test--with-buffer + (concat "(let (({p1}alpha {p2}beta)\n" + " ({p3}gamma ({p4}delta {p5}epsilon)))\n" + " ({p6}zeta))\n") + (should (equal (elisp--xref-infer-namespace p1) 'variable)) + (should (equal (elisp--xref-infer-namespace p2) 'variable)) + (should (equal (elisp--xref-infer-namespace p3) 'variable)) + (should (equal (elisp--xref-infer-namespace p4) 'function)) + (should (equal (elisp--xref-infer-namespace p5) 'maybe-variable)) + (should (equal (elisp--xref-infer-namespace p6) 'function))) + (elisp-mode-test--with-buffer (concat "(defun {p1}alpha () {p2}beta)\n" "(defface {p3}gamma ...)\n" commit 7d12c06725d733f1ea223f5fe55d506c71e44370 Merge: a6f156a7b0 c163fd9260 Author: Glenn Morris Date: Mon Oct 18 07:50:26 2021 -0700 Merge from origin/emacs-28 c163fd9260 (origin/emacs-28) Minor fixes for recent changes in ELisp ... fefada4816 Fix example in calc manual e74e17c1f0 Rewrites of Elisp manual including tab-bar and tab-line ch... 3b138917b7 ; * INSTALL: Fix typo. ce71446585 * lisp/tab-bar.el: Improve docstrings (bug#51247) ace4ce16a3 * lisp/tab-bar.el (tab-bar-mouse-move-tab): Don't drag tab... 04716ca48f Add tab-bar-drag-maybe for indication of tab dragging (bug... 81e3697600 * lisp/tab-bar.el: Add a new tab on [mouse-1] instead of [... a191d3c725 Add new and fix existing docstrings in tab-bar.el and tab-... 77dbaedadc Add tab bar support to the nextstep port 7b6fb486c2 Fix potential buffer overflow (bug#50767) ed9f5546aa Improve doc strings in tab-line.el 686a03ee22 More documentation fixes in tab-bar.el 35920791df Improve doc strings of tab-bar commands 2d15db6e89 Fix a semantic test on some macOS machines ac6ac76e3a Update to Org 9.5-57-g9bc3a2 commit c163fd9260317adbb85a2274dab795a6a7f3061f Author: Eli Zaretskii Date: Mon Oct 18 17:13:18 2021 +0300 Minor fixes for recent changes in ELisp manual * doc/lispref/windows.texi (Basic Windows, Windows and Frames) (Selecting Windows): * doc/lispref/objects.texi (Window Type): * doc/lispref/frames.texi (Input Focus, Frame Layout): Fix wording, punctuation, and indexing. diff --git a/doc/lispref/frames.texi b/doc/lispref/frames.texi index 2c3a58d551..f851d12c08 100644 --- a/doc/lispref/frames.texi +++ b/doc/lispref/frames.texi @@ -644,8 +644,9 @@ accommodate an overlong tool bar. @item Tab Bar @cindex internal tab bar The tab bar (@pxref{Tab Bars,,,emacs, The GNU Emacs Manual}) is always -drawn by Emacs itself. On builds with internal tool bars, the tab bar -appears above the tool bar, on builds with external tool bars below. +drawn by Emacs itself. The tab bar appears above the tool bar in +Emacs built with an internal tool bar, and below the tool bar in +builds with an external tool bar. Display of the tab bar can be suppressed by setting the @code{tab-bar-lines} parameter (@pxref{Layout Parameters}) to zero. @@ -3009,7 +3010,7 @@ Auto-selection}). Note that this option does not distinguish ``sloppy'' focus (where the frame that previously had focus retains focus as long as the mouse -pointer does not move into another window system window) from ``strict'' +pointer does not move into another window-system window) from ``strict'' focus (where a frame immediately loses focus when it's left by the mouse pointer). Neither does it recognize whether your window manager supports delayed focusing or auto-raising where you can explicitly diff --git a/doc/lispref/objects.texi b/doc/lispref/objects.texi index 2b82e03006..0551bb5673 100644 --- a/doc/lispref/objects.texi +++ b/doc/lispref/objects.texi @@ -1625,7 +1625,7 @@ markers. @node Window Type @subsection Window Type - A @dfn{window} describes a portion of the screen that Emacs uses to + A @dfn{window} describes the portion of the screen that Emacs uses to display buffers. Every live window (@pxref{Basic Windows}) has one associated buffer, whose contents appear in that window. By contrast, a given buffer may appear in one window, no window, or several windows. diff --git a/doc/lispref/windows.texi b/doc/lispref/windows.texi index c4bb4e68e6..c66ae173e4 100644 --- a/doc/lispref/windows.texi +++ b/doc/lispref/windows.texi @@ -65,15 +65,15 @@ another window. @cindex terminal screen @cindex screen of terminal -@cindex window system window +@cindex window-system window Emacs uses the term ``window'' with a different meaning than in graphical desktop environments and window systems, such as the X Window System. When Emacs is run on X, each graphical X window owned by the Emacs process corresponds to one Emacs frame. When Emacs is run on a text terminal, each Emacs frame fills the entire terminal screen. In either case, the frame may contain one or more Emacs windows. For -disambiguation, we use the term @dfn{window system window} when we mean -the window system window corresponding to an Emacs frame. +disambiguation, we use the term @dfn{window-system window} when we mean +the window-system window corresponding to an Emacs frame. @cindex tiled windows Unlike X windows, Emacs windows are @dfn{tiled}; they never overlap @@ -82,7 +82,8 @@ deleted, the change in window space is taken from or given to other windows on the same frame, so that the total area of the frame is unchanged. -In Emacs Lisp, windows are represented by a special Lisp object type. +In Emacs Lisp, windows are represented by a special Lisp object type +(@pxref{Window Type}). @defun windowp object This function returns @code{t} if @var{object} is a window (whether or @@ -212,7 +213,7 @@ window} which is used for displaying a tooltip in a tooltip frame Each window belongs to exactly one frame (@pxref{Frames}). For all windows belonging to a specific frame, we sometimes also say that these -windows are owned by that frame or simply that they are on that frame. +windows are @dfn{owned} by that frame or simply that they are on that frame. @defun window-frame &optional window This function returns the specified @var{window}'s frame---the frame @@ -251,14 +252,15 @@ the first element. whose leaf nodes are the live windows. The internal nodes of a window tree are not live; they exist for the purpose of organizing the relationships between live windows. The root node of a window tree is -called the @dfn{root window}. It is either a live window (if the frame -has just one window besides the minibuffer window or the frame is a -minibuffer-only frame, see @ref{Frame Layout}), or an internal window. +called the @dfn{root window}. It is either a live window or an +internal window. If it is a live window, then the frame has just one +window besides the minibuffer window, or the frame is a +minibuffer-only frame, @pxref{Frame Layout}. A minibuffer window (@pxref{Minibuffer Windows}) that is not alone on its frame does not have a parent window, so it strictly speaking is not part of its frame's window tree. Nonetheless, it is a sibling window of -the frame's root window, and thus can be reached from there via +the frame's root window, and thus can be reached from the root window via @code{window-next-sibling}, see below. Also, the function @code{window-tree} described at the end of this section lists the minibuffer window alongside the actual window tree. @@ -282,7 +284,7 @@ these live windows become leaf nodes of the window tree, as @dfn{child windows} of a single internal window. If necessary, Emacs automatically creates this internal window, which is also called the @dfn{parent window}, and assigns it to the appropriate position in the window tree. -A set of windows that share the same parent are called @dfn{siblings}. +The set of windows that share the same parent are called @dfn{siblings}. @cindex parent window @defun window-parent &optional window @@ -513,7 +515,7 @@ The following function explicitly selects a window and its frame. @defun select-window window &optional norecord This function makes @var{window} the selected window and the window -selected within its frame and selects that frame. It also makes +selected within its frame, and selects that frame. It also makes @var{window}'s buffer (@pxref{Buffers and Windows}) current and sets that buffer's value of @code{point} to the value of @code{window-point} (@pxref{Window Point}) in @var{window}. @var{window} must be a live @@ -529,7 +531,7 @@ update the display of @var{window} when its frame gets redisplayed the next time. If @var{norecord} is non-@code{nil}, such updates are usually not performed. If, however, @var{norecord} equals the special symbol @code{mark-for-redisplay}, the additional actions mentioned above -are omitted but @var{window} will be nevertheless updated. +are omitted but @var{window}'s display will be nevertheless updated. Note that sometimes selecting a window is not enough to show it, or make its frame the top-most frame on display: you may also need to @@ -670,7 +672,7 @@ display a bigger portion of the buffer than one window could alone. It is often useful to consider such a @dfn{window group} as a single entity. Several functions such as @code{window-group-start} (@pxref{Window Start and End}) allow you to do this by supplying, as -an argument, one of the windows as a stand in for the whole group. +an argument, one of the windows as a stand-in for the whole group. @defun selected-window-group @vindex selected-window-group-function diff --git a/lisp/tab-bar.el b/lisp/tab-bar.el index 82ec617ccc..3dc95c9169 100644 --- a/lisp/tab-bar.el +++ b/lisp/tab-bar.el @@ -705,11 +705,14 @@ the formatted tab name to display in the tab bar." "Template for displaying tab bar items. Every item in the list is a function that returns a string, or a list of menu-item elements, or nil. -When you add more items `tab-bar-format-align-right' and -`tab-bar-format-global' to the end, then after enabling -`display-time-mode' (or any other mode that uses `global-mode-string') -it will display time aligned to the right on the tab bar instead of -the mode line. Replacing `tab-bar-format-tabs' with +Adding a function to the list causes the tab bar to show +that string, or display a menu with those menu items when +you click on the tab bar. +If the list ends with `tab-bar-format-align-right' and +`tab-bar-format-global', then after enabling `display-time-mode' +(or any other mode that uses `global-mode-string'), +it will display time aligned to the right on the tab bar instead +of the mode line. Replacing `tab-bar-format-tabs' with `tab-bar-format-tabs-groups' will group tabs on the tab bar." :type 'hook :options '(tab-bar-format-menu-global @@ -728,7 +731,7 @@ the mode line. Replacing `tab-bar-format-tabs' with :version "28.1") (defun tab-bar-format-menu-global () - "Show global menu on clicking the Menu button." + "Produce the Menu button for the tab bar that shows a global menu." `((add-tab menu-item (propertize "Menu" 'face 'tab-bar-tab-inactive) (lambda (event) (interactive "e") (let ((menu (make-sparse-keymap @@ -745,7 +748,8 @@ the mode line. Replacing `tab-bar-format-tabs' with :help "Global Menu"))) (defun tab-bar-format-history () - "Show back and forward buttons when `tab-bar-history-mode' is enabled. + "Produce back and forward buttons for the tab bar. +These buttons will be shown when `tab-bar-history-mode' is enabled. You can hide these buttons by customizing `tab-bar-format' and removing `tab-bar-format-history' from it." (when tab-bar-history-mode @@ -781,7 +785,7 @@ You can hide these buttons by customizing `tab-bar-format' and removing ,(alist-get 'close-binding tab)))))) (defun tab-bar-format-tabs () - "Show all tabs." + "Produce all the tabs for the tab bar." (let ((i 0)) (mapcan (lambda (tab) @@ -855,7 +859,7 @@ when the tab is current. Return the result as a keymap." :help "Click to visit group")))) (defun tab-bar-format-tabs-groups () - "Show tabs with their groups." + "Produce tabs for the tab bar grouped according to their groups." (let* ((tabs (funcall tab-bar-tabs-function)) (current-group (funcall tab-bar-tab-group-function (tab-bar--current-tab-find tabs))) @@ -899,7 +903,7 @@ when the tab is current. Return the result as a keymap." `((align-right menu-item ,str ignore)))) (defun tab-bar-format-global () - "Format `global-mode-string' to display it in the tab bar. + "Produce display of `global-mode-string' in the tab bar. When `tab-bar-format-global' is added to `tab-bar-format' (possibly appended after `tab-bar-format-align-right'), then modes that display information on the mode line commit fefada48169c1b22734d301e293253d6b1509c26 Author: Lars Ingebrigtsen Date: Mon Oct 18 15:56:51 2021 +0200 Fix example in calc manual * doc/misc/calc.texi (Arithmetic Tutorial): Fix sign in the example (bug#51265). diff --git a/doc/misc/calc.texi b/doc/misc/calc.texi index e11267e7a2..c77ccf766f 100644 --- a/doc/misc/calc.texi +++ b/doc/misc/calc.texi @@ -2865,7 +2865,7 @@ that always equals one. Let's try to verify this identity. @smallexample @group 2: -64 2: -64 2: -64 2: 9.7192e54 2: 9.7192e54 -1: -64 1: -3.1175e27 1: 9.7192e54 1: -64 1: 9.7192e54 +1: -64 1: 3.1175e27 1: 9.7192e54 1: -64 1: 9.7192e54 . . . . . 64 n @key{RET} @key{RET} H C 2 ^ @key{TAB} H S 2 ^ commit a6f156a7b03e410c044ad96f1ba16645d451c083 Author: Miha Rihtaršič Date: Mon Oct 18 15:24:54 2021 +0200 *-watch-for-password-prompt: Use run-at-time to read password * lisp/comint.el (comint-watch-for-password-prompt): * lisp/eshell/esh-mode.el (eshell-watch-for-password-prompt): * lisp/term.el (term-watch-for-password-prompt): Use run-at-time to read a password (bug#51263). diff --git a/lisp/comint.el b/lisp/comint.el index a0873c0b6a..e925b3a4b6 100644 --- a/lisp/comint.el +++ b/lisp/comint.el @@ -2455,11 +2455,19 @@ This function could be in the list `comint-output-filter-functions'." (when (let ((case-fold-search t)) (string-match comint-password-prompt-regexp (string-replace "\r" "" string))) - (let ((comint--prompt-recursion-depth (1+ comint--prompt-recursion-depth))) - (if (> comint--prompt-recursion-depth 10) - (message "Password prompt recursion too deep") - (comint-send-invisible - (string-trim string "[ \n\r\t\v\f\b\a]+" "\n+")))))) + ;; Use `run-at-time' in order not to pause execution of the + ;; process filter with a minibuffer + (run-at-time + 0 nil + (lambda (current-buf) + (with-current-buffer current-buf + (let ((comint--prompt-recursion-depth + (1+ comint--prompt-recursion-depth))) + (if (> comint--prompt-recursion-depth 10) + (message "Password prompt recursion too deep") + (comint-send-invisible + (string-trim string "[ \n\r\t\v\f\b\a]+" "\n+")))))) + (current-buffer)))) ;; Low-level process communication diff --git a/lisp/eshell/esh-mode.el b/lisp/eshell/esh-mode.el index 98e89037f3..579b01f4d1 100644 --- a/lisp/eshell/esh-mode.el +++ b/lisp/eshell/esh-mode.el @@ -940,7 +940,14 @@ This function could be in the list `eshell-output-filter-functions'." (beginning-of-line) (if (re-search-forward eshell-password-prompt-regexp eshell-last-output-end t) - (eshell-send-invisible)))))) + ;; Use `run-at-time' in order not to pause execution of + ;; the process filter with a minibuffer + (run-at-time + 0 nil + (lambda (current-buf) + (with-current-buffer current-buf + (eshell-send-invisible))) + (current-buffer))))))) (custom-add-option 'eshell-output-filter-functions 'eshell-watch-for-password-prompt) diff --git a/lisp/term.el b/lisp/term.el index dd5457745b..530b93484e 100644 --- a/lisp/term.el +++ b/lisp/term.el @@ -2409,7 +2409,14 @@ Checks if STRING contains a password prompt as defined by (when (term-in-line-mode) (when (let ((case-fold-search t)) (string-match comint-password-prompt-regexp string)) - (term-send-invisible (read-passwd string))))) + ;; Use `run-at-time' in order not to pause execution of the + ;; process filter with a minibuffer + (run-at-time + 0 nil + (lambda (current-buf) + (with-current-buffer current-buf + (term-send-invisible (read-passwd string)))) + (current-buffer))))) ;;; Low-level process communication commit f3c5a1b3685debefb9c019f96992b887f6ca69f2 Author: Lars Ingebrigtsen Date: Mon Oct 18 11:35:51 2021 +0200 Add some defvar indent tests diff --git a/test/lisp/progmodes/elisp-mode-resources/elisp-indents.erts b/test/lisp/progmodes/elisp-mode-resources/elisp-indents.erts index ba2f81a3a9..2c0d51edae 100644 --- a/test/lisp/progmodes/elisp-mode-resources/elisp-indents.erts +++ b/test/lisp/progmodes/elisp-mode-resources/elisp-indents.erts @@ -71,3 +71,18 @@ Name: def-indent2 (define-keymap 1 2 3) =-=-= + +Name: elisp-indents1 + +=-= +(defvar foo + () + "bar") +=-=-= + +Name: elisp-indents2 + +=-= +(defvar foo () + "bar") +=-=-= commit 84d8df59703b9cb708f6ce044a5d36690425e392 Author: Lars Ingebrigtsen Date: Mon Oct 18 10:48:45 2021 +0200 Mention that we now install the pdmp file with a fingerprinted name diff --git a/etc/NEWS b/etc/NEWS index 2ef585f12d..80d4ca9bb2 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -24,6 +24,12 @@ applies, and please also update docstrings as needed. * Installation Changes in Emacs 29.1 +** Emacs now installs the .pdmp file using a unique fingerprint in the name. +The file is typically installed using a file name akin to +...dir/libexec/emacs/29.0.50/x86_64-pc-linux-gnu/emacs-.pdmp +If a constant file name is required, the file can be renamed to +"emacs.pdmp", and Emacs will find it during startup anyway. + * Startup Changes in Emacs 29.1 commit 7e1329e7edf3b69ee5ceb7e0343a31ed35ea7529 Author: Lars Ingebrigtsen Date: Mon Oct 18 10:44:28 2021 +0200 Add indentation rules for DEFUN's def* functions diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el index fadc0a7379..57fc750515 100644 --- a/lisp/emacs-lisp/lisp-mode.el +++ b/lisp/emacs-lisp/lisp-mode.el @@ -1295,6 +1295,13 @@ Lisp function does not specify a special indentation." (put 'autoload 'lisp-indent-function 'defun) ;Elisp (put 'progn 'lisp-indent-function 0) +(put 'defvar 'lisp-indent-function 'defun) +(put 'defalias 'lisp-indent-function 'defun) +(put 'defvaralias 'lisp-indent-function 'defun) +(put 'defconst 'lisp-indent-function 'defun) +(put 'define-category 'lisp-indent-function 'defun) +(put 'define-charset-internal 'lisp-indent-function 'defun) +(put 'define-fringe-bitmap 'lisp-indent-function 'defun) (put 'prog1 'lisp-indent-function 1) (put 'save-excursion 'lisp-indent-function 0) ;Elisp (put 'save-restriction 'lisp-indent-function 0) ;Elisp commit 8d086592c31e624d7e10e0becea1f08a004e2274 Author: Lars Ingebrigtsen Date: Mon Oct 18 10:40:08 2021 +0200 Update elp-not-profilable * lisp/emacs-lisp/elp.el (elp-not-profilable): Update list of denied functions (bug#40335). diff --git a/lisp/emacs-lisp/elp.el b/lisp/emacs-lisp/elp.el index 8c33b7c994..fde7947a27 100644 --- a/lisp/emacs-lisp/elp.el +++ b/lisp/emacs-lisp/elp.el @@ -202,14 +202,13 @@ This variable is set by the master function.") (defvar elp-not-profilable ;; First, the functions used inside each instrumented function: '(called-interactively-p - ;; Then the functions used by the above functions. I used - ;; (delq nil (mapcar (lambda (x) (and (symbolp x) (fboundp x) x)) - ;; (aref (symbol-function 'elp-wrapper) 2))) - ;; to help me find this list. - error call-interactively apply current-time + ;; (delq + ;; nil (mapcar + ;; (lambda (x) (and (symbolp x) (fboundp x) x)) + ;; (aref (aref (aref (symbol-function 'elp--make-wrapper) 2) 1) 2))) + error apply current-time float-time time-subtract ;; Andreas Politz reports problems profiling these (Bug#4233): - + byte-code-function-p functionp byte-code subrp - indirect-function fboundp) + + byte-code-function-p functionp byte-code subrp fboundp) "List of functions that cannot be profiled. Those functions are used internally by the profiling code and profiling them would thus lead to infinite recursion.") commit 32df2034234056bf24312ef5883671b59a387520 Author: Lars Ingebrigtsen Date: Mon Oct 18 10:00:20 2021 +0200 Remove the "def" indentation heuristic * lisp/emacs-lisp/lisp-mode.el (lisp-indent-function): Don't indent function calls with names that that start with "def" specially (bug#43329). diff --git a/etc/NEWS b/etc/NEWS index f4b462516f..2ef585f12d 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -164,6 +164,26 @@ Emacs buffers, like indentation and the like. The new ert function * Incompatible Lisp Changes in Emacs 29.1 +--- +** 'def' indentation changes. +In 'emacs-lisp-mode', forms with a symbol with a name that start with +"def" have been automatically indented as if they were 'defun'-like +forms, for instance: + + (defzot 1 + 2 3) + +This heuristic has now been removed, and all functions/macros that +want to be indented this way have to be marked with + + (declare (indent defun)) + +or the like. If the function/macro definition itself can't be +changed, the indentation can also be adjusted by saying something +like: + + (put 'defzot 'lisp-indent-function 'defun) + --- ** The 'inhibit-changing-match-data' variable is now obsolete. Instead, functions like 'string-match' and 'looking-at' now take an diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el index c2f756c977..fadc0a7379 100644 --- a/lisp/emacs-lisp/lisp-mode.el +++ b/lisp/emacs-lisp/lisp-mode.el @@ -1220,9 +1220,6 @@ Lisp function does not specify a special indentation." 'lisp-indent-function) (get (intern-soft function) 'lisp-indent-hook))) (cond ((or (eq method 'defun) - (and (null method) - (> (length function) 3) - (string-match "\\`def" function)) ;; Check whether we are in flet-like form. (lisp--local-defform-body-p state)) (lisp-indent-defform state indent-point)) diff --git a/test/lisp/progmodes/elisp-mode-resources/elisp-indents.erts b/test/lisp/progmodes/elisp-mode-resources/elisp-indents.erts index d3eaac9ba5..ba2f81a3a9 100644 --- a/test/lisp/progmodes/elisp-mode-resources/elisp-indents.erts +++ b/test/lisp/progmodes/elisp-mode-resources/elisp-indents.erts @@ -57,3 +57,17 @@ Name: defvar-keymap :foo bar "\r" #'eww-follow-link) =-=-= + +Name: def-indent1 + +=-= +(defzot-does-not-exist 1 + 2 3) +=-=-= + +Name: def-indent2 + +=-= +(define-keymap 1 + 2 3) +=-=-= commit e74e17c1f020b4570f7e63b3703c12a406985479 Author: Martin Rudalics Date: Mon Oct 18 09:58:48 2021 +0200 Rewrites of Elisp manual including tab-bar and tab-line changes * doc/lispref/buffers.texi (Current Buffer, Buffer List): Update references to 'selected-window'. * doc/lispref/elisp.texi (Top): Move up Selecting Windows section in front of Window Sizes section. * doc/lispref/frames.texi (Creating Frames): Say window system instead of windowing system. (Frame Layout): Add Tab Bar to layout. (Layout Parameters): Add 'tab-bar-lines'. (Input Focus): Say window system window instead of window manager window. Fix reference to 'selected-window'. * doc/lispref/objects.texi (Window Type): Minor rewrite. * doc/lispref/windows.texi (Basic Windows): Rewrite. Settle on term 'window system window' for disambiguation with our windows. Move 'selected-window' description to Selecting Windows section. Move schematic of window structure here. Use 'decorations' for objects outside the window body. Say that the areas reserved for continuation and truncation glyphs, vertical dividers and line numbers are part of the window body. (Windows and Frames): Minor rewrite, adding and fixing some cross references. Move live window schematic to 'Basic Windows' section. (Selecting Windows): Move section in front of Window Sizes section. Move description of 'selected-window' here. Move up description of 'frame-selected-window' and 'set-frame-selected-window'. Update and move description of 'window-bump-use-time' here. (Window Sizes): Throughout use the term 'decorations' instead of enumerating them individually. Add 'window-tab-line-height' description. (Resizing Windows): Again use the term 'decorations' instead of enumerating them individually. (Splitting Windows): Minor fix. (Cyclic Window Ordering): Improve descriptions of 'get-lru-window' and 'get-mru-window'. Move 'window-bump-use-time' to Selecting Windows section. (Coordinates and Windows, Window Configurations): Once more use the term 'decorations' instead of enumerating them individually. * src/window.c (Fwindow_bump_use_time): Move after 'window-use-time'. Make it work for live windows only. Make WINDOW argument optional. Update doc-string. diff --git a/doc/lispref/buffers.texi b/doc/lispref/buffers.texi index 55e9d00d8b..6a0095dca9 100644 --- a/doc/lispref/buffers.texi +++ b/doc/lispref/buffers.texi @@ -89,11 +89,12 @@ in which most editing takes place. Most of the primitives for examining or changing text operate implicitly on the current buffer (@pxref{Text}). - Normally, the buffer displayed in the selected window is the current -buffer, but this is not always so: a Lisp program can temporarily -designate any buffer as current in order to operate on its contents, -without changing what is displayed on the screen. The most basic -function for designating a current buffer is @code{set-buffer}. + Normally, the buffer displayed in the selected window +(@pxref{Selecting Windows}) is the current buffer, but this is not +always so: a Lisp program can temporarily designate any buffer as +current in order to operate on its contents, without changing what is +displayed on the screen. The most basic function for designating a +current buffer is @code{set-buffer}. @defun current-buffer This function returns the current buffer. @@ -118,12 +119,12 @@ on it. When an editing command returns to the editor command loop, Emacs automatically calls @code{set-buffer} on the buffer shown in the -selected window. This is to prevent confusion: it ensures that the -buffer that the cursor is in, when Emacs reads a command, is the -buffer to which that command applies (@pxref{Command Loop}). Thus, -you should not use @code{set-buffer} to switch visibly to a different -buffer; for that, use the functions described in @ref{Switching -Buffers}. +selected window (@pxref{Selecting Windows}). This is to prevent +confusion: it ensures that the buffer that the cursor is in, when Emacs +reads a command, is the buffer to which that command applies +(@pxref{Command Loop}). Thus, you should not use @code{set-buffer} to +switch visibly to a different buffer; for that, use the functions +described in @ref{Switching Buffers}. When writing a Lisp function, do @emph{not} rely on this behavior of the command loop to restore the current buffer after an operation. @@ -912,16 +913,17 @@ History}) provided it is shown in that window. If @var{buffer-or-name} is @code{nil} or omitted, this means to bury the current buffer. In addition, if the current buffer is displayed in the -selected window, this makes sure that the window is either deleted or -another buffer is shown in it. More precisely, if the selected window -is dedicated (@pxref{Dedicated Windows}) and there are other windows on -its frame, the window is deleted. If it is the only window on its frame -and that frame is not the only frame on its terminal, the frame is -dismissed by calling the function specified by -@code{frame-auto-hide-function} (@pxref{Quitting Windows}). Otherwise, -it calls @code{switch-to-prev-buffer} (@pxref{Window History}) to show -another buffer in that window. If @var{buffer-or-name} is displayed in -some other window, it remains displayed there. +selected window (@pxref{Selecting Windows}), this makes sure that the +window is either deleted or another buffer is shown in it. More +precisely, if the selected window is dedicated (@pxref{Dedicated +Windows}) and there are other windows on its frame, the window is +deleted. If it is the only window on its frame and that frame is not +the only frame on its terminal, the frame is dismissed by calling the +function specified by @code{frame-auto-hide-function} (@pxref{Quitting +Windows}). Otherwise, it calls @code{switch-to-prev-buffer} +(@pxref{Window History}) to show another buffer in that window. If +@var{buffer-or-name} is displayed in some other window, it remains +displayed there. To replace a buffer in all the windows that display it, use @code{replace-buffer-in-windows}, @xref{Buffers and Windows}. diff --git a/doc/lispref/elisp.texi b/doc/lispref/elisp.texi index da3a3a84e9..c4bd97bf81 100644 --- a/doc/lispref/elisp.texi +++ b/doc/lispref/elisp.texi @@ -1048,6 +1048,7 @@ Windows * Basic Windows:: Basic information on using windows. * Windows and Frames:: Relating windows to the frame they appear on. +* Selecting Windows:: The selected window is the one that you edit in. * Window Sizes:: Accessing a window's size. * Resizing Windows:: Changing the sizes of windows. * Preserving Window Sizes:: Preserving the size of windows. @@ -1055,7 +1056,6 @@ Windows * Deleting Windows:: Deleting a window gives its space to other windows. * Recombining Windows:: Preserving the frame layout when splitting and deleting windows. -* Selecting Windows:: The selected window is the one that you edit in. * Cyclic Window Ordering:: Moving around the existing windows. * Buffers and Windows:: Each window displays the contents of a buffer. * Switching Buffers:: Higher-level functions for switching to a buffer. diff --git a/doc/lispref/frames.texi b/doc/lispref/frames.texi index 477c105a95..2c3a58d551 100644 --- a/doc/lispref/frames.texi +++ b/doc/lispref/frames.texi @@ -151,7 +151,7 @@ the window (a.k.a.@: the @dfn{dominating} monitor). This function itself does not make the new frame the selected frame. @xref{Input Focus}. The previously selected frame remains selected. -On graphical terminals, however, the windowing system may select the +On graphical terminals, however, the window system may select the new frame for its own reasons. @end deffn @@ -494,7 +494,8 @@ a graphical terminal: | | |_____________ Title Bar ______________| | | | (1)_____________ Menu Bar ______________| | ^ | | (2)_____________ Tool Bar ______________| | ^ - | | (3) _________ Internal Border ________ | | ^ + | | (3)_____________ Tab Bar _______________| | ^ + | | | _________ Internal Border ________ | | ^ | | | | ^ | | | | | | | | | | | | | Outer | | | Inner | | | Native @@ -640,6 +641,14 @@ GTK+, on the other hand, never wraps the tool bar but may automatically increase the outer width of a frame in order to accommodate an overlong tool bar. +@item Tab Bar +@cindex internal tab bar +The tab bar (@pxref{Tab Bars,,,emacs, The GNU Emacs Manual}) is always +drawn by Emacs itself. On builds with internal tool bars, the tab bar +appears above the tool bar, on builds with external tool bars below. +Display of the tab bar can be suppressed by setting the +@code{tab-bar-lines} parameter (@pxref{Layout Parameters}) to zero. + @item Native Frame @cindex native frame @cindex native edges @@ -740,8 +749,8 @@ the internal border, one vertical scroll bar, and one left and one right fringe if they are specified for this frame, see @ref{Layout Parameters}. Its height can be obtained by removing from that of the native height the widths of the internal border and the heights of the -frame's internal menu and tool bars and one horizontal scroll bar if -specified for this frame. +frame's internal menu and tool bars, the tab bar and one horizontal +scroll bar if specified for this frame. @end table @cindex absolute position @@ -1875,6 +1884,13 @@ The position of the tool bar when Emacs was built with GTK+. Its value can be one of @code{top}, @code{bottom} @code{left}, @code{right}. The default is @code{top}. +@vindex tab-bar-lines@r{, a frame parameter} +@item tab-bar-lines +The number of lines to use for the tab bar (@pxref{Tab Bars,,,emacs, The +GNU Emacs Manual}). The default is one if Tab Bar mode is enabled and +zero otherwise. This value may change whenever the tab bar wraps +(@pxref{Frame Layout}). + @vindex line-spacing@r{, a frame parameter} @item line-spacing Additional space to leave below each text line, in pixels (a positive @@ -2758,7 +2774,8 @@ Terminals}. @cindex selected frame At any time, one frame in Emacs is the @dfn{selected frame}. The -selected window always resides on the selected frame. +selected window (@pxref{Selecting Windows}) always resides on the +selected frame. When Emacs displays its frames on several terminals (@pxref{Multiple Terminals}), each terminal has its own selected frame. But only one @@ -2992,12 +3009,11 @@ Auto-selection}). Note that this option does not distinguish ``sloppy'' focus (where the frame that previously had focus retains focus as long as the mouse -pointer does not move into another window manager window) from -``strict'' focus (where a frame immediately loses focus when it's left -by the mouse pointer). Neither does it recognize whether your window -manager supports delayed focusing or auto-raising where you can -explicitly specify the time until a new frame gets focus or is -auto-raised. +pointer does not move into another window system window) from ``strict'' +focus (where a frame immediately loses focus when it's left by the mouse +pointer). Neither does it recognize whether your window manager +supports delayed focusing or auto-raising where you can explicitly +specify the time until a new frame gets focus or is auto-raised. You can supply a ``focus follows mouse'' policy for individual Emacs windows by customizing the variable @code{mouse-autoselect-window} diff --git a/doc/lispref/objects.texi b/doc/lispref/objects.texi index a20343f4c7..2b82e03006 100644 --- a/doc/lispref/objects.texi +++ b/doc/lispref/objects.texi @@ -1625,19 +1625,18 @@ markers. @node Window Type @subsection Window Type - A @dfn{window} describes the portion of the terminal screen that Emacs -uses to display a buffer. Every window has one associated buffer, whose -contents appear in the window. By contrast, a given buffer may appear -in one window, no window, or several windows. + A @dfn{window} describes a portion of the screen that Emacs uses to +display buffers. Every live window (@pxref{Basic Windows}) has one +associated buffer, whose contents appear in that window. By contrast, a +given buffer may appear in one window, no window, or several windows. +Windows are grouped on the screen into frames; each window belongs to +one and only one frame. @xref{Frame Type}. Though many windows may exist simultaneously, at any time one window -is designated the @dfn{selected window}. This is the window where the -cursor is (usually) displayed when Emacs is ready for a command. The -selected window usually displays the current buffer (@pxref{Current -Buffer}), but this is not necessarily the case. - - Windows are grouped on the screen into frames; each window belongs to -one and only one frame. @xref{Frame Type}. +is designated the @dfn{selected window} (@pxref{Selecting Windows}). +This is the window where the cursor is (usually) displayed when Emacs is +ready for a command. The selected window usually displays the current +buffer (@pxref{Current Buffer}), but this is not necessarily the case. Windows have no read syntax. They print in hash notation, giving the window number and the name of the buffer being displayed. The window diff --git a/doc/lispref/spellfile b/doc/lispref/spellfile index 45a122d26a..11a6ce813a 100644 --- a/doc/lispref/spellfile +++ b/doc/lispref/spellfile @@ -179,6 +179,8 @@ copyleft counterintuitive cr creatable +customization +customizations customize deactivate deactivated @@ -243,6 +245,8 @@ fmakunbound fo fol following' +fontification +fontified fooba foobaz foox @@ -257,6 +261,7 @@ garbles gc getenv gid +glyphs gp grep gtr @@ -270,6 +275,8 @@ hostname hpux hscroll ick +iconified +iconify id idiom ii @@ -314,6 +321,7 @@ mathsurround memq mh mini +minibuf minibuffer's minibuffers misalignment @@ -387,6 +395,7 @@ passwd ped perverse pid +pixelwise plist pointer' pointm @@ -417,6 +426,10 @@ reader' rebind rec rechecking +redisplay +redisplayed +redisplaying +redisplays redo redrawing redraws @@ -430,6 +443,7 @@ reinitialize reinitialized reinstall reinstalled +resizable resize resized resizes @@ -486,6 +500,8 @@ terpri text' tildes time's +tooltip +tooltips towards transportable txt @@ -494,6 +510,7 @@ unbind unbinding unbinds unclutters +uncustomized undefine undefines underfull @@ -520,6 +537,7 @@ vconcat vectorp vn voidness +whitespace window' windowing windowp diff --git a/doc/lispref/windows.texi b/doc/lispref/windows.texi index 679744884a..c4bb4e68e6 100644 --- a/doc/lispref/windows.texi +++ b/doc/lispref/windows.texi @@ -14,6 +14,7 @@ is displayed in windows. @menu * Basic Windows:: Basic information on using windows. * Windows and Frames:: Relating windows to the frame they appear on. +* Selecting Windows:: The selected window is the one that you edit in. * Window Sizes:: Accessing a window's size. * Resizing Windows:: Changing the sizes of windows. * Preserving Window Sizes:: Preserving the size of windows. @@ -21,7 +22,6 @@ is displayed in windows. * Deleting Windows:: Removing a window from its frame. * Recombining Windows:: Preserving the frame layout when splitting and deleting windows. -* Selecting Windows:: The selected window is the one that you edit in. * Cyclic Window Ordering:: Moving around the existing windows. * Buffers and Windows:: Each window displays the contents of a buffer. * Switching Buffers:: Higher-level functions for switching to a buffer. @@ -53,32 +53,36 @@ is displayed in windows. @section Basic Concepts of Emacs Windows @cindex window -A @dfn{window} is an area of the screen that is used to display a buffer -(@pxref{Buffers}). In Emacs Lisp, windows are represented by a special -Lisp object type. - @cindex multiple windows - Windows are grouped into frames (@pxref{Frames}). Each frame -contains at least one window; the user can subdivide it into multiple, -non-overlapping windows to view several buffers at once. Lisp -programs can use multiple windows for a variety of purposes. In -Rmail, for example, you can view a summary of message titles in one -window, and the contents of the selected message in another window. +A @dfn{window} is an area of the screen that can be used to display a +buffer (@pxref{Buffers}). Windows are grouped into frames +(@pxref{Frames}). Each frame contains at least one window; the user can +subdivide a frame into multiple, non-overlapping windows to view several +buffers at once. Lisp programs can use multiple windows for a variety +of purposes. In Rmail, for example, you can view a summary of message +titles in one window, and the contents of the selected message in +another window. @cindex terminal screen @cindex screen of terminal - Emacs uses the word ``window'' with a different meaning than in -graphical desktop environments and window systems, such as the X -Window System. When Emacs is run on X, each of its graphical X -windows is an Emacs frame (containing one or more Emacs windows). -When Emacs is run on a text terminal, the frame fills the entire -terminal screen. +@cindex window system window + Emacs uses the term ``window'' with a different meaning than in +graphical desktop environments and window systems, such as the X Window +System. When Emacs is run on X, each graphical X window owned by the +Emacs process corresponds to one Emacs frame. When Emacs is run on a +text terminal, each Emacs frame fills the entire terminal screen. In +either case, the frame may contain one or more Emacs windows. For +disambiguation, we use the term @dfn{window system window} when we mean +the window system window corresponding to an Emacs frame. @cindex tiled windows Unlike X windows, Emacs windows are @dfn{tiled}; they never overlap -within the area of the frame. When a window is created, resized, or -deleted, the change in window space is taken from or given to the -adjacent windows, so that the total area of the frame is unchanged. +within the area of their frame. When a window is created, resized, or +deleted, the change in window space is taken from or given to other +windows on the same frame, so that the total area of the frame is +unchanged. + +In Emacs Lisp, windows are represented by a special Lisp object type. @defun windowp object This function returns @code{t} if @var{object} is a window (whether or @@ -117,94 +121,147 @@ internal window in a window tree. Otherwise, it returns @code{nil}, including for the case where @var{object} is a deleted window. @end defun -@cindex selected window -@cindex window selected within a frame - In each frame, at any time, exactly one Emacs window is designated -as @dfn{selected within the frame}. For the selected frame, that -window is called the @dfn{selected window}---the one in which most -editing takes place, and in which the cursor for selected windows -appears (@pxref{Cursor Parameters}). Keyboard input that inserts or -deletes text is also normally directed to this window. The selected -window's buffer is usually also the current buffer, except when -@code{set-buffer} has been used (@pxref{Current Buffer}). As for -non-selected frames, the window selected within the frame becomes the -selected window if the frame is ever selected. @xref{Selecting -Windows}. + The following schematic shows the structure of a live window: -@defun selected-window -This function returns the selected window (which is always a live -window). -@end defun +@smallexample +@group + ____________________________________________ + |________________ Tab Line _______________|RD| ^ + |______________ Header Line ______________| | | + ^ |LS|LM|LF| |RF|RM|RS| | | + | | | | | | | | | | | +Window | | | | Text Area | | | | | Window +Body | | | | | (Window Body) | | | | | Total +Height | | | | | | | | | Height + | | | | |<- Window Body Width ->| | | | | | + v |__|__|__|_______________________|__|__|__| | | + |_________ Horizontal Scroll Bar _________| | | + |_______________ Mode Line _______________|__| | + |_____________ Bottom Divider _______________| v + <---------- Window Total Width ------------> -@anchor{Window Group}Sometimes several windows collectively and -cooperatively display a buffer, for example, under the management of -Follow Mode (@pxref{Follow Mode,,, emacs}), where the windows together -display a bigger portion of the buffer than one window could alone. -It is often useful to consider such a @dfn{window group} as a single -entity. Several functions such as @code{window-group-start} -(@pxref{Window Start and End}) allow you to do this by supplying, as -an argument, one of the windows as a stand in for the whole group. +@end group +@end smallexample -@defun selected-window-group -@vindex selected-window-group-function -When the selected window is a member of a group of windows, this -function returns a list of the windows in the group, ordered such that -the first window in the list is displaying the earliest part of the -buffer, and so on. Otherwise the function returns a list containing -just the selected window. +@cindex window body +@cindex text area of a window +@cindex body of a window +@cindex window decorations +@cindex left and right window decorations +@cindex top and bottom window decorations + At the center of that window is the @dfn{text area}, or @dfn{body}, +where the buffer text is displayed. The text area can be surrounded by +a series of optional areas which we will call @dfn{window decorations}. +On the left and right, from innermost to outermost, these are the left +and right fringes, denoted by LF and RF (@pxref{Fringes}); the left and +right margins, denoted by LM and RM in the schematic (@pxref{Display +Margins}); the left or right vertical scroll bar, only one of which is +present at any time, denoted by LS and RS (@pxref{Scroll Bars}); and the +right divider, denoted by RD (@pxref{Window Dividers}). Together these +are the window's @dfn{left and right decorations}. + + At the top of the window are the tab line and the header line +(@pxref{Header Lines}). At the bottom of the window are the horizontal +scroll bar (@pxref{Scroll Bars}); the mode line (@pxref{Mode Line +Format}); and the bottom divider (@pxref{Window Dividers}). Together +these form the window's @dfn{top and bottom decorations}. + + There are two special areas omitted in the schematic: + +@itemize @bullet +@item +When any of the fringes is missing, the display engine may use one +character cell in its place for showing a continuation or truncation +glyph provided a text line doesn't fit in a window. + +@item +When both, the vertical scroll bar and the right divider are missing, +the display engine usurps one pixel for drawing a vertical divider line +between this window and the window on its right, provided such a window +exists. On a text terminal, this divider always occupies an entire +character cell. +@end itemize + +In either case, the resulting artifact is considered part of the +window's body although its screen space cannot be used for displaying +buffer text. + + Note also, that line numbers (and their surrounding whitespace) as +displayed by @code{display-line-numbers-mode} (@pxref{Display Custom,,, +emacs, The GNU Emacs Manual}) do not count as decorations either; they +are part of the window's body too. + + Internal windows neither show any text nor do they have decorations. +Hence, the concept of ``body'' does not make sense for them. In fact, +most functions operating on the body of a window will yield an error +when applied to an internal window. + +@cindex minibuffer window +@cindex tooltip window + By default, an Emacs frame exhibits one special live window that is +used for displaying messages and accepting user input---the +@dfn{minibuffer window} (@pxref{Minibuffer Windows}). Since the +minibuffer window is used for displaying text, it has a body but it does +not have a tab or header line or any margins. Finally, a @dfn{tooltip +window} which is used for displaying a tooltip in a tooltip frame +(@pxref{Tooltips}) has a body too but no decorations at all. -The selected window is considered part of a group when the buffer -local variable @code{selected-window-group-function} is set to a -function. In this case, @code{selected-window-group} calls it with no -arguments and returns its result (which should be the list of windows -in the group). -@end defun @node Windows and Frames @section Windows and Frames -Each window belongs to exactly one frame (@pxref{Frames}). +Each window belongs to exactly one frame (@pxref{Frames}). For all +windows belonging to a specific frame, we sometimes also say that these +windows are owned by that frame or simply that they are on that frame. @defun window-frame &optional window -This function returns the frame that the window @var{window} belongs -to. If @var{window} is @code{nil}, it defaults to the selected -window. +This function returns the specified @var{window}'s frame---the frame +that @var{window} belongs to. If @var{window} is omitted or @code{nil}, +it defaults to the selected window (@pxref{Selecting Windows}). @end defun @defun window-list &optional frame minibuffer window -This function returns a list of live windows belonging to the frame +This function returns a list of all live windows owned by the specified @var{frame}. If @var{frame} is omitted or @code{nil}, it defaults to -the selected frame. +the selected frame (@pxref{Input Focus}). -The optional argument @var{minibuffer} specifies whether to include -the minibuffer window in the returned list. If @var{minibuffer} is -@code{t}, the minibuffer window is included. If @var{minibuffer} is +The optional argument @var{minibuffer} specifies whether to include the +minibuffer window (@pxref{Minibuffer Windows}) in that list. If +@var{minibuffer} is @code{t}, the minibuffer window is included. If @code{nil} or omitted, the minibuffer window is included only if it is active. If @var{minibuffer} is neither @code{nil} nor @code{t}, the minibuffer window is never included. -The optional argument @var{window}, if non-@code{nil}, should be a live +Note that the window returned by @code{minibuffer-window} called with +the argument @var{frame} is returned by @code{window-list} called with +the same argument if and only if that window actually belongs to +@var{frame}. If the minibuffer window is owned by another frame, it is +not returned by this invocation. + +The optional argument @var{window}, if non-@code{nil}, must be a live window on the specified frame; then @var{window} will be the first element in the returned list. If @var{window} is omitted or @code{nil}, -the window selected within the frame is the first element. +the window selected within @var{frame} (@pxref{Selecting Windows}) is +the first element. @end defun @cindex window tree @cindex root window - Windows in the same frame are organized into a @dfn{window tree}, + Windows on the same frame are organized into a @dfn{window tree}, whose leaf nodes are the live windows. The internal nodes of a window tree are not live; they exist for the purpose of organizing the relationships between live windows. The root node of a window tree is -called the @dfn{root window}. It can be either a live window (if the -frame has just one window), or an internal window. - - A minibuffer window (@pxref{Minibuffer Windows}) that is not alone -on its frame does not have a parent window, so it strictly speaking is -not part of its frame's window tree. Nonetheless, it is a sibling -window of the frame's root window, and thus can be reached via -@code{window-next-sibling}. Also, the function @code{window-tree} -described at the end of this section lists the minibuffer window -alongside the actual window tree. +called the @dfn{root window}. It is either a live window (if the frame +has just one window besides the minibuffer window or the frame is a +minibuffer-only frame, see @ref{Frame Layout}), or an internal window. + + A minibuffer window (@pxref{Minibuffer Windows}) that is not alone on +its frame does not have a parent window, so it strictly speaking is not +part of its frame's window tree. Nonetheless, it is a sibling window of +the frame's root window, and thus can be reached from there via +@code{window-next-sibling}, see below. Also, the function +@code{window-tree} described at the end of this section lists the +minibuffer window alongside the actual window tree. @defun frame-root-window &optional frame-or-window This function returns the root window for @var{frame-or-window}. The @@ -217,15 +274,15 @@ of that window's frame. @cindex parent window @cindex child window @cindex sibling window - When a window is split, there are two live windows where previously -there was one. One of these is represented by the same Lisp window -object as the original window, and the other is represented by a -newly-created Lisp window object. Both of these live windows become -leaf nodes of the window tree, as @dfn{child windows} of a single -internal window. If necessary, Emacs automatically creates this -internal window, which is also called the @dfn{parent window}, and -assigns it to the appropriate position in the window tree. A set of -windows that share the same parent are called @dfn{siblings}. + When a live window is split (@pxref{Splitting Windows}), there are two +live windows where previously there was one. One of these is +represented by the same Lisp window object as the original window, and +the other is represented by a newly-created Lisp window object. Both of +these live windows become leaf nodes of the window tree, as @dfn{child +windows} of a single internal window. If necessary, Emacs automatically +creates this internal window, which is also called the @dfn{parent +window}, and assigns it to the appropriate position in the window tree. +A set of windows that share the same parent are called @dfn{siblings}. @cindex parent window @defun window-parent &optional window @@ -235,16 +292,16 @@ window. The return value is @code{nil} if @var{window} has no parent (i.e., it is a minibuffer window or the root window of its frame). @end defun - Each internal window always has at least two child windows. If this -number falls to one as a result of window deletion, Emacs -automatically deletes the internal window, and its sole remaining -child window takes its place in the window tree. + A parent window always has at least two child windows. If this number +were to fall to one as a result of window deletion (@pxref{Deleting +Windows}), Emacs automatically deletes the parent window too, and its +sole remaining child window takes its place in the window tree. - Each child window can be either a live window, or an internal window + A child window can be either a live window, or an internal window (which in turn would have its own child windows). Therefore, each internal window can be thought of as occupying a certain rectangular -@dfn{screen area}---the union of the areas occupied by the live -windows that are ultimately descended from it. +@dfn{screen area}---the union of the areas occupied by the live windows +that are ultimately descended from it. @cindex window combination @cindex vertical combination @@ -284,7 +341,9 @@ windows @var{W4} and @var{W5}. Hence, the live windows in this window tree are @var{W2}, @var{W4}, and @var{W5}. The following functions can be used to retrieve a child window of an -internal window, and the siblings of a child window. +internal window, and the siblings of a child window. Their @var{window} +argument always defaults to the selected window (@pxref{Selecting +Windows}). @defun window-top-child &optional window This function returns the topmost child window of @var{window}, if @@ -309,8 +368,7 @@ the leftmost child window for a horizontal combination. If @defun window-combined-p &optional window horizontal This function returns a non-@code{nil} value if and only if -@var{window} is part of a vertical combination. If @var{window} is -omitted or @code{nil}, it defaults to the selected one. +@var{window} is part of a vertical combination. If the optional argument @var{horizontal} is non-@code{nil}, this means to return non-@code{nil} if and only if @var{window} is part of @@ -318,24 +376,21 @@ a horizontal combination. @end defun @defun window-next-sibling &optional window -This function returns the next sibling of the window @var{window}. If -omitted or @code{nil}, @var{window} defaults to the selected window. -The return value is @code{nil} if @var{window} is the last child of -its parent. +This function returns the next sibling of the specified @var{window}. The +return value is @code{nil} if @var{window} is the last child of its +parent. @end defun @defun window-prev-sibling &optional window -This function returns the previous sibling of the window @var{window}. -If omitted or @code{nil}, @var{window} defaults to the selected -window. The return value is @code{nil} if @var{window} is the first -child of its parent. +This function returns the previous sibling of the specified @var{window}. +The return value is @code{nil} if @var{window} is the first child of its +parent. @end defun -The functions @code{window-next-sibling} and -@code{window-prev-sibling} should not be confused with the functions -@code{next-window} and @code{previous-window}, which return the next -and previous window, respectively, in the cyclic ordering of windows -(@pxref{Cyclic Window Ordering}). +The functions @code{window-next-sibling} and @code{window-prev-sibling} +should not be confused with the functions @code{next-window} and +@code{previous-window}, which return the next and previous window in the +cyclic ordering of windows (@pxref{Cyclic Window Ordering}). The following functions can be useful to locate a window within its frame. @@ -408,8 +463,7 @@ Don't use this function to check whether there is @emph{no} window in much more efficient way to do that. @end defun -The following function allows the entire window tree of a frame to be -retrieved: +The following function retrieves the entire window tree of a frame: @defun window-tree &optional frame This function returns a list representing the window tree for frame @@ -433,54 +487,218 @@ internal window). The @var{edges} element is a list @code{(@var{left} @end defun -@node Window Sizes -@section Window Sizes -@cindex window size -@cindex size of window +@node Selecting Windows +@section Selecting Windows +@cindex selecting a window - The following schematic shows the structure of a live window: +@cindex selected window +@cindex window selected within a frame + In each frame, at any time, exactly one Emacs window is designated +as @dfn{selected within the frame}. For the selected frame, that +window is called the @dfn{selected window}---the one in which most +editing takes place, and in which the cursor for selected windows +appears (@pxref{Cursor Parameters}). Keyboard input that inserts or +deletes text is also normally directed to this window. The selected +window's buffer is usually also the current buffer, except when +@code{set-buffer} has been used (@pxref{Current Buffer}). As for +non-selected frames, the window selected within the frame becomes the +selected window if the frame is ever selected. -@smallexample -@group - ____________________________________________ - |______________ Header Line ______________|RD| ^ - ^ |LS|LM|LF| |RF|RM|RS| | | - | | | | | | | | | | | -Window | | | | Text Area | | | | | Window -Body | | | | | (Window Body) | | | | | Total -Height | | | | | | | | | Height - | | | | |<- Window Body Width ->| | | | | | - v |__|__|__|_______________________|__|__|__| | | - |_________ Horizontal Scroll Bar _________| | | - |_______________ Mode Line _______________|__| | - |_____________ Bottom Divider _______________| v - <---------- Window Total Width ------------> +@defun selected-window +This function returns the selected window (which is always a live +window). +@end defun -@end group -@end smallexample +The following function explicitly selects a window and its frame. -@cindex window body -@cindex text area of a window -@cindex body of a window - At the center of the window is the @dfn{text area}, or @dfn{body}, -where the buffer text is displayed. The text area can be surrounded by -a series of optional areas. On the left and right, from innermost to -outermost, these are the left and right fringes, denoted by LF and RF -(@pxref{Fringes}); the left and right margins, denoted by LM and RM in -the schematic (@pxref{Display Margins}); the left or right vertical -scroll bar, only one of which is present at any time, denoted by LS and -RS (@pxref{Scroll Bars}); and the right divider, denoted by RD -(@pxref{Window Dividers}). At the top of the window is the header line -(@pxref{Header Lines}). At the bottom of the window are the horizontal -scroll bar (@pxref{Scroll Bars}); the mode line (@pxref{Mode Line -Format}); and the bottom divider (@pxref{Window Dividers}). +@defun select-window window &optional norecord +This function makes @var{window} the selected window and the window +selected within its frame and selects that frame. It also makes +@var{window}'s buffer (@pxref{Buffers and Windows}) current and sets +that buffer's value of @code{point} to the value of @code{window-point} +(@pxref{Window Point}) in @var{window}. @var{window} must be a live +window. The return value is @var{window}. + +By default, this function also moves @var{window}'s buffer to the front +of the buffer list (@pxref{Buffer List}) and makes @var{window} the most +recently selected window. If the optional argument @var{norecord} is +non-@code{nil}, these additional actions are omitted. + +In addition, this function by default also tells the display engine to +update the display of @var{window} when its frame gets redisplayed the +next time. If @var{norecord} is non-@code{nil}, such updates are +usually not performed. If, however, @var{norecord} equals the special +symbol @code{mark-for-redisplay}, the additional actions mentioned above +are omitted but @var{window} will be nevertheless updated. + +Note that sometimes selecting a window is not enough to show it, or +make its frame the top-most frame on display: you may also need to +raise the frame or make sure input focus is directed to that frame. +@xref{Input Focus}. +@end defun + +@cindex select window hooks +@cindex running a hook when a window gets selected +For historical reasons, Emacs does not run a separate hook whenever a +window gets selected. Applications and internal routines often +temporarily select a window to perform a few actions on it. They do +that either to simplify coding---because many functions by default +operate on the selected window when no @var{window} argument is +specified---or because some functions did not (and still do not) take a +window as argument and always operate(d) on the selected window instead. +Running a hook every time a window gets selected for a short time and +once more when the previously selected window gets restored is not +useful. + + However, when its @var{norecord} argument is @code{nil}, +@code{select-window} updates the buffer list and thus indirectly runs +the normal hook @code{buffer-list-update-hook} (@pxref{Buffer List}). +Consequently, that hook provides one way to run a function whenever a +window gets selected more ``permanently''. + + Since @code{buffer-list-update-hook} is also run by functions that are +not related to window management, it will usually make sense to save the +value of the selected window somewhere and compare it with the value of +@code{selected-window} while running that hook. Also, to avoid false +positives when using @code{buffer-list-update-hook}, it is good practice +that every @code{select-window} call supposed to select a window only +temporarily passes a non-@code{nil} @var{norecord} argument. If +possible, the macro @code{with-selected-window} (see below) should be +used in such cases. + + Emacs also runs the hook @code{window-selection-change-functions} +whenever the redisplay routine detects that another window has been +selected since last redisplay. @xref{Window Hooks}, for a detailed +explanation. @code{window-state-change-functions} (described in the +same section) is another abnormal hook run after a different window +has been selected but is triggered by other window changes as well. + +@cindex most recently selected windows + The sequence of calls to @code{select-window} with a non-@code{nil} +@var{norecord} argument determines an ordering of windows by their +selection or use time, see below. The function @code{get-lru-window}, +for example, can then be used to retrieve the least recently selected +window (@pxref{Cyclic Window Ordering}). + +@defun frame-selected-window &optional frame +This function returns the window on @var{frame} that is selected +within that frame. @var{frame} should be a live frame; if omitted or +@code{nil}, it defaults to the selected frame. +@end defun - Emacs provides miscellaneous functions for finding the height and -width of a window. The return value of many of these functions can be +@defun set-frame-selected-window frame window &optional norecord +This function makes @var{window} the window selected within the frame +@var{frame}. @var{frame} should be a live frame; if @code{nil}, it +defaults to the selected frame. @var{window} should be a live window; +if @code{nil}, it defaults to the selected window. + +If @var{frame} is the selected frame, this makes @var{window} the +selected window. + +If the optional argument @var{norecord} is non-@code{nil}, this function +does not alter the ordering of the most recently selected windows, nor +the buffer list. +@end defun + + The following macros are useful to temporarily select a window without +affecting the ordering of recently selected windows or the buffer list. + +@defmac save-selected-window forms@dots{} +This macro records the selected frame, as well as the selected window +of each frame, executes @var{forms} in sequence, then restores the +earlier selected frame and windows. It also saves and restores the +current buffer. It returns the value of the last form in @var{forms}. + +This macro does not save or restore anything about the sizes, +arrangement or contents of windows; therefore, if @var{forms} change +them, the change persists. If the previously selected window of some +frame is no longer live at the time of exit from @var{forms}, that +frame's selected window is left alone. If the previously selected +window is no longer live, then whatever window is selected at the end of +@var{forms} remains selected. The current buffer is restored if and +only if it is still live when exiting @var{forms}. + +This macro changes neither the ordering of recently selected windows nor +the buffer list. +@end defmac + +@defmac with-selected-window window forms@dots{} +This macro selects @var{window}, executes @var{forms} in sequence, then +restores the previously selected window and current buffer. The +ordering of recently selected windows and the buffer list remain +unchanged unless you deliberately change them within @var{forms}; for +example, by calling @code{select-window} with argument @var{norecord} +@code{nil}. Hence, this macro is the preferred way to temporarily work +with @var{window} as the selected window without needlessly running +@code{buffer-list-update-hook}. +@end defmac + +@defmac with-selected-frame frame forms@dots{} +This macro executes @var{forms} with @var{frame} as the selected +frame. The value returned is the value of the last form in +@var{forms}. This macro saves and restores the selected frame, and +changes the order of neither the recently selected windows nor the +buffers in the buffer list. +@end defmac + +@cindex window use time +@cindex use time of window +@cindex window order by time of last use +@defun window-use-time &optional window +This function returns the use time of window @var{window}. @var{window} +must be a live window and defaults to the selected one. + +The @dfn{use time} of a window is not really a time value, but an +integer that does increase monotonically with each call of +@code{select-window} with a @code{nil} @var{norecord} argument. The +window with the lowest use time is usually called the least recently +used window while the window with the highest use time is called the +most recently used one (@pxref{Cyclic Window Ordering}). +@end defun + +@defun window-bump-use-time &optional window +This function marks @var{window} as being the most recently used +one. This can be useful when writing certain @code{pop-to-buffer} +scenarios (@pxref{Switching Buffers}). @var{window} must be a live +window and defaults to the selected one. +@end defun + +@anchor{Window Group}Sometimes several windows collectively and +cooperatively display a buffer, for example, under the management of +Follow Mode (@pxref{Follow Mode,,, emacs}), where the windows together +display a bigger portion of the buffer than one window could alone. +It is often useful to consider such a @dfn{window group} as a single +entity. Several functions such as @code{window-group-start} +(@pxref{Window Start and End}) allow you to do this by supplying, as +an argument, one of the windows as a stand in for the whole group. + +@defun selected-window-group +@vindex selected-window-group-function +When the selected window is a member of a group of windows, this +function returns a list of the windows in the group, ordered such that +the first window in the list is displaying the earliest part of the +buffer, and so on. Otherwise the function returns a list containing +just the selected window. + +The selected window is considered part of a group when the buffer +local variable @code{selected-window-group-function} is set to a +function. In this case, @code{selected-window-group} calls it with no +arguments and returns its result (which should be the list of windows +in the group). +@end defun + + +@node Window Sizes +@section Window Sizes +@cindex window size +@cindex size of window + +Emacs provides miscellaneous functions for finding the height and width +of a window. The return value of many of these functions can be specified either in units of pixels or in units of lines and columns. On a graphical display, the latter actually correspond to the height and -width of a default character specified by the frame's default font -as returned by @code{frame-char-height} and @code{frame-char-width} +width of a default character specified by the frame's default font as +returned by @code{frame-char-height} and @code{frame-char-width} (@pxref{Frame Font}). Thus, if a window is displaying text with a different font or size, the reported line height and column width for that window may differ from the actual number of text lines or columns @@ -490,8 +708,7 @@ displayed within it. @cindex height of a window @cindex total height of a window The @dfn{total height} of a window is the number of lines comprising -the window's body, the header line, the horizontal scroll bar, the mode -line and the bottom divider (if any). +its body and its top and bottom decorations (@pxref{Basic Windows}). @defun window-total-height &optional window round This function returns the total height, in lines, of the window @@ -521,9 +738,8 @@ with any other @var{round} it returns the internal value of @cindex window width @cindex width of a window @cindex total width of a window -The @dfn{total width} of a window is the number of lines comprising the -window's body, its margins, fringes, scroll bars and a right divider (if -any). +The @dfn{total width} of a window is the number of lines comprising its +body and its left and right decorations (@pxref{Basic Windows}). @defun window-total-width &optional window round This function returns the total width, in columns, of the window @@ -564,10 +780,9 @@ window in units of pixels. This function returns the total height of window @var{window} in pixels. @var{window} must be a valid window and defaults to the selected one. -The return value includes mode and header line, a horizontal scroll bar -and a bottom divider, if any. If @var{window} is an internal window, -its pixel height is the pixel height of the screen areas spanned by its -children. +The return value includes the heights of @var{window}'s top and bottom +decorations. If @var{window} is an internal window, its pixel height is +the pixel height of the screen areas spanned by its children. @end defun @cindex window pixel width @@ -578,10 +793,9 @@ children. This function returns the width of window @var{window} in pixels. @var{window} must be a valid window and defaults to the selected one. -The return value includes the fringes and margins of @var{window} as -well as any vertical dividers or scroll bars belonging to @var{window}. -If @var{window} is an internal window, its pixel width is the width of -the screen areas spanned by its children. +The return value includes the widths of @var{window}'s left and right +decorations. If @var{window} is an internal window, its pixel width is +the width of the screen areas spanned by its children. @end defun @cindex full-width window @@ -608,8 +822,8 @@ that of the root window on that frame. If @var{window} is omitted or @cindex window body height @cindex body height of a window The @dfn{body height} of a window is the height of its text area, which -does not include a mode or header line, a horizontal scroll bar, or a -bottom divider. +does not include any of its top or bottom decorations (@pxref{Basic +Windows}). @defun window-body-height &optional window pixelwise This function returns the height, in lines, of the body of window @@ -629,7 +843,9 @@ exceed its total height as returned by @code{window-total-height}. @cindex window body width @cindex body width of a window The @dfn{body width} of a window is the width of its text area, which -does not include the scroll bar, fringes, margins or a right divider. +does not include any of its left or right decorations (@pxref{Basic +Windows}). + Note that when one or both fringes are removed (by setting their width to zero), the display engine reserves two character cells, one on each side of the window, for displaying the continuation and truncation @@ -662,16 +878,11 @@ to calling @code{window-body-width}. In either case, the optional argument @var{pixelwise} is passed to the function called. @end defun -For compatibility with previous versions of Emacs, -@code{window-height} is an alias for @code{window-total-height}, and -@code{window-width} is an alias for @code{window-body-width}. These -aliases are considered obsolete and will be removed in the future. - - The pixel heights of a window's mode and header line can be retrieved -with the functions given below. Their return value is usually accurate -unless the window has not been displayed before: In that case, the -return value is based on an estimate of the font used for the window's -frame. + The pixel heights of a window's mode, tab and header line can be +retrieved with the functions given below. Their return value is usually +accurate unless the window has not been displayed before: In that case, +the return value is based on an estimate of the font used for the +window's frame. @defun window-mode-line-height &optional window This function returns the height in pixels of @var{window}'s mode line. @@ -679,6 +890,12 @@ This function returns the height in pixels of @var{window}'s mode line. @var{window} has no mode line, the return value is zero. @end defun +@defun window-tab-line-height &optional window +This function returns the height in pixels of @var{window}'s tab line. +@var{window} must be a live window and defaults to the selected one. If +@var{window} has no tab line, the return value is zero. +@end defun + @defun window-header-line-height &optional window This function returns the height in pixels of @var{window}'s header line. @var{window} must be a live window and defaults to the selected @@ -720,15 +937,14 @@ size (@pxref{Preserving Window Sizes}). @defopt window-min-height This option specifies the minimum total height, in lines, of any window. -Its value has to accommodate at least one text line as well as a mode -and header line, a horizontal scroll bar and a bottom divider, if -present. +Its value has to accommodate at least one text line and any top or +bottom decorations. @end defopt @defopt window-min-width This option specifies the minimum total width, in columns, of any -window. Its value has to accommodate two text columns as well as -margins, fringes, a scroll bar and a right divider, if present. +window. Its value has to accommodate at least two text columns and any +left or right decorations. @end defopt The following function tells how small a specific window can get taking @@ -745,10 +961,9 @@ of @var{window}'s lines. The return value makes sure that all components of @var{window} remain fully visible if @var{window}'s size were actually set to it. With -@var{horizontal} @code{nil} it includes the mode and header line, the -horizontal scroll bar and the bottom divider, if present. With -@var{horizontal} non-@code{nil} it includes the margins and fringes, the -vertical scroll bar and the right divider, if present. +@var{horizontal} @code{nil} it includes any top or bottom decorations. +With @var{horizontal} non-@code{nil} it includes any left or right +decorations of @var{window}. The optional argument @var{ignore}, if non-@code{nil}, means ignore restrictions imposed by fixed size windows, @code{window-min-height} or @@ -770,10 +985,10 @@ minimum size of @var{window} counted in pixels. @cindex changing window size @cindex window size, changing - This section describes functions for resizing a window without -changing the size of its frame. Because live windows do not overlap, -these functions are meaningful only on frames that contain two or more -windows: resizing a window also changes the size of a neighboring +This section describes functions for resizing a window without changing +the size of its frame. Because live windows do not overlap, these +functions are meaningful only on frames that contain two or more +windows: resizing a window also changes the size of at least one other window. If there is just one window on a frame, its size cannot be changed except by resizing the frame (@pxref{Frame Size}). @@ -801,11 +1016,10 @@ Normally, the variables @code{window-min-height} and (@pxref{Window Sizes}). However, if the optional argument @var{ignore} is non-@code{nil}, this function ignores @code{window-min-height} and @code{window-min-width}, as well as @code{window-size-fixed}. Instead, -it considers the minimum-height window to be one consisting of a header -and a mode line, a horizontal scrollbar and a bottom divider (if any), -plus a text area one line tall; and a minimum-width window as one -consisting of fringes, margins, a scroll bar and a right divider (if -any), plus a text area two columns wide. +it considers the minimum height of a window as the sum of its top and +bottom decorations plus a text area of one line; and its minimum width +as the sum of its left and right decorations plus a text area of two +columns. If the optional argument @var{pixelwise} is non-@code{nil}, @var{delta} is interpreted as pixels. @@ -889,7 +1103,7 @@ that this function can give @var{window}. The optional argument @var{min-height}, if non-@code{nil}, specifies the minimum total height that it can give, which overrides the variable @code{window-min-height}. Both @var{max-height} and @var{min-height} are specified in lines and -include mode and header line and a bottom divider, if any. +include any top or bottom decorations of @var{window}. If @var{window} is part of a horizontal combination and the value of the option @code{fit-window-to-buffer-horizontally} (see below) is @@ -900,8 +1114,8 @@ The optional argument @var{max-width} specifies a maximum width and defaults to the width of @var{window}'s frame. The optional argument @var{min-width} specifies a minimum width and defaults to @code{window-min-width}. Both @var{max-width} and @var{min-width} are -specified in columns and include fringes, margins and scrollbars, if -any. +specified in columns and include any left or right decorations of +@var{window}. The optional argument @var{preserve-size}, if non-@code{nil}, will install a parameter to preserve the size of @var{window} during future @@ -1148,15 +1362,14 @@ one that has space for a text area one line tall and/or two columns wide. Hence, if @var{size} is specified, it's the caller's responsibility to -check whether the emanating windows are large enough to encompass all -areas like a mode line or a scroll bar. The function +check whether the emanating windows are large enough to encompass all of +their decorations like a mode line or a scroll bar. The function @code{window-min-size} (@pxref{Window Sizes}) can be used to determine the minimum requirements of @var{window} in this regard. Since the new -window usually inherits areas like the mode line or the scroll bar -from @var{window}, that function is also a good guess for the minimum -size of the new window. The caller should specify a smaller size only -if it correspondingly removes an inherited area before the next -redisplay. +window usually inherits areas like the mode line or the scroll bar from +@var{window}, that function is also a good guess for the minimum size of +the new window. The caller should specify a smaller size only if it +correspondingly removes an inherited area before the next redisplay. The optional third argument @var{side} determines the position of the new window relative to @var{window}. If it is @code{nil} or @@ -1762,153 +1975,6 @@ distribute its space proportionally among the two remaining live windows. -@node Selecting Windows -@section Selecting Windows -@cindex selecting a window - -@defun select-window window &optional norecord -This function makes @var{window} the selected window and the window -selected within its frame (@pxref{Basic Windows}), and selects that -frame. It also makes @var{window}'s buffer (@pxref{Buffers and -Windows}) current and sets that buffer's value of @code{point} to the -value of @code{window-point} (@pxref{Window Point}) in @var{window}. -@var{window} must be a live window. The return value is @var{window}. - -By default, this function also moves @var{window}'s buffer to the front -of the buffer list (@pxref{Buffer List}) and makes @var{window} the most -recently selected window. If the optional argument @var{norecord} is -non-@code{nil}, these additional actions are omitted. - -In addition, this function by default also tells the display engine to -update the display of @var{window} when its frame gets redisplayed the -next time. If @var{norecord} is non-@code{nil}, such updates are -usually not performed. If, however, @var{norecord} equals the special -symbol @code{mark-for-redisplay}, the additional actions mentioned above -are omitted but @var{window} will be nevertheless updated. - -Note that sometimes selecting a window is not enough to show it, or -make its frame the top-most frame on display: you may also need to -raise the frame or make sure input focus is directed to that frame. -@xref{Input Focus}. -@end defun - -@cindex select window hooks -@cindex running a hook when a window gets selected -For historical reasons, Emacs does not run a separate hook whenever a -window gets selected. Applications and internal routines often -temporarily select a window to perform a few actions on it. They do -that either to simplify coding---because many functions by default -operate on the selected window when no @var{window} argument is -specified---or because some functions did not (and still do not) take a -window as argument and always operate(d) on the selected window instead. -Running a hook every time a window gets selected for a short time and -once more when the previously selected window gets restored is not -useful. - - However, when its @var{norecord} argument is @code{nil}, -@code{select-window} updates the buffer list and thus indirectly runs -the normal hook @code{buffer-list-update-hook} (@pxref{Buffer List}). -Consequently, that hook provides one way to run a function whenever a -window gets selected more ``permanently''. - - Since @code{buffer-list-update-hook} is also run by functions that are -not related to window management, it will usually make sense to save the -value of the selected window somewhere and compare it with the value of -@code{selected-window} while running that hook. Also, to avoid false -positives when using @code{buffer-list-update-hook}, it is good practice -that every @code{select-window} call supposed to select a window only -temporarily passes a non-@code{nil} @var{norecord} argument. If -possible, the macro @code{with-selected-window} (see below) should be -used in such cases. - - Emacs also runs the hook @code{window-selection-change-functions} -whenever the redisplay routine detects that another window has been -selected since last redisplay. @xref{Window Hooks}, for a detailed -explanation. @code{window-state-change-functions} (described in the -same section) is another abnormal hook run after a different window -has been selected but is triggered by other window changes as well. - -@cindex most recently selected windows - The sequence of calls to @code{select-window} with a non-@code{nil} -@var{norecord} argument determines an ordering of windows by their -selection time. The function @code{get-lru-window} can be used to -retrieve the least recently selected live window (@pxref{Cyclic Window -Ordering}). - -@defmac save-selected-window forms@dots{} -This macro records the selected frame, as well as the selected window -of each frame, executes @var{forms} in sequence, then restores the -earlier selected frame and windows. It also saves and restores the -current buffer. It returns the value of the last form in @var{forms}. - -This macro does not save or restore anything about the sizes, -arrangement or contents of windows; therefore, if @var{forms} change -them, the change persists. If the previously selected window of some -frame is no longer live at the time of exit from @var{forms}, that -frame's selected window is left alone. If the previously selected -window is no longer live, then whatever window is selected at the end of -@var{forms} remains selected. The current buffer is restored if and -only if it is still live when exiting @var{forms}. - -This macro changes neither the ordering of recently selected windows nor -the buffer list. -@end defmac - -@defmac with-selected-window window forms@dots{} -This macro selects @var{window}, executes @var{forms} in sequence, then -restores the previously selected window and current buffer. The -ordering of recently selected windows and the buffer list remain -unchanged unless you deliberately change them within @var{forms}; for -example, by calling @code{select-window} with argument @var{norecord} -@code{nil}. Hence, this macro is the preferred way to temporarily work -with @var{window} as the selected window without needlessly running -@code{buffer-list-update-hook}. -@end defmac - -@defmac with-selected-frame frame forms@dots{} -This macro executes @var{forms} with @var{frame} as the selected -frame. The value returned is the value of the last form in -@var{forms}. This macro saves and restores the selected frame, and -changes the order of neither the recently selected windows nor the -buffers in the buffer list. -@end defmac - -@defun frame-selected-window &optional frame -This function returns the window on @var{frame} that is selected -within that frame. @var{frame} should be a live frame; if omitted or -@code{nil}, it defaults to the selected frame. -@end defun - -@defun set-frame-selected-window frame window &optional norecord -This function makes @var{window} the window selected within the frame -@var{frame}. @var{frame} should be a live frame; if @code{nil}, it -defaults to the selected frame. @var{window} should be a live window; -if @code{nil}, it defaults to the selected window. - -If @var{frame} is the selected frame, this makes @var{window} the -selected window. - -If the optional argument @var{norecord} is non-@code{nil}, this -function does not alter the list of most recently selected windows, -nor the buffer list. -@end defun - -@cindex window use time -@cindex use time of window -@cindex window order by time of last use -@defun window-use-time &optional window -This functions returns the use time of window @var{window}. -@var{window} must be a live window and defaults to the selected one. - -The @dfn{use time} of a window is not really a time value, but an -integer that does increase monotonically with each call of -@code{select-window} with a @code{nil} @var{norecord} argument. The -window with the lowest use time is usually called the least recently -used window while the window with the highest use time is called the -most recently used one (@pxref{Cyclic Window Ordering}). -@end defun - - @node Cyclic Window Ordering @section Cyclic Ordering of Windows @cindex cyclic ordering of windows @@ -2036,8 +2102,11 @@ criterion, without selecting it: @cindex least recently used window @defun get-lru-window &optional all-frames dedicated not-selected no-other This function returns a live window which is heuristically the least -recently used. The optional argument @var{all-frames} has -the same meaning as in @code{next-window}. +recently used one. The @dfn{least recently used window} is the least +recently selected one---the window whose use time is less than the use +time of all other live windows (@pxref{Selecting Windows}). The +optional argument @var{all-frames} has the same meaning as in +@code{next-window}. If any full-width windows are present, only those windows are considered. A minibuffer window is never a candidate. A dedicated @@ -2053,8 +2122,14 @@ function returns @code{nil} in that case. The optional argument @cindex most recently used window @defun get-mru-window &optional all-frames dedicated not-selected no-other This function is like @code{get-lru-window}, but it returns the most -recently used window instead. The meaning of the arguments is the -same as for @code{get-lru-window}. +recently used window instead. The @dfn{most recently used window} is +the most recently selected one---the window whose use time exceeds the +use time of all other live windows (@pxref{Selecting Windows}). The +meaning of the arguments is the same as for @code{get-lru-window}. + +Since in practice the most recently used window is always the selected +one, it usually makes sense to call this function with a non-@code{nil} +@var{not-selected} argument only. @end defun @cindex largest window @@ -2081,11 +2156,6 @@ windows to search, and have the same meanings as in @code{next-window}. @end defun -@defun window-bump-use-time window -This function marks @var{window} as having been recently used. This -can be useful when creating certain @code{pop-to-buffer} scenarios. -@end defun - @node Buffers and Windows @section Buffers and Windows @@ -2924,9 +2994,9 @@ A non-@code{nil} value prevents another frame from being raised or selected, if the window chosen by @code{display-buffer} is displayed there. Primarily affected by this are @code{display-buffer-use-some-frame} and -@code{display-buffer-reuse-window}. -@code{display-buffer-pop-up-frame} should be affected as well, but -there is no guarantee that the window manager will comply. +@code{display-buffer-reuse-window}. Ideally, +@code{display-buffer-pop-up-frame} should be affected as well, but there +is no guarantee that the window manager will comply. @vindex window-parameters@r{, a buffer display action alist entry} @item window-parameters @@ -2972,8 +3042,8 @@ root window. If the value specifies a function, that function is called with one argument---the chosen window. The function is supposed to adjust the height of the window; its return value is ignored. Suitable functions -are @code{shrink-window-if-larger-than-buffer} and -@code{fit-window-to-buffer}, see @ref{Resizing Windows}. +are @code{fit-window-to-buffer} and +@code{shrink-window-if-larger-than-buffer}, see @ref{Resizing Windows}. @end itemize By convention, the height of the chosen window is adjusted only if the @@ -5583,10 +5653,9 @@ right of the rightmost column, and the Y coordinate one row down from the bottommost row. Note that these are the actual outer edges of the window, including any -header line, mode line, scroll bar, fringes, window divider and display -margins. On a text terminal, if the window has a neighbor on its right, -its right edge includes the separator line between the window and its -neighbor. +of its decorations. On a text terminal, if the window has a neighbor on +its right, its right edge includes the separator line between the window +and its neighbor. If the optional argument @var{body} is @code{nil}, this means to return the edges corresponding to the total size of @var{window}. @@ -5902,12 +5971,11 @@ all other child frames of that frame's parent frame. @cindex saving window information A @dfn{window configuration} records the entire layout of one -frame---all windows, their sizes, which buffers they contain, how those -buffers are scrolled, and their value of point; also their -fringes, margins, and scroll bar settings. It also includes the value -of @code{minibuffer-scroll-window}. As a special exception, the window -configuration does not record the value of point in the selected window -for the current buffer. +frame---all windows, their sizes, their decorations, which buffers they +contain, how those buffers are scrolled, and their value of point, It +also includes the value of @code{minibuffer-scroll-window}. As a +special exception, the window configuration does not record the value of +point in the selected window for the current buffer. You can bring back an entire frame layout by restoring a previously saved window configuration. If you want to record the layout of all diff --git a/src/window.c b/src/window.c index 9845fbb876..e801ff821f 100644 --- a/src/window.c +++ b/src/window.c @@ -765,6 +765,19 @@ selected one. */) { return make_fixnum (decode_live_window (window)->use_time); } + +DEFUN ("window-bump-use-time", Fwindow_bump_use_time, + Swindow_bump_use_time, 0, 1, 0, + doc: /* Mark WINDOW as having been most recently used. +WINDOW must be a live window and defaults to the selected one. */) + (Lisp_Object window) +{ + struct window *w = decode_live_window (window); + + w->use_time = ++window_select_count; + + return Qnil; +} DEFUN ("window-pixel-width", Fwindow_pixel_width, Swindow_pixel_width, 0, 1, 0, doc: /* Return the width of window WINDOW in pixels. @@ -8122,18 +8135,6 @@ and scrolling positions. */) return Qt; return Qnil; } - -DEFUN ("window-bump-use-time", Fwindow_bump_use_time, - Swindow_bump_use_time, 1, 1, 0, - doc: /* Mark WINDOW as having been recently used. */) - (Lisp_Object window) -{ - struct window *w = decode_valid_window (window); - - w->use_time = ++window_select_count; - return Qnil; -} - static void init_window_once_for_pdumper (void); commit ef9fa3682a799ea94db11c3d7f3da03294f17196 Author: Lars Ingebrigtsen Date: Mon Oct 18 09:44:24 2021 +0200 Fontify :doc keywords as documentation * lisp/emacs-lisp/lisp-mode.el (lisp-string-after-doc-keyword-p): Extend to :doc, too (bug#51230). diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el index b7b8f3a90c..c2f756c977 100644 --- a/lisp/emacs-lisp/lisp-mode.el +++ b/lisp/emacs-lisp/lisp-mode.el @@ -591,6 +591,8 @@ containing STARTPOS." (defun lisp-string-after-doc-keyword-p (listbeg startpos) "Return non-nil if `:documentation' symbol ends at STARTPOS inside a list. +`:doc' can also be used. + LISTBEG is the position of the start of the innermost list containing STARTPOS." (and listbeg ; We are inside a Lisp form. @@ -598,7 +600,7 @@ containing STARTPOS." (goto-char startpos) (ignore-errors (progn (backward-sexp 1) - (looking-at ":documentation\\_>")))))) + (looking-at ":documentation\\_>\\|:doc\\_>")))))) (defun lisp-font-lock-syntactic-face-function (state) "Return syntactic face function for the position represented by STATE. commit 9f505c476eb1a8e85ba26964abf218cab7db0e57 Author: Daniel Martín Date: Sat Oct 16 20:24:19 2021 +0200 New option show-paren-context-when-offscreen * lisp/simple.el (blink-paren-open-paren-line-string): Extract functionality that shows the open paren line in the echo area into its own function, to reuse it from paren.el. (blink-matching-open): Use blink-paren-open-paren-line-string. * lisp/paren.el (show-paren-context-when-offscreen): New option show-paren-context-when-offscreen. (show-paren-function): Implement it using blink-paren-open-paren-line-string. * lisp/emacs-lisp/eldoc.el (eldoc-display-message-no-interference-p): Make sure the feature works well with eldoc. * test/lisp/paren-tests.el (paren-tests-open-paren-line): Test blink-paren-open-paren-line-string. * doc/emacs/programs.texi (Matching): Update the documentation. * etc/NEWS: And announce the new feature. diff --git a/doc/emacs/programs.texi b/doc/emacs/programs.texi index 51a48df2e2..0056906e1f 100644 --- a/doc/emacs/programs.texi +++ b/doc/emacs/programs.texi @@ -868,6 +868,15 @@ highlighting also when point is in whitespace at the beginning of a line and there is a paren at the first or last non-whitespace position on the line, or when point is at the end of a line and there is a paren at the last non-whitespace position on the line. + +@item +@vindex show-paren-context-when-offscreen +@code{show-paren-context-when-offscreen}, when non-@code{nil}, shows +some context in the echo area when point is in a closing delimiter and +the opening delimiter is offscreen. The context is usually the line +that contains the opening delimiter, except if the opening delimiter +is on its own line, in which case the context includes the previous +nonblank line. @end itemize @cindex Electric Pair mode diff --git a/etc/NEWS b/etc/NEWS index d618891915..f4b462516f 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -86,6 +86,14 @@ effectively dragged. Customize this option to limit the amount of entries in the menu "Edit->Paste from Kill Menu". The default is 60. +** show-paren-mode + ++++ +*** New user option 'show-paren-context-when-offscreen'. +When non-nil, if the point is in a closing delimiter and the opening +delimiter is offscreen, shows some context around the opening +delimiter in the echo area. + * Changes in Specialized Modes and Packages in Emacs 29.1 diff --git a/lisp/emacs-lisp/eldoc.el b/lisp/emacs-lisp/eldoc.el index a1c3c3268f..b30d3fc30f 100644 --- a/lisp/emacs-lisp/eldoc.el +++ b/lisp/emacs-lisp/eldoc.el @@ -380,7 +380,14 @@ Also store it in `eldoc-last-message' and return that value." ;; it undesirable to print eldoc messages right this instant. (defun eldoc-display-message-no-interference-p () "Return nil if displaying a message would cause interference." - (not (or executing-kbd-macro (bound-and-true-p edebug-active)))) + (not (or executing-kbd-macro + (bound-and-true-p edebug-active) + ;; The following configuration shows "Matches..." in the + ;; echo area when point is after a closing bracket, which + ;; conflicts with eldoc. + (and show-paren-context-when-offscreen + (not (pos-visible-in-window-p + (overlay-end show-paren--overlay))))))) (defvar eldoc-documentation-functions nil diff --git a/lisp/paren.el b/lisp/paren.el index ce6aa9ae13..7e7cf6c262 100644 --- a/lisp/paren.el +++ b/lisp/paren.el @@ -88,6 +88,14 @@ is not highlighted, the cursor being regarded as adequate to mark its position." :type 'boolean) +(defcustom show-paren-context-when-offscreen nil + "If non-nil, show context in the echo area when the openparen is offscreen. +The context is usually the line that contains the openparen, +except if the openparen is on its own line, in which case the +context includes the previous nonblank line." + :type 'boolean + :version "29.1") + (defvar show-paren--idle-timer nil) (defvar show-paren--overlay (let ((ol (make-overlay (point) (point) nil t))) (delete-overlay ol) ol) @@ -312,6 +320,19 @@ 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. + (let ((openparen (min here-beg there-beg))) + (if (and show-paren-context-when-offscreen + (< there-beg here-beg) + (not (pos-visible-in-window-p openparen))) + (let ((open-paren-line-string + (blink-paren-open-paren-line-string openparen)) + (message-log-max nil)) + (minibuffer-message + "Matches %s" + (substring-no-properties open-paren-line-string))))) ;; Always set the overlay face, since it varies. (overlay-put show-paren--overlay 'priority show-paren-priority) (overlay-put show-paren--overlay 'face face)))))) diff --git a/lisp/simple.el b/lisp/simple.el index c7bb928cd7..4f711d60ea 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -8577,40 +8577,43 @@ The function should return non-nil if the two tokens do not match.") (current-buffer)) (sit-for blink-matching-delay)) (delete-overlay blink-matching--overlay))))) - (t - (let ((open-paren-line-string - (save-excursion - (goto-char blinkpos) - ;; Show what precedes the open in its line, if anything. - (cond - ((save-excursion (skip-chars-backward " \t") (not (bolp))) - (buffer-substring (line-beginning-position) - (1+ blinkpos))) - ;; Show what follows the open in its line, if anything. - ((save-excursion - (forward-char 1) - (skip-chars-forward " \t") - (not (eolp))) - (buffer-substring blinkpos - (line-end-position))) - ;; Otherwise show the previous nonblank line, - ;; if there is one. - ((save-excursion (skip-chars-backward "\n \t") (not (bobp))) - (concat - (buffer-substring (progn - (skip-chars-backward "\n \t") - (line-beginning-position)) - (progn (end-of-line) - (skip-chars-backward " \t") - (point))) - ;; Replace the newline and other whitespace with `...'. - "..." - (buffer-substring blinkpos (1+ blinkpos)))) - ;; There is nothing to show except the char itself. - (t (buffer-substring blinkpos (1+ blinkpos))))))) - (minibuffer-message - "Matches %s" - (substring-no-properties open-paren-line-string)))))))) + ((not show-paren-context-when-offscreen) + (minibuffer-message + "Matches %s" + (substring-no-properties + (blink-paren-open-paren-line-string blinkpos)))))))) + +(defun blink-paren-open-paren-line-string (pos) + "Return the line string that contains the openparen at POS." + (save-excursion + (goto-char pos) + ;; Show what precedes the open in its line, if anything. + (cond + ((save-excursion (skip-chars-backward " \t") (not (bolp))) + (buffer-substring (line-beginning-position) + (1+ pos))) + ;; Show what follows the open in its line, if anything. + ((save-excursion + (forward-char 1) + (skip-chars-forward " \t") + (not (eolp))) + (buffer-substring pos + (line-end-position))) + ;; Otherwise show the previous nonblank line, + ;; if there is one. + ((save-excursion (skip-chars-backward "\n \t") (not (bobp))) + (concat + (buffer-substring (progn + (skip-chars-backward "\n \t") + (line-beginning-position)) + (progn (end-of-line) + (skip-chars-backward " \t") + (point))) + ;; Replace the newline and other whitespace with `...'. + "..." + (buffer-substring pos (1+ pos)))) + ;; There is nothing to show except the char itself. + (t (buffer-substring pos (1+ pos)))))) (defvar blink-paren-function 'blink-matching-open "Function called, if non-nil, whenever a close parenthesis is inserted. diff --git a/test/lisp/paren-tests.el b/test/lisp/paren-tests.el index c4bec5d86d..11249ee9bc 100644 --- a/test/lisp/paren-tests.el +++ b/test/lisp/paren-tests.el @@ -117,5 +117,36 @@ (- (point-max) 1) (point-max) nil))))) +(ert-deftest paren-tests-open-paren-line () + (cl-flet ((open-paren-line () + (let* ((data (show-paren--default)) + (here-beg (nth 0 data)) + (there-beg (nth 2 data))) + (blink-paren-open-paren-line-string + (min here-beg there-beg))))) + ;; Lisp-like + (with-temp-buffer + (insert "(defun foo () + (dummy))") + (goto-char (point-max)) + (should (string= "(defun foo ()" (open-paren-line)))) + + ;; C-like + (with-temp-buffer + (insert "int foo() { + int blah; + }") + (goto-char (point-max)) + (should (string= "int foo() {" (open-paren-line)))) + + ;; C-like with hanging { + (with-temp-buffer + (insert "int foo() + { + int blah; + }") + (goto-char (point-max)) + (should (string= "int foo()...{" (open-paren-line)))))) + (provide 'paren-tests) ;;; paren-tests.el ends here commit 25e624e5859c2e81cafe4b59d0f2d5064aca9ce5 Author: Lars Ingebrigtsen Date: Mon Oct 18 09:22:22 2021 +0200 Fix possible build issue in pcvs.el and diff-mode.el * lisp/vc/pcvs.el (easy-mmode): * lisp/vc/diff-mode.el (easy-mmode): Require. diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el index 297bf4a548..da70ff00dd 100644 --- a/lisp/vc/diff-mode.el +++ b/lisp/vc/diff-mode.el @@ -55,6 +55,7 @@ ;;; Code: (eval-when-compile (require 'cl-lib)) (eval-when-compile (require 'subr-x)) +(require 'easy-mmode) (autoload 'vc-find-revision "vc") (autoload 'vc-find-revision-no-save "vc") diff --git a/lisp/vc/pcvs.el b/lisp/vc/pcvs.el index 15c9157f00..2daa42fbf8 100644 --- a/lisp/vc/pcvs.el +++ b/lisp/vc/pcvs.el @@ -121,6 +121,7 @@ (require 'pcvs-parse) (require 'pcvs-info) (require 'vc-cvs) +(require 'easy-mmode) ;;;; commit c0c807909c8ee963a633011ebfd4291148ca0db4 Author: Protesilaos Stavrou Date: Mon Oct 18 10:07:03 2021 +0300 Add sample user function in eww-auto-rename-buffer * eww.el (eww-auto-rename-buffer): Update doc string. Fix bug#51176. Co-authored-by: Abhiseck Paira Co-authored-by: Protesilaos Stavrou diff --git a/lisp/net/eww.el b/lisp/net/eww.el index bed458ed8a..178a25e4be 100644 --- a/lisp/net/eww.el +++ b/lisp/net/eww.el @@ -187,7 +187,14 @@ determine the renaming scheme, as follows: - `title': Use the web page's title. - `url': Use the web page's URL. - a function's symbol: Run a user-defined function that returns a - string with which to rename the buffer. + string with which to rename the buffer. Sample of a + user-defined function: + + (defun my-eww-rename-buffer () + (when (eq major-mode 'eww-mode) + (when-let ((string (or (plist-get eww-data :title) + (plist-get eww-data :url)))) + (format \"*%s*\" string)))) The string of `title' and `url' is always truncated to the value of `eww-buffer-name-length'." commit a4770152f5f969060edf7a149aa2ee7ff5f5abac Author: Lars Ingebrigtsen Date: Mon Oct 18 09:13:51 2021 +0200 Fix build issue with smerge-mode * lisp/vc/smerge-mode.el (easy-mmode): Require. diff --git a/lisp/vc/smerge-mode.el b/lisp/vc/smerge-mode.el index 5a0b90863a..0be1a03c65 100644 --- a/lisp/vc/smerge-mode.el +++ b/lisp/vc/smerge-mode.el @@ -47,6 +47,7 @@ (require 'diff) ;For diff-check-labels. (require 'diff-mode) ;For diff-refine. (require 'newcomment) +(require 'easy-mmode) ;;; The real definition comes later. (defvar smerge-mode) commit dd7cd14d281644d8e2c5b3f16eb7f074f61d18f7 Author: Lars Ingebrigtsen Date: Mon Oct 18 08:58:02 2021 +0200 Allow :filter t in make-process to work as with set-process-filter * src/process.c (create_process): (create_pty): (Fmake_pipe_process): (Fmake_serial_process): Don't add the read_fd if the filter is t (which means that we don't accept output from the filter). diff --git a/src/process.c b/src/process.c index 6731f8808f..f923aff1cb 100644 --- a/src/process.c +++ b/src/process.c @@ -2167,7 +2167,8 @@ create_process (Lisp_Object process, char **new_argv, Lisp_Object current_dir) p->pty_flag = pty_flag; pset_status (p, Qrun); - if (!EQ (p->command, Qt)) + if (!EQ (p->command, Qt) + && !EQ (p->filter, Qt)) add_process_read_fd (inchannel); ptrdiff_t count = SPECPDL_INDEX (); @@ -2285,7 +2286,8 @@ create_pty (Lisp_Object process) pset_status (p, Qrun); setup_process_coding_systems (process); - add_process_read_fd (pty_fd); + if (!EQ (p->filter, Qt)) + add_process_read_fd (pty_fd); pset_tty_name (p, build_string (pty_name)); } @@ -2394,7 +2396,8 @@ usage: (make-pipe-process &rest ARGS) */) pset_command (p, Qt); eassert (! p->pty_flag); - if (!EQ (p->command, Qt)) + if (!EQ (p->command, Qt) + && !EQ (p->filter, Qt)) add_process_read_fd (inchannel); p->adaptive_read_buffering = (NILP (Vprocess_adaptive_read_buffering) ? 0 @@ -3129,7 +3132,8 @@ usage: (make-serial-process &rest ARGS) */) pset_command (p, Qt); eassert (! p->pty_flag); - if (!EQ (p->command, Qt)) + if (!EQ (p->command, Qt) + && !EQ (p->filter, Qt)) add_process_read_fd (fd); update_process_mark (p); commit 595dcf88fd880a1c96fb7bb462ac53fedd2eb744 Author: Lars Ingebrigtsen Date: Mon Oct 18 07:37:08 2021 +0200 Do kbd-valid-p prefix comparisons case-sensitively * lisp/subr.el (kbd-valid-p): Compare case-sensitively. diff --git a/lisp/subr.el b/lisp/subr.el index f2cbe36340..78709b7fa9 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -941,7 +941,8 @@ which is (save-match-data (catch 'exit (let ((prefixes - "\\(A-\\)?\\(C-\\)?\\(H-\\)?\\(M-\\)?\\(S-\\)?\\(s-\\)?")) + "\\(A-\\)?\\(C-\\)?\\(H-\\)?\\(M-\\)?\\(S-\\)?\\(s-\\)?") + (case-fold-search nil)) (dolist (key (split-string keys " ")) ;; Every key might have these modifiers, and they should be ;; in this order. diff --git a/test/lisp/subr-tests.el b/test/lisp/subr-tests.el index 3e6a7a8bd8..238c9be1ab 100644 --- a/test/lisp/subr-tests.el +++ b/test/lisp/subr-tests.el @@ -311,6 +311,7 @@ (should (kbd-valid-p "")) (should (kbd-valid-p "")) + (should (not (kbd-valid-p "c-x"))) (should (not (kbd-valid-p "C-xx"))) (should (not (kbd-valid-p "M-xx"))) (should (not (kbd-valid-p "M-x")))) commit 3b138917b792695cc015a4a6786e171e768dc708 Author: Stefan Kangas Date: Mon Oct 18 02:35:33 2021 +0200 ; * INSTALL: Fix typo. diff --git a/INSTALL b/INSTALL index 8c036f2e60..6207f43cec 100644 --- a/INSTALL +++ b/INSTALL @@ -220,7 +220,7 @@ GNU/Linux distribution that you use, and the options that you want to configure Emacs with. On Debian-based systems, you can install all the packages needed to build the installed version of Emacs with a command like 'apt-get build-dep emacs' (on older systems, replace 'emacs' with -eg 'emacs25'). On Red Hat-based systems, the corresponding command is +e.g. 'emacs25'). On Red Hat-based systems, the corresponding command is 'dnf builddep emacs' (on older systems, use 'yum-builddep' instead). On FreeBSD, the command is 'pkg install -y `pkg rquery %dn emacs-devel`'. commit 735086e440aa748072be547f04c8878ac3798723 Author: Stefan Kangas Date: Sat Oct 16 14:39:04 2021 +0200 Recommend against using uce.el * lisp/mail/uce.el (uce-reply-to-uce): Recommend against its use on the first invocation. (Bug#46472) diff --git a/lisp/mail/uce.el b/lisp/mail/uce.el index b07004de38..4347ff1402 100644 --- a/lisp/mail/uce.el +++ b/lisp/mail/uce.el @@ -30,6 +30,9 @@ ;; uce-reply-to-uce. Please let me know about your changes so I can ;; incorporate them. I'd appreciate it. +;; NOTE: We don't recommend using this feature; see the message in +;; 'uce-reply-to-uce' for the reasons. + ;; The command uce-reply-to-uce, if called when the current message ;; buffer is a UCE, will setup a reply *mail* buffer as follows. It ;; scans the full headers of the message for: 1) the normal return @@ -213,6 +216,8 @@ These are mostly meant for headers that prevent delivery errors reporting." (declare-function rmail-maybe-set-message-counters "rmail" ()) (declare-function rmail-toggle-header "rmail" (&optional arg)) +(defvar uce--usage-warning-displayed nil) + ;;;###autoload (defun uce-reply-to-uce (&optional _ignored) "Compose a reply to unsolicited commercial email (UCE). @@ -358,7 +363,32 @@ You might need to set `uce-mail-reader' before using this." ;; Run hooks before we leave buffer for editing. Reasonable usage ;; might be to set up special key bindings, replace standard ;; functions in mail-mode, etc. - (run-hooks 'mail-setup-hook 'uce-setup-hook)))) + (run-hooks 'mail-setup-hook 'uce-setup-hook))) + (unless uce--usage-warning-displayed + (setq uce--usage-warning-displayed t) + (pop-to-buffer (get-buffer-create "uce-reply-to-uce warning")) + (insert "\ +-- !!! NOTE !!! --------------------------------------------- + +Replying to spam is at best pointless, but most likely actively +harmful. + +- You will confirm that your email address is valid, thus ensuring + you get more spam. + +- You will leak information and open yourself up for further + attack. For example, they could use your \"geolocation\" to find + your home address and phone number. + +- The sender address is likely fake. + +- You help them refine their methods of spamming. + +Therefore, we strongly recommend that you do not use this package. +Use a spam filter instead, or just delete the spam. + +------------------------------------------------------------- +"))) (defun uce-insert-ranting (&optional _ignored) "Insert text of the usual reply to UCE into current buffer." commit 7b4b7de26e640fb4fe7cf6584c9045a06fe1c90f Author: Stefan Kangas Date: Mon Oct 18 01:49:39 2021 +0200 * lisp/erc/erc-compat.el (format-spec): Remove redundant require. diff --git a/lisp/erc/erc-compat.el b/lisp/erc/erc-compat.el index 6b1da2f905..9bbc1f6a0d 100644 --- a/lisp/erc/erc-compat.el +++ b/lisp/erc/erc-compat.el @@ -27,8 +27,6 @@ ;;; Code: -(require 'format-spec) - ;;;###autoload(autoload 'erc-define-minor-mode "erc-compat") (define-obsolete-function-alias 'erc-define-minor-mode #'define-minor-mode "28.1") commit 140e587dd505849cb09c5b3f183bbc686ac020b7 Author: Stefan Kangas Date: Mon Oct 18 01:33:21 2021 +0200 Prefer defvar-local in MH-E * lisp/mh-e/mh-comp.el (mh-insert-auto-fields-done-local): * lisp/mh-e/mh-e.el (mh-thread-scan-line-map) (mh-thread-scan-line-map-stack): * lisp/mh-e/mh-identity.el (mh-identity-pgg-default-user-id) (mh-identity-local): * lisp/mh-e/mh-scan.el (mh-cmd-note): * lisp/mh-e/mh-seq.el (mh-non-seq-mode-line-annotation): * lisp/mh-e/mh-thread.el (mh-thread-id-hash) (mh-thread-subject-hash, mh-thread-id-table) (mh-thread-index-id-map, mh-thread-id-index-map) (mh-thread-subject-container-hash, mh-thread-duplicates) (mh-thread-history): Prefer defvar-local. diff --git a/lisp/mh-e/mh-comp.el b/lisp/mh-e/mh-comp.el index b42527f1bf..130d3784dd 100644 --- a/lisp/mh-e/mh-comp.el +++ b/lisp/mh-e/mh-comp.el @@ -177,9 +177,8 @@ Used by the \\[mh-edit-again] and \\[mh-extract-rejected-mail] commands.") "Messages annotated, either a sequence name or a list of message numbers. This variable can be used by `mh-annotate-msg-hook'.") -(defvar mh-insert-auto-fields-done-local nil +(defvar-local mh-insert-auto-fields-done-local nil "Buffer-local variable set when `mh-insert-auto-fields' called successfully.") -(make-variable-buffer-local 'mh-insert-auto-fields-done-local) diff --git a/lisp/mh-e/mh-e.el b/lisp/mh-e/mh-e.el index f47b6f46cf..4e1ca2897b 100644 --- a/lisp/mh-e/mh-e.el +++ b/lisp/mh-e/mh-e.el @@ -345,15 +345,13 @@ when searching for a separator.") "This regular expression matches the signature separator. See `mh-signature-separator'.") -(defvar mh-thread-scan-line-map nil +(defvar-local mh-thread-scan-line-map nil "Map of message index to various parts of the scan line.") -(make-variable-buffer-local 'mh-thread-scan-line-map) -(defvar mh-thread-scan-line-map-stack nil +(defvar-local mh-thread-scan-line-map-stack nil "Old map of message index to various parts of the scan line. This is the original map that is stored when the folder is narrowed.") -(make-variable-buffer-local 'mh-thread-scan-line-map-stack) (defcustom mh-x-mailer-string nil "String containing the contents of the X-Mailer header field. diff --git a/lisp/mh-e/mh-identity.el b/lisp/mh-e/mh-identity.el index 3643e46231..994ab71391 100644 --- a/lisp/mh-e/mh-identity.el +++ b/lisp/mh-e/mh-identity.el @@ -39,11 +39,10 @@ (autoload 'mml-insert-tag "mml") -(defvar mh-identity-pgg-default-user-id nil +(defvar-local mh-identity-pgg-default-user-id nil "Holds the GPG key ID to be used by pgg.el. This is normally set as part of an Identity in `mh-identity-list'.") -(make-variable-buffer-local 'mh-identity-pgg-default-user-id) (defvar mh-identity-menu nil "The Identity menu.") @@ -90,9 +89,8 @@ See `mh-identity-make-menu'." (declare (obsolete nil "29.1")) nil) -(defvar mh-identity-local nil +(defvar-local mh-identity-local nil "Buffer-local variable that holds the identity currently in use.") -(make-variable-buffer-local 'mh-identity-local) (defun mh-header-field-delete (field value-only) "Delete header FIELD, or only its value if VALUE-ONLY is t. diff --git a/lisp/mh-e/mh-scan.el b/lisp/mh-e/mh-scan.el index 5aa599942e..5a1a671aee 100644 --- a/lisp/mh-e/mh-scan.el +++ b/lisp/mh-e/mh-scan.el @@ -315,7 +315,7 @@ produced by \"inc\".") ;;; Widths, Offsets and Columns -(defvar mh-cmd-note 4 +(defvar-local mh-cmd-note 4 "Column for notations. This variable should be set with the function `mh-set-cmd-note'. @@ -323,7 +323,6 @@ This variable may be updated dynamically if `mh-adaptive-cmd-note-flag' is on. Note that columns in Emacs start with 0.") -(make-variable-buffer-local 'mh-cmd-note) (defvar mh-scan-cmd-note-width 1 "Number of columns consumed by the cmd-note field in `mh-scan-format'. diff --git a/lisp/mh-e/mh-seq.el b/lisp/mh-e/mh-seq.el index f4dd65177f..077e289c01 100644 --- a/lisp/mh-e/mh-seq.el +++ b/lisp/mh-e/mh-seq.el @@ -38,9 +38,8 @@ (defvar mh-last-seq-used nil "Name of seq to which a msg was last added.") -(defvar mh-non-seq-mode-line-annotation nil +(defvar-local mh-non-seq-mode-line-annotation nil "Saved value of `mh-mode-line-annotation' when narrowed to a seq.") -(make-variable-buffer-local 'mh-non-seq-mode-line-annotation) (defvar mh-internal-seqs '(answered cur deleted forwarded printed)) diff --git a/lisp/mh-e/mh-thread.el b/lisp/mh-e/mh-thread.el index a4b4151bcf..21954da6ac 100644 --- a/lisp/mh-e/mh-thread.el +++ b/lisp/mh-e/mh-thread.el @@ -86,41 +86,33 @@ message parent children (real-child-p t)) -(defvar mh-thread-id-hash nil +(defvar-local mh-thread-id-hash nil "Hash table used to canonicalize message identifiers.") -(make-variable-buffer-local 'mh-thread-id-hash) -(defvar mh-thread-subject-hash nil +(defvar-local mh-thread-subject-hash nil "Hash table used to canonicalize subject strings.") -(make-variable-buffer-local 'mh-thread-subject-hash) -(defvar mh-thread-id-table nil +(defvar-local mh-thread-id-table nil "Thread ID table maps from message identifiers to message containers.") -(make-variable-buffer-local 'mh-thread-id-table) -(defvar mh-thread-index-id-map nil +(defvar-local mh-thread-index-id-map nil "Table to look up message identifier from message index.") -(make-variable-buffer-local 'mh-thread-index-id-map) -(defvar mh-thread-id-index-map nil +(defvar-local mh-thread-id-index-map nil "Table to look up message index number from message identifier.") -(make-variable-buffer-local 'mh-thread-id-index-map) -(defvar mh-thread-subject-container-hash nil +(defvar-local mh-thread-subject-container-hash nil "Hash table used to group messages by subject.") -(make-variable-buffer-local 'mh-thread-subject-container-hash) -(defvar mh-thread-duplicates nil +(defvar-local mh-thread-duplicates nil "Hash table used to associate messages with the same message identifier.") -(make-variable-buffer-local 'mh-thread-duplicates) -(defvar mh-thread-history () +(defvar-local mh-thread-history () "Variable to remember the transformations to the thread tree. When new messages are added, these transformations are rewound, then the links are added from the newly seen messages. Finally the transformations are redone to get the new thread tree. This makes incremental threading easier.") -(make-variable-buffer-local 'mh-thread-history) (defvar mh-thread-body-width nil "Width of scan substring that contains subject and body of message.") commit 7a876397b271c52d603381858750c0224e600e3b Author: Stefan Kangas Date: Mon Oct 18 01:28:49 2021 +0200 Make thumbs-image-type obsolete * lisp/thumbs.el (thumbs-image-type): Make into obsolete function alias for 'image-type-from-file-name'. Update callers. diff --git a/lisp/thumbs.el b/lisp/thumbs.el index 4c863883ba..001b2c8e77 100644 --- a/lisp/thumbs.el +++ b/lisp/thumbs.el @@ -91,7 +91,7 @@ When it reaches that size (in bytes), a warning is sent." (defcustom thumbs-conversion-program (if (eq system-type 'windows-nt) ;; FIXME is this necessary, or can a sane PATHEXE be assumed? - ;; Eg find-program does not do this. + ;; E.g. find-program does not do this. "convert.exe" "convert") "Name of conversion program for thumbnails generation. @@ -292,22 +292,11 @@ smaller according to whether INCREMENT is 1 or -1." (thumbs-call-convert fn tn "sample" thumbs-geometry)) tn)) -(defun thumbs-image-type (img) - "Return image type from filename IMG." - (cond ((string-match ".*\\.jpe?g\\'" img) 'jpeg) - ((string-match ".*\\.xpm\\'" img) 'xpm) - ((string-match ".*\\.xbm\\'" img) 'xbm) - ((string-match ".*\\.pbm\\'" img) 'pbm) - ((string-match ".*\\.gif\\'" img) 'gif) - ((string-match ".*\\.bmp\\'" img) 'bmp) - ((string-match ".*\\.png\\'" img) 'png) - ((string-match ".*\\.tiff?\\'" img) 'tiff))) - (declare-function image-size "image.c" (spec &optional pixels frame)) (defun thumbs-file-size (img) (let ((i (image-size - (find-image `((:type ,(thumbs-image-type img) :file ,img))) t))) + (find-image `((:type ,(image-type-from-file-name img) :file ,img))) t))) (concat (number-to-string (round (car i))) "x" (number-to-string (round (cdr i)))))) @@ -410,7 +399,7 @@ and SAME-WINDOW to show thumbs in the same window." thumbs-image-num (or num 0)) (delete-region (point-min)(point-max)) (save-excursion - (thumbs-insert-image img (thumbs-image-type img) 0))))) + (thumbs-insert-image img (image-type-from-file-name img) 0))))) (defun thumbs-find-image-at-point (&optional img otherwin) "Display image IMG for thumbnail at point. @@ -544,7 +533,7 @@ Open another window." " - " (number-to-string num))) (let ((inhibit-read-only t)) (erase-buffer) - (thumbs-insert-image img (thumbs-image-type img) 0) + (thumbs-insert-image img (image-type-from-file-name img) 0) (goto-char (point-min)))) (setq thumbs-image-num num thumbs-current-image-filename img)))) @@ -775,6 +764,9 @@ ACTION and ARG should be a valid convert command." (define-key dired-mode-map "\C-tm" 'thumbs-dired-show-marked) (define-key dired-mode-map "\C-tw" 'thumbs-dired-setroot) +(define-obsolete-function-alias 'thumbs-image-type + #'image-type-from-file-name "29.1") + (provide 'thumbs) ;;; thumbs.el ends here commit 38527847f18012a5725a31c2afb8fe34cc6da6a7 Author: Lars Ingebrigtsen Date: Mon Oct 18 01:27:27 2021 +0200 Use define-keymap in pcvs and pcvs-defs.el * lisp/vc/pcvs-defs.el (cvs-mode-diff-map): * lisp/vc/pcvs.el (pcvs-defs): (cvs-mode-diff-map): Move maps to pcvs (because the commands are defined in pcvs.el and #' gives us checking) and transform from easy-mmode-defmap to define-keymap. diff --git a/lisp/vc/pcvs-defs.el b/lisp/vc/pcvs-defs.el index 54ef06960f..c3109f7e85 100644 --- a/lisp/vc/pcvs-defs.el +++ b/lisp/vc/pcvs-defs.el @@ -264,160 +264,6 @@ This variable is buffer local and only used in the *cvs* buffer.") (defconst cvs-vendor-branch "1.1.1" "The default branch used by CVS for vendor code.") -(easy-mmode-defmap cvs-mode-diff-map - '(("E" "imerge" . cvs-mode-imerge) - ("=" . cvs-mode-diff) - ("e" "idiff" . cvs-mode-idiff) - ("2" "other" . cvs-mode-idiff-other) - ("d" "diff" . cvs-mode-diff) - ("b" "backup" . cvs-mode-diff-backup) - ("h" "head" . cvs-mode-diff-head) - ("r" "repository" . cvs-mode-diff-repository) - ("y" "yesterday" . cvs-mode-diff-yesterday) - ("v" "vendor" . cvs-mode-diff-vendor)) - "Keymap for diff-related operations in `cvs-mode'." - :name "Diff") -;; This is necessary to allow correct handling of \\[cvs-mode-diff-map] -;; in substitute-command-keys. -(fset 'cvs-mode-diff-map cvs-mode-diff-map) - -(easy-mmode-defmap cvs-mode-map - ;;(define-prefix-command 'cvs-mode-map-diff-prefix) - ;;(define-prefix-command 'cvs-mode-map-control-c-prefix) - '(;; various - ;; (undo . cvs-mode-undo) - ("?" . cvs-help) - ("h" . cvs-help) - ("q" . cvs-bury-buffer) - ("z" . kill-this-buffer) - ("F" . cvs-mode-set-flags) - ;; ("\M-f" . cvs-mode-force-command) - ("!" . cvs-mode-force-command) - ("\C-c\C-c" . cvs-mode-kill-process) - ;; marking - ("m" . cvs-mode-mark) - ("M" . cvs-mode-mark-all-files) - ("S" . cvs-mode-mark-on-state) - ("u" . cvs-mode-unmark) - ("\C-?". cvs-mode-unmark-up) - ("%" . cvs-mode-mark-matching-files) - ("T" . cvs-mode-toggle-marks) - ("\M-\C-?" . cvs-mode-unmark-all-files) - ;; navigation keys - (" " . cvs-mode-next-line) - ("n" . cvs-mode-next-line) - ("p" . cvs-mode-previous-line) - ("\t" . cvs-mode-next-line) - ([backtab] . cvs-mode-previous-line) - ;; M- keys are usually those that operate on modules - ;;("\M-C". cvs-mode-rcs2log) ; i.e. "Create a ChangeLog" - ;;("\M-t". cvs-rtag) - ;;("\M-l". cvs-rlog) - ("\M-c". cvs-checkout) - ("\M-e". cvs-examine) - ("g" . cvs-mode-revert-buffer) - ("\M-u". cvs-update) - ("\M-s". cvs-status) - ;; diff commands - ("=" . cvs-mode-diff) - ("d" . cvs-mode-diff-map) - ;; keys that operate on individual files - ("\C-k" . cvs-mode-acknowledge) - ("A" . cvs-mode-add-change-log-entry-other-window) - ;;("B" . cvs-mode-byte-compile-files) - ("C" . cvs-mode-commit-setup) - ("O" . cvs-mode-update) - ("U" . cvs-mode-undo) - ("I" . cvs-mode-insert) - ("a" . cvs-mode-add) - ("b" . cvs-set-branch-prefix) - ("B" . cvs-set-secondary-branch-prefix) - ("c" . cvs-mode-commit) - ("e" . cvs-mode-examine) - ("f" . cvs-mode-find-file) - ("\C-m" . cvs-mode-find-file) - ("i" . cvs-mode-ignore) - ("l" . cvs-mode-log) - ("o" . cvs-mode-find-file-other-window) - ("r" . cvs-mode-remove) - ("s" . cvs-mode-status) - ("t" . cvs-mode-tag) - ("v" . cvs-mode-view-file) - ("x" . cvs-mode-remove-handled) - ;; cvstree bindings - ("+" . cvs-mode-tree) - ;; mouse bindings - ([mouse-2] . cvs-mode-find-file) - ([follow-link] . (lambda (pos) - (if (eq (get-char-property pos 'face) 'cvs-filename) t))) - ([(down-mouse-3)] . cvs-menu) - ;; dired-like bindings - ("\C-o" . cvs-mode-display-file) - ;; Emacs-21 toolbar - ;;([tool-bar item1] . (menu-item "Examine" cvs-examine :image (image :file "/usr/share/icons/xpaint.xpm" :type xpm))) - ;;([tool-bar item2] . (menu-item "Update" cvs-update :image (image :file "/usr/share/icons/mail1.xpm" :type xpm))) - ) - "Keymap for `cvs-mode'." - :dense t - :suppress t) - -(fset 'cvs-mode-map cvs-mode-map) - -(easy-menu-define cvs-menu cvs-mode-map "Menu used in `cvs-mode'." - '("CVS" - ["Open file" cvs-mode-find-file t] - ["Open in other window" cvs-mode-find-file-other-window t] - ["Display in other window" cvs-mode-display-file t] - ["Interactive merge" cvs-mode-imerge t] - ("View diff" - ["Interactive diff" cvs-mode-idiff t] - ["Current diff" cvs-mode-diff t] - ["Diff with head" cvs-mode-diff-head t] - ["Diff with vendor" cvs-mode-diff-vendor t] - ["Diff against yesterday" cvs-mode-diff-yesterday t] - ["Diff with backup" cvs-mode-diff-backup t]) - ["View log" cvs-mode-log t] - ["View status" cvs-mode-status t] - ["View tag tree" cvs-mode-tree t] - "----" - ["Insert" cvs-mode-insert] - ["Update" cvs-mode-update (cvs-enabledp 'update)] - ["Re-examine" cvs-mode-examine t] - ["Commit" cvs-mode-commit-setup (cvs-enabledp 'commit)] - ["Tag" cvs-mode-tag (cvs-enabledp (when cvs-force-dir-tag 'tag))] - ["Undo changes" cvs-mode-undo (cvs-enabledp 'undo)] - ["Add" cvs-mode-add (cvs-enabledp 'add)] - ["Remove" cvs-mode-remove (cvs-enabledp 'remove)] - ["Ignore" cvs-mode-ignore (cvs-enabledp 'ignore)] - ["Add ChangeLog" cvs-mode-add-change-log-entry-other-window t] - "----" - ["Mark" cvs-mode-mark t] - ["Mark all" cvs-mode-mark-all-files t] - ["Mark by regexp..." cvs-mode-mark-matching-files t] - ["Mark by state..." cvs-mode-mark-on-state t] - ["Unmark" cvs-mode-unmark t] - ["Unmark all" cvs-mode-unmark-all-files t] - ["Hide handled" cvs-mode-remove-handled t] - "----" - ["PCL-CVS Manual" (lambda () (interactive) - (info "(pcl-cvs)Top")) t] - "----" - ["Quit" cvs-mode-quit t])) - -;;;; -;;;; CVS-Minor mode -;;;; - -(defcustom cvs-minor-mode-prefix "\C-xc" - "Prefix key for the `cvs-mode' bindings in `cvs-minor-mode'." - :type 'string) - -(easy-mmode-defmap cvs-minor-mode-map - `((,cvs-minor-mode-prefix . cvs-mode-map) - ("e" . (menu-item nil cvs-mode-edit-log - :filter (lambda (x) (if (derived-mode-p 'log-view-mode) x))))) - "Keymap for `cvs-minor-mode', used in buffers related to PCL-CVS.") - (defvar cvs-buffer nil "(Buffer local) The *cvs* buffer associated with this buffer.") (put 'cvs-buffer 'permanent-local t) diff --git a/lisp/vc/pcvs.el b/lisp/vc/pcvs.el index 0413b2bc56..15c9157f00 100644 --- a/lisp/vc/pcvs.el +++ b/lisp/vc/pcvs.el @@ -117,7 +117,6 @@ (require 'cl-lib) (require 'ewoc) ;Ewoc was once cookie -(require 'pcvs-defs) (require 'pcvs-util) (require 'pcvs-parse) (require 'pcvs-info) @@ -138,6 +137,147 @@ (defvar cvs-from-vc nil "Bound to t inside VC advice.") +(defvar-keymap cvs-mode-diff-map + :name "Diff" + "E" (cons "imerge" #'cvs-mode-imerge) + "=" #'cvs-mode-diff + "e" (cons "idiff" #'cvs-mode-idiff) + "2" (cons "other" #'cvs-mode-idiff-other) + "d" (cons "diff" #'cvs-mode-diff) + "b" (cons "backup" #'cvs-mode-diff-backup) + "h" (cons "head" #'cvs-mode-diff-head) + "r" (cons "repository" #'cvs-mode-diff-repository) + "y" (cons "yesterday" #'cvs-mode-diff-yesterday) + "v" (cons "vendor" #'cvs-mode-diff-vendor)) +;; This is necessary to allow correct handling of \\[cvs-mode-diff-map] +;; in substitute-command-keys. +(fset 'cvs-mode-diff-map cvs-mode-diff-map) + +(defvar-keymap cvs-mode-map + :full t + :suppress t + ;; various + "?" #'cvs-help + "h" #'cvs-help + "q" #'cvs-bury-buffer + "z" #'kill-this-buffer + "F" #'cvs-mode-set-flags + "!" #'cvs-mode-force-command + ["C-c C-c"] #'cvs-mode-kill-process + ;; marking + "m" #'cvs-mode-mark + "M" #'cvs-mode-mark-all-files + "S" #'cvs-mode-mark-on-state + "u" #'cvs-mode-unmark + ["DEL"] #'cvs-mode-unmark-up + "%" #'cvs-mode-mark-matching-files + "T" #'cvs-mode-toggle-marks + ["M-DEL"] #'cvs-mode-unmark-all-files + ;; navigation keys + " " #'cvs-mode-next-line + "n" #'cvs-mode-next-line + "p" #'cvs-mode-previous-line + "\t" #'cvs-mode-next-line + [backtab] #'cvs-mode-previous-line + ;; M- keys are usually those that operate on modules + ["M-c"] #'cvs-checkout + ["M-e"] #'cvs-examine + "g" #'cvs-mode-revert-buffer + ["M-u"] #'cvs-update + ["M-s"] #'cvs-status + ;; diff commands + "=" #'cvs-mode-diff + "d" cvs-mode-diff-map + ;; keys that operate on individual files + ["C-k"] #'cvs-mode-acknowledge + "A" #'cvs-mode-add-change-log-entry-other-window + "C" #'cvs-mode-commit-setup + "O" #'cvs-mode-update + "U" #'cvs-mode-undo + "I" #'cvs-mode-insert + "a" #'cvs-mode-add + "b" #'cvs-set-branch-prefix + "B" #'cvs-set-secondary-branch-prefix + "c" #'cvs-mode-commit + "e" #'cvs-mode-examine + "f" #'cvs-mode-find-file + ["RET"] #'cvs-mode-find-file + "i" #'cvs-mode-ignore + "l" #'cvs-mode-log + "o" #'cvs-mode-find-file-other-window + "r" #'cvs-mode-remove + "s" #'cvs-mode-status + "t" #'cvs-mode-tag + "v" #'cvs-mode-view-file + "x" #'cvs-mode-remove-handled + ;; cvstree bindings + "+" #'cvs-mode-tree + ;; mouse bindings + [mouse-2] #'cvs-mode-find-file + [follow-link] (lambda (pos) + (eq (get-char-property pos 'face) 'cvs-filename)) + [(down-mouse-3)] #'cvs-menu + ;; dired-like bindings + "\C-o" #'cvs-mode-display-file) + +(easy-menu-define cvs-menu cvs-mode-map "Menu used in `cvs-mode'." + '("CVS" + ["Open file" cvs-mode-find-file t] + ["Open in other window" cvs-mode-find-file-other-window t] + ["Display in other window" cvs-mode-display-file t] + ["Interactive merge" cvs-mode-imerge t] + ("View diff" + ["Interactive diff" cvs-mode-idiff t] + ["Current diff" cvs-mode-diff t] + ["Diff with head" cvs-mode-diff-head t] + ["Diff with vendor" cvs-mode-diff-vendor t] + ["Diff against yesterday" cvs-mode-diff-yesterday t] + ["Diff with backup" cvs-mode-diff-backup t]) + ["View log" cvs-mode-log t] + ["View status" cvs-mode-status t] + ["View tag tree" cvs-mode-tree t] + "----" + ["Insert" cvs-mode-insert] + ["Update" cvs-mode-update (cvs-enabledp 'update)] + ["Re-examine" cvs-mode-examine t] + ["Commit" cvs-mode-commit-setup (cvs-enabledp 'commit)] + ["Tag" cvs-mode-tag (cvs-enabledp (when cvs-force-dir-tag 'tag))] + ["Undo changes" cvs-mode-undo (cvs-enabledp 'undo)] + ["Add" cvs-mode-add (cvs-enabledp 'add)] + ["Remove" cvs-mode-remove (cvs-enabledp 'remove)] + ["Ignore" cvs-mode-ignore (cvs-enabledp 'ignore)] + ["Add ChangeLog" cvs-mode-add-change-log-entry-other-window t] + "----" + ["Mark" cvs-mode-mark t] + ["Mark all" cvs-mode-mark-all-files t] + ["Mark by regexp..." cvs-mode-mark-matching-files t] + ["Mark by state..." cvs-mode-mark-on-state t] + ["Unmark" cvs-mode-unmark t] + ["Unmark all" cvs-mode-unmark-all-files t] + ["Hide handled" cvs-mode-remove-handled t] + "----" + ["PCL-CVS Manual" (lambda () (interactive) + (info "(pcl-cvs)Top")) t] + "----" + ["Quit" cvs-mode-quit t])) + +;;;; +;;;; CVS-Minor mode +;;;; + +(defcustom cvs-minor-mode-prefix "\C-xc" + "Prefix key for the `cvs-mode' bindings in `cvs-minor-mode'." + :type 'string + :group 'pcl-cvs) + +(defvar-keymap cvs-minor-mode-map + cvs-minor-mode-prefix 'cvs-mode-map + "e" '(menu-item nil cvs-mode-edit-log + :filter (lambda (x) + (and (derived-mode-p 'log-view-mode) x)))) + +(require 'pcvs-defs) + ;;;; ;;;; flags variables ;;;; commit 9efa67f764cc55ceaf846eccf61a6943975f0d6d Author: Lars Ingebrigtsen Date: Mon Oct 18 00:49:56 2021 +0200 Convert diff-mode.el from easy-mmode-defmap to define-keymap * lisp/vc/diff-mode.el (diff-mode-shared-map, diff-mode-map) (diff-minor-mode-map): Convert from easy-mmode-defmap to defvar-keymap. diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el index 057ffcd06e..297bf4a548 100644 --- a/lisp/vc/diff-mode.el +++ b/lisp/vc/diff-mode.el @@ -162,57 +162,55 @@ and hunk-based syntax highlighting otherwise as a fallback." ;;;; keymap, menu, ... ;;;; -(easy-mmode-defmap diff-mode-shared-map - '(("n" . diff-hunk-next) - ("N" . diff-file-next) - ("p" . diff-hunk-prev) - ("P" . diff-file-prev) - ("\t" . diff-hunk-next) - ([backtab] . diff-hunk-prev) - ("k" . diff-hunk-kill) - ("K" . diff-file-kill) - ("}" . diff-file-next) ; From compilation-minor-mode. - ("{" . diff-file-prev) - ("\C-m" . diff-goto-source) - ([mouse-2] . diff-goto-source) - ("W" . widen) - ("o" . diff-goto-source) ; other-window - ("A" . diff-ediff-patch) - ("r" . diff-restrict-view) - ("R" . diff-reverse-direction) - ([remap undo] . diff-undo)) - "Basic keymap for `diff-mode', bound to various prefix keys." - :inherit special-mode-map) - -(easy-mmode-defmap diff-mode-map - `(("\e" . ,(let ((map (make-sparse-keymap))) - ;; We want to inherit most bindings from diff-mode-shared-map, - ;; but not all since they may hide useful M- global - ;; bindings when editing. - (set-keymap-parent map diff-mode-shared-map) - (dolist (key '("A" "r" "R" "g" "q" "W" "z")) - (define-key map key nil)) - map)) - ;; From compilation-minor-mode. - ("\C-c\C-c" . diff-goto-source) - ;; By analogy with the global C-x 4 a binding. - ("\C-x4A" . diff-add-change-log-entries-other-window) - ;; Misc operations. - ("\C-c\C-a" . diff-apply-hunk) - ("\C-c\C-e" . diff-ediff-patch) - ("\C-c\C-n" . diff-restrict-view) - ("\C-c\C-s" . diff-split-hunk) - ("\C-c\C-t" . diff-test-hunk) - ("\C-c\C-r" . diff-reverse-direction) - ("\C-c\C-u" . diff-context->unified) - ;; `d' because it duplicates the context :-( --Stef - ("\C-c\C-d" . diff-unified->context) - ("\C-c\C-w" . diff-ignore-whitespace-hunk) - ;; `l' because it "refreshes" the hunk like C-l refreshes the screen - ("\C-c\C-l" . diff-refresh-hunk) - ("\C-c\C-b" . diff-refine-hunk) ;No reason for `b' :-( - ("\C-c\C-f" . next-error-follow-minor-mode)) - "Keymap for `diff-mode'. See also `diff-mode-shared-map'.") +(defvar-keymap diff-mode-shared-map + :inherit special-mode-map + "n" #'diff-hunk-next + "N" #'diff-file-next + "p" #'diff-hunk-prev + "P" #'diff-file-prev + ["TAB"] #'diff-hunk-next + [backtab] #'diff-hunk-prev + "k" #'diff-hunk-kill + "K" #'diff-file-kill + "}" #'diff-file-next ; From compilation-minor-mode. + "{" #'diff-file-prev + ["RET"] #'diff-goto-source + [mouse-2] #'diff-goto-source + "W" #'widen + "o" #'diff-goto-source ; other-window + "A" #'diff-ediff-patch + "r" #'diff-restrict-view + "R" #'diff-reverse-direction + [remap undo] #'diff-undo) + +(defvar-keymap diff-mode-map + :doc "Keymap for `diff-mode'. See also `diff-mode-shared-map'." + ["ESC"] (let ((map (define-keymap :parent diff-mode-shared-map))) + ;; We want to inherit most bindings from + ;; `diff-mode-shared-map', but not all since they may hide + ;; useful `M-' global bindings when editing. + (dolist (key '("A" "r" "R" "g" "q" "W" "z")) + (define-key map key nil)) + map) + ;; From compilation-minor-mode. + ["C-c C-c"] #'diff-goto-source + ;; By analogy with the global C-x 4 a binding. + ["C-x 4 A"] #'diff-add-change-log-entries-other-window + ;; Misc operations. + ["C-c C-a"] #'diff-apply-hunk + ["C-c C-e"] #'diff-ediff-patch + ["C-c C-n"] #'diff-restrict-view + ["C-c C-s"] #'diff-split-hunk + ["C-c C-t"] #'diff-test-hunk + ["C-c C-r"] #'diff-reverse-direction + ["C-c C-u"] #'diff-context->unified + ;; `d' because it duplicates the context :-( --Stef + ["C-c C-d"] #'diff-unified->context + ["C-c C-w"] #'diff-ignore-whitespace-hunk + ;; `l' because it "refreshes" the hunk like C-l refreshes the screen + ["C-c C-l"] #'diff-refresh-hunk + ["C-c C-b"] #'diff-refine-hunk ;No reason for `b' :-( + ["C-c C-f"] #'next-error-follow-minor-mode) (easy-menu-define diff-mode-menu diff-mode-map "Menu for `diff-mode'." @@ -269,9 +267,9 @@ and hunk-based syntax highlighting otherwise as a fallback." "Prefix key for `diff-minor-mode' commands." :type '(choice (string "\e") (string "C-c=") string)) -(easy-mmode-defmap diff-minor-mode-map - `((,diff-minor-mode-prefix . ,diff-mode-shared-map)) - "Keymap for `diff-minor-mode'. See also `diff-mode-shared-map'.") +(defvar-keymap diff-minor-mode-map + :doc "Keymap for `diff-minor-mode'. See also `diff-mode-shared-map'." + diff-minor-mode-prefix diff-mode-shared-map) (define-minor-mode diff-auto-refine-mode "Toggle automatic diff hunk finer highlighting (Diff Auto Refine mode). commit 2ae3b66fa80ea6ae7256279e36b1ab2c5d2227eb Author: Lars Ingebrigtsen Date: Mon Oct 18 00:35:32 2021 +0200 Convert smerge-mode.el from easy-mmode-defmap to define-keymap * lisp/vc/smerge-mode.el (smerge-basic-map, smerge-mode-map): Convert form easy-mmode-defmap to define-keymap. diff --git a/lisp/vc/smerge-mode.el b/lisp/vc/smerge-mode.el index b2a875c81f..5a0b90863a 100644 --- a/lisp/vc/smerge-mode.el +++ b/lisp/vc/smerge-mode.el @@ -142,25 +142,24 @@ Used in `smerge-diff-base-upper' and related functions." "Face used for added characters shown by `smerge-refine'." :version "24.3") -(easy-mmode-defmap smerge-basic-map - `(("n" . smerge-next) - ("p" . smerge-prev) - ("r" . smerge-resolve) - ("a" . smerge-keep-all) - ("b" . smerge-keep-base) - ("o" . smerge-keep-lower) ; for the obsolete keep-other - ("l" . smerge-keep-lower) - ("m" . smerge-keep-upper) ; for the obsolete keep-mine - ("u" . smerge-keep-upper) - ("E" . smerge-ediff) - ("C" . smerge-combine-with-next) - ("R" . smerge-refine) - ("\C-m" . smerge-keep-current) - ("=" . ,(make-sparse-keymap "Diff")) - ("=<" "base-upper" . smerge-diff-base-upper) - ("=>" "base-lower" . smerge-diff-base-lower) - ("==" "upper-lower" . smerge-diff-upper-lower)) - "The base keymap for `smerge-mode'.") +(defvar-keymap smerge-basic-map + "n" #'smerge-next + "p" #'smerge-prev + "r" #'smerge-resolve + "a" #'smerge-keep-all + "b" #'smerge-keep-base + "o" #'smerge-keep-lower ; for the obsolete keep-other + "l" #'smerge-keep-lower + "m" #'smerge-keep-upper ; for the obsolete keep-mine + "u" #'smerge-keep-upper + "E" #'smerge-ediff + "C" #'smerge-combine-with-next + "R" #'smerge-refine + ["C-m"] #'smerge-keep-current + "=" (define-keymap :name "Diff" + "<" (cons "base-upper" #'smerge-diff-base-upper) + ">" (cons "base-lower" #'smerge-diff-base-lower) + "=" (cons "upper-lower" #'smerge-diff-upper-lower))) (defcustom smerge-command-prefix "\C-c^" "Prefix for `smerge-mode' commands." @@ -169,9 +168,8 @@ Used in `smerge-diff-base-upper' and related functions." (const :tag "none" "") string)) -(easy-mmode-defmap smerge-mode-map - `((,smerge-command-prefix . ,smerge-basic-map)) - "Keymap for `smerge-mode'.") +(defvar-keymap smerge-mode-map + smerge-command-prefix 'smerge-basic-map) (defvar-local smerge-check-cache nil) (defun smerge-check (n) commit 1638f81f9d53d1248db2e48d8ca85f2aeab7690b Author: Lars Ingebrigtsen Date: Sun Oct 17 22:27:13 2021 +0200 Add kbd examples to the doc string * lisp/subr.el (kbd): Add some examples to the doc string. diff --git a/lisp/subr.el b/lisp/subr.el index 07737e2c08..f2cbe36340 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -971,9 +971,18 @@ which is "Convert KEYS to the internal Emacs key representation. KEYS should be a string in the format returned by commands such as `C-h k' (`describe-key'). + This is the same format used for saving keyboard macros (see `edmacro-mode'). +Here's some example key sequences: + + \"f\" + \"C-c C-c\" + \"H-\" + \"M-RET\" + \"C-M-\" + For an approximate inverse of this, see `key-description'." (declare (pure t) (side-effect-free t)) ;; A pure function is expected to preserve the match data. commit 3fa6f7242316a81f5752e4526d94837f2a90f969 Author: Lars Ingebrigtsen Date: Sun Oct 17 22:14:30 2021 +0200 Reverse the edmacro-parse-keys/kbd vector/string logic * lisp/edmacro.el (edmacro-parse-keys): Convert to a vector if needed. * lisp/subr.el (kbd): Remove the NEED-VECTOR parameter. diff --git a/lisp/edmacro.el b/lisp/edmacro.el index decb8edbb1..b3118b0aa6 100644 --- a/lisp/edmacro.el +++ b/lisp/edmacro.el @@ -640,7 +640,10 @@ This function assumes that the events can be stored in a string." ;;; Parsing a human-readable keyboard macro. (defun edmacro-parse-keys (string &optional need-vector) - (kbd string need-vector)) + (let ((result (kbd string))) + (if (and need-vector (stringp result)) + (seq-into result 'vector) + result))) (provide 'edmacro) diff --git a/lisp/subr.el b/lisp/subr.el index 1da453b30f..07737e2c08 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -967,18 +967,14 @@ which is (throw 'exit nil))) t))))) -(defun kbd (keys &optional need-vector) +(defun kbd (keys) "Convert KEYS to the internal Emacs key representation. KEYS should be a string in the format returned by commands such as `C-h k' (`describe-key'). This is the same format used for saving keyboard macros (see `edmacro-mode'). -For an approximate inverse of this, see `key-description'. - -If NEED-VECTOR is non-nil, always return a vector instead of a -string. This is mainly intended for use by `edmacro-parse-keys', -and should normally not be needed." +For an approximate inverse of this, see `key-description'." (declare (pure t) (side-effect-free t)) ;; A pure function is expected to preserve the match data. (save-match-data @@ -1076,15 +1072,13 @@ and should normally not be needed." (setq lres (cdr (cdr lres))) (nreverse lres) lres)))) - (if (and (not need-vector) - (not (memq nil (mapcar (lambda (ch) - (and (numberp ch) - (<= 0 ch 127))) - res)))) - (concat (mapcar (lambda (ch) - (if (= (logand ch ?\M-\^@) 0) - ch (+ ch 128))) - res)) + (if (not (memq nil (mapcar (lambda (ch) + (and (numberp ch) + (<= 0 ch 127))) + res))) + ;; Return a string. + (concat (mapcar #'identity res)) + ;; Return a vector. res)))) (defun undefined () commit c0f5987ffd4374f152197d1f8d0e6efcbcf99d11 Author: Lars Ingebrigtsen Date: Sun Oct 17 21:49:43 2021 +0200 Allow in kbd-valid-p * lisp/subr.el (kbd-valid-p): Allow (kbd-valid-p ""). diff --git a/lisp/subr.el b/lisp/subr.el index 635942205b..1da453b30f 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -940,26 +940,32 @@ which is (string-match-p "\\`[^ ]+\\( [^ ]+\\)*\\'" keys) (save-match-data (catch 'exit - (dolist (key (split-string keys " ")) - ;; Every key might have these modifiers, and they should be - ;; in this order. - (when (string-match - "\\`\\(A-\\)?\\(C-\\)?\\(H-\\)?\\(M-\\)?\\(S-\\)?\\(s-\\)?" - key) - (setq key (substring key (match-end 0)))) - (unless (or (and (= (length key) 1) - ;; Don't accept control characters as keys. - (not (< (aref key 0) ?\s)) - ;; Don't accept Meta'd characters as keys. - (or (multibyte-string-p key) - (not (<= 127 (aref key 0) 255)))) - (string-match-p "\\`<[A-Za-z0-9]+>\\'" key) - (string-match-p - "\\`\\(NUL\\|RET\\|TAB\\|LFD\\|ESC\\|SPC\\|DEL\\)\\'" - key)) - ;; Invalid. - (throw 'exit nil))) - t)))) + (let ((prefixes + "\\(A-\\)?\\(C-\\)?\\(H-\\)?\\(M-\\)?\\(S-\\)?\\(s-\\)?")) + (dolist (key (split-string keys " ")) + ;; Every key might have these modifiers, and they should be + ;; in this order. + (when (string-match (concat "\\`" prefixes) key) + (setq key (substring key (match-end 0)))) + (unless (or (and (= (length key) 1) + ;; Don't accept control characters as keys. + (not (< (aref key 0) ?\s)) + ;; Don't accept Meta'd characters as keys. + (or (multibyte-string-p key) + (not (<= 127 (aref key 0) 255)))) + (and (string-match-p "\\`<[-_A-Za-z0-9]+>\\'" key) + ;; Don't allow . + (= (progn + (string-match + (concat "\\`<" prefixes) key) + (match-end 0)) + 1)) + (string-match-p + "\\`\\(NUL\\|RET\\|TAB\\|LFD\\|ESC\\|SPC\\|DEL\\)\\'" + key)) + ;; Invalid. + (throw 'exit nil))) + t))))) (defun kbd (keys &optional need-vector) "Convert KEYS to the internal Emacs key representation. diff --git a/test/lisp/subr-tests.el b/test/lisp/subr-tests.el index 8380e8abfd..3e6a7a8bd8 100644 --- a/test/lisp/subr-tests.el +++ b/test/lisp/subr-tests.el @@ -308,6 +308,9 @@ (should (kbd-valid-p "C-M-")) (should (not (kbd-valid-p ""))) + (should (kbd-valid-p "")) + (should (kbd-valid-p "")) + (should (not (kbd-valid-p "C-xx"))) (should (not (kbd-valid-p "M-xx"))) (should (not (kbd-valid-p "M-x")))) commit 50296843582b13d3e43c4215c7c4e98e44ce650f Author: Lars Ingebrigtsen Date: Sun Oct 17 21:29:59 2021 +0200 Reinstate defvar-keymap expansion * lisp/emacs-lisp/byte-opt.el (byte-optimize-define-keymap--define): Make more robust. diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index aa57e022c5..abfc9b3b31 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -1237,14 +1237,17 @@ See Info node `(elisp) Integer Basics'." (defun byte-optimize-define-keymap--define (form) "Expand key bindings in FORM." - (let ((optimized (byte-optimize-define-keymap (nth 1 form)))) - (if (eq optimized (nth 1 form)) - ;; No improvement. - form - (list (car form) optimized)))) - -;;(put 'define-keymap 'byte-optimizer #'byte-optimize-define-keymap) -;;(put 'define-keymap--define 'byte-optimizer #'byte-optimize-define-keymap--define) + (if (not (consp (nth 1 form))) + form + (let ((optimized (byte-optimize-define-keymap (nth 1 form)))) + (if (eq optimized (nth 1 form)) + ;; No improvement. + form + (list (car form) optimized))))) + +(put 'define-keymap 'byte-optimizer #'byte-optimize-define-keymap) +(put 'define-keymap--define 'byte-optimizer + #'byte-optimize-define-keymap--define) ;; I'm not convinced that this is necessary. Doesn't the optimizer loop ;; take care of this? - Jamie commit 94fe416c9544ddeb6973c6fa8fb6d77b42dfbd62 Author: Lars Ingebrigtsen Date: Sun Oct 17 21:06:26 2021 +0200 Back out `define-keymap' optimization -- it leads to a build error diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index f4650de5e0..aa57e022c5 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -1243,9 +1243,8 @@ See Info node `(elisp) Integer Basics'." form (list (car form) optimized)))) -(put 'define-keymap 'byte-optimizer #'byte-optimize-define-keymap) -(put 'define-keymap--define 'byte-optimizer - #'byte-optimize-define-keymap--define) +;;(put 'define-keymap 'byte-optimizer #'byte-optimize-define-keymap) +;;(put 'define-keymap--define 'byte-optimizer #'byte-optimize-define-keymap--define) ;; I'm not convinced that this is necessary. Doesn't the optimizer loop ;; take care of this? - Jamie commit 958d6b4cf77af951d1ad40c02c5d5dcc28f31120 Author: Lars Ingebrigtsen Date: Sun Oct 17 20:48:34 2021 +0200 Convert cvs-status-mode-map to new syntax * lisp/vc/cvs-status.el (cvs-status-mode-map): Convert a small keymap to the new ["..."] syntax. diff --git a/lisp/vc/cvs-status.el b/lisp/vc/cvs-status.el index 6b49690aa4..723f277e07 100644 --- a/lisp/vc/cvs-status.el +++ b/lisp/vc/cvs-status.el @@ -40,8 +40,8 @@ "p" #'previous-line "N" #'cvs-status-next "P" #'cvs-status-prev - (kbd "M-n") #'cvs-status-next - (kbd "M-p") #'cvs-status-prev + ["M-n"] #'cvs-status-next + ["M-p"] #'cvs-status-prev "t" #'cvs-status-cvstrees "T" #'cvs-status-trees ">" #'cvs-mode-checkout) commit e36d3fc452735d1a1a2293e18b8e4ef944f8793d Author: Lars Ingebrigtsen Date: Sun Oct 17 20:48:01 2021 +0200 Support a new ["..."] key binding syntax * doc/lispref/keymaps.texi (Key Sequences): (Changing Key Bindings): Document the various key syntaxes. * lisp/emacs-lisp/byte-opt.el (byte-optimize-define-key) (byte-optimize-define-keymap) (byte-optimize-define-keymap--define): New functions to check and expand ["..."] syntax at compile time. * src/keymap.c (Fdefine_key): Understand the ["..."] syntax. (syms_of_keymap): Define `kbd' symbols. diff --git a/doc/lispref/keymaps.texi b/doc/lispref/keymaps.texi index 4277c718fe..899499ed46 100644 --- a/doc/lispref/keymaps.texi +++ b/doc/lispref/keymaps.texi @@ -100,6 +100,16 @@ The @code{kbd} function is very permissive, and will try to return something sensible even if the syntax used isn't completely conforming. To check whether the syntax is actually valid, use the @code{kbd-valid-p} function. + +@code{define-key} also supports using the shorthand syntax +@samp{["..."]} syntax to define a key. The string has to be a +strictly valid @code{kbd} sequence, and if it's not valid, an error +will be signalled. For instance, to bind @key{C-c f}, you can say: + +@lisp +(define-key global-map ["C-c f"] #'find-file-literally) +@end lisp + @end defun @@ -1285,24 +1295,46 @@ Binding Conventions}). @cindex meta character key constants @cindex control character key constants - In writing the key sequence to rebind, it is good to use the special -escape sequences for control and meta characters (@pxref{String Type}). -The syntax @samp{\C-} means that the following character is a control -character and @samp{\M-} means that the following character is a meta -character. Thus, the string @code{"\M-x"} is read as containing a -single @kbd{M-x}, @code{"\C-f"} is read as containing a single -@kbd{C-f}, and @code{"\M-\C-x"} and @code{"\C-\M-x"} are both read as -containing a single @kbd{C-M-x}. You can also use this escape syntax in -vectors, as well as others that aren't allowed in strings; one example -is @samp{[?\C-\H-x home]}. @xref{Character Type}. - - The key definition and lookup functions accept an alternate syntax for -event types in a key sequence that is a vector: you can use a list -containing modifier names plus one base event (a character or function -key name). For example, @code{(control ?a)} is equivalent to -@code{?\C-a} and @code{(hyper control left)} is equivalent to -@code{C-H-left}. One advantage of such lists is that the precise -numeric codes for the modifier bits don't appear in compiled files. + @code{define-key} (and other functions that are used to rebind keys) +understand a number of different syntaxes for the keys. + +@table @asis +@item A vector containing a single string. +This is the preferred way to represent a key sequence. Here's a +couple of examples: + +@example +["C-c M-f"] +["S-"] +@end example + +The syntax is the same as the one used by Emacs when displaying key +bindings, for instance in @samp{*Help*} buffers and help texts. + +If the syntax isn't valid, an error will be raised when running +@code{define-key}, or when byte-compiling code that has these calls. + +@item A vector containing lists of keys. +You can use a list containing modifier names plus one base event (a +character or function key name). For example, @code{[(control ?a) +(meta b)]} is equivalent to @kbd{C-a M-b} and @code{[(hyper control +left)]} is equivalent to @kbd{C-H-left}. + +@item A string with control and meta characters. +Internally, key sequences are often represented as strings using the +special escape sequences for control and meta characters +(@pxref{String Type}), but this representation can also be used by +users when rebinding keys. A string like @code{"\M-x"} is read as +containing a single @kbd{M-x}, @code{"\C-f"} is read as containing a +single @kbd{C-f}, and @code{"\M-\C-x"} and @code{"\C-\M-x"} are both +read as containing a single @kbd{C-M-x}. + +@item a vector of characters. +This is the other internal representation of key sequences, and +supports a fuller range of modifiers than the string representation. +One example is @samp{[?\C-\H-x home]}, which represents the @kbd{C-H-x +home} key sequence. @xref{Character Type}. +@end table The functions below signal an error if @var{keymap} is not a keymap, or if @var{key} is not a string or vector representing a key sequence. @@ -1344,7 +1376,7 @@ bindings in it: @result{} (keymap) @end group @group -(define-key map "\C-f" 'forward-char) +(define-key map ["C-f"] 'forward-char) @result{} forward-char @end group @group @@ -1354,7 +1386,7 @@ map @group ;; @r{Build sparse submap for @kbd{C-x} and bind @kbd{f} in that.} -(define-key map (kbd "C-x f") 'forward-word) +(define-key map ["C-x f"] 'forward-word) @result{} forward-word @end group @group @@ -1367,14 +1399,14 @@ map @group ;; @r{Bind @kbd{C-p} to the @code{ctl-x-map}.} -(define-key map (kbd "C-p") ctl-x-map) +(define-key map ["C-p"] ctl-x-map) ;; @code{ctl-x-map} @result{} [nil @dots{} find-file @dots{} backward-kill-sentence] @end group @group ;; @r{Bind @kbd{C-f} to @code{foo} in the @code{ctl-x-map}.} -(define-key map (kbd "C-p C-f") 'foo) +(define-key map ["C-p C-f"] 'foo) @result{} 'foo @end group @group @@ -1404,7 +1436,8 @@ keys. Here's a very basic example: @lisp (define-keymap "n" #'forward-line - "f" #'previous-line) + "f" #'previous-line + ["C-c C-c"] #'quit-window) @end lisp This function creates a new sparse keymap, defines the two keystrokes diff --git a/etc/NEWS b/etc/NEWS index fcc9b4ad32..d618891915 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -173,6 +173,13 @@ with recent versions of Firefox. * Lisp Changes in Emacs 29.1 ++++ +** 'define-key' now understands a new strict 'kbd' representation for keys. +The (define-key map ["C-c M-f"] #'some-command) syntax is now +supported, and is like the 'kbd' representation, but is stricter. If +the string doesn't represent a valid key sequence, an error is +signalled (both when evaluating and byte compiling). + +++ ** :keys in 'menu-item' can now be a function. If so, it is called whenever the menu is computed, and can be used to diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index c8990f2353..f4650de5e0 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -1186,6 +1186,67 @@ See Info node `(elisp) Integer Basics'." (put 'concat 'byte-optimizer #'byte-optimize-concat) +(defun byte-optimize-define-key (form) + "Expand key bindings in FORM." + (let ((key (nth 2 form))) + (if (and (vectorp key) + (= (length key) 1) + (stringp (aref key 0))) + ;; We have key on the form ["C-c C-c"]. + (if (not (kbd-valid-p (aref key 0))) + (error "Invalid `kbd' syntax: %S" key) + (list (nth 0 form) (nth 1 form) + (kbd (aref key 0)) (nth 4 form))) + ;; No improvement. + form))) + +(put 'define-key 'byte-optimizer #'byte-optimize-define-key) + +(defun byte-optimize-define-keymap (form) + "Expand key bindings in FORM." + (let ((result nil) + (orig-form form) + improved) + (push (pop form) result) + (while (and form + (keywordp (car form)) + (not (eq (car form) :menu))) + (push (pop form) result) + (when (null form) + (error "Uneven number of keywords in %S" form)) + (push (pop form) result)) + ;; Bindings. + (while form + (let ((key (pop form))) + (if (and (vectorp key) + (= (length key) 1) + (stringp (aref key 0))) + (progn + (unless (kbd-valid-p (aref key 0)) + (error "Invalid `kbd' syntax: %S" key)) + (push (kbd (aref key 0)) result) + (setq improved t)) + ;; No improvement. + (push key result))) + (when (null form) + (error "Uneven number of key bindings in %S" form)) + (push (pop form) result)) + (if improved + (nreverse result) + orig-form))) + +(defun byte-optimize-define-keymap--define (form) + "Expand key bindings in FORM." + (let ((optimized (byte-optimize-define-keymap (nth 1 form)))) + (if (eq optimized (nth 1 form)) + ;; No improvement. + form + (list (car form) optimized)))) + +(put 'define-keymap 'byte-optimizer #'byte-optimize-define-keymap) +(put 'define-keymap--define 'byte-optimizer + #'byte-optimize-define-keymap--define) + ;; I'm not convinced that this is necessary. Doesn't the optimizer loop ;; take care of this? - Jamie ;; I think this may some times be necessary to reduce ie (quote 5) to 5, diff --git a/src/keymap.c b/src/keymap.c index 5324f7f021..60e736efc7 100644 --- a/src/keymap.c +++ b/src/keymap.c @@ -1084,6 +1084,22 @@ binding KEY to DEF is added at the front of KEYMAP. */) def = tmp; } + if (VECTORP (key) && ASIZE (key) == 1 && STRINGP (AREF (key, 0))) + { + /* KEY is on the ["C-c"] format, so translate to internal + format. */ + if (NILP (Ffboundp (Qkbd_valid_p))) + xsignal2 (Qerror, + build_string ("`kbd-valid-p' is not defined, so this syntax can't be used: %s"), + key); + if (NILP (call1 (Qkbd_valid_p, AREF (key, 0)))) + xsignal2 (Qerror, build_string ("Invalid `kbd' syntax: %S"), key); + key = call1 (Qkbd, AREF (key, 0)); + length = CHECK_VECTOR_OR_STRING (key); + if (length == 0) + xsignal2 (Qerror, build_string ("Invalid `kbd' syntax: %S"), key); + } + ptrdiff_t idx = 0; while (1) { @@ -3263,4 +3279,7 @@ that describe key bindings. That is why the default is nil. */); defsubr (&Stext_char_description); defsubr (&Swhere_is_internal); defsubr (&Sdescribe_buffer_bindings); + + DEFSYM (Qkbd, "kbd"); + DEFSYM (Qkbd_valid_p, "kbd-valid-p"); } commit ce714465851f5687a7964bf5178515db75c26b87 Author: Juri Linkov Date: Sun Oct 17 21:28:54 2021 +0300 * lisp/tab-bar.el: Improve docstrings (bug#51247) * lisp/tab-bar.el (tab-bar--key-to-number) (tab-bar--event-to-item, tab-bar--format-tab-group) (tab-bar--current-tab-make): Improve docstrings. (switch-to-buffer-other-tab): Obsolete the arg NORECORD. diff --git a/lisp/tab-bar.el b/lisp/tab-bar.el index fe3472215a..82ec617ccc 100644 --- a/lisp/tab-bar.el +++ b/lisp/tab-bar.el @@ -227,10 +227,10 @@ a list of frames to update." ;;; Key bindings (defun tab-bar--key-to-number (key) - "This function is used to interpret the key that represents a tab. -It returns `t' for the `nil' value, `nil' for the current tab, -returns the number for the symbol that begins with `tab-' like `tab-1', -and `t' for other values." + "Return the tab number represented by KEY. +If KEY is a symbol 'tab-N', where N is a tab number, the value is N. +If KEY is \\='current-tab, the value is nil. +For any other value of KEY, the value is t." (cond ((null key) t) ((eq key 'current-tab) nil) @@ -242,10 +242,12 @@ and `t' for other values." (defvar tab-bar-drag-maybe) (defun tab-bar--event-to-item (posn) - "This function extracts extra info from the mouse event POSN. -It returns a list that contains three elements: a key, -a key binding, and a boolean value whether the close button \"+\" -was clicked." + "This function extracts extra info from the mouse event at position POSN. +It returns a list of the form (KEY KEY-BINDING CLOSE-P), where: + KEY is a symbol representing a tab, such as \\='tab-1 or \\='current-tab; + KEY-BINDING is the binding of KEY; + CLOSE-P is non-nil if the mouse event was a click on the close button \"x\", + nil otherwise." (setq tab-bar-drag-maybe nil) (if (posn-window posn) (let ((caption (car (posn-string posn)))) @@ -834,8 +836,8 @@ Function gets one argument: a tab." (defun tab-bar--format-tab-group (tab i &optional current-p) "Format TAB as a tab that represents a group of tabs. -Use the argument I as its index, and non-nil CURRENT-P when the tab is -current. Return the result as a keymap." +The argument I is the tab index, and CURRENT-P is non-nil +when the tab is current. Return the result as a keymap." (append `((,(intern (format "sep-%i" i)) menu-item ,(tab-bar-separator) ignore)) `((,(intern (format "group-%i" i)) @@ -986,7 +988,8 @@ on the tab bar instead." (defun tab-bar--current-tab-make (&optional tab) "Make the current tab data structure from TAB. -TAB here is an argument meaning \"use tab as template\". This is +TAB here is an argument meaning \"use tab as template\", +i.e. the tab is created using data from TAB. This is necessary when switching tabs, otherwise the destination tab inherits the current tab's `explicit-name' parameter." (let* ((tab-explicit-name (alist-get 'explicit-name tab)) @@ -2246,16 +2249,16 @@ indirectly called by the latter." (tab-bar-change-tab-group tab-group))) (window--display-buffer buffer (selected-window) 'tab alist))) -(defun switch-to-buffer-other-tab (buffer-or-name &optional norecord) +(defun switch-to-buffer-other-tab (buffer-or-name &optional _norecord) "Switch to buffer BUFFER-OR-NAME in another tab. Like \\[switch-to-buffer-other-frame] (which see), but creates a new tab. Interactively, prompt for the buffer to switch to." + (declare (advertised-calling-convention (buffer-or-name) "28.1")) (interactive (list (read-buffer-to-switch "Switch to buffer in other tab: "))) (display-buffer (window-normalize-buffer-to-switch-to buffer-or-name) '((display-buffer-in-tab) - (inhibit-same-window . nil)) - norecord)) + (inhibit-same-window . nil)))) (defun find-file-other-tab (filename &optional wildcards) "Edit file FILENAME, in another tab. commit ace4ce16a3b393a4f670efe4603966ef93b4eb63 Author: Juri Linkov Date: Sun Oct 17 21:03:27 2021 +0300 * lisp/tab-bar.el (tab-bar-mouse-move-tab): Don't drag tab to itself. diff --git a/lisp/tab-bar.el b/lisp/tab-bar.el index 76a217c936..fe3472215a 100644 --- a/lisp/tab-bar.el +++ b/lisp/tab-bar.el @@ -362,8 +362,9 @@ at the mouse-down event to the position at mouse-up event." (to (tab-bar--key-to-number (nth 0 (tab-bar--event-to-item (event-end event)))))) - (unless (or (eq from t) (eq to t)) - (tab-bar-move-tab-to to from)))) + (unless (or (eq from to) (eq from t) (eq to t)) + (tab-bar-move-tab-to + (if (null to) (1+ (tab-bar--current-tab-index)) to) from)))) (defvar tab-bar-map (let ((map (make-sparse-keymap))) commit 8122501fca00fe96165c46260ed8e297eb904373 Author: Paul Eggert Date: Sun Oct 17 10:51:56 2021 -0700 Pacify gcc -Wsuggest-attribute=malloc Problem found with gcc (Ubuntu 11.2.0-7ubuntu2) 11.2.0 x86-64. * src/sysstdio.h (emacs_fopen): Mark with ATTRIBUTE_MALLOC. diff --git a/src/sysstdio.h b/src/sysstdio.h index d4df3d7456..d6ebfb455f 100644 --- a/src/sysstdio.h +++ b/src/sysstdio.h @@ -26,7 +26,7 @@ along with GNU Emacs. If not, see . */ #include #include "unlocked-io.h" -extern FILE *emacs_fopen (char const *, char const *); +extern FILE *emacs_fopen (char const *, char const *) ATTRIBUTE_MALLOC; extern void errputc (int); extern void errwrite (void const *, ptrdiff_t); extern void close_output_streams (void); commit 04716ca48fbaf4750a56e3c8d6f0ad125f889105 Author: Martin Rudalics Date: Sun Oct 17 20:48:45 2021 +0300 Add tab-bar-drag-maybe for indication of tab dragging (bug#50993) * lisp/tab-bar.el (tab-bar--event-to-item) (tab-bar-mouse-move-tab): Set tab-bar-drag-maybe to nil. (tab-bar-mouse-down-1): Set tab-bar-drag-maybe to t. * src/xdisp.c (note_mouse_highlight): Set cursor to 'hand_cursor' when tab_bar_drag_maybe is true. (syms_of_xdisp): New variable tab-bar-drag-maybe. diff --git a/lisp/tab-bar.el b/lisp/tab-bar.el index 9fb363d90b..76a217c936 100644 --- a/lisp/tab-bar.el +++ b/lisp/tab-bar.el @@ -239,11 +239,14 @@ and `t' for other values." (string-to-number (string-replace "tab-" "" key-name))))) (t t))) +(defvar tab-bar-drag-maybe) + (defun tab-bar--event-to-item (posn) "This function extracts extra info from the mouse event POSN. It returns a list that contains three elements: a key, a key binding, and a boolean value whether the close button \"+\" was clicked." + (setq tab-bar-drag-maybe nil) (if (posn-window posn) (let ((caption (car (posn-string posn)))) (when caption @@ -275,6 +278,7 @@ existing tab." (interactive "e") (let* ((item (tab-bar--event-to-item (event-start event))) (tab-number (tab-bar--key-to-number (nth 0 item)))) + (setq tab-bar-drag-maybe t) ;; Don't close the tab when clicked on the close button. Also ;; don't add new tab on down-mouse. Let `tab-bar-mouse-1' do this. (unless (or (eq (car item) 'add-tab) (nth 2 item)) @@ -351,6 +355,7 @@ only when you click on its \"x\" close button." This command should be bound to a drag event. It moves the tab at the mouse-down event to the position at mouse-up event." (interactive "e") + (setq tab-bar-drag-maybe nil) (let ((from (tab-bar--key-to-number (nth 0 (tab-bar--event-to-item (event-start event))))) diff --git a/src/xdisp.c b/src/xdisp.c index 40d578ae9a..dc927253ef 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -33644,7 +33644,13 @@ note_mouse_highlight (struct frame *f, int x, int y) if (EQ (window, f->tab_bar_window)) { note_tab_bar_highlight (f, x, y); - return; + if (tab_bar_drag_maybe) + { + cursor = FRAME_OUTPUT_DATA (f)->hand_cursor; + goto set_cursor; + } + else + return; } #endif @@ -35774,6 +35780,10 @@ When nil, mouse-movement events will not be generated as long as the mouse stays within the extent of a single glyph (except for images). */); mouse_fine_grained_tracking = false; + DEFVAR_BOOL ("tab-bar-drag-maybe", tab_bar_drag_maybe, + doc: /* Non-nil when maybe dragging tab bar item. */); + tab_bar_drag_maybe = false; + DEFVAR_BOOL ("redisplay-skip-initial-frame", redisplay_skip_initial_frame, doc: /* Non-nil to skip redisplay in initial frame. The initial frame is not displayed anywhere, so skipping it is commit 81e3697600e5c792cf2ee99bd0d2818807e62108 Author: Juri Linkov Date: Sun Oct 17 20:27:16 2021 +0300 * lisp/tab-bar.el: Add a new tab on [mouse-1] instead of [down-mouse-1] * lisp/tab-bar.el (tab-bar-mouse-down-1): Rename from tab-bar-mouse-select-tab. Ignore 'add-tab'. (tab-bar-mouse-1): Rename from tab-bar-mouse-close-tab-from-button. Use binding of 'add-tab'. (tab-bar-map): Rebind [down-mouse-1] from tab-bar-mouse-select-tab to tab-bar-mouse-down-1, and [mouse-1] from tab-bar-mouse-close-tab-from-button to tab-bar-mouse-1 (bug#51246). diff --git a/lisp/tab-bar.el b/lisp/tab-bar.el index 8738e387b6..9fb363d90b 100644 --- a/lisp/tab-bar.el +++ b/lisp/tab-bar.el @@ -267,7 +267,7 @@ was clicked." (setq column (+ column (length (nth 1 binding)))))) keymap)))))) -(defun tab-bar-mouse-select-tab (event) +(defun tab-bar-mouse-down-1 (event) "Select the tab at mouse click, or add a new tab on the tab bar. Whether this command adds a new tab or selects an existing tab depends on whether the click is on the \"+\" button or on an @@ -275,29 +275,31 @@ existing tab." (interactive "e") (let* ((item (tab-bar--event-to-item (event-start event))) (tab-number (tab-bar--key-to-number (nth 0 item)))) - ;; Don't close the tab when clicked on the close button. - ;; Let `tab-bar-mouse-close-tab-from-button' do this. - (unless (nth 2 item) + ;; Don't close the tab when clicked on the close button. Also + ;; don't add new tab on down-mouse. Let `tab-bar-mouse-1' do this. + (unless (or (eq (car item) 'add-tab) (nth 2 item)) (if (functionp (nth 1 item)) (call-interactively (nth 1 item)) (unless (eq tab-number t) (tab-bar-select-tab tab-number)))))) -(defun tab-bar-mouse-close-tab-from-button (event) +(defun tab-bar-mouse-1 (event) "Close the tab whose \"x\" close button you click. See also `tab-bar-mouse-close-tab', which closes the tab -regardless of where you click on it." +regardless of where you click on it. Also add a new tab." (interactive "e") (let* ((item (tab-bar--event-to-item (event-start event))) (tab-number (tab-bar--key-to-number (nth 0 item)))) - (when (nth 2 item) - (unless (eq tab-number t) - (tab-bar-close-tab tab-number))))) + (cond + ((and (eq (car item) 'add-tab) (functionp (nth 1 item))) + (call-interactively (nth 1 item))) + ((and (nth 2 item) (not (eq tab-number t))) + (tab-bar-close-tab tab-number))))) (defun tab-bar-mouse-close-tab (event) "Close the tab you click on. -This is in contrast with `tab-bar-mouse-close-tab-from-button' -that closes a tab only when you click on its \"x\" close button." +This is in contrast with `tab-bar-mouse-1' that closes a tab +only when you click on its \"x\" close button." (interactive "e") (let* ((item (tab-bar--event-to-item (event-start event))) (tab-number (tab-bar--key-to-number (nth 0 item)))) @@ -360,11 +362,11 @@ at the mouse-down event to the position at mouse-up event." (defvar tab-bar-map (let ((map (make-sparse-keymap))) - (define-key map [down-mouse-1] 'tab-bar-mouse-select-tab) + (define-key map [down-mouse-1] 'tab-bar-mouse-down-1) (define-key map [drag-mouse-1] 'tab-bar-mouse-move-tab) - (define-key map [mouse-1] 'tab-bar-mouse-close-tab-from-button) + (define-key map [mouse-1] 'tab-bar-mouse-1) (define-key map [down-mouse-2] 'tab-bar-mouse-close-tab) - (define-key map [mouse-2] 'ignore) + (define-key map [mouse-2] 'ignore) (define-key map [down-mouse-3] 'tab-bar-mouse-context-menu) (define-key map [mouse-4] 'tab-previous) commit 9e46267755e634c49122ea6decffc5b5c5017550 Author: Lars Ingebrigtsen Date: Sun Oct 17 19:25:52 2021 +0200 Rewrite kbd-valid-p to not use seq * lisp/subr.el (kbd-valid-p): Rewrite to not use seq. diff --git a/lisp/subr.el b/lisp/subr.el index 6bd3b693b8..635942205b 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -939,24 +939,27 @@ which is (and (stringp keys) (string-match-p "\\`[^ ]+\\( [^ ]+\\)*\\'" keys) (save-match-data - (seq-every-p - (lambda (key) - ;; Every key might have these modifiers, and they should be - ;; in this order. - (when (string-match - "\\`\\(A-\\)?\\(C-\\)?\\(H-\\)?\\(M-\\)?\\(S-\\)?\\(s-\\)?" - key) - (setq key (substring key (match-end 0)))) - (or (and (= (length key) 1) - ;; Don't accept control characters as keys. - (not (< (aref key 0) ?\s)) - ;; Don't accept Meta'd characters as keys. - (or (multibyte-string-p key) - (not (<= 127 (aref key 0) 255)))) - (string-match-p "\\`<[A-Za-z0-9]+>\\'" key) - (string-match-p - "\\`\\(NUL\\|RET\\|TAB\\|LFD\\|ESC\\|SPC\\|DEL\\)\\'" key))) - (split-string keys " "))))) + (catch 'exit + (dolist (key (split-string keys " ")) + ;; Every key might have these modifiers, and they should be + ;; in this order. + (when (string-match + "\\`\\(A-\\)?\\(C-\\)?\\(H-\\)?\\(M-\\)?\\(S-\\)?\\(s-\\)?" + key) + (setq key (substring key (match-end 0)))) + (unless (or (and (= (length key) 1) + ;; Don't accept control characters as keys. + (not (< (aref key 0) ?\s)) + ;; Don't accept Meta'd characters as keys. + (or (multibyte-string-p key) + (not (<= 127 (aref key 0) 255)))) + (string-match-p "\\`<[A-Za-z0-9]+>\\'" key) + (string-match-p + "\\`\\(NUL\\|RET\\|TAB\\|LFD\\|ESC\\|SPC\\|DEL\\)\\'" + key)) + ;; Invalid. + (throw 'exit nil))) + t)))) (defun kbd (keys &optional need-vector) "Convert KEYS to the internal Emacs key representation. commit a191d3c725e155bd2d30c0c239cf68021cbd6c6d Author: Juri Linkov Date: Sun Oct 17 20:09:29 2021 +0300 Add new and fix existing docstrings in tab-bar.el and tab-line.el (bug#51247) * lisp/tab-bar.el (tab-bar--key-to-number) (tab-bar--event-to-item, tab-bar--format-tab) (tab-bar--format-tab-group, tab-bar--tab, tab-bar--current-tab) (tab-bar--current-tab-make): Add/fix docstrings. diff --git a/lisp/tab-bar.el b/lisp/tab-bar.el index 85f947f598..8738e387b6 100644 --- a/lisp/tab-bar.el +++ b/lisp/tab-bar.el @@ -227,6 +227,10 @@ a list of frames to update." ;;; Key bindings (defun tab-bar--key-to-number (key) + "This function is used to interpret the key that represents a tab. +It returns `t' for the `nil' value, `nil' for the current tab, +returns the number for the symbol that begins with `tab-' like `tab-1', +and `t' for other values." (cond ((null key) t) ((eq key 'current-tab) nil) @@ -236,6 +240,10 @@ a list of frames to update." (t t))) (defun tab-bar--event-to-item (posn) + "This function extracts extra info from the mouse event POSN. +It returns a list that contains three elements: a key, +a key binding, and a boolean value whether the close button \"+\" +was clicked." (if (posn-window posn) (let ((caption (car (posn-string posn)))) (when caption @@ -741,7 +749,7 @@ You can hide these buttons by customizing `tab-bar-format' and removing :help "Click to go forward in tab history")))) (defun tab-bar--format-tab (tab i) - "Format TAB using its index I and return the result as a string." + "Format TAB using its index I and return the result as a keymap." (append `((,(intern (format "sep-%i" i)) menu-item ,(tab-bar-separator) ignore)) (cond @@ -817,6 +825,9 @@ Function gets one argument: a tab." (tab-bar-tab-face-default tab))) (defun tab-bar--format-tab-group (tab i &optional current-p) + "Format TAB as a tab that represents a group of tabs. +Use the argument I as its index, and non-nil CURRENT-P when the tab is +current. Return the result as a keymap." (append `((,(intern (format "sep-%i" i)) menu-item ,(tab-bar-separator) ignore)) `((,(intern (format "group-%i" i)) @@ -927,6 +938,7 @@ on the tab bar instead." (push '(tabs . frameset-filter-tabs) frameset-filter-alist) (defun tab-bar--tab (&optional frame) + "Make a new tab data structure that can be added to tabs on the FRAME." (let* ((tab (tab-bar--current-tab-find nil frame)) (tab-explicit-name (alist-get 'explicit-name tab)) (tab-group (alist-get 'group tab)) @@ -961,12 +973,14 @@ on the tab bar instead." (cdr tab))))) (defun tab-bar--current-tab (&optional tab frame) + "Make the current tab data structure from TAB on FRAME." (tab-bar--current-tab-make (or tab (tab-bar--current-tab-find nil frame)))) (defun tab-bar--current-tab-make (&optional tab) - ;; `tab' here is an argument meaning "use tab as template". This is - ;; necessary when switching tabs, otherwise the destination tab - ;; inherits the current tab's `explicit-name' parameter. + "Make the current tab data structure from TAB. +TAB here is an argument meaning \"use tab as template\". This is +necessary when switching tabs, otherwise the destination tab +inherits the current tab's `explicit-name' parameter." (let* ((tab-explicit-name (alist-get 'explicit-name tab)) (tab-group (if tab (alist-get 'group tab) @@ -989,27 +1003,33 @@ on the tab bar instead." (cdr tab))))) (defun tab-bar--current-tab-find (&optional tabs frame) + ;; Find the current tab as a pointer to its data structure. (assq 'current-tab (or tabs (funcall tab-bar-tabs-function frame)))) (defun tab-bar--current-tab-index (&optional tabs frame) + ;; Return the index of the current tab. (seq-position (or tabs (funcall tab-bar-tabs-function frame)) 'current-tab (lambda (a b) (eq (car a) b)))) (defun tab-bar--tab-index (tab &optional tabs frame) + ;; Return the index of TAB. (seq-position (or tabs (funcall tab-bar-tabs-function frame)) tab #'eq)) (defun tab-bar--tab-index-by-name (name &optional tabs frame) + ;; Return the index of TAB by the its NAME. (seq-position (or tabs (funcall tab-bar-tabs-function frame)) name (lambda (a b) (equal (alist-get 'name a) b)))) (defun tab-bar--tab-index-recent (nth &optional tabs frame) + ;; Return the index of NTH recent tab. (let* ((tabs (or tabs (funcall tab-bar-tabs-function frame))) (sorted-tabs (tab-bar--tabs-recent tabs frame)) (tab (nth (1- nth) sorted-tabs))) (tab-bar--tab-index tab tabs))) (defun tab-bar--tabs-recent (&optional tabs frame) + ;; Return the list of tabs sorted by recency. (let* ((tabs (or tabs (funcall tab-bar-tabs-function frame)))) (seq-sort-by (lambda (tab) (alist-get 'time tab)) #'> (seq-remove (lambda (tab) @@ -1227,7 +1247,7 @@ to which to move the tab; ARG defaults to 1." (defun tab-bar-detach-tab (&optional from-number) "Move tab number FROM-NUMBER to a new frame. -FROM-NUMBER defaults to the current tab (which happens interactively." +FROM-NUMBER defaults to the current tab (which happens interactively)." (interactive (list (1+ (tab-bar--current-tab-index)))) (let* ((tabs (funcall tab-bar-tabs-function)) (tab-index (1- (or from-number (1+ (tab-bar--current-tab-index tabs))))) @@ -1260,11 +1280,11 @@ If `left', create to the left of the current tab. If `right', create to the right of the current tab. If `rightmost', create as the last tab. If the value is a function, it should return a number as a position -on the tab bar specifying where to insert a new tab." - :type '(choice (const :tag "Insert first" leftmost) - (const :tag "Insert left" left) - (const :tag "Insert right" right) - (const :tag "Insert last" rightmost) +on the tab bar specifying where to add a new tab." + :type '(choice (const :tag "Add as First" leftmost) + (const :tag "Add to Left" left) + (const :tag "Add to Right" right) + (const :tag "Add as Last" rightmost) (function :tag "Function")) :group 'tab-bar :version "27.1") @@ -1632,7 +1652,7 @@ function `tab-bar-tab-name-function'." ;;; Tab groups (defun tab-bar-move-tab-to-group (&optional tab) - "Relocate TAB (default: the current tab) closer to its group." + "Relocate TAB (by default, the current tab) closer to its group." (interactive) (let* ((tabs (funcall tab-bar-tabs-function)) (tab (or tab (tab-bar--current-tab-find tabs))) @@ -2021,7 +2041,7 @@ Then move up one line. Prefix arg means move that many lines." (tab-switcher-delete (- (or arg 1)))) (defun tab-switcher-delete-from-list (tab) - "Delete the window configuration from both lists." + "Delete the window configuration from the list of tabs." (push `((frame . ,(selected-frame)) (index . ,(tab-bar--tab-index tab)) (tab . ,tab)) diff --git a/lisp/tab-line.el b/lisp/tab-line.el index 5be9052af4..5affae7913 100644 --- a/lisp/tab-line.el +++ b/lisp/tab-line.el @@ -269,7 +269,7 @@ the list of all tabs." tab-line-tab-name-buffer) (const :tag "Truncated buffer name" tab-line-tab-name-truncated-buffer) - (function :tag "Function")) + (function :tag "Function")) :initialize 'custom-initialize-default :set (lambda (sym val) (set-default sym val) @@ -543,7 +543,7 @@ This is used by `tab-line-format'." (defun tab-line-tab-face-inactive-alternating (tab tabs face _buffer-p selected-p) "Return FACE for TAB in TABS with alternation. -SELECTED-P non-nil means TAB is not the selected tab. +SELECTED-P nil means TAB is not the selected tab. When TAB is not selected and is even-numbered, make FACE inherit from `tab-line-tab-inactive-alternate'. For use in `tab-line-tab-face-functions'." commit f092b0961b32037cc2428339a7f2f3495d83ccfd Author: Stefan Kangas Date: Sun Oct 17 16:07:59 2021 +0200 * src/image.c: Fix comment. diff --git a/src/image.c b/src/image.c index 206c7baa2f..470409c648 100644 --- a/src/image.c +++ b/src/image.c @@ -6421,9 +6421,8 @@ image_can_use_native_api (Lisp_Object type) } /* - * These functions are actually defined in the OS-native implementation - * file. Currently, for Windows GDI+ interface, w32image.c, but other - * operating systems can follow suit. + * These functions are actually defined in the OS-native implementation file. + * Currently, for Windows GDI+ interface, w32image.c, and nsimage.m for macOS. */ /* Indices of image specification fields in native format, below. */ commit d52035e8b648f5d15e618b81f3a23f8dc55bdc1b Author: Eli Zaretskii Date: Sun Oct 17 15:13:28 2021 +0300 ; Fix typos in last change. diff --git a/src/xdisp.c b/src/xdisp.c index c42d6893e4..783ef396a3 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -28674,7 +28674,7 @@ right_overwriting (struct glyph_string *s) in the drawing area. If S->hl is DRAW_CURSOR, S->f is a window system frame, and the - cursor in S's window is currently inside mouse face, also uodate + cursor in S's window is currently inside mouse face, also update S->width to take into account potentially differing :box properties between the original face and the mouse face. */ @@ -28705,10 +28705,10 @@ set_glyph_string_background_width (struct glyph_string *s, int start, int last_x && s->hl == DRAW_CURSOR && cursor_in_mouse_face_p (s->w)) { - /* Adjust the background width of the glyph string string, - because if the glyph's face has the :box attribute, its - pixel_width might be different from the :box attribute of - the mouse face. */ + /* Adjust the background width of the glyph string, because + if the glyph's face has the :box attribute, its + pixel_width might be different when it's displayed in the + mouse-face, if that also has the :box attribute. */ struct glyph *g = s->first_glyph; struct face *regular_face = FACE_FROM_ID (s->f, g->face_id); s->background_width += commit fba7e2c0056c7ebef59fad8c292794072969cd2a Author: Eli Zaretskii Date: Sun Oct 17 15:10:04 2021 +0300 Minor stylistic changes in last commit * src/xdisp.c (adjust_glyph_width_for_mouse_face): Renamed from 'get_glyph_pixel_width_delta_for_mouse_face'; all callers changed. diff --git a/src/xdisp.c b/src/xdisp.c index 7fb6cb8bfd..c42d6893e4 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -1179,11 +1179,10 @@ static void append_stretch_glyph (struct it *, Lisp_Object, static Lisp_Object get_it_property (struct it *, Lisp_Object); static Lisp_Object calc_line_height_property (struct it *, Lisp_Object, struct font *, int, bool); -static int get_glyph_pixel_width_delta_for_mouse_face (struct glyph *, - struct glyph_row *, - struct window *, - struct face *, - struct face *); +static int adjust_glyph_width_for_mouse_face (struct glyph *, + struct glyph_row *, + struct window *, struct face *, + struct face *); static void get_cursor_offset_for_mouse_face (struct window *w, struct glyph_row *row, int *offset); @@ -28136,7 +28135,6 @@ fill_composite_glyph_string (struct glyph_string *s, struct face *base_face, int c = COMPOSITION_GLYPH (s->cmp, 0); Mouse_HLInfo *hlinfo = MOUSE_HL_INFO (s->f); s->face = FACE_FROM_ID_OR_NULL (s->f, hlinfo->mouse_face_face_id); - if (!s->face) s->face = FACE_FROM_ID (s->f, MOUSE_FACE_ID); @@ -28675,10 +28673,10 @@ right_overwriting (struct glyph_string *s) first glyph following S. LAST_X is the right-most x-position + 1 in the drawing area. - If S's hl is DRAW_CURSOR, S->f is a window system frame, and the - cursor in S's window is currently under mouse face, s->width will - also be updated to take into account differing :box properties - between the original face and the mouse face. */ + If S->hl is DRAW_CURSOR, S->f is a window system frame, and the + cursor in S's window is currently inside mouse face, also uodate + S->width to take into account potentially differing :box + properties between the original face and the mouse face. */ static void set_glyph_string_background_width (struct glyph_string *s, int start, int last_x) @@ -28707,17 +28705,16 @@ set_glyph_string_background_width (struct glyph_string *s, int start, int last_x && s->hl == DRAW_CURSOR && cursor_in_mouse_face_p (s->w)) { - /* We will have to adjust the background width of the string - in this situation, because the glyph's pixel_width might - be inconsistent with the box of the mouse face, which - leads to an ugly over-wide cursor. */ - + /* Adjust the background width of the glyph string string, + because if the glyph's face has the :box attribute, its + pixel_width might be different from the :box attribute of + the mouse face. */ struct glyph *g = s->first_glyph; struct face *regular_face = FACE_FROM_ID (s->f, g->face_id); s->background_width += - get_glyph_pixel_width_delta_for_mouse_face (g, s->row, s->w, - regular_face, s->face); - /* s->width is probably worth adjusting here as well. */ + adjust_glyph_width_for_mouse_face (g, s->row, s->w, + regular_face, s->face); + /* S->width is probably worth adjusting here as well. */ s->width = s->background_width; } #endif @@ -31929,7 +31926,7 @@ erase_phys_cursor (struct window *w) /* Since erasing the phys cursor will probably lead to corruption of the mouse face display if the glyph's pixel_width is not kept up to date with the :box property of the mouse face, just redraw the - mouse face. */ + mouse face. */ if (FRAME_WINDOW_P (WINDOW_XFRAME (w)) && mouse_face_here_p) { w->phys_cursor_on_p = false; @@ -36092,27 +36089,26 @@ cancel_hourglass (void) } } -/* Return a delta that must be applied to g->pixel_width in order to - obtain the correct pixel_width of G when drawn under MOUSE_FACE. +/* Return a correction to be applied to G->pixel_width when it is + displayed in MOUSE_FACE. This is needed for the first and the last + glyphs of text inside a face with :box when it is displayed with + MOUSE_FACE that has a different or no :box attribute. ORIGINAL_FACE is the face G was originally drawn in, and MOUSE_FACE - is the face it will be drawn in now. ROW should be the row G is - located in. W should be the window G is located in. */ + is the face it will be drawn in now. ROW is the G's glyph row and + W is its window. */ static int -get_glyph_pixel_width_delta_for_mouse_face (struct glyph *g, - struct glyph_row *row, - struct window *w, - struct face *original_face, - struct face *mouse_face) +adjust_glyph_width_for_mouse_face (struct glyph *g, struct glyph_row *row, + struct window *w, + struct face *original_face, + struct face *mouse_face) { int sum = 0; bool do_left_box_p = g->left_box_line_p; bool do_right_box_p = g->right_box_line_p; - /* This is required because we test some parameters - of the image slice before applying the box in - produce_image_glyph. */ - + /* This is required because we test some parameters of the image + slice before applying the box in produce_image_glyph. */ if (g->type == IMAGE_GLYPH) { if (!row->reversed_p) @@ -36141,7 +36137,7 @@ get_glyph_pixel_width_delta_for_mouse_face (struct glyph *g, /* Likewise with the right box line, as there may be a box there as well. */ if (do_right_box_p) - sum -= max (0, original_face->box_vertical_line_width); + sum -= max (0, original_face->box_vertical_line_width); /* Now add the line widths from the new face. */ if (g->left_box_line_p) sum += max (0, mouse_face->box_vertical_line_width); @@ -36197,13 +36193,11 @@ get_cursor_offset_for_mouse_face (struct window *w, struct glyph_row *row, /* Calculate the offset by which to correct phys_cursor x if we are drawing the cursor inside mouse-face highlighted text. */ - for (; row->reversed_p ? start > end : start < end; - row->reversed_p ? --start : ++start) - { - sum += get_glyph_pixel_width_delta_for_mouse_face (start, row, w, - FACE_FROM_ID (f, start->face_id), - mouse_face); - } + for ( ; row->reversed_p ? start > end : start < end; + row->reversed_p ? --start : ++start) + sum += adjust_glyph_width_for_mouse_face (start, row, w, + FACE_FROM_ID (f, start->face_id), + mouse_face); if (row->reversed_p) sum = -sum; commit 2028df7826bb2c2909b2aaeba47282ca70c514e3 Author: Po Lu Date: Thu Oct 14 18:38:26 2021 +0800 Fix minor issues with text display when cursor is in mouse face * src/xdisp.c (get_cursor_offset_for_mouse_face): Don't calculate offsets for the glyph the cursor is on, and move some logic to get_glyph_pixel_width_delta_for_mouse_face. (fill_composite_glyph_string) (fill_gstring_glyph_string) (fill_glyphless_glyph_string) (fill_glyph_string) (fill_image_glyph_string) (fill_xwidget_glyph_string) (fill_stretch_glyph_string): Set s->face to mouse face whenever appropriate. (get_glyph_pixel_width_delta_for_mouse_face): New function. (set_glyph_string_background_width): Update background width and s->width to take into account differing :box properties of the mouse face, when producing strings for the cursor. (erase_phys_cursor): Redraw mouse face when erasing a cursor on top of the mouse face. * src/xterm.c (x_set_mouse_face_gc): Stop setting s->face when under mouse face because redisplay now does that for us. * src/w32term.c (w32_set_mouse_face_gc): Likewise. diff --git a/src/w32term.c b/src/w32term.c index 9cf250cd73..07a5cd3564 100644 --- a/src/w32term.c +++ b/src/w32term.c @@ -954,22 +954,6 @@ w32_set_cursor_gc (struct glyph_string *s) static void w32_set_mouse_face_gc (struct glyph_string *s) { - int face_id; - struct face *face; - - /* What face has to be used last for the mouse face? */ - face_id = MOUSE_HL_INFO (s->f)->mouse_face_face_id; - face = FACE_FROM_ID_OR_NULL (s->f, face_id); - if (face == NULL) - face = FACE_FROM_ID (s->f, MOUSE_FACE_ID); - - if (s->first_glyph->type == CHAR_GLYPH) - face_id = FACE_FOR_CHAR (s->f, face, s->first_glyph->u.ch, -1, Qnil); - else - face_id = FACE_FOR_CHAR (s->f, face, 0, -1, Qnil); - s->face = FACE_FROM_ID (s->f, face_id); - prepare_face_for_display (s->f, s->face); - /* If font in this face is same as S->font, use it. */ if (s->font == s->face->font) s->gc = s->face->gc; diff --git a/src/xdisp.c b/src/xdisp.c index f4ea7de190..7fb6cb8bfd 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -1179,6 +1179,11 @@ static void append_stretch_glyph (struct it *, Lisp_Object, static Lisp_Object get_it_property (struct it *, Lisp_Object); static Lisp_Object calc_line_height_property (struct it *, Lisp_Object, struct font *, int, bool); +static int get_glyph_pixel_width_delta_for_mouse_face (struct glyph *, + struct glyph_row *, + struct window *, + struct face *, + struct face *); static void get_cursor_offset_for_mouse_face (struct window *w, struct glyph_row *row, int *offset); @@ -28125,6 +28130,20 @@ fill_composite_glyph_string (struct glyph_string *s, struct face *base_face, s->font = s->face->font; } + if (s->hl == DRAW_MOUSE_FACE + || (s->hl == DRAW_CURSOR && cursor_in_mouse_face_p (s->w))) + { + int c = COMPOSITION_GLYPH (s->cmp, 0); + Mouse_HLInfo *hlinfo = MOUSE_HL_INFO (s->f); + s->face = FACE_FROM_ID_OR_NULL (s->f, hlinfo->mouse_face_face_id); + + if (!s->face) + s->face = FACE_FROM_ID (s->f, MOUSE_FACE_ID); + + s->face = FACE_FROM_ID (s->f, FACE_FOR_CHAR (s->f, s->face, c, -1, Qnil)); + prepare_face_for_display (s->f, s->face); + } + /* All glyph strings for the same composition has the same width, i.e. the width set for the first component of the composition. */ s->width = s->first_glyph->pixel_width; @@ -28161,7 +28180,17 @@ fill_gstring_glyph_string (struct glyph_string *s, int face_id, s->cmp_id = glyph->u.cmp.id; s->cmp_from = glyph->slice.cmp.from; s->cmp_to = glyph->slice.cmp.to + 1; - s->face = FACE_FROM_ID (s->f, face_id); + if (s->hl == DRAW_MOUSE_FACE + || (s->hl == DRAW_CURSOR && cursor_in_mouse_face_p (s->w))) + { + Mouse_HLInfo *hlinfo = MOUSE_HL_INFO (s->f); + s->face = FACE_FROM_ID_OR_NULL (s->f, hlinfo->mouse_face_face_id); + if (!s->face) + s->face = FACE_FROM_ID (s->f, MOUSE_FACE_ID); + prepare_face_for_display (s->f, s->face); + } + else + s->face = FACE_FROM_ID (s->f, face_id); lgstring = composition_gstring_from_id (s->cmp_id); s->font = XFONT_OBJECT (LGSTRING_FONT (lgstring)); /* The width of a composition glyph string is the sum of the @@ -28217,6 +28246,15 @@ fill_glyphless_glyph_string (struct glyph_string *s, int face_id, voffset = glyph->voffset; s->face = FACE_FROM_ID (s->f, face_id); s->font = s->face->font ? s->face->font : FRAME_FONT (s->f); + if (s->hl == DRAW_MOUSE_FACE + || (s->hl == DRAW_CURSOR && cursor_in_mouse_face_p (s->w))) + { + Mouse_HLInfo *hlinfo = MOUSE_HL_INFO (s->f); + s->face = FACE_FROM_ID_OR_NULL (s->f, hlinfo->mouse_face_face_id); + if (!s->face) + s->face = FACE_FROM_ID (s->f, MOUSE_FACE_ID); + prepare_face_for_display (s->f, s->face); + } s->nchars = 1; s->width = glyph->pixel_width; glyph++; @@ -28280,6 +28318,19 @@ fill_glyph_string (struct glyph_string *s, int face_id, s->font = s->face->font; + if (s->hl == DRAW_MOUSE_FACE + || (s->hl == DRAW_CURSOR && cursor_in_mouse_face_p (s->w))) + { + Mouse_HLInfo *hlinfo = MOUSE_HL_INFO (s->f); + s->face = FACE_FROM_ID_OR_NULL (s->f, hlinfo->mouse_face_face_id); + if (!s->face) + s->face = FACE_FROM_ID (s->f, MOUSE_FACE_ID); + s->face + = FACE_FROM_ID (s->f, FACE_FOR_CHAR (s->f, s->face, + s->first_glyph->u.ch, -1, Qnil)); + prepare_face_for_display (s->f, s->face); + } + /* If the specified font could not be loaded, use the frame's font, but record the fact that we couldn't load it in S->font_not_found_p so that we can draw rectangles for the @@ -28309,6 +28360,15 @@ fill_image_glyph_string (struct glyph_string *s) s->slice = s->first_glyph->slice.img; s->face = FACE_FROM_ID (s->f, s->first_glyph->face_id); s->font = s->face->font; + if (s->hl == DRAW_MOUSE_FACE + || (s->hl == DRAW_CURSOR && cursor_in_mouse_face_p (s->w))) + { + Mouse_HLInfo *hlinfo = MOUSE_HL_INFO (s->f); + s->face = FACE_FROM_ID_OR_NULL (s->f, hlinfo->mouse_face_face_id); + if (!s->face) + s->face = FACE_FROM_ID (s->f, MOUSE_FACE_ID); + prepare_face_for_display (s->f, s->face); + } s->width = s->first_glyph->pixel_width; /* Adjust base line for subscript/superscript text. */ @@ -28323,6 +28383,15 @@ fill_xwidget_glyph_string (struct glyph_string *s) eassert (s->first_glyph->type == XWIDGET_GLYPH); s->face = FACE_FROM_ID (s->f, s->first_glyph->face_id); s->font = s->face->font; + if (s->hl == DRAW_MOUSE_FACE + || (s->hl == DRAW_CURSOR && cursor_in_mouse_face_p (s->w))) + { + Mouse_HLInfo *hlinfo = MOUSE_HL_INFO (s->f); + s->face = FACE_FROM_ID_OR_NULL (s->f, hlinfo->mouse_face_face_id); + if (!s->face) + s->face = FACE_FROM_ID (s->f, MOUSE_FACE_ID); + prepare_face_for_display (s->f, s->face); + } s->width = s->first_glyph->pixel_width; s->ybase += s->first_glyph->voffset; s->xwidget = s->first_glyph->u.xwidget; @@ -28348,6 +28417,15 @@ fill_stretch_glyph_string (struct glyph_string *s, int start, int end) face_id = glyph->face_id; s->face = FACE_FROM_ID (s->f, face_id); s->font = s->face->font; + if (s->hl == DRAW_MOUSE_FACE + || (s->hl == DRAW_CURSOR && cursor_in_mouse_face_p (s->w))) + { + Mouse_HLInfo *hlinfo = MOUSE_HL_INFO (s->f); + s->face = FACE_FROM_ID_OR_NULL (s->f, hlinfo->mouse_face_face_id); + if (!s->face) + s->face = FACE_FROM_ID (s->f, MOUSE_FACE_ID); + prepare_face_for_display (s->f, s->face); + } s->width = glyph->pixel_width; s->nchars = 1; voffset = glyph->voffset; @@ -28595,7 +28673,12 @@ right_overwriting (struct glyph_string *s) /* Set background width of glyph string S. START is the index of the first glyph following S. LAST_X is the right-most x-position + 1 - in the drawing area. */ + in the drawing area. + + If S's hl is DRAW_CURSOR, S->f is a window system frame, and the + cursor in S's window is currently under mouse face, s->width will + also be updated to take into account differing :box properties + between the original face and the mouse face. */ static void set_glyph_string_background_width (struct glyph_string *s, int start, int last_x) @@ -28617,7 +28700,28 @@ set_glyph_string_background_width (struct glyph_string *s, int start, int last_x if (s->extends_to_end_of_line_p) s->background_width = last_x - s->x + 1; else - s->background_width = s->width; + { + s->background_width = s->width; +#ifdef HAVE_WINDOW_SYSTEM + if (FRAME_WINDOW_P (s->f) + && s->hl == DRAW_CURSOR + && cursor_in_mouse_face_p (s->w)) + { + /* We will have to adjust the background width of the string + in this situation, because the glyph's pixel_width might + be inconsistent with the box of the mouse face, which + leads to an ugly over-wide cursor. */ + + struct glyph *g = s->first_glyph; + struct face *regular_face = FACE_FROM_ID (s->f, g->face_id); + s->background_width += + get_glyph_pixel_width_delta_for_mouse_face (g, s->row, s->w, + regular_face, s->face); + /* s->width is probably worth adjusting here as well. */ + s->width = s->background_width; + } +#endif + } } @@ -31752,10 +31856,6 @@ erase_phys_cursor (struct window *w) Mouse_HLInfo *hlinfo = MOUSE_HL_INFO (f); int hpos = w->phys_cursor.hpos; int vpos = w->phys_cursor.vpos; -#ifdef HAVE_WINDOW_SYSTEM - int mouse_delta; - int phys_x = w->phys_cursor.x; -#endif bool mouse_face_here_p = false; struct glyph_matrix *active_glyphs = w->current_matrix; struct glyph_row *cursor_row; @@ -31826,13 +31926,16 @@ erase_phys_cursor (struct window *w) mouse_face_here_p = true; #ifdef HAVE_WINDOW_SYSTEM - /* Adjust the physical cursor's X coordinate if needed. The problem - solved by the code below is outlined in the comment above - 'get_cursor_offset_for_mouse_face'. */ - if (mouse_face_here_p) + /* Since erasing the phys cursor will probably lead to corruption of + the mouse face display if the glyph's pixel_width is not kept up + to date with the :box property of the mouse face, just redraw the + mouse face. */ + if (FRAME_WINDOW_P (WINDOW_XFRAME (w)) && mouse_face_here_p) { - get_cursor_offset_for_mouse_face (w, cursor_row, &mouse_delta); - w->phys_cursor.x += mouse_delta; + w->phys_cursor_on_p = false; + w->phys_cursor_type = NO_CURSOR; + show_mouse_face (MOUSE_HL_INFO (WINDOW_XFRAME (w)), DRAW_MOUSE_FACE); + return; } #endif @@ -31871,10 +31974,6 @@ erase_phys_cursor (struct window *w) draw_phys_cursor_glyph (w, cursor_row, hl); mark_cursor_off: -#ifdef HAVE_WINDOW_SYSTEM - /* Restore the original cursor position. */ - w->phys_cursor.x = phys_x; -#endif w->phys_cursor_on_p = false; w->phys_cursor_type = NO_CURSOR; } @@ -35993,6 +36092,65 @@ cancel_hourglass (void) } } +/* Return a delta that must be applied to g->pixel_width in order to + obtain the correct pixel_width of G when drawn under MOUSE_FACE. + ORIGINAL_FACE is the face G was originally drawn in, and MOUSE_FACE + is the face it will be drawn in now. ROW should be the row G is + located in. W should be the window G is located in. */ +static int +get_glyph_pixel_width_delta_for_mouse_face (struct glyph *g, + struct glyph_row *row, + struct window *w, + struct face *original_face, + struct face *mouse_face) +{ + int sum = 0; + + bool do_left_box_p = g->left_box_line_p; + bool do_right_box_p = g->right_box_line_p; + + /* This is required because we test some parameters + of the image slice before applying the box in + produce_image_glyph. */ + + if (g->type == IMAGE_GLYPH) + { + if (!row->reversed_p) + { + struct image *img = IMAGE_FROM_ID (WINDOW_XFRAME (w), + g->u.img_id); + do_left_box_p = g->left_box_line_p && + g->slice.img.x == 0; + do_right_box_p = g->right_box_line_p && + g->slice.img.x + g->slice.img.width == img->width; + } + else + { + struct image *img = IMAGE_FROM_ID (WINDOW_XFRAME (w), + g->u.img_id); + do_left_box_p = g->left_box_line_p && + g->slice.img.x + g->slice.img.width == img->width; + do_right_box_p = g->right_box_line_p && + g->slice.img.x == 0; + } + } + + /* If the glyph has a left box line, subtract it from the offset. */ + if (do_left_box_p) + sum -= max (0, original_face->box_vertical_line_width); + /* Likewise with the right box line, as there may be a + box there as well. */ + if (do_right_box_p) + sum -= max (0, original_face->box_vertical_line_width); + /* Now add the line widths from the new face. */ + if (g->left_box_line_p) + sum += max (0, mouse_face->box_vertical_line_width); + if (g->right_box_line_p) + sum += max (0, mouse_face->box_vertical_line_width); + + return sum; +} + /* Get the offset due to mouse-highlight to apply before drawing phys_cursor, and return it in OFFSET. ROW should be the row that is under mouse face and contains the phys cursor. @@ -36036,57 +36194,15 @@ get_cursor_offset_for_mouse_face (struct window *w, struct glyph_row *row, start = &row->glyphs[TEXT_AREA][row->used[TEXT_AREA] - 1]; } - /* Calculate the offset to correct phys_cursor x if we are + /* Calculate the offset by which to correct phys_cursor x if we are drawing the cursor inside mouse-face highlighted text. */ - for (; row->reversed_p ? start >= end : start <= end; + for (; row->reversed_p ? start > end : start < end; row->reversed_p ? --start : ++start) { - struct glyph *g = start; - struct face *mouse = mouse_face; - struct face *regular_face = FACE_FROM_ID (f, g->face_id); - - bool do_left_box_p = g->left_box_line_p; - bool do_right_box_p = g->right_box_line_p; - - /* This is required because we test some parameters - of the image slice before applying the box in - produce_image_glyph. */ - - if (g->type == IMAGE_GLYPH) - { - if (!row->reversed_p) - { - struct image *img = IMAGE_FROM_ID (WINDOW_XFRAME (w), - g->u.img_id); - do_left_box_p = g->left_box_line_p && - g->slice.img.x == 0; - do_right_box_p = g->right_box_line_p && - g->slice.img.x + g->slice.img.width == img->width; - } - else - { - struct image *img = IMAGE_FROM_ID (WINDOW_XFRAME (w), - g->u.img_id); - do_left_box_p = g->left_box_line_p && - g->slice.img.x + g->slice.img.width == img->width; - do_right_box_p = g->right_box_line_p && - g->slice.img.x == 0; - } - } - - /* If the glyph has a left box line, subtract it from the offset. */ - if (do_left_box_p) - sum -= max (0, regular_face->box_vertical_line_width); - /* Likewise with the right box line, as there may be a - box there as well. */ - if (do_right_box_p) - sum -= max (0, regular_face->box_vertical_line_width); - /* Now add the line widths from the new face. */ - if (g->left_box_line_p) - sum += max (0, mouse->box_vertical_line_width); - if (g->right_box_line_p) - sum += max (0, mouse->box_vertical_line_width); + sum += get_glyph_pixel_width_delta_for_mouse_face (start, row, w, + FACE_FROM_ID (f, start->face_id), + mouse_face); } if (row->reversed_p) diff --git a/src/xterm.c b/src/xterm.c index 89885e0d88..961c61c245 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -1563,22 +1563,6 @@ x_set_cursor_gc (struct glyph_string *s) static void x_set_mouse_face_gc (struct glyph_string *s) { - int face_id; - struct face *face; - - /* What face has to be used last for the mouse face? */ - face_id = MOUSE_HL_INFO (s->f)->mouse_face_face_id; - face = FACE_FROM_ID_OR_NULL (s->f, face_id); - if (face == NULL) - face = FACE_FROM_ID (s->f, MOUSE_FACE_ID); - - if (s->first_glyph->type == CHAR_GLYPH) - face_id = FACE_FOR_CHAR (s->f, face, s->first_glyph->u.ch, -1, Qnil); - else - face_id = FACE_FOR_CHAR (s->f, face, 0, -1, Qnil); - s->face = FACE_FROM_ID (s->f, face_id); - prepare_face_for_display (s->f, s->face); - if (s->font == s->face->font) s->gc = s->face->gc; else commit 5a5651a2f927b7758dfdf36953073f1f1a9920f9 Author: Lars Ingebrigtsen Date: Sun Oct 17 12:56:54 2021 +0200 Fix up recent kbd simplification * lisp/subr.el (kbd): Fix breakage with X- from previous change. diff --git a/lisp/subr.el b/lisp/subr.el index a9669ab750..6bd3b693b8 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -1068,12 +1068,14 @@ and should normally not be needed." (nreverse lres) lres)))) (if (and (not need-vector) - (not (memq nil (mapcar (lambda (ch) (<= 0 ch 127)) - (append res nil))))) + (not (memq nil (mapcar (lambda (ch) + (and (numberp ch) + (<= 0 ch 127))) + res)))) (concat (mapcar (lambda (ch) (if (= (logand ch ?\M-\^@) 0) ch (+ ch 128))) - (append res nil))) + res)) res)))) (defun undefined () commit 77dbaedadc0129534e5ca9bdeef881a48b8d53e7 Author: Po Lu Date: Fri Oct 15 19:02:54 2021 +0100 Add tab bar support to the nextstep port * src/nsfns.m (ns_change_tab_bar_height): New function. (ns_set_tab_bar_lines): Check tab bar height and set tab bar accordingly. * src/nsterm.m (ns_clear_under_internal_border): Clear internal border correctly when there is a tab bar. (ns_create_terminal): Add ns_change_tab_bar_height. (mouseDown): Handle tab bar mouse click events. diff --git a/src/nsfns.m b/src/nsfns.m index 906c5c934f..797d0ce782 100644 --- a/src/nsfns.m +++ b/src/nsfns.m @@ -609,13 +609,72 @@ Turn the input menu (an NSMenu) into a lisp list for tracking on lisp side. } } +void +ns_change_tab_bar_height (struct frame *f, int height) +{ + int unit = FRAME_LINE_HEIGHT (f); + int old_height = FRAME_TAB_BAR_HEIGHT (f); + int lines = (height + unit - 1) / unit; + Lisp_Object fullscreen = get_frame_param (f, Qfullscreen); + + /* Make sure we redisplay all windows in this frame. */ + fset_redisplay (f); + + /* Recalculate tab bar and frame text sizes. */ + FRAME_TAB_BAR_HEIGHT (f) = height; + FRAME_TAB_BAR_LINES (f) = lines; + store_frame_param (f, Qtab_bar_lines, make_fixnum (lines)); + + if (FRAME_NS_WINDOW (f) && FRAME_TAB_BAR_HEIGHT (f) == 0) + { + clear_frame (f); + clear_current_matrices (f); + } + + if ((height < old_height) && WINDOWP (f->tab_bar_window)) + clear_glyph_matrix (XWINDOW (f->tab_bar_window)->current_matrix); + + if (!f->tab_bar_resized) + { + /* As long as tab_bar_resized is false, effectively try to change + F's native height. */ + if (NILP (fullscreen) || EQ (fullscreen, Qfullwidth)) + adjust_frame_size (f, FRAME_TEXT_WIDTH (f), FRAME_TEXT_HEIGHT (f), + 1, false, Qtab_bar_lines); + else + adjust_frame_size (f, -1, -1, 4, false, Qtab_bar_lines); + + f->tab_bar_resized = f->tab_bar_redisplayed; + } + else + /* Any other change may leave the native size of F alone. */ + adjust_frame_size (f, -1, -1, 3, false, Qtab_bar_lines); + + /* adjust_frame_size might not have done anything, garbage frame + here. */ + adjust_frame_glyphs (f); + SET_FRAME_GARBAGED (f); +} /* tabbar support */ static void ns_set_tab_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval) { - /* Currently unimplemented. */ - NSTRACE ("ns_set_tab_bar_lines"); + int olines = FRAME_TAB_BAR_LINES (f); + int nlines; + + /* Treat tab bars like menu bars. */ + if (FRAME_MINIBUF_ONLY_P (f)) + return; + + /* Use VALUE only if an int >= 0. */ + if (RANGED_FIXNUMP (0, value, INT_MAX)) + nlines = XFIXNAT (value); + else + nlines = 0; + + if (nlines != olines && (olines == 0 || nlines == 0)) + ns_change_tab_bar_height (f, nlines * FRAME_LINE_HEIGHT (f)); } diff --git a/src/nsterm.h b/src/nsterm.h index 46733e6949..4bbcf43973 100644 --- a/src/nsterm.h +++ b/src/nsterm.h @@ -1136,6 +1136,7 @@ extern void ns_implicitly_set_name (struct frame *f, Lisp_Object arg, Lisp_Object oldval); extern void ns_set_scroll_bar_default_width (struct frame *f); extern void ns_set_scroll_bar_default_height (struct frame *f); +extern void ns_change_tab_bar_height (struct frame *f, int height); extern const char *ns_get_string_resource (void *_rdb, const char *name, const char *class); diff --git a/src/nsterm.m b/src/nsterm.m index a6c2e7505b..c6f80f8035 100644 --- a/src/nsterm.m +++ b/src/nsterm.m @@ -2721,11 +2721,10 @@ Hide the window (X11 semantics) if (FRAME_LIVE_P (f) && FRAME_INTERNAL_BORDER_WIDTH (f) > 0) { - int border_width = FRAME_INTERNAL_BORDER_WIDTH (f); - NSView *view = FRAME_NS_VIEW (f); - NSRect edge_rect, frame_rect = [view bounds]; - NSRectEdge edge[] = {NSMinXEdge, NSMinYEdge, NSMaxXEdge, NSMaxYEdge}; - + int border = FRAME_INTERNAL_BORDER_WIDTH (f); + int width = FRAME_PIXEL_WIDTH (f); + int height = FRAME_PIXEL_HEIGHT (f); + int margin = FRAME_TOP_MARGIN_HEIGHT (f); int face_id = (FRAME_PARENT_FRAME (f) ? (!NILP (Vface_remapping_alist) @@ -2747,12 +2746,12 @@ Hide the window (X11 semantics) ns_focus (f, NULL, 1); [ns_lookup_indexed_color (NS_FACE_BACKGROUND (face), f) set]; - for (int i = 0; i < 4 ; i++) - { - NSDivideRect (frame_rect, &edge_rect, &frame_rect, border_width, edge[i]); - NSRectFill (edge_rect); - } + NSRectFill (NSMakeRect (0, margin, width, border)); + NSRectFill (NSMakeRect (0, 0, border, height)); + NSRectFill (NSMakeRect (0, margin, width, border)); + NSRectFill (NSMakeRect (width - border, 0, border, height)); + NSRectFill (NSMakeRect (0, height - border, width, border)); ns_unfocus (f); } } @@ -5066,6 +5065,7 @@ static Lisp_Object ns_new_font (struct frame *f, Lisp_Object font_object, terminal->free_pixmap = ns_free_pixmap; terminal->delete_frame_hook = ns_destroy_window; terminal->delete_terminal_hook = ns_delete_terminal; + terminal->change_tab_bar_height_hook = ns_change_tab_bar_height; /* Other hooks are NULL by default. */ return terminal; @@ -6675,7 +6675,27 @@ - (void)mouseDown: (NSEvent *)theEvent } else { - emacs_event->kind = MOUSE_CLICK_EVENT; + Lisp_Object tab_bar_arg = Qnil; + bool tab_bar_p = false; + + if (WINDOWP (emacsframe->tab_bar_window) + && WINDOW_TOTAL_LINES (XWINDOW (emacsframe->tab_bar_window))) + { + Lisp_Object window; + int x = lrint (p.x); + int y = lrint (p.y); + + window = window_from_coordinates (emacsframe, x, y, 0, true, true); + tab_bar_p = EQ (window, emacsframe->tab_bar_window); + + if (tab_bar_p) + tab_bar_arg = handle_tab_bar_click (emacsframe, x, y, EV_UDMODIFIERS (theEvent) & down_modifier, + EV_MODIFIERS (theEvent) | EV_UDMODIFIERS (theEvent)); + } + + if (!(tab_bar_p && NILP (tab_bar_arg))) + emacs_event->kind = MOUSE_CLICK_EVENT; + emacs_event->arg = tab_bar_arg; emacs_event->code = EV_BUTTON (theEvent); emacs_event->modifiers = EV_MODIFIERS (theEvent) | EV_UDMODIFIERS (theEvent); commit 7b6fb486c2e8555a04b20e067b723ef9fdb13396 Author: Alan Third Date: Mon Oct 4 22:35:41 2021 +0100 Fix potential buffer overflow (bug#50767) * src/image.c (svg_load_image): Check how many bytes were actually written to the buffer. Don't check xmalloc return value as xmalloc doesn't return if it fails. diff --git a/src/image.c b/src/image.c index 206c7baa2f..49b26301e8 100644 --- a/src/image.c +++ b/src/image.c @@ -9996,10 +9996,16 @@ svg_load_image (struct frame *f, struct image *img, char *contents, if (!STRINGP (lcss)) { /* Generate the CSS for the SVG image. */ - const char *css_spec = "svg{font-family:\"%s\";font-size:%4dpx}"; - int css_len = strlen (css_spec) + strlen (img->face_font_family); + /* FIXME: The below calculations leave enough space for a font + size up to 9999, if it overflows we just throw an error but + should probably increase the buffer size. */ + const char *css_spec = "svg{font-family:\"%s\";font-size:%dpx}"; + int css_len = strlen (css_spec) + strlen (img->face_font_family) + 1; css = xmalloc (css_len); - snprintf (css, css_len, css_spec, img->face_font_family, img->face_font_size); + if (css_len <= snprintf (css, css_len, css_spec, + img->face_font_family, img->face_font_size)) + goto rsvg_error; + rsvg_handle_set_stylesheet (rsvg_handle, (guint8 *)css, strlen (css), NULL); } else @@ -10157,12 +10163,11 @@ svg_load_image (struct frame *f, struct image *img, char *contents, wrapped_contents = xmalloc (buffer_size); - if (!wrapped_contents - || buffer_size <= snprintf (wrapped_contents, buffer_size, wrapper, - foreground & 0xFFFFFF, width, height, - viewbox_width, viewbox_height, - background & 0xFFFFFF, - SSDATA (encoded_contents))) + if (buffer_size <= snprintf (wrapped_contents, buffer_size, wrapper, + foreground & 0xFFFFFF, width, height, + viewbox_width, viewbox_height, + background & 0xFFFFFF, + SSDATA (encoded_contents))) goto rsvg_error; wrapped_size = strlen (wrapped_contents); commit ed9f5546aa71e0f187eaff1b2a9ccfe7772e9f5c Author: Eli Zaretskii Date: Sun Oct 17 12:49:04 2021 +0300 Improve doc strings in tab-line.el * lisp/tab-line.el (tab-line-tab-name-function) (tab-line-tab-name-truncated-buffer, tab-line-tabs-mode-buffers) (tab-line-tabs-buffer-group-function) (tab-line-tabs-buffer-group-sort-function) (tab-line-tabs-buffer-groups, tab-line-tab-name-format-function) (tab-line-tab-name-format-default, tab-line-format-template) (tab-line-tab-face-inactive-alternating) (tab-line-tab-face-special, tab-line-tab-face-modified) (tab-line-format, tab-line-auto-hscroll, tab-line-hscroll-right) (tab-line-hscroll-left, tab-line-new-tab, tab-line-select-tab) (tab-line-switch-to-prev-tab, tab-line-switch-to-next-tab) (tab-line-close-tab-function, tab-line-close-tab) (tab-line-tab-context-menu, tab-line-context-menu) (tab-line-mode, tab-line-exclude-modes, tab-line-mode--turn-on): Add or fix doc strings. diff --git a/lisp/tab-line.el b/lisp/tab-line.el index 78c06bbb64..5be9052af4 100644 --- a/lisp/tab-line.el +++ b/lisp/tab-line.el @@ -262,8 +262,9 @@ If nil, don't show it at all." (defcustom tab-line-tab-name-function #'tab-line-tab-name-buffer "Function to get a tab name. -Function gets two arguments: tab to get name for and a list of tabs -to display. By default, use function `tab-line-tab-name'." +The function is called with one or two arguments: the buffer or +another object whose tab's name is requested, and, optionally, +the list of all tabs." :type '(choice (const :tag "Buffer name" tab-line-tab-name-buffer) (const :tag "Truncated buffer name" @@ -294,9 +295,9 @@ to `tab-line-tab-name-truncated-buffer'." (defvar tab-line-tab-name-ellipsis t) (defun tab-line-tab-name-truncated-buffer (buffer &optional _buffers) - "Generate tab name from BUFFER. + "Generate tab name from BUFFER, truncating it as needed. Truncate it to the length specified by `tab-line-tab-name-truncated-max'. -Append ellipsis `tab-line-tab-name-ellipsis' in this case." +If truncated, append ellipsis per `tab-line-tab-name-ellipsis'." (let ((tab-name (buffer-name buffer))) (if (< (length tab-name) tab-line-tab-name-truncated-max) tab-name @@ -343,7 +344,7 @@ Used only for `tab-line-tabs-mode-buffers' and `tab-line-tabs-buffer-groups'.") (buffer-list))))) (defun tab-line-tabs-mode-buffers () - "Return a list of buffers with the same major mode with current buffer." + "Return a list of buffers with the same major mode as the current buffer." (let ((mode major-mode)) (seq-sort-by #'buffer-name #'string< (seq-filter (lambda (b) (with-current-buffer b @@ -351,12 +352,12 @@ Used only for `tab-line-tabs-mode-buffers' and `tab-line-tabs-buffer-groups'.") (funcall tab-line-tabs-buffer-list-function))))) (defvar tab-line-tabs-buffer-group-function nil - "Function to put a buffer to the group. -Takes a buffer as arg and should return a group name as string. -When the return value is nil, filter out the buffer.") + "Function to add a buffer to the appropriate group of tabs. +Takes a buffer as arg and should return a group name as a string. +If the return value is nil, the buffer should be filtered out.") (defvar tab-line-tabs-buffer-group-sort-function nil - "Function to sort buffers in group.") + "Function to sort buffers in a group.") (defvar tab-line-tabs-buffer-groups-sort-function #'string< "Function to sort group names.") @@ -364,7 +365,9 @@ When the return value is nil, filter out the buffer.") (defvar tab-line-tabs-buffer-groups mouse-buffer-menu-mode-groups "How to group various major modes together in the tab line. Each element has the form (REGEXP . GROUPNAME). -If the major mode's name string matches REGEXP, use GROUPNAME instead.") +If the major mode's name matches REGEXP, it belongs to GROUPNAME. +The default is for each major mode to have a separate group +named the same as the mode.") (defun tab-line-tabs-buffer-group-name (&optional buffer) (if (functionp tab-line-tabs-buffer-group-function) @@ -460,8 +463,11 @@ variable `tab-line-tabs-function'." (defcustom tab-line-tab-name-format-function #'tab-line-tab-name-format-default "Function to format a tab name. -Function gets two arguments: the tab and a list of all tabs, and -should return the formatted tab name to display in the tab line." +The function will be called two arguments: the tab whose name to format, +and the list of all the tabs; it should return the formatted tab name +to display in the tab line. +The first argument could also be a different object, for example the buffer +which the tab will represent." :type 'function :initialize 'custom-initialize-default :set (lambda (sym val) @@ -471,6 +477,7 @@ should return the formatted tab name to display in the tab line." :version "28.1") (defun tab-line-tab-name-format-default (tab tabs) + "Default function to use as `tab-line-tab-name-format-function', which see." (let* ((buffer-p (bufferp tab)) (selected-p (if buffer-p (eq tab (window-buffer)) @@ -503,7 +510,8 @@ should return the formatted tab name to display in the tab line." mouse-face tab-line-highlight)))) (defun tab-line-format-template (tabs) - "Template for displaying tab line for selected window." + "Template of the format for displaying tab line for selected window. +This is used by `tab-line-format'." (let* ((separator (or tab-line-separator (if window-system " " "|"))) (hscroll (window-parameter nil 'tab-line-hscroll)) (strings @@ -535,7 +543,8 @@ should return the formatted tab name to display in the tab line." (defun tab-line-tab-face-inactive-alternating (tab tabs face _buffer-p selected-p) "Return FACE for TAB in TABS with alternation. -When TAB is an inactive buffer and is even-numbered, make FACE +SELECTED-P non-nil means TAB is not the selected tab. +When TAB is not selected and is even-numbered, make FACE inherit from `tab-line-tab-inactive-alternate'. For use in `tab-line-tab-face-functions'." (when (and (not selected-p) (cl-evenp (cl-position tab tabs))) @@ -543,8 +552,8 @@ inherit from `tab-line-tab-inactive-alternate'. For use in face) (defun tab-line-tab-face-special (tab _tabs face buffer-p _selected-p) - "Return FACE for TAB according to whether it's special. -When TAB is a non-file-backed buffer, make FACE inherit from + "Return FACE for TAB according to whether its buffer is special. +When TAB is a non-file-visiting buffer, make FACE inherit from `tab-line-tab-special'. For use in `tab-line-tab-face-functions'." (when (and buffer-p (not (buffer-file-name tab))) @@ -552,7 +561,7 @@ When TAB is a non-file-backed buffer, make FACE inherit from face) (defun tab-line-tab-face-modified (tab _tabs face buffer-p _selected-p) - "Return FACE for TAB according to whether it's modified. + "Return FACE for TAB according to whether its buffer is modified. When TAB is a modified, file-backed buffer, make FACE inherit from `tab-line-tab-modified'. For use in `tab-line-tab-face-functions'." @@ -570,7 +579,7 @@ For use in `tab-line-tab-face-functions'." (defvar tab-line-auto-hscroll) (defun tab-line-format () - "Template for displaying tab line for selected window." + "Format for displaying the tab line of the selected window." (let* ((tabs (funcall tab-line-tabs-function)) (cache-key (list tabs ;; handle buffer renames @@ -598,7 +607,7 @@ For use in `tab-line-tab-face-functions'." (defcustom tab-line-auto-hscroll t "Allow or disallow automatic horizontal scrolling of the tab line. -Non-nil means the tab line are automatically scrolled horizontally to make +Non-nil means the tab lines are automatically scrolled horizontally to make the selected tab visible." :type 'boolean :group 'tab-line @@ -694,12 +703,16 @@ the selected tab visible." (force-mode-line-update t)))) (defun tab-line-hscroll-right (&optional arg event) + "Scroll the tab line ARG positions to the right. +Interactively, ARG is the prefix numeric argument and defaults to 1." (interactive (list current-prefix-arg last-nonmenu-event)) (let ((window (and (listp event) (posn-window (event-start event))))) (tab-line-hscroll arg window) (force-mode-line-update window))) (defun tab-line-hscroll-left (&optional arg event) + "Scroll the tab line ARG positions to the left. +Interactively, ARG is the prefix numeric argument and defaults to 1." (interactive (list current-prefix-arg last-nonmenu-event)) (let ((window (and (listp event) (posn-window (event-start event))))) (tab-line-hscroll (- (or arg 1)) window) @@ -707,10 +720,10 @@ the selected tab visible." (defun tab-line-new-tab (&optional event) - "Add a new tab to the tab line. -Usually is invoked by clicking on the plus-shaped button. -But any switching to other buffer also adds a new tab -corresponding to the switched buffer." + "Add a new tab to the selected-window's tab line. +This command is usually invoked by clicking on the plus-shaped button +on the tab line. Switching to another buffer also adds a new tab +corresponding to the new buffer shown in the window." (interactive (list last-nonmenu-event)) (if (functionp tab-line-new-tab-choice) (funcall tab-line-new-tab-choice) @@ -723,9 +736,9 @@ corresponding to the switched buffer." (tmm-prompt (mouse-buffer-menu-keymap)))))) (defun tab-line-select-tab (&optional event) - "Switch to the selected tab. + "Switch to the buffer specified by the tab on which you click. This command maintains the original order of prev/next buffers. -So for example, switching to a previous tab is equivalent to +So, for example, switching to a previous tab is equivalent to using the `previous-buffer' command." (interactive "e") (let* ((posnp (event-start event)) @@ -771,7 +784,7 @@ when `tab-line-tabs-function' is `tab-line-tabs-window-buffers'." :version "28.1") (defun tab-line-switch-to-prev-tab (&optional event) - "Switch to the previous tab. + "Switch to the previous tab's buffer. Its effect is the same as using the `previous-buffer' command (\\[previous-buffer])." (interactive (list last-nonmenu-event)) @@ -795,7 +808,7 @@ Its effect is the same as using the `previous-buffer' command (switch-to-buffer buffer))))))) (defun tab-line-switch-to-next-tab (&optional event) - "Switch to the next tab. + "Switch to the next tab's buffer. Its effect is the same as using the `next-buffer' command (\\[next-buffer])." (interactive (list last-nonmenu-event)) @@ -820,9 +833,9 @@ Its effect is the same as using the `next-buffer' command (defcustom tab-line-close-tab-function 'bury-buffer - "Defines what to do on closing the tab. + "What to do upon closing a tab on the tab line. If `bury-buffer', put the tab's buffer at the end of the list of all -buffers that effectively hides the buffer's tab from the tab line. +buffers, which effectively hides the buffer's tab from the tab line. If `kill-buffer', kills the tab's buffer. When a function, it is called with the tab as its argument. This option is useful when `tab-line-tabs-function' has the value @@ -835,9 +848,9 @@ This option is useful when `tab-line-tabs-function' has the value (defun tab-line-close-tab (&optional event) "Close the selected tab. -Usually is invoked by clicking on the close button on the right side -of the tab. This command buries the buffer, so it goes out of sight -from the tab line." +This command is usually invoked by clicking on the close button on the +right side of the tab. This command buries the buffer, so it goes out of +sight of the tab line." (interactive (list last-nonmenu-event)) (let* ((posnp (and (listp event) (event-start event))) (window (and posnp (posn-window posnp))) @@ -860,7 +873,7 @@ from the tab line." (force-mode-line-update)))) (defun tab-line-tab-context-menu (&optional event) - "Pop up context menu for the tab." + "Pop up the context menu for a tab-line tab." (interactive "e") (let ((menu (make-sparse-keymap (propertize "Context Menu" 'hide t)))) (define-key-after menu [close] @@ -868,7 +881,7 @@ from the tab line." (popup-menu menu event))) (defun tab-line-context-menu (&optional event) - "Pop up context menu for the tab line." + "Pop up the context menu for the tab line." (interactive "e") (let ((menu (make-sparse-keymap (propertize "Context Menu" 'hide t)))) (define-key-after menu [close] @@ -878,13 +891,15 @@ from the tab line." ;;;###autoload (define-minor-mode tab-line-mode - "Toggle display of window tab line in the buffer." + "Toggle display of tab line in the windows displaying the current buffer." :lighter nil (setq tab-line-format (when tab-line-mode '(:eval (tab-line-format))))) (defcustom tab-line-exclude-modes '(completion-list-mode) - "List of major modes in which the tab line is not enabled." + "List of major modes for which the tab-line display is not enabled. +Buffers under any of these major modes will not show the tab line in +their windows, even if `global-tab-line-mode' is enabled." :type '(repeat symbol) :group 'tab-line :version "27.1") @@ -893,7 +908,12 @@ from the tab line." (defvar-local tab-line-exclude nil) (defun tab-line-mode--turn-on () - "Turn on `tab-line-mode'." + "Turn on `tab-line-mode' in all pertinent buffers. +Temporary buffers, buffers whose names begin with a space, buffers +under major modes that are either mentioned in `tab-line-exclude-mode' +or have a non-nil `tab-line-exclude' property on their symbol, +and buffers that have a non-nil buffer-local value +of `tab-line-exclude', are exempt from `tab-line-mode'." (unless (or (minibufferp) (string-match-p "\\` " (buffer-name)) (memq major-mode tab-line-exclude-modes) commit 686a03ee222071d7efdca07ccf09ddfff94aa87c Author: Eli Zaretskii Date: Sun Oct 17 11:42:23 2021 +0300 More documentation fixes in tab-bar.el * lisp/tab-bar.el (tab-bar-detach-tab, tab-bar-move-window-to-tab) (tab-bar-new-tab-to, tab-bar-new-tab, tab-bar-close-tab-select) (tab-bar-close-last-tab-choice, tab-bar-tab-pre-close-functions) (tab-bar-close-tab, tab-bar-close-tab-by-name) (tab-bar-close-other-tabs, tab-bar-rename-tab) (tab-bar-rename-tab-by-name, tab-bar-move-tab-to-group) (tab-bar-change-tab-group, tab-bar-close-group-tabs) (tab-switcher-next-line, tab-switcher-prev-line) (tab-switcher-unmark, tab-switcher-delete, tab-switcher-select) (tab-bar-get-buffer-tab, display-buffer-in-tab) (display-buffer-in-new-tab, switch-to-buffer-other-tab) (find-file-other-tab, find-file-read-only-other-tab): Doc fixes. diff --git a/lisp/tab-bar.el b/lisp/tab-bar.el index 63ab932ac0..85f947f598 100644 --- a/lisp/tab-bar.el +++ b/lisp/tab-bar.el @@ -1227,7 +1227,7 @@ to which to move the tab; ARG defaults to 1." (defun tab-bar-detach-tab (&optional from-number) "Move tab number FROM-NUMBER to a new frame. -Interactively or without argument, move the current tab." +FROM-NUMBER defaults to the current tab (which happens interactively." (interactive (list (1+ (tab-bar--current-tab-index)))) (let* ((tabs (funcall tab-bar-tabs-function)) (tab-index (1- (or from-number (1+ (tab-bar--current-tab-index tabs))))) @@ -1241,7 +1241,10 @@ Interactively or without argument, move the current tab." (tab-bar-close-tab)))) (defun tab-bar-move-window-to-tab () - "Detach the selected window to a new tab." + "Move the selected window to a new tab. +This command removes the selected window from the configuration stored +on the current tab, and makes a new tab with that window in its +configuration." (interactive) (let ((tab-bar-new-tab-choice 'window)) (tab-bar-new-tab)) @@ -1251,17 +1254,17 @@ Interactively or without argument, move the current tab." (defcustom tab-bar-new-tab-to 'right - "Defines where to create a new tab. + "Where to create a new tab. If `leftmost', create as the first tab. -If `left', create to the left from the current tab. -If `right', create to the right from the current tab. +If `left', create to the left of the current tab. +If `right', create to the right of the current tab. If `rightmost', create as the last tab. If the value is a function, it should return a number as a position on the tab bar specifying where to insert a new tab." - :type '(choice (const :tag "First tab" leftmost) - (const :tag "To the left" left) - (const :tag "To the right" right) - (const :tag "Last tab" rightmost) + :type '(choice (const :tag "Insert first" leftmost) + (const :tag "Insert left" left) + (const :tag "Insert right" right) + (const :tag "Insert last" rightmost) (function :tag "Function")) :group 'tab-bar :version "27.1") @@ -1280,7 +1283,7 @@ TAB-NUMBER counts from 1. If no TAB-NUMBER is specified, then add a new tab at the position specified by `tab-bar-new-tab-to'. Negative TAB-NUMBER counts tabs from the end of the tab bar, and -1 means the new tab will become the last one. -Argument addressing is absolute in contrast to `tab-bar-new-tab' +Argument addressing is absolute in contrast to `tab-bar-new-tab', where argument addressing is relative. After the tab is created, the hooks in `tab-bar-tab-post-open-functions' are run." @@ -1353,7 +1356,7 @@ If a negative ARG, create a new tab ARG positions to the left. If ARG is zero, create a new tab in place of the current tab. If no ARG is specified, then add a new tab at the position specified by `tab-bar-new-tab-to'. -Argument addressing is relative in contrast to `tab-bar-new-tab-to' +Argument addressing is relative in contrast to `tab-bar-new-tab-to', where argument addressing is absolute. If FROM-NUMBER is a tab number, a new tab is created from that tab." (interactive "P") @@ -1380,7 +1383,7 @@ ARG and FROM-NUMBER have the same meaning as in `tab-bar-new-tab'." "A list of closed tabs to be able to undo their closing.") (defcustom tab-bar-close-tab-select 'recent - "Defines what tab to select after closing the specified tab. + "Which tab to make current after closing the specified tab. If `left', select the adjacent left tab. If `right', select the adjacent right tab. If `recent', select the most recently visited tab." @@ -1391,7 +1394,7 @@ If `recent', select the most recently visited tab." :version "27.1") (defcustom tab-bar-close-last-tab-choice nil - "Defines what to do when the last tab is closed. + "What to do when the last tab is closed. If nil, do nothing and show a message, like closing the last window or frame. If `delete-frame', delete the containing frame, as a web browser would do. If `tab-bar-mode-disable', disable `tab-bar-mode' so that tabs no longer show @@ -1416,9 +1419,8 @@ function returns a non-nil value, the tab will not be closed." (defcustom tab-bar-tab-pre-close-functions nil "List of functions to call before closing a tab. -The tab to be closed and a boolean indicating whether or not it -is the only tab in the frame are supplied as arguments, -respectively." +Each function is called with two arguments: the tab to be closed +and a boolean indicating whether or not it is the only tab on its frame." :type '(repeat function) :group 'tab-bar :version "27.1") @@ -1427,6 +1429,7 @@ respectively." "Close the tab specified by its absolute position TAB-NUMBER. If no TAB-NUMBER is specified, then close the current tab and switch to the tab specified by `tab-bar-close-tab-select'. +Interactively, TAB-NUMBER is the prefix numeric argument, and defaults to 1. TAB-NUMBER counts from 1. Optional TO-NUMBER could be specified to override the value of `tab-bar-close-tab-select' programmatically with a position @@ -1500,7 +1503,8 @@ for the last tab on a frame is determined by (message "Deleted tab and switched to %s" tab-bar-close-tab-select)))))) (defun tab-bar-close-tab-by-name (name) - "Close the tab by NAME." + "Close the tab given its NAME. +Interactively, prompt for NAME." (interactive (list (completing-read "Close tab by name: " (mapcar (lambda (tab) @@ -1509,8 +1513,9 @@ for the last tab on a frame is determined by (tab-bar-close-tab (1+ (tab-bar--tab-index-by-name name)))) (defun tab-bar-close-other-tabs (&optional tab-number) - "Close all tabs on the selected frame, except TAB-NUMBER. -TAB-NUMBER counts from 1 and defaults to the current tab." + "Close all tabs on the selected frame, except the tab TAB-NUMBER. +TAB-NUMBER counts from 1 and defaults to the current tab (which +happens interactively)." (interactive) (let* ((tabs (funcall tab-bar-tabs-function)) (current-index (tab-bar--current-tab-index tabs)) @@ -1576,9 +1581,12 @@ TAB-NUMBER counts from 1 and defaults to the current tab." (defun tab-bar-rename-tab (name &optional tab-number) - "Rename the tab specified by its absolute position TAB-NUMBER. + "Give the tab specified by its absolute position TAB-NUMBER a new NAME. If no TAB-NUMBER is specified, then rename the current tab. +Interactively, TAB-NUMBER is the prefix numeric argument, and defaults +to the current tab. TAB-NUMBER counts from 1. +Interactively, prompt for the new NAME. If NAME is the empty string, then use the automatic name function `tab-bar-tab-name-function'." (interactive @@ -1606,7 +1614,8 @@ function `tab-bar-tab-name-function'." (message "Renamed tab to '%s'" tab-new-name)))) (defun tab-bar-rename-tab-by-name (tab-name new-name) - "Rename the tab named TAB-NAME. + "Rename the tab named TAB-NAME to NEW-NAME. +Interactively, prompt for TAB-NAME and NEW-NAME. If NEW-NAME is the empty string, then use the automatic name function `tab-bar-tab-name-function'." (interactive @@ -1623,7 +1632,7 @@ function `tab-bar-tab-name-function'." ;;; Tab groups (defun tab-bar-move-tab-to-group (&optional tab) - "Relocate TAB (or the current tab) closer to its group." + "Relocate TAB (default: the current tab) closer to its group." (interactive) (let* ((tabs (funcall tab-bar-tabs-function)) (tab (or tab (tab-bar--current-tab-find tabs))) @@ -1661,6 +1670,8 @@ The current tab is supplied as an argument." (defun tab-bar-change-tab-group (group-name &optional tab-number) "Add the tab specified by its absolute position TAB-NUMBER to GROUP-NAME. If no TAB-NUMBER is specified, then set the GROUP-NAME for the current tab. +Interactively, TAB-NUMBER is the prefix numeric argument, and the command +prompts for GROUP-NAME. TAB-NUMBER counts from 1. If GROUP-NAME is the empty string, then remove the tab from any group. While using this command, you might also want to replace @@ -1698,7 +1709,8 @@ While using this command, you might also want to replace (message "Set tab group to '%s'" group-new-name)))) (defun tab-bar-close-group-tabs (group-name) - "Close all tabs that belong to GROUP-NAME on the selected frame." + "Close all tabs that belong to GROUP-NAME on the selected frame. +Interactively, prompt for GROUP-NAME." (interactive (let ((group-name (funcall tab-bar-tab-group-function (tab-bar--current-tab-find)))) @@ -1745,7 +1757,7 @@ While using this command, you might also want to replace (defun tab-bar--history-pre-change () (setq tab-bar-history-old-minibuffer-depth (minibuffer-depth)) - ;; Store wc before possibly entering the minibuffer + ;; Store window-configuration before possibly entering the minibuffer. (when (zerop tab-bar-history-old-minibuffer-depth) (setq tab-bar-history-old `((wc . ,(current-window-configuration)) @@ -1754,7 +1766,8 @@ While using this command, you might also want to replace (defun tab-bar--history-change () (when (and (not tab-bar-history-omit) tab-bar-history-old - ;; Store wc before possibly entering the minibuffer + ;; Store window-configuration before possibly entering + ;; the minibuffer. (zerop tab-bar-history-old-minibuffer-depth)) (puthash (selected-frame) (seq-take (cons tab-bar-history-old @@ -1946,12 +1959,16 @@ Letters do not insert themselves; instead, they are commands. nil)))) (defun tab-switcher-next-line (&optional arg) + "Move to ARGth next line in the list of tabs. +Interactively, ARG is the prefix numeric argument and defaults to 1." (interactive "p") (forward-line arg) (beginning-of-line) (move-to-column tab-switcher-column)) (defun tab-switcher-prev-line (&optional arg) + "Move to ARGth previous line in the list of tabs. +Interactively, ARG is the prefix numeric argument and defaults to 1." (interactive "p") (forward-line (- arg)) (beginning-of-line) @@ -1959,7 +1976,7 @@ Letters do not insert themselves; instead, they are commands. (defun tab-switcher-unmark (&optional backup) "Cancel requested operations on window configuration on this line and move down. -Optional prefix arg means move up." +With prefix arg, move up instead." (interactive "P") (beginning-of-line) (move-to-column tab-switcher-column) @@ -1979,7 +1996,7 @@ Optional prefix arg means move up." (defun tab-switcher-delete (&optional arg) "Mark window configuration on this line to be deleted by \\\\[tab-switcher-execute] command. -Prefix arg is how many window configurations to delete. +Prefix arg says how many window configurations to delete. Negative arg means delete backwards." (interactive "p") (let ((buffer-read-only nil)) @@ -2032,8 +2049,8 @@ Then move up one line. Prefix arg means move that many lines." (defun tab-switcher-select () "Select this line's window configuration. -This command deletes and replaces all the previously existing windows -in the selected frame." +This command replaces all the existing windows in the selected frame +with those specified by the selected window configuration." (interactive) (let* ((to-tab (tab-switcher-current-tab t))) (kill-buffer (current-buffer)) @@ -2059,8 +2076,8 @@ in the selected frame." (t (list (selected-frame))))) (defun tab-bar-get-buffer-tab (buffer-or-name &optional all-frames ignore-current-tab) - "Return a tab owning a window whose buffer is BUFFER-OR-NAME. -BUFFER-OR-NAME may be a buffer or a buffer name and defaults to + "Return the tab that owns the window whose buffer is BUFFER-OR-NAME. +BUFFER-OR-NAME may be a buffer or a buffer name, and defaults to the current buffer. The optional argument ALL-FRAMES specifies the frames to consider: @@ -2108,7 +2125,7 @@ Otherwise, prefer buffers of the current tab." (tab-bar--reusable-frames all-frames))))) (defun display-buffer-in-tab (buffer alist) - "Display BUFFER in a tab. + "Display BUFFER in a tab using display actions in ALIST. ALIST is an association list of action symbols and values. See Info node `(elisp) Buffer Display Action Alists' for details of such alists. @@ -2116,8 +2133,8 @@ such alists. If ALIST contains a `tab-name' entry, it creates a new tab with that name and displays BUFFER in a new tab. If a tab with this name already exists, it switches to that tab before displaying BUFFER. The `tab-name' entry can be -a function, then it is called with two arguments: BUFFER and ALIST, and -should return the tab name. When a `tab-name' entry is omitted, create +a function, in which case it is called with two arguments: BUFFER and ALIST, +and should return the tab name. When a `tab-name' entry is omitted, create a new tab without an explicit name. The ALIST entry `tab-group' (string or function) defines the tab group. @@ -2167,7 +2184,7 @@ indirectly called by the latter." (display-buffer-in-new-tab buffer alist)))))) (defun display-buffer-in-new-tab (buffer alist) - "Display BUFFER in a new tab. + "Display BUFFER in a new tab using display actions in ALIST. ALIST is an association list of action symbols and values. See Info node `(elisp) Buffer Display Action Alists' for details of such alists. @@ -2177,9 +2194,9 @@ without checking if a suitable tab already exists. If ALIST contains a `tab-name' entry, it creates a new tab with that name and displays BUFFER in a new tab. The `tab-name' entry can be a function, -then it is called with two arguments: BUFFER and ALIST, and should return -the tab name. When a `tab-name' entry is omitted, create a new tab without -an explicit name. +in which case it is called with two arguments: BUFFER and ALIST, and should +return the tab name. When a `tab-name' entry is omitted, create a new tab +without an explicit name. The ALIST entry `tab-group' (string or function) defines the tab group. @@ -2203,7 +2220,8 @@ indirectly called by the latter." (defun switch-to-buffer-other-tab (buffer-or-name &optional norecord) "Switch to buffer BUFFER-OR-NAME in another tab. -Like \\[switch-to-buffer-other-frame] (which see), but creates a new tab." +Like \\[switch-to-buffer-other-frame] (which see), but creates a new tab. +Interactively, prompt for the buffer to switch to." (interactive (list (read-buffer-to-switch "Switch to buffer in other tab: "))) (display-buffer (window-normalize-buffer-to-switch-to buffer-or-name) @@ -2213,7 +2231,10 @@ Like \\[switch-to-buffer-other-frame] (which see), but creates a new tab." (defun find-file-other-tab (filename &optional wildcards) "Edit file FILENAME, in another tab. -Like \\[find-file-other-frame] (which see), but creates a new tab." +Like \\[find-file-other-frame] (which see), but creates a new tab. +Interactively, prompt for FILENAME. +If WILDCARDS is non-nil, FILENAME can include widcards, and all matching +files will be visited." (interactive (find-file-read-args "Find file in other tab: " (confirm-nonexistent-file-or-buffer))) @@ -2230,7 +2251,10 @@ Like \\[find-file-other-frame] (which see), but creates a new tab." "Edit file FILENAME, in another tab, but don't allow changes. Like \\[find-file-other-frame] (which see), but creates a new tab. Like \\[find-file-other-tab], but marks buffer as read-only. -Use \\[read-only-mode] to permit editing." +Use \\[read-only-mode] to permit editing. +Interactively, prompt for FILENAME. +If WILDCARDS is non-nil, FILENAME can include widcards, and all matching +files will be visited." (interactive (find-file-read-args "Find file read-only in other tab: " (confirm-nonexistent-file-or-buffer))) commit c094b8c20a79c731cd36e86a3a6bc777606586bc Author: Michael Albinus Date: Sun Oct 17 09:36:59 2021 +0200 Warn about `file-notify-rm-all-watches' side effects * doc/lispref/os.texi (File Notifications): Warn about `file-notify-rm-all-watches' side effects. diff --git a/doc/lispref/os.texi b/doc/lispref/os.texi index 7c7673f9c5..1fbd66458a 100644 --- a/doc/lispref/os.texi +++ b/doc/lispref/os.texi @@ -3233,6 +3233,10 @@ Removes an existing file watch specified by its @var{descriptor}. @deffn Command file-notify-rm-all-watches Removes all existing file notification watches from Emacs. + +Use this command with caution, because it could have unexpected side +effects on packages relying on file watches. It is intended mainly +for debugging purposes, or when Emacs has been stalled. @end deffn @defun file-notify-valid-p descriptor commit 35920791df78400a36bf4420584bd8349ce9bbee Author: Eli Zaretskii Date: Sun Oct 17 10:33:34 2021 +0300 Improve doc strings of tab-bar commands * lisp/tab-bar.el (tab-bar-mouse-select-tab) (tab-bar-mouse-move-tab, tab-bar-mouse-close-tab-from-button) (tab-bar-mouse-close-tab, tab-bar-mouse-context-menu) (tab-bar-switch-to-next-tab, tab-bar-switch-to-prev-tab) (tab-bar-switch-to-last-tab, tab-bar-switch-to-recent-tab) (tab-bar-move-tab-backward, tab-bar-move-tab) (tab-bar-move-tab-to-frame): Add/fix doc strings. diff --git a/lisp/tab-bar.el b/lisp/tab-bar.el index ccecdbc044..63ab932ac0 100644 --- a/lisp/tab-bar.el +++ b/lisp/tab-bar.el @@ -260,6 +260,10 @@ a list of frames to update." keymap)))))) (defun tab-bar-mouse-select-tab (event) + "Select the tab at mouse click, or add a new tab on the tab bar. +Whether this command adds a new tab or selects an existing tab +depends on whether the click is on the \"+\" button or on an +existing tab." (interactive "e") (let* ((item (tab-bar--event-to-item (event-start event))) (tab-number (tab-bar--key-to-number (nth 0 item)))) @@ -272,7 +276,9 @@ a list of frames to update." (tab-bar-select-tab tab-number)))))) (defun tab-bar-mouse-close-tab-from-button (event) - "Close the tab only when clicked on the close button." + "Close the tab whose \"x\" close button you click. +See also `tab-bar-mouse-close-tab', which closes the tab +regardless of where you click on it." (interactive "e") (let* ((item (tab-bar--event-to-item (event-start event))) (tab-number (tab-bar--key-to-number (nth 0 item)))) @@ -281,9 +287,9 @@ a list of frames to update." (tab-bar-close-tab tab-number))))) (defun tab-bar-mouse-close-tab (event) - "Close the tab when clicked anywhere on the tab. + "Close the tab you click on. This is in contrast with `tab-bar-mouse-close-tab-from-button' -that closes only when clicked on the close button." +that closes a tab only when you click on its \"x\" close button." (interactive "e") (let* ((item (tab-bar--event-to-item (event-start event))) (tab-number (tab-bar--key-to-number (nth 0 item)))) @@ -291,6 +297,7 @@ that closes only when clicked on the close button." (tab-bar-close-tab tab-number)))) (defun tab-bar-mouse-context-menu (event) + "Pop up the context menu for the tab on which you click." (interactive "e") (let* ((item (tab-bar--event-to-item (event-start event))) (tab-number (tab-bar--key-to-number (nth 0 item))) @@ -330,6 +337,9 @@ that closes only when clicked on the close button." (popup-menu menu event))) (defun tab-bar-mouse-move-tab (event) + "Move a tab to a different position on the tab bar. +This command should be bound to a drag event. It moves the tab +at the mouse-down event to the position at mouse-up event." (interactive "e") (let ((from (tab-bar--key-to-number (nth 0 (tab-bar--event-to-item @@ -1089,7 +1099,8 @@ the tab bar." (force-mode-line-update)))) (defun tab-bar-switch-to-next-tab (&optional arg) - "Switch to ARGth next tab." + "Switch to ARGth next tab. +Interactively, ARG is the prefix numeric argument and defaults to 1." (interactive "p") (unless (integerp arg) (setq arg 1)) @@ -1099,20 +1110,24 @@ the tab bar." (tab-bar-select-tab (1+ to-index)))) (defun tab-bar-switch-to-prev-tab (&optional arg) - "Switch to ARGth previous tab." + "Switch to ARGth previous tab. +Interactively, ARG is the prefix numeric argument and defaults to 1." (interactive "p") (unless (integerp arg) (setq arg 1)) (tab-bar-switch-to-next-tab (- arg))) (defun tab-bar-switch-to-last-tab (&optional arg) - "Switch to the last tab or ARGth tab from the end of the tab bar." + "Switch to the last tab or ARGth tab from the end of the tab bar. +Interactively, ARG is the prefix numeric argument; it defaults to 1, +which means the last tab on the tab bar." (interactive "p") (tab-bar-select-tab (- (length (funcall tab-bar-tabs-function)) (1- (or arg 1))))) (defun tab-bar-switch-to-recent-tab (&optional arg) - "Switch to ARGth most recently visited tab." + "Switch to ARGth most recently visited tab. +Interactively, ARG is the prefix numeric argument and defaults to 1." (interactive "p") (unless (integerp arg) (setq arg 1)) @@ -1160,8 +1175,9 @@ where argument addressing is relative." (defun tab-bar-move-tab (&optional arg) "Move the current tab ARG positions to the right. -If a negative ARG, move the current tab ARG positions to the left. -Argument addressing is relative in contrast to `tab-bar-move-tab-to' +Interactively, ARG is the prefix numeric argument and defaults to 1. +If ARG is negative, move the current tab ARG positions to the left. +Argument addressing is relative in contrast to `tab-bar-move-tab-to', where argument addressing is absolute." (interactive "p") (let* ((tabs (funcall tab-bar-tabs-function)) @@ -1171,6 +1187,7 @@ where argument addressing is absolute." (defun tab-bar-move-tab-backward (&optional arg) "Move the current tab ARG positions to the left. +Interactively, ARG is the prefix numeric argument and defaults to 1. Like `tab-bar-move-tab', but moves in the opposite direction." (interactive "p") (tab-bar-move-tab (- (or arg 1)))) @@ -1181,7 +1198,8 @@ FROM-NUMBER defaults to the current tab number. FROM-NUMBER and TO-NUMBER count from 1. FROM-FRAME specifies the source frame and defaults to the selected frame. TO-FRAME specifies the target frame and defaults the next frame. -Interactively, ARG selects the ARGth different frame to move to." +Interactively, ARG selects the ARGth next frame on the same terminal, +to which to move the tab; ARG defaults to 1." (interactive "P") (unless from-frame (setq from-frame (selected-frame))) commit 2d15db6e892456b0577990c8dac7f48d39a915cd Author: Stefan Kangas Date: Sun Oct 17 03:00:10 2021 +0200 Fix a semantic test on some macOS machines * test/lisp/cedet/semantic/bovine/gcc-tests.el (semantic-gcc-test-output-parser-this-machine): Fix test on some macOS machines where running "gcc" runs "llvm" instead. diff --git a/test/lisp/cedet/semantic/bovine/gcc-tests.el b/test/lisp/cedet/semantic/bovine/gcc-tests.el index 93677d6c87..d049f95b4c 100644 --- a/test/lisp/cedet/semantic/bovine/gcc-tests.el +++ b/test/lisp/cedet/semantic/bovine/gcc-tests.el @@ -124,6 +124,11 @@ gcc version 2.95.2 19991024 (release)" "Test the output parser against the machine currently running Emacs." (skip-unless (executable-find "gcc")) (let ((semantic-gcc-test-strings (list (semantic-gcc-query "gcc" "-v")))) - (semantic-gcc-test-output-parser))) + ;; Some macOS machines run llvm when you type gcc. (!) + ;; We can't even check if it's a symlink; it's a binary placed in + ;; "/usr/bin/gcc". So check the output and just skip this test if + ;; it says "Apple LLVM". + (unless (string-match "Apple LLVM" (car semantic-gcc-test-strings)) + (semantic-gcc-test-output-parser)))) ;;; gcc-tests.el ends here commit ae9bfaa891c4f3cacb118aef6e35432d5fbeb88d Author: Stefan Kangas Date: Sat Oct 16 22:09:54 2021 +0200 Simplify condition in kbd * lisp/subr.el (kbd): Simplify condition. This was discussed in: https://lists.gnu.org/r/emacs-devel/2021-10/msg01136.html diff --git a/lisp/subr.el b/lisp/subr.el index e55c94a9f8..a9669ab750 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -1068,13 +1068,8 @@ and should normally not be needed." (nreverse lres) lres)))) (if (and (not need-vector) - (let ((ret t)) - (dolist (ch (append res nil)) - (unless (and (characterp ch) - (let ((ch2 (logand ch (lognot ?\M-\^@)))) - (and (>= ch2 0) (<= ch2 127)))) - (setq ret nil))) - ret)) + (not (memq nil (mapcar (lambda (ch) (<= 0 ch 127)) + (append res nil))))) (concat (mapcar (lambda (ch) (if (= (logand ch ?\M-\^@) 0) ch (+ ch 128))) commit ac6ac76e3ae5ca96607ac7eba4a3ccf146fc8815 Author: Kyle Meyer Date: Sat Oct 16 14:01:34 2021 -0400 Update to Org 9.5-57-g9bc3a2 diff --git a/etc/ORG-NEWS b/etc/ORG-NEWS index cbb0d38a2a..5e7813ca7f 100644 --- a/etc/ORG-NEWS +++ b/etc/ORG-NEWS @@ -98,6 +98,15 @@ latest stable version of Org should be compatible with Emacs 28.x, See [[https://orgmode.org/worg/org-maintenance.html#emacs-compatibility][this note on Worg]] and [[git::519947e508e081e71bf67db99e27b1c171ba4dfe][this commit]]. +*** The keybinding for ~org-table-blank-field~ has been removed + +If you prefer to keep the keybinding, you can add it back to +~org-mode-map~ like so: + +#+begin_src emacs-lisp +(define-key org-mode-map (kbd "C-c SPC") #'org-table-blank-field) +#+end_src + ** New features *** New citation engine diff --git a/lisp/org/oc-basic.el b/lisp/org/oc-basic.el index 98242f3b84..c51c7d301e 100644 --- a/lisp/org/oc-basic.el +++ b/lisp/org/oc-basic.el @@ -69,7 +69,6 @@ (require 'bibtex) (require 'json) (require 'oc) -(require 'org) (require 'seq) (declare-function org-open-at-point "org" (&optional arg)) diff --git a/lisp/org/oc-biblatex.el b/lisp/org/oc-biblatex.el index daf56e792a..e985963816 100644 --- a/lisp/org/oc-biblatex.el +++ b/lisp/org/oc-biblatex.el @@ -213,8 +213,8 @@ PROPS is the local properties of the bibliography, as a property list." (defun org-cite-biblatex-export-citation (citation style _ info) "Export CITATION object. -STYLE is the citation style, as a string or nil. INFO is the export state, as -a property list." +STYLE is the citation style, as a pair of either strings or nil. +INFO is the export state, as a property list." (apply #'org-cite-biblatex--command citation info (pcase style diff --git a/lisp/org/oc-csl.el b/lisp/org/oc-csl.el index 3d13880759..94de97e33a 100644 --- a/lisp/org/oc-csl.el +++ b/lisp/org/oc-csl.el @@ -248,11 +248,11 @@ If nil then the Chicago author-date style is used as a fallback.") ("paras." . "paragraph") ("¶" . "paragraph") ("¶¶" . "paragraph") - ("§" . "paragraph") - ("§§" . "paragraph") ("part" . "part") ("pt." . "part") ("pts." . "part") + ("§" . "section") + ("§§" . "section") ("section" . "section") ("sec." . "section") ("secs." . "section") @@ -270,11 +270,12 @@ If nil then the Chicago author-date style is used as a fallback.") (defconst org-cite-csl--label-regexp ;; Prior to Emacs-27.1 argument of `regexp' form must be a string literal. ;; It is the reason why `rx' is avoided here. - (rx-to-string `(seq word-start - (regexp ,(regexp-opt (mapcar #'car org-cite-csl--label-alist) t)) - (0+ digit) - (or word-start line-end (any ?\s ?\t))) - t) + (rx-to-string + `(seq (or line-start space) + (regexp ,(regexp-opt (mapcar #'car org-cite-csl--label-alist) t)) + (0+ digit) + (or word-end line-end space " ")) + t) "Regexp matching a label in a citation reference suffix. Label is in match group 1.") @@ -371,7 +372,7 @@ or raise an error if the variable is unset." ((and (guard org-cite-csl-styles-dir) file) (expand-file-name file org-cite-csl-styles-dir)) (other - (user-error "Cannot handle relative style file name" other)))) + (user-error "Cannot handle relative style file name: %S" other)))) (defun org-cite-csl--locale-getter () "Return a locale getter. @@ -425,7 +426,9 @@ The result is a association list. Keys are: `id', `prefix',`suffix', ((re-search-forward org-cite-csl--label-regexp nil t) (setq location-start (match-beginning 0)) (setq label (cdr (assoc (match-string 1) org-cite-csl--label-alist))) - (setq locator-start (match-end 1))) + (goto-char (match-end 1)) + (skip-chars-forward "[:space:] ") + (setq locator-start (point))) ((re-search-forward (rx digit) nil t) (setq location-start (match-beginning 0)) (setq label "page") diff --git a/lisp/org/oc.el b/lisp/org/oc.el index 2f741768f8..dcda8d7d08 100644 --- a/lisp/org/oc.el +++ b/lisp/org/oc.el @@ -789,6 +789,20 @@ Citations are ordered by appearance in the document, when following footnotes. INFO is the export communication channel, as a property list." (or (plist-get info :citations) (letrec ((cites nil) + (tree (plist-get info :parse-tree)) + (find-definition + ;; Find definition for standard reference LABEL. At + ;; this point, it is impossible to rely on + ;; `org-export-get-footnote-definition' because the + ;; function caches results that could contain + ;; un-processed citation objects. So we use + ;; a simplified version of the function above. + (lambda (label) + (org-element-map tree 'footnote-definition + (lambda (d) + (and (equal label (org-element-property :label d)) + (or (org-element-contents d) ""))) + info t))) (search-cites (lambda (data) (org-element-map data '(citation footnote-reference) @@ -798,22 +812,13 @@ INFO is the export communication channel, as a property list." ;; Do not force entering inline definitions, since ;; `org-element-map' is going to enter it anyway. ((guard (eq 'inline (org-element-property :type datum)))) - ;; Find definition for current standard - ;; footnote reference. Unlike to - ;; `org-export-get-footnote-definition', do - ;; not cache results as they would contain - ;; un-processed citation objects. + ;; Walk footnote definition. (_ (let ((label (org-element-property :label datum))) - (funcall - search-cites - (org-element-map data 'footnote-definition - (lambda (d) - (and - (equal label (org-element-property :label d)) - (or (org-element-contents d) ""))))))))) + (funcall search-cites + (funcall find-definition label)))))) info nil 'footnote-definition t)))) - (funcall search-cites (plist-get info :parse-tree)) + (funcall search-cites tree) (let ((result (nreverse cites))) (plist-put info :citations result) result)))) @@ -1593,8 +1598,9 @@ The generated function inserts or edit a citation at point. More specifically, (concat "/" style) "")) "") - (mapconcat (lambda (k) (concat "@" k)) keys ";")))))))) + (mapconcat (lambda (k) (concat "@" k)) keys "; ")))))))) +;;;###autoload (defun org-cite-insert (arg) "Insert a citation at point. Insertion is done according to the processor set in `org-cite-insert-processor'. @@ -1603,7 +1609,7 @@ ARG is the prefix argument received when calling interactively the function." (let ((name org-cite-insert-processor)) (cond ((null name) - (user-error "No processor set to follow citations")) + (user-error "No processor set to insert citations")) ((not (org-cite--get-processor name)) (user-error "Unknown processor %S" name)) ((not (org-cite-processor-has-capability-p name 'insert)) diff --git a/lisp/org/org-version.el b/lisp/org/org-version.el index 9948008774..4464459695 100644 --- a/lisp/org/org-version.el +++ b/lisp/org/org-version.el @@ -11,7 +11,7 @@ Inserted by installing Org mode or when a release is made." (defun org-git-version () "The Git version of Org mode. Inserted by installing Org or when a release is made." - (let ((org-git-version "release_9.5-46-gb71474")) + (let ((org-git-version "release_9.5-57-g9bc3a2")) org-git-version)) (provide 'org-version) diff --git a/lisp/org/org.el b/lisp/org/org.el index c2a37e6cdd..83b3d79cb1 100644 --- a/lisp/org/org.el +++ b/lisp/org/org.el @@ -95,6 +95,7 @@ (require 'org-keys) (require 'ol) (require 'oc) +(require 'oc-basic) (require 'org-table) ;; `org-outline-regexp' ought to be a defconst but is let-bound in commit 60296fd168a895c55069d704c8164b9f794be7d0 Merge: 536968304b 1dfe9d6285 Author: Glenn Morris Date: Sat Oct 16 09:18:37 2021 -0700 ; Merge from origin/emacs-28 The following commit was skipped: 1dfe9d6285 (origin/emacs-28) Recommend against using uce.el commit 536968304bd2ab70819b2920fc015e4bf9330636 Merge: ffff168d5f e8488808df Author: Glenn Morris Date: Sat Oct 16 09:18:37 2021 -0700 Merge from origin/emacs-28 e8488808df Avoid aborts when a thread is signaled while "waiting for ... 21397cce51 Improve documentation string for 'compilation-error-regexp... 2971a6890f * lisp/emacs-lisp/comp.el (comp-trampoline-compile): Fix t... e842d7f29a Fix removal of fringe indication of bookmarks b5a0eda978 Prefer "graphical displays" to "X terminals" in documentation 4ad0fc0dd0 Precise documentation of file-notify-add-watch f5b8df14c6 Fixes to account for windows' tab lines ced72b6e4c * Fix `native-compile-target-directory' effectiveness on t... 502788bc3d Add missing single quotes in the Emacs manual 1af45ad04e ; * lisp/emacs-lisp/comp.el (comp-trampoline-compile): Fix... 12654b7423 * lisp/menu-bar.el (yank-menu-length): Fix docstring (bug#... # Conflicts: # lisp/gnus/gnus-undo.el # lisp/menu-bar.el commit ffff168d5fb14fbfa74f7c04fab0235a14bb7e64 Author: Michael Albinus Date: Sat Oct 16 18:08:25 2021 +0200 Set EMACS_TEST_TIMEOUT for emba * test/Makefile.in: Support EMACS_TEST_TIMEOUT environment variable. * test/README: Mention EMACS_TEST_TIMEOUT environment variable. * test/infra/gitlab-ci.yml (variables): Set default value of EMACS_TEST_TIMEOUT. (.job-template): Propagate EMACS_TEST_TIMEOUT and EMACS_TEST_VERBOSE. (test-all-inotify): Set specific EMACS_TEST_TIMEOUT. diff --git a/test/Makefile.in b/test/Makefile.in index a5720b2571..7bef1c3660 100644 --- a/test/Makefile.in +++ b/test/Makefile.in @@ -77,9 +77,14 @@ EMACSOPT = --no-init-file --no-site-file --no-site-lisp -L "$(SEPCHAR)$(srcdir)" # Prevent any settings in the user environment causing problems. unexport EMACSDATA EMACSDOC EMACSPATH GREP_OPTIONS XDG_CONFIG_HOME -## To run tests under a debugger, set this to eg: "gdb --args". +# To run tests under a debugger, set this to eg: "gdb --args". GDB = +# Whether a timeout shall be given, writing possibly a core dump. +ifneq (${EMACS_TEST_TIMEOUT},) +TEST_TIMEOUT = timeout -s ABRT ${EMACS_TEST_TIMEOUT} +endif + # Set this to 'yes' to run the tests in an interactive instance. TEST_INTERACTIVE ?= no @@ -117,7 +122,7 @@ endif # and prevent locals to influence the text of the errors we expect to receive. emacs = LANG=C EMACSLOADPATH= \ EMACS_TEST_DIRECTORY=$(abspath $(srcdir)) \ - $(GDB) "$(EMACS)" $(MODULES_EMACSOPT) $(EMACSOPT) + $(GDB) $(TEST_TIMEOUT) "$(EMACS)" $(MODULES_EMACSOPT) $(EMACSOPT) # Set HOME to a nonexistent directory to prevent tests from accessing # it accidentally (e.g., popping up a gnupg dialog if ~/.authinfo.gpg diff --git a/test/README b/test/README index a0961249cf..4d447c9bf1 100644 --- a/test/README +++ b/test/README @@ -140,6 +140,11 @@ these test environments. $EMACS_HYDRA_CI indicates the hydra environment, and $EMACS_EMBA_CI indicates the emba environment, respectively. +If tests on these premises take too long, and it is needed to create a +core dump for further analysis, the environment variable +$EMACS_TEST_TIMEOUT could set a limit (in seconds) when this shall +happen. + (Also, see etc/compilation.txt for compilation mode font lock tests and etc/grep.txt for grep mode font lock tests.) diff --git a/test/infra/gitlab-ci.yml b/test/infra/gitlab-ci.yml index 98abd1d2c4..d4b7ee99d8 100644 --- a/test/infra/gitlab-ci.yml +++ b/test/infra/gitlab-ci.yml @@ -44,6 +44,8 @@ workflow: variables: GIT_STRATEGY: fetch EMACS_EMBA_CI: 1 + # Three hours, see below. + EMACS_TEST_TIMEOUT: 10800 EMACS_TEST_VERBOSE: 1 # # Use TLS https://docs.gitlab.com/ee/ci/docker/using_docker_build.html#tls-enabled # DOCKER_HOST: tcp://docker:2376 @@ -108,7 +110,7 @@ default: # TODO: with make -j4 several of the tests were failing, for # example shadowfile-tests, but passed without it. - 'export PWD=$(pwd)' - - 'timeout 7200s docker run -i -e EMACS_EMBA_CI=${EMACS_EMBA_CI} --volumes-from $(docker ps -q -f "label=com.gitlab.gitlab-runner.job.id=${CI_JOB_ID}"):ro --name ${test_name} ${CI_REGISTRY_IMAGE}:${target}-${BUILD_TAG} /bin/bash -c "git fetch ${PWD} HEAD && echo checking out these updated files && git diff --name-only FETCH_HEAD && ( git diff --name-only FETCH_HEAD | xargs git checkout -f FETCH_HEAD ) && make -j4 && timeout -s ABRT 3600s make ${make_params}"' + - 'docker run -i -e EMACS_EMBA_CI=${EMACS_EMBA_CI} -e EMACS_TEST_TIMEOUT=${EMACS_TEST_TIMEOUT} -e EMACS_TEST_VERBOSE=${EMACS_TEST_VERBOSE} --volumes-from $(docker ps -q -f "label=com.gitlab.gitlab-runner.job.id=${CI_JOB_ID}"):ro --name ${test_name} ${CI_REGISTRY_IMAGE}:${target}-${BUILD_TAG} /bin/bash -c "git fetch ${PWD} HEAD && echo checking out these updated files && git diff --name-only FETCH_HEAD && ( git diff --name-only FETCH_HEAD | xargs git checkout -f FETCH_HEAD ) && make -j4 && make ${make_params}"' after_script: - docker ps -a - printenv @@ -312,6 +314,8 @@ test-all-inotify: variables: target: emacs-inotify make_params: check-expensive + # Two hours. + EMACS_TEST_TIMEOUT: 7200 # Local Variables: # add-log-current-defun-header-regexp: "^\\([-_.[:alnum:]]+\\)[ \t]*:" commit 4c468c6b3c12c12a96a6efce7a49c9b77e73bbd0 Author: Lars Ingebrigtsen Date: Sat Oct 16 17:50:36 2021 +0200 Add new function 'kbd-valid-p' * doc/lispref/keymaps.texi (Key Sequences): New function 'kbd-valid-p'. * lisp/subr.el (kbd-valid-p): Document it. diff --git a/doc/lispref/keymaps.texi b/doc/lispref/keymaps.texi index 066d8b3693..4277c718fe 100644 --- a/doc/lispref/keymaps.texi +++ b/doc/lispref/keymaps.texi @@ -94,8 +94,15 @@ Manual}. (kbd " SPC") @result{} [f1 32] (kbd "C-M-") @result{} [C-M-down] @end example + +@findex kbd-valid-p +The @code{kbd} function is very permissive, and will try to return +something sensible even if the syntax used isn't completely +conforming. To check whether the syntax is actually valid, use the +@code{kbd-valid-p} function. @end defun + @node Keymap Basics @section Keymap Basics @cindex key binding diff --git a/etc/NEWS b/etc/NEWS index e7d3de7798..fcc9b4ad32 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -209,6 +209,13 @@ This macro allows defining keymap variables more conveniently. ** 'kbd' can now be used in built-in, preloaded libraries. It no longer depends on edmacro.el and cl-lib.el. ++++ +** New function 'kbd-valid-p'. +The 'kbd' function is quite permissive, and will try to return +something usable even if the syntax of the argument isn't completely +correct. The 'kbd-valid-p' predicate does a stricter check of the +syntax. + * Changes in Emacs 29.1 on Non-Free Operating Systems diff --git a/lisp/subr.el b/lisp/subr.el index 93ec76e290..e55c94a9f8 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -925,6 +925,39 @@ side-effects, and the argument LIST is not modified." ;;;; Keymap support. +(defun kbd-valid-p (keys) + "Say whether KEYS is a valid `kbd' sequence. +In particular, this checks the order of the modifiers, and they +have to be specified in this order: + + A-C-H-M-S-s + +which is + + Alt-Control-Hyper-Meta-Shift-super" + (declare (pure t) (side-effect-free t)) + (and (stringp keys) + (string-match-p "\\`[^ ]+\\( [^ ]+\\)*\\'" keys) + (save-match-data + (seq-every-p + (lambda (key) + ;; Every key might have these modifiers, and they should be + ;; in this order. + (when (string-match + "\\`\\(A-\\)?\\(C-\\)?\\(H-\\)?\\(M-\\)?\\(S-\\)?\\(s-\\)?" + key) + (setq key (substring key (match-end 0)))) + (or (and (= (length key) 1) + ;; Don't accept control characters as keys. + (not (< (aref key 0) ?\s)) + ;; Don't accept Meta'd characters as keys. + (or (multibyte-string-p key) + (not (<= 127 (aref key 0) 255)))) + (string-match-p "\\`<[A-Za-z0-9]+>\\'" key) + (string-match-p + "\\`\\(NUL\\|RET\\|TAB\\|LFD\\|ESC\\|SPC\\|DEL\\)\\'" key))) + (split-string keys " "))))) + (defun kbd (keys &optional need-vector) "Convert KEYS to the internal Emacs key representation. KEYS should be a string in the format returned by commands such diff --git a/test/lisp/subr-tests.el b/test/lisp/subr-tests.el index da46646d39..8380e8abfd 100644 --- a/test/lisp/subr-tests.el +++ b/test/lisp/subr-tests.el @@ -198,6 +198,120 @@ ;; These should be equivalent: (should (equal (kbd "\C-xf") (kbd "C-x f")))) +(ert-deftest subr-test-kbd-valid-p () + (should (not (kbd-valid-p ""))) + (should (kbd-valid-p "f")) + (should (kbd-valid-p "X")) + (should (not (kbd-valid-p " X"))) + (should (kbd-valid-p "X f")) + (should (not (kbd-valid-p "a b"))) + (should (not (kbd-valid-p "foobar"))) + (should (not (kbd-valid-p "return"))) + + (should (kbd-valid-p "")) + (should (kbd-valid-p " TAB")) + (should (kbd-valid-p " RET")) + (should (kbd-valid-p " SPC")) + (should (kbd-valid-p "")) + (should (not (kbd-valid-p "[f1]"))) + (should (kbd-valid-p "")) + (should (not (kbd-valid-p "< right >"))) + + ;; Modifiers: + (should (kbd-valid-p "C-x")) + (should (kbd-valid-p "C-x a")) + (should (kbd-valid-p "C-;")) + (should (kbd-valid-p "C-a")) + (should (kbd-valid-p "C-c SPC")) + (should (kbd-valid-p "C-c TAB")) + (should (kbd-valid-p "C-c c")) + (should (kbd-valid-p "C-x 4 C-f")) + (should (kbd-valid-p "C-x C-f")) + (should (kbd-valid-p "C-M-")) + (should (not (kbd-valid-p ""))) + (should (kbd-valid-p "C-RET")) + (should (kbd-valid-p "C-SPC")) + (should (kbd-valid-p "C-TAB")) + (should (kbd-valid-p "C-")) + (should (kbd-valid-p "C-c C-c C-c")) + + (should (kbd-valid-p "M-a")) + (should (kbd-valid-p "M-")) + (should (not (kbd-valid-p "M-C-a"))) + (should (kbd-valid-p "C-M-a")) + (should (kbd-valid-p "M-ESC")) + (should (kbd-valid-p "M-RET")) + (should (kbd-valid-p "M-SPC")) + (should (kbd-valid-p "M-TAB")) + (should (kbd-valid-p "M-x a")) + (should (kbd-valid-p "M-")) + (should (kbd-valid-p "M-c M-c M-c")) + + (should (kbd-valid-p "s-SPC")) + (should (kbd-valid-p "s-a")) + (should (kbd-valid-p "s-x a")) + (should (kbd-valid-p "s-c s-c s-c")) + + (should (not (kbd-valid-p "S-H-a"))) + (should (kbd-valid-p "S-a")) + (should (kbd-valid-p "S-x a")) + (should (kbd-valid-p "S-c S-c S-c")) + + (should (kbd-valid-p "H-")) + (should (kbd-valid-p "H-DEL")) + (should (kbd-valid-p "H-a")) + (should (kbd-valid-p "H-x a")) + (should (kbd-valid-p "H-c H-c H-c")) + + (should (kbd-valid-p "A-H-a")) + (should (kbd-valid-p "A-SPC")) + (should (kbd-valid-p "A-TAB")) + (should (kbd-valid-p "A-a")) + (should (kbd-valid-p "A-c A-c A-c")) + + (should (kbd-valid-p "C-M-a")) + (should (kbd-valid-p "C-M-")) + + ;; Special characters. + (should (kbd-valid-p "DEL")) + (should (kbd-valid-p "ESC C-a")) + (should (kbd-valid-p "ESC")) + (should (kbd-valid-p "LFD")) + (should (kbd-valid-p "NUL")) + (should (kbd-valid-p "RET")) + (should (kbd-valid-p "SPC")) + (should (kbd-valid-p "TAB")) + (should (not (kbd-valid-p "\^i"))) + (should (not (kbd-valid-p "^M"))) + + ;; With numbers. + (should (not (kbd-valid-p "\177"))) + (should (not (kbd-valid-p "\000"))) + (should (not (kbd-valid-p "\\177"))) + (should (not (kbd-valid-p "\\000"))) + (should (not (kbd-valid-p "C-x \\150"))) + + ;; Multibyte + (should (kbd-valid-p "ñ")) + (should (kbd-valid-p "ü")) + (should (kbd-valid-p "ö")) + (should (kbd-valid-p "ğ")) + (should (kbd-valid-p "ա")) + (should (not (kbd-valid-p "üüöö"))) + (should (kbd-valid-p "C-ü")) + (should (kbd-valid-p "M-ü")) + (should (kbd-valid-p "H-ü")) + + ;; Handle both new and old style key descriptions (bug#45536). + (should (kbd-valid-p "s-")) + (should (not (kbd-valid-p ""))) + (should (kbd-valid-p "C-M-")) + (should (not (kbd-valid-p ""))) + + (should (not (kbd-valid-p "C-xx"))) + (should (not (kbd-valid-p "M-xx"))) + (should (not (kbd-valid-p "M-x")))) + (ert-deftest subr-test-define-prefix-command () (define-prefix-command 'foo-prefix-map) (defvar foo-prefix-map) commit 570d4f29fd61b3557fa8ab29e580bf7de8fb0dd5 Author: Michael Albinus Date: Sat Oct 16 17:23:57 2021 +0200 Fix :version of new faces in term.el * lisp/term.el (term-faint, term-italic, term-slow-blink) (term-fast-blink): Set proper :version. diff --git a/lisp/term.el b/lisp/term.el index 0e36e877e6..dd5457745b 100644 --- a/lisp/term.el +++ b/lisp/term.el @@ -777,13 +777,13 @@ Buffer local variable.") '((t :inherit ansi-color-faint)) "Default face to use for faint text." :group 'term - :version "28.1") + :version "29.1") (defface term-italic '((t :inherit ansi-color-italic)) "Default face to use for italic text." :group 'term - :version "28.1") + :version "29.1") (defface term-underline '((t :inherit ansi-color-underline)) @@ -795,13 +795,13 @@ Buffer local variable.") '((t :inherit ansi-color-slow-blink)) "Default face to use for slowly blinking text." :group 'term - :version "28.1") + :version "29.1") (defface term-fast-blink '((t :inherit ansi-color-fast-blink)) "Default face to use for rapidly blinking text." :group 'term - :version "28.1") + :version "29.1") (defface term-color-black '((t :inherit ansi-color-black)) commit 8ee63604e3738750a845b7d03563942a94052bd9 Author: Stefan Kangas Date: Wed Oct 13 22:54:47 2021 +0200 Remove duplicate code in edmacro-parse-keys * lisp/subr.el (kbd): Add argument NEED-VECTOR and make it suitable for calling from 'edmacro-parse-keys'. * lisp/edmacro.el (edmacro-parse-keys): Replace definition with a call to 'kbd'. This change was discussed in: https://lists.gnu.org/r/emacs-devel/2021-10/msg00909.html diff --git a/lisp/edmacro.el b/lisp/edmacro.el index a4eb574a4c..decb8edbb1 100644 --- a/lisp/edmacro.el +++ b/lisp/edmacro.el @@ -640,101 +640,7 @@ This function assumes that the events can be stored in a string." ;;; Parsing a human-readable keyboard macro. (defun edmacro-parse-keys (string &optional need-vector) - (let ((case-fold-search nil) - (len (length string)) ; We won't alter string in the loop below. - (pos 0) - (res [])) - (while (and (< pos len) - (string-match "[^ \t\n\f]+" string pos)) - (let* ((word-beg (match-beginning 0)) - (word-end (match-end 0)) - (word (substring string word-beg len)) - (times 1) - key) - ;; Try to catch events of the form "". - (if (string-match "\\`<[^ <>\t\n\f][^>\t\n\f]*>" word) - (setq word (match-string 0 word) - pos (+ word-beg (match-end 0))) - (setq word (substring string word-beg word-end) - pos word-end)) - (when (string-match "\\([0-9]+\\)\\*." word) - (setq times (string-to-number (substring word 0 (match-end 1)))) - (setq word (substring word (1+ (match-end 1))))) - (cond ((string-match "^<<.+>>$" word) - (setq key (vconcat (if (eq (key-binding [?\M-x]) - 'execute-extended-command) - [?\M-x] - (or (car (where-is-internal - 'execute-extended-command)) - [?\M-x])) - (substring word 2 -2) "\r"))) - ((and (string-match "^\\(\\([ACHMsS]-\\)*\\)<\\(.+\\)>$" word) - (progn - (setq word (concat (match-string 1 word) - (match-string 3 word))) - (not (string-match - "\\<\\(NUL\\|RET\\|LFD\\|ESC\\|SPC\\|DEL\\)$" - word)))) - (setq key (list (intern word)))) - ((or (equal word "REM") (string-match "^;;" word)) - (setq pos (string-match "$" string pos))) - (t - (let ((orig-word word) (prefix 0) (bits 0)) - (while (string-match "^[ACHMsS]-." word) - (cl-incf bits (cdr (assq (aref word 0) - '((?A . ?\A-\^@) (?C . ?\C-\^@) - (?H . ?\H-\^@) (?M . ?\M-\^@) - (?s . ?\s-\^@) (?S . ?\S-\^@))))) - (cl-incf prefix 2) - (cl-callf substring word 2)) - (when (string-match "^\\^.$" word) - (cl-incf bits ?\C-\^@) - (cl-incf prefix) - (cl-callf substring word 1)) - (let ((found (assoc word '(("NUL" . "\0") ("RET" . "\r") - ("LFD" . "\n") ("TAB" . "\t") - ("ESC" . "\e") ("SPC" . " ") - ("DEL" . "\177"))))) - (when found (setq word (cdr found)))) - (when (string-match "^\\\\[0-7]+$" word) - (cl-loop for ch across word - for n = 0 then (+ (* n 8) ch -48) - finally do (setq word (vector n)))) - (cond ((= bits 0) - (setq key word)) - ((and (= bits ?\M-\^@) (stringp word) - (string-match "^-?[0-9]+$" word)) - (setq key (cl-loop for x across word - collect (+ x bits)))) - ((/= (length word) 1) - (error "%s must prefix a single character, not %s" - (substring orig-word 0 prefix) word)) - ((and (/= (logand bits ?\C-\^@) 0) (stringp word) - ;; We used to accept . and ? here, - ;; but . is simply wrong, - ;; and C-? is not used (we use DEL instead). - (string-match "[@-_a-z]" word)) - (setq key (list (+ bits (- ?\C-\^@) - (logand (aref word 0) 31))))) - (t - (setq key (list (+ bits (aref word 0))))))))) - (when key - (cl-loop repeat times do (cl-callf vconcat res key))))) - (when (and (>= (length res) 4) - (eq (aref res 0) ?\C-x) - (eq (aref res 1) ?\() - (eq (aref res (- (length res) 2)) ?\C-x) - (eq (aref res (- (length res) 1)) ?\))) - (setq res (cl-subseq res 2 -2))) - (if (and (not need-vector) - (cl-loop for ch across res - always (and (characterp ch) - (let ((ch2 (logand ch (lognot ?\M-\^@)))) - (and (>= ch2 0) (<= ch2 127)))))) - (concat (cl-loop for ch across res - collect (if (= (logand ch ?\M-\^@) 0) - ch (+ ch 128)))) - res))) + (kbd string need-vector)) (provide 'edmacro) diff --git a/lisp/subr.el b/lisp/subr.el index 1c3dc26a4d..93ec76e290 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -925,14 +925,18 @@ side-effects, and the argument LIST is not modified." ;;;; Keymap support. -(defun kbd (keys) +(defun kbd (keys &optional need-vector) "Convert KEYS to the internal Emacs key representation. KEYS should be a string in the format returned by commands such as `C-h k' (`describe-key'). This is the same format used for saving keyboard macros (see `edmacro-mode'). -For an approximate inverse of this, see `key-description'." +For an approximate inverse of this, see `key-description'. + +If NEED-VECTOR is non-nil, always return a vector instead of a +string. This is mainly intended for use by `edmacro-parse-keys', +and should normally not be needed." (declare (pure t) (side-effect-free t)) ;; A pure function is expected to preserve the match data. (save-match-data @@ -1030,13 +1034,14 @@ For an approximate inverse of this, see `key-description'." (setq lres (cdr (cdr lres))) (nreverse lres) lres)))) - (if (let ((ret t)) - (dolist (ch (append res nil)) - (unless (and (characterp ch) - (let ((ch2 (logand ch (lognot ?\M-\^@)))) - (and (>= ch2 0) (<= ch2 127)))) - (setq ret nil))) - ret) + (if (and (not need-vector) + (let ((ret t)) + (dolist (ch (append res nil)) + (unless (and (characterp ch) + (let ((ch2 (logand ch (lognot ?\M-\^@)))) + (and (>= ch2 0) (<= ch2 127)))) + (setq ret nil))) + ret)) (concat (mapcar (lambda (ch) (if (= (logand ch ?\M-\^@) 0) ch (+ ch 128))) commit e082a1628444125ca36c222d81bf5fe8a84ccbc5 Author: Stefan Kangas Date: Wed Oct 13 01:40:14 2021 +0200 Make kbd usable during bootstrap * lisp/subr.el (kbd): Make 'kbd' usable during bootstrap by copying the definition of 'read-kbd-macro' into it, and adjusting it to no longer use CL-Lib functions. This change was discussed in: https://lists.gnu.org/r/emacs-devel/2021-10/msg00909.html diff --git a/etc/NEWS b/etc/NEWS index 5a7b204d65..e7d3de7798 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -205,6 +205,10 @@ This function allows defining a number of keystrokes with one form. ** New macro 'defvar-keymap'. This macro allows defining keymap variables more conveniently. +--- +** 'kbd' can now be used in built-in, preloaded libraries. +It no longer depends on edmacro.el and cl-lib.el. + * Changes in Emacs 29.1 on Non-Free Operating Systems diff --git a/lisp/subr.el b/lisp/subr.el index a1858e5911..1c3dc26a4d 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -933,11 +933,115 @@ This is the same format used for saving keyboard macros (see `edmacro-mode'). For an approximate inverse of this, see `key-description'." - ;; Don't use a defalias, since the `pure' property is true only for - ;; the calling convention of `kbd'. (declare (pure t) (side-effect-free t)) ;; A pure function is expected to preserve the match data. - (save-match-data (read-kbd-macro keys))) + (save-match-data + (let ((case-fold-search nil) + (len (length keys)) ; We won't alter keys in the loop below. + (pos 0) + (res [])) + (while (and (< pos len) + (string-match "[^ \t\n\f]+" keys pos)) + (let* ((word-beg (match-beginning 0)) + (word-end (match-end 0)) + (word (substring keys word-beg len)) + (times 1) + key) + ;; Try to catch events of the form "". + (if (string-match "\\`<[^ <>\t\n\f][^>\t\n\f]*>" word) + (setq word (match-string 0 word) + pos (+ word-beg (match-end 0))) + (setq word (substring keys word-beg word-end) + pos word-end)) + (when (string-match "\\([0-9]+\\)\\*." word) + (setq times (string-to-number (substring word 0 (match-end 1)))) + (setq word (substring word (1+ (match-end 1))))) + (cond ((string-match "^<<.+>>$" word) + (setq key (vconcat (if (eq (key-binding [?\M-x]) + 'execute-extended-command) + [?\M-x] + (or (car (where-is-internal + 'execute-extended-command)) + [?\M-x])) + (substring word 2 -2) "\r"))) + ((and (string-match "^\\(\\([ACHMsS]-\\)*\\)<\\(.+\\)>$" word) + (progn + (setq word (concat (match-string 1 word) + (match-string 3 word))) + (not (string-match + "\\<\\(NUL\\|RET\\|LFD\\|ESC\\|SPC\\|DEL\\)$" + word)))) + (setq key (list (intern word)))) + ((or (equal word "REM") (string-match "^;;" word)) + (setq pos (string-match "$" keys pos))) + (t + (let ((orig-word word) (prefix 0) (bits 0)) + (while (string-match "^[ACHMsS]-." word) + (setq bits (+ bits (cdr (assq (aref word 0) + '((?A . ?\A-\^@) (?C . ?\C-\^@) + (?H . ?\H-\^@) (?M . ?\M-\^@) + (?s . ?\s-\^@) (?S . ?\S-\^@)))))) + (setq prefix (+ prefix 2)) + (setq word (substring word 2))) + (when (string-match "^\\^.$" word) + (setq bits (+ bits ?\C-\^@)) + (setq prefix (1+ prefix)) + (setq word (substring word 1))) + (let ((found (assoc word '(("NUL" . "\0") ("RET" . "\r") + ("LFD" . "\n") ("TAB" . "\t") + ("ESC" . "\e") ("SPC" . " ") + ("DEL" . "\177"))))) + (when found (setq word (cdr found)))) + (when (string-match "^\\\\[0-7]+$" word) + (let ((n 0)) + (dolist (ch (cdr (string-to-list word))) + (setq n (+ (* n 8) ch -48))) + (setq word (vector n)))) + (cond ((= bits 0) + (setq key word)) + ((and (= bits ?\M-\^@) (stringp word) + (string-match "^-?[0-9]+$" word)) + (setq key (mapcar (lambda (x) (+ x bits)) + (append word nil)))) + ((/= (length word) 1) + (error "%s must prefix a single character, not %s" + (substring orig-word 0 prefix) word)) + ((and (/= (logand bits ?\C-\^@) 0) (stringp word) + ;; We used to accept . and ? here, + ;; but . is simply wrong, + ;; and C-? is not used (we use DEL instead). + (string-match "[@-_a-z]" word)) + (setq key (list (+ bits (- ?\C-\^@) + (logand (aref word 0) 31))))) + (t + (setq key (list (+ bits (aref word 0))))))))) + (when key + (dolist (_ (number-sequence 1 times)) + (setq res (vconcat res key)))))) + (when (and (>= (length res) 4) + (eq (aref res 0) ?\C-x) + (eq (aref res 1) ?\() + (eq (aref res (- (length res) 2)) ?\C-x) + (eq (aref res (- (length res) 1)) ?\))) + (setq res (apply #'vector (let ((lres (append res nil))) + ;; Remove the first and last two elements. + (setq lres (cdr (cdr lres))) + (nreverse lres) + (setq lres (cdr (cdr lres))) + (nreverse lres) + lres)))) + (if (let ((ret t)) + (dolist (ch (append res nil)) + (unless (and (characterp ch) + (let ((ch2 (logand ch (lognot ?\M-\^@)))) + (and (>= ch2 0) (<= ch2 127)))) + (setq ret nil))) + ret) + (concat (mapcar (lambda (ch) + (if (= (logand ch ?\M-\^@) 0) + ch (+ ch 128))) + (append res nil))) + res)))) (defun undefined () "Beep to tell the user this binding is undefined." commit a232821c5127d5ebf862dc229f14a35dfef78e40 Author: Michael Albinus Date: Sat Oct 16 14:33:52 2021 +0200 Add command `file-notify-rm-all-watches' * doc/lispref/os.texi (File Notifications): Add `file-notify-rm-all-watches'. * etc/NEWS: Mention 'file-notify-rm-all-watches'. Fix typos. * lisp/filenotify.el (file-notify-rm-all-watches): New defun. * test/lisp/filenotify-tests.el (file-notify--test-cleanup): Use `file-notify-rm-all-watches'. (file-notify-test02-rm-watch): Test also `file-notify-rm-all-watches'. diff --git a/doc/lispref/os.texi b/doc/lispref/os.texi index e3297b1be7..e3dcd6c778 100644 --- a/doc/lispref/os.texi +++ b/doc/lispref/os.texi @@ -3230,6 +3230,10 @@ Removes an existing file watch specified by its @var{descriptor}. @code{file-notify-add-watch}. @end defun +@deffn Command file-notify-rm-all-watches +Removes all existing file notification watches from Emacs. +@end deffn + @defun file-notify-valid-p descriptor Checks a watch specified by its @var{descriptor} for validity. @var{descriptor} should be an object returned by diff --git a/etc/NEWS b/etc/NEWS index 2c09d24dde..5a7b204d65 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -28,7 +28,7 @@ applies, and please also update docstrings as needed. * Startup Changes in Emacs 29.1 +++ -** Emacs now has a --fingerprint option. +** Emacs now has a '--fingerprint' option. This will output a string identifying the current Emacs build. +++ @@ -73,7 +73,7 @@ point. --- *** Improved mouse behavior with auto-scrolling modes. -When clicking inside the `scroll-margin' or `hscroll-margin' region +When clicking inside the 'scroll-margin' or 'hscroll-margin' region the point is now moved only when releasing the mouse button. This no longer results in a bogus selection, unless the mouse has been effectively dragged. @@ -106,6 +106,8 @@ default, no automatic renaming is performed. The new command 'image-dired-unmark-all-marks' has been added with a binding in the menu. +** info-look + --- *** info-look specs can now be expanded at run time instead of a load time. The new ':doc-spec-function' element can be used to compute the @@ -115,9 +117,9 @@ mode (instead of at load time). ** subr-x +++ -*** New macro 'with-memoization' provides a very primitive form of memoization +*** New macro 'with-memoization' provides a very primitive form of memoization. -** ansi-color.el +** ansi-color --- *** Support for ANSI 256-color and 24-bit colors. @@ -130,14 +132,18 @@ filters and displayed with the specified color. *** Support for ANSI 256-color and 24-bit colors, italic and other fonts. Term-mode can now display 256-color and 24-bit color codes. It can also handle ANSI codes for faint, italic and blinking text, displaying -it with new 'ansi-term-faint/italic/slow-blinking/fast-blinking' -faces. +it with new 'term-{faint,italic,slow-blink,fast-blink}' faces. ** Xref *** 'project-find-file' and 'project-or-external-find-file' now accept a prefix argument which is interpreted to mean "include all files". +** File notifications + ++++ +*** The new command 'file-notify-rm-all-watches' removes all file notifications. + * New Modes and Packages in Emacs 29.1 @@ -183,7 +189,7 @@ If given the new optional KILL-PERMANENT argument, also kill permanent local variables. +++ -** Third 'mapconcat' argument 'separator' is now optional. +** Third 'mapconcat' argument SEPARATOR is now optional. An explicit nil always meant the empty string, now it can be left out. --- diff --git a/lisp/filenotify.el b/lisp/filenotify.el index e0dceb704d..a2a27625e4 100644 --- a/lisp/filenotify.el +++ b/lisp/filenotify.el @@ -478,6 +478,14 @@ DESCRIPTOR should be an object returned by `file-notify-add-watch'." ;; Modify `file-notify-descriptors' and send a `stopped' event. (file-notify--rm-descriptor descriptor)))) +(defun file-notify-rm-all-watches () + "Remove all existing file notification watches from Emacs." + (interactive) + (maphash + (lambda (key _value) + (file-notify-rm-watch key)) + file-notify-descriptors)) + (defun file-notify-valid-p (descriptor) "Check a watch specified by its DESCRIPTOR. DESCRIPTOR should be an object returned by `file-notify-add-watch'." diff --git a/test/lisp/filenotify-tests.el b/test/lisp/filenotify-tests.el index 6125069c6b..e8a647df90 100644 --- a/test/lisp/filenotify-tests.el +++ b/test/lisp/filenotify-tests.el @@ -162,9 +162,7 @@ Return nil when any other file notification watch is still active." (defun file-notify--test-cleanup () "Cleanup after a test." - (file-notify-rm-watch file-notify--test-desc) - (file-notify-rm-watch file-notify--test-desc1) - (file-notify-rm-watch file-notify--test-desc2) + (file-notify-rm-all-watches) (ignore-errors (delete-file (file-newest-backup file-notify--test-tmpfile))) @@ -421,7 +419,7 @@ If UNSTABLE is non-nil, the test is tagged as `:unstable'." ;; This test is inspired by Bug#26126 and Bug#26127. (ert-deftest file-notify-test02-rm-watch () - "Check `file-notify-rm-watch'." + "Check `file-notify-rm-watch' and `file-notify-rm-all-watches'." (skip-unless (file-notify--test-local-enabled)) (unwind-protect @@ -516,6 +514,31 @@ If UNSTABLE is non-nil, the test is tagged as `:unstable'." ;; The environment shall be cleaned up. (file-notify--test-cleanup-p)))) + ;; Cleanup. + (file-notify--test-cleanup)) + + (unwind-protect + ;; Check `file-notify-rm-all-watches'. + (progn + (setq file-notify--test-tmpfile (file-notify--test-make-temp-name) + file-notify--test-tmpfile1 (file-notify--test-make-temp-name)) + (write-region "any text" nil file-notify--test-tmpfile nil 'no-message) + (write-region "any text" nil file-notify--test-tmpfile1 nil 'no-message) + (should + (setq file-notify--test-desc + (file-notify-add-watch + file-notify--test-tmpfile '(change) #'ignore))) + (should + (setq file-notify--test-desc1 + (file-notify-add-watch + file-notify--test-tmpfile1 '(change) #'ignore))) + (file-notify-rm-all-watches) + (delete-file file-notify--test-tmpfile) + (delete-file file-notify--test-tmpfile1) + + ;; The environment shall be cleaned up. + (file-notify--test-cleanup-p)) + ;; Cleanup. (file-notify--test-cleanup))) commit 1dfe9d628535a4ba8fd902cad8563b5651c6ec36 Author: Stefan Kangas Date: Tue Oct 12 06:30:20 2021 +0200 Recommend against using uce.el * lisp/mail/uce.el: Recommend against its use. (Bug#46472) Do not merge to master. diff --git a/lisp/mail/uce.el b/lisp/mail/uce.el index b07004de38..0a488e176f 100644 --- a/lisp/mail/uce.el +++ b/lisp/mail/uce.el @@ -30,6 +30,27 @@ ;; uce-reply-to-uce. Please let me know about your changes so I can ;; incorporate them. I'd appreciate it. +;; -- !!! NOTE !!! --------------------------------------------- +;; +;; Replying to spam is at best pointless, but most likely actively +;; harmful. +;; +;; - You will confirm that your email address is valid, thus ensuring +;; you get more spam. +;; +;; - You will leak information and open yourself up for further +;; attack. For example, they could use your \"geolocation\" to find +;; your home address and phone number. +;; +;; - The sender address is likely fake. +;; +;; - You help them refine their methods of spamming. +;; +;; Therefore, we strongly recommend that you do not use this package. +;; Use a spam filter instead, or just delete the spam. +;; +;; ------------------------------------------------------------- + ;; The command uce-reply-to-uce, if called when the current message ;; buffer is a UCE, will setup a reply *mail* buffer as follows. It ;; scans the full headers of the message for: 1) the normal return commit a3fb10d94bd8c096595657a35315d7013b326a8c Author: Andreas Schwab Date: Sat Oct 16 13:58:13 2021 +0200 * src/emacs.c (standard_args): Sort --fingerprint second. (bug#51238) diff --git a/src/emacs.c b/src/emacs.c index 999690c7e0..a24543a586 100644 --- a/src/emacs.c +++ b/src/emacs.c @@ -2360,6 +2360,9 @@ struct standard_args static const struct standard_args standard_args[] = { { "-version", "--version", 150, 0 }, +#ifdef HAVE_PDUMPER + { "-fingerprint", "--fingerprint", 140, 0 }, +#endif { "-chdir", "--chdir", 130, 1 }, { "-t", "--terminal", 120, 1 }, { "-nw", "--no-window-system", 110, 0 }, commit e8488808dfe1460ce07042a1a523097ab90cf079 Author: Eli Zaretskii Date: Sat Oct 16 14:47:32 2021 +0300 Avoid aborts when a thread is signaled while "waiting for input". * src/process.c (kbd_is_ours): New function. (wait_reading_process_output): Set 'waiting_for_input' only if the current thread is monitoring the keyboard descriptor. See also https://lists.gnu.org/archive/html/emacs-devel/2021-10/msg01180.html. (Bug#51229) diff --git a/src/process.c b/src/process.c index 746cdc0428..6731f8808f 100644 --- a/src/process.c +++ b/src/process.c @@ -683,6 +683,22 @@ clear_waiting_thread_info (void) } } +/* Return TRUE if the keyboard descriptor is being monitored by the + current thread, FALSE otherwise. */ +static bool +kbd_is_ours (void) +{ + for (int fd = 0; fd <= max_desc; ++fd) + { + if (fd_callback_info[fd].waiting_thread != current_thread) + continue; + if ((fd_callback_info[fd].flags & (FOR_READ | KEYBOARD_FD)) + == (FOR_READ | KEYBOARD_FD)) + return true; + } + return false; +} + /* Compute the Lisp form of the process status, p->status, from the numeric status that was returned by `wait'. */ @@ -5312,13 +5328,13 @@ wait_reading_process_output (intmax_t time_limit, int nsecs, int read_kbd, wait_reading_process_output_1 (); } - /* Cause C-g and alarm signals to take immediate action, + /* Cause C-g signals to take immediate action, and cause input available signals to zero out timeout. It is important that we do this before checking for process activity. If we get a SIGCHLD after the explicit checks for process activity, timeout is the only way we will know. */ - if (read_kbd < 0) + if (read_kbd < 0 && kbd_is_ours ()) set_waiting_for_input (&timeout); /* If status of something has changed, and no input is @@ -5448,7 +5464,7 @@ wait_reading_process_output (intmax_t time_limit, int nsecs, int read_kbd, { clear_waiting_for_input (); redisplay_preserve_echo_area (11); - if (read_kbd < 0) + if (read_kbd < 0 && kbd_is_ours ()) set_waiting_for_input (&timeout); } commit cf94c9902de6fe161f66d6393d89633c8ef31c7e Author: Eli Zaretskii Date: Sat Oct 16 14:00:52 2021 +0300 ; * src/emacs.c (load_pdump): Adjust comment to recent code changes. diff --git a/src/emacs.c b/src/emacs.c index 1f6490fbc0..999690c7e0 100644 --- a/src/emacs.c +++ b/src/emacs.c @@ -928,9 +928,9 @@ load_pdump (int argc, char **argv) path_exec = ns_relocate (path_exec); #endif - /* Look for "emacs.pdmp" in PATH_EXEC. We hardcode "emacs" in - "emacs.pdmp" so that the Emacs binary still works if the user - copies and renames it. */ + /* Look for "emacs-FINGERPRINT.pdmp" in PATH_EXEC. We hardcode + "emacs" in "emacs-FINGERPRINT.pdmp" so that the Emacs binary + still works if the user copies and renames it. */ hexbuf_size = 2 * sizeof fingerprint; hexbuf = xmalloc (hexbuf_size + 1); hexbuf_digest (hexbuf, (char *) fingerprint, sizeof fingerprint); commit 21397cce51dc3f9b6e9b0e7a5cc877b63efa8dd4 Author: Philipp Stephani Date: Sat Oct 16 11:46:49 2021 +0200 Improve documentation string for 'compilation-error-regexp-alist'. * lisp/progmodes/compile.el (compilation-error-regexp-alist): Clarify behavior when TYPE is a cons cell. diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el index 73f9806811..ac26f5e934 100644 --- a/lisp/progmodes/compile.el +++ b/lisp/progmodes/compile.el @@ -662,7 +662,8 @@ has just been matched, and should correspondingly preserve this match data. TYPE is 2 or nil for a real error or 1 for warning or 0 for info. TYPE can also be of the form (WARNING . INFO). In that case this will be equivalent to 1 if the WARNING'th subexpression matched -or else equivalent to 0 if the INFO'th subexpression matched. +or else equivalent to 0 if the INFO'th subexpression matched, +or else equivalent to 2 if neither of them matched. See `compilation-error-face', `compilation-warning-face', `compilation-info-face' and `compilation-skip-threshold'. commit 2971a6890f562dccc2182dd1f802fa47333d496c Author: Andrea Corallo Date: Sat Oct 16 10:55:43 2021 +0200 * lisp/emacs-lisp/comp.el (comp-trampoline-compile): Fix target dir. diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index 7b5c5ad44f..0a10505257 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -3790,7 +3790,8 @@ Return the trampoline if found or nil otherwise." form nil (cl-loop for dir in (if native-compile-target-directory - (list native-compile-target-directory) + (list (expand-file-name comp-native-version-dir + native-compile-target-directory)) (comp-eln-load-path-eff)) for f = (expand-file-name (comp-trampoline-filename subr-name) commit e842d7f29ac6a42e44065a94623b36b2dcbb81eb Author: Eli Zaretskii Date: Sat Oct 16 10:10:06 2021 +0300 Fix removal of fringe indication of bookmarks * lisp/bookmark.el (bookmark--remove-fringe-mark): Fix off-by-one error in looking for bookmark-related overlays. (Bug#51233) diff --git a/lisp/bookmark.el b/lisp/bookmark.el index d64966df5a..fb90f01456 100644 --- a/lisp/bookmark.el +++ b/lisp/bookmark.el @@ -479,7 +479,7 @@ See user option `bookmark-set-fringe'." (dolist (buf (buffer-list)) (with-current-buffer buf (when (equal filename buffer-file-name) - (setq overlays (overlays-in pos pos)) + (setq overlays (overlays-in pos (1+ pos))) (while (and (not found) (setq temp (pop overlays))) (when (eq 'bookmark (overlay-get temp 'category)) (delete-overlay (setq found temp)))))))))) commit e4b99f24f8e8e63cf3d3c1da47d5dc1e6dda61bb Author: Stefan Monnier Date: Sat Oct 16 00:07:03 2021 -0400 * lisp/menu-bar.el (menu-bar-edit-menu): Expose lambdas to the compiler diff --git a/lisp/menu-bar.el b/lisp/menu-bar.el index 1c3b8014e9..6dd1896a29 100644 --- a/lisp/menu-bar.el +++ b/lisp/menu-bar.el @@ -515,10 +515,10 @@ kill-ring)) (not buffer-read-only)))) :help "Paste (yank) text most recently cut/copied" - :keys (lambda () - (if cua-mode - "\\[cua-paste]" - "\\[yank]")))) + :keys ,(lambda () + (if cua-mode + "\\[cua-paste]" + "\\[yank]")))) (bindings--define-key menu [copy] ;; ns-win.el said: Substitute a Copy function that works better ;; under X (for GNUstep). @@ -527,23 +527,23 @@ 'kill-ring-save) :enable mark-active :help "Copy text in region between mark and current position" - :keys (lambda () - (cond - ((featurep 'ns) - "\\[ns-copy-including-secondary]") - ((and cua-mode mark-active) - "\\[cua-copy-handler]") - (t - "\\[kill-ring-save]"))))) + :keys ,(lambda () + (cond + ((featurep 'ns) + "\\[ns-copy-including-secondary]") + ((and cua-mode mark-active) + "\\[cua-copy-handler]") + (t + "\\[kill-ring-save]"))))) (bindings--define-key menu [cut] - '(menu-item "Cut" kill-region + `(menu-item "Cut" kill-region :enable (and mark-active (not buffer-read-only)) :help "Cut (kill) text in region between mark and current position" - :keys (lambda () - (if (and cua-mode mark-active) - "\\[cua-cut-handler]" - "\\[kill-region]")))) + :keys ,(lambda () + (if (and cua-mode mark-active) + "\\[cua-cut-handler]" + "\\[kill-region]")))) ;; ns-win.el said: Separate undo from cut/paste section. (if (featurep 'ns) (bindings--define-key menu [separator-undo] menu-bar-separator)) commit ca3d7234d39fd55e6cd4521e5e583aba12434402 Author: Amin Bandali Date: Fri Oct 15 16:51:59 2021 -0400 Release ERC 5.4.1 * doc/misc/erc.texi (ERCVER): Bump to 5.4.1. * etc/ERC-NEWS: Add entry for 5.4.1 with explanations. * lisp/erc/erc.el (Version, erc-version): Bump to 5.4.1. (customize-package-emacs-version-alist): Add entry for 5.4.1. diff --git a/doc/misc/erc.texi b/doc/misc/erc.texi index 69376df974..3b8e231d3a 100644 --- a/doc/misc/erc.texi +++ b/doc/misc/erc.texi @@ -2,7 +2,7 @@ @c %**start of header @setfilename ../../info/erc.info @settitle ERC Manual -@set ERCVER 5.4 +@set ERCVER 5.4.1 @set ERCDIST as distributed with Emacs @value{EMACSVER} @include docstyle.texi @syncodeindex fn cp diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS index f533c58aa4..31ea3de620 100644 --- a/etc/ERC-NEWS +++ b/etc/ERC-NEWS @@ -11,6 +11,14 @@ This file is about changes in ERC, the powerful, modular, and extensible IRC (Internet Relay Chat) client distributed with GNU Emacs since Emacs version 22.1. + +* Changes in ERC 5.4.1 + +** No user-visible changes since ERC 5.4, but a few tweaks in some ERC +file headers and the ERC manual in order to successfully build ERC for +GNU ELPA. (See below for the news item of ERC now being distributed +on GNU ELPA in addition to its continued inclusion in GNU Emacs core.) + * Changes in ERC 5.4 diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 2a28dafab2..88c105040c 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -12,7 +12,7 @@ ;; David Edmondson (dme@dme.org) ;; Michael Olson (mwolson@gnu.org) ;; Kelvin White (kwhite@gnu.org) -;; Version: 5.4 +;; Version: 5.4.1 ;; Package-Requires: ((emacs "27.1")) ;; Keywords: IRC, chat, client, Internet ;; URL: https://www.gnu.org/software/emacs/erc.html @@ -69,7 +69,7 @@ (require 'iso8601) (eval-when-compile (require 'subr-x)) -(defconst erc-version "5.4" +(defconst erc-version "5.4.1" "This version of ERC.") (defvar erc-official-location @@ -83,7 +83,8 @@ 'customize-package-emacs-version-alist '(ERC ("5.2" . "22.1") ("5.3" . "23.1") - ("5.4" . "28.1"))) + ("5.4" . "28.1") + ("5.4.1" . "29.1"))) (defgroup erc nil "Emacs Internet Relay Chat client." commit b5a0eda978738467eed16b9a530d175c33418362 Author: Stefan Kangas Date: Fri Oct 15 20:22:11 2021 +0200 Prefer "graphical displays" to "X terminals" in documentation * doc/lispref/objects.texi (Ctl-Char Syntax): Fix incorrect remark; some text terminals can generate ASCII control characters. (Other Char Bits): * lisp/bindings.el: * lisp/gnus/gnus-undo.el (gnus-undo-mode-map): Say "graphical display" and "GUI display" instead of "X terminal"; the latter term is archaic. (Bug#51217) diff --git a/doc/lispref/objects.texi b/doc/lispref/objects.texi index 365d5ac8d6..a20343f4c7 100644 --- a/doc/lispref/objects.texi +++ b/doc/lispref/objects.texi @@ -516,9 +516,9 @@ codes for these non-@acronym{ASCII} control characters include the 2**26 @end ifnottex bit as well as the code for the corresponding non-control character. -Ordinary text terminals have no way of generating non-@acronym{ASCII} -control characters, but you can generate them straightforwardly using -X and other window systems. +Not all text terminals can generate non-@acronym{ASCII} control +characters, but it is straightforward to generate them using X and +other window systems. For historical reasons, Emacs treats the @key{DEL} character as the control equivalent of @kbd{?}: @@ -588,8 +588,8 @@ character is upper case or lower case. Emacs uses the 2**25 @end ifnottex bit to indicate that the shift key was used in typing a control -character. This distinction is possible only when you use X terminals -or other special terminals; ordinary text terminals do not report the +character. This distinction is possible only on a graphical display +such as a GUI display on X; text terminals do not report the distinction. The Lisp syntax for the shift bit is @samp{\S-}; thus, @samp{?\C-\S-o} or @samp{?\C-\S-O} represents the shifted-control-o character. diff --git a/lisp/bindings.el b/lisp/bindings.el index 2c45710a58..121e484a0e 100644 --- a/lisp/bindings.el +++ b/lisp/bindings.el @@ -981,7 +981,7 @@ if `inhibit-field-text-motion' is non-nil." (define-key ctl-x-map "\M-:" 'repeat-complex-command) (define-key ctl-x-map "u" 'undo) (put 'undo :advertised-binding [?\C-x ?u]) -;; Many people are used to typing C-/ on X terminals and getting C-_. +;; Many people are used to typing C-/ on GUI frames and getting C-_. (define-key global-map [?\C-/] 'undo) (define-key global-map "\C-_" 'undo) ;; Richard said that we should not use C-x and I have diff --git a/lisp/gnus/gnus-undo.el b/lisp/gnus/gnus-undo.el index 64ed2bbad6..07cf5d495a 100644 --- a/lisp/gnus/gnus-undo.el +++ b/lisp/gnus/gnus-undo.el @@ -81,7 +81,7 @@ "\M-\C-_" gnus-undo "\C-_" gnus-undo "\C-xu" gnus-undo - ;; many people are used to type `C-/' on X terminals and get `C-_'. + ;; Many people are used to type `C-/' on GUI frames and get `C-_'. [(control /)] gnus-undo) map)) commit 4ad0fc0dd08d65978ed8a1637bc1a14c26b41bee Author: Michael Albinus Date: Fri Oct 15 16:29:11 2021 +0200 Precise documentation of file-notify-add-watch * doc/lispref/os.texi (File Notifications): * lisp/filenotify.el (file-notify-add-watch): Precise, that watching a directory includes reports on file changes for some backends. (Bug#51146) diff --git a/doc/lispref/os.texi b/doc/lispref/os.texi index e3297b1be7..db986178dd 100644 --- a/doc/lispref/os.texi +++ b/doc/lispref/os.texi @@ -3124,8 +3124,9 @@ watch for file attribute changes, like permissions or modification time @end table -If @var{file} is a directory, changes for all files in that directory -will be notified. This does not work recursively. +If @var{file} is a directory, @code{change} watches for file creation +or deletion in that directory. Some of the file notification backends +report also file changes. This does not work recursively. When any event happens, Emacs will call the @var{callback} function passing it a single argument @var{event}, which is of the form diff --git a/lisp/filenotify.el b/lisp/filenotify.el index e0dceb704d..271fa27083 100644 --- a/lisp/filenotify.el +++ b/lisp/filenotify.el @@ -390,7 +390,9 @@ include the following symbols: permissions or modification time If FILE is a directory, `change' watches for file creation or -deletion in that directory. This does not work recursively. +deletion in that directory. Some of the file notification +backends report also file changes. This does not work +recursively. When any event happens, Emacs will call the CALLBACK function passing it a single argument EVENT, which is of the form diff --git a/test/lisp/filenotify-tests.el b/test/lisp/filenotify-tests.el index 6125069c6b..9be515ab17 100644 --- a/test/lisp/filenotify-tests.el +++ b/test/lisp/filenotify-tests.el @@ -743,7 +743,7 @@ delivered." ;; the directory. Except for ;; GFam{File,Directory}Monitor, GPollFileMonitor and ;; kqueue. And GFam{File,Directory}Monitor and - ;; GPollFileMonitordo not raise a `changed' event. + ;; GPollFileMonitor do not raise a `changed' event. ((memq (file-notify--test-monitor) '(GFamFileMonitor GFamDirectoryMonitor GPollFileMonitor)) '(created deleted stopped)) commit aa55dd61e10e94733e290f32eae1d02a3535cfcd Author: Michael Albinus Date: Fri Oct 15 16:10:53 2021 +0200 ; Move timeout in gitlab-ci.yml diff --git a/test/infra/gitlab-ci.yml b/test/infra/gitlab-ci.yml index add05110dc..98abd1d2c4 100644 --- a/test/infra/gitlab-ci.yml +++ b/test/infra/gitlab-ci.yml @@ -108,7 +108,7 @@ default: # TODO: with make -j4 several of the tests were failing, for # example shadowfile-tests, but passed without it. - 'export PWD=$(pwd)' - - 'docker run -i -e EMACS_EMBA_CI=${EMACS_EMBA_CI} --timeout 7200 --volumes-from $(docker ps -q -f "label=com.gitlab.gitlab-runner.job.id=${CI_JOB_ID}"):ro --name ${test_name} ${CI_REGISTRY_IMAGE}:${target}-${BUILD_TAG} /bin/bash -c "git fetch ${PWD} HEAD && echo checking out these updated files && git diff --name-only FETCH_HEAD && ( git diff --name-only FETCH_HEAD | xargs git checkout -f FETCH_HEAD ) && make -j4 && timeout -s ABRT 3600s make ${make_params}"' + - 'timeout 7200s docker run -i -e EMACS_EMBA_CI=${EMACS_EMBA_CI} --volumes-from $(docker ps -q -f "label=com.gitlab.gitlab-runner.job.id=${CI_JOB_ID}"):ro --name ${test_name} ${CI_REGISTRY_IMAGE}:${target}-${BUILD_TAG} /bin/bash -c "git fetch ${PWD} HEAD && echo checking out these updated files && git diff --name-only FETCH_HEAD && ( git diff --name-only FETCH_HEAD | xargs git checkout -f FETCH_HEAD ) && make -j4 && timeout -s ABRT 3600s make ${make_params}"' after_script: - docker ps -a - printenv commit 281f34f9de6f3cf7d731630df9d48d384c3d989d Author: Lars Ingebrigtsen Date: Fri Oct 15 14:19:32 2021 +0200 Convert two `easy-mmode-defmap' usages to `defvar-keymap' * lisp/vc/log-edit.el (log-edit-mode-map): * lisp/vc/cvs-status.el (cvs-status-mode-map): Convert `easy-mmode-defmap' to `defvar-keymap'. diff --git a/lisp/vc/cvs-status.el b/lisp/vc/cvs-status.el index 63b886362b..6b49690aa4 100644 --- a/lisp/vc/cvs-status.el +++ b/lisp/vc/cvs-status.el @@ -29,23 +29,22 @@ ;;; Code: (require 'cl-lib) -(require 'pcvs-util) +(require 'pcvs) +(require 'easy-mmode) ;;; -(easy-mmode-defmap cvs-status-mode-map - '(("n" . next-line) - ("p" . previous-line) - ("N" . cvs-status-next) - ("P" . cvs-status-prev) - ("\M-n" . cvs-status-next) - ("\M-p" . cvs-status-prev) - ("t" . cvs-status-cvstrees) - ("T" . cvs-status-trees) - (">" . cvs-mode-checkout)) - "CVS-Status' keymap." - :group 'cvs-status - :inherit 'cvs-mode-map) +(defvar-keymap cvs-status-mode-map + :inherit 'cvs-mode-map + "n" #'next-line + "p" #'previous-line + "N" #'cvs-status-next + "P" #'cvs-status-prev + (kbd "M-n") #'cvs-status-next + (kbd "M-p") #'cvs-status-prev + "t" #'cvs-status-cvstrees + "T" #'cvs-status-trees + ">" #'cvs-mode-checkout) ;;(easy-menu-define cvs-status-menu cvs-status-mode-map ;; "Menu for `cvs-status-mode'." diff --git a/lisp/vc/log-edit.el b/lisp/vc/log-edit.el index 4d151d555c..c8d089e411 100644 --- a/lisp/vc/log-edit.el +++ b/lisp/vc/log-edit.el @@ -54,21 +54,19 @@ (define-obsolete-variable-alias 'vc-log-mode-map 'log-edit-mode-map "28.1") (define-obsolete-variable-alias 'vc-log-entry-mode 'log-edit-mode-map "28.1") -(easy-mmode-defmap log-edit-mode-map - '(("\C-c\C-c" . log-edit-done) - ("\C-c\C-a" . log-edit-insert-changelog) - ("\C-c\C-w" . log-edit-generate-changelog-from-diff) - ("\C-c\C-d" . log-edit-show-diff) - ("\C-c\C-f" . log-edit-show-files) - ("\C-c\C-k" . log-edit-kill-buffer) - ("\C-a" . log-edit-beginning-of-line) - ("\M-n" . log-edit-next-comment) - ("\M-p" . log-edit-previous-comment) - ("\M-r" . log-edit-comment-search-backward) - ("\M-s" . log-edit-comment-search-forward) - ("\C-c?" . log-edit-mode-help)) - "Keymap for the `log-edit-mode' (to edit version control log messages)." - :group 'log-edit) +(defvar-keymap log-edit-mode-map + (kbd "C-c C-c") #'log-edit-done + (kbd "C-c C-a") #'log-edit-insert-changelog + (kbd "C-c C-w") #'log-edit-generate-changelog-from-diff + (kbd "C-c C-d") #'log-edit-show-diff + (kbd "C-c C-f") #'log-edit-show-files + (kbd "C-c C-k") #'log-edit-kill-buffer + (kbd "C-a") #'log-edit-beginning-of-line + (kbd "M-n") #'log-edit-next-comment + (kbd "M-p") #'log-edit-previous-comment + (kbd "M-r") #'log-edit-comment-search-backward + (kbd "M-s") #'log-edit-comment-search-forward + (kbd "C-c ?") #'log-edit-mode-help) (easy-menu-define log-edit-menu log-edit-mode-map "Menu used for `log-edit-mode'." commit 705b07660aa39705baf7c6daef4bce0ee7f7b418 Author: Michael Albinus Date: Fri Oct 15 14:15:28 2021 +0200 ; Fix last change on gitlab-ci.yml diff --git a/test/infra/gitlab-ci.yml b/test/infra/gitlab-ci.yml index 05341bd033..add05110dc 100644 --- a/test/infra/gitlab-ci.yml +++ b/test/infra/gitlab-ci.yml @@ -108,7 +108,7 @@ default: # TODO: with make -j4 several of the tests were failing, for # example shadowfile-tests, but passed without it. - 'export PWD=$(pwd)' - - 'docker run -i -e EMACS_EMBA_CI=${EMACS_EMBA_CI} --timeout=7200 --volumes-from $(docker ps -q -f "label=com.gitlab.gitlab-runner.job.id=${CI_JOB_ID}"):ro --name ${test_name} ${CI_REGISTRY_IMAGE}:${target}-${BUILD_TAG} /bin/bash -c "git fetch ${PWD} HEAD && echo checking out these updated files && git diff --name-only FETCH_HEAD && ( git diff --name-only FETCH_HEAD | xargs git checkout -f FETCH_HEAD ) && make -j4 && timeout -s ABRT 3600s make ${make_params}"' + - 'docker run -i -e EMACS_EMBA_CI=${EMACS_EMBA_CI} --timeout 7200 --volumes-from $(docker ps -q -f "label=com.gitlab.gitlab-runner.job.id=${CI_JOB_ID}"):ro --name ${test_name} ${CI_REGISTRY_IMAGE}:${target}-${BUILD_TAG} /bin/bash -c "git fetch ${PWD} HEAD && echo checking out these updated files && git diff --name-only FETCH_HEAD && ( git diff --name-only FETCH_HEAD | xargs git checkout -f FETCH_HEAD ) && make -j4 && timeout -s ABRT 3600s make ${make_params}"' after_script: - docker ps -a - printenv commit 171de3eee459ed64388a8ced7d07fa031ea025a6 Author: Protesilaos Stavrou Date: Fri Oct 15 14:12:32 2021 +0200 Add new option to rename eww buffers * etc/NEWS: Document the new user options. * lisp/net/eww.el (eww-auto-rename-buffer, eww-buffer-name-length): Add new user options. (eww--rename-buffer): Introduce new function that performs the renaming of buffers. (eww--after-page-change): Add new wrapper function which calls 'eww-update-header-line-format' and 'eww--rename-buffer'. (eww, eww-render, eww-tag-title, eww-readable, eww-restore-history): Include eww--after-page-change. Fix bug#51176. Co-authored-by: Abhiseck Paira Co-authored-by: Protesilaos Stavrou diff --git a/doc/misc/eww.texi b/doc/misc/eww.texi index 2543dc2ff5..7635685e56 100644 --- a/doc/misc/eww.texi +++ b/doc/misc/eww.texi @@ -380,6 +380,14 @@ thus allowing for the use of the usual substitutions, such as @code{\[eww-reload]} for the current key binding of the @code{eww-reload} command. +@vindex eww-auto-rename-buffer + If the @code{eww-auto-rename-buffer} user option is non-@code{nil}, +EWW buffers will be renamed after rendering a document. If this is +@code{title}, rename based on the title of the document. If this is +@code{url}, rename based on the @acronym{URL} of the document. This +can also be a user-defined function, which is called with no +parameters in the EWW buffer, and should return a string. + @node Command Line @chapter Command Line Usage diff --git a/etc/NEWS b/etc/NEWS index 7dd4d14274..2c09d24dde 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -89,6 +89,16 @@ Customize this option to limit the amount of entries in the menu * Changes in Specialized Modes and Packages in Emacs 29.1 +** eww + ++++ +*** New user option to automatically rename EWW buffers. +The 'eww-auto-rename-buffer' user option can be configured to rename +rendered web pages by using their title, URL, or a user-defined +function which returns a string. For the first two cases, the length +of the resulting name is controlled by 'eww-buffer-name-length'. By +default, no automatic renaming is performed. + ** image-dired --- diff --git a/lisp/net/eww.el b/lisp/net/eww.el index 24c6335210..bed458ed8a 100644 --- a/lisp/net/eww.el +++ b/lisp/net/eww.el @@ -178,6 +178,33 @@ the tab bar is enabled." :group 'eww :type 'hook) +(defcustom eww-auto-rename-buffer nil + "Automatically rename EWW buffers once the page is rendered. + +When nil, do not rename the buffer. With a non-nil value +determine the renaming scheme, as follows: + +- `title': Use the web page's title. +- `url': Use the web page's URL. +- a function's symbol: Run a user-defined function that returns a + string with which to rename the buffer. + +The string of `title' and `url' is always truncated to the value +of `eww-buffer-name-length'." + :version "29.1" + :type '(choice + (const :tag "Do not rename buffers (default)" nil) + (const :tag "Rename buffer to web page title" title) + (const :tag "Rename buffer to web page URL" url) + (function :tag "A user-defined function to rename the buffer")) + :group 'eww) + +(defcustom eww-buffer-name-length 40 + "Length of renamed buffer name, per `eww-auto-rename-buffer'." + :type 'natnum + :version "29.1" + :group 'eww) + (defcustom eww-form-checkbox-selected-symbol "[X]" "Symbol used to represent a selected checkbox. See also `eww-form-checkbox-symbol'." @@ -353,7 +380,7 @@ killed after rendering." (setq url (url-recreate-url parsed))) (plist-put eww-data :url url) (plist-put eww-data :title "") - (eww-update-header-line-format) + (eww--after-page-change) (let ((inhibit-read-only t)) (insert (format "Loading %s..." url)) (goto-char (point-min))) @@ -502,6 +529,30 @@ Currently this means either text/html or application/xhtml+xml." (member content-type '("text/html" "application/xhtml+xml"))) +(defun eww--rename-buffer () + "Rename the current EWW buffer. +The renaming scheme is performed in accordance with +`eww-auto-rename-buffer'." + (let ((rename-string) + (formatter + (lambda (string) + (format "*%s # eww*" (truncate-string-to-width + string eww-buffer-name-length)))) + (site-title (plist-get eww-data :title)) + (site-url (plist-get eww-data :url))) + (cond ((null eww-auto-rename-buffer)) + ((eq eww-auto-rename-buffer 'url) + (setq rename-string (funcall formatter site-url))) + ((functionp eww-auto-rename-buffer) + (setq rename-string (funcall eww-auto-rename-buffer))) + (t (setq rename-string + (funcall formatter (if (or (equal site-title "") + (null site-title)) + "Untitled" + site-title))))) + (when rename-string + (rename-buffer rename-string t)))) + (defun eww-render (status url &optional point buffer encode) (let* ((headers (eww-parse-headers)) (content-type @@ -552,7 +603,7 @@ Currently this means either text/html or application/xhtml+xml." (eww-display-raw buffer (or encode charset 'utf-8)))) (with-current-buffer buffer (plist-put eww-data :url url) - (eww-update-header-line-format) + (eww--after-page-change) (setq eww-history-position 0) (and last-coding-system-used (set-buffer-file-coding-system last-coding-system-used)) @@ -796,12 +847,16 @@ Currently this means either text/html or application/xhtml+xml." `((?u . ,(or url "")) (?t . ,title)))))))) +(defun eww--after-page-change () + (eww-update-header-line-format) + (eww--rename-buffer)) + (defun eww-tag-title (dom) (plist-put eww-data :title (replace-regexp-in-string "^ \\| $" "" (replace-regexp-in-string "[ \t\r\n]+" " " (dom-text dom)))) - (eww-update-header-line-format)) + (eww--after-page-change)) (defun eww-display-raw (buffer &optional encode) (let ((data (buffer-substring (point) (point-max)))) @@ -929,7 +984,7 @@ the like." nil (current-buffer)) (dolist (elem '(:source :url :title :next :previous :up)) (plist-put eww-data elem (plist-get old-data elem))) - (eww-update-header-line-format))) + (eww--after-page-change))) (defun eww-score-readability (node) (let ((score -1)) @@ -1161,7 +1216,7 @@ instead of `browse-url-new-window-flag'." (goto-char (plist-get elem :point)) ;; Make buffer listings more informative. (setq list-buffers-directory (plist-get elem :url)) - (eww-update-header-line-format)))) + (eww--after-page-change)))) (defun eww-next-url () "Go to the page marked `next'. commit 7dedba1cc02055befa097f8782cda108f4af08c6 Author: Dmitry Gutov Date: Fri Oct 15 15:02:23 2021 +0300 Special-case the "Permission denied" messages * lisp/progmodes/project.el (project--files-in-directory): Special-case the "Permission denied" messages, to make sure the user sees the unreadable directory's name (https://lists.gnu.org/archive/html/emacs-devel/2021-10/msg01015.html). diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el index 79d2e050d9..ed076a683d 100644 --- a/lisp/progmodes/project.el +++ b/lisp/progmodes/project.el @@ -322,7 +322,15 @@ to find the list of ignores for each directory." (process-file-shell-command command nil t)) (pt (point-min))) (unless (zerop status) - (error "File listing failed: %s" (buffer-string))) + (goto-char (point-min)) + (if (and + (not (eql status 127)) + (search-forward "Permission denied\n" nil t)) + (let ((end (1- (point)))) + (re-search-backward "\\`\\|\0") + (error "File listing failed: %s" + (buffer-substring (1+ (point)) end))) + (error "File listing failed: %s" (buffer-string)))) (goto-char pt) (while (search-forward "\0" nil t) (push (buffer-substring-no-properties (1+ pt) (1- (point))) commit 5757b6b20422096de3f4c34e06e8c3b6252d6d85 Author: Mattias Engdegård Date: Fri Oct 15 12:04:02 2021 +0200 Calc: mend math-nth-root-float (bug#51209) Reported by Iñaki Cornejo. * lisp/calc/calc-math.el (math-nth-root-float): Fix old refactoring mistake. * test/lisp/calc/calc-tests.el (calc-nth-root): New test. diff --git a/lisp/calc/calc-math.el b/lisp/calc/calc-math.el index 1c2e7bcf2b..ba2b6b2ca9 100644 --- a/lisp/calc/calc-math.el +++ b/lisp/calc/calc-math.el @@ -618,8 +618,9 @@ If this can't be done, return NIL." (defun math-nth-root-float (a nrf-n &optional guess) (math-inexact-result) (math-with-extra-prec 1 - (let ((math-nrf-nf (math-float nrf-n)) - (math-nrf-nfm1 (math-float (1- nrf-n)))) + (let ((math-nrf-n nrf-n) + (math-nrf-nf (math-float nrf-n)) + (math-nrf-nfm1 (math-float (1- nrf-n)))) (math-nth-root-float-iter a (or guess (math-make-float 1 (/ (+ (math-numdigs (nth 1 a)) diff --git a/test/lisp/calc/calc-tests.el b/test/lisp/calc/calc-tests.el index 8a78a06824..3eb6b34c13 100644 --- a/test/lisp/calc/calc-tests.el +++ b/test/lisp/calc/calc-tests.el @@ -810,6 +810,12 @@ An existing calc stack is reused, otherwise a new one is created." (should (equal (calcFunc-test6 3) (* (* 3 2) (- 3 1)))) (should (equal (calcFunc-test7 3) (* 3 2)))) +(ert-deftest calc-nth-root () + ;; bug#51209 + (let* ((calc-display-working-message nil) + (x (calc-tests--calc-to-number (math-pow 8 '(frac 1 6))))) + (should (< (abs (- x (sqrt 2.0))) 1.0e-10)))) + (provide 'calc-tests) ;;; calc-tests.el ends here commit d8d71cef9e7b653dbbb0e89ab24eab45e756ed49 Author: Michael Albinus Date: Fri Oct 15 11:01:55 2021 +0200 Further gitlab-ci.yml changes * test/infra/gitlab-ci.yml (.job-template): Add --timeout. (.test-template): Adapt artifact paths. diff --git a/test/infra/gitlab-ci.yml b/test/infra/gitlab-ci.yml index 9c7beea9d4..05341bd033 100644 --- a/test/infra/gitlab-ci.yml +++ b/test/infra/gitlab-ci.yml @@ -108,7 +108,7 @@ default: # TODO: with make -j4 several of the tests were failing, for # example shadowfile-tests, but passed without it. - 'export PWD=$(pwd)' - - 'docker run -i -e EMACS_EMBA_CI=${EMACS_EMBA_CI} --volumes-from $(docker ps -q -f "label=com.gitlab.gitlab-runner.job.id=${CI_JOB_ID}"):ro --name ${test_name} ${CI_REGISTRY_IMAGE}:${target}-${BUILD_TAG} /bin/bash -c "git fetch ${PWD} HEAD && echo checking out these updated files && git diff --name-only FETCH_HEAD && ( git diff --name-only FETCH_HEAD | xargs git checkout -f FETCH_HEAD ) && make -j4 && timeout -s ABRT 3600s make ${make_params}"' + - 'docker run -i -e EMACS_EMBA_CI=${EMACS_EMBA_CI} --timeout=7200 --volumes-from $(docker ps -q -f "label=com.gitlab.gitlab-runner.job.id=${CI_JOB_ID}"):ro --name ${test_name} ${CI_REGISTRY_IMAGE}:${target}-${BUILD_TAG} /bin/bash -c "git fetch ${PWD} HEAD && echo checking out these updated files && git diff --name-only FETCH_HEAD && ( git diff --name-only FETCH_HEAD | xargs git checkout -f FETCH_HEAD ) && make -j4 && timeout -s ABRT 3600s make ${make_params}"' after_script: - docker ps -a - printenv @@ -116,7 +116,6 @@ default: - test -n "$(docker ps -aq -f name=${test_name})" && docker cp ${test_name}:checkout/test ${test_name} - test -n "$(docker ps -aq -f name=${test_name})" && docker rm ${test_name} - ls -alR ${test_name} - - docker ps -a .build-template: needs: [] @@ -159,8 +158,9 @@ default: public: true expire_in: 1 week paths: - - "**.log" - - "**core" + - ${test_name}/**/*.log + - ${test_name}/**/core + - ${test_name}/core when: always .gnustep-template: commit e16974a10d95d9496cbe1003ff4319b953176661 Author: Martin Rudalics Date: Fri Oct 15 10:28:15 2021 +0200 Simplify functions dealing with preserving the size of windows * lisp/window.el (window--preservable-size): Remove function. (window-preserve-size, window-preserved-size) (window--preserve-size): Simplify. Use 'window-body-height' etc. instead of 'window--preservable-size'. diff --git a/lisp/window.el b/lisp/window.el index 20c662c23f..bc0ccd72a0 100644 --- a/lisp/window.el +++ b/lisp/window.el @@ -1514,21 +1514,11 @@ Emacs won't change the size of any window displaying that buffer, unless it has no other choice (like when deleting a neighboring window).") -(defun window--preservable-size (window &optional horizontal) - "Return height of WINDOW as `window-preserve-size' would preserve it. -Optional argument HORIZONTAL non-nil means to return the width of -WINDOW as `window-preserve-size' would preserve it." - (if horizontal - (window-body-width window t) - (+ (window-body-height window t) - (window-header-line-height window) - (window-mode-line-height window)))) - (defun window-preserve-size (&optional window horizontal preserve) - "Preserve height of window WINDOW. + "Preserve height of specified WINDOW's body. WINDOW must be a live window and defaults to the selected one. -Optional argument HORIZONTAL non-nil means preserve the width of -WINDOW. +Optional argument HORIZONTAL non-nil means to preserve the width +of WINDOW's body. PRESERVE t means to preserve the current height/width of WINDOW's body in frame and window resizing operations whenever possible. @@ -1545,21 +1535,15 @@ WINDOW as argument also removes the respective restraint. Other values of PRESERVE are reserved for future use." (setq window (window-normalize-window window t)) (let* ((parameter (window-parameter window 'window-preserved-size)) - (width (nth 1 parameter)) - (height (nth 2 parameter))) - (if horizontal - (set-window-parameter - window 'window-preserved-size - (list - (window-buffer window) - (and preserve (window--preservable-size window t)) - height)) - (set-window-parameter - window 'window-preserved-size - (list - (window-buffer window) - width - (and preserve (window--preservable-size window))))))) + (width (if horizontal + (and preserve (window-body-width window t)) + (nth 1 parameter))) + (height (if horizontal + (nth 2 parameter) + (and preserve (window-body-height window t))))) + (set-window-parameter + window 'window-preserved-size + (list (window-buffer window) width height)))) (defun window-preserved-size (&optional window horizontal) "Return preserved height of window WINDOW. @@ -1567,12 +1551,9 @@ WINDOW must be a live window and defaults to the selected one. Optional argument HORIZONTAL non-nil means to return preserved width of WINDOW." (setq window (window-normalize-window window t)) - (let* ((parameter (window-parameter window 'window-preserved-size)) - (buffer (nth 0 parameter)) - (width (nth 1 parameter)) - (height (nth 2 parameter))) - (when (eq buffer (window-buffer window)) - (if horizontal width height)))) + (let ((parameter (window-parameter window 'window-preserved-size))) + (when (eq (nth 0 parameter) (window-buffer window)) + (nth (if horizontal 1 2) parameter)))) (defun window--preserve-size (window horizontal) "Return non-nil when the height of WINDOW shall be preserved. @@ -1580,7 +1561,7 @@ Optional argument HORIZONTAL non-nil means to return non-nil when the width of WINDOW shall be preserved." (let ((size (window-preserved-size window horizontal))) (and (numberp size) - (= size (window--preservable-size window horizontal))))) + (= size (window-body-size window horizontal t))))) (defun window-safe-min-size (&optional window horizontal pixelwise) "Return safe minimum size of WINDOW. commit f5b8df14c6d9c906eed548c694f23e5abcf6e403 Author: Martin Rudalics Date: Fri Oct 15 10:21:05 2021 +0200 Fixes to account for windows' tab lines * doc/lispref/display.texi (Size of Displayed Text): Fix entry on 'window-text-pixel-size'. * lisp/window.el (window--dump-window): Dump tab-line-height and scroll-bar-height too. (window--min-size-1): Take 'window-tab-line-height' into account. * src/xdisp.c (Fwindow_text_pixel_size): Fix doc-string of 'window-text-pixel-size'. Rename last argument to 'MODE-LINES'. diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi index 2ae04a8521..4500795e45 100644 --- a/doc/lispref/display.texi +++ b/doc/lispref/display.texi @@ -2050,7 +2050,7 @@ displayed in a given window. This function is used by (@pxref{Resizing Windows}) to make a window exactly as large as the text it contains. -@defun window-text-pixel-size &optional window from to x-limit y-limit mode-and-header-line +@defun window-text-pixel-size &optional window from to x-limit y-limit mode-lines This function returns the size of the text of @var{window}'s buffer in pixels. @var{window} must be a live window and defaults to the selected one. The return value is a cons of the maximum pixel-width @@ -2092,12 +2092,12 @@ calculating the pixel-height of a large buffer can take some time, it makes sense to specify this argument; in particular, if the caller does not know the size of the buffer. -The optional argument @var{mode-and-header-line} @code{nil} or omitted -means to not include the height of the mode- or header-line of -@var{window} in the return value. If it is either the symbol -@code{mode-line} or @code{header-line}, include only the height of that +The optional argument @var{mode-lines} @code{nil} or omitted means to +not include the height of the mode-, tab- or header-line of @var{window} +in the return value. If it is either the symbol @code{mode-line}, +@code{tab-line} or @code{header-line}, include only the height of that line, if present, in the return value. If it is @code{t}, include the -height of both, if present, in the return value. +height of all of these lines, if present, in the return value. @end defun @code{window-text-pixel-size} treats the text displayed in a window as a diff --git a/lisp/window.el b/lisp/window.el index 971264b634..d12232641e 100644 --- a/lisp/window.el +++ b/lisp/window.el @@ -1407,9 +1407,12 @@ before writing to it." (cadr fringes) (window-scroll-bar-width window) (window-right-divider-width window)) - (format "height header-line: %s mode-line: %s divider: %s\n" + (format "height tab-line: %s header-line: %s mode-line: %s\n" + (window-tab-line-height window) (window-header-line-height window) - (window-mode-line-height window) + (window-mode-line-height window)) + (format "height scroll-bar: %s divider: %s" + (window-scroll-bar-height window) (window-bottom-divider-width window))))) (insert "\n"))) @@ -1691,6 +1694,7 @@ return the minimum pixel-size of WINDOW." ((let ((char-size (frame-char-size window)) (pixel-height (+ (window-safe-min-size window nil t) + (window-tab-line-height window) (window-header-line-height window) (window-scroll-bar-height window) (window-mode-line-height window) diff --git a/src/xdisp.c b/src/xdisp.c index d8aff5084c..40d578ae9a 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -10661,13 +10661,13 @@ position specified by TO. Since calculating the text height of a large buffer can take some time, it makes sense to specify this argument if the size of the buffer is large or unknown. -Optional argument MODE-AND-HEADER-LINE nil or omitted means do not -include the height of the mode- or header-line of WINDOW in the return -value. If it is either the symbol `mode-line' or `header-line', include +Optional argument MODE-LINES nil or omitted means do not include the +height of the mode-, tab- or header-line of WINDOW in the return value. +If it is the symbol `mode-line', 'tab-line' or `header-line', include only the height of that line, if present, in the return value. If t, -include the height of both, if present, in the return value. */) +include the height of any of these, if present, in the return value. */) (Lisp_Object window, Lisp_Object from, Lisp_Object to, Lisp_Object x_limit, - Lisp_Object y_limit, Lisp_Object mode_and_header_line) + Lisp_Object y_limit, Lisp_Object mode_lines) { struct window *w = decode_live_window (window); Lisp_Object buffer = w->contents; @@ -10841,18 +10841,15 @@ include the height of both, if present, in the return value. */) if (y > max_y) y = max_y; - if (EQ (mode_and_header_line, Qtab_line) - || EQ (mode_and_header_line, Qt)) + if (EQ (mode_lines, Qtab_line) || EQ (mode_lines, Qt)) /* Re-add height of tab-line as requested. */ y = y + WINDOW_TAB_LINE_HEIGHT (w); - if (EQ (mode_and_header_line, Qheader_line) - || EQ (mode_and_header_line, Qt)) + if (EQ (mode_lines, Qheader_line) || EQ (mode_lines, Qt)) /* Re-add height of header-line as requested. */ y = y + WINDOW_HEADER_LINE_HEIGHT (w); - if (EQ (mode_and_header_line, Qmode_line) - || EQ (mode_and_header_line, Qt)) + if (EQ (mode_lines, Qmode_line) || EQ (mode_lines, Qt)) /* Add height of mode-line as requested. */ y = y + WINDOW_MODE_LINE_HEIGHT (w); commit ced72b6e4c03c75e99e828410c363eefd80fbf54 Author: Andrea Corallo Date: Fri Oct 15 09:26:24 2021 +0200 * Fix `native-compile-target-directory' effectiveness on trampolines * lisp/emacs-lisp/comp.el (comp-trampoline-compile): Fix `native-compile-target-directory' effectiveness on trampoline compilation. diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index 0e4e54b76b..7b5c5ad44f 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -3789,7 +3789,9 @@ Return the trampoline if found or nil otherwise." (comp--native-compile form nil (cl-loop - for dir in (comp-eln-load-path-eff) + for dir in (if native-compile-target-directory + (list native-compile-target-directory) + (comp-eln-load-path-eff)) for f = (expand-file-name (comp-trampoline-filename subr-name) dir) commit 502788bc3d9cd2f95427114dbb243c62a27edb2b Author: Jan Synacek Date: Fri Oct 15 08:20:40 2021 +0200 Add missing single quotes in the Emacs manual * lisp/mwheel.el (mouse-wheel-scroll-amount): Add missing single quotes. (Bug#51223) Copyright-paperwork-exempt: yes. diff --git a/lisp/mwheel.el b/lisp/mwheel.el index def7758774..51410e3ef4 100644 --- a/lisp/mwheel.el +++ b/lisp/mwheel.el @@ -103,7 +103,7 @@ less than a full screen. If AMOUNT is the symbol 'hscroll', this means that with MODIFIER, the mouse wheel will scroll horizontally instead of vertically. -If AMOUNT is the symbol text-scale, this means that with +If AMOUNT is the symbol 'text-scale', this means that with MODIFIER, the mouse wheel will change the face height instead of scrolling." :group 'mouse commit 1af45ad04ef1755ada0483957018889dcf0f9207 Author: Andrea Corallo Date: Fri Oct 15 09:18:54 2021 +0200 ; * lisp/emacs-lisp/comp.el (comp-trampoline-compile): Fix comment. diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index 0052fd0f8d..0e4e54b76b 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -3781,8 +3781,8 @@ Return the trampoline if found or nil otherwise." for arg in lambda-list unless (memq arg '(&optional &rest)) collect arg))))) - ;; Use speed 0 to maximize compilation speed and not to - ;; optimize away funcall calls! + ;; Use speed 1 for compilation speed and not to optimize away + ;; funcall calls! (byte-optimize nil) (native-comp-speed 1) (lexical-binding t)) commit 12654b74236b914f571f173689b0ac87247d0f24 Author: Juri Linkov Date: Fri Oct 15 09:58:29 2021 +0300 * lisp/menu-bar.el (yank-menu-length): Fix docstring (bug#51138). diff --git a/lisp/help-fns.el b/lisp/help-fns.el index 03bbc979a9..2b759a5a5c 100644 --- a/lisp/help-fns.el +++ b/lisp/help-fns.el @@ -823,7 +823,7 @@ Returns a list of the form (REAL-FUNCTION DEF ALIASED REAL-DEF)." ;; Advised & aliased function. (and advised (symbolp real-function) (not (eq 'autoload (car-safe def)))) - (and (subrp def) + (and (subrp def) (symbolp function) (not (string= (subr-name def) (symbol-name function))))))) (real-def (cond diff --git a/lisp/menu-bar.el b/lisp/menu-bar.el index b2577c085f..1cc126b501 100644 --- a/lisp/menu-bar.el +++ b/lisp/menu-bar.el @@ -2159,7 +2159,7 @@ otherwise it could decide to silently do nothing." (> count 1))) (defcustom yank-menu-length 20 - "Maximum length to display in the `yank-menu'." + "Text of items in `yank-menu' longer than this will be truncated." :type 'integer :group 'menu) commit 88bd6fccf15065defd7b9e9afdf44a61c5c6eee7 Author: Amin Bandali Date: Thu Oct 14 22:02:02 2021 -0400 * doc/misc/erc.texi: Add 'ERCVER' and 'ERCDIST'. To mention the ERC version in the manual, and to allow for more easily overriding the distribution description when building for GNU ELPA. diff --git a/doc/misc/erc.texi b/doc/misc/erc.texi index 10ced678e1..69376df974 100644 --- a/doc/misc/erc.texi +++ b/doc/misc/erc.texi @@ -2,13 +2,15 @@ @c %**start of header @setfilename ../../info/erc.info @settitle ERC Manual +@set ERCVER 5.4 +@set ERCDIST as distributed with Emacs @value{EMACSVER} @include docstyle.texi @syncodeindex fn cp @include emacsver.texi @c %**end of header @copying -This manual is for ERC as distributed with Emacs @value{EMACSVER}. +This manual is for ERC @value{ERCVER} @value{ERCDIST}. Copyright @copyright{} 2005--2021 Free Software Foundation, Inc. commit 86f08fb377e2b8f2df0614c48783bdce347f3758 Author: Wilson Snyder Date: Thu Oct 14 21:36:59 2021 -0400 ; verilog-mode.el documentation and regexp cleanup from upstream. diff --git a/lisp/progmodes/verilog-mode.el b/lisp/progmodes/verilog-mode.el index 3dd9a5efc1..14f252b42d 100644 --- a/lisp/progmodes/verilog-mode.el +++ b/lisp/progmodes/verilog-mode.el @@ -9,7 +9,7 @@ ;; Keywords: languages ;; The "Version" is the date followed by the decimal rendition of the Git ;; commit hex. -;; Version: 2021.09.23.089128420 +;; Version: 2021.10.14.127365406 ;; Yoni Rabkin contacted the maintainer of this ;; file on 19/3/2008, and the maintainer agreed that when a bug is @@ -124,7 +124,7 @@ ;; ;; This variable will always hold the version number of the mode -(defconst verilog-mode-version "2021-09-23-54ffde4-vpo-GNU" +(defconst verilog-mode-version "2021-10-14-797711e-vpo-GNU" "Version of this Verilog mode.") (defconst verilog-mode-release-emacs t "If non-nil, this version of Verilog mode was released with Emacs itself.") @@ -1264,7 +1264,9 @@ See `verilog-auto-inst-param-value'." Also affects AUTOINSTPARAM. Declaration order is the default for backward compatibility, and as some teams prefer signals that are declared together to remain together. Sorted order reduces -changes when declarations are moved around in a file. +changes when declarations are moved around in a file. Sorting is +within input/output/inout groupings, there is intentionally no +option to intermix between input/output/inouts. See also `verilog-auto-arg-sort'." :version "24.1" ; rev688 @@ -6601,7 +6603,8 @@ Also move point to constraint." (equal (char-before) ?\;) (equal (char-before) ?\})) ;; skip what looks like bus repetition operator {#{ - (not (string-match "^{\\s-*[\\(\\)0-9a-zA-Z_]*\\s-*{" (buffer-substring p (point))))))))) + (not (string-match "^{\\s-*[()0-9a-zA-Z_\\]*\\s-*{" + (buffer-substring p (point))))))))) (progn (let ( (pt (point)) (pass 0)) (verilog-backward-ws&directives) commit 8785d70601c5ef02f20604dc3cd85d6c73d7aef7 Author: Lars Ingebrigtsen Date: Thu Oct 14 20:11:51 2021 +0200 Use `define-keymap' in log-view.el * lisp/vc/log-view.el (log-view-mode-map): Convert a `easy-mmode-defmap' to `define-keymap'. diff --git a/lisp/vc/log-view.el b/lisp/vc/log-view.el index c2f008fc47..2c78000e38 100644 --- a/lisp/vc/log-view.el +++ b/lisp/vc/log-view.el @@ -110,6 +110,7 @@ ;;; Code: (require 'pcvs-util) +(require 'easy-mmode) (autoload 'vc-find-revision "vc") (autoload 'vc-diff-internal "vc") @@ -121,39 +122,23 @@ :group 'pcl-cvs :prefix "log-view-") -(easy-mmode-defmap log-view-mode-map - '( - ("-" . negative-argument) - ("0" . digit-argument) - ("1" . digit-argument) - ("2" . digit-argument) - ("3" . digit-argument) - ("4" . digit-argument) - ("5" . digit-argument) - ("6" . digit-argument) - ("7" . digit-argument) - ("8" . digit-argument) - ("9" . digit-argument) - - ("\C-m" . log-view-toggle-entry-display) - ("m" . log-view-toggle-mark-entry) - ("e" . log-view-modify-change-comment) - ("d" . log-view-diff) - ("=" . log-view-diff) - ("D" . log-view-diff-changeset) - ("a" . log-view-annotate-version) - ("f" . log-view-find-revision) - ("n" . log-view-msg-next) - ("p" . log-view-msg-prev) - ("\t" . log-view-msg-next) - ([backtab] . log-view-msg-prev) - ("N" . log-view-file-next) - ("P" . log-view-file-prev) - ("\M-n" . log-view-file-next) - ("\M-p" . log-view-file-prev)) - "Log-View's keymap." - :inherit special-mode-map - :group 'log-view) +(defvar-keymap log-view-mode-map + (kbd "RET") #'log-view-toggle-entry-display + "m" #'log-view-toggle-mark-entry + "e" #'log-view-modify-change-comment + "d" #'log-view-diff + "=" #'log-view-diff + "D" #'log-view-diff-changeset + "a" #'log-view-annotate-version + "f" #'log-view-find-revision + "n" #'log-view-msg-next + "p" #'log-view-msg-prev + (kbd "TAB") #'log-view-msg-next + (kbd "") #'log-view-msg-prev + "N" #'log-view-file-next + "P" #'log-view-file-prev + (kbd "M-n") #'log-view-file-next + (kbd "M-p") #'log-view-file-prev) (easy-menu-define log-view-mode-menu log-view-mode-map "Log-View Display Menu." commit 732666b86ec7c415a4d7246db3e9709a95bebf95 Author: Lars Ingebrigtsen Date: Thu Oct 14 19:53:00 2021 +0200 define-key doc string improvement * src/keymap.c (Fdefine_key): Explain what the STRING is used for. (local-set-key "\C-c\C-c" (define-keymap :name "Zot" "a" '("foo" . ignore) "b" '("gazonk" . ignore))) diff --git a/src/keymap.c b/src/keymap.c index be45d2be1e..5324f7f021 100644 --- a/src/keymap.c +++ b/src/keymap.c @@ -1047,7 +1047,9 @@ DEF is anything that can be a key's definition: function definition, which should at that time be one of the above, or another symbol whose function definition is used, etc.), a cons (STRING . DEFN), meaning that DEFN is the definition - (DEFN should be a valid definition in its own right), + (DEFN should be a valid definition in its own right) and + STRING is the menu item name (which is used only if the containing + keymap has been created with a menu name, see `make-keymap'), or a cons (MAP . CHAR), meaning use definition of CHAR in keymap MAP, or an extended menu item definition. (See info node `(elisp)Extended Menu Items'.) commit 40f20109711db5747da982e118a4497235351544 Author: Michael Albinus Date: Thu Oct 14 19:38:53 2021 +0200 ; Instrument gitlab-ci.yml diff --git a/test/infra/gitlab-ci.yml b/test/infra/gitlab-ci.yml index b7bb93d45b..9c7beea9d4 100644 --- a/test/infra/gitlab-ci.yml +++ b/test/infra/gitlab-ci.yml @@ -110,11 +110,13 @@ default: - 'export PWD=$(pwd)' - 'docker run -i -e EMACS_EMBA_CI=${EMACS_EMBA_CI} --volumes-from $(docker ps -q -f "label=com.gitlab.gitlab-runner.job.id=${CI_JOB_ID}"):ro --name ${test_name} ${CI_REGISTRY_IMAGE}:${target}-${BUILD_TAG} /bin/bash -c "git fetch ${PWD} HEAD && echo checking out these updated files && git diff --name-only FETCH_HEAD && ( git diff --name-only FETCH_HEAD | xargs git checkout -f FETCH_HEAD ) && make -j4 && timeout -s ABRT 3600s make ${make_params}"' after_script: - # - docker ps -a - # - printenv - # - test -n "$(docker ps -aq -f name=${test_name})" && ( docker export ${test_name} | tar -tvf - ) + - docker ps -a + - printenv + - test -n "$(docker ps -aq -f name=${test_name})" && ( docker export ${test_name} | tar -tvf - ) - test -n "$(docker ps -aq -f name=${test_name})" && docker cp ${test_name}:checkout/test ${test_name} - test -n "$(docker ps -aq -f name=${test_name})" && docker rm ${test_name} + - ls -alR ${test_name} + - docker ps -a .build-template: needs: [] commit a6dea09a15549d4091d6a4f2e764074195847276 Merge: 64f9fdc812 9ff6999a06 Author: Glenn Morris Date: Thu Oct 14 07:50:29 2021 -0700 Merge from origin/emacs-28 9ff6999a06 (origin/emacs-28) Accept process-filter t in Tramp cf95962092 ; * doc/lispref/processes.texi (Filter Functions): Fix las... 1ad4ad0c11 Document the t value for set-process-filter in the manual b014efa1e5 * doc/misc/tramp.texi (Frequently Asked Questions): Add re... b9b78b2631 Fix Help functions for clicks on tool bar and tab bar 74deafe921 ; * etc/DEBUG: Add a section about debugging native-compil... 8153f70b9c In make_lispy_position fix Bug#50993 in rudimentary fashion 0aa52e94f3 Mark vc-switch-backend as obsolete 568e479c59 Add missing parentheses in the Emacs manual 44ce50b0df Improve tooltip of mode-line-position again 9b1adf8b4f Use browse-url-button-regexp for rcirc-url-regexp 9ed53b022d * lisp/help.el (help--analyze-key): Avoid mouse-set-point ... # Conflicts: # etc/NEWS commit 9ff6999a060244c7726752f5cb07e8c8d1218f41 Author: Michael Albinus Date: Thu Oct 14 14:32:47 2021 +0200 Accept process-filter t in Tramp * lisp/net/tramp.el (tramp-handle-make-process): * lisp/net/tramp-adb.el (tramp-adb-handle-make-process): * lisp/net/tramp-sh.el (tramp-sh-handle-make-process): Filter can be t. * test/lisp/net/tramp-tests.el (tramp-test29-start-file-process) (tramp-test30-make-process): Test filter equal t. diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el index 63ffb2d057..6d8bed1d78 100644 --- a/lisp/net/tramp-adb.el +++ b/lisp/net/tramp-adb.el @@ -947,7 +947,7 @@ implementation will be used." (setq connection-type 'pty)) (unless (memq connection-type '(nil pipe pty)) (signal 'wrong-type-argument (list #'symbolp connection-type))) - (unless (or (null filter) (functionp filter)) + (unless (or (null filter) (eq filter t) (functionp filter)) (signal 'wrong-type-argument (list #'functionp filter))) (unless (or (null sentinel) (functionp sentinel)) (signal 'wrong-type-argument (list #'functionp sentinel))) diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 8fa53cb5a2..6984dd8b42 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -2785,7 +2785,7 @@ implementation will be used." (setq connection-type 'pty)) (unless (memq connection-type '(nil pipe pty)) (signal 'wrong-type-argument (list #'symbolp connection-type))) - (unless (or (null filter) (functionp filter)) + (unless (or (null filter) (eq filter t) (functionp filter)) (signal 'wrong-type-argument (list #'functionp filter))) (unless (or (null sentinel) (functionp sentinel)) (signal 'wrong-type-argument (list #'functionp sentinel))) diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index a8ae71b147..318b4e454d 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -4141,7 +4141,7 @@ substitution. SPEC-LIST is a list of char/value pairs used for (setq connection-type 'pty)) (unless (memq connection-type '(nil pipe pty)) (signal 'wrong-type-argument (list #'symbolp connection-type))) - (unless (or (null filter) (functionp filter)) + (unless (or (null filter) (eq filter t) (functionp filter)) (signal 'wrong-type-argument (list #'functionp filter))) (unless (or (null sentinel) (functionp sentinel)) (signal 'wrong-type-argument (list #'functionp sentinel))) diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index ebedbaf45f..da15401be0 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -4562,6 +4562,24 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." ;; Cleanup. (ignore-errors (delete-process proc))) + (unwind-protect + (with-temp-buffer + (setq proc (start-file-process "test3" (current-buffer) "cat")) + (should (processp proc)) + (should (equal (process-status proc) 'run)) + (set-process-filter proc t) + (process-send-string proc "foo\n") + (process-send-eof proc) + ;; Read output. + (with-timeout (10 (tramp--test-timeout-handler)) + (while (process-live-p proc) + (while (accept-process-output proc 0 nil t)))) + ;; No output due to process filter. + (should (= (point-min) (point-max)))) + + ;; Cleanup. + (ignore-errors (delete-process proc))) + ;; Process connection type. (when (and (tramp--test-sh-p) (not (tramp-direct-async-process-p)) @@ -4735,6 +4753,28 @@ If UNSTABLE is non-nil, the test is tagged as `:unstable'." ;; Cleanup. (ignore-errors (delete-process proc))) + (unwind-protect + (with-temp-buffer + (setq proc + (with-no-warnings + (make-process + :name "test3" :buffer (current-buffer) :command '("cat") + :filter t + :file-handler t))) + (should (processp proc)) + (should (equal (process-status proc) 'run)) + (process-send-string proc "foo\n") + (process-send-eof proc) + ;; Read output. + (with-timeout (10 (tramp--test-timeout-handler)) + (while (process-live-p proc) + (while (accept-process-output proc 0 nil t)))) + ;; No output due to process filter. + (should (= (point-min) (point-max)))) + + ;; Cleanup. + (ignore-errors (delete-process proc))) + ;; Process sentinel. (unwind-protect (with-temp-buffer commit cf95962092bebbe623180b5480c4876a6860f44e Author: Eli Zaretskii Date: Thu Oct 14 14:51:04 2021 +0300 ; * doc/lispref/processes.texi (Filter Functions): Fix last change. diff --git a/doc/lispref/processes.texi b/doc/lispref/processes.texi index 0aa7b39f12..8a9cb2a8f8 100644 --- a/doc/lispref/processes.texi +++ b/doc/lispref/processes.texi @@ -1783,7 +1783,8 @@ This function gives @var{process} the filter function @var{filter}. If @var{filter} is @code{nil}, it gives the process the default filter, which inserts the process output into the process buffer. If @var{filter} is @code{t}, Emacs stops accepting output from the -process. +process, unless it's a network server process that listens for +incoming connections. @end defun @defun process-filter process commit 1ad4ad0c11ce6e1f4663f611334792aec86308f1 Author: Lars Ingebrigtsen Date: Thu Oct 14 13:10:00 2021 +0200 Document the t value for set-process-filter in the manual * doc/lispref/processes.texi (Filter Functions): Mention what t means (bug#51177). diff --git a/doc/lispref/processes.texi b/doc/lispref/processes.texi index d90097d0b0..0aa7b39f12 100644 --- a/doc/lispref/processes.texi +++ b/doc/lispref/processes.texi @@ -1779,9 +1779,11 @@ or more batches of output; one way to do this is to insert the received text into a temporary buffer, which can then be searched. @defun set-process-filter process filter -This function gives @var{process} the filter function @var{filter}. If -@var{filter} is @code{nil}, it gives the process the default filter, -which inserts the process output into the process buffer. +This function gives @var{process} the filter function @var{filter}. +If @var{filter} is @code{nil}, it gives the process the default +filter, which inserts the process output into the process buffer. If +@var{filter} is @code{t}, Emacs stops accepting output from the +process. @end defun @defun process-filter process commit b014efa1e5bbec13d6d8f1f68645b6431f013fc6 Author: Michael Albinus Date: Thu Oct 14 11:50:47 2021 +0200 * doc/misc/tramp.texi (Frequently Asked Questions): Add reference to ELPA Installation node. diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi index 5fdd9a4989..8cc3eafc87 100644 --- a/doc/misc/tramp.texi +++ b/doc/misc/tramp.texi @@ -5193,11 +5193,13 @@ tramp-compat-with-mutex} @value{tramp} comes with compatibility code for different Emacs versions. When you see such a message (the text might differ), you don't use the Emacs built-in version of @value{tramp}. In case you -have installed @value{tramp} from GNU ELPA, see the package README -file for instructions how to recompile it. +have installed @value{tramp} from GNU ELPA, @ifset installchapter -@xref{Recompilation}. +@xref{ELPA Installation}. @end ifset +@ifclear installchapter +see the package README file for instructions how to recompile it. +@end ifclear @item commit b9b78b263148d26ea585622e98e8e5ccd2602799 Author: Eli Zaretskii Date: Thu Oct 14 12:29:43 2021 +0300 Fix Help functions for clicks on tool bar and tab bar * lisp/mouse.el (mouse-minibuffer-check): Don't assume posn-window returns a window. (Bug#5199) diff --git a/lisp/mouse.el b/lisp/mouse.el index bb47d04a3a..bcb58d153a 100644 --- a/lisp/mouse.el +++ b/lisp/mouse.el @@ -571,7 +571,8 @@ This is the keyboard interface to \\[context-menu-map]." (defun mouse-minibuffer-check (event) (let ((w (posn-window (event-start event)))) - (and (window-minibuffer-p w) + (and (windowp w) + (window-minibuffer-p w) (not (minibuffer-window-active-p w)) (user-error "Minibuffer window is not active"))) ;; Give temporary modes such as isearch a chance to turn off. commit 74deafe9212b3ff085c281eade530b2aaff0e03b Author: Eli Zaretskii Date: Thu Oct 14 12:14:14 2021 +0300 ; * etc/DEBUG: Add a section about debugging native-compilation. diff --git a/etc/DEBUG b/etc/DEBUG index fae8726186..a1c0634260 100644 --- a/etc/DEBUG +++ b/etc/DEBUG @@ -573,6 +573,28 @@ debugging did not (yet) happen. Here are some useful techniques for that: GET_FROM_IMAGE for displaying an image, etc. See 'enum it_method' in dispextern.h for the full list of values. +** Debugging problems with native-compiled Lisp. + +When you encounter problems specific to native-compilation of Lisp, we +recommend to follow the procedure below to try to identify the cause: + + . Reduce the problematic .el file to the minimum by bisection, and + try identifying the function that causes the problem. + + . Reduce the problematic function to the minimal code that still + reproduces the problem. + + . Study the problem's artifacts, like Lisp or C backtraces, to try + identifying the cause of the problem. + +If you cannot figure out the cause for the problem using the above, +native-compile the problematic file after setting the variable +'comp-libgccjit-reproducer' to a non-nil value. That should produce a +file names ELNFILENAME_libgccjit_repro.c, where ELNFILENAME is the +name of the problematic .eln file, in the same directory where the +.eln file is produced. Then attach that reproducer C file to your bug +report. + ** Following longjmp call. Recent versions of glibc (2.4+?) encrypt stored values for setjmp/longjmp which @@ -875,15 +897,6 @@ It is also useful to look at the corrupted object or data structure in a fresh Emacs session and compare its contents with a session that you are debugging. -** Debugging problems with non-ASCII characters - -If you experience problems which seem to be related to non-ASCII -characters, such as \201 characters appearing in the buffer or in your -files, set the variable byte-debug-flag to t. This causes Emacs to do -some extra checks, such as look for broken relations between byte and -character positions in buffers and strings; the resulting diagnostics -might pinpoint the cause of the problem. - ** Debugging the TTY (non-windowed) version The most convenient method of debugging the character-terminal display commit 64f9fdc812bb2e1f533ae294355d33396985e469 Author: Eli Zaretskii Date: Thu Oct 14 11:57:07 2021 +0300 Fix display of cursor in mouse-highlighted face with ':box' * src/xdisp.c (erase_phys_cursor, show_mouse_face): Adjust phys_cursor.x as needed if the cursor is inside mouse-highlight. (get_cursor_offset_for_mouse_face): New function. * src/dispnew.c (gui_update_window_end): Set 'mouse_face_overwritten_p' if the cursor is in mouse-face, to trigger more thorough redisplay of the cursor. (Bug#50660) diff --git a/src/dispnew.c b/src/dispnew.c index 69c2023fdf..c3f6d0bfef 100644 --- a/src/dispnew.c +++ b/src/dispnew.c @@ -3848,6 +3848,9 @@ gui_update_window_end (struct window *w, bool cursor_on_p, w->output_cursor.hpos, w->output_cursor.vpos, w->output_cursor.x, w->output_cursor.y); + if (cursor_in_mouse_face_p (w) && cursor_on_p) + mouse_face_overwritten_p = 1; + if (draw_window_fringes (w, true)) { if (WINDOW_RIGHT_DIVIDER_WIDTH (w)) diff --git a/src/xdisp.c b/src/xdisp.c index d8aff5084c..012c2ad8bf 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -1179,7 +1179,9 @@ static void append_stretch_glyph (struct it *, Lisp_Object, static Lisp_Object get_it_property (struct it *, Lisp_Object); static Lisp_Object calc_line_height_property (struct it *, Lisp_Object, struct font *, int, bool); - +static void get_cursor_offset_for_mouse_face (struct window *w, + struct glyph_row *row, + int *offset); #endif /* HAVE_WINDOW_SYSTEM */ static void produce_special_glyphs (struct it *, enum display_element_type); @@ -29519,6 +29521,8 @@ produce_image_glyph (struct it *it) if (face->box != FACE_NO_BOX) { + /* If you change the logic here, please change it in + get_cursor_offset_for_mouse_face as well. */ if (face->box_horizontal_line_width > 0) { if (slice.y == 0) @@ -31751,6 +31755,10 @@ erase_phys_cursor (struct window *w) Mouse_HLInfo *hlinfo = MOUSE_HL_INFO (f); int hpos = w->phys_cursor.hpos; int vpos = w->phys_cursor.vpos; +#ifdef HAVE_WINDOW_SYSTEM + int mouse_delta; + int phys_x = w->phys_cursor.x; +#endif bool mouse_face_here_p = false; struct glyph_matrix *active_glyphs = w->current_matrix; struct glyph_row *cursor_row; @@ -31820,6 +31828,17 @@ erase_phys_cursor (struct window *w) && cursor_row->used[TEXT_AREA] > hpos && hpos >= 0) mouse_face_here_p = true; +#ifdef HAVE_WINDOW_SYSTEM + /* Adjust the physical cursor's X coordinate if needed. The problem + solved by the code below is outlined in the comment above + 'get_cursor_offset_for_mouse_face'. */ + if (mouse_face_here_p) + { + get_cursor_offset_for_mouse_face (w, cursor_row, &mouse_delta); + w->phys_cursor.x += mouse_delta; + } +#endif + /* Maybe clear the display under the cursor. */ if (w->phys_cursor_type == HOLLOW_BOX_CURSOR) { @@ -31855,6 +31874,10 @@ erase_phys_cursor (struct window *w) draw_phys_cursor_glyph (w, cursor_row, hl); mark_cursor_off: +#ifdef HAVE_WINDOW_SYSTEM + /* Restore the original cursor position. */ + w->phys_cursor.x = phys_x; +#endif w->phys_cursor_on_p = false; w->phys_cursor_type = NO_CURSOR; } @@ -32091,6 +32114,9 @@ show_mouse_face (Mouse_HLInfo *hlinfo, enum draw_glyphs_face draw) && hlinfo->mouse_face_end_row < w->current_matrix->nrows) { bool phys_cursor_on_p = w->phys_cursor_on_p; +#ifdef HAVE_WINDOW_SYSTEM + int mouse_off = 0; +#endif struct glyph_row *row, *first, *last; first = MATRIX_ROW (w->current_matrix, hlinfo->mouse_face_beg_row); @@ -32164,6 +32190,15 @@ show_mouse_face (Mouse_HLInfo *hlinfo, enum draw_glyphs_face draw) row->mouse_face_p = draw == DRAW_MOUSE_FACE || draw == DRAW_IMAGE_RAISED; } +#ifdef HAVE_WINDOW_SYSTEM + /* Compute the cursor offset due to mouse-highlight. */ + if ((MATRIX_ROW_VPOS (row, w->current_matrix) == w->phys_cursor.vpos) + /* But not when highlighting a pseudo window, such as + the toolbar, which can't have a cursor anyway. */ + && !w->pseudo_window_p + && draw == DRAW_MOUSE_FACE) + get_cursor_offset_for_mouse_face (w, row, &mouse_off); +#endif } /* When we've written over the cursor, arrange for it to @@ -32173,6 +32208,7 @@ show_mouse_face (Mouse_HLInfo *hlinfo, enum draw_glyphs_face draw) { #ifdef HAVE_WINDOW_SYSTEM int hpos = w->phys_cursor.hpos; + int old_phys_cursor_x = w->phys_cursor.x; /* When the window is hscrolled, cursor hpos can legitimately be out of bounds, but we draw the cursor at the corresponding @@ -32184,7 +32220,11 @@ show_mouse_face (Mouse_HLInfo *hlinfo, enum draw_glyphs_face draw) block_input (); display_and_set_cursor (w, true, hpos, w->phys_cursor.vpos, - w->phys_cursor.x, w->phys_cursor.y); + w->phys_cursor.x + mouse_off, + w->phys_cursor.y); + /* Restore the original cursor coordinates, perhaps modified + to account for mouse-highlight. */ + w->phys_cursor.x = old_phys_cursor_x; unblock_input (); #endif /* HAVE_WINDOW_SYSTEM */ } @@ -35956,4 +35996,107 @@ cancel_hourglass (void) } } +/* Get the offset due to mouse-highlight to apply before drawing + phys_cursor, and return it in OFFSET. ROW should be the row that + is under mouse face and contains the phys cursor. + + This is required because the produce_XXX_glyph series of functions + add the width of the various vertical box lines to the total width + of the glyphs, but that must be updated when the row is put under + mouse face, which can have different box dimensions. */ +static void +get_cursor_offset_for_mouse_face (struct window *w, struct glyph_row *row, + int *offset) +{ + int sum = 0; + /* Return because the mode line can't possibly have a cursor. */ + if (row->mode_line_p) + return; + + block_input (); + + struct frame *f = WINDOW_XFRAME (w); + Mouse_HLInfo *hlinfo = MOUSE_HL_INFO (f); + struct glyph *start, *end; + struct face *mouse_face = FACE_FROM_ID (f, hlinfo->mouse_face_face_id); + int hpos = w->phys_cursor.hpos; + end = &row->glyphs[TEXT_AREA][hpos]; + + if (!row->reversed_p) + { + if (MATRIX_ROW_VPOS (row, w->current_matrix) == + hlinfo->mouse_face_beg_row) + start = &row->glyphs[TEXT_AREA][hlinfo->mouse_face_beg_col]; + else + start = row->glyphs[TEXT_AREA]; + } + else + { + if (MATRIX_ROW_VPOS (row, w->current_matrix) == + hlinfo->mouse_face_end_row) + start = &row->glyphs[TEXT_AREA][hlinfo->mouse_face_end_col]; + else + start = &row->glyphs[TEXT_AREA][row->used[TEXT_AREA] - 1]; + } + + /* Calculate the offset to correct phys_cursor x if we are + drawing the cursor inside mouse-face highlighted text. */ + + for (; row->reversed_p ? start >= end : start <= end; + row->reversed_p ? --start : ++start) + { + struct glyph *g = start; + struct face *mouse = mouse_face; + struct face *regular_face = FACE_FROM_ID (f, g->face_id); + + bool do_left_box_p = g->left_box_line_p; + bool do_right_box_p = g->right_box_line_p; + + /* This is required because we test some parameters + of the image slice before applying the box in + produce_image_glyph. */ + + if (g->type == IMAGE_GLYPH) + { + if (!row->reversed_p) + { + struct image *img = IMAGE_FROM_ID (WINDOW_XFRAME (w), + g->u.img_id); + do_left_box_p = g->left_box_line_p && + g->slice.img.x == 0; + do_right_box_p = g->right_box_line_p && + g->slice.img.x + g->slice.img.width == img->width; + } + else + { + struct image *img = IMAGE_FROM_ID (WINDOW_XFRAME (w), + g->u.img_id); + do_left_box_p = g->left_box_line_p && + g->slice.img.x + g->slice.img.width == img->width; + do_right_box_p = g->right_box_line_p && + g->slice.img.x == 0; + } + } + + /* If the glyph has a left box line, subtract it from the offset. */ + if (do_left_box_p) + sum -= max (0, regular_face->box_vertical_line_width); + /* Likewise with the right box line, as there may be a + box there as well. */ + if (do_right_box_p) + sum -= max (0, regular_face->box_vertical_line_width); + /* Now add the line widths from the new face. */ + if (g->left_box_line_p) + sum += max (0, mouse->box_vertical_line_width); + if (g->right_box_line_p) + sum += max (0, mouse->box_vertical_line_width); + } + + if (row->reversed_p) + sum = -sum; + + *offset = sum; + + unblock_input (); +} #endif /* HAVE_WINDOW_SYSTEM */ commit 8153f70b9ccc1ebd0f1bf639691a0af5a8d9ad4f Author: Martin Rudalics Date: Thu Oct 14 10:39:27 2021 +0200 In make_lispy_position fix Bug#50993 in rudimentary fashion * src/keyboard.c (make_lispy_position): Do not set posn to tool- or tab-bar when track_mouse is enabled (Bug#50993). diff --git a/src/keyboard.c b/src/keyboard.c index 4e47136e49..6895a249f2 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -5122,7 +5122,20 @@ make_lispy_position (struct frame *f, Lisp_Object x, Lisp_Object y, #endif ) { - posn = EQ (window_or_frame, f->tab_bar_window) ? Qtab_bar : Qtool_bar; + /* FIXME: While track_mouse is non-nil, we do not report this + event as something that happened on the tool or tab bar since + that would break mouse dragging operations that originate from + an ordinary window beneath and expect the window to auto-scroll + as soon as the mouse cursor appears above or beneath it + (Bug#50993). Since this "fix" might break track_mouse based + operations originating from the tool or tab bar itself, such + operations should set track_mouse to some special value that + would be recognized by the following check. + + This issue should be properly handled by 'mouse-drag-track' and + friends, so the below is only a temporary workaround. */ + if (NILP (track_mouse)) + posn = EQ (window_or_frame, f->tab_bar_window) ? Qtab_bar : Qtool_bar; /* Kludge alert: for mouse events on the tab bar and tool bar, keyboard.c wants the frame, not the special-purpose window we use to display those, and it wants frame-relative commit 9c0128faf7d8de1a017e94595420a16a27321fc1 Author: Martin Rudalics Date: Thu Oct 14 10:21:17 2021 +0200 In 'window--display-buffer' handle nil size values as intended (Bug#51062) * lisp/window.el (window--display-buffer): Make sure that (window-height . nil), (window-width . nil) and (window-size . nil) action alist entries are processed as intended. diff --git a/lisp/window.el b/lisp/window.el index 1a5f2d4006..20c662c23f 100644 --- a/lisp/window.el +++ b/lisp/window.el @@ -7267,7 +7267,9 @@ Return WINDOW if BUFFER and WINDOW are live." ;; Adjust size of frame if asked for. We probably should do ;; that only for a single window frame. (cond - ((not size)) + ((not size) + (when window-size + (setq resize-temp-buffer-window-inhibit t))) ((consp size) (let ((width (car size)) (height (cdr size)) @@ -7293,7 +7295,9 @@ Return WINDOW if BUFFER and WINDOW are live." ;; ;; Adjust width and/or height of window if asked for. (cond - ((not height)) + ((not height) + (when window-height + (setq resize-temp-buffer-window-inhibit 'vertical))) ((numberp height) (let* ((new-height (if (integerp height) @@ -7311,7 +7315,9 @@ Return WINDOW if BUFFER and WINDOW are live." (setq resize-temp-buffer-window-inhibit 'vertical))) ;; Adjust width of window if asked for. (cond - ((not width)) + ((not width) + (when window-width + (setq resize-temp-buffer-window-inhibit 'horizontal))) ((numberp width) (let* ((new-width (if (integerp width) @@ -7327,10 +7333,12 @@ Return WINDOW if BUFFER and WINDOW are live." ((functionp width) (ignore-errors (funcall width window)) (setq resize-temp-buffer-window-inhibit 'horizontal))) + ;; Preserve window size if asked for. (when (consp preserve-size) (window-preserve-size window t (car preserve-size)) (window-preserve-size window nil (cdr preserve-size))))) + ;; Assign any window parameters specified. (let ((parameters (cdr (assq 'window-parameters alist)))) (dolist (parameter parameters) commit 2202f3f5fe06827d96f61ad802199ebd05791695 Author: Michael Albinus Date: Thu Oct 14 09:37:13 2021 +0200 Adapt gitlab-ci.yml paths * test/infra/gitlab-ci.yml (.job-template): Increase timeout. (.job-template, .build-template, .test-template) (.gnustep-template, .filenotify-gio-template) (.native-comp-template): Adapt paths. diff --git a/test/infra/gitlab-ci.yml b/test/infra/gitlab-ci.yml index 30efe89c06..b7bb93d45b 100644 --- a/test/infra/gitlab-ci.yml +++ b/test/infra/gitlab-ci.yml @@ -69,26 +69,25 @@ default: test_name: ${CI_JOB_NAME}-${CI_COMMIT_SHORT_SHA} rules: - changes: - - "**/Makefile.in" + - "**Makefile.in" - .gitlab-ci.yml - aclocal.m4 - autogen.sh - configure.ac - lib/*.{h,c} - - lisp/*.el - - lisp/**/*.el + - lisp/**.el - src/*.{h,c} - test/infra/* - test/lib-src/*.el - - test/lisp/*.el - - test/lisp/**/*.el + - test/lisp/**.el + - test/misc/*.el - test/src/*.el - changes: # gfilemonitor, kqueue - src/gfilenotify.c - src/kqueue.c # MS Windows - - "**/w32*" + - "**w32*" # GNUstep - lisp/term/ns-win.el - src/ns*.{h,m} @@ -109,7 +108,7 @@ default: # TODO: with make -j4 several of the tests were failing, for # example shadowfile-tests, but passed without it. - 'export PWD=$(pwd)' - - 'docker run -i -e EMACS_EMBA_CI=${EMACS_EMBA_CI} --volumes-from $(docker ps -q -f "label=com.gitlab.gitlab-runner.job.id=${CI_JOB_ID}"):ro --name ${test_name} ${CI_REGISTRY_IMAGE}:${target}-${BUILD_TAG} /bin/bash -c "git fetch ${PWD} HEAD && echo checking out these updated files && git diff --name-only FETCH_HEAD && ( git diff --name-only FETCH_HEAD | xargs git checkout -f FETCH_HEAD ) && make -j4 && timeout -s ABRT 1800s make ${make_params}"' + - 'docker run -i -e EMACS_EMBA_CI=${EMACS_EMBA_CI} --volumes-from $(docker ps -q -f "label=com.gitlab.gitlab-runner.job.id=${CI_JOB_ID}"):ro --name ${test_name} ${CI_REGISTRY_IMAGE}:${target}-${BUILD_TAG} /bin/bash -c "git fetch ${PWD} HEAD && echo checking out these updated files && git diff --name-only FETCH_HEAD && ( git diff --name-only FETCH_HEAD | xargs git checkout -f FETCH_HEAD ) && make -j4 && timeout -s ABRT 3600s make ${make_params}"' after_script: # - docker ps -a # - printenv @@ -123,7 +122,7 @@ default: - if: '$CI_PIPELINE_SOURCE == "web"' when: always - changes: - - "**/Makefile.in" + - "**Makefile.in" - .gitlab-ci.yml - aclocal.m4 - autogen.sh @@ -137,7 +136,7 @@ default: - src/gfilenotify.c - src/kqueue.c # MS Windows - - "**/w32*" + - "**w32*" # GNUstep - lisp/term/ns-win.el - src/ns*.{h,m} @@ -158,22 +157,22 @@ default: public: true expire_in: 1 week paths: - - "**/*.log" - - "**/core" - - core + - "**.log" + - "**core" + when: always .gnustep-template: rules: - if: '$CI_PIPELINE_SOURCE == "web"' - if: '$CI_PIPELINE_SOURCE == "schedule"' changes: - - "**/Makefile.in" + - "**Makefile.in" - .gitlab-ci.yml - configure.ac - src/ns*.{h,m} - src/macfont.{h,m} - lisp/term/ns-win.el - - nextstep/**/* + - nextstep/** - test/infra/* .filenotify-gio-template: @@ -181,7 +180,7 @@ default: - if: '$CI_PIPELINE_SOURCE == "web"' - if: '$CI_PIPELINE_SOURCE == "schedule"' changes: - - "**/Makefile.in" + - "**Makefile.in" - .gitlab-ci.yml - lisp/autorevert.el - lisp/filenotify.el @@ -196,7 +195,7 @@ default: - if: '$CI_PIPELINE_SOURCE == "web"' - if: '$CI_PIPELINE_SOURCE == "schedule"' changes: - - "**/Makefile.in" + - "**Makefile.in" - .gitlab-ci.yml - lisp/emacs-lisp/comp.el - lisp/emacs-lisp/comp-cstr.el commit 14bfb31dba47a947538f2dec76a059fcab496280 Author: Dmitry Gutov Date: Thu Oct 14 03:43:42 2021 +0300 Add new argument INCLUDE-ALL to project-find-file * lisp/progmodes/project.el (project-find-file): Add new argument INCLUDE-ALL. Have 'C-u' make it non-nil. (project-or-external-find-file): Ditto. (project-find-file-in): Add new argument INCLUDE-ALL. (https://lists.gnu.org/archive/html/emacs-devel/2021-10/msg00209.html) diff --git a/etc/NEWS b/etc/NEWS index 82847cf9b9..7dd4d14274 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -123,6 +123,11 @@ also handle ANSI codes for faint, italic and blinking text, displaying it with new 'ansi-term-faint/italic/slow-blinking/fast-blinking' faces. +** Xref + +*** 'project-find-file' and 'project-or-external-find-file' now accept +a prefix argument which is interpreted to mean "include all files". + * New Modes and Packages in Emacs 29.1 diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el index da7435cddf..79d2e050d9 100644 --- a/lisp/progmodes/project.el +++ b/lisp/progmodes/project.el @@ -840,28 +840,36 @@ pattern to search for." project-regexp-history-variable))) ;;;###autoload -(defun project-find-file () +(defun project-find-file (&optional include-all) "Visit a file (with completion) in the current project. The filename at point (determined by `thing-at-point'), if any, -is available as part of \"future history\"." - (interactive) +is available as part of \"future history\". + +If INCLUDE-ALL is non-nil, or with prefix argument when called +interactively, include all files under the project root, except +for VCS directories listed in `vc-directory-exclusion-list'." + (interactive "P") (let* ((pr (project-current t)) (dirs (list (project-root pr)))) - (project-find-file-in (thing-at-point 'filename) dirs pr))) + (project-find-file-in (thing-at-point 'filename) dirs pr include-all))) ;;;###autoload -(defun project-or-external-find-file () +(defun project-or-external-find-file (&optional include-all) "Visit a file (with completion) in the current project or external roots. The filename at point (determined by `thing-at-point'), if any, -is available as part of \"future history\"." - (interactive) +is available as part of \"future history\". + +If INCLUDE-ALL is non-nil, or with prefix argument when called +interactively, include all files under the project root, except +for VCS directories listed in `vc-directory-exclusion-list'." + (interactive "P") (let* ((pr (project-current t)) (dirs (cons (project-root pr) (project-external-roots pr)))) - (project-find-file-in (thing-at-point 'filename) dirs pr))) + (project-find-file-in (thing-at-point 'filename) dirs pr include-all))) (defcustom project-read-file-name-function #'project--read-file-cpd-relative "Function to call to read a file name from a list. @@ -914,12 +922,25 @@ by the user at will." predicate hist mb-default)) -(defun project-find-file-in (suggested-filename dirs project) +(defun project-find-file-in (suggested-filename dirs project &optional include-all) "Complete a file name in DIRS in PROJECT and visit the result. SUGGESTED-FILENAME is a relative file name, or part of it, which -is used as part of \"future history\"." - (let* ((all-files (project-files project dirs)) +is used as part of \"future history\". + +If INCLUDE-ALL is non-nil, or with prefix argument when called +interactively, include all files from DIRS, except for VCS +directories listed in `vc-directory-exclusion-list'." + (let* ((vc-dirs-ignores (mapcar + (lambda (dir) + (concat dir "/")) + vc-directory-exclusion-list)) + (all-files + (if include-all + (mapcan + (lambda (dir) (project--files-in-directory dir vc-dirs-ignores)) + dirs) + (project-files project dirs))) (completion-ignore-case read-file-name-completion-ignore-case) (file (funcall project-read-file-name-function "Find file" all-files nil nil commit 0aa52e94f37e34a8f59d3a91e4798ee082781e3d Author: Dmitry Gutov Date: Thu Oct 14 02:28:00 2021 +0300 Mark vc-switch-backend as obsolete * etc/NEWS: Mention the change. * lisp/vc/vc.el (vc-switch-backend): Mark as obsolete (bug#50344). (vc-transfer-file): Wrap the calls in 'with-suppressed-warnings'. diff --git a/etc/NEWS b/etc/NEWS index 791248f7dc..b7c4346db9 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1937,6 +1937,10 @@ tags to be considered as well. *** New user option 'vc-git-log-switches'. String or list of strings specifying switches for Git log under VC. +*** Command 'vc-switch-backend' is now obsolete. +If you are still using it with any regularity, please file a bug +report with some details. + ** Gnus +++ diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el index 5b259fcdb3..67003c8392 100644 --- a/lisp/vc/vc.el +++ b/lisp/vc/vc.el @@ -2864,6 +2864,7 @@ permanent, only for the current session. This function only changes VC's perspective on FILE, it does not register or unregister it. By default, this command cycles through the registered backends. To get a prompt, use a prefix argument." + (declare (obsolete nil "28.1")) (interactive (list (or buffer-file-name @@ -2918,7 +2919,8 @@ backend to NEW-BACKEND, and unregister FILE from the current backend. (if registered (set-file-modes file (logior (file-modes file) 128)) ;; `registered' might have switched under us. - (vc-switch-backend file old-backend) + (with-suppressed-warnings ((obsolete vc-switch-backend)) + (vc-switch-backend file old-backend)) (let* ((rev (vc-working-revision file)) (modified-file (and edited (make-temp-file file))) (unmodified-file (and modified-file (vc-version-backup-file file)))) @@ -2937,16 +2939,19 @@ backend to NEW-BACKEND, and unregister FILE from the current backend. (vc-revert-file file)))) (vc-call-backend new-backend 'receive-file file rev)) (when modified-file - (vc-switch-backend file new-backend) + (with-suppressed-warnings ((obsolete vc-switch-backend)) + (vc-switch-backend file new-backend)) (unless (eq (vc-checkout-model new-backend (list file)) 'implicit) (vc-checkout file)) (rename-file modified-file file 'ok-if-already-exists) (vc-file-setprop file 'vc-checkout-time nil))))) (when move - (vc-switch-backend file old-backend) + (with-suppressed-warnings ((obsolete vc-switch-backend)) + (vc-switch-backend file old-backend)) (setq comment (vc-call-backend old-backend 'comment-history file)) (vc-call-backend old-backend 'unregister file)) - (vc-switch-backend file new-backend) + (with-suppressed-warnings ((obsolete vc-switch-backend)) + (vc-switch-backend file new-backend)) (when (or move edited) (vc-file-setprop file 'vc-state 'edited) (vc-mode-line file new-backend) commit 568e479c59b757e3adc28bae906b5200a6b64c15 Author: Yan Date: Thu Oct 14 01:28:02 2021 +0200 Add missing parentheses in the Emacs manual * doc/emacs/maintaining.texi (Xref Commands): Add missing parentheses (bug#51195). Copyright-paperwork-exempt: yes diff --git a/doc/emacs/maintaining.texi b/doc/emacs/maintaining.texi index d1380bc297..5b66031b8a 100644 --- a/doc/emacs/maintaining.texi +++ b/doc/emacs/maintaining.texi @@ -2283,12 +2283,12 @@ the match with @var{replacement}. @xref{Identifier Search}. @item g @findex xref-revert-buffer Refresh the contents of the @file{*xref*} buffer -(@code{xref-revert-buffer}. +(@code{xref-revert-buffer}). @item M-, @findex xref-quit-and-pop-marker-stack Quit the window showing the @file{*xref*} buffer, and then jump to the -previous Xref stack location (@code{xref-quit-and-pop-marker-stack}. +previous Xref stack location (@code{xref-quit-and-pop-marker-stack}). @item q @findex xref-quit commit 44ce50b0df468b22a3387b568b04b04e2f154e9f Author: Stefan Kangas Date: Thu Oct 14 00:26:51 2021 +0200 Improve tooltip of mode-line-position again * lisp/bindings.el (mode-line-position): Improve tooltip again. This change was discussed in https://lists.gnu.org/r/emacs-devel/2021-10/msg00952.html diff --git a/lisp/bindings.el b/lisp/bindings.el index e397e44b2f..2c45710a58 100644 --- a/lisp/bindings.el +++ b/lisp/bindings.el @@ -505,7 +505,7 @@ mouse-1: Display Line and Column Mode Menu")) local-map ,mode-line-column-line-number-mode-map mouse-face mode-line-highlight ;; XXX needs better description - help-echo "Buffer Position + help-echo "Window Scroll Percentage mouse-1: Display Line and Column Mode Menu") (size-indication-mode (8 ,(propertize commit 97c4f84cbce4fef3dddebdae29df590bbb7fd516 Author: Stefan Kangas Date: Tue Oct 12 18:23:46 2021 +0200 Double the default value of kill-ring-max * lisp/simple.el (kill-ring-max): Double the default to 120. * lisp/menu-bar.el (yank-menu-length): Doc fix. (yank-menu-max-items): New variable. (menu-bar-update-yank-menu): Don't display more than 'yank-menu-max-items' in the yank menu. * doc/emacs/custom.texi (Changing a Variable): * doc/emacs/killing.texi (Kill Ring): * doc/lispintro/emacs-lisp-intro.texi (kill-new function): * doc/lispref/text.texi (Internals of Kill Ring): Doc fix to use the new value. diff --git a/doc/emacs/custom.texi b/doc/emacs/custom.texi index 73dfe03898..eb30a6acc5 100644 --- a/doc/emacs/custom.texi +++ b/doc/emacs/custom.texi @@ -195,7 +195,7 @@ the customization buffer: The first line shows that the variable is named @code{kill-ring-max}, formatted as @samp{Kill Ring Max} for easier -viewing. Its value is @samp{60}. The button labeled @samp{[Hide]}, +viewing. Its value is @samp{120}. The button labeled @samp{[Hide]}, if activated, hides the variable's value and state; this is useful to avoid cluttering up the customization buffer with very long values (for this reason, variables that have very long values may start out diff --git a/doc/emacs/killing.texi b/doc/emacs/killing.texi index 6e4fd77e8b..76fccdbdfe 100644 --- a/doc/emacs/killing.texi +++ b/doc/emacs/killing.texi @@ -353,7 +353,7 @@ other ways to move text around.) @vindex kill-ring-max The maximum number of entries in the kill ring is controlled by the -variable @code{kill-ring-max}. The default is 60. If you make a new +variable @code{kill-ring-max}. The default is 120. If you make a new kill when this limit has been reached, Emacs makes room by deleting the oldest entry in the kill ring. diff --git a/doc/lispintro/emacs-lisp-intro.texi b/doc/lispintro/emacs-lisp-intro.texi index 6ecd552ebb..81ae253633 100644 --- a/doc/lispintro/emacs-lisp-intro.texi +++ b/doc/lispintro/emacs-lisp-intro.texi @@ -8767,7 +8767,7 @@ keeps the kill ring from growing too long. It looks like this: The code checks whether the length of the kill ring is greater than the maximum permitted length. This is the value of -@code{kill-ring-max} (which is 60, by default). If the length of the +@code{kill-ring-max} (which is 120, by default). If the length of the kill ring is too long, then this code sets the last element of the kill ring to @code{nil}. It does this by using two functions, @code{nthcdr} and @code{setcdr}. diff --git a/doc/lispref/text.texi b/doc/lispref/text.texi index 1e062be2c6..163ac9038b 100644 --- a/doc/lispref/text.texi +++ b/doc/lispref/text.texi @@ -1342,7 +1342,7 @@ that @kbd{C-y} should yank. @defopt kill-ring-max The value of this variable is the maximum length to which the kill ring can grow, before elements are thrown away at the end. The default -value for @code{kill-ring-max} is 60. +value for @code{kill-ring-max} is 120. @end defopt @node Undo diff --git a/etc/NEWS b/etc/NEWS index 9daf958b07..82847cf9b9 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -78,6 +78,14 @@ the point is now moved only when releasing the mouse button. This no longer results in a bogus selection, unless the mouse has been effectively dragged. ++++ +** 'kill-ring-max' now defaults to 120. + +--- +** New user option 'yank-menu-max-items'. +Customize this option to limit the amount of entries in the menu +"Edit->Paste from Kill Menu". The default is 60. + * Changes in Specialized Modes and Packages in Emacs 29.1 diff --git a/lisp/menu-bar.el b/lisp/menu-bar.el index 7c9fc1aeba..1c3b8014e9 100644 --- a/lisp/menu-bar.el +++ b/lisp/menu-bar.el @@ -2169,10 +2169,16 @@ otherwise it could decide to silently do nothing." (> count 1))) (defcustom yank-menu-length 20 - "Maximum length to display in the `yank-menu'." + "Items in `yank-menu' longer than this will be truncated." :type 'integer :group 'menu) +(defcustom yank-menu-max-items 60 + "Maximum number of entries to display in the `yank-menu'." + :type 'integer + :group 'menu + :version "29.1") + (defun menu-bar-update-yank-menu (string old) (let ((front (car (cdr yank-menu))) (menu-string (if (<= (length string) yank-menu-length) @@ -2196,8 +2202,9 @@ otherwise it could decide to silently do nothing." (cons (cons string (cons menu-string 'menu-bar-select-yank)) (cdr yank-menu))))) - (if (> (length (cdr yank-menu)) kill-ring-max) - (setcdr (nthcdr kill-ring-max yank-menu) nil))) + (let ((max-items (min yank-menu-max-items kill-ring-max))) + (if (> (length (cdr yank-menu)) max-items) + (setcdr (nthcdr max-items yank-menu) nil)))) (put 'menu-bar-select-yank 'apropos-inhibit t) (defun menu-bar-select-yank () diff --git a/lisp/simple.el b/lisp/simple.el index 7b6c52a389..c7bb928cd7 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -5076,10 +5076,11 @@ interact nicely with `interprogram-cut-function' and interaction; you may want to use them instead of manipulating the kill ring directly.") -(defcustom kill-ring-max 60 +(defcustom kill-ring-max 120 "Maximum length of kill ring before oldest elements are thrown away." :type 'integer - :group 'killing) + :group 'killing + :version "29.1") (defvar kill-ring-yank-pointer nil "The tail of the kill ring whose car is the last thing yanked.") commit 845640538ecec167bbda8abeb98fcee70d68fd0a Author: Stefan Kangas Date: Wed Oct 13 23:13:40 2021 +0200 New tests for kbd and edmacro-parse-keys * test/lisp/edmacro-tests.el: New file. * test/lisp/subr-tests.el (subr-test-kbd): Expand test. diff --git a/test/lisp/edmacro-tests.el b/test/lisp/edmacro-tests.el new file mode 100644 index 0000000000..974f506a36 --- /dev/null +++ b/test/lisp/edmacro-tests.el @@ -0,0 +1,47 @@ +;;; edmacro-tests.el --- Tests for edmacro.el -*- lexical-binding:t -*- + +;; Copyright (C) 2021 Free Software Foundation, Inc. + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Commentary: + +;;; Code: + +(require 'ert) +(require 'edmacro) + +(ert-deftest edmacro-test-edmacro-parse-keys () + (should (equal (edmacro-parse-keys "") "")) + (should (equal (edmacro-parse-keys "x") "x")) + (should (equal (edmacro-parse-keys "C-a") "\C-a")) + + ;; comments + (should (equal (edmacro-parse-keys ";; foobar") "")) + (should (equal (edmacro-parse-keys ";;;") "")) + (should (equal (edmacro-parse-keys "; ; ;") ";;;")) + (should (equal (edmacro-parse-keys "REM foobar") "")) + (should (equal (edmacro-parse-keys "x ;; foobar") "x")) + (should (equal (edmacro-parse-keys "x REM foobar") "x")) + (should (equal (edmacro-parse-keys "<>") + [134217848 103 111 116 111 45 108 105 110 101 13])) + + ;; repetitions + (should (equal (edmacro-parse-keys "3*x") "xxx")) + (should (equal (edmacro-parse-keys "3*C-m") "\C-m\C-m\C-m")) + (should (equal (edmacro-parse-keys "10*foo") "foofoofoofoofoofoofoofoofoofoo"))) + +;;; edmacro-tests.el ends here diff --git a/test/lisp/subr-tests.el b/test/lisp/subr-tests.el index 32c0bc3ed3..da46646d39 100644 --- a/test/lisp/subr-tests.el +++ b/test/lisp/subr-tests.el @@ -84,16 +84,119 @@ ;;;; Keymap support. (ert-deftest subr-test-kbd () + (should (equal (kbd "") "")) (should (equal (kbd "f") "f")) + (should (equal (kbd "X") "X")) + (should (equal (kbd "foobar") "foobar")) ; 6 characters + (should (equal (kbd "return") "return")) ; 6 characters + + (should (equal (kbd "") [F2])) + (should (equal (kbd " TAB") [f1 f2 ?\t])) + (should (equal (kbd " RET") [f1 ?\r])) + (should (equal (kbd " SPC") [f1 ? ])) (should (equal (kbd "") [f1])) - (should (equal (kbd "RET") "\C-m")) + (should (equal (kbd "") [f1])) + (should (equal (kbd "[f1]") "[f1]")) + (should (equal (kbd "") [return])) + (should (equal (kbd "< right >") "")) ; 7 characters + + ;; Modifiers: + (should (equal (kbd "C-x") "\C-x")) (should (equal (kbd "C-x a") "\C-xa")) - ;; Check that kbd handles both new and old style key descriptions - ;; (bug#45536). + (should (equal (kbd "C-;") [?\C-\;])) + (should (equal (kbd "C-a") "\C-a")) + (should (equal (kbd "C-c SPC") "\C-c ")) + (should (equal (kbd "C-c TAB") "\C-c\t")) + (should (equal (kbd "C-c c") "\C-cc")) + (should (equal (kbd "C-x 4 C-f") "\C-x4\C-f")) + (should (equal (kbd "C-x C-f") "\C-x\C-f")) + (should (equal (kbd "C-M-") [C-M-down])) + (should (equal (kbd "") [C-M-down])) + (should (equal (kbd "C-RET") [?\C-\C-m])) + (should (equal (kbd "C-SPC") [?\C- ])) + (should (equal (kbd "C-TAB") [?\C-\t])) + (should (equal (kbd "C-") [C-down])) + (should (equal (kbd "C-c C-c C-c") "\C-c\C-c\C-c")) + + (should (equal (kbd "M-a") [?\M-a])) + (should (equal (kbd "M-") [?\M-\d])) + (should (equal (kbd "M-C-a") [?\M-\C-a])) + (should (equal (kbd "M-ESC") [?\M-\e])) + (should (equal (kbd "M-RET") [?\M-\r])) + (should (equal (kbd "M-SPC") [?\M- ])) + (should (equal (kbd "M-TAB") [?\M-\t])) + (should (equal (kbd "M-x a") [?\M-x ?a])) + (should (equal (kbd "M-") [M-up])) + (should (equal (kbd "M-c M-c M-c") [?\M-c ?\M-c ?\M-c])) + + (should (equal (kbd "s-SPC") [?\s- ])) + (should (equal (kbd "s-a") [?\s-a])) + (should (equal (kbd "s-x a") [?\s-x ?a])) + (should (equal (kbd "s-c s-c s-c") [?\s-c ?\s-c ?\s-c])) + + (should (equal (kbd "S-H-a") [?\S-\H-a])) + (should (equal (kbd "S-a") [?\S-a])) + (should (equal (kbd "S-x a") [?\S-x ?a])) + (should (equal (kbd "S-c S-c S-c") [?\S-c ?\S-c ?\S-c])) + + (should (equal (kbd "H-") [?\H-\r])) + (should (equal (kbd "H-DEL") [?\H-\d])) + (should (equal (kbd "H-a") [?\H-a])) + (should (equal (kbd "H-x a") [?\H-x ?a])) + (should (equal (kbd "H-c H-c H-c") [?\H-c ?\H-c ?\H-c])) + + (should (equal (kbd "A-H-a") [?\A-\H-a])) + (should (equal (kbd "A-SPC") [?\A- ])) + (should (equal (kbd "A-TAB") [?\A-\t])) + (should (equal (kbd "A-a") [?\A-a])) + (should (equal (kbd "A-c A-c A-c") [?\A-c ?\A-c ?\A-c])) + + (should (equal (kbd "C-M-a") [?\C-\M-a])) + (should (equal (kbd "C-M-") [C-M-up])) + + ;; Special characters. + (should (equal (kbd "DEL") "\d")) + (should (equal (kbd "ESC C-a") "\e\C-a")) + (should (equal (kbd "ESC") "\e")) + (should (equal (kbd "LFD") "\n")) + (should (equal (kbd "NUL") "\0")) + (should (equal (kbd "RET") "\C-m")) + (should (equal (kbd "SPC") "\s")) + (should (equal (kbd "TAB") "\t")) + (should (equal (kbd "\^i") "")) + (should (equal (kbd "^M") "\^M")) + + ;; With numbers. + (should (equal (kbd "\177") "\^?")) + (should (equal (kbd "\000") "\0")) + (should (equal (kbd "\\177") "\^?")) + (should (equal (kbd "\\000") "\0")) + (should (equal (kbd "C-x \\150") "\C-xh")) + + ;; Multibyte + (should (equal (kbd "ñ") [?ñ])) + (should (equal (kbd "ü") [?ü])) + (should (equal (kbd "ö") [?ö])) + (should (equal (kbd "ğ") [?ğ])) + (should (equal (kbd "ա") [?ա])) + (should (equal (kbd "üüöö") [?ü ?ü ?ö ?ö])) + (should (equal (kbd "C-ü") [?\C-ü])) + (should (equal (kbd "M-ü") [?\M-ü])) + (should (equal (kbd "H-ü") [?\H-ü])) + + ;; Handle both new and old style key descriptions (bug#45536). (should (equal (kbd "s-") [s-return])) (should (equal (kbd "") [s-return])) (should (equal (kbd "C-M-") [C-M-return])) - (should (equal (kbd "") [C-M-return]))) + (should (equal (kbd "") [C-M-return])) + + ;; Error. + (should-error (kbd "C-xx")) + (should-error (kbd "M-xx")) + (should-error (kbd "M-x")) + + ;; These should be equivalent: + (should (equal (kbd "\C-xf") (kbd "C-x f")))) (ert-deftest subr-test-define-prefix-command () (define-prefix-command 'foo-prefix-map) commit 3b3211c0239b0d3cb6587f3ef6968f51f2d30fd2 Author: Lars Ingebrigtsen Date: Wed Oct 13 21:52:50 2021 +0200 Mark def* macros for indentation * lisp/widget.el (define-widget-keywords): * lisp/vc/pcvs.el (defun-cvs-mode): * lisp/subr.el (defvar-local): (defvar-keymap): * lisp/skeleton.el (define-skeleton): * lisp/simple.el (define-alternatives): * lisp/progmodes/gud.el (gdb-script-mode): * lisp/progmodes/gdb-mi.el (def-gdb-preempt-display-buffer): (def-gdb-auto-update-trigger): (def-gdb-auto-update-handler): (def-gdb-trigger-and-handler): (def-gdb-thread-buffer-command): (def-gdb-thread-buffer-simple-command): (def-gdb-thread-buffer-gud-command): (def-gdb-set-positive-number): (def-gdb-memory-format): (def-gdb-memory-unit): (def-gdb-memory-show-page): * lisp/progmodes/compile.el (define-compilation-mode): * lisp/progmodes/cc-vars.el (defcustom-c-stylevar): * lisp/obsolete/cl.el (define-setf-expander): (defsetf): (define-modify-macro): * lisp/obsolete/cl-compat.el (defkeyword): * lisp/net/hmac-def.el (define-hmac-function): * lisp/international/mule-conf.el (define-iso-single-byte-charset): * lisp/international/ccl.el (define-ccl-program): * lisp/image.el (defimage): * lisp/gnus/gmm-utils.el (defun-gmm): * lisp/ezimage.el (defezimage): * lisp/erc/erc.el (define-erc-module): * lisp/emacs-lisp/shortdoc.el (define-short-documentation-group): * lisp/emacs-lisp/eieio.el (defclass): * lisp/emacs-lisp/eieio-compat.el (defgeneric): (defmethod): * lisp/emacs-lisp/easy-mmode.el (define-minor-mode): (define-globalized-minor-mode): * lisp/emacs-lisp/derived.el (define-derived-mode): * lisp/emacs-lisp/byte-run.el (defsubst): (define-obsolete-function-alias): (define-obsolete-variable-alias): * lisp/custom.el (defcustom): (defface): (defgroup): (deftheme): * lisp/cedet/semantic/wisent.el (define-wisent-lexer): * lisp/cedet/semantic/lex.el (define-lex): (define-lex-analyzer): (define-lex-regex-analyzer): (define-lex-simple-regex-analyzer): (define-lex-block-analyzer): (define-lex-keyword-type-analyzer): (define-lex-sexp-type-analyzer): (define-lex-regex-type-analyzer): (define-lex-string-type-analyzer): (define-lex-block-type-analyzer): * lisp/cedet/semantic/lex-spp.el (define-lex-spp-macro-declaration-analyzer): (define-lex-spp-macro-undeclaration-analyzer): (define-lex-spp-include-analyzer): * lisp/cedet/semantic/dep.el (defcustom-mode-local-semantic-dependency-system-include-path): * lisp/cedet/semantic/decorate/mode.el (define-semantic-decoration-style): * lisp/cedet/mode-local.el (define-child-mode): (define-overloadable-function): (define-mode-local-override): * lisp/calc/calc.el (defcalcmodevar): (defmath): Explicitly mark all macros that have names that start with "def" that should indent defunly-like (bug#43329). diff --git a/lisp/calc/calc.el b/lisp/calc/calc.el index 553bdc9c6e..bd4ec4ff2f 100644 --- a/lisp/calc/calc.el +++ b/lisp/calc/calc.el @@ -494,7 +494,7 @@ This setting only applies to floats in normal display mode.") (defmacro defcalcmodevar (var defval &optional doc) "Declare VAR as a Calc variable, with default value DEFVAL and doc-string DOC. The variable VAR will be added to `calc-mode-var-list'." - (declare (doc-string 3)) + (declare (doc-string 3) (indent defun)) `(progn (defvar ,var ,defval ,doc) (add-to-list 'calc-mode-var-list (list (quote ,var) ,defval)))) @@ -3439,7 +3439,7 @@ The prefix `calcFunc-' is added to the specified name to get the actual Lisp function name. See Info node `(calc)Defining Functions'." - (declare (doc-string 3)) ;; FIXME: Edebug spec? + (declare (doc-string 3) (indent defun)) ;; FIXME: Edebug spec? (require 'calc-ext) (math-do-defmath func args body)) diff --git a/lisp/cedet/mode-local.el b/lisp/cedet/mode-local.el index 18fb05e7eb..e0717fbfe5 100644 --- a/lisp/cedet/mode-local.el +++ b/lisp/cedet/mode-local.el @@ -156,7 +156,7 @@ local variables have been defined." DOCSTRING is optional and not used. To work properly, this should be put after PARENT mode local variables definition." - (declare (obsolete define-derived-mode "27.1")) + (declare (obsolete define-derived-mode "27.1") (indent 2)) `(mode-local--set-parent ',mode ',parent)) (defun mode-local-use-bindings-p (this-mode desired-mode) @@ -567,6 +567,7 @@ appropriate arguments deduced from ARGS. OVERARGS is a list of arguments passed to the override and `NAME-default' function, in place of those deduced from ARGS." (declare (doc-string 3) + (indent defun) (debug (&define name lambda-list stringp def-body))) `(eval-and-compile (defun ,name ,args @@ -595,6 +596,7 @@ DOCSTRING is the documentation string. BODY is the implementation of this function." ;; FIXME: Make this obsolete and use cl-defmethod with &context instead. (declare (doc-string 4) + (indent defun) (debug (&define name symbolp lambda-list stringp def-body))) (let ((newname (intern (format "%s-%s" name mode)))) `(progn diff --git a/lisp/cedet/semantic/decorate/mode.el b/lisp/cedet/semantic/decorate/mode.el index 6271fb1ced..0a234b3000 100644 --- a/lisp/cedet/semantic/decorate/mode.el +++ b/lisp/cedet/semantic/decorate/mode.el @@ -391,6 +391,7 @@ etc., found in the semantic-decorate library. To add other kind of decorations on a tag, `NAME-highlight' must use `semantic-decorate-tag', and other functions of the semantic decoration API found in this library." + (declare (indent 1)) (let ((predicate (semantic-decorate-style-predicate name)) (highlighter (semantic-decorate-style-highlighter name)) (predicatedef (semantic-decorate-style-predicate-default name)) diff --git a/lisp/cedet/semantic/dep.el b/lisp/cedet/semantic/dep.el index 0694b9c232..cae38e6f11 100644 --- a/lisp/cedet/semantic/dep.el +++ b/lisp/cedet/semantic/dep.el @@ -82,6 +82,7 @@ users will customize. Creates a customizable variable users can customize that will keep semantic data structures up to date." + (declare (indent defun)) `(progn ;; Create a variable users can customize. (defcustom ,name ,value diff --git a/lisp/cedet/semantic/lex-spp.el b/lisp/cedet/semantic/lex-spp.el index 8073640a8b..3297367db9 100644 --- a/lisp/cedet/semantic/lex-spp.el +++ b/lisp/cedet/semantic/lex-spp.el @@ -1165,7 +1165,8 @@ of type `spp-macro-def' is to be created. VALFORM are forms that return the value to be saved for this macro, or nil. When implementing a macro, you can use `semantic-lex-spp-stream-for-macro' to convert text into a lexical stream for storage in the macro." - (declare (debug (&define name stringp stringp form def-body))) + (declare (debug (&define name stringp stringp form def-body)) + (indent 1)) (let ((start (make-symbol "start")) (end (make-symbol "end")) (val (make-symbol "val")) @@ -1199,7 +1200,8 @@ REGEXP is a regular expression for the analyzer to match. See `define-lex-regex-analyzer' for more on regexp. TOKIDX is an index into REGEXP for which a new lexical token of type `spp-macro-undef' is to be created." - (declare (debug (&define name stringp stringp form))) + (declare (debug (&define name stringp stringp form)) + (indent 1)) (let ((start (make-symbol "start")) (end (make-symbol "end"))) `(define-lex-regex-analyzer ,name @@ -1260,7 +1262,8 @@ type of include. The return value should be of the form: (NAME . TYPE) where NAME is the name of the include, and TYPE is the type of the include, where a valid symbol is `system', or nil." - (declare (debug (&define name stringp stringp form def-body))) + (declare (debug (&define name stringp stringp form def-body)) + (indent 1)) (let ((start (make-symbol "start")) (end (make-symbol "end")) (val (make-symbol "val")) diff --git a/lisp/cedet/semantic/lex.el b/lisp/cedet/semantic/lex.el index 69f20deeb7..d524b733db 100644 --- a/lisp/cedet/semantic/lex.el +++ b/lisp/cedet/semantic/lex.el @@ -760,7 +760,7 @@ If two analyzers can match the same text, it is important to order the analyzers so that the one you want to match first occurs first. For example, it is good to put a number analyzer in front of a symbol analyzer which might mistake a number for a symbol." - (declare (debug (&define name stringp (&rest symbolp)))) + (declare (debug (&define name stringp (&rest symbolp))) (indent 1)) `(defun ,name (start end &optional depth length) ,(concat doc "\nSee `semantic-lex' for more information.") ;; Make sure the state of block parsing starts over. @@ -1096,7 +1096,7 @@ Proper action in FORMS is to move the value of `semantic-lex-end-point' to after the location of the analyzed entry, and to add any discovered tokens at the beginning of `semantic-lex-token-stream'. This can be done by using `semantic-lex-push-token'." - (declare (debug (&define name stringp form def-body))) + (declare (debug (&define name stringp form def-body)) (indent 1)) `(eval-and-compile ;; This is the real info used by `define-lex' (via semantic-lex-one-token). (defconst ,name '(,condition ,@forms) ,doc) @@ -1118,7 +1118,7 @@ This can be done by using `semantic-lex-push-token'." "Create a lexical analyzer with NAME and DOC that will match REGEXP. FORMS are evaluated upon a successful match. See `define-lex-analyzer' for more about analyzers." - (declare (debug (&define name stringp form def-body))) + (declare (debug (&define name stringp form def-body)) (indent 1)) `(define-lex-analyzer ,name ,doc (looking-at ,regexp) @@ -1137,7 +1137,8 @@ FORMS are evaluated upon a successful match BEFORE the new token is created. It is valid to ignore FORMS. See `define-lex-analyzer' for more about analyzers." (declare (debug - (&define name stringp form symbolp [ &optional form ] def-body))) + (&define name stringp form symbolp [ &optional form ] def-body)) + (indent 1)) `(define-lex-analyzer ,name ,doc (looking-at ,regexp) @@ -1162,7 +1163,8 @@ where BLOCK-SYM is the symbol returned in a block token. OPEN-DELIM and CLOSE-DELIM are respectively the open and close delimiters identifying a block. OPEN-SYM and CLOSE-SYM are respectively the symbols returned in open and close tokens." - (declare (debug (&define name stringp form (&rest form)))) + (declare (debug (&define name stringp form (&rest form))) + (indent 1)) (let ((specs (cons spec1 specs)) spec open olist clist) (while specs @@ -1471,6 +1473,7 @@ syntax as specified by the syntax table." (defmacro define-lex-keyword-type-analyzer (name doc syntax) "Define a keyword type analyzer NAME with DOC string. SYNTAX is the regexp that matches a keyword syntactic expression." + (declare (indent 1)) (let ((key (make-symbol "key"))) `(define-lex-analyzer ,name ,doc @@ -1486,6 +1489,7 @@ SYNTAX is the regexp that matches a keyword syntactic expression." "Define a sexp type analyzer NAME with DOC string. SYNTAX is the regexp that matches the beginning of the s-expression. TOKEN is the lexical token returned when SYNTAX matches." + (declare (indent 1)) `(define-lex-regex-analyzer ,name ,doc ,syntax @@ -1504,6 +1508,7 @@ SYNTAX is the regexp that matches a syntactic expression. MATCHES is an alist of lexical elements used to refine the syntactic expression. DEFAULT is the default lexical token returned when no MATCHES." + (declare (indent 1)) (if matches (let* ((val (make-symbol "val")) (lst (make-symbol "lst")) @@ -1536,6 +1541,7 @@ SYNTAX is the regexp that matches a syntactic expression. MATCHES is an alist of lexical elements used to refine the syntactic expression. DEFAULT is the default lexical token returned when no MATCHES." + (declare (indent 1)) (if matches (let* ((val (make-symbol "val")) (lst (make-symbol "lst")) @@ -1633,6 +1639,7 @@ When the lexer encounters the open-paren delimiter \"(\": - If the maximum depth of parenthesis tracking is reached (current depth >= max depth), it returns the whole parenthesis block as a (PAREN_BLOCK start . end) token." + (declare (indent 1)) (let* ((val (make-symbol "val")) (lst (make-symbol "lst")) (elt (make-symbol "elt"))) diff --git a/lisp/cedet/semantic/wisent.el b/lisp/cedet/semantic/wisent.el index f5f381d407..afcdd14282 100644 --- a/lisp/cedet/semantic/wisent.el +++ b/lisp/cedet/semantic/wisent.el @@ -66,7 +66,7 @@ Returned tokens must have the form: (TOKSYM VALUE START . END) where VALUE is the buffer substring between START and END positions." - (declare (debug (&define name stringp def-body))) + (declare (debug (&define name stringp def-body)) (indent 1)) `(defun ,name () ,doc (cond diff --git a/lisp/custom.el b/lisp/custom.el index 0cd4318e63..a04af9abaa 100644 --- a/lisp/custom.el +++ b/lisp/custom.el @@ -364,7 +364,8 @@ call that function directly. See Info node `(elisp) Customization' in the Emacs Lisp manual for more information." - (declare (doc-string 3) (debug (name body))) + (declare (doc-string 3) (debug (name body)) + (indent defun)) ;; It is better not to use backquote in this file, ;; because that makes a bootstrapping problem ;; if you need to recompile all the Lisp files using interpreted code. @@ -447,7 +448,7 @@ In the ATTS property list, possible attributes are `:family', See Info node `(elisp) Faces' in the Emacs Lisp manual for more information." - (declare (doc-string 3)) + (declare (doc-string 3) (indent defun)) ;; It is better not to use backquote in this file, ;; because that makes a bootstrapping problem ;; if you need to recompile all the Lisp files using interpreted code. @@ -511,7 +512,7 @@ For a list of valid keywords, see the common keywords listed in See Info node `(elisp) Customization' in the Emacs Lisp manual for more information." - (declare (doc-string 3)) + (declare (doc-string 3) (indent defun)) ;; It is better not to use backquote in this file, ;; because that makes a bootstrapping problem ;; if you need to recompile all the Lisp files using interpreted code. @@ -1142,6 +1143,7 @@ The optional argument DOC is a doc string describing the theme. Any theme `foo' should be defined in a file called `foo-theme.el'; see `custom-make-theme-feature' for more information." (declare (doc-string 2) + (indent 1) (advertised-calling-convention (theme &optional doc) "22.1")) (let ((feature (custom-make-theme-feature theme))) ;; It is better not to use backquote in this file, diff --git a/lisp/emacs-lisp/byte-run.el b/lisp/emacs-lisp/byte-run.el index da86fa5cec..d82d9454e8 100644 --- a/lisp/emacs-lisp/byte-run.el +++ b/lisp/emacs-lisp/byte-run.el @@ -380,7 +380,7 @@ You don't need this. (See bytecomp.el commentary for more details.) "Define an inline function. The syntax is just like that of `defun'. \(fn NAME ARGLIST &optional DOCSTRING DECL &rest BODY)" - (declare (debug defun) (doc-string 3)) + (declare (debug defun) (doc-string 3) (indent 2)) (or (memq (get name 'byte-optimizer) '(nil byte-compile-inline-expand)) (error "`%s' is a primitive" name)) @@ -434,7 +434,7 @@ WHEN should be a string indicating when the function was first made obsolete, for example a date or a release number. See the docstrings of `defalias' and `make-obsolete' for more details." - (declare (doc-string 4)) + (declare (doc-string 4) (indent defun)) `(progn (defalias ,obsolete-name ,current-name ,docstring) (make-obsolete ,obsolete-name ,current-name ,when))) @@ -483,7 +483,7 @@ For the benefit of Customize, if OBSOLETE-NAME has any of the following properties, they are copied to CURRENT-NAME, if it does not already have them: `saved-value', `saved-variable-comment'." - (declare (doc-string 4)) + (declare (doc-string 4) (indent defun)) `(progn (defvaralias ,obsolete-name ,current-name ,docstring) ;; See Bug#4706. diff --git a/lisp/emacs-lisp/derived.el b/lisp/emacs-lisp/derived.el index dd30846546..af5eecc22a 100644 --- a/lisp/emacs-lisp/derived.el +++ b/lisp/emacs-lisp/derived.el @@ -175,12 +175,7 @@ See Info node `(elisp)Derived Modes' for more details. (declare (debug (&define name symbolp sexp [&optional stringp] [&rest keywordp sexp] def-body)) (doc-string 4) - ;; Ask not what - ;;(indent 3) - ;; can do for you, ask what it can do to others. IOW, the - ;; missing of indentation setting here is the indentation - ;; setting and not an oversight. - ) + (indent defun)) (when (and docstring (not (stringp docstring))) ;; Some trickiness, since what appears to be the docstring may really be diff --git a/lisp/emacs-lisp/easy-mmode.el b/lisp/emacs-lisp/easy-mmode.el index f752861d80..db86e0e029 100644 --- a/lisp/emacs-lisp/easy-mmode.el +++ b/lisp/emacs-lisp/easy-mmode.el @@ -198,6 +198,7 @@ INIT-VALUE LIGHTER KEYMAP. \(fn MODE DOC [KEYWORD VAL ... &rest BODY])" (declare (doc-string 2) + (indent defun) (debug (&define name string-or-null-p [&optional [¬ keywordp] sexp &optional [¬ keywordp] sexp @@ -450,7 +451,7 @@ after running the major mode's hook. However, MODE is not turned on if the hook has explicitly disabled it. \(fn GLOBAL-MODE MODE TURN-ON [KEY VALUE]... BODY...)" - (declare (doc-string 2)) + (declare (doc-string 2) (indent defun)) (let* ((global-mode-name (symbol-name global-mode)) (mode-name (symbol-name mode)) (pretty-name (easy-mmode-pretty-mode-name mode)) diff --git a/lisp/emacs-lisp/eieio-compat.el b/lisp/emacs-lisp/eieio-compat.el index 6d84839c34..60b0638c63 100644 --- a/lisp/emacs-lisp/eieio-compat.el +++ b/lisp/emacs-lisp/eieio-compat.el @@ -70,7 +70,8 @@ is appropriate to use. Uses `defmethod' to create methods, and calls `defgeneric' for you. With this implementation the ARGS are currently ignored. You can use `defgeneric' to apply specialized top level documentation to a method." - (declare (doc-string 3) (obsolete cl-defgeneric "25.1")) + (declare (doc-string 3) (obsolete cl-defgeneric "25.1") + (indent defun)) `(eieio--defalias ',method (eieio--defgeneric-init-form ',method @@ -103,6 +104,7 @@ Summary: \"doc-string\" body)" (declare (doc-string 3) (obsolete cl-defmethod "25.1") + (indent defun) (debug (&define ; this means we are defining something [&name sexp] ;Allow (setf ...) additionally to symbols. diff --git a/lisp/emacs-lisp/eieio.el b/lisp/emacs-lisp/eieio.el index 2dc3e0aeff..3d73e5fef7 100644 --- a/lisp/emacs-lisp/eieio.el +++ b/lisp/emacs-lisp/eieio.el @@ -110,7 +110,7 @@ Options in CLOS not supported in EIEIO: Due to the way class options are set up, you can add any tags you wish, and reference them using the function `class-option'." - (declare (doc-string 4)) + (declare (doc-string 4) (indent defun)) (cl-check-type superclasses list) (cond ((and (stringp (car options-and-doc)) diff --git a/lisp/emacs-lisp/shortdoc.el b/lisp/emacs-lisp/shortdoc.el index 17ac3e471c..8f65437207 100644 --- a/lisp/emacs-lisp/shortdoc.el +++ b/lisp/emacs-lisp/shortdoc.el @@ -71,6 +71,7 @@ string, it'll be inserted as is, then the string will be `read', and then evaluated. There can be any number of :example/:result elements." + (declare (indent defun)) `(progn (setq shortdoc--groups (delq (assq ',group shortdoc--groups) shortdoc--groups)) diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 885d311cf3..2a28dafab2 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -1291,7 +1291,7 @@ Example: #\\='erc-replace-insert)) ((remove-hook \\='erc-insert-modify-hook #\\='erc-replace-insert)))" - (declare (doc-string 3)) + (declare (doc-string 3) (indent defun)) (let* ((sn (symbol-name name)) (mode (intern (format "erc-%s-mode" (downcase sn)))) (group (intern (format "erc-%s" (downcase sn)))) diff --git a/lisp/ezimage.el b/lisp/ezimage.el index 13f5c039a7..57033cde05 100644 --- a/lisp/ezimage.el +++ b/lisp/ezimage.el @@ -45,6 +45,7 @@ (defmacro defezimage (variable imagespec docstring) "Define VARIABLE as an image if `defimage' is not available. IMAGESPEC is the image data, and DOCSTRING is documentation for the image." + (declare (indent defun)) `(progn (defimage ,variable ,imagespec ,docstring) (put (quote ,variable) 'ezimage t))) diff --git a/lisp/gnus/gmm-utils.el b/lisp/gnus/gmm-utils.el index bcf8dd014b..68a9098904 100644 --- a/lisp/gnus/gmm-utils.el +++ b/lisp/gnus/gmm-utils.el @@ -239,6 +239,7 @@ DEFAULT-MAP specifies the default key map for ICON-LIST." "Create function NAME. If FUNCTION exists, then NAME becomes an alias for FUNCTION. Otherwise, create function NAME with ARG-LIST and BODY." + (declare (indent defun)) (let ((defined-p (fboundp function))) (if defined-p `(defalias ',name ',function) diff --git a/lisp/image.el b/lisp/image.el index 6e1dbbdf5c..2022b41d1f 100644 --- a/lisp/image.el +++ b/lisp/image.el @@ -791,7 +791,7 @@ Example: (defimage test-image ((:type xpm :file \"~/test1.xpm\") (:type xbm :file \"~/test1.xbm\")))" - (declare (doc-string 3)) + (declare (doc-string 3) (indent defun)) `(defvar ,symbol (find-image ',specs) ,doc)) diff --git a/lisp/international/ccl.el b/lisp/international/ccl.el index 629cd4c287..883b0b60fc 100644 --- a/lisp/international/ccl.el +++ b/lisp/international/ccl.el @@ -1553,7 +1553,7 @@ MAP := MAP-IDs := MAP-ID ... MAP-SET := MAP-IDs | (MAP-IDs) MAP-SET MAP-ID := integer" - (declare (doc-string 3)) + (declare (doc-string 3) (indent defun)) `(let ((prog ,(unwind-protect (progn ;; To make ,(charset-id CHARSET) works well. diff --git a/lisp/international/mule-conf.el b/lisp/international/mule-conf.el index 9a68fce2e8..ec027e9a93 100644 --- a/lisp/international/mule-conf.el +++ b/lisp/international/mule-conf.el @@ -148,6 +148,7 @@ (defmacro define-iso-single-byte-charset (symbol iso-symbol name nickname iso-ir iso-final emacs-mule-id map) + (declare (indent defun)) `(progn (define-charset ,symbol ,name diff --git a/lisp/net/hmac-def.el b/lisp/net/hmac-def.el index 5af6d4324a..5778857ff8 100644 --- a/lisp/net/hmac-def.el +++ b/lisp/net/hmac-def.el @@ -37,6 +37,7 @@ a string and return a digest of it (in binary form). B is a byte length of a block size of H. (B=64 for both SHA1 and MD5.) L is a byte length of hash outputs. (L=16 for MD5, L=20 for SHA1.) If BIT is non-nil, truncate output to specified bits." + (declare (indent defun)) `(defun ,name (text key) ,(concat "Compute " (upcase (symbol-name name)) diff --git a/lisp/obsolete/cl-compat.el b/lisp/obsolete/cl-compat.el index 619bc06122..0dba366192 100644 --- a/lisp/obsolete/cl-compat.el +++ b/lisp/obsolete/cl-compat.el @@ -52,6 +52,7 @@ ;;; Keyword routines not supported by new package. (defmacro defkeyword (x &optional doc) + (declare (indent defun)) (cl-list* 'defconst x (list 'quote x) (and doc (list doc)))) (defun keyword-of (sym) diff --git a/lisp/obsolete/cl.el b/lisp/obsolete/cl.el index 9df6231857..a892ed7c76 100644 --- a/lisp/obsolete/cl.el +++ b/lisp/obsolete/cl.el @@ -513,7 +513,8 @@ a temporary-variables list, a value-forms list, a store-variables list See `gv-define-expander', and `gv-define-setter' for better and simpler ways to define setf-methods." (declare (debug - (&define name cl-lambda-list cl-declarations-or-string def-body))) + (&define name cl-lambda-list cl-declarations-or-string def-body)) + (indent defun)) `(progn ,@(if (stringp (car body)) (list `(put ',name 'setf-documentation ,(pop body)))) @@ -554,7 +555,8 @@ You can replace this form with `gv-define-setter'. (&define name [&or [symbolp &optional stringp] [cl-lambda-list (symbolp)]] - cl-declarations-or-string def-body))) + cl-declarations-or-string def-body)) + (indent defun)) (if (and (listp arg1) (consp args)) ;; Like `gv-define-setter' but with `cl-function'. `(gv-define-expander ,name @@ -615,7 +617,8 @@ arguments from ARGLIST using FUNC. For example: You can replace this macro with `gv-letplace'." (declare (debug (&define name cl-lambda-list ;; should exclude &key - symbolp &optional stringp))) + symbolp &optional stringp)) + (indent defun)) (if (memq '&key arglist) (error "&key not allowed in define-modify-macro")) (require 'cl-macs) ;For cl--arglist-args. diff --git a/lisp/progmodes/cc-vars.el b/lisp/progmodes/cc-vars.el index d843c783ed..83fd3da7c1 100644 --- a/lisp/progmodes/cc-vars.el +++ b/lisp/progmodes/cc-vars.el @@ -179,7 +179,7 @@ STYLE stands for the choice where the value is taken from some style setting. PREAMBLE is optionally prepended to FOO; that is, if FOO contains :tag or :value, the respective two-element list component is ignored." - (declare (debug (symbolp form stringp &rest))) + (declare (debug (symbolp form stringp &rest)) (indent defun)) (let* ((expanded-doc (concat doc " This is a style variable. Apart from the valid values described diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el index 73f9806811..2b480e8950 100644 --- a/lisp/progmodes/compile.el +++ b/lisp/progmodes/compile.el @@ -2227,6 +2227,7 @@ The parent is always `compilation-mode' and the customizable `compilation-...' variables are also set from the name of the mode you have chosen, by replacing the first word, e.g., `compilation-scroll-output' from `grep-scroll-output' if that variable exists." + (declare (indent defun)) (let ((mode-name (replace-regexp-in-string "-mode\\'" "" (symbol-name mode)))) `(define-derived-mode ,mode compilation-mode ,name ,doc diff --git a/lisp/progmodes/gdb-mi.el b/lisp/progmodes/gdb-mi.el index fa54f51160..39fcfd341c 100644 --- a/lisp/progmodes/gdb-mi.el +++ b/lisp/progmodes/gdb-mi.el @@ -1612,6 +1612,7 @@ this trigger is subscribed to `gdb-buf-publisher' and called with ;; Used to display windows with thread-bound buffers (defmacro def-gdb-preempt-display-buffer (name buffer &optional doc split-horizontal) + (declare (indent defun)) `(defun ,name (&optional thread) ,(when doc doc) (message "%s" thread) @@ -3012,6 +3013,7 @@ calling `gdb-current-context-command'). Triggers defined by this command are meant to be used as a trigger argument when describing buffer types with `gdb-set-buffer-rules'." + (declare (indent defun)) `(defun ,trigger-name (&optional signal) (when (or (not ,signal-list) @@ -3032,6 +3034,7 @@ Erase current buffer and evaluate CUSTOM-DEFUN. Then call `gdb-update-buffer-name'. If NOPRESERVE is non-nil, window point is not restored after CUSTOM-DEFUN." + (declare (indent defun)) `(defun ,handler-name () (let* ((inhibit-read-only t) ,@(unless nopreserve @@ -3055,6 +3058,7 @@ See `def-gdb-auto-update-trigger'. HANDLER-NAME handler uses customization of CUSTOM-DEFUN. See `def-gdb-auto-update-handler'." + (declare (indent defun)) `(progn (def-gdb-auto-update-trigger ,trigger-name ,gdb-command @@ -3473,6 +3477,7 @@ corresponding to the mode line clicked." CUSTOM-DEFUN may use locally bound `thread' variable, which will be the value of `gdb-thread' property of the current line. If `gdb-thread' is nil, error is signaled." + (declare (indent defun)) `(defun ,name (&optional event) ,(when doc doc) (interactive (list last-input-event)) @@ -3488,6 +3493,7 @@ If `gdb-thread' is nil, error is signaled." &optional doc) "Define a NAME which will call BUFFER-COMMAND with id of thread on the current line." + (declare (indent defun)) `(def-gdb-thread-buffer-command ,name (,buffer-command (gdb-mi--field thread 'id)) ,doc)) @@ -3543,6 +3549,7 @@ on the current line." "Define a NAME which will execute GUD-COMMAND with `gdb-thread-number' locally bound to id of thread on the current line." + (declare (indent defun)) `(def-gdb-thread-buffer-command ,name (if gdb-non-stop (let ((gdb-thread-number (gdb-mi--field thread 'id)) @@ -3711,6 +3718,7 @@ in `gdb-memory-format'." (defmacro def-gdb-set-positive-number (name variable echo-string &optional doc) "Define a function NAME which reads new VAR value from minibuffer." + (declare (indent defun)) `(defun ,name (event) ,(when doc doc) (interactive "e") @@ -3739,6 +3747,7 @@ in `gdb-memory-format'." "Define a function NAME to switch memory buffer to use FORMAT. DOC is an optional documentation string." + (declare (indent defun)) `(defun ,name () ,(when doc doc) (interactive) (customize-set-variable 'gdb-memory-format ,format) @@ -3808,6 +3817,7 @@ DOC is an optional documentation string." "Define a function NAME to switch memory unit size to UNIT-SIZE. DOC is an optional documentation string." + (declare (indent defun)) `(defun ,name () ,(when doc doc) (interactive) (customize-set-variable 'gdb-memory-unit ,unit-size) @@ -3832,6 +3842,7 @@ The defined function switches Memory buffer to show address stored in ADDRESS-VAR variable. DOC is an optional documentation string." + (declare (indent defun)) `(defun ,name ,(when doc doc) (interactive) diff --git a/lisp/progmodes/gud.el b/lisp/progmodes/gud.el index 2061d41480..9b884c4ff8 100644 --- a/lisp/progmodes/gud.el +++ b/lisp/progmodes/gud.el @@ -3539,8 +3539,8 @@ Treats actions as defuns." #'gdb-script-end-of-defun) (setq-local font-lock-defaults '(gdb-script-font-lock-keywords nil nil ((?_ . "w")) nil - (font-lock-syntactic-face-function - . gdb-script-font-lock-syntactic-face))) + (font-lock-syntactic-face-function + . gdb-script-font-lock-syntactic-face))) ;; Recognize docstrings. (setq-local syntax-propertize-function gdb-script-syntax-propertize-function) diff --git a/lisp/simple.el b/lisp/simple.el index 841983a3b6..7b6c52a389 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -9859,6 +9859,7 @@ does not have any effect until this variable is set. CUSTOMIZATIONS, if non-nil, should be composed of alternating `defcustom' keywords and values to add to the declaration of `COMMAND-alternatives' (typically :group and :version)." + (declare (indent defun)) (let* ((command-name (symbol-name command)) (varalt-name (concat command-name "-alternatives")) (varalt-sym (intern varalt-name)) diff --git a/lisp/skeleton.el b/lisp/skeleton.el index c363fb2c48..2b183996d8 100644 --- a/lisp/skeleton.el +++ b/lisp/skeleton.el @@ -113,7 +113,8 @@ are integer buffer positions in the reverse order of the insertion order.") "Define a user-configurable COMMAND that enters a statement skeleton. DOCUMENTATION is that of the command. SKELETON is as defined under `skeleton-insert'." - (declare (doc-string 2) (debug (&define name stringp skeleton-edebug-spec))) + (declare (doc-string 2) (debug (&define name stringp skeleton-edebug-spec)) + (indent defun)) (if skeleton-debug (set command skeleton)) `(progn diff --git a/lisp/subr.el b/lisp/subr.el index 46cd4c127d..a1858e5911 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -193,7 +193,7 @@ set earlier in the `setq-local'. The return value of the "Define VAR as a buffer-local variable with default value VAL. Like `defvar' but additionally marks the variable as being automatically buffer-local wherever it is set." - (declare (debug defvar) (doc-string 3)) + (declare (debug defvar) (doc-string 3) (indent 2)) ;; Can't use backquote here, it's too early in the bootstrap. (list 'progn (list 'defvar var val docstring) (list 'make-variable-buffer-local (list 'quote var)))) @@ -6551,6 +6551,7 @@ macro also accepts a `:doc' keyword, which (if present) is used as the variable documentation string. \(fn VARIABLE-NAME &key DOC FULL PARENT SUPPRESS NAME PREFIX KEYMAP &rest [KEY DEFINITION]...)" + (declare (indent 1)) (let ((opts nil) doc) (while (and defs diff --git a/lisp/vc/pcvs.el b/lisp/vc/pcvs.el index 8f662e8458..0413b2bc56 100644 --- a/lisp/vc/pcvs.el +++ b/lisp/vc/pcvs.el @@ -758,6 +758,7 @@ clear what alternative to use. - `DOUBLE' is the generic case." (declare (debug (&define sexp lambda-list stringp ("interactive" interactive) def-body)) + (indent defun) (doc-string 3)) (let ((style (cvs-cdr fun)) (fun (cvs-car fun))) diff --git a/lisp/widget.el b/lisp/widget.el index 0d1977164b..0232f6cf93 100644 --- a/lisp/widget.el +++ b/lisp/widget.el @@ -44,7 +44,7 @@ ;; (list 'or (list 'boundp (list 'car 'keywords)) ;; (list 'set (list 'car 'keywords) (list 'car 'keywords))) ;; (list 'setq 'keywords (list 'cdr 'keywords))))) - (declare (obsolete nil "27.1")) + (declare (obsolete nil "27.1") (indent defun)) nil) ;;(define-widget-keywords :documentation-indent commit 43f59b91aa2bc5e1771ed68e9a3a84b4aef26ef4 Author: Lars Ingebrigtsen Date: Wed Oct 13 21:21:23 2021 +0200 Mark all def* functions that should indent as `defun' * lisp/abbrev.el (define-abbrev): (define-abbrev-table): Mark all functions that have names that start with "def" that should indent according to the current heuristics (bug#43329). * lisp/autoinsert.el (define-auto-insert): * lisp/button.el (define-button-type): * lisp/subr.el (define-key-after): (define-mail-user-agent): (define-keymap): * lisp/widget.el (define-widget): * lisp/emacs-lisp/package.el (define-package): * lisp/international/mule-cmds.el (define-char-code-property): * lisp/international/mule.el (define-charset): (define-coding-system): (define-translation-table): (define-translation-hash-table): diff --git a/lisp/abbrev.el b/lisp/abbrev.el index b0e8a4fa99..d3daf637cc 100644 --- a/lisp/abbrev.el +++ b/lisp/abbrev.el @@ -583,6 +583,7 @@ PROPS is a property list. The following properties are special: An obsolete but still supported calling form is: \(define-abbrev TABLE NAME EXPANSION &optional HOOK COUNT SYSTEM)." + (declare (indent defun)) (when (and (consp props) (or (null (car props)) (numberp (car props)))) ;; Old-style calling convention. (setq props `(:count ,(car props) @@ -1139,7 +1140,7 @@ Properties with special meaning: - `:enable-function' can be set to a function of no argument which returns non-nil if and only if the abbrevs in this table should be used for this instance of `expand-abbrev'." - (declare (doc-string 3)) + (declare (doc-string 3) (indent defun)) ;; We used to manually add the docstring, but we also want to record this ;; location as the definition of the variable (in load-history), so we may ;; as well just use `defvar'. diff --git a/lisp/autoinsert.el b/lisp/autoinsert.el index 063d0a14d6..b448c0f8da 100644 --- a/lisp/autoinsert.el +++ b/lisp/autoinsert.el @@ -415,6 +415,7 @@ Matches the visited file name against the elements of `auto-insert-alist'." "Associate CONDITION with (additional) ACTION in `auto-insert-alist'. Optional AFTER means to insert action after all existing actions for CONDITION, or if CONDITION had no actions, after all other CONDITIONs." + (declare (indent defun)) (let ((elt (assoc condition auto-insert-alist))) (if elt (setcdr elt diff --git a/lisp/button.el b/lisp/button.el index aedd07b762..acf7646433 100644 --- a/lisp/button.el +++ b/lisp/button.el @@ -130,6 +130,7 @@ In addition, the keyword argument :supertype may be used to specify a `button-type' from which NAME inherits its default property values (however, the inheritance happens only when NAME is defined; subsequent changes to a supertype are not reflected in its subtypes)." + (declare (indent defun)) (let ((catsym (make-symbol (concat (symbol-name name) "-button"))) (super-catsym (button-category-symbol diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index 5445fa970f..40318dcb65 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -714,6 +714,7 @@ REQUIREMENTS is a list of dependencies on other packages. where OTHER-VERSION is a string. EXTRA-PROPERTIES is currently unused." + (declare (indent defun)) ;; FIXME: Placeholder! Should we keep it? (error "Don't call me!")) diff --git a/lisp/international/mule-cmds.el b/lisp/international/mule-cmds.el index a0a6557c95..94d2f82e8c 100644 --- a/lisp/international/mule-cmds.el +++ b/lisp/international/mule-cmds.el @@ -2927,6 +2927,7 @@ Optional 3rd argument DOCSTRING is a documentation string of the property. See also the documentation of `get-char-code-property' and `put-char-code-property'." + (declare (indent defun)) (or (symbolp name) (error "Not a symbol: %s" name)) (if (char-table-p table) diff --git a/lisp/international/mule.el b/lisp/international/mule.el index 5022a17db5..3e45a64dc9 100644 --- a/lisp/international/mule.el +++ b/lisp/international/mule.el @@ -218,6 +218,7 @@ corresponding Unicode character code. If it is a string, it is a name of file that contains the above information. The file format is the same as what described for `:map' attribute." + (declare (indent defun)) (when (vectorp (car props)) ;; Old style code: ;; (define-charset CHARSET-ID CHARSET-SYMBOL INFO-VECTOR) @@ -890,6 +891,7 @@ non-nil. VALUE non-nil means Emacs prefers UTF-8 on code detection for non-ASCII files. This attribute is meaningful only when `:coding-type' is `undecided'." + (declare (indent defun)) (let* ((common-attrs (mapcar 'list '(:mnemonic :coding-type @@ -2320,6 +2322,7 @@ This function sets properties `translation-table' and `translation-table-id' of SYMBOL to the created table itself and the identification number of the table respectively. It also registers the table in `translation-table-vector'." + (declare (indent defun)) (let ((table (if (and (char-table-p (car args)) (eq (char-table-subtype (car args)) 'translation-table)) @@ -2394,6 +2397,7 @@ Value is what BODY returns." Analogous to `define-translation-table', but updates `translation-hash-table-vector' and the table is for use in the CCL `lookup-integer' and `lookup-character' functions." + (declare (indent defun)) (unless (and (symbolp symbol) (hash-table-p table)) (error "Bad args to define-translation-hash-table")) diff --git a/lisp/subr.el b/lisp/subr.el index 805c14eae3..46cd4c127d 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -1000,6 +1000,7 @@ Bindings are always added before any inherited map. The order of bindings in a keymap matters only when it is used as a menu, so this function is not useful for non-menu keymaps." + (declare (indent defun)) (unless after (setq after t)) (or (keymapp keymap) (signal 'wrong-type-argument (list 'keymapp keymap))) @@ -5572,6 +5573,7 @@ If HOOKVAR is nil, `mail-send-hook' is used. The properties used on SYMBOL are `composefunc', `sendfunc', `abortfunc', and `hookvar'." + (declare (indent defun)) (put symbol 'composefunc composefunc) (put symbol 'sendfunc sendfunc) (put symbol 'abortfunc (or abortfunc #'kill-buffer)) @@ -6491,6 +6493,7 @@ also be the special symbol `:menu', in which case DEFINITION should be a MENU form as accepted by `easy-menu-define'. \(fn &key FULL PARENT SUPPRESS NAME PREFIX KEYMAP &rest [KEY DEFINITION]...)" + (declare (indent defun)) (define-keymap--define definitions)) (defun define-keymap--define (definitions) diff --git a/lisp/widget.el b/lisp/widget.el index 393fe6c21b..0d1977164b 100644 --- a/lisp/widget.el +++ b/lisp/widget.el @@ -83,7 +83,7 @@ create identical widgets: * (apply #\\='widget-create CLASS ARGS) The third argument DOC is a documentation string for the widget." - (declare (doc-string 3)) + (declare (doc-string 3) (indent defun)) ;; (unless (or (null doc) (stringp doc)) (error "Widget documentation must be nil or a string")) commit 9b1adf8b4feaf92f5229839edfe42fe89ceba677 Author: Philip Kaludercic Date: Wed Oct 13 21:49:28 2021 +0200 Use browse-url-button-regexp for rcirc-url-regexp * rcirc.el (rcirc-url-regexp): Copy improved regexp from browse-url diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el index c18748ae09..52d74a3394 100644 --- a/lisp/net/rcirc.el +++ b/lisp/net/rcirc.el @@ -2827,24 +2827,9 @@ keywords when no KEYWORD is given." string)) (defvar rcirc-url-regexp - (concat - "\\b\\(\\(www\\.\\|\\(s?https?\\|ftp\\|file\\|gopher\\|" - "nntp\\|news\\|telnet\\|wais\\|mailto\\|info\\):\\)" - "\\(//[-a-z0-9_.]+:[0-9]*\\)?" - (if (string-match "[[:digit:]]" "1") ;; Support POSIX? - (let ((chars "-a-z0-9_=#$@~%&*+\\/[:word:]") - (punct "!?:;.,")) - (concat - "\\(?:" - ;; Match paired parentheses, e.g. in Wikipedia URLs: - "[" chars punct "]+" "(" "[" chars punct "]+" ")" "[" chars "]" - "\\|" - "[" chars punct "]+" "[" chars "]" - "\\)")) - (concat ;; XEmacs 21.4 doesn't support POSIX. - "\\([-a-z0-9_=!?#$@~%&*+\\/:;.,]\\|\\w\\)+" - "\\([-a-z0-9_=#$@~%&*+\\/]\\|\\w\\)")) - "\\)") + (eval-when-compile + (require 'browse-url) + browse-url-button-regexp) "Regexp matching URLs. Set to nil to disable URL features in rcirc.") ;; cf cl-remove-if-not commit 9ed53b022db7df2d027a82af6897ea8ac977664b Author: Juri Linkov Date: Wed Oct 13 22:17:27 2021 +0300 * lisp/help.el (help--analyze-key): Avoid mouse-set-point for non-mouse events (bug#51173) diff --git a/lisp/help.el b/lisp/help.el index eaca33795a..7e2e492a36 100644 --- a/lisp/help.el +++ b/lisp/help.el @@ -695,11 +695,13 @@ Returns a list of the form (BRIEF-DESC DEFN EVENT MOUSE-MSG)." (mouse-msg (if (or (memq 'click modifiers) (memq 'down modifiers) (memq 'drag modifiers)) " at that spot" "")) - ;; Use mouse-set-point to handle the case when a menu item + ;; Use `mouse-set-point' to handle the case when a menu item ;; is selected from the context menu that should describe KEY ;; at the position of mouse click that opened the context menu. - ;; When no mouse was involved, it defaults to window-point. - (defn (save-excursion (mouse-set-point event) (key-binding key t)))) + ;; When no mouse was involved, don't use `mouse-set-point'. + (defn (if (consp event) + (save-excursion (mouse-set-point event) (key-binding key t)) + (key-binding key t)))) ;; Handle the case where we faked an entry in "Select and Paste" menu. (when (and (eq defn nil) (stringp (aref key (1- (length key)))) commit 5be4483d33e574d30146e06b7ed083d1e1ece3d6 Author: Paul Eggert Date: Wed Oct 13 11:16:54 2021 -0700 Pacify gcc -Warray-parameter * src/pdumper.h: Declare array parameter with the same signature that the function definition uses. diff --git a/src/pdumper.h b/src/pdumper.h index 79f8bce2d8..7f1f5e46ad 100644 --- a/src/pdumper.h +++ b/src/pdumper.h @@ -21,6 +21,7 @@ along with GNU Emacs. If not, see . */ #define EMACS_PDUMPER_H #include +#include "fingerprint.h" #include "lisp.h" INLINE_HEADER_BEGIN @@ -52,7 +53,7 @@ enum { PDUMPER_NO_OBJECT = -1 }; pdumper_remember_scalar (&(thing), sizeof (thing)) extern void dump_fingerprint (FILE *output, const char *label, - const unsigned char *xfingerprint); + unsigned char const fingerp[sizeof fingerprint]); extern void pdumper_remember_scalar_impl (void *data, ptrdiff_t nbytes); commit 33525102e728134f5f7399a3490a154bb0078e6d Author: Paul Eggert Date: Wed Oct 13 11:16:33 2021 -0700 Pacify GCC -Wanalyzer-possible-null-dereference This fixes the only remaining GCC diagnostics when emacs-28 is configured with --enable-gcc-warnings. It does so by adding ATTRIBUTE_RETURNS_NONNULL so that GCC knows certain functions return nonnull. It also arranges for three of those functions to always return nonnull; I thought these functions already were doing so, but apparently not, and it is conceivable (though I haven’t checked this) that changing these functions to always return nonnull even on non-GNU platforms may fix unlikely portability bugs elsewhere in Emacs. I used GCC 11.2.1 20210728 (Red Hat 11.2.1-1) on x86-64 when checking the diagnostics. * configure.ac: Invoke gl_EEMALLOC before gl_INIT, in case the regex code doesn't invoke gl_EEMALLOC; needed for src/alloc.c’s use of MALLOC_0_IS_NONNULL. * src/alloc.c (xmalloc, xzalloc, xrealloc): Don’t worry about the special case where SIZE == 0, since lmalloc and lrealloc now return null only on allocation failure. (lmalloc, lrealloc): Return null only on allocation failure, instead of having special cases that treat malloc (0) and realloc (X, 0) as successes even when they return null. * src/lisp.h: Add ATTRIBUTE_RETURNS_NONNULL to a few functions that always return nonnull pointers, so that gcc -fanalyzer does not issue diagnostics like “alloc.c: In function ‘allocate_vector_block’: alloc.c:2985:15: warning: dereference of possibly-NULL ‘block’ [CWE-690] [-Wanalyzer-possible-null-dereference]” as per . diff --git a/configure.ac b/configure.ac index bd7ff2e1b7..9ab0314428 100644 --- a/configure.ac +++ b/configure.ac @@ -5673,6 +5673,7 @@ CFLAGS=$pre_PKG_CONFIG_CFLAGS LIBS="$LIB_PTHREAD $pre_PKG_CONFIG_LIBS" gl_ASSERT_NO_GNULIB_POSIXCHECK gl_ASSERT_NO_GNULIB_TESTS +gl_EEMALLOC gl_INIT CFLAGS=$SAVE_CFLAGS LIBS=$SAVE_LIBS diff --git a/src/alloc.c b/src/alloc.c index 0c04d5cde0..aa790d3afa 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -765,7 +765,7 @@ xmalloc (size_t size) val = lmalloc (size, false); MALLOC_UNBLOCK_INPUT; - if (!val && size) + if (!val) memory_full (size); MALLOC_PROBE (size); return val; @@ -782,7 +782,7 @@ xzalloc (size_t size) val = lmalloc (size, true); MALLOC_UNBLOCK_INPUT; - if (!val && size) + if (!val) memory_full (size); MALLOC_PROBE (size); return val; @@ -796,15 +796,15 @@ xrealloc (void *block, size_t size) void *val; MALLOC_BLOCK_INPUT; - /* We must call malloc explicitly when BLOCK is 0, since some - reallocs don't do this. */ + /* Call lmalloc when BLOCK is null, for the benefit of long-obsolete + platforms lacking support for realloc (NULL, size). */ if (! block) val = lmalloc (size, false); else val = lrealloc (block, size); MALLOC_UNBLOCK_INPUT; - if (!val && size) + if (!val) memory_full (size); MALLOC_PROBE (size); return val; @@ -988,8 +988,7 @@ record_xmalloc (size_t size) /* Like malloc but used for allocating Lisp data. NBYTES is the number of bytes to allocate, TYPE describes the intended use of the - allocated memory block (for strings, for conses, ...). - NBYTES must be positive. */ + allocated memory block (for strings, for conses, ...). */ #if ! USE_LSB_TAG void *lisp_malloc_loser EXTERNALLY_VISIBLE; @@ -1330,16 +1329,20 @@ laligned (void *p, size_t size) || size % LISP_ALIGNMENT != 0); } -/* Like malloc and realloc except that if SIZE is Lisp-aligned, make - sure the result is too, if necessary by reallocating (typically - with larger and larger sizes) until the allocator returns a - Lisp-aligned pointer. Code that needs to allocate C heap memory +/* Like malloc and realloc except return null only on failure, + the result is Lisp-aligned if SIZE is, and lrealloc's pointer + argument must be nonnull. Code allocating C heap memory for a Lisp object should use one of these functions to obtain a pointer P; that way, if T is an enum Lisp_Type value and L == make_lisp_ptr (P, T), then XPNTR (L) == P and XTYPE (L) == T. + If CLEARIT, arrange for the allocated memory to be cleared. + This might use calloc, as calloc can be faster than malloc+memset. + On typical modern platforms these functions' loops do not iterate. - On now-rare (and perhaps nonexistent) platforms, the loops in + On now-rare (and perhaps nonexistent) platforms, the code can loop, + reallocating (typically with larger and larger sizes) until the + allocator returns a Lisp-aligned pointer. This loop in theory could repeat forever. If an infinite loop is possible on a platform, a build would surely loop and the builder can then send us a bug report. Adding a counter to try to detect any such loop @@ -1353,8 +1356,13 @@ lmalloc (size_t size, bool clearit) if (! MALLOC_IS_LISP_ALIGNED && size % LISP_ALIGNMENT == 0) { void *p = aligned_alloc (LISP_ALIGNMENT, size); - if (clearit && p) - memclear (p, size); + if (p) + { + if (clearit) + memclear (p, size); + } + else if (! (MALLOC_0_IS_NONNULL || size)) + return aligned_alloc (LISP_ALIGNMENT, LISP_ALIGNMENT); return p; } #endif @@ -1362,7 +1370,7 @@ lmalloc (size_t size, bool clearit) while (true) { void *p = clearit ? calloc (1, size) : malloc (size); - if (laligned (p, size)) + if (laligned (p, size) && (MALLOC_0_IS_NONNULL || size || p)) return p; free (p); size_t bigger = size + LISP_ALIGNMENT; @@ -1377,7 +1385,7 @@ lrealloc (void *p, size_t size) while (true) { p = realloc (p, size); - if (laligned (p, size)) + if (laligned (p, size) && (size || p)) return p; size_t bigger = size + LISP_ALIGNMENT; if (size < bigger) diff --git a/src/lisp.h b/src/lisp.h index 480c389a3b..31656bb3b1 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -3947,7 +3947,8 @@ build_string (const char *str) extern Lisp_Object pure_cons (Lisp_Object, Lisp_Object); extern Lisp_Object make_vector (ptrdiff_t, Lisp_Object); -extern struct Lisp_Vector *allocate_nil_vector (ptrdiff_t); +extern struct Lisp_Vector *allocate_nil_vector (ptrdiff_t) + ATTRIBUTE_RETURNS_NONNULL; /* Make an uninitialized vector for SIZE objects. NOTE: you must be sure that GC cannot happen until the vector is completely @@ -3960,7 +3961,8 @@ extern struct Lisp_Vector *allocate_nil_vector (ptrdiff_t); allocate_vector has a similar problem. */ -extern struct Lisp_Vector *allocate_vector (ptrdiff_t); +extern struct Lisp_Vector *allocate_vector (ptrdiff_t) + ATTRIBUTE_RETURNS_NONNULL; INLINE Lisp_Object make_uninit_vector (ptrdiff_t size) @@ -3992,7 +3994,8 @@ make_nil_vector (ptrdiff_t size) } extern struct Lisp_Vector *allocate_pseudovector (int, int, int, - enum pvec_type); + enum pvec_type) + ATTRIBUTE_RETURNS_NONNULL; /* Allocate uninitialized pseudovector with no Lisp_Object slots. */ @@ -4024,7 +4027,7 @@ extern void free_cons (struct Lisp_Cons *); extern void init_alloc_once (void); extern void init_alloc (void); extern void syms_of_alloc (void); -extern struct buffer * allocate_buffer (void); +extern struct buffer *allocate_buffer (void) ATTRIBUTE_RETURNS_NONNULL; extern int valid_lisp_object_p (Lisp_Object); /* Defined in gmalloc.c. */ @@ -4182,7 +4185,8 @@ extern Lisp_Object internal_condition_case_n (Lisp_Object (*) (ptrdiff_t, Lisp_Object *), ptrdiff_t, Lisp_Object *, Lisp_Object, Lisp_Object (*) (Lisp_Object, ptrdiff_t, Lisp_Object *)); extern Lisp_Object internal_catch_all (Lisp_Object (*) (void *), void *, Lisp_Object (*) (enum nonlocal_exit, Lisp_Object)); -extern struct handler *push_handler (Lisp_Object, enum handlertype); +extern struct handler *push_handler (Lisp_Object, enum handlertype) + ATTRIBUTE_RETURNS_NONNULL; extern struct handler *push_handler_nosignal (Lisp_Object, enum handlertype); extern void specbind (Lisp_Object, Lisp_Object); extern void record_unwind_protect (void (*) (Lisp_Object), Lisp_Object); @@ -4323,9 +4327,10 @@ extern void syms_of_marker (void); /* Defined in fileio.c. */ -extern char *splice_dir_file (char *, char const *, char const *); +extern char *splice_dir_file (char *, char const *, char const *) + ATTRIBUTE_RETURNS_NONNULL; extern bool file_name_absolute_p (const char *); -extern char const *get_homedir (void); +extern char const *get_homedir (void) ATTRIBUTE_RETURNS_NONNULL; extern Lisp_Object expand_and_dir_to_file (Lisp_Object); extern Lisp_Object write_region (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, @@ -4479,7 +4484,7 @@ INLINE void fixup_locale (void) {} INLINE void synchronize_system_messages_locale (void) {} INLINE void synchronize_system_time_locale (void) {} #endif -extern char *emacs_strerror (int); +extern char *emacs_strerror (int) ATTRIBUTE_RETURNS_NONNULL; extern void shut_down_emacs (int, Lisp_Object); /* True means don't do interactive redisplay and don't change tty modes. */ @@ -4545,7 +4550,7 @@ extern void setup_process_coding_systems (Lisp_Object); extern int emacs_spawn (pid_t *, int, int, int, char **, char **, const char *, const char *, const sigset_t *); -extern char **make_environment_block (Lisp_Object); +extern char **make_environment_block (Lisp_Object) ATTRIBUTE_RETURNS_NONNULL; extern void init_callproc_1 (void); extern void init_callproc (void); extern void set_initial_environment (void); @@ -4814,17 +4819,24 @@ extern char my_edata[]; extern char my_endbss[]; extern char *my_endbss_static; -extern void *xmalloc (size_t) ATTRIBUTE_MALLOC_SIZE ((1)); -extern void *xzalloc (size_t) ATTRIBUTE_MALLOC_SIZE ((1)); -extern void *xrealloc (void *, size_t) ATTRIBUTE_ALLOC_SIZE ((2)); +extern void *xmalloc (size_t) + ATTRIBUTE_MALLOC_SIZE ((1)) ATTRIBUTE_RETURNS_NONNULL; +extern void *xzalloc (size_t) + ATTRIBUTE_MALLOC_SIZE ((1)) ATTRIBUTE_RETURNS_NONNULL; +extern void *xrealloc (void *, size_t) + ATTRIBUTE_ALLOC_SIZE ((2)) ATTRIBUTE_RETURNS_NONNULL; extern void xfree (void *); -extern void *xnmalloc (ptrdiff_t, ptrdiff_t) ATTRIBUTE_MALLOC_SIZE ((1,2)); +extern void *xnmalloc (ptrdiff_t, ptrdiff_t) + ATTRIBUTE_MALLOC_SIZE ((1,2)) ATTRIBUTE_RETURNS_NONNULL; extern void *xnrealloc (void *, ptrdiff_t, ptrdiff_t) - ATTRIBUTE_ALLOC_SIZE ((2,3)); -extern void *xpalloc (void *, ptrdiff_t *, ptrdiff_t, ptrdiff_t, ptrdiff_t); - -extern char *xstrdup (const char *) ATTRIBUTE_MALLOC; -extern char *xlispstrdup (Lisp_Object) ATTRIBUTE_MALLOC; + ATTRIBUTE_ALLOC_SIZE ((2,3)) ATTRIBUTE_RETURNS_NONNULL; +extern void *xpalloc (void *, ptrdiff_t *, ptrdiff_t, ptrdiff_t, ptrdiff_t) + ATTRIBUTE_RETURNS_NONNULL; + +extern char *xstrdup (char const *) + ATTRIBUTE_MALLOC ATTRIBUTE_RETURNS_NONNULL; +extern char *xlispstrdup (Lisp_Object) + ATTRIBUTE_MALLOC ATTRIBUTE_RETURNS_NONNULL; extern void dupstring (char **, char const *); /* Make DEST a copy of STRING's data. Return a pointer to DEST's terminating @@ -4874,7 +4886,8 @@ extern void init_system_name (void); enum MAX_ALLOCA { MAX_ALLOCA = 16 * 1024 }; -extern void *record_xmalloc (size_t) ATTRIBUTE_ALLOC_SIZE ((1)); +extern void *record_xmalloc (size_t) + ATTRIBUTE_ALLOC_SIZE ((1)) ATTRIBUTE_RETURNS_NONNULL; #define USE_SAFE_ALLOCA \ ptrdiff_t sa_avail = MAX_ALLOCA; \ commit 8e072e6abef2bf1ec75b7c73883caeb7b7459eb1 Merge: 396d2d88af efb1cd7fa9 Author: Paul Eggert Date: Wed Oct 13 11:19:12 2021 -0700 Merge from origin/emacs-28 efb1cd7fa9 ; * etc/charsets/README: Update the format documentation. cc796b7409 Tramp doc cleanup a338d46060 Make emacs-lisp-byte-compile-and-load load the .elc file a... 3eac7dc780 Fix point movement in image-dired 4e9452a399 Improve shortdoc for vector f223ac6ef9 Fix test bug when calloc returns null ebeaa54f19 Pacify GCC 11 -fanalyzer on x86-64 56d1f42f30 Improve handling of non-character events in input methods 3fbe6fd367 ; Fix mistakes in last doc rewording about shorthands commit 396d2d88afe254715eb3b09226e0353e72c47936 Author: Paul Eggert Date: Wed Oct 13 11:14:59 2021 -0700 Change release branch to emacs-28 * admin/notes/git-workflow: * Makefile.in (PREFERRED_BRANCH): emacs-27 → emacs-28 diff --git a/Makefile.in b/Makefile.in index 300340c6e8..ccb5d93f2f 100644 --- a/Makefile.in +++ b/Makefile.in @@ -1165,7 +1165,7 @@ ChangeLog: ./$(emacslog) -o $(CHANGELOG) -n $(CHANGELOG_HISTORY_INDEX_MAX) # Check that we are in a good state for changing history. -PREFERRED_BRANCH = emacs-27 +PREFERRED_BRANCH = emacs-28 preferred-branch-is-current: git branch | grep -q '^\* $(PREFERRED_BRANCH)$$' unchanged-history-files: diff --git a/admin/notes/git-workflow b/admin/notes/git-workflow index d109cdaa35..265a106bad 100644 --- a/admin/notes/git-workflow +++ b/admin/notes/git-workflow @@ -16,14 +16,14 @@ Initial setup Then we want to clone the repository. We normally want to have both the current master and (if there is one) the active release branch -(eg emacs-27). +(eg emacs-28). mkdir ~/emacs cd ~/emacs git clone @git.sv.gnu.org:/srv/git/emacs.git master cd master git config push.default current -git worktree add ../emacs-27 emacs-27 +git worktree add ../emacs-28 emacs-28 You now have both branches conveniently accessible, and you can do "git pull" in them once in a while to keep updated. @@ -67,7 +67,7 @@ which will look like commit 958b768a6534ae6e77a8547a56fc31b46b63710b -cd ~/emacs/emacs-27 +cd ~/emacs/emacs-28 git cherry-pick -xe 958b768a6534ae6e77a8547a56fc31b46b63710b and add "Backport:" to the commit string. Then @@ -109,7 +109,7 @@ up-to-date by doing a pull. Then start Emacs with emacs -l admin/gitmerge.el -f gitmerge You'll be asked for the branch to merge, which will default to -(eg) 'origin/emacs-27', which you should accept. Merging a local tracking +(eg) 'origin/emacs-28', which you should accept. Merging a local tracking branch is discouraged, since it might not be up-to-date, or worse, contain commits from you which are not yet pushed upstream. commit efb1cd7fa9f1a71ad3bf34627fe678acfcb48b38 Author: Eli Zaretskii Date: Wed Oct 13 20:02:23 2021 +0300 ; * etc/charsets/README: Update the format documentation. diff --git a/etc/charsets/README b/etc/charsets/README index 0045a0f638..96cba7c613 100644 --- a/etc/charsets/README +++ b/etc/charsets/README @@ -27,7 +27,9 @@ character code separated by a space. Both code points and Unicode character codes are in hexadecimal preceded by "0x". Comments may be used, starting with "#". Code ranges may also be used, with (inclusive) start and end code points separated by "-" followed by the -Unicode of the start of the range +Unicode of the start of the range. +Code points for which there's no mapping to Unicode should be skipped, +i.e. their lines should be omitted. Examples: 0xA0 0x00A0 # no-break space commit 9e3b3ae9d94c6d521d771e08e1536a8e4875d720 Author: Lars Ingebrigtsen Date: Wed Oct 13 19:01:48 2021 +0200 Update Emacs requirement after removing compat code diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index 5819f59315..49b8a865ef 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -5,7 +5,7 @@ ;; Author: Fabián E. Gallina ;; URL: https://github.com/fgallina/python.el ;; Version: 0.28 -;; Package-Requires: ((emacs "24.2") (cl-lib "1.0")) +;; Package-Requires: ((emacs "24.4") (cl-lib "1.0")) ;; Maintainer: emacs-devel@gnu.org ;; Created: Jul 2010 ;; Keywords: languages commit 913a7d30a33f7faa1a98e7dffd10159b1d2a6b97 Author: Lars Ingebrigtsen Date: Wed Oct 13 19:00:25 2021 +0200 Allow inhibiting `not-unused' warnings * lisp/emacs-lisp/bytecomp.el (byte-compile-warning-types): Allow inhibiting the `not-unused' warning (bug#31641). (There has been some discussion about removing the `not-unused' warning, but it's still in there, so making it possible to inhibit it seems like the right thing to do.) * lisp/emacs-lisp/cconv.el (cconv--analyze-use): Don't warn about `not-unused'. diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 3f050d1b79..471a0b623a 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -299,7 +299,7 @@ The information is logged to `byte-compile-log-buffer'." '(redefine callargs free-vars unresolved obsolete noruntime interactive-only make-local mapcar constants suspicious lexical lexical-dynamic - docstrings) + docstrings not-unused) "The list of warning types used when `byte-compile-warnings' is t.") (defcustom byte-compile-warnings t "List of warnings that the byte-compiler should issue (t for all). @@ -321,6 +321,7 @@ Elements of the list may be: lexically bound variable declared dynamic elsewhere make-local calls to `make-variable-buffer-local' that may be incorrect. mapcar mapcar called for effect. + not-unused warning about using variables with symbol names starting with _. constants let-binding of, or assignment to, constants/nonvariables. docstrings docstrings that are too wide (longer than `byte-compile-docstring-max-column' or diff --git a/lisp/emacs-lisp/cconv.el b/lisp/emacs-lisp/cconv.el index 0a6b04b4c1..03e109f250 100644 --- a/lisp/emacs-lisp/cconv.el +++ b/lisp/emacs-lisp/cconv.el @@ -608,10 +608,9 @@ FORM is the parent form that binds this var." (`((,(and var (guard (eq ?_ (aref (symbol-name var) 0)))) . ,_) ,_ ,_ ,_ ,_) ;; FIXME: Convert this warning to use `macroexp--warn-wrap' - ;; so as to give better position information and obey - ;; `byte-compile-warnings'. - (byte-compile-warn - "%s `%S' not left unused" varkind var)) + ;; so as to give better position information. + (when (byte-compile-warning-enabled-p 'not-unused var) + (byte-compile-warn "%s `%S' not left unused" varkind var))) ((and (let (or 'let* 'let) (car form)) `((,var) ;; (or `(,var nil) : Too many false positives: bug#47080 t nil ,_ ,_)) commit ab34293d849086a67effc52800e18bab1400ce72 Author: Lars Ingebrigtsen Date: Wed Oct 13 18:44:35 2021 +0200 Fix problem with multiline fontification in interactive Python * lisp/progmodes/python.el (python-shell-font-lock-post-command-hook): When doing multi-line (`C-c SPC') inputs, remove all the preceding lines when doing fontification (bug#47657). diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index 75aae23051..5819f59315 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -2724,16 +2724,12 @@ goes wrong and syntax highlighting in the shell gets messed up." (deactivate-mark nil) (start-pos prompt-end) (buffer-undo-list t) - (font-lock-buffer-pos nil) (replacement (python-shell-font-lock-with-font-lock-buffer - (delete-region (line-beginning-position) - (point-max)) - (setq font-lock-buffer-pos (point)) + (delete-region (point-min) (point-max)) (insert input) (font-lock-ensure) - (buffer-substring font-lock-buffer-pos - (point-max)))) + (buffer-string))) (replacement-length (length replacement)) (i 0)) ;; Inject text properties to get input fontified. commit e494a2d00a4948a54cb6c9f403956db4526d4348 Author: Michael Albinus Date: Wed Oct 13 18:59:58 2021 +0200 Continue to work on emba integration * test/infra/Dockerfile.emba: Remove instrumentation. * test/infra/gitlab-ci.yml (.job-template): Specify timeout signal. (.job-template, .test-template): Improve wildcard. diff --git a/test/infra/Dockerfile.emba b/test/infra/Dockerfile.emba index e62a55e7a5..c129bc8be8 100644 --- a/test/infra/Dockerfile.emba +++ b/test/infra/Dockerfile.emba @@ -26,7 +26,6 @@ FROM debian:stretch as emacs-base -RUN cat /proc/sys/kernel/core_pattern RUN apt-get update && \ apt-get install -y --no-install-recommends -o=Dpkg::Use-Pty=0 \ libc-dev gcc g++ make autoconf automake libncurses-dev gnutls-dev \ diff --git a/test/infra/gitlab-ci.yml b/test/infra/gitlab-ci.yml index 15327b0028..30efe89c06 100644 --- a/test/infra/gitlab-ci.yml +++ b/test/infra/gitlab-ci.yml @@ -75,11 +75,13 @@ default: - autogen.sh - configure.ac - lib/*.{h,c} - - lisp/**.el + - lisp/*.el + - lisp/**/*.el - src/*.{h,c} - test/infra/* - test/lib-src/*.el - - test/lisp/**.el + - test/lisp/*.el + - test/lisp/**/*.el - test/src/*.el - changes: # gfilemonitor, kqueue @@ -107,7 +109,7 @@ default: # TODO: with make -j4 several of the tests were failing, for # example shadowfile-tests, but passed without it. - 'export PWD=$(pwd)' - - 'docker run -i -e EMACS_EMBA_CI=${EMACS_EMBA_CI} --volumes-from $(docker ps -q -f "label=com.gitlab.gitlab-runner.job.id=${CI_JOB_ID}"):ro --name ${test_name} ${CI_REGISTRY_IMAGE}:${target}-${BUILD_TAG} /bin/bash -c "git fetch ${PWD} HEAD && echo checking out these updated files && git diff --name-only FETCH_HEAD && ( git diff --name-only FETCH_HEAD | xargs git checkout -f FETCH_HEAD ) && make -j4 && timeout 3600s make ${make_params}"' + - 'docker run -i -e EMACS_EMBA_CI=${EMACS_EMBA_CI} --volumes-from $(docker ps -q -f "label=com.gitlab.gitlab-runner.job.id=${CI_JOB_ID}"):ro --name ${test_name} ${CI_REGISTRY_IMAGE}:${target}-${BUILD_TAG} /bin/bash -c "git fetch ${PWD} HEAD && echo checking out these updated files && git diff --name-only FETCH_HEAD && ( git diff --name-only FETCH_HEAD | xargs git checkout -f FETCH_HEAD ) && make -j4 && timeout -s ABRT 1800s make ${make_params}"' after_script: # - docker ps -a # - printenv @@ -156,7 +158,9 @@ default: public: true expire_in: 1 week paths: - - "**.log" + - "**/*.log" + - "**/core" + - core .gnustep-template: rules: commit cc796b7409c74992e7b71951c2d9eea24860649a Author: Michael Albinus Date: Wed Oct 13 18:59:10 2021 +0200 Tramp doc cleanup * doc/misc/tramp.texi (Overview, Bug Reports) (Frequently Asked Questions): Stylistic changes. (Bug Reports): Mention tramp buffers appended to bug report. diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi index c2655d6e17..5fdd9a4989 100644 --- a/doc/misc/tramp.texi +++ b/doc/misc/tramp.texi @@ -290,7 +290,7 @@ file's contents. For external transfers, @value{tramp} sends a command as follows: @example -rcp user@@host:/path/to/remote/file /tmp/tramp.4711 +$ rcp user@@host:/path/to/remote/file /tmp/tramp.4711 @end example @value{tramp} reads the local temporary file @file{/tmp/tramp.4711} into a buffer, and then deletes the temporary file. @@ -4299,7 +4299,7 @@ explicitly, because @command{emacs -Q} ignores installed ELPA packages. Call (version number adapted) @example -emacs -Q -l ~/.emacs.d/elpa/tramp-2.4.5.1/tramp-autoloads +$ emacs -Q -l ~/.emacs.d/elpa/tramp-2.4.5.1/tramp-autoloads @end example When including @value{tramp}'s messages in the bug report, increase @@ -4311,6 +4311,11 @@ non-@acronym{ASCII} characters which are relevant for analysis, append the buffers as attachments to the bug report. This is also needed in order to avoid line breaks during mail transfer. +If you send the message from Emacs, you are asked about to append +these buffers to the bug report. If you use an external mail program, +you must save these buffers to files, and append them with that mail +program. + @strong{Note} that a verbosity level greater than 6 is not necessary at this stage. Also note that a verbosity level of 6 or greater, the contents of files and directories will be included in the debug @@ -5104,7 +5109,7 @@ location. Then start Emacs Client from the command line: @example -emacsclient @trampfn{ssh,user@@host,/file/to/edit} +$ emacsclient @trampfn{ssh,user@@host,/file/to/edit} @end example @code{user} and @code{host} refer to the local host. @@ -5124,7 +5129,7 @@ Then change the environment variable @env{EDITOR} to point to the wrapper script: @example -export EDITOR=/path/to/emacsclient.sh +$ export EDITOR=/path/to/emacsclient.sh @end example commit 93b40da8e1c0ef418c716ee62b8e8fdecc16cd44 Author: Lars Ingebrigtsen Date: Wed Oct 13 18:34:58 2021 +0200 Remove some compat code from python.el * lisp/progmodes/python.el (python-shell-font-lock-post-command-hook): Remove Emacs 24.3 and earlier compat code. diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index f1dab76a81..75aae23051 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -2731,11 +2731,7 @@ goes wrong and syntax highlighting in the shell gets messed up." (point-max)) (setq font-lock-buffer-pos (point)) (insert input) - ;; Ensure buffer is fontified, keeping it - ;; compatible with Emacs < 24.4. - (if (fboundp 'font-lock-ensure) - (funcall 'font-lock-ensure) - (font-lock-default-fontify-buffer)) + (font-lock-ensure) (buffer-substring font-lock-buffer-pos (point-max)))) (replacement-length (length replacement)) commit a338d46060a89ddeb476d030cd0e18a677db8506 Author: Lars Ingebrigtsen Date: Wed Oct 13 13:41:21 2021 +0200 Make emacs-lisp-byte-compile-and-load load the .elc file again * lisp/progmodes/elisp-mode.el (emacs-lisp-byte-compile-and-load): Load the compiled file instead of the source (bug#51180). diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el index c7474b25a7..10a3794257 100644 --- a/lisp/progmodes/elisp-mode.el +++ b/lisp/progmodes/elisp-mode.el @@ -210,7 +210,7 @@ All commands in `lisp-mode-shared-map' are inherited by this map.") (emacs-lisp--before-compile-buffer) (require 'bytecomp) (byte-recompile-file buffer-file-name nil 0) - (load buffer-file-name)) + (load (byte-compile-dest-file buffer-file-name))) (declare-function native-compile "comp") (defun emacs-lisp-native-compile-and-load () commit 3eac7dc780433e2eab046e83315f1d90caf3cab9 Author: Peter Münster Date: Tue Oct 12 14:31:58 2021 +0200 Fix point movement in image-dired * lisp/image-dired.el (image-dired-thumb-file-marked-p): Don't move point in associated dired buffer. (image-dired-delete-marked): Revert "Fix deletion of associated image" because it was wrong and introduced another problem (bug#51152). diff --git a/lisp/image-dired.el b/lisp/image-dired.el index 3ca47300a9..4e6a410c11 100644 --- a/lisp/image-dired.el +++ b/lisp/image-dired.el @@ -2314,18 +2314,19 @@ non-nil." (dired-buf (image-dired-associated-dired-buffer))) (when (and dired-buf file-name) (with-current-buffer dired-buf - (when (dired-goto-file file-name) - (image-dired-dired-file-marked-p)))))) + (save-excursion + (when (dired-goto-file file-name) + (image-dired-dired-file-marked-p))))))) (defun image-dired-delete-marked () "Delete current or marked thumbnails and associated images." (interactive) - (with-current-buffer (image-dired-associated-dired-buffer) - (dired-do-delete)) (image-dired--with-marked (image-dired-delete-char) (backward-char)) - (image-dired--line-up-with-method)) + (image-dired--line-up-with-method) + (with-current-buffer (image-dired-associated-dired-buffer) + (dired-do-delete))) (defun image-dired-thumb-update-marks () "Update the marks in the thumbnail buffer." commit aed4aec6bb6509234d1e9f2590d8f6b082885be1 Author: Andreas Schwab Date: Wed Oct 13 10:04:33 2021 +0200 * src/pdumper.h: Include . diff --git a/src/pdumper.h b/src/pdumper.h index 87de592b81..79f8bce2d8 100644 --- a/src/pdumper.h +++ b/src/pdumper.h @@ -20,6 +20,7 @@ along with GNU Emacs. If not, see . */ #ifndef EMACS_PDUMPER_H #define EMACS_PDUMPER_H +#include #include "lisp.h" INLINE_HEADER_BEGIN commit 2223c519a5b6c8f437ec4ece9028c9555cc98ea9 Author: Martin Rudalics Date: Wed Oct 13 09:51:27 2021 +0200 Improve 'display-buffer' 'temp-buffer-resize-mode' cohabitation (Bug#51062) * doc/lispref/display.texi (Temporary Displays): Explain how to override the effect of 'temp-buffer-resize-mode' with a suitable 'display-buffer' action alist entry. * doc/lispref/windows.texi (Buffer Display Action Alists): Mention that an 'inhibit-switch-frame' entry might not work with every WM. Describe the 'window-size' entry. Describe how automatic window resizing can be overridden. * lisp/help.el (resize-temp-buffer-window-inhibit): New variable. (resize-temp-buffer-window): Handle case where user overrides automatic resizing. * lisp/window.el (temp-buffer-window-show): Bind 'resize-temp-buffer-window-inhibit' to nil around 'display-buffer'. Do not raise frame automatically to avoid defeating 'inhibit-switch-frame'. (window--display-buffer): Set 'resize-temp-buffer-window-inhibit' to t when the action alist contains a 'window-height', 'window-width' or 'window-size' entry. Use 'modify-frame-parameters' instead of 'set-frame-height' and 'set-frame-width' to avoid that the latter step on each others toes. (display-buffer): Fix 'inhibit-switch-frame' part in and add 'window-size' part to doc-string. diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi index 2ae04a8521..52fe97b299 100644 --- a/doc/lispref/display.texi +++ b/doc/lispref/display.texi @@ -1334,6 +1334,11 @@ are not resized. By default, this mode uses @code{fit-window-to-buffer} (@pxref{Resizing Windows}) for resizing. You can specify a different function by customizing the options @code{temp-buffer-max-height} and @code{temp-buffer-max-width} below. + +The effect of this option can be overridden by providing a suitable +@code{window-height}, @code{window-width} or @code{window-size} action +alist entry for @code{display-buffer} (@pxref{Buffer Display Action +Alists}). @end defopt @defopt temp-buffer-max-height diff --git a/doc/lispref/windows.texi b/doc/lispref/windows.texi index 679744884a..d015ac1844 100644 --- a/doc/lispref/windows.texi +++ b/doc/lispref/windows.texi @@ -2924,9 +2924,9 @@ A non-@code{nil} value prevents another frame from being raised or selected, if the window chosen by @code{display-buffer} is displayed there. Primarily affected by this are @code{display-buffer-use-some-frame} and -@code{display-buffer-reuse-window}. -@code{display-buffer-pop-up-frame} should be affected as well, but -there is no guarantee that the window manager will comply. +@code{display-buffer-reuse-window}. Ideally, +@code{display-buffer-pop-up-frame} should be affected as well, but there +is no guarantee that the window manager will comply. @vindex window-parameters@r{, a buffer display action alist entry} @item window-parameters @@ -2972,8 +2972,8 @@ root window. If the value specifies a function, that function is called with one argument---the chosen window. The function is supposed to adjust the height of the window; its return value is ignored. Suitable functions -are @code{shrink-window-if-larger-than-buffer} and -@code{fit-window-to-buffer}, see @ref{Resizing Windows}. +are @code{fit-window-to-buffer} and +@code{shrink-window-if-larger-than-buffer}, see @ref{Resizing Windows}. @end itemize By convention, the height of the chosen window is adjusted only if the @@ -3007,11 +3007,31 @@ argument---the chosen window. The function is supposed to adjust the width of the window; its return value is ignored. @end itemize -By convention, the width of the chosen window is adjusted only if the -window is part of a horizontal combination (@pxref{Windows and -Frames}) to avoid changing the width of other, unrelated windows. -Also, this entry should be processed under only certain conditions -which are specified right below this list. +@vindex window-size@r{, a buffer display action alist entry} +@item window-size +This entry is a combination of the two preceding ones and can be used to +adjust the chosen window's height and width. Since windows can be +resized in one direction only without affecting other windows, +@code{window-size} is effective only to set up the size of a window +appearing alone on a frame. The value can be one of the following: + +@itemize @bullet +@item +@code{nil} means to leave the size of the chosen window alone. + +@item +A cons cell of two integers specifies the desired total width and height +of the chosen window in lines and columns. It's effect is to adjust the +size of the frame accordingly. + +@item +If the value specifies a function, that function is called with one +argument---the chosen window. The function is supposed to adjust the +size of the window's frame; its return value is ignored. +@end itemize + +This entry should be processed under only certain conditions which are +specified right below this list. @vindex dedicated@r{, a buffer display action alist entry} @item dedicated @@ -3112,6 +3132,14 @@ the window was created earlier by @code{display-buffer} to show the buffer and never was used to show another buffer until it was reused by the current invocation of @code{display-buffer}. +If no @code{window-height}, @code{window-width} or @code{window-size} +entry was specified, the window may still be resized automatically when +the buffer is temporary and @code{temp-buffer-resize-mode} has been +enabled, @ref{Temporary Displays}. In that case, the @sc{cdr} of a +@code{window-height}, @code{window-width} or @code{window-size} entry +can be used to inhibit or override the default behavior of +@code{temp-buffer-resize-mode} for specific buffers or invocations of +@code{display-buffer}. @node Choosing Window Options @subsection Additional Options for Displaying Buffers diff --git a/lisp/help.el b/lisp/help.el index eaca33795a..fa4eaee417 100644 --- a/lisp/help.el +++ b/lisp/help.el @@ -1596,10 +1596,16 @@ and some others." (add-hook 'temp-buffer-show-hook 'resize-temp-buffer-window 'append) (remove-hook 'temp-buffer-show-hook 'resize-temp-buffer-window))) +(defvar resize-temp-buffer-window-inhibit nil + "Non-nil means `resize-temp-buffer-window' should not resize.") + (defun resize-temp-buffer-window (&optional window) "Resize WINDOW to fit its contents. WINDOW must be a live window and defaults to the selected one. -Do not resize if WINDOW was not created by `display-buffer'. +Do not resize if WINDOW was not created by `display-buffer'. Do +not resize either if a `window-height', `window-width' or +`window-size' entry in `display-buffer-alist' prescribes some +alternative resizing for WINDOW's buffer. If WINDOW is part of a vertical combination, restrain its new size by `temp-buffer-max-height' and do not resize if its minimum @@ -1614,27 +1620,33 @@ provided `fit-frame-to-buffer' is non-nil. This function may call `preserve-window-size' to preserve the size of WINDOW." (setq window (window-normalize-window window t)) - (let ((height (if (functionp temp-buffer-max-height) + (let* ((buffer (window-buffer window)) + (height (if (functionp temp-buffer-max-height) + (with-selected-window window + (funcall temp-buffer-max-height buffer)) + temp-buffer-max-height)) + (width (if (functionp temp-buffer-max-width) (with-selected-window window - (funcall temp-buffer-max-height (window-buffer))) - temp-buffer-max-height)) - (width (if (functionp temp-buffer-max-width) - (with-selected-window window - (funcall temp-buffer-max-width (window-buffer))) - temp-buffer-max-width)) - (quit-cadr (cadr (window-parameter window 'quit-restore)))) - ;; Resize WINDOW iff it was made by `display-buffer'. + (funcall temp-buffer-max-width buffer)) + temp-buffer-max-width)) + (quit-cadr (cadr (window-parameter window 'quit-restore)))) + ;; Resize WINDOW only if it was made by `display-buffer'. (when (or (and (eq quit-cadr 'window) (or (and (window-combined-p window) (not (eq fit-window-to-buffer-horizontally 'only)) - (pos-visible-in-window-p (point-min) window)) + (pos-visible-in-window-p + (with-current-buffer buffer (point-min)) + window) + (not resize-temp-buffer-window-inhibit)) (and (window-combined-p window t) - fit-window-to-buffer-horizontally))) + fit-window-to-buffer-horizontally + (not resize-temp-buffer-window-inhibit)))) (and (eq quit-cadr 'frame) fit-frame-to-buffer - (eq window (frame-root-window window)))) - (fit-window-to-buffer window height nil width nil t)))) + (eq window (frame-root-window window)) + (not resize-temp-buffer-window-inhibit))) + (fit-window-to-buffer window height nil width nil t)))) ;;; Help windows. (defcustom help-window-select nil diff --git a/lisp/window.el b/lisp/window.el index 971264b634..1a5f2d4006 100644 --- a/lisp/window.el +++ b/lisp/window.el @@ -108,11 +108,14 @@ Return the buffer." ;; Return the buffer. buffer))) +;; Defined in help.el. +(defvar resize-temp-buffer-window-inhibit) + (defun temp-buffer-window-show (buffer &optional action) "Show temporary buffer BUFFER in a window. Return the window showing BUFFER. Pass ACTION as action argument to `display-buffer'." - (let (window frame) + (let (resize-temp-buffer-window-inhibit window) (with-current-buffer buffer (set-buffer-modified-p nil) (setq buffer-read-only t) @@ -130,9 +133,9 @@ to `display-buffer'." t window-combination-limit))) (setq window (display-buffer buffer action))) - (setq frame (window-frame window)) - (unless (eq frame (selected-frame)) - (raise-frame frame)) + ;; We used to raise the window's frame here. Do not do that + ;; since it would override an `inhibit-switch-frame' entry + ;; specified for the action alist used by `display-buffer'. (setq minibuffer-scroll-window window) (set-window-hscroll window 0) (with-selected-window window @@ -7246,11 +7249,14 @@ Return WINDOW if BUFFER and WINDOW are live." (inhibit-modification-hooks t)) (funcall (cdr (assq 'body-function alist)) window))) - (let ((quit-restore (window-parameter window 'quit-restore)) - (height (cdr (assq 'window-height alist))) - (width (cdr (assq 'window-width alist))) - (size (cdr (assq 'window-size alist))) - (preserve-size (cdr (assq 'preserve-size alist)))) + (let* ((quit-restore (window-parameter window 'quit-restore)) + (window-height (assq 'window-height alist)) + (height (cdr window-height)) + (window-width (assq 'window-width alist)) + (width (cdr window-width)) + (window-size (assq 'window-size alist)) + (size (cdr window-size)) + (preserve-size (cdr (assq 'preserve-size alist)))) (cond ((or (eq type 'frame) (and (eq (car quit-restore) 'same) @@ -7267,14 +7273,18 @@ Return WINDOW if BUFFER and WINDOW are live." (height (cdr size)) (frame (window-frame window))) (when (and (numberp width) (numberp height)) - (set-frame-height - frame (+ (frame-height frame) - (- height (window-total-height window)))) - (set-frame-width - frame (+ (frame-width frame) - (- width (window-total-width window))))))) + ;; Modifying the parameters of a newly created frame might + ;; not work everywhere, but then `temp-buffer-resize-mode' + ;; will certainly fail in a similar fashion. + (modify-frame-parameters + frame `((height . ,(+ (frame-height frame) + (- height (window-total-height window)))) + (width . ,(+ (frame-width frame) + (- width (window-total-width window)))))))) + (setq resize-temp-buffer-window-inhibit t)) ((functionp size) - (ignore-errors (funcall size window))))) + (ignore-errors (funcall size window)) + (setq resize-temp-buffer-window-inhibit t)))) ((or (eq type 'window) (and (eq (car quit-restore) 'same) (eq (nth 1 quit-restore) 'window))) @@ -7294,9 +7304,11 @@ Return WINDOW if BUFFER and WINDOW are live." (delta (- new-height (window-total-height window)))) (when (and (window--resizable-p window delta nil 'safe) (window-combined-p window)) - (window-resize window delta nil 'safe)))) + (window-resize window delta nil 'safe))) + (setq resize-temp-buffer-window-inhibit 'vertical)) ((functionp height) - (ignore-errors (funcall height window)))) + (ignore-errors (funcall height window)) + (setq resize-temp-buffer-window-inhibit 'vertical))) ;; Adjust width of window if asked for. (cond ((not width)) @@ -7310,9 +7322,11 @@ Return WINDOW if BUFFER and WINDOW are live." (delta (- new-width (window-total-width window)))) (when (and (window--resizable-p window delta t 'safe) (window-combined-p window t)) - (window-resize window delta t 'safe)))) + (window-resize window delta t 'safe))) + (setq resize-temp-buffer-window-inhibit 'horizontal)) ((functionp width) - (ignore-errors (funcall width window)))) + (ignore-errors (funcall width window)) + (setq resize-temp-buffer-window-inhibit 'horizontal))) ;; Preserve window size if asked for. (when (consp preserve-size) (window-preserve-size window t (car preserve-size)) @@ -7557,9 +7571,11 @@ perform. Action alist entries are: `inhibit-same-window' -- A non-nil value prevents the same window from being used for display. - `inhibit-switch-frame' -- A non-nil value prevents any frame - used for showing the buffer from being raised or selected. - `reusable-frames' -- The value specifies the set of frames to +`inhibit-switch-frame' -- A non-nil value prevents any frame used + for showing the buffer from being raised or selected. Note + that a window manager may still raise a new frame and give it + focus, effectively overriding the value specified here. +`reusable-frames' -- The value specifies the set of frames to search for a window that already displays the buffer. Possible values are nil (the selected frame), t (any live frame), visible (any visible frame), 0 (any visible or @@ -7582,7 +7598,14 @@ Action alist entries are: window) or a function to be called with one argument - the chosen window. The function is supposed to adjust the width of the window; its return value is ignored. - `preserve-size' -- The value should be either (t . nil) to + `window-size' -- This entry is only useful for windows appearing + alone on their frame and specifies the desired size of that + window either as a cons of integers (the total width and + height of the window on that frame), or a function to be + called with one argument - the chosen window. The function + is supposed to adjust the size of the frame; its return value + is ignored. +`preserve-size' -- The value should be either (t . nil) to preserve the width of the chosen window, (nil . t) to preserve its height or (t . t) to preserve its height and width in future changes of the window configuration. commit 4e9452a399c878ab110811b4f890c350d3cb9c36 Author: Stefan Kangas Date: Wed Oct 13 05:00:10 2021 +0200 Improve shortdoc for vector * lisp/emacs-lisp/shortdoc.el (vector): Improve shortdoc with titles. Add mapc. Fix typo where 'seq-reduce' is incorrectly written as 'reduce'. diff --git a/lisp/emacs-lisp/shortdoc.el b/lisp/emacs-lisp/shortdoc.el index 25bd17bdb9..17ac3e471c 100644 --- a/lisp/emacs-lisp/shortdoc.el +++ b/lisp/emacs-lisp/shortdoc.el @@ -647,10 +647,12 @@ There can be any number of :example/:result elements." (define-short-documentation-group vector + "Making Vectors" (make-vector :eval (make-vector 5 "foo")) (vector :eval (vector 1 "b" 3)) + "Operations on Vectors" (vectorp :eval (vectorp [1]) :eval (vectorp "1")) @@ -660,13 +662,16 @@ There can be any number of :example/:result elements." :eval (append [1 2] nil)) (length :eval (length [1 2 3])) - (mapcar - :eval (mapcar #'identity [1 2 3])) - (reduce - :eval (reduce #'+ [1 2 3])) + (seq-reduce + :eval (seq-reduce #'+ [1 2 3] 0)) (seq-subseq :eval (seq-subseq [1 2 3 4 5] 1 3) - :eval (seq-subseq [1 2 3 4 5] 1))) + :eval (seq-subseq [1 2 3 4 5] 1)) + "Mapping Over Vectors" + (mapcar + :eval (mapcar #'identity [1 2 3])) + (mapc + :eval (mapc #'insert ["1" "2" "3"]))) (define-short-documentation-group regexp "Matching Strings" commit dec613d1e727b94fc3b672134d3a75063bd6b618 Author: Stephen Gildea Date: Tue Oct 12 18:29:30 2021 -0700 MH-E: restore message about obsolete key binding * lisp/mh-e/mh-show.el: * lisp/mh-e/mh-folder.el: Restore "obsolete key" message for "J w" that was lost in the conversion from gnus-define-keys to define-keymap. diff --git a/lisp/mh-e/mh-folder.el b/lisp/mh-e/mh-folder.el index c423d22e89..e6c295764b 100644 --- a/lisp/mh-e/mh-folder.el +++ b/lisp/mh-e/mh-folder.el @@ -278,7 +278,7 @@ annotation.") "?" #'mh-prefix-help "a" #'mh-junk-allowlist "b" #'mh-junk-blocklist - "w" #'mh-junk-allowlist) + "w" #'mh-junk-whitelist) "P" (define-keymap :prefix 'mh-ps-print-map "?" #'mh-prefix-help diff --git a/lisp/mh-e/mh-show.el b/lisp/mh-e/mh-show.el index 4b98d6c487..524179648d 100644 --- a/lisp/mh-e/mh-show.el +++ b/lisp/mh-e/mh-show.el @@ -462,8 +462,7 @@ still visible.\n") (mh-defun-show-buffer mh-show-toggle-tick mh-toggle-tick) (mh-defun-show-buffer mh-show-narrow-to-tick mh-narrow-to-tick) (mh-defun-show-buffer mh-show-junk-allowlist mh-junk-allowlist) -(mh-defun-show-buffer mh-show-junk-whitelist mh-junk-allowlist) -(make-obsolete 'mh-show-junk-whitelist 'mh-show-junk-allowlist "28.1") +(mh-defun-show-buffer mh-show-junk-whitelist mh-junk-whitelist) (mh-defun-show-buffer mh-show-junk-blocklist mh-junk-blocklist) (mh-defun-show-buffer mh-show-index-new-messages mh-index-new-messages) (mh-defun-show-buffer mh-show-index-ticked-messages mh-index-ticked-messages) @@ -635,7 +634,7 @@ still visible.\n") "?" #'mh-prefix-help "a" #'mh-show-junk-allowlist "b" #'mh-show-junk-blocklist - "w" #'mh-show-junk-allowlist) + "w" #'mh-show-junk-whitelist) "P" (define-keymap :prefix 'mh-show-ps-print-map "?" #'mh-prefix-help commit f223ac6ef92b7cf69048c81ff58b5c983c7d25da Author: Paul Eggert Date: Tue Oct 12 17:10:46 2021 -0700 Fix test bug when calloc returns null * test/src/emacs-module-resources/mod-test.c (Fmod_test_userptr_make): Don’t dump core if calloc returns null and signal_errno returns. diff --git a/test/src/emacs-module-resources/mod-test.c b/test/src/emacs-module-resources/mod-test.c index 5720af8c60..4c0b168e34 100644 --- a/test/src/emacs-module-resources/mod-test.c +++ b/test/src/emacs-module-resources/mod-test.c @@ -298,7 +298,10 @@ Fmod_test_userptr_make (emacs_env *env, ptrdiff_t nargs, emacs_value args[], { struct super_struct *p = calloc (1, sizeof *p); if (!p) - signal_errno (env, "calloc"); + { + signal_errno (env, "calloc"); + return NULL; + } p->amazing_int = env->extract_integer (env, args[0]); return env->make_user_ptr (env, free, p); } commit bcb43fbc95ad0c635c8f19c391ec90d3f8a74035 Author: Basil L. Contovounesios Date: Mon Oct 11 19:14:23 2021 +0100 Fix byte-compilation warnings in nox builds For discussion, see bug#51139. * lisp/edmacro.el (edmacro-fix-menu-commands): Load mwheel to pacify free variable warnings in without-x builds. * lisp/mh-e/mh-compat.el: Declare image.el functions that are not preloaded in without-x builds. * lisp/mh-e/mh-utils.el (mh--with-image-load-path): New macro. (mh-logo-display): * lisp/mh-e/mh-tool-bar.el (mh-tool-bar-folder-buttons-init) (mh-tool-bar-letter-buttons-init): Use it to pacify byte-compilation warnings about image.el definitions not preloaded without-x. diff --git a/lisp/edmacro.el b/lisp/edmacro.el index e90b3a006e..a4eb574a4c 100644 --- a/lisp/edmacro.el +++ b/lisp/edmacro.el @@ -604,6 +604,12 @@ This function assumes that the events can be stored in a string." (defun edmacro-fix-menu-commands (macro &optional noerror) (if (vectorp macro) (let (result) + ;; Not preloaded in without-x builds. + (require 'mwheel) + (defvar mouse-wheel-down-event) + (defvar mouse-wheel-left-event) + (defvar mouse-wheel-right-event) + (defvar mouse-wheel-up-event) ;; Make a list of the elements. (setq macro (append macro nil)) (dolist (ev macro) diff --git a/lisp/mh-e/mh-compat.el b/lisp/mh-e/mh-compat.el index 1c36c27bbf..19be5afd79 100644 --- a/lisp/mh-e/mh-compat.el +++ b/lisp/mh-e/mh-compat.el @@ -83,9 +83,13 @@ the completions." (define-obsolete-function-alias 'mh-font-lock-add-keywords #'font-lock-add-keywords "29.1") +;; Not preloaded in without-x builds. +(declare-function image-load-path-for-library "image") (define-obsolete-function-alias 'mh-image-load-path-for-library #'image-load-path-for-library "29.1") +;; Not preloaded in without-x builds. +(declare-function image-search-load-path "image") (define-obsolete-function-alias 'mh-image-search-load-path #'image-search-load-path "29.1") diff --git a/lisp/mh-e/mh-tool-bar.el b/lisp/mh-e/mh-tool-bar.el index ca08cc3b35..0200d232c3 100644 --- a/lisp/mh-e/mh-tool-bar.el +++ b/lisp/mh-e/mh-tool-bar.el @@ -211,11 +211,7 @@ where, ;; Tool bar initialization functions (defun mh-tool-bar-folder-buttons-init () (when (mh-buffer-exists-p 'mh-folder-mode) - (let* ((load-path (image-load-path-for-library "mh-e" - "mh-logo.xpm")) - (image-load-path (cons (car load-path) - (when (boundp 'image-load-path) - image-load-path)))) + (mh--with-image-load-path (setq mh-folder-tool-bar-map (let ((tool-bar-map (make-sparse-keymap))) ,@(nreverse folder-button-setter) @@ -234,11 +230,7 @@ where, tool-bar-map))))) (defun mh-tool-bar-letter-buttons-init () (when (mh-buffer-exists-p 'mh-letter-mode) - (let* ((load-path (image-load-path-for-library "mh-e" - "mh-logo.xpm")) - (image-load-path (cons (car load-path) - (when (boundp 'image-load-path) - image-load-path)))) + (mh--with-image-load-path (setq mh-letter-tool-bar-map (let ((tool-bar-map (make-sparse-keymap))) ,@(nreverse letter-button-setter) diff --git a/lisp/mh-e/mh-utils.el b/lisp/mh-e/mh-utils.el index dcfb691ff6..feebf6416f 100644 --- a/lisp/mh-e/mh-utils.el +++ b/lisp/mh-e/mh-utils.el @@ -116,22 +116,32 @@ Ignores case when searching for OLD." ;;; Logo Display +;;;###mh-autoload +(defmacro mh--with-image-load-path (&rest body) + "Load `image' and eval BODY with `image-load-path' set appropriately." + (declare (debug t) (indent 0)) + `(progn + ;; Not preloaded in without-x builds. + (require 'image) + (defvar image-load-path) + (declare-function image-load-path-for-library "image") + (let* ((load-path (image-load-path-for-library "mh-e" "mh-logo.xpm")) + (image-load-path (cons (car load-path) image-load-path))) + ,@body))) + (defvar mh-logo-cache nil) ;;;###mh-autoload (defun mh-logo-display () "Modify mode line to display MH-E logo." - (let* ((load-path (image-load-path-for-library "mh-e" "mh-logo.xpm")) - (image-load-path (cons (car load-path) - (when (boundp 'image-load-path) - image-load-path)))) + (mh--with-image-load-path (add-text-properties 0 2 `(display ,(or mh-logo-cache (setq mh-logo-cache (mh-funcall-if-exists - find-image '((:type xpm :ascent center - :file "mh-logo.xpm")))))) + find-image '(( :type xpm :ascent center + :file "mh-logo.xpm" )))))) (car mode-line-buffer-identification)))) commit e47b85a68339063dd3a784e8b90aecbf90b23f41 Author: Eric Abrahamsen Date: Mon Oct 11 08:45:09 2021 -0700 Clean up nnimap buffers with dead processes * lisp/gnus/nnimap.el (nnimap-keepalive): If the keepalive "NOOP" fails, remove the buffer with the dead process from `nnimap-process-buffers' and `nnimap-connection-alist'. (nnimap-find-connection): Do the same here, when the connection can't be found. (nnimap-close-server): Remove process buffer from lists when closing server. diff --git a/lisp/gnus/nnimap.el b/lisp/gnus/nnimap.el index 059101c890..8a2acf6459 100644 --- a/lisp/gnus/nnimap.el +++ b/lisp/gnus/nnimap.el @@ -429,8 +429,18 @@ during splitting, which may be slow." now (nnimap-last-command-time nnimap-object)))) (with-local-quit - (ignore-errors ;E.g. "buffer foo has no process". - (nnimap-send-command "NOOP"))))))))) + (ignore-errors ;E.g. "buffer foo has no process". + (nnimap-send-command "NOOP")) + ;; If our connection has died in the meantime, clean it + ;; and its buffer up. + (unless (process-live-p (get-buffer-process buffer)) + (setq nnimap-process-buffers + (delq buffer nnimap-process-buffers)) + (setq nnimap-connection-alist + (seq-filter (lambda (elt) + (null (eq buffer (cdr elt)))) + nnimap-connection-alist)) + (kill-buffer buffer))))))))) (defun nnimap-open-connection (buffer) ;; Be backwards-compatible -- the earlier value of nnimap-stream was @@ -662,10 +672,17 @@ during splitting, which may be slow." (deffoo nnimap-close-server (&optional server defs) (when (nnoo-change-server 'nnimap server defs) - (ignore-errors - (delete-process (get-buffer-process (nnimap-buffer)))) - (nnoo-close-server 'nnimap server) - t)) + (let ((buf (nnimap-buffer))) + (ignore-errors + (delete-process (get-buffer-process buf))) + (setq nnimap-process-buffers + (delq buf nnimap-process-buffers) + nnimap-connection-alist + (seq-filter (lambda (elt) + (null (eq buf (cdr elt)))) + nnimap-connection-alist)) + (nnoo-close-server 'nnimap server) + t))) (deffoo nnimap-request-close () t) @@ -1937,10 +1954,13 @@ Return the server's response to the SELECT or EXAMINE command." (when entry (if (and (buffer-live-p (cadr entry)) (get-buffer-process (cadr entry)) - (memq (process-status (get-buffer-process (cadr entry))) - '(open run))) + (process-live-p (get-buffer-process (cadr entry)))) (get-buffer-process (cadr entry)) - (setq nnimap-connection-alist (delq entry nnimap-connection-alist)) + (setq nnimap-connection-alist (delq entry nnimap-connection-alist) + nnimap-process-buffers + (delq (cadr entry) nnimap-process-buffers)) + (when (buffer-live-p (cadr entry)) + (kill-buffer (cadr entry))) nil)))) ;; Leave room for `open-network-stream' to issue a couple of IMAP commit 85edcf7af5d897fcc94ef1a0efb527c4b5e2bcc5 Author: Lars Ingebrigtsen Date: Tue Oct 12 21:55:26 2021 +0200 decoded-time-add doc string addition * lisp/calendar/time-date.el (decoded-time-add): Add a usage example. diff --git a/lisp/calendar/time-date.el b/lisp/calendar/time-date.el index 0aa38166bc..155c34927f 100644 --- a/lisp/calendar/time-date.el +++ b/lisp/calendar/time-date.el @@ -406,7 +406,11 @@ entries only for the values that should be altered. For instance, if you want to \"add two months\" to TIME, then leave all other fields but the month field in DELTA nil, and make -the month field 2. The values in DELTA can be negative. +the month field 2. For instance: + + (decoded-time-add (decode-time) (make-decoded-time :month 2)) + +The values in DELTA can be negative. If applying a month/year delta leaves the time spec invalid, it is decreased to be valid (\"add one month\" to January 31st 2019 commit ebeaa54f1986b6414c6af60660dc6bd53cbf3bf9 Author: Paul Eggert Date: Tue Oct 12 11:54:32 2021 -0700 Pacify GCC 11 -fanalyzer on x86-64 * src/buffer.c (fix_overlays_before): Redo slightly to work around GCC bug 102692 . diff --git a/src/buffer.c b/src/buffer.c index f405bcb583..eca2843e2b 100644 --- a/src/buffer.c +++ b/src/buffer.c @@ -3843,7 +3843,9 @@ fix_overlays_before (struct buffer *bp, ptrdiff_t prev, ptrdiff_t pos) or the found one ends before PREV, or the found one is the last one in the list, we don't have to fix anything. */ - if (!tail || end < prev || !tail->next) + if (!tail) + return; + if (end < prev || !tail->next) return; right_pair = parent; commit 83195c57e6136a8efdeed243e9fffbc1da344f7a Author: Michael Albinus Date: Tue Oct 12 18:53:54 2021 +0200 Adapt emba control files * test/infra/Dockerfile.emba: Print core pattern. * test/infra/gitlab-ci.yml (.job-template, .test-template): Improve wildcard. (.job-template): Add timeout. diff --git a/test/infra/Dockerfile.emba b/test/infra/Dockerfile.emba index c129bc8be8..e62a55e7a5 100644 --- a/test/infra/Dockerfile.emba +++ b/test/infra/Dockerfile.emba @@ -26,6 +26,7 @@ FROM debian:stretch as emacs-base +RUN cat /proc/sys/kernel/core_pattern RUN apt-get update && \ apt-get install -y --no-install-recommends -o=Dpkg::Use-Pty=0 \ libc-dev gcc g++ make autoconf automake libncurses-dev gnutls-dev \ diff --git a/test/infra/gitlab-ci.yml b/test/infra/gitlab-ci.yml index 532d333e34..15327b0028 100644 --- a/test/infra/gitlab-ci.yml +++ b/test/infra/gitlab-ci.yml @@ -75,11 +75,11 @@ default: - autogen.sh - configure.ac - lib/*.{h,c} - - lisp/**/*.el + - lisp/**.el - src/*.{h,c} - test/infra/* - test/lib-src/*.el - - test/lisp/**/*.el + - test/lisp/**.el - test/src/*.el - changes: # gfilemonitor, kqueue @@ -107,7 +107,7 @@ default: # TODO: with make -j4 several of the tests were failing, for # example shadowfile-tests, but passed without it. - 'export PWD=$(pwd)' - - 'docker run -i -e EMACS_EMBA_CI=${EMACS_EMBA_CI} --volumes-from $(docker ps -q -f "label=com.gitlab.gitlab-runner.job.id=${CI_JOB_ID}"):ro --name ${test_name} ${CI_REGISTRY_IMAGE}:${target}-${BUILD_TAG} /bin/bash -c "git fetch ${PWD} HEAD && echo checking out these updated files && git diff --name-only FETCH_HEAD && ( git diff --name-only FETCH_HEAD | xargs git checkout -f FETCH_HEAD ) && make -j4 && make ${make_params}"' + - 'docker run -i -e EMACS_EMBA_CI=${EMACS_EMBA_CI} --volumes-from $(docker ps -q -f "label=com.gitlab.gitlab-runner.job.id=${CI_JOB_ID}"):ro --name ${test_name} ${CI_REGISTRY_IMAGE}:${target}-${BUILD_TAG} /bin/bash -c "git fetch ${PWD} HEAD && echo checking out these updated files && git diff --name-only FETCH_HEAD && ( git diff --name-only FETCH_HEAD | xargs git checkout -f FETCH_HEAD ) && make -j4 && timeout 3600s make ${make_params}"' after_script: # - docker ps -a # - printenv @@ -146,8 +146,6 @@ default: - docker push ${CI_REGISTRY_IMAGE}:${target}-${BUILD_TAG} .test-template: - # Do not block later stages. - # allow_failure: true # Do not run fast and normal test jobs when scheduled. rules: - if: '$CI_JOB_STAGE =~ "fast|normal" && $CI_PIPELINE_SOURCE == "schedule"' @@ -158,7 +156,7 @@ default: public: true expire_in: 1 week paths: - - "${test_name}/**/*.log" + - "**.log" .gnustep-template: rules: commit 56d1f42f3007c9b4be8ddb6322e8e2ed21d5da95 Author: Gregory Heytings Date: Tue Oct 12 12:50:21 2021 +0000 Improve handling of non-character events in input methods * lisp/international/quail.el (quail-add-unread-command-events): Handle non-vector event arguments. Fixes bug#51118. diff --git a/lisp/international/quail.el b/lisp/international/quail.el index 50ff307b73..ee935b11ec 100644 --- a/lisp/international/quail.el +++ b/lisp/international/quail.el @@ -1382,6 +1382,8 @@ a cons cell of the form (no-record . KEY). If KEY is a vector of events, the events in the vector are prepended to `unread-command-events', after converting each event to a cons cell of the form (no-record . EVENT). +If KEY is an event, it is prepended to `unread-command-events' as a cons +cell of the form (no-record . EVENT). If RESET is non-nil, the events in `unread-command-events' are first discarded, i.e. in this case KEY will end up being the only key in `unread-command-events'." @@ -1390,7 +1392,7 @@ in `unread-command-events'." (if (characterp key) (cons (cons 'no-record key) unread-command-events) (append (mapcan (lambda (e) (list (cons 'no-record e))) - (append key nil)) + (append (if (vectorp key) key (vector key)) nil)) unread-command-events)))) (defun quail-start-translation (key) commit 3fbe6fd367ddb337a25ff261502e2e8dccb69649 Author: João Távora Date: Tue Oct 12 16:50:46 2021 +0100 ; Fix mistakes in last doc rewording about shorthands bug#51089 1. The 'punctuation' syntax class is actually empty in Emacs Lisp. The class used in the implementation is 'symbol constituents'; 2) The prefix to escape shorthands is '#_' together, not '#' or '_'. * doc/lispref/symbols.texi (Shorthands): Fix exception. diff --git a/doc/lispref/symbols.texi b/doc/lispref/symbols.texi index 32590d4f99..b30a16927e 100644 --- a/doc/lispref/symbols.texi +++ b/doc/lispref/symbols.texi @@ -742,12 +742,12 @@ There are two exceptions to rules governing Shorthand transformations: @itemize @bullet @item -Symbol forms comprised entirely of symbol and punctuation characters -(@pxref{Syntax Class Table}) are not transformed. For example, -it's possible to use @code{-} or @code{/=} as shorthand prefixes, but -that won't shadow the arithmetic @emph{functions} of those names. +Symbol forms comprised entirely of characters in the Emacs Lisp symbol +constituent class (@pxref{Syntax Class Table}) are not transformed. +For example, it's possible to use @code{-} or @code{/=} as shorthand +prefixes, but that won't shadow the arithmetic @emph{functions} of +those names. @item -Symbol forms whose names start with @samp{#} or @samp{_} are not -transformed. +Symbol forms whose names start with @samp{#_} are not transformed. @end itemize commit d4a033696d3389bd65d751050f98de12236e3101 Merge: b36cbf2fef 66b8dfd060 Author: Glenn Morris Date: Tue Oct 12 07:50:19 2021 -0700 Merge from origin/emacs-28 66b8dfd060 (origin/emacs-28) ; Fix last change related to shorthands 3832b983cf In Fdelete_other_windows_internal fix new total window siz... 5deb0ec14f * lisp/mh-e/mh-show.el (mh-junk-whitelist): Custom obsoles... cf1409db71 Don't apply shorthands to punctuation-only symbols (bug#51... b3d0f53b29 * lisp/progmodes/python.el: Bump package version to 0.28. commit b36cbf2fefe6d9c154e615b660a9166abdca1f51 Merge: 655c8c29d4 392d6708a5 Author: Glenn Morris Date: Tue Oct 12 07:50:19 2021 -0700 ; Merge from origin/emacs-28 The following commit was skipped: 392d6708a5 Fontify "print" and "exec" as functions in python-mode commit 655c8c29d4839b4a9c42e3caf8bcd48380c54e91 Merge: 2708b48719 47e09d1855 Author: Glenn Morris Date: Tue Oct 12 07:50:19 2021 -0700 Merge from origin/emacs-28 47e09d1855 Copy parent face attributes to tab-line-tab-current instea... d96f8b22c0 Another fix for 'ibuffer-shrink-to-fit' (Bug#7218, Bug#51029) commit 2708b4871951d231ac68c685ca3c28e42c614ed9 Merge: 1283c2db5c 665a184f87 Author: Glenn Morris Date: Tue Oct 12 07:50:19 2021 -0700 ; Merge from origin/emacs-28 The following commit was skipped: 665a184f87 Backport: * doc/misc/tramp.texi (Bug Reports): Describe, h... commit 1283c2db5c3a846046612617f0b83f76d885e963 Merge: a1477ebb0c 0d374b1b83 Author: Glenn Morris Date: Tue Oct 12 07:50:19 2021 -0700 Merge from origin/emacs-28 0d374b1b83 Work around GCC bug 102671 commit 66b8dfd0602c2175a0296ce6a844d77c94813429 Author: Eli Zaretskii Date: Tue Oct 12 16:20:47 2021 +0300 ; Fix last change related to shorthands * src/lread.c (read1): Minor stylistic fixes of the last change, including the wording of the comment. * doc/lispref/symbols.texi (Shorthands): Fix wording and typos. diff --git a/doc/lispref/symbols.texi b/doc/lispref/symbols.texi index ed7dce1c09..32590d4f99 100644 --- a/doc/lispref/symbols.texi +++ b/doc/lispref/symbols.texi @@ -742,13 +742,12 @@ There are two exceptions to rules governing Shorthand transformations: @itemize @bullet @item -Symbol forms comprised entirely of symbol constituents (@pxref{Syntax -Class Table}) are exempt not transform. For example, it's possible to -use @code{-} or @code{/=} as shorthand prefixes, but that won't shadow -the arithmetic @emph{functions} that have exactly that prefix as their -full name.; +Symbol forms comprised entirely of symbol and punctuation characters +(@pxref{Syntax Class Table}) are not transformed. For example, +it's possible to use @code{-} or @code{/=} as shorthand prefixes, but +that won't shadow the arithmetic @emph{functions} of those names. @item -Symbol forms whose name starts with the the characters @code{#_} are -also exempted. +Symbol forms whose names start with @samp{#} or @samp{_} are not +transformed. @end itemize diff --git a/src/lread.c b/src/lread.c index 128b46aefe..b3f9e6ff52 100644 --- a/src/lread.c +++ b/src/lread.c @@ -3805,12 +3805,13 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list) ptrdiff_t longhand_bytes = 0; Lisp_Object tem; - if (skip_shorthand || + if (skip_shorthand /* The following ASCII characters are used in the - only "core" Emacs Lisp symbols that are - exclusively comprised of 'symbol constituent' - syntax. */ - strspn(read_buffer, "^*+-/<=>_|") >= nbytes) + only "core" Emacs Lisp symbols that are comprised + entirely of characters that have the 'symbol + constituent' syntax. We exempt them from + transforming according to shorthands. */ + || strspn (read_buffer, "^*+-/<=>_|") >= nbytes) tem = oblookup (obarray, read_buffer, nchars, nbytes); else tem = oblookup_considering_shorthand (obarray, read_buffer, commit a1477ebb0c849a2beadca94620766a7ba5a1350a Author: Lars Ingebrigtsen Date: Tue Oct 12 14:27:29 2021 +0200 Fix more Gnus group key bindings recently changed * lisp/gnus/gnus-group.el (:keymap): Fix some prefix keys that ended up in the wrong place during the keymap rewrite (bug#51136). diff --git a/lisp/gnus/gnus-group.el b/lisp/gnus/gnus-group.el index 2a4c84c94b..ddc819877c 100644 --- a/lisp/gnus/gnus-group.el +++ b/lisp/gnus/gnus-group.el @@ -683,27 +683,27 @@ simple manner." "z" #'gnus-group-compact-group "x" #'gnus-group-expunge-group "\177" #'gnus-group-delete-group - [delete] #'gnus-group-delete-group) - - "S" (define-keymap :prefix 'gnus-group-sort-map - "s" #'gnus-group-sort-groups - "a" #'gnus-group-sort-groups-by-alphabet - "u" #'gnus-group-sort-groups-by-unread - "l" #'gnus-group-sort-groups-by-level - "v" #'gnus-group-sort-groups-by-score - "r" #'gnus-group-sort-groups-by-rank - "m" #'gnus-group-sort-groups-by-method - "n" #'gnus-group-sort-groups-by-real-name) - - "P" (define-keymap :prefix 'gnus-group-sort-selected-map - "s" #'gnus-group-sort-selected-groups - "a" #'gnus-group-sort-selected-groups-by-alphabet - "u" #'gnus-group-sort-selected-groups-by-unread - "l" #'gnus-group-sort-selected-groups-by-level - "v" #'gnus-group-sort-selected-groups-by-score - "r" #'gnus-group-sort-selected-groups-by-rank - "m" #'gnus-group-sort-selected-groups-by-method - "n" #'gnus-group-sort-selected-groups-by-real-name) + [delete] #'gnus-group-delete-group + + "S" (define-keymap :prefix 'gnus-group-sort-map + "s" #'gnus-group-sort-groups + "a" #'gnus-group-sort-groups-by-alphabet + "u" #'gnus-group-sort-groups-by-unread + "l" #'gnus-group-sort-groups-by-level + "v" #'gnus-group-sort-groups-by-score + "r" #'gnus-group-sort-groups-by-rank + "m" #'gnus-group-sort-groups-by-method + "n" #'gnus-group-sort-groups-by-real-name) + + "P" (define-keymap :prefix 'gnus-group-sort-selected-map + "s" #'gnus-group-sort-selected-groups + "a" #'gnus-group-sort-selected-groups-by-alphabet + "u" #'gnus-group-sort-selected-groups-by-unread + "l" #'gnus-group-sort-selected-groups-by-level + "v" #'gnus-group-sort-selected-groups-by-score + "r" #'gnus-group-sort-selected-groups-by-rank + "m" #'gnus-group-sort-selected-groups-by-method + "n" #'gnus-group-sort-selected-groups-by-real-name)) "A" (define-keymap :prefix 'gnus-group-list-map "k" #'gnus-group-list-killed commit 3e0b2a353519f849093086e777bde359175c4547 Author: Stefan Kangas Date: Tue Oct 12 14:04:21 2021 +0200 Remove more MH-E compat code * lisp/mh-e/mh-e.el (mh-strip-package-version, defgroup-mh) (defcustom-mh, defface-mh): Make Emacs 21 compat aliases obsolete. Update callers. * lisp/mh-e/mh-e.el: (mh-exchange-point-and-mark-preserving-active-mark) * lisp/mh-e/mh-folder.el (desktop-buffer-mode-handlers): * lisp/mh-e/mh-mime.el (mh-mm-inline-media-tests) (mh-have-file-command, mh-mime-security-button-map): * lisp/mh-e/mh-show.el (mh-summary-height): * lisp/mh-e/mh-speed.el (mh-process-kill-without-query): * lisp/mh-e/mh-xface.el (mh-uncompface-executable) (mh-face-to-png, mh-uncompface, mh-picon-file-contents): Remove XEmacs and Emacs 21 and older compat code. diff --git a/lisp/mh-e/mh-acros.el b/lisp/mh-e/mh-acros.el index 575b233e1b..0669f5bb22 100644 --- a/lisp/mh-e/mh-acros.el +++ b/lisp/mh-e/mh-acros.el @@ -110,11 +110,11 @@ XEmacs and versions of GNU Emacs before 21.1 require (defmacro mh-mark-active-p (check-transient-mark-mode-flag) "If CHECK-TRANSIENT-MARK-MODE-FLAG is non-nil then check if variable `transient-mark-mode' is active." + (declare (obsolete nil "29.1")) (cond ((not check-transient-mark-mode-flag) - '(and (boundp 'mark-active) mark-active)) + 'mark-active) (t - '(and (boundp 'transient-mark-mode) transient-mark-mode - (boundp 'mark-active) mark-active)))) + '(and transient-mark-mode mark-active)))) ;;;###mh-autoload (defmacro with-mh-folder-updating (save-modification-flag &rest body) diff --git a/lisp/mh-e/mh-e.el b/lisp/mh-e/mh-e.el index b02b8e0154..f47b6f46cf 100644 --- a/lisp/mh-e/mh-e.el +++ b/lisp/mh-e/mh-e.el @@ -88,26 +88,6 @@ (require 'mh-buffers) (require 'mh-compat) -(font-lock-add-keywords - 'emacs-lisp-mode - (eval-when-compile - `((,(concat "(\\(" - ;; Function declarations (use font-lock-function-name-face). - "\\(def\\(un\\|macro\\)-mh\\)\\|" - ;; Variable declarations (use font-lock-variable-name-face). - "\\(def\\(custom\\|face\\)-mh\\)\\|" - ;; Group declarations (use font-lock-type-face). - "\\(defgroup-mh\\)" - "\\)\\>" - ;; Any whitespace and defined object. - "[ \t'(]*" - "\\(setf[ \t]+\\sw+)\\|\\sw+\\)?") - (1 font-lock-keyword-face) - (7 (cond ((match-beginning 2) font-lock-function-name-face) - ((match-beginning 4) font-lock-variable-name-face) - (t font-lock-type-face)) - nil t))))) - ;;; Global Variables @@ -621,14 +601,13 @@ Output is expected to be shown to user, not parsed by MH-E." This command works even when the mark is not active, and preserves whether the mark is active or not." (interactive nil) - (let ((is-active (and (boundp 'mark-active) mark-active))) + (let ((is-active mark-active)) (let ((omark (mark t))) (if (null omark) (error "No mark set in this buffer")) (set-mark (point)) (goto-char omark) - (if (boundp 'mark-active) - (setq mark-active is-active)) + (setq mark-active is-active) nil))) (defun mh-exec-lib-cmd-output (command &rest args) @@ -659,50 +638,36 @@ Set mark after inserted text." ;; Temporary function and data structure used customization. ;; These will be unbound after the options are defined. (defmacro mh-strip-package-version (args) - "Strip :package-version keyword and its value from ARGS. -In Emacs versions that support the :package-version keyword, -ARGS is returned unchanged." - `(if (boundp 'customize-package-emacs-version-alist) - ,args - (let (seen) - (cl-loop for keyword in ,args - if (cond ((eq keyword ':package-version) (setq seen t) nil) - (seen (setq seen nil) nil) - (t t)) - collect keyword)))) + "ARGS is returned unchanged." + (declare (obsolete identity "29.1")) + args) (defmacro defgroup-mh (symbol members doc &rest args) "Declare SYMBOL as a customization group containing MEMBERS. See documentation for `defgroup' for a description of the arguments -SYMBOL, MEMBERS, DOC and ARGS. -This macro is used by Emacs versions that lack the :package-version -keyword, introduced in Emacs 22." - (declare (doc-string 3) (indent defun)) - `(defgroup ,symbol ,members ,doc ,@(mh-strip-package-version args))) +SYMBOL, MEMBERS, DOC and ARGS." + (declare (obsolete defgroup "29.1") (doc-string 3) (indent defun)) + `(defgroup ,symbol ,members ,doc ,args)) (defmacro defcustom-mh (symbol value doc &rest args) "Declare SYMBOL as a customizable variable that defaults to VALUE. See documentation for `defcustom' for a description of the arguments -SYMBOL, VALUE, DOC and ARGS. -This macro is used by Emacs versions that lack the :package-version -keyword, introduced in Emacs 22." - (declare (doc-string 3) (indent defun)) - `(defcustom ,symbol ,value ,doc ,@(mh-strip-package-version args))) +SYMBOL, VALUE, DOC and ARGS." + (declare (obsolete defcustom "29.1") (doc-string 3) (indent defun)) + `(defcustom ,symbol ,value ,doc ,args)) (defmacro defface-mh (face spec doc &rest args) "Declare FACE as a customizable face that defaults to SPEC. See documentation for `defface' for a description of the arguments -FACE, SPEC, DOC and ARGS. -This macro is used by Emacs versions that lack the :package-version -keyword, introduced in Emacs 22." - (declare (doc-string 3) (indent defun)) - `(defface ,face ,spec ,doc ,@(mh-strip-package-version args))) +FACE, SPEC, DOC and ARGS." + (declare (obsolete defface "29.1") (doc-string 3) (indent defun)) + `(defface ,face ,spec ,doc ,args)) ;;; Variant Support -(defcustom-mh mh-path nil +(defcustom mh-path nil "Additional list of directories to search for MH. See `mh-variant'." :group 'mh-e @@ -937,7 +902,7 @@ finally GNU mailutils MH." (mapconcat (lambda (x) (format "%s" (car x))) (mh-variants) " or ")))))) -(defcustom-mh mh-variant 'autodetect +(defcustom mh-variant 'autodetect "Specifies the variant used by MH-E. The default setting of this option is \"Auto-detect\" which means @@ -1013,19 +978,18 @@ windows in the frame are removed." (when delete-other-windows-flag (delete-other-windows))) -(if (boundp 'customize-package-emacs-version-alist) - (add-to-list 'customize-package-emacs-version-alist - '(MH-E ("6.0" . "22.1") ("6.1" . "22.1") ("7.0" . "22.1") - ("7.1" . "22.1") ("7.2" . "22.1") ("7.3" . "22.1") - ("7.4" . "22.1") ("8.0" . "22.1") ("8.1" . "23.1") - ("8.2" . "23.1") ("8.3" . "24.1") ("8.4" . "24.4") - ("8.5" . "24.4") ("8.6" . "24.4")))) +(add-to-list 'customize-package-emacs-version-alist + '(MH-E ("6.0" . "22.1") ("6.1" . "22.1") ("7.0" . "22.1") + ("7.1" . "22.1") ("7.2" . "22.1") ("7.3" . "22.1") + ("7.4" . "22.1") ("8.0" . "22.1") ("8.1" . "23.1") + ("8.2" . "23.1") ("8.3" . "24.1") ("8.4" . "24.4") + ("8.5" . "24.4") ("8.6" . "24.4"))) ;;; MH-E Customization Groups -(defgroup-mh mh-e nil +(defgroup mh-e nil "Emacs interface to the MH mail system. MH is the Rand Mail Handler. Other implementations include nmh and GNU mailutils." @@ -1033,126 +997,126 @@ and GNU mailutils." :group 'mail :package-version '(MH-E . "8.0")) -(defgroup-mh mh-alias nil +(defgroup mh-alias nil "Aliases." :link '(custom-manual "(mh-e)Aliases") :prefix "mh-alias-" :group 'mh-e :package-version '(MH-E . "7.1")) -(defgroup-mh mh-folder nil +(defgroup mh-folder nil "Organizing your mail with folders." :prefix "mh-" :link '(custom-manual "(mh-e)Folders") :group 'mh-e :package-version '(MH-E . "7.1")) -(defgroup-mh mh-folder-selection nil +(defgroup mh-folder-selection nil "Folder selection." :prefix "mh-" :link '(custom-manual "(mh-e)Folder Selection") :group 'mh-e :package-version '(MH-E . "8.0")) -(defgroup-mh mh-identity nil +(defgroup mh-identity nil "Identities." :link '(custom-manual "(mh-e)Identities") :prefix "mh-identity-" :group 'mh-e :package-version '(MH-E . "7.1")) -(defgroup-mh mh-inc nil +(defgroup mh-inc nil "Incorporating your mail." :prefix "mh-inc-" :link '(custom-manual "(mh-e)Incorporating Mail") :group 'mh-e :package-version '(MH-E . "8.0")) -(defgroup-mh mh-junk nil +(defgroup mh-junk nil "Dealing with junk mail." :link '(custom-manual "(mh-e)Junk") :prefix "mh-junk-" :group 'mh-e :package-version '(MH-E . "7.3")) -(defgroup-mh mh-letter nil +(defgroup mh-letter nil "Editing a draft." :prefix "mh-" :link '(custom-manual "(mh-e)Editing Drafts") :group 'mh-e :package-version '(MH-E . "7.1")) -(defgroup-mh mh-ranges nil +(defgroup mh-ranges nil "Ranges." :prefix "mh-" :link '(custom-manual "(mh-e)Ranges") :group 'mh-e :package-version '(MH-E . "8.0")) -(defgroup-mh mh-scan-line-formats nil +(defgroup mh-scan-line-formats nil "Scan line formats." :link '(custom-manual "(mh-e)Scan Line Formats") :prefix "mh-" :group 'mh-e :package-version '(MH-E . "8.0")) -(defgroup-mh mh-search nil +(defgroup mh-search nil "Searching." :link '(custom-manual "(mh-e)Searching") :prefix "mh-search-" :group 'mh-e :package-version '(MH-E . "8.0")) -(defgroup-mh mh-sending-mail nil +(defgroup mh-sending-mail nil "Sending mail." :prefix "mh-" :link '(custom-manual "(mh-e)Sending Mail") :group 'mh-e :package-version '(MH-E . "8.0")) -(defgroup-mh mh-sequences nil +(defgroup mh-sequences nil "Sequences." :prefix "mh-" :link '(custom-manual "(mh-e)Sequences") :group 'mh-e :package-version '(MH-E . "8.0")) -(defgroup-mh mh-show nil +(defgroup mh-show nil "Reading your mail." :prefix "mh-" :link '(custom-manual "(mh-e)Reading Mail") :group 'mh-e :package-version '(MH-E . "7.1")) -(defgroup-mh mh-speedbar nil +(defgroup mh-speedbar nil "The speedbar." :prefix "mh-speed-" :link '(custom-manual "(mh-e)Speedbar") :group 'mh-e :package-version '(MH-E . "8.0")) -(defgroup-mh mh-thread nil +(defgroup mh-thread nil "Threading." :prefix "mh-thread-" :link '(custom-manual "(mh-e)Threading") :group 'mh-e :package-version '(MH-E . "8.0")) -(defgroup-mh mh-tool-bar nil +(defgroup mh-tool-bar nil "The tool bar" :link '(custom-manual "(mh-e)Tool Bar") :prefix "mh-" :group 'mh-e :package-version '(MH-E . "8.0")) -(defgroup-mh mh-hooks nil +(defgroup mh-hooks nil "MH-E hooks." :link '(custom-manual "(mh-e)Top") :prefix "mh-" :group 'mh-e :package-version '(MH-E . "7.1")) -(defgroup-mh mh-faces nil +(defgroup mh-faces nil "Faces used in MH-E." :link '(custom-manual "(mh-e)Top") :prefix "mh-" @@ -1168,7 +1132,7 @@ and GNU mailutils." ;;; Aliases (:group 'mh-alias) -(defcustom-mh mh-alias-completion-ignore-case-flag t +(defcustom mh-alias-completion-ignore-case-flag t "Non-nil means don't consider case significant in MH alias completion. As MH ignores case in the aliases, so too does MH-E. However, you @@ -1179,7 +1143,7 @@ lowercase for mailing lists and uppercase for people." :group 'mh-alias :package-version '(MH-E . "7.1")) -(defcustom-mh mh-alias-expand-aliases-flag nil +(defcustom mh-alias-expand-aliases-flag nil "Non-nil means to expand aliases entered in the minibuffer. In other words, aliases entered in the minibuffer will be @@ -1189,7 +1153,7 @@ this expansion is not performed." :group 'mh-alias :package-version '(MH-E . "7.1")) -(defcustom-mh mh-alias-flash-on-comma t +(defcustom mh-alias-flash-on-comma t "Specify whether to flash address or warn on translation. This option controls the behavior when a [comma] is pressed while @@ -1202,7 +1166,7 @@ does not display a warning if the alias is not found." :group 'mh-alias :package-version '(MH-E . "7.1")) -(defcustom-mh mh-alias-insert-file nil +(defcustom mh-alias-insert-file nil "Filename used to store a new MH-E alias. The default setting of this option is \"Use Aliasfile Profile @@ -1216,7 +1180,7 @@ name, MH-E will prompt for one of them when MH-E adds an alias." :group 'mh-alias :package-version '(MH-E . "7.1")) -(defcustom-mh mh-alias-insertion-location 'sorted +(defcustom mh-alias-insertion-location 'sorted "Specifies where new aliases are entered in alias files. This option is set to \"Alphabetical\" by default. If you organize @@ -1228,7 +1192,7 @@ or \"Bottom\" of your alias file might be more appropriate." :group 'mh-alias :package-version '(MH-E . "7.1")) -(defcustom-mh mh-alias-local-users t +(defcustom mh-alias-local-users t "Non-nil means local users are added to alias completion. Aliases are created from \"/etc/passwd\" entries with a user ID @@ -1249,7 +1213,7 @@ NIS password file." :group 'mh-alias :package-version '(MH-E . "7.1")) -(defcustom-mh mh-alias-local-users-prefix "local." +(defcustom mh-alias-local-users-prefix "local." "String prefixed to the real names of users from the password file. This option can also be set to \"Use Login\". @@ -1271,7 +1235,7 @@ turned off." :group 'mh-alias :package-version '(MH-E . "7.4")) -(defcustom-mh mh-alias-passwd-gecos-comma-separator-flag t +(defcustom mh-alias-passwd-gecos-comma-separator-flag t "Non-nil means the gecos field in the password file uses a comma separator. In the example in `mh-alias-local-users-prefix', commas are used @@ -1285,7 +1249,7 @@ whose contents may contain commas, you can turn this option off." ;;; Organizing Your Mail with Folders (:group 'mh-folder) -(defcustom-mh mh-new-messages-folders t +(defcustom mh-new-messages-folders t "Folders searched for the \"unseen\" sequence. Set this option to \"Inbox\" to search the \"+inbox\" folder or @@ -1300,7 +1264,7 @@ See also `mh-recursive-folders-flag'." :group 'mh-folder :package-version '(MH-E . "8.0")) -(defcustom-mh mh-ticked-messages-folders t +(defcustom mh-ticked-messages-folders t "Folders searched for `mh-tick-seq'. Set this option to \"Inbox\" to search the \"+inbox\" folder or @@ -1315,7 +1279,7 @@ See also `mh-recursive-folders-flag'." :group 'mh-folder :package-version '(MH-E . "8.0")) -(defcustom-mh mh-large-folder 200 +(defcustom mh-large-folder 200 "The number of messages that indicates a large folder. If a folder is deemed to be large, that is the number of messages @@ -1327,7 +1291,7 @@ folders are treated as if they are small." :group 'mh-folder :package-version '(MH-E . "7.0")) -(defcustom-mh mh-recenter-summary-flag nil +(defcustom mh-recenter-summary-flag nil "Non-nil means to recenter the summary window. If this option is turned on, recenter the summary window when the @@ -1336,13 +1300,13 @@ show window is toggled off." :group 'mh-folder :package-version '(MH-E . "7.0")) -(defcustom-mh mh-recursive-folders-flag nil +(defcustom mh-recursive-folders-flag nil "Non-nil means that commands which operate on folders do so recursively." :type 'boolean :group 'mh-folder :package-version '(MH-E . "7.0")) -(defcustom-mh mh-sortm-args nil +(defcustom mh-sortm-args nil "Additional arguments for \"sortm\"\\. This option is consulted when a prefix argument is used with @@ -1356,7 +1320,7 @@ an alternate view. For example, (\"-nolimit\" \"-textfield\" ;;; Folder Selection (:group 'mh-folder-selection) -(defcustom-mh mh-default-folder-for-message-function nil +(defcustom mh-default-folder-for-message-function nil "Function to select a default folder for refiling or \"Fcc:\". When this function is called, the current buffer contains the message @@ -1368,7 +1332,7 @@ the default, or an empty string to suppress the default entirely." :group 'mh-folder-selection :package-version '(MH-E . "8.0")) -(defcustom-mh mh-default-folder-list nil +(defcustom mh-default-folder-list nil "List of addresses and folders. The folder name associated with the first address found in this @@ -1386,7 +1350,7 @@ for more information." :group 'mh-folder-selection :package-version '(MH-E . "7.2")) -(defcustom-mh mh-default-folder-must-exist-flag t +(defcustom mh-default-folder-must-exist-flag t "Non-nil means guessed folder name must exist to be used. If the derived folder does not exist, and this option is on, then @@ -1400,7 +1364,7 @@ for more information." :group 'mh-folder-selection :package-version '(MH-E . "7.2")) -(defcustom-mh mh-default-folder-prefix "" +(defcustom mh-default-folder-prefix "" "Prefix used for folder names generated from aliases. The prefix is used to prevent clutter in your mail directory. @@ -1419,7 +1383,7 @@ for more information." Real definition will take effect when mh-identity is loaded." nil))) -(defcustom-mh mh-identity-list nil +(defcustom mh-identity-list nil "List of identities. To customize this option, click on the \"INS\" button and enter a label @@ -1488,7 +1452,7 @@ fashion." :group 'mh-identity :package-version '(MH-E . "7.1")) -(defcustom-mh mh-auto-fields-list nil +(defcustom mh-auto-fields-list nil "List of recipients for which header lines are automatically inserted. This option can be used to set the identity depending on the @@ -1549,14 +1513,14 @@ as the result is undefined." :group 'mh-identity :package-version '(MH-E . "7.3")) -(defcustom-mh mh-auto-fields-prompt-flag t +(defcustom mh-auto-fields-prompt-flag t "Non-nil means to prompt before sending if fields inserted. See `mh-auto-fields-list'." :type 'boolean :group 'mh-identity :package-version '(MH-E . "8.0")) -(defcustom-mh mh-identity-default nil +(defcustom mh-identity-default nil "Default identity to use when `mh-letter-mode' is called. See `mh-identity-list'." :type (append @@ -1567,7 +1531,7 @@ See `mh-identity-list'." :group 'mh-identity :package-version '(MH-E . "7.1")) -(defcustom-mh mh-identity-handlers +(defcustom mh-identity-handlers '(("From" . mh-identity-handler-top) (":default" . mh-identity-handler-bottom) (":attribution-verb" . mh-identity-handler-attribution-verb) @@ -1603,7 +1567,7 @@ containing the VALUE for the field is given." ;;; Incorporating Your Mail (:group 'mh-inc) -(defcustom-mh mh-inc-prog "inc" +(defcustom mh-inc-prog "inc" "Program to incorporate new mail into a folder. This program generates a one-line summary for each of the new @@ -1622,7 +1586,7 @@ several scan line format variables appropriately." Real definition will take effect when mh-inc is loaded." nil))) -(defcustom-mh mh-inc-spool-list nil +(defcustom mh-inc-spool-list nil "Alternate spool files. You can use the `mh-inc-spool-list' variable to direct MH-E to @@ -1692,7 +1656,7 @@ The function is always called with SYMBOL bound to until (executable-find (symbol-name (car element))) finally return (car element))))) -(defcustom-mh mh-junk-background nil +(defcustom mh-junk-background nil "If on, spam programs are run in background. By default, the programs are run in the foreground, but this can @@ -1710,14 +1674,14 @@ may be useful for debugging." :group 'mh-junk :package-version '(MH-E . "8.0")) -(defcustom-mh mh-junk-disposition nil +(defcustom mh-junk-disposition nil "Disposition of junk mail." :type '(choice (const :tag "Delete Spam" nil) (string :tag "Spam Folder")) :group 'mh-junk :package-version '(MH-E . "8.0")) -(defcustom-mh mh-junk-program nil +(defcustom mh-junk-program nil "Spam program that MH-E should use. The default setting of this option is \"Auto-detect\" which means @@ -1735,7 +1699,7 @@ bogofilter, then you can set this option to \"Bogofilter\"." ;;; Editing a Draft (:group 'mh-letter) -(defcustom-mh mh-compose-insertion (if (locate-library "mml") 'mml 'mh) +(defcustom mh-compose-insertion (if (locate-library "mml") 'mml 'mh) "Type of tags used when composing MIME messages. In addition to MH-style directives, MH-E also supports MML (MIME @@ -1749,7 +1713,7 @@ MH-style directives are preferred." :group 'mh-letter :package-version '(MH-E . "7.0")) -(defcustom-mh mh-compose-skipped-header-fields +(defcustom mh-compose-skipped-header-fields '("From" "Organization" "References" "In-Reply-To" "X-Face" "Face" "X-Image-URL" "X-Mailer") "List of header fields to skip over when navigating in draft." @@ -1757,13 +1721,13 @@ MH-style directives are preferred." :group 'mh-letter :package-version '(MH-E . "7.4")) -(defcustom-mh mh-compose-space-does-completion-flag nil +(defcustom mh-compose-space-does-completion-flag nil "Non-nil means \\\\[mh-letter-complete-or-space] does completion in message header." :type 'boolean :group 'mh-letter :package-version '(MH-E . "7.4")) -(defcustom-mh mh-delete-yanked-msg-window-flag nil +(defcustom mh-delete-yanked-msg-window-flag nil "Non-nil means delete any window displaying the message. This deletes the window containing the original message after @@ -1773,7 +1737,7 @@ more room on your screen for your reply." :group 'mh-letter :package-version '(MH-E . "7.0")) -(defcustom-mh mh-extract-from-attribution-verb "wrote:" +(defcustom mh-extract-from-attribution-verb "wrote:" "Verb to use for attribution when a message is yanked by \\\\[mh-yank-cur-msg]. The attribution consists of the sender's name and email address @@ -1787,7 +1751,7 @@ followed by the content of this option. This option can be set to :group 'mh-letter :package-version '(MH-E . "7.0")) -(defcustom-mh mh-ins-buf-prefix "> " +(defcustom mh-ins-buf-prefix "> " "String to put before each line of a yanked or inserted message. The prefix \"> \" is the default setting of this option. I @@ -1803,7 +1767,7 @@ flavors of `mh-yank-behavior' or you have added a :group 'mh-letter :package-version '(MH-E . "6.0")) -(defcustom-mh mh-letter-complete-function 'ispell-complete-word +(defcustom mh-letter-complete-function 'ispell-complete-word "Function to call when completing outside of address or folder fields. In the body of the message, @@ -1813,7 +1777,7 @@ which is set to \"ispell-complete-word\" by default." :group 'mh-letter :package-version '(MH-E . "7.1")) -(defcustom-mh mh-letter-fill-column 72 +(defcustom mh-letter-fill-column 72 "Fill column to use in MH Letter mode. By default, this option is 72 to allow others to quote your @@ -1822,7 +1786,7 @@ message without line wrapping." :group 'mh-letter :package-version '(MH-E . "6.0")) -(defcustom-mh mh-mml-method-default (if mh-pgp-support-flag "pgpmime" "none") +(defcustom mh-mml-method-default (if mh-pgp-support-flag "pgpmime" "none") "Default method to use in security tags. This option is used to select between a variety of mail security @@ -1845,7 +1809,7 @@ you write!" :group 'mh-letter :package-version '(MH-E . "8.0")) -(defcustom-mh mh-signature-file-name "~/.signature" +(defcustom mh-signature-file-name "~/.signature" "Source of user's signature. By default, the text of your signature is taken from the file @@ -1868,7 +1832,7 @@ The signature is inserted into your message with the command :group 'mh-letter :package-version '(MH-E . "6.0")) -(defcustom-mh mh-signature-separator-flag t +(defcustom mh-signature-separator-flag t "Non-nil means a signature separator should be inserted. It is not recommended that you change this option since various @@ -1879,7 +1843,7 @@ replying or yanking a letter into a draft." :group 'mh-letter :package-version '(MH-E . "8.0")) -(defcustom-mh mh-x-face-file "~/.face" +(defcustom mh-x-face-file "~/.face" "File containing face header field to insert in outgoing mail. If the file starts with either of the strings \"X-Face:\", \"Face:\" @@ -1908,7 +1872,7 @@ this option doesn't exist." :group 'mh-letter :package-version '(MH-E . "7.0")) -(defcustom-mh mh-yank-behavior 'attribution +(defcustom mh-yank-behavior 'attribution "Controls which part of a message is yanked by \\\\[mh-yank-cur-msg]. To include the entire message, including the entire header, use @@ -1955,7 +1919,7 @@ inserted." ;;; Ranges (:group 'mh-ranges) -(defcustom-mh mh-interpret-number-as-range-flag t +(defcustom mh-interpret-number-as-range-flag t "Non-nil means interpret a number as a range. Since one of the most frequent ranges used is \"last:N\", MH-E @@ -1975,7 +1939,7 @@ message 200, then use the range \"200:200\"." Real definition, below, uses variables that aren't defined yet." (set-default symbol value)))) -(defcustom-mh mh-adaptive-cmd-note-flag t +(defcustom mh-adaptive-cmd-note-flag t "Non-nil means that the message number width is determined dynamically. If you've created your own format to handle long message numbers, @@ -2004,7 +1968,7 @@ set SYMBOL to VALUE." "unless you use \"Use MH-E scan Format\"") (set-default symbol value))) -(defcustom-mh mh-scan-format-file t +(defcustom mh-scan-format-file t "Specifies the format file to pass to the scan program. The default setting for this option is \"Use MH-E scan Format\". This @@ -2043,7 +2007,7 @@ Otherwise, set SYMBOL to VALUE." "is set to \"Use MH-E scan Format\"") (set-default symbol value))) -(defcustom-mh mh-scan-prog "scan" +(defcustom mh-scan-prog "scan" "Program used to scan messages. The name of the program that generates a listing of one line per @@ -2058,7 +2022,7 @@ directory. You may link another program to `scan' (see ;;; Searching (:group 'mh-search) -(defcustom-mh mh-search-program nil +(defcustom mh-search-program nil "Search program that MH-E shall use. The default setting of this option is \"Auto-detect\" which means @@ -2081,7 +2045,7 @@ MH-E can be found in the documentation of `mh-search'." ;;; Sending Mail (:group 'mh-sending-mail) -(defcustom-mh mh-compose-forward-as-mime-flag t +(defcustom mh-compose-forward-as-mime-flag t "Non-nil means that messages are forwarded as attachments. By default, this option is on which means that the forwarded @@ -2097,7 +2061,7 @@ regardless of the settings of this option." :group 'mh-sending-mail :package-version '(MH-E . "8.0")) -(defcustom-mh mh-compose-letter-function nil +(defcustom mh-compose-letter-function nil "Invoked when starting a new draft. However, it is the last function called before you edit your @@ -2109,13 +2073,13 @@ fields." :group 'mh-sending-mail :package-version '(MH-E . "6.0")) -(defcustom-mh mh-compose-prompt-flag nil +(defcustom mh-compose-prompt-flag nil "Non-nil means prompt for header fields when composing a new draft." :type 'boolean :group 'mh-sending-mail :package-version '(MH-E . "7.4")) -(defcustom-mh mh-forward-subject-format "%s: %s" +(defcustom mh-forward-subject-format "%s: %s" "Format string for forwarded message subject. This option is a string which includes two escapes (\"%s\"). The @@ -2125,7 +2089,7 @@ and the second one is replaced with the original \"Subject:\"." :group 'mh-sending-mail :package-version '(MH-E . "6.0")) -(defcustom-mh mh-insert-x-mailer-flag t +(defcustom mh-insert-x-mailer-flag t "Non-nil means append an \"X-Mailer:\" header field to the header. This header field includes the version of MH-E and Emacs that you @@ -2135,7 +2099,7 @@ can turn this option off." :group 'mh-sending-mail :package-version '(MH-E . "7.0")) -(defcustom-mh mh-redist-full-contents-flag nil +(defcustom mh-redist-full-contents-flag nil "Non-nil means the \"dist\" command needs entire letter for redistribution. This option must be turned on if \"dist\" requires the whole @@ -2147,7 +2111,7 @@ has been redistributed before, turn off this option." :group 'mh-sending-mail :package-version '(MH-E . "8.0")) -(defcustom-mh mh-reply-default-reply-to nil +(defcustom mh-reply-default-reply-to nil "Sets the person or persons to whom a reply will be sent. This option is set to \"Prompt\" by default so that you are @@ -2163,7 +2127,7 @@ this option to \"cc\". Other choices include \"from\", \"to\", or :group 'mh-sending-mail :package-version '(MH-E . "6.0")) -(defcustom-mh mh-reply-show-message-flag t +(defcustom mh-reply-show-message-flag t "Non-nil means the MH-Show buffer is displayed when replying. If you include the message automatically, you can hide the @@ -2180,7 +2144,7 @@ See also `mh-reply'." ;; the docstring: "Additional sequences that should not to be preserved can be ;; specified by setting `mh-unpropagated-sequences' appropriately." XXX -(defcustom-mh mh-refile-preserves-sequences-flag t +(defcustom mh-refile-preserves-sequences-flag t "Non-nil means that sequences are preserved when messages are refiled. If a message is in any sequence (except \"Previous-Sequence:\" @@ -2191,7 +2155,7 @@ desired, then turn off this option." :group 'mh-sequences :package-version '(MH-E . "7.4")) -(defcustom-mh mh-tick-seq 'tick +(defcustom mh-tick-seq 'tick "The name of the MH sequence for ticked messages. You can customize this option if you already use the \"tick\" @@ -2203,7 +2167,7 @@ there isn't much advantage to that." :group 'mh-sequences :package-version '(MH-E . "7.3")) -(defcustom-mh mh-update-sequences-after-mh-show-flag t +(defcustom mh-update-sequences-after-mh-show-flag t "Non-nil means flush MH sequences to disk after message is shown\\. Three sequences are maintained internally by MH-E and pushed out @@ -2218,7 +2182,7 @@ commands." :group 'mh-sequences :package-version '(MH-E . "7.0")) -(defcustom-mh mh-allowlist-preserves-sequences-flag t +(defcustom mh-allowlist-preserves-sequences-flag t "Non-nil means that sequences are preserved when messages are allowlisted. If a message is in any sequence (except \"Previous-Sequence:\" @@ -2231,7 +2195,7 @@ not desired, then turn off this option." ;;; Reading Your Mail (:group 'mh-show) -(defcustom-mh mh-bury-show-buffer-flag t +(defcustom mh-bury-show-buffer-flag t "Non-nil means show buffer is buried. One advantage of not burying the show buffer is that one can @@ -2242,7 +2206,7 @@ running \\[electric-buffer-list] to see what I mean." :group 'mh-show :package-version '(MH-E . "7.0")) -(defcustom-mh mh-clean-message-header-flag t +(defcustom mh-clean-message-header-flag t "Non-nil means remove extraneous header fields. See also `mh-invisible-header-fields-default' and @@ -2251,7 +2215,7 @@ See also `mh-invisible-header-fields-default' and :group 'mh-show :package-version '(MH-E . "7.0")) -(defcustom-mh mh-decode-mime-flag (not (not (locate-library "mm-decode"))) +(defcustom mh-decode-mime-flag (not (not (locate-library "mm-decode"))) "Non-nil means attachments are handled\\. MH-E can handle attachments as well if the Gnus `mm-decode' @@ -2269,7 +2233,7 @@ messages and other graphical widgets. See the options :group 'mh-show :package-version '(MH-E . "7.0")) -(defcustom-mh mh-display-buttons-for-alternatives-flag nil +(defcustom mh-display-buttons-for-alternatives-flag nil "Non-nil means display buttons for all alternative attachments. Sometimes, a mail program will produce multiple alternatives of @@ -2281,7 +2245,7 @@ inline and buttons are shown for each of the other alternatives." :group 'mh-show :package-version '(MH-E . "7.4")) -(defcustom-mh mh-display-buttons-for-inline-parts-flag nil +(defcustom mh-display-buttons-for-inline-parts-flag nil "Non-nil means display buttons for all inline attachments\\. The sender can request that attachments should be viewed inline so @@ -2304,7 +2268,7 @@ text (including HTML) and images." :group 'mh-show :package-version '(MH-E . "7.0")) -(defcustom-mh mh-do-not-confirm-flag nil +(defcustom mh-do-not-confirm-flag nil "Non-nil means non-reversible commands do not prompt for confirmation. Commands such as `mh-pack-folder' prompt to confirm whether to @@ -2316,7 +2280,7 @@ retracted--without question." :group 'mh-show :package-version '(MH-E . "7.0")) -(defcustom-mh mh-fetch-x-image-url nil +(defcustom mh-fetch-x-image-url nil "Control fetching of \"X-Image-URL:\" header field image. This option controls the fetching of the \"X-Image-URL:\" header @@ -2352,7 +2316,7 @@ turned on." :group 'mh-show :package-version '(MH-E . "7.3")) -(defcustom-mh mh-graphical-smileys-flag t +(defcustom mh-graphical-smileys-flag t "Non-nil means graphical smileys are displayed. It is a long standing custom to inject body language using a @@ -2367,7 +2331,7 @@ turned off." :group 'mh-show :package-version '(MH-E . "7.0")) -(defcustom-mh mh-graphical-emphasis-flag t +(defcustom mh-graphical-emphasis-flag t "Non-nil means graphical emphasis is displayed. A few typesetting features are indicated in ASCII text with @@ -2384,7 +2348,7 @@ turned off." :group 'mh-show :package-version '(MH-E . "7.0")) -(defcustom-mh mh-highlight-citation-style 'gnus +(defcustom mh-highlight-citation-style 'gnus "Style for highlighting citations. If the sender of the message has cited other messages in his @@ -2806,7 +2770,7 @@ Because the function `mh-invisible-headers' uses both `mh-invisible-header-fields' and `mh-invisible-header-fields', it cannot be run until both variables have been initialized.") -(defcustom-mh mh-invisible-header-fields nil +(defcustom mh-invisible-header-fields nil "Additional header fields to hide. Header fields that you would like to hide that aren't listed in @@ -2829,7 +2793,7 @@ See also `mh-clean-message-header-flag'." :group 'mh-show :package-version '(MH-E . "7.1")) -(defcustom-mh mh-invisible-header-fields-default nil +(defcustom mh-invisible-header-fields-default nil "List of hidden header fields. The header fields listed in this option are hidden, although you @@ -2886,7 +2850,7 @@ removed and entries from `mh-invisible-header-fields' are added." ;; Compile invisible header fields. (mh-invisible-headers) -(defcustom-mh mh-lpr-command-format "lpr -J '%s'" +(defcustom mh-lpr-command-format "lpr -J '%s'" "Command used to print\\. This option contains the Unix command line which performs the @@ -2903,7 +2867,7 @@ This option is not used by the commands \\[mh-ps-print-msg] or :group 'mh-show :package-version '(MH-E . "6.0")) -(defcustom-mh mh-max-inline-image-height nil +(defcustom mh-max-inline-image-height nil "Maximum inline image height if \"Content-Disposition:\" is not present. Some older mail programs do not insert this needed plumbing to @@ -2919,7 +2883,7 @@ these numbers." :group 'mh-show :package-version '(MH-E . "7.0")) -(defcustom-mh mh-max-inline-image-width nil +(defcustom mh-max-inline-image-width nil "Maximum inline image width if \"Content-Disposition:\" is not present. Some older mail programs do not insert this needed plumbing to @@ -2935,7 +2899,7 @@ these numbers." :group 'mh-show :package-version '(MH-E . "7.0")) -(defcustom-mh mh-mhl-format-file nil +(defcustom mh-mhl-format-file nil "Specifies the format file to pass to the \"mhl\" program. Normally MH-E takes care of displaying messages itself (rather than @@ -2959,7 +2923,7 @@ file." :group 'mh-show :package-version '(MH-E . "8.0")) -(defcustom-mh mh-mime-save-parts-default-directory t +(defcustom mh-mime-save-parts-default-directory t "Default directory to use for \\\\[mh-mime-save-parts]. The default value for this option is \"Prompt Always\" so that @@ -2975,7 +2939,7 @@ directory's name." :group 'mh-show :package-version '(MH-E . "7.0")) -(defcustom-mh mh-print-background-flag nil +(defcustom mh-print-background-flag nil "Non-nil means messages should be printed in the background\\. Normally messages are printed in the foreground. If this is slow on @@ -2991,7 +2955,7 @@ This option is not used by the commands \\[mh-ps-print-msg] or :group 'mh-show :package-version '(MH-E . "7.0")) -(defcustom-mh mh-show-maximum-size 0 +(defcustom mh-show-maximum-size 0 "Maximum size of message (in bytes) to display automatically. This option provides an opportunity to skip over large messages @@ -3001,7 +2965,7 @@ message are shown regardless of size." :group 'mh-show :package-version '(MH-E . "8.0")) -(defcustom-mh mh-show-use-xface-flag (>= emacs-major-version 21) +(defcustom mh-show-use-xface-flag (>= emacs-major-version 21) "Non-nil means display face images in MH-show buffers. MH-E can display the content of \"Face:\", \"X-Face:\", and @@ -3038,7 +3002,7 @@ The option `mh-fetch-x-image-url' controls the fetching of the :group 'mh-show :package-version '(MH-E . "7.0")) -(defcustom-mh mh-store-default-directory nil +(defcustom mh-store-default-directory nil "Default directory for \\\\[mh-store-msg]. If you would like to change the initial default directory, @@ -3050,7 +3014,7 @@ the content of these messages." :group 'mh-show :package-version '(MH-E . "6.0")) -(defcustom-mh mh-summary-height nil +(defcustom mh-summary-height nil "Number of lines in MH-Folder buffer (including the mode line). The default value of this option is \"Automatic\" which means @@ -3065,7 +3029,7 @@ lines you'd like to see." ;;; The Speedbar (:group 'mh-speedbar) -(defcustom-mh mh-speed-update-interval 60 +(defcustom mh-speed-update-interval 60 "Time between speedbar updates in seconds. Set to 0 to disable automatic update." :type 'integer @@ -3074,7 +3038,7 @@ Set to 0 to disable automatic update." ;;; Threading (:group 'mh-thread) -(defcustom-mh mh-show-threads-flag nil +(defcustom mh-show-threads-flag nil "Non-nil means new folders start in threaded mode. Threading large number of messages can be time consuming so this @@ -3090,7 +3054,7 @@ threaded is less than `mh-large-folder'." ;; mh-tool-bar-folder-buttons and mh-tool-bar-letter-buttons defined ;; dynamically in mh-tool-bar.el. -(defcustom-mh mh-tool-bar-search-function 'mh-search +(defcustom mh-tool-bar-search-function 'mh-search "Function called by the tool bar search button. By default, this is set to `mh-search'. You can also choose @@ -3105,7 +3069,7 @@ of your own choosing." ;;; Hooks (:group 'mh-hooks + group where hook described) -(defcustom-mh mh-after-commands-processed-hook nil +(defcustom mh-after-commands-processed-hook nil "Hook run by \\\\[mh-execute-commands] after performing outstanding refile and delete requests. Variables that are useful in this hook include @@ -3117,14 +3081,14 @@ folder, which is also available in `mh-current-folder'." :group 'mh-folder :package-version '(MH-E . "8.0")) -(defcustom-mh mh-alias-reloaded-hook nil +(defcustom mh-alias-reloaded-hook nil "Hook run by `mh-alias-reload' after loading aliases." :type 'hook :group 'mh-hooks :group 'mh-alias :package-version '(MH-E . "8.0")) -(defcustom-mh mh-annotate-msg-hook nil +(defcustom mh-annotate-msg-hook nil "Hook run when a message is sent and after annotating the scan lines and message. Hook functions can access the current folder name with `mh-current-folder' and obtain the message numbers of the @@ -3134,7 +3098,7 @@ annotated messages with `mh-annotate-list'." :group 'mh-sending-mail :package-version '(MH-E . "8.1")) -(defcustom-mh mh-before-commands-processed-hook nil +(defcustom mh-before-commands-processed-hook nil "Hook run by \\\\[mh-execute-commands] before performing outstanding refile and delete requests. Variables that are useful in this hook include `mh-delete-list', @@ -3146,7 +3110,7 @@ used to see which changes will be made to the current folder, :group 'mh-folder :package-version '(MH-E . "8.0")) -(defcustom-mh mh-before-quit-hook nil +(defcustom mh-before-quit-hook nil "Hook run by \\\\[mh-quit] before quitting MH-E. This hook is called before the quit occurs, so you might use it @@ -3159,7 +3123,7 @@ See also `mh-quit-hook'." :group 'mh-folder :package-version '(MH-E . "6.0")) -(defcustom-mh mh-before-send-letter-hook nil +(defcustom mh-before-send-letter-hook nil "Hook run at the beginning of the \\\\[mh-send-letter] command. For example, if you want to check your spelling in your message @@ -3170,14 +3134,14 @@ before sending, add the `ispell-message' function." :group 'mh-letter :package-version '(MH-E . "6.0")) -(defcustom-mh mh-blocklist-msg-hook nil +(defcustom mh-blocklist-msg-hook nil "Hook run by \\\\[mh-junk-blocklist] after marking each message for blocklisting." :type 'hook :group 'mh-hooks :group 'mh-show :package-version '(MH-E . "8.4")) -(defcustom-mh mh-delete-msg-hook nil +(defcustom mh-delete-msg-hook nil "Hook run by \\\\[mh-delete-msg] after marking each message for deletion. For example, a past maintainer of MH-E used this once when he @@ -3187,7 +3151,7 @@ kept statistics on his mail usage." :group 'mh-show :package-version '(MH-E . "6.0")) -(defcustom-mh mh-find-path-hook nil +(defcustom mh-find-path-hook nil "Hook run by `mh-find-path' after reading the user's MH profile. This hook can be used the change the value of the variables that @@ -3198,28 +3162,28 @@ between MH and MH-E." :group 'mh-e :package-version '(MH-E . "7.0")) -(defcustom-mh mh-folder-mode-hook nil +(defcustom mh-folder-mode-hook nil "Hook run by `mh-folder-mode' when visiting a new folder." :type 'hook :group 'mh-hooks :group 'mh-folder :package-version '(MH-E . "6.0")) -(defcustom-mh mh-forward-hook nil +(defcustom mh-forward-hook nil "Hook run by `mh-forward' on a forwarded letter." :type 'hook :group 'mh-hooks :group 'mh-sending-mail :package-version '(MH-E . "8.0")) -(defcustom-mh mh-inc-folder-hook nil +(defcustom mh-inc-folder-hook nil "Hook run by \\\\[mh-inc-folder] after incorporating mail into a folder." :type 'hook :group 'mh-hooks :group 'mh-inc :package-version '(MH-E . "6.0")) -(defcustom-mh mh-insert-signature-hook nil +(defcustom mh-insert-signature-hook nil "Hook run by \\\\[mh-insert-signature] after signature has been inserted. Hook functions may access the actual name of the file or the @@ -3232,7 +3196,7 @@ function used to insert the signature with (define-obsolete-variable-alias 'mh-kill-folder-suppress-prompt-hooks 'mh-kill-folder-suppress-prompt-functions "24.3") -(defcustom-mh mh-kill-folder-suppress-prompt-functions '(mh-search-p) +(defcustom mh-kill-folder-suppress-prompt-functions '(mh-search-p) "Abnormal hook run at the beginning of \\\\[mh-kill-folder]. The hook functions are called with no arguments and should return @@ -3250,7 +3214,7 @@ accident in the \"+inbox\" folder, you will not be happy." :group 'mh-folder :package-version '(MH-E . "7.4")) -(defcustom-mh mh-letter-mode-hook nil +(defcustom mh-letter-mode-hook nil "Hook run by `mh-letter-mode' on a new letter. This hook allows you to do some processing before editing a @@ -3263,14 +3227,14 @@ go." :group 'mh-sending-mail :package-version '(MH-E . "6.0")) -(defcustom-mh mh-mh-to-mime-hook nil +(defcustom mh-mh-to-mime-hook nil "Hook run on the formatted letter by \\\\[mh-mh-to-mime]." :type 'hook :group 'mh-hooks :group 'mh-letter :package-version '(MH-E . "8.0")) -(defcustom-mh mh-search-mode-hook nil +(defcustom mh-search-mode-hook nil "Hook run upon entry to `mh-search-mode'\\. If you find that you do the same thing over and over when editing @@ -3282,7 +3246,7 @@ This can be done with this hook which is called when :group 'mh-search :package-version '(MH-E . "8.0")) -(defcustom-mh mh-pack-folder-hook nil +(defcustom mh-pack-folder-hook nil "Hook run by \\\\[mh-pack-folder] after renumbering the messages. Hook functions can access the current folder name with `mh-current-folder'." :type 'hook @@ -3290,7 +3254,7 @@ Hook functions can access the current folder name with `mh-current-folder'." :group 'mh-folder :package-version '(MH-E . "8.2")) -(defcustom-mh mh-quit-hook nil +(defcustom mh-quit-hook nil "Hook run by \\\\[mh-quit] after quitting MH-E. This hook is not run in an MH-E context, so you might use it to @@ -3302,14 +3266,14 @@ See also `mh-before-quit-hook'." :group 'mh-folder :package-version '(MH-E . "6.0")) -(defcustom-mh mh-refile-msg-hook nil +(defcustom mh-refile-msg-hook nil "Hook run by \\\\[mh-refile-msg] after marking each message for refiling." :type 'hook :group 'mh-hooks :group 'mh-folder :package-version '(MH-E . "6.0")) -(defcustom-mh mh-show-hook nil +(defcustom mh-show-hook nil "Hook run after \\\\[mh-show] shows a message. It is the last thing called after messages are displayed. It's @@ -3320,7 +3284,7 @@ used to affect the behavior of MH-E in general or when :group 'mh-show :package-version '(MH-E . "6.0")) -(defcustom-mh mh-show-mode-hook nil +(defcustom mh-show-mode-hook nil "Hook run upon entry to `mh-show-mode'. This hook is called early on in the process of the message display, @@ -3332,7 +3296,7 @@ buffer itself. See also `mh-show-hook'." :group 'mh-show :package-version '(MH-E . "8.7")) -(defcustom-mh mh-unseen-updated-hook nil +(defcustom mh-unseen-updated-hook nil "Hook run after the unseen sequence has been updated. The variable `mh-seen-list' can be used by this hook to obtain @@ -3343,7 +3307,7 @@ sequence." :group 'mh-sequences :package-version '(MH-E . "6.0")) -(defcustom-mh mh-allowlist-msg-hook nil +(defcustom mh-allowlist-msg-hook nil "Hook run by \\\\[mh-junk-allowlist] after marking each message for allowlisting." :type 'hook :group 'mh-hooks @@ -3354,15 +3318,10 @@ sequence." ;;; Faces (:group 'mh-faces + group where faces described) -(if (boundp 'facemenu-unlisted-faces) - ;; This variable was removed in Emacs 22.1. - (add-to-list 'facemenu-unlisted-faces "^mh-")) - ;; To add a new face: ;; 1. Add entry to variable mh-face-data. -;; 2. Create face using defface-mh (which removes min-color spec and -;; :package-version keyword where these are not supported), -;; accessing face data with function mh-face-data. +;; 2. Create face using defface, accessing face data with function +;; mh-face-data. ;; 3. Add inherit argument to function mh-face-data if applicable. (defvar mh-face-data '((mh-folder-followup @@ -3509,7 +3468,7 @@ sequence." (:underline t))))) "MH-E face data. Used by function `mh-face-data' which returns spec that is -consumed by `defface-mh'.") +consumed by `defface'.") (require 'cus-face) @@ -3535,21 +3494,21 @@ not added to the returned spec." (cadr (assq face mh-face-data)) (error "Could not find %s in mh-face-data" face))) -(defface-mh mh-folder-address +(defface mh-folder-address (mh-face-data 'mh-folder-subject '((t (:inherit mh-folder-subject)))) "Recipient face." :group 'mh-faces :group 'mh-folder :package-version '(MH-E . "8.0")) -(defface-mh mh-folder-blocklisted +(defface mh-folder-blocklisted (mh-face-data 'mh-folder-msg-number '((t (:inherit mh-folder-msg-number)))) "Blocklisted message face." :group 'mh-faces :group 'mh-folder :package-version '(MH-E . "8.4")) -(defface-mh mh-folder-body +(defface mh-folder-body (mh-face-data 'mh-folder-msg-number '((((class color)) (:inherit mh-folder-msg-number)) @@ -3560,7 +3519,7 @@ not added to the returned spec." :group 'mh-folder :package-version '(MH-E . "8.0")) -(defface-mh mh-folder-cur-msg-number +(defface mh-folder-cur-msg-number (mh-face-data 'mh-folder-msg-number '((t (:inherit mh-folder-msg-number :bold t)))) "Current message number face." @@ -3568,39 +3527,39 @@ not added to the returned spec." :group 'mh-folder :package-version '(MH-E . "8.0")) -(defface-mh mh-folder-date +(defface mh-folder-date (mh-face-data 'mh-folder-msg-number '((t (:inherit mh-folder-msg-number)))) "Date face." :group 'mh-faces :group 'mh-folder :package-version '(MH-E . "8.0")) -(defface-mh mh-folder-deleted +(defface mh-folder-deleted (mh-face-data 'mh-folder-msg-number '((t (:inherit mh-folder-msg-number)))) "Deleted message face." :group 'mh-faces :group 'mh-folder :package-version '(MH-E . "8.0")) -(defface-mh mh-folder-followup (mh-face-data 'mh-folder-followup) +(defface mh-folder-followup (mh-face-data 'mh-folder-followup) "\"Re:\" face." :group 'mh-faces :group 'mh-folder :package-version '(MH-E . "8.0")) -(defface-mh mh-folder-msg-number (mh-face-data 'mh-folder-msg-number) +(defface mh-folder-msg-number (mh-face-data 'mh-folder-msg-number) "Message number face." :group 'mh-faces :group 'mh-folder :package-version '(MH-E . "8.0")) -(defface-mh mh-folder-refiled (mh-face-data 'mh-folder-refiled) +(defface mh-folder-refiled (mh-face-data 'mh-folder-refiled) "Refiled message face." :group 'mh-faces :group 'mh-folder :package-version '(MH-E . "8.0")) -(defface-mh mh-folder-sent-to-me-hint +(defface mh-folder-sent-to-me-hint (mh-face-data 'mh-folder-msg-number '((t (:inherit mh-folder-date)))) "Fontification hint face in messages sent directly to us. The detection of messages sent to us is governed by the scan @@ -3610,7 +3569,7 @@ format `mh-scan-format-nmh' and the regular expression :group 'mh-folder :package-version '(MH-E . "8.0")) -(defface-mh mh-folder-sent-to-me-sender +(defface mh-folder-sent-to-me-sender (mh-face-data 'mh-folder-followup '((t (:inherit mh-folder-followup)))) "Sender face in messages sent directly to us. The detection of messages sent to us is governed by the scan @@ -3620,105 +3579,105 @@ format `mh-scan-format-nmh' and the regular expression :group 'mh-folder :package-version '(MH-E . "8.0")) -(defface-mh mh-folder-subject (mh-face-data 'mh-folder-subject) +(defface mh-folder-subject (mh-face-data 'mh-folder-subject) "Subject face." :group 'mh-faces :group 'mh-folder :package-version '(MH-E . "8.0")) -(defface-mh mh-folder-tick (mh-face-data 'mh-folder-tick) +(defface mh-folder-tick (mh-face-data 'mh-folder-tick) "Ticked message face." :group 'mh-faces :group 'mh-folder :package-version '(MH-E . "8.0")) -(defface-mh mh-folder-to (mh-face-data 'mh-folder-to) +(defface mh-folder-to (mh-face-data 'mh-folder-to) "\"To:\" face." :group 'mh-faces :group 'mh-folder :package-version '(MH-E . "8.0")) -(defface-mh mh-folder-allowlisted +(defface mh-folder-allowlisted (mh-face-data 'mh-folder-refiled '((t (:inherit mh-folder-refiled)))) "Allowlisted message face." :group 'mh-faces :group 'mh-folder :package-version '(MH-E . "8.4")) -(defface-mh mh-letter-header-field (mh-face-data 'mh-letter-header-field) +(defface mh-letter-header-field (mh-face-data 'mh-letter-header-field) "Editable header field value face in draft buffers." :group 'mh-faces :group 'mh-letter :package-version '(MH-E . "8.0")) -(defface-mh mh-search-folder (mh-face-data 'mh-search-folder) +(defface mh-search-folder (mh-face-data 'mh-search-folder) "Folder heading face in MH-Folder buffers created by searches." :group 'mh-faces :group 'mh-search :package-version '(MH-E . "8.0")) -(defface-mh mh-show-cc (mh-face-data 'mh-show-cc) +(defface mh-show-cc (mh-face-data 'mh-show-cc) "Face used to highlight \"cc:\" header fields." :group 'mh-faces :group 'mh-show :package-version '(MH-E . "8.0")) -(defface-mh mh-show-date (mh-face-data 'mh-show-date) +(defface mh-show-date (mh-face-data 'mh-show-date) "Face used to highlight \"Date:\" header fields." :group 'mh-faces :group 'mh-show :package-version '(MH-E . "8.0")) -(defface-mh mh-show-from (mh-face-data 'mh-show-from) +(defface mh-show-from (mh-face-data 'mh-show-from) "Face used to highlight \"From:\" header fields." :group 'mh-faces :group 'mh-show :package-version '(MH-E . "8.0")) -(defface-mh mh-show-header (mh-face-data 'mh-show-header) +(defface mh-show-header (mh-face-data 'mh-show-header) "Face used to deemphasize less interesting header fields." :group 'mh-faces :group 'mh-show :package-version '(MH-E . "8.0")) -(defface-mh mh-show-pgg-bad (mh-face-data 'mh-show-pgg-bad) +(defface mh-show-pgg-bad (mh-face-data 'mh-show-pgg-bad) "Bad PGG signature face." :group 'mh-faces :group 'mh-show :package-version '(MH-E . "8.0")) -(defface-mh mh-show-pgg-good (mh-face-data 'mh-show-pgg-good) +(defface mh-show-pgg-good (mh-face-data 'mh-show-pgg-good) "Good PGG signature face." :group 'mh-faces :group 'mh-show :package-version '(MH-E . "8.0")) -(defface-mh mh-show-pgg-unknown (mh-face-data 'mh-show-pgg-unknown) +(defface mh-show-pgg-unknown (mh-face-data 'mh-show-pgg-unknown) "Unknown or untrusted PGG signature face." :group 'mh-faces :group 'mh-show :package-version '(MH-E . "8.0")) -(defface-mh mh-show-signature (mh-face-data 'mh-show-signature) +(defface mh-show-signature (mh-face-data 'mh-show-signature) "Signature face." :group 'mh-faces :group 'mh-show :package-version '(MH-E . "8.0")) -(defface-mh mh-show-subject +(defface mh-show-subject (mh-face-data 'mh-folder-subject '((t (:inherit mh-folder-subject)))) "Face used to highlight \"Subject:\" header fields." :group 'mh-faces :group 'mh-show :package-version '(MH-E . "8.0")) -(defface-mh mh-show-to (mh-face-data 'mh-show-to) +(defface mh-show-to (mh-face-data 'mh-show-to) "Face used to highlight \"To:\" header fields." :group 'mh-faces :group 'mh-show :package-version '(MH-E . "8.0")) -(defface-mh mh-show-xface +(defface mh-show-xface (mh-face-data 'mh-show-from '((t (:inherit (mh-show-from highlight))))) "X-Face image face. The background and foreground are used in the image." @@ -3726,13 +3685,13 @@ The background and foreground are used in the image." :group 'mh-show :package-version '(MH-E . "8.0")) -(defface-mh mh-speedbar-folder (mh-face-data 'mh-speedbar-folder) +(defface mh-speedbar-folder (mh-face-data 'mh-speedbar-folder) "Basic folder face." :group 'mh-faces :group 'mh-speedbar :package-version '(MH-E . "8.0")) -(defface-mh mh-speedbar-folder-with-unseen-messages +(defface mh-speedbar-folder-with-unseen-messages (mh-face-data 'mh-speedbar-folder '((t (:inherit mh-speedbar-folder :bold t)))) "Folder face when folder contains unread messages." @@ -3740,14 +3699,14 @@ The background and foreground are used in the image." :group 'mh-speedbar :package-version '(MH-E . "8.0")) -(defface-mh mh-speedbar-selected-folder +(defface mh-speedbar-selected-folder (mh-face-data 'mh-speedbar-selected-folder) "Selected folder face." :group 'mh-faces :group 'mh-speedbar :package-version '(MH-E . "8.0")) -(defface-mh mh-speedbar-selected-folder-with-unseen-messages +(defface mh-speedbar-selected-folder-with-unseen-messages (mh-face-data 'mh-speedbar-selected-folder '((t (:inherit mh-speedbar-selected-folder :bold t)))) "Selected folder face when folder contains unread messages." diff --git a/lisp/mh-e/mh-folder.el b/lisp/mh-e/mh-folder.el index aabcdd2466..c423d22e89 100644 --- a/lisp/mh-e/mh-folder.el +++ b/lisp/mh-e/mh-folder.el @@ -72,10 +72,8 @@ the MH mail system." ;;; Desktop Integration -;; desktop-buffer-mode-handlers appeared in Emacs 22. -(if (boundp 'desktop-buffer-mode-handlers) - (add-to-list 'desktop-buffer-mode-handlers - '(mh-folder-mode . mh-restore-desktop-buffer))) +(add-to-list 'desktop-buffer-mode-handlers + '(mh-folder-mode . mh-restore-desktop-buffer)) (defun mh-restore-desktop-buffer (_file-name name _misc) "Restore an MH folder buffer specified in a desktop file. diff --git a/lisp/mh-e/mh-letter.el b/lisp/mh-e/mh-letter.el index 59d8175b62..1f7902640a 100644 --- a/lisp/mh-e/mh-letter.el +++ b/lisp/mh-e/mh-letter.el @@ -692,7 +692,7 @@ and `mh-ins-buf-prefix' is not inserted." ;; Find displayed message (with-current-buffer show-buffer (let* ((from-attr (mh-extract-from-attribution)) - (yank-region (mh-mark-active-p nil)) + (yank-region mark-active) (mh-ins-str (cond ((and yank-region (or (eq 'supercite mh-yank-behavior) diff --git a/lisp/mh-e/mh-mime.el b/lisp/mh-e/mh-mime.el index d2a09037fe..3d9128c15a 100644 --- a/lisp/mh-e/mh-mime.el +++ b/lisp/mh-e/mh-mime.el @@ -135,7 +135,7 @@ ("application/emacs-lisp" mm-display-elisp-inline identity) ("application/x-emacs-lisp" mm-display-elisp-inline identity) ("text/html" - ,(if (fboundp 'mm-inline-text-html) 'mm-inline-text-html 'mm-inline-text) + mm-inline-text-html (lambda (handle) mm-text-html-renderer)) ("text/x-vcard" @@ -202,8 +202,6 @@ Set from last use.") (?D pressed-details ?s))) (defvar mh-mime-security-button-map (let ((map (make-sparse-keymap))) - (unless (>= (string-to-number emacs-version) 21) - (set-keymap-parent map mh-show-mode-map)) (define-key map "\r" #'mh-press-button) (define-key map [mouse-2] #'mh-push-button) map)) @@ -1144,6 +1142,7 @@ this ;-)" This is used to decide if smileys and graphical emphasis should be displayed." (let ((max nil)) + ;; FIXME: font-lock-maximum-size is obsolete. (when (and (boundp 'font-lock-maximum-size) font-lock-maximum-size) (cond ((numberp font-lock-maximum-size) (setq max font-lock-maximum-size)) @@ -1768,8 +1767,7 @@ initialized. Always use the command `mh-have-file-command'.") 'file -i' is used to get MIME type of composition insertion." (when (eq mh-have-file-command 'undefined) (setq mh-have-file-command - (and (fboundp 'executable-find) - (executable-find "file") ; file command exists + (and (executable-find "file") ; file command exists ; and accepts -i and -b args. (zerop (call-process "file" nil nil nil "-i" "-b" (expand-file-name "inc" mh-progs)))))) diff --git a/lisp/mh-e/mh-seq.el b/lisp/mh-e/mh-seq.el index dc2ed613b1..f4dd65177f 100644 --- a/lisp/mh-e/mh-seq.el +++ b/lisp/mh-e/mh-seq.el @@ -577,7 +577,7 @@ Otherwise, the message number at point is returned. This function is usually used with `mh-iterate-on-range' in order to provide a uniform interface to MH-E functions." - (cond ((mh-mark-active-p t) (cons (region-beginning) (region-end))) + (cond ((and transient-mark-mode mark-active) (cons (region-beginning) (region-end))) (current-prefix-arg (mh-read-range range-prompt nil nil t t)) (default default) (t (mh-get-msg-num t)))) diff --git a/lisp/mh-e/mh-show.el b/lisp/mh-e/mh-show.el index d212252374..4b98d6c487 100644 --- a/lisp/mh-e/mh-show.el +++ b/lisp/mh-e/mh-show.el @@ -328,8 +328,7 @@ ignored if VISIBLE-HEADERS is non-nil." (defun mh-summary-height () "Return ideal value for the variable `mh-summary-height'. The current frame height is taken into consideration." - (or (and (fboundp 'frame-height) - (> (frame-height) 24) + (or (and (> (frame-height) 24) (min 10 (/ (frame-height) 6))) 4)) diff --git a/lisp/mh-e/mh-speed.el b/lisp/mh-e/mh-speed.el index a019c28b88..82b108c8c8 100644 --- a/lisp/mh-e/mh-speed.el +++ b/lisp/mh-e/mh-speed.el @@ -374,12 +374,9 @@ uses." (defvar mh-speed-flists-folder nil) (defmacro mh-process-kill-without-query (process) - "PROCESS can be killed without query on Emacs exit. -Avoid using `process-kill-without-query' if possible since it is -now obsolete." - (if (fboundp 'set-process-query-on-exit-flag) - `(set-process-query-on-exit-flag ,process nil) - `(process-kill-without-query ,process))) + "PROCESS can be killed without query on Emacs exit." + (declare (obsolete set-process-query-on-exit-flag "29.1")) + `(set-process-query-on-exit-flag ,process nil)) ;;;###mh-autoload (defun mh-speed-flists (force &rest folders) @@ -427,7 +424,7 @@ flists is run only for that one folder." (or mh-speed-flists-folder '("-recurse")))) ;; Run flists on all folders the next time around... (setq mh-speed-flists-folder nil) - (mh-process-kill-without-query mh-speed-flists-process) + (set-process-query-on-exit-flag mh-speed-flists-process nil) (set-process-filter mh-speed-flists-process #'mh-speed-parse-flists-output))))))) diff --git a/lisp/mh-e/mh-xface.el b/lisp/mh-e/mh-xface.el index d44cca361a..0c1bcdfefd 100644 --- a/lisp/mh-e/mh-xface.el +++ b/lisp/mh-e/mh-xface.el @@ -34,8 +34,7 @@ "Determine at run time what function should be called to display X-Face.") (make-obsolete-variable 'mh-show-xface-function nil "29.1") -(defvar mh-uncompface-executable - (and (fboundp 'executable-find) (executable-find "uncompface"))) +(defvar mh-uncompface-executable (executable-find "uncompface")) @@ -86,8 +85,7 @@ in this order is used." (defun mh-face-to-png (data) "Convert base64 encoded DATA to png image." (with-temp-buffer - (if (fboundp 'set-buffer-multibyte) - (set-buffer-multibyte nil)) + (set-buffer-multibyte nil) (insert data) (ignore-errors (base64-decode-region (point-min) (point-max))) (buffer-string))) @@ -95,8 +93,7 @@ in this order is used." (defun mh-uncompface (data) "Run DATA through `uncompface' to generate bitmap." (with-temp-buffer - (if (fboundp 'set-buffer-multibyte) - (set-buffer-multibyte nil)) + (set-buffer-multibyte nil) (insert data) (when (and mh-uncompface-executable (equal (call-process-region (point-min) (point-max) @@ -232,8 +229,7 @@ file contents as a string is returned. If FILE is nil, then both elements of the list are nil." (if (stringp file) (with-temp-buffer - (if (fboundp 'set-buffer-multibyte) - (set-buffer-multibyte nil)) + (set-buffer-multibyte nil) (let ((type (and (string-match ".*\\.\\(...\\)$" file) (intern (match-string 1 file))))) (insert-file-contents-literally file) commit 1a02683ceeb6fbcebd0d7bb71dce448177f1d228 Author: Lars Ingebrigtsen Date: Tue Oct 12 13:56:47 2021 +0200 Make dbus work in a dumped Emacs * lisp/net/dbus.el (dbus--init): Make into a defun. (after-pdump-load-hook): Put it onto the new pdump hook so that it's run after startup (bug#37331). diff --git a/lisp/net/dbus.el b/lisp/net/dbus.el index 560ece6751..3fff5398c0 100644 --- a/lisp/net/dbus.el +++ b/lisp/net/dbus.el @@ -2252,15 +2252,19 @@ keywords `:system-private' or `:session-private', respectively." bus nil dbus-path-local dbus-interface-local "Disconnected" #'dbus-handle-bus-disconnect))) - -;; Initialize `:system' and `:session' buses. This adds their file -;; descriptors to input_wait_mask, in order to detect incoming -;; messages immediately. -(when (featurep 'dbusbind) - (dbus-ignore-errors - (dbus-init-bus :system)) - (dbus-ignore-errors - (dbus-init-bus :session))) + +(defun dbus--init () + ;; Initialize `:system' and `:session' buses. This adds their file + ;; descriptors to input_wait_mask, in order to detect incoming + ;; messages immediately. + (when (featurep 'dbusbind) + (dbus-ignore-errors + (dbus-init-bus :system)) + (dbus-ignore-errors + (dbus-init-bus :session)))) + +(add-hook 'after-pdump-load-hook #'dbus--init) +(dbus--init) (provide 'dbus) commit 6d68fbd57f730051dd3af470e7b0c41b41238bd0 Author: Lars Ingebrigtsen Date: Tue Oct 12 13:55:28 2021 +0200 Add a new after-pdump-load-hook variable * doc/lispref/internals.texi (Building Emacs): Document it. * lisp/subr.el (after-pdump-load-hook): New variable. * src/emacs.c (main): Run the new hook. * src/pdumper.c (syms_of_pdumper): Define a symbol. diff --git a/doc/lispref/internals.texi b/doc/lispref/internals.texi index d3edd63317..7718712b9b 100644 --- a/doc/lispref/internals.texi +++ b/doc/lispref/internals.texi @@ -218,6 +218,14 @@ the Emacs executable that dumped them. If you want to use this function in an Emacs that was already dumped, you must run Emacs with the @samp{-batch} option. + +@vindex after-pdump-load-hook +If you're including @samp{.el} files in the dumped Emacs and that +@samp{.el} file has code that is normally run at load time, that code +won't be run when Emacs starts after dumping. To help work around +that problem, you can put functions on the +@code{after-pdump-load-hook} hook. This hook is run when starting +Emacs. @end defun @defun dump-emacs to-file from-file diff --git a/etc/NEWS b/etc/NEWS index fe6f21fec2..9daf958b07 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -31,6 +31,12 @@ applies, and please also update docstrings as needed. ** Emacs now has a --fingerprint option. This will output a string identifying the current Emacs build. ++++ +** New hook 'after-pdump-load-hook'. +This is run at the end of the Emacs startup process, and it meant to +be used to reinitialize structures that would normally be done at load +time. + * Changes in Emacs 29.1 diff --git a/lisp/subr.el b/lisp/subr.el index 90f24a237f..805c14eae3 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -3568,6 +3568,9 @@ If either NAME or VAL are specified, both should be specified." (defvar suspend-resume-hook nil "Normal hook run by `suspend-emacs', after Emacs is continued.") +(defvar after-pdump-load-hook nil + "Normal hook run after loading the .pdmp file.") + (defvar temp-buffer-show-hook nil "Normal hook run by `with-output-to-temp-buffer' after displaying the buffer. When the hook runs, the temporary buffer is current, and the window it diff --git a/src/emacs.c b/src/emacs.c index b178c6a06c..1f6490fbc0 100644 --- a/src/emacs.c +++ b/src/emacs.c @@ -2333,6 +2333,11 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem if (dump_mode) Vdump_mode = build_string (dump_mode); +#ifdef HAVE_PDUMPER + /* Allow code to be run (mostly useful after redumping). */ + safe_run_hooks (Qafter_pdump_load_hook); +#endif + /* Enter editor command loop. This never returns. */ set_initial_minibuffer_mode (); Frecursive_edit (); diff --git a/src/pdumper.c b/src/pdumper.c index 96fbd56a23..6cf7b847cb 100644 --- a/src/pdumper.c +++ b/src/pdumper.c @@ -5706,6 +5706,7 @@ pdumper_load (const char *dump_filename, char *argv0) dump_mmap_release (§ions[i]); if (dump_fd >= 0) emacs_close (dump_fd); + return err; } @@ -5790,6 +5791,7 @@ syms_of_pdumper (void) DEFSYM (Qdumped_with_pdumper, "dumped-with-pdumper"); DEFSYM (Qload_time, "load-time"); DEFSYM (Qdump_file_name, "dump-file-name"); + DEFSYM (Qafter_pdump_load_hook, "after-pdump-load-hook"); defsubr (&Spdumper_stats); #endif /* HAVE_PDUMPER */ } commit 8a7c280d81c8a8c902ce0b48f23772e3c2cc09b2 Author: Stefan Kangas Date: Tue Oct 12 13:29:28 2021 +0200 Make mh-do-in-gnu-emacs obsolete * lisp/mh-e/mh-acros.el (mh-do-in-gnu-emacs): Make obsolete. * lisp/mh-e/mh-tool-bar.el: Don't use above obsolete macro. (mh-acros): Require to avoid warnings. Thanks to Lars Ingebrigtsen . diff --git a/lisp/mh-e/mh-acros.el b/lisp/mh-e/mh-acros.el index d18579d7ea..575b233e1b 100644 --- a/lisp/mh-e/mh-acros.el +++ b/lisp/mh-e/mh-acros.el @@ -47,16 +47,13 @@ ;;;###mh-autoload (defmacro mh-do-in-gnu-emacs (&rest body) "Execute BODY if in GNU Emacs." - ;; FIXME: This cannot yet be obsoleted, due to one remaining call in - ;; mh-tool-bar.el. Once that is removed, this can be obsoleted. - (declare ;; (obsolete nil "29.1") - (debug t) (indent defun)) + (declare (obsolete progn "29.1") (debug t) (indent defun)) (unless (featurep 'xemacs) `(progn ,@body))) ;;;###mh-autoload (defmacro mh-do-in-xemacs (&rest body) "Execute BODY if in XEmacs." - (declare (obsolete nil "29.1") (debug t) (indent defun)) + (declare (obsolete ignore "29.1") (debug t) (indent defun)) (when (featurep 'xemacs) `(progn ,@body))) ;;;###mh-autoload diff --git a/lisp/mh-e/mh-tool-bar.el b/lisp/mh-e/mh-tool-bar.el index 22ed477b57..ca08cc3b35 100644 --- a/lisp/mh-e/mh-tool-bar.el +++ b/lisp/mh-e/mh-tool-bar.el @@ -27,10 +27,8 @@ ;;; Code: (require 'mh-e) -;; FIXME: Figure out why removing the call to the `mh-do-in-gnu-emacs' -;; macro here leads to errors. -(mh-do-in-gnu-emacs - (require 'tool-bar)) +(require 'mh-acros) +(require 'tool-bar) ;;; Tool Bar Commands commit 0fe91bcfe2ba87be40050e214284a995a2a54900 Author: Andreas Schwab Date: Tue Oct 12 10:47:33 2021 +0200 Change --fingerprint to output to stdout * src/pdumper.c (dump_fingerprint): Add argument OUTPUT, use it instead of stderr, update all uses. Don't print colon if LABEL is empty. * src/pdumper.h (dump_fingerprint): Adjust. * src/emacs.c (main): Print fingerprint to stdout, without label. * Makefile.in (EMACS_PDMP): Adjust. diff --git a/Makefile.in b/Makefile.in index c6c507fd42..300340c6e8 100644 --- a/Makefile.in +++ b/Makefile.in @@ -313,7 +313,7 @@ TRANSFORM = @program_transform_name@ EMACS_NAME = `echo emacs | sed '$(TRANSFORM)'` EMACS = ${EMACS_NAME}${EXEEXT} EMACSFULL = `echo emacs-${version} | sed '$(TRANSFORM)'`${EXEEXT} -EMACS_PDMP = `./src/emacs${EXEEXT} --fingerprint 2>&1 | sed 's/.* //'`.pdmp +EMACS_PDMP = `./src/emacs${EXEEXT} --fingerprint`.pdmp # Subdirectories to make recursively. SUBDIR = $(NTDIR) lib lib-src src lisp diff --git a/src/emacs.c b/src/emacs.c index cda7a9bf77..b178c6a06c 100644 --- a/src/emacs.c +++ b/src/emacs.c @@ -933,7 +933,7 @@ load_pdump (int argc, char **argv) copies and renames it. */ hexbuf_size = 2 * sizeof fingerprint; hexbuf = xmalloc (hexbuf_size + 1); - hexbuf_digest (hexbuf, (char *)fingerprint, sizeof fingerprint); + hexbuf_digest (hexbuf, (char *) fingerprint, sizeof fingerprint); hexbuf[hexbuf_size] = '\0'; needed = (strlen (path_exec) + 1 @@ -1403,7 +1403,8 @@ main (int argc, char **argv) { if (initialized) { - dump_fingerprint ("fingerprint", (unsigned char *)fingerprint); + dump_fingerprint (stdout, "", + (unsigned char *) fingerprint); exit (0); } else diff --git a/src/pdumper.c b/src/pdumper.c index 977f4fb2a8..96fbd56a23 100644 --- a/src/pdumper.c +++ b/src/pdumper.c @@ -313,13 +313,14 @@ dump_reloc_set_offset (struct dump_reloc *reloc, dump_off offset) } void -dump_fingerprint (char const *label, +dump_fingerprint (FILE *output, char const *label, unsigned char const xfingerprint[sizeof fingerprint]) { enum { hexbuf_size = 2 * sizeof fingerprint }; char hexbuf[hexbuf_size]; hexbuf_digest (hexbuf, xfingerprint, sizeof fingerprint); - fprintf (stderr, "%s: %.*s\n", label, hexbuf_size, hexbuf); + fprintf (output, "%s%s%.*s\n", label, *label ? ": " : "", + hexbuf_size, hexbuf); } /* To be used if some order in the relocation process has to be enforced. */ @@ -4127,7 +4128,7 @@ types. */) ctx->header.fingerprint[i] = fingerprint[i]; const dump_off header_start = ctx->offset; - dump_fingerprint ("Dumping fingerprint", ctx->header.fingerprint); + dump_fingerprint (stderr, "Dumping fingerprint", ctx->header.fingerprint); dump_write (ctx, &ctx->header, sizeof (ctx->header)); const dump_off header_end = ctx->offset; @@ -5596,8 +5597,8 @@ pdumper_load (const char *dump_filename, char *argv0) desired[i] = fingerprint[i]; if (memcmp (header->fingerprint, desired, sizeof desired) != 0) { - dump_fingerprint ("desired fingerprint", desired); - dump_fingerprint ("found fingerprint", header->fingerprint); + dump_fingerprint (stderr, "desired fingerprint", desired); + dump_fingerprint (stderr, "found fingerprint", header->fingerprint); goto out; } diff --git a/src/pdumper.h b/src/pdumper.h index bc339c42da..87de592b81 100644 --- a/src/pdumper.h +++ b/src/pdumper.h @@ -50,7 +50,7 @@ enum { PDUMPER_NO_OBJECT = -1 }; #define PDUMPER_REMEMBER_SCALAR(thing) \ pdumper_remember_scalar (&(thing), sizeof (thing)) -extern void dump_fingerprint (const char *label, +extern void dump_fingerprint (FILE *output, const char *label, const unsigned char *xfingerprint); extern void pdumper_remember_scalar_impl (void *data, ptrdiff_t nbytes); commit 7865bd6782dacf506de8f69064f018de444da27f Author: Martin Rudalics Date: Tue Oct 12 09:53:57 2021 +0200 Have 'while-no-input-ignore-events' handle idle timers too (Bug#49997) * src/keyboard.c (read_char): Use Vwhile_no_input_ignore_events to check which idle timers should be resumed (Bug#49997). (init_while_no_input_ignore_events): New function to initialize Vwhile_no_input_ignore_events. (Vwhile_no_input_ignore_events): Say in doc-string that events in this list do not stop idle timers. * lisp/subr.el (while-no-input): Remove initialization of 'while-no-input-ignore-events'; do that in keyboard.c now. diff --git a/lisp/subr.el b/lisp/subr.el index fa097b3f19..90f24a237f 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -4387,11 +4387,6 @@ is allowed once again. (Immediately, if `inhibit-quit' is nil.)" ;; that intends to handle the quit signal next time. (eval '(ignore nil))))) -;; Don't throw `throw-on-input' on those events by default. -(setq while-no-input-ignore-events - '(focus-in focus-out help-echo iconify-frame - make-frame-visible selection-request)) - (defmacro while-no-input (&rest body) "Execute BODY only as long as there's no pending input. If input arrives, that ends the execution of BODY, diff --git a/src/keyboard.c b/src/keyboard.c index 7184b1509b..ce3b900b48 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -2943,20 +2943,8 @@ read_char (int commandflag, Lisp_Object map, last_input_event = c; call4 (Qcommand_execute, tem, Qnil, Fvector (1, &last_input_event), Qt); - if (CONSP (c) - && (EQ (XCAR (c), Qselect_window) - || EQ (XCAR (c), Qfocus_out) -#ifdef HAVE_DBUS - || EQ (XCAR (c), Qdbus_event) -#endif -#ifdef USE_FILE_NOTIFY - || EQ (XCAR (c), Qfile_notify) -#endif -#ifdef THREADS_ENABLED - || EQ (XCAR (c), Qthread_event) -#endif - || EQ (XCAR (c), Qconfig_changed_event)) - && !end_time) + if (CONSP (c) && !NILP (Fmemq (XCAR (c), Vwhile_no_input_ignore_events)) + && !end_time) /* We stopped being idle for this event; undo that. This prevents automatic window selection (under mouse-autoselect-window) from acting as a real input event, for @@ -11605,6 +11593,27 @@ static const struct event_head head_table[] = { {SYMBOL_INDEX (Qselect_window), SYMBOL_INDEX (Qswitch_frame)} }; +static Lisp_Object +init_while_no_input_ignore_events (void) +{ + Lisp_Object events = listn (9, Qselect_window, Qhelp_echo, Qmove_frame, + Qiconify_frame, Qmake_frame_visible, + Qfocus_in, Qfocus_out, Qconfig_changed_event, + Qselection_request); + +#ifdef HAVE_DBUS + events = Fcons (Qdbus_event, events); +#endif +#ifdef USE_FILE_NOTIFY + events = Fcons (Qfile_notify, events); +#endif +#ifdef THREADS_ENABLED + events = Fcons (Qthread_event, events); +#endif + + return events; +} + static void syms_of_keyboard_for_pdumper (void); void @@ -12499,7 +12508,11 @@ If nil, Emacs crashes immediately in response to fatal signals. */); DEFVAR_LISP ("while-no-input-ignore-events", Vwhile_no_input_ignore_events, - doc: /* Ignored events from while-no-input. */); + doc: /* Ignored events from `while-no-input'. +Events in this list do not count as pending input while running +`while-no-input' and do not cause any idle timers to get reset when they +occur. */); + Vwhile_no_input_ignore_events = init_while_no_input_ignore_events (); DEFVAR_BOOL ("translate-upper-case-key-bindings", translate_upper_case_key_bindings, commit 3832b983cfbb7163616041e68f5f46d094137e79 Author: Martin Rudalics Date: Tue Oct 12 09:25:57 2021 +0200 In Fdelete_other_windows_internal fix new total window sizes (Bug#51007) * src/window.c (Fdelete_other_windows_internal): Assign the new total sizes of windows _after_ the new window configuration is in place (Bug#51007). diff --git a/src/window.c b/src/window.c index ec3c941c3b..9845fbb876 100644 --- a/src/window.c +++ b/src/window.c @@ -3199,8 +3199,10 @@ function in a program gives strange scrolling, make sure the window-start value is reasonable when this function is called. */) (Lisp_Object window, Lisp_Object root) { - struct window *w, *r, *s; - struct frame *f; + struct window *w = decode_valid_window (window); + struct window *r, *s; + Lisp_Object frame = w->frame; + struct frame *f = XFRAME (frame); Lisp_Object sibling, pwindow, delta; Lisp_Object swindow UNINIT; ptrdiff_t startpos UNINIT, startbyte UNINIT; @@ -3208,9 +3210,7 @@ window-start value is reasonable when this function is called. */) int new_top; bool resize_failed = false; - w = decode_valid_window (window); XSETWINDOW (window, w); - f = XFRAME (w->frame); if (NILP (root)) /* ROOT is the frame's root window. */ @@ -3250,7 +3250,7 @@ window-start value is reasonable when this function is called. */) /* Make sure WINDOW is the frame's selected window. */ if (!EQ (window, FRAME_SELECTED_WINDOW (f))) { - if (EQ (selected_frame, w->frame)) + if (EQ (selected_frame, frame)) Fselect_window (window, Qnil); else /* Do not clear f->select_mini_window_flag here. If the @@ -3283,7 +3283,7 @@ window-start value is reasonable when this function is called. */) if (!EQ (swindow, FRAME_SELECTED_WINDOW (f))) { - if (EQ (selected_frame, w->frame)) + if (EQ (selected_frame, frame)) Fselect_window (swindow, Qnil); else fset_selected_window (f, swindow); @@ -3318,18 +3318,12 @@ window-start value is reasonable when this function is called. */) w->top_line = r->top_line; resize_root_window (window, delta, Qnil, Qnil, Qt); if (window_resize_check (w, false)) - { - window_resize_apply (w, false); - window_pixel_to_total (w->frame, Qnil); - } + window_resize_apply (w, false); else { resize_root_window (window, delta, Qnil, Qt, Qt); if (window_resize_check (w, false)) - { - window_resize_apply (w, false); - window_pixel_to_total (w->frame, Qnil); - } + window_resize_apply (w, false); else resize_failed = true; } @@ -3342,18 +3336,12 @@ window-start value is reasonable when this function is called. */) XSETINT (delta, r->pixel_width - w->pixel_width); resize_root_window (window, delta, Qt, Qnil, Qt); if (window_resize_check (w, true)) - { - window_resize_apply (w, true); - window_pixel_to_total (w->frame, Qt); - } + window_resize_apply (w, true); else { resize_root_window (window, delta, Qt, Qt, Qt); if (window_resize_check (w, true)) - { - window_resize_apply (w, true); - window_pixel_to_total (w->frame, Qt); - } + window_resize_apply (w, true); else resize_failed = true; } @@ -3395,6 +3383,12 @@ window-start value is reasonable when this function is called. */) } replace_window (root, window, true); + /* Assign new total sizes to all windows on FRAME. We can't do that + _before_ WINDOW replaces ROOT since 'window--pixel-to-total' works + on the whole frame and thus would work on the frame's old window + configuration (Bug#51007). */ + window_pixel_to_total (frame, Qnil); + window_pixel_to_total (frame, Qt); /* This must become SWINDOW anyway ....... */ if (BUFFERP (w->contents) && !resize_failed) commit 5deb0ec14f304658bce12809b5c4d97c62eca858 Author: Stephen Gildea Date: Mon Oct 11 18:19:18 2021 -0700 * lisp/mh-e/mh-show.el (mh-junk-whitelist): Custom obsolescence message. diff --git a/lisp/mh-e/mh-junk.el b/lisp/mh-e/mh-junk.el index 467667f5af..2097bcbe1e 100644 --- a/lisp/mh-e/mh-junk.el +++ b/lisp/mh-e/mh-junk.el @@ -110,8 +110,15 @@ message(s) as specified by the option `mh-junk-disposition'." ;;;###mh-autoload (defun mh-junk-whitelist (range) "Old name for `mh-junk-allowlist'; use \\[mh-junk-allowlist] instead." - (declare (obsolete mh-junk-allowlist "28.1")) (interactive (list (mh-interactive-range "Allowlist"))) + ;; We do our own message here instead of using "declare obsolete" + ;; in order to talk about keys instead of function names. Also, it + ;; lets us bind "J w" to this without the Emacs 29 compiler complaining. + (when (not (get 'mh-junk-whitelist 'command-execute-obsolete-warned)) + (message "%s is an obsolete key (as of 28.1); use %s instead" + (substitute-command-keys "\\[mh-junk-whitelist]") + (substitute-command-keys "\\[mh-junk-allowlist]")) + (put 'mh-junk-whitelist 'command-execute-obsolete-warned t)) (mh-junk-allowlist range)) ;;;###mh-autoload commit 7e185bc9bae85ac3b50f9b7bd4b3c33bb8a016a8 Author: Stefan Monnier Date: Mon Oct 11 20:55:19 2021 -0400 * list/erc/erc-{replace,imenu,dcc}: Tweak copyright format * lisp/erc/erc-replace.el: * lisp/erc/erc-imenu.el: * lisp/erc/erc-dcc.el: Massage copyright so elpa-admin.el recognizes it diff --git a/lisp/erc/erc-dcc.el b/lisp/erc/erc-dcc.el index 52b0b9586d..f27425ac8a 100644 --- a/lisp/erc/erc-dcc.el +++ b/lisp/erc/erc-dcc.el @@ -1,7 +1,6 @@ ;;; erc-dcc.el --- CTCP DCC module for ERC -*- lexical-binding: t; -*- -;; Copyright (C) 1993-1995, 1998, 2002-2004, 2006-2021 Free Software -;; Foundation, Inc. +;; Copyright (C) 1993-2021 Free Software Foundation, Inc. ;; Author: Ben A. Mesander ;; Noah Friedman diff --git a/lisp/erc/erc-imenu.el b/lisp/erc/erc-imenu.el index dcf6db7407..522bc805f8 100644 --- a/lisp/erc/erc-imenu.el +++ b/lisp/erc/erc-imenu.el @@ -1,7 +1,6 @@ ;;; erc-imenu.el --- Imenu support for ERC -*- lexical-binding: t; -*- -;; Copyright (C) 2001-2002, 2004, 2006-2021 Free Software Foundation, -;; Inc. +;; Copyright (C) 2001-2021 Free Software Foundation, Inc. ;; Author: Mario Lang ;; Maintainer: Amin Bandali diff --git a/lisp/erc/erc-replace.el b/lisp/erc/erc-replace.el index 90c0ee6f8a..b2e9047ce7 100644 --- a/lisp/erc/erc-replace.el +++ b/lisp/erc/erc-replace.el @@ -1,7 +1,6 @@ ;;; erc-replace.el --- wash and massage messages inserted into the buffer -*- lexical-binding: t; -*- -;; Copyright (C) 2001-2002, 2004, 2006-2021 Free Software Foundation, -;; Inc. +;; Copyright (C) 2001-2021 Free Software Foundation, Inc. ;; Author: Andreas Fuchs ;; Maintainer: Amin Bandali commit cd5b63807b6558ae0c4a05dc322601282a8312c2 Author: Stefan Kangas Date: Tue Oct 12 02:35:23 2021 +0200 Remove last XEmacs compat code from ERC * lisp/erc/erc-dcc.el (erc-dcc-member): Remove XEmacs compat code. * lisp/erc/erc-goodies.el (erc-move-to-prompt-setup): Doc fix; remove spurious reference to XEmacs; this is needed also for Emacs. diff --git a/lisp/erc/erc-dcc.el b/lisp/erc/erc-dcc.el index db278a1275..52b0b9586d 100644 --- a/lisp/erc/erc-dcc.el +++ b/lisp/erc/erc-dcc.el @@ -183,9 +183,7 @@ compared with `erc-nick-equal-p' which is IRC case-insensitive." (let ((prop (car prem)) (val (cadr prem))) (setq prem (cddr prem) - ;; plist-member is a predicate in xemacs - test (and (plist-member elt prop) - (plist-get elt prop))) + test (cadr (plist-member elt prop))) ;; if the property exists and is equal, we continue, else, try the ;; next element of the list (or (and (eq prop :nick) (if (>= emacs-major-version 28) diff --git a/lisp/erc/erc-goodies.el b/lisp/erc/erc-goodies.el index fc9a8d39ef..683ac2d37c 100644 --- a/lisp/erc/erc-goodies.el +++ b/lisp/erc/erc-goodies.el @@ -137,7 +137,7 @@ Put this function on `erc-insert-post-hook' and/or `erc-send-post-hook'." (goto-char (point-max)))) (defun erc-move-to-prompt-setup () - "Initialize the move-to-prompt module for XEmacs." + "Initialize the move-to-prompt module." (add-hook 'pre-command-hook #'erc-move-to-prompt nil t)) ;;; Keep place in unvisited channels commit 8436243ac62a12b732e9c8cb54bb3c1d6efc9c25 Author: Stefan Kangas Date: Tue Oct 12 02:02:22 2021 +0200 Prefer setq-local in lisp/mh-e/*.el * lisp/mh-e/mh-utils.el (mh-make-local-vars): Make obsolete. * lisp/mh-e/mh-comp.el (mh-forward): * lisp/mh-e/mh-folder.el (mh-folder-mode): * lisp/mh-e/mh-identity.el (mh-identity-handler-signature) (mh-identity-insert-attribution-verb): * lisp/mh-e/mh-letter.el (mh-letter-mode): * lisp/mh-e/mh-search.el (mh-search-folder): * lisp/mh-e/mh-seq.el (mh-narrow-to-seq, mh-widen): * lisp/mh-e/mh-show.el (mh-show-mode): * lisp/mh-e/mh-tool-bar.el (mh-tool-bar-define): * lisp/mh-e/mh-xface.el (mh-x-image-url-display) (mh-x-image-url-fetch-image): Prefer setq-local. diff --git a/lisp/mh-e/mh-comp.el b/lisp/mh-e/mh-comp.el index 4681ad885d..b42527f1bf 100644 --- a/lisp/mh-e/mh-comp.el +++ b/lisp/mh-e/mh-comp.el @@ -579,11 +579,12 @@ See also `mh-compose-forward-as-mime-flag', (goto-char (point-min)) ;; Set the local value of mh-mail-header-separator according to what is ;; present in the buffer... - (set (make-local-variable 'mh-mail-header-separator) - (save-excursion - (goto-char (mh-mail-header-end)) - (buffer-substring-no-properties (point) (line-end-position)))) - (set (make-local-variable 'mail-header-separator) mh-mail-header-separator) ;override sendmail.el + (setq-local mh-mail-header-separator + (save-excursion + (goto-char (mh-mail-header-end)) + (buffer-substring-no-properties (point) + (line-end-position)))) + (setq-local mail-header-separator mh-mail-header-separator) ;override sendmail.el ;; If using MML, translate MH-style directive (if (equal mh-compose-insertion 'mml) (save-excursion diff --git a/lisp/mh-e/mh-folder.el b/lisp/mh-e/mh-folder.el index 6e097d2b74..aabcdd2466 100644 --- a/lisp/mh-e/mh-folder.el +++ b/lisp/mh-e/mh-folder.el @@ -579,54 +579,54 @@ perform the operation on all messages in that region. (unless mh-folder-tool-bar-map (mh-tool-bar-folder-buttons-init)) (if (boundp 'tool-bar-map) - (set (make-local-variable 'tool-bar-map) mh-folder-tool-bar-map)) + (setq-local tool-bar-map mh-folder-tool-bar-map)) (make-local-variable 'font-lock-defaults) (setq font-lock-defaults '(mh-folder-font-lock-keywords t)) (make-local-variable 'desktop-save-buffer) (setq desktop-save-buffer t) - (mh-make-local-vars - 'mh-colors-available-flag (mh-colors-available-p) + (setq-local + mh-colors-available-flag (mh-colors-available-p) ; Do we have colors available - 'mh-current-folder (buffer-name) ; Name of folder, a string - 'mh-show-buffer (format "show-%s" (buffer-name)) ; Buffer that displays msgs - 'mh-folder-filename ; e.g. "/usr/foobar/Mail/inbox/" + mh-current-folder (buffer-name) ; Name of folder, a string + mh-show-buffer (format "show-%s" (buffer-name)) ; Buffer that displays msgs + mh-folder-filename ; e.g. "/usr/foobar/Mail/inbox/" (file-name-as-directory (mh-expand-file-name (buffer-name))) - 'mh-display-buttons-for-inline-parts-flag + mh-display-buttons-for-inline-parts-flag mh-display-buttons-for-inline-parts-flag ; Allow for display of buttons to ; be toggled. - 'mh-arrow-marker (make-marker) ; Marker where arrow is displayed - 'overlay-arrow-position nil ; Allow for simultaneous display in - 'overlay-arrow-string ">" ; different MH-E buffers. - 'mh-showing-mode nil ; Show message also? - 'mh-refile-list nil ; List of folder names in mh-seq-list - 'mh-delete-list nil ; List of msgs nums to delete - 'mh-blocklist nil ; List of messages to process as spam - 'mh-allowlist nil ; List of messages to process as ham - 'mh-seq-list nil ; Alist of (seq . msgs) nums - 'mh-seen-list nil ; List of displayed messages - 'mh-next-direction 'forward ; Direction to move to next message - 'mh-view-ops () ; Stack that keeps track of the order + mh-arrow-marker (make-marker) ; Marker where arrow is displayed + overlay-arrow-position nil ; Allow for simultaneous display in + overlay-arrow-string ">" ; different MH-E buffers. + mh-showing-mode nil ; Show message also? + mh-refile-list nil ; List of folder names in mh-seq-list + mh-delete-list nil ; List of msgs nums to delete + mh-blocklist nil ; List of messages to process as spam + mh-allowlist nil ; List of messages to process as ham + mh-seq-list nil ; Alist of (seq . msgs) nums + mh-seen-list nil ; List of displayed messages + mh-next-direction 'forward ; Direction to move to next message + mh-view-ops () ; Stack that keeps track of the order ; in which narrowing/threading has been ; carried out. - 'mh-folder-view-stack () ; Stack of previous views of the + mh-folder-view-stack () ; Stack of previous views of the ; folder. - 'mh-index-data nil ; If the folder was created by a call + mh-index-data nil ; If the folder was created by a call ; to mh-search, this contains info ; about the search results. - 'mh-index-previous-search nil ; folder, indexer, search-regexp - 'mh-index-msg-checksum-map nil ; msg -> checksum map - 'mh-index-checksum-origin-map nil ; checksum -> ( orig-folder, orig-msg ) - 'mh-index-sequence-search-flag nil ; folder resulted from sequence search - 'mh-first-msg-num nil ; Number of first msg in buffer - 'mh-last-msg-num nil ; Number of last msg in buffer - 'mh-msg-count nil ; Number of msgs in buffer - 'mh-mode-line-annotation nil ; Indicates message range - 'mh-sequence-notation-history (make-hash-table) + mh-index-previous-search nil ; folder, indexer, search-regexp + mh-index-msg-checksum-map nil ; msg -> checksum map + mh-index-checksum-origin-map nil ; checksum -> ( orig-folder, orig-msg ) + mh-index-sequence-search-flag nil ; folder resulted from sequence search + mh-first-msg-num nil ; Number of first msg in buffer + mh-last-msg-num nil ; Number of last msg in buffer + mh-msg-count nil ; Number of msgs in buffer + mh-mode-line-annotation nil ; Indicates message range + mh-sequence-notation-history (make-hash-table) ; Remember what is overwritten by ; mh-note-seq. - 'imenu-create-index-function 'mh-index-create-imenu-index + imenu-create-index-function 'mh-index-create-imenu-index ; Setup imenu support - 'mh-previous-window-config nil) ; Previous window configuration + mh-previous-window-config nil) ; Previous window configuration (setq truncate-lines t) (auto-save-mode -1) (setq buffer-offer-save t) diff --git a/lisp/mh-e/mh-identity.el b/lisp/mh-e/mh-identity.el index 4e639f1f74..3643e46231 100644 --- a/lisp/mh-e/mh-identity.el +++ b/lisp/mh-e/mh-identity.el @@ -234,11 +234,9 @@ added." (if (null value) (mh-insert-signature) (mh-insert-signature value)) - (set (make-local-variable 'mh-identity-signature-start) - (point-min-marker)) + (setq-local mh-identity-signature-start (point-min-marker)) (set-marker-insertion-type mh-identity-signature-start t) - (set (make-local-variable 'mh-identity-signature-end) - (point-max-marker))))))) + (setq-local mh-identity-signature-end (point-max-marker))))))) (defvar mh-identity-attribution-verb-start nil "Marker for the beginning of the attribution verb.") @@ -270,11 +268,9 @@ If VALUE is nil, use `mh-extract-from-attribution-verb'." (if (null value) (insert mh-extract-from-attribution-verb) (insert value)) - (set (make-local-variable 'mh-identity-attribution-verb-start) - (point-min-marker)) + (setq-local mh-identity-attribution-verb-start (point-min-marker)) (set-marker-insertion-type mh-identity-attribution-verb-start t) - (set (make-local-variable 'mh-identity-attribution-verb-end) - (point-max-marker)))) + (setq-local mh-identity-attribution-verb-end (point-max-marker)))) (defun mh-identity-handler-default (field action top &optional value) "Process header FIELD. diff --git a/lisp/mh-e/mh-letter.el b/lisp/mh-e/mh-letter.el index 52a130dc0c..59d8175b62 100644 --- a/lisp/mh-e/mh-letter.el +++ b/lisp/mh-e/mh-letter.el @@ -294,18 +294,18 @@ order). (unless mh-letter-tool-bar-map (mh-tool-bar-letter-buttons-init)) (if (boundp 'tool-bar-map) - (set (make-local-variable 'tool-bar-map) mh-letter-tool-bar-map)) + (setq-local tool-bar-map mh-letter-tool-bar-map)) ;; Set the local value of mh-mail-header-separator according to what is ;; present in the buffer... - (set (make-local-variable 'mh-mail-header-separator) - (save-excursion - (goto-char (mh-mail-header-end)) - (buffer-substring-no-properties (point) (line-end-position)))) + (setq-local mh-mail-header-separator + (save-excursion + (goto-char (mh-mail-header-end)) + (buffer-substring-no-properties (point) (line-end-position)))) (make-local-variable 'mail-header-separator) (setq mail-header-separator mh-mail-header-separator) ;override sendmail.el (mh-set-help mh-letter-mode-help-messages) (setq buffer-invisibility-spec '((vanish . t) t)) - (set (make-local-variable 'line-move-ignore-invisible) t) + (setq-local line-move-ignore-invisible t) ;; Enable undo since a show-mode buffer might have been reused. (buffer-enable-undo) diff --git a/lisp/mh-e/mh-search.el b/lisp/mh-e/mh-search.el index 23f0f5a7c2..ef84c5eb28 100644 --- a/lisp/mh-e/mh-search.el +++ b/lisp/mh-e/mh-search.el @@ -333,8 +333,8 @@ configuration and is used when the search folder is dismissed." (not (y-or-n-p "Reuse pattern? "))) (mh-make-pick-template) (message "")) - (mh-make-local-vars 'mh-current-folder folder - 'mh-previous-window-config window-config) + (setq-local mh-current-folder folder + mh-previous-window-config window-config) (message "%s" (substitute-command-keys (concat "Type \\[mh-index-do-search] to search messages, " "\\[mh-pick-do-search] to use pick, " diff --git a/lisp/mh-e/mh-seq.el b/lisp/mh-e/mh-seq.el index 06d2ec639b..dc2ed613b1 100644 --- a/lisp/mh-e/mh-seq.el +++ b/lisp/mh-e/mh-seq.el @@ -224,12 +224,12 @@ When you want to widen the view to all your messages again, use (mh-make-folder-mode-line) (mh-recenter nil) (when (and (boundp 'tool-bar-mode) tool-bar-mode) - (set (make-local-variable 'tool-bar-map) - mh-folder-seq-tool-bar-map) + (setq-local tool-bar-map + mh-folder-seq-tool-bar-map) (when (buffer-live-p (get-buffer mh-show-buffer)) (with-current-buffer mh-show-buffer - (set (make-local-variable 'tool-bar-map) - mh-show-seq-tool-bar-map)))) + (setq-local tool-bar-map + mh-show-seq-tool-bar-map)))) (push 'widen mh-view-ops))) (t (error "No messages in sequence %s" (symbol-name sequence)))))) @@ -357,10 +357,10 @@ remove all limits and sequence restrictions." (mh-notate-cur) (mh-recenter nil))) (when (and (null mh-folder-view-stack) (boundp 'tool-bar-mode) tool-bar-mode) - (set (make-local-variable 'tool-bar-map) mh-folder-tool-bar-map) + (setq-local tool-bar-map mh-folder-tool-bar-map) (when (buffer-live-p (get-buffer mh-show-buffer)) (with-current-buffer mh-show-buffer - (set (make-local-variable 'tool-bar-map) mh-show-tool-bar-map))))) + (setq-local tool-bar-map mh-show-tool-bar-map))))) diff --git a/lisp/mh-e/mh-show.el b/lisp/mh-e/mh-show.el index 057799d1ea..d212252374 100644 --- a/lisp/mh-e/mh-show.el +++ b/lisp/mh-e/mh-show.el @@ -833,13 +833,13 @@ See also `mh-folder-mode'. \\{mh-show-mode-map}" (if (boundp 'tool-bar-map) - (set (make-local-variable 'tool-bar-map) mh-show-tool-bar-map)) - (set (make-local-variable 'mail-header-separator) mh-mail-header-separator) + (setq-local tool-bar-map mh-show-tool-bar-map)) + (setq-local mail-header-separator mh-mail-header-separator) (setq paragraph-start (default-value 'paragraph-start)) (setq buffer-invisibility-spec '((vanish . t) t)) - (set (make-local-variable 'line-move-ignore-invisible) t) + (setq-local line-move-ignore-invisible t) (make-local-variable 'font-lock-defaults) - ;;(set (make-local-variable 'font-lock-support-mode) nil) + ;;(setq-local font-lock-support-mode nil) (cond ((equal mh-highlight-citation-style 'font-lock) (setq font-lock-defaults '(mh-show-font-lock-keywords-with-cite t))) diff --git a/lisp/mh-e/mh-tool-bar.el b/lisp/mh-e/mh-tool-bar.el index 06b94b6bf8..22ed477b57 100644 --- a/lisp/mh-e/mh-tool-bar.el +++ b/lisp/mh-e/mh-tool-bar.el @@ -260,7 +260,7 @@ Use SEQUENCE-MAP if display is limited; DEFAULT-MAP otherwise." ;; mh-e.el, after the +inbox buffer has been ;; created, but before mh-folder-mode has run and ;; created the local map. - (set (make-local-variable 'tool-bar-map) map)))))) + (setq-local tool-bar-map map)))))) (defun mh-tool-bar-folder-buttons-set (symbol value) "Construct tool bar for `mh-folder-mode' and `mh-show-mode'." (set-default symbol value) diff --git a/lisp/mh-e/mh-utils.el b/lisp/mh-e/mh-utils.el index ec2bd7f67b..dcfb691ff6 100644 --- a/lisp/mh-e/mh-utils.el +++ b/lisp/mh-e/mh-utils.el @@ -78,6 +78,7 @@ used in lieu of `search' in the CL package." ;;;###mh-autoload (defun mh-make-local-vars (&rest pairs) "Initialize local variables according to the variable-value PAIRS." + (declare (obsolete setq-local "29.1")) (while pairs (set (make-local-variable (car pairs)) (car (cdr pairs))) (setq pairs (cdr (cdr pairs))))) diff --git a/lisp/mh-e/mh-xface.el b/lisp/mh-e/mh-xface.el index 634d12a489..d44cca361a 100644 --- a/lisp/mh-e/mh-xface.el +++ b/lisp/mh-e/mh-xface.el @@ -283,7 +283,7 @@ If the URL isn't present in the cache then it is fetched with wget." (let* ((cache-filename (mh-x-image-url-cache-canonicalize url)) (state (mh-x-image-get-download-state cache-filename)) (marker (point-marker))) - (set (make-local-variable 'mh-x-image-marker) marker) + (setq-local mh-x-image-marker marker) (cond ((not (mh-x-image-url-sane-p url))) ((eq state 'ok) (mh-x-image-display cache-filename marker)) @@ -378,9 +378,9 @@ actual display is carried out by the SENTINEL function." (let ((buffer (generate-new-buffer mh-temp-fetch-buffer)) (filename (make-temp-file "mhe-fetch"))) (with-current-buffer buffer - (set (make-local-variable 'mh-x-image-url-cache-file) cache-file) - (set (make-local-variable 'mh-x-image-marker) marker) - (set (make-local-variable 'mh-x-image-temp-file) filename)) + (setq-local mh-x-image-url-cache-file cache-file) + (setq-local mh-x-image-marker marker) + (setq-local mh-x-image-temp-file filename)) (set-process-sentinel (start-process "*mh-x-image-url-fetch*" buffer mh-wget-executable mh-wget-option filename url) commit f8d750135e90282864019b4484d0f0dec34cbd2f Author: Stefan Kangas Date: Mon Oct 11 23:58:24 2021 +0200 Remove some more MH-E compat code * lisp/mh-e/mh-acros.el (defun-mh, defmacro-mh): Make obsolete. * lisp/mh-e/mh-gnus.el (mh-gnus-local-map-property): Make obsolete. * lisp/mh-e/mh-mime.el (mh-insert-mime-security-button) (mh-insert-mime-button): Don't use above obsolete function. * lisp/mh-e/mh-gnus.el (mh-mm-text-html-renderer): Make obsolete. * lisp/mh-e/mh-mime.el (mh-mm-inline-media-tests) (mh-signature-highlight): Remove references to removed Gnus variable 'mm-inline-text-html-renderer'. * lisp/mh-e/mh-letter.el (mh-letter-complete): Make into obsolete function alias for 'completion-at-point'. Update callers. * lisp/mh-e/mh-e.el (mh-inc-spool-list, mh-show-use-xface-flag): * lisp/mh-e/mh-comp.el (mh-ascii-buffer-p): * lisp/mh-e/mh-show.el: * lisp/mh-e/mh-utils.el: Remove some references to XEmacs. * lisp/mh-e/mh-comp.el (mh-send-letter): Remove XEmacs and Emacs compat code. * lisp/mh-e/mh-compat.el (mh-display-completion-list): Remove compat code for Emacs 22 and earlier. * lisp/mh-e/mh-e.el (mh-inherit-face-flag) (mh-min-colors-defined-flag): Make XEmacs and Emacs 21 compat variables obsolete. (mh-face-data): Adjust to assume above variables are always t. * lisp/mh-e/mh-mime.el (mh-mime-button-map): Remove XEmacs and Emacs 20 compat code. * lisp/mh-e/mh-utils.el (mh-mapc): Make Emacs 20 compat function into obsolete function alias for mapc. Update callers. * lisp/mh-e/mh-xface.el (mh-show-xface-function, mh-show-xface): Remove Emacs 20 compat code. diff --git a/lisp/mh-e/mh-acros.el b/lisp/mh-e/mh-acros.el index 3674acc6cc..d18579d7ea 100644 --- a/lisp/mh-e/mh-acros.el +++ b/lisp/mh-e/mh-acros.el @@ -75,7 +75,8 @@ "Create function NAME. If FUNCTION exists, then NAME becomes an alias for FUNCTION. Otherwise, create function NAME with ARG-LIST and BODY." - (declare (indent defun) (doc-string 4) + (declare (obsolete defun "29.1") + (indent defun) (doc-string 4) (debug (&define name symbolp sexp def-body))) `(defalias ',name (if (fboundp ',function) @@ -87,7 +88,8 @@ Otherwise, create function NAME with ARG-LIST and BODY." "Create macro NAME. If MACRO exists, then NAME becomes an alias for MACRO. Otherwise, create macro NAME with ARG-LIST and BODY." - (declare (indent defun) (doc-string 4) + (declare (obsolete defmacro "29.1") + (indent defun) (doc-string 4) (debug (&define name symbolp sexp def-body))) (let ((defined-p (fboundp macro))) (if defined-p diff --git a/lisp/mh-e/mh-comp.el b/lisp/mh-e/mh-comp.el index 8d5a472552..4681ad885d 100644 --- a/lisp/mh-e/mh-comp.el +++ b/lisp/mh-e/mh-comp.el @@ -304,21 +304,7 @@ message and scan line." (let ((draft-buffer (current-buffer)) (file-name buffer-file-name) (config mh-previous-window-config) - ;; FIXME this is subtly different to select-message-coding-system. - (coding-system-for-write - (if (fboundp 'select-message-coding-system) - (select-message-coding-system) ; Emacs has this since at least 21.1 - (if (and (local-variable-p 'buffer-file-coding-system - (current-buffer)) ;XEmacs needs two args - ;; We're not sure why, but buffer-file-coding-system - ;; tends to get set to undecided-unix. - (not (memq buffer-file-coding-system - '(undecided undecided-unix undecided-dos)))) - buffer-file-coding-system - (or (and (boundp 'sendmail-coding-system) sendmail-coding-system) - (and (default-boundp 'buffer-file-coding-system) - (default-value 'buffer-file-coding-system)) - 'utf-8))))) + (coding-system-for-write (select-message-coding-system))) ;; Older versions of spost do not support -msgid and -mime. (unless mh-send-uses-spost-flag ;; Adding a Message-ID field looks good, makes it easier to search for @@ -433,7 +419,7 @@ See also `mh-send'." (mh-clean-msg-header (point-min) mh-new-draft-cleaned-headers nil) (mh-insert-header-separator) ;; Merge in components - (mh-mapc + (mapc (lambda (header-field) (let ((field (car header-field)) (value (cdr header-field)) @@ -697,7 +683,7 @@ message and scan line." ;; For "From", the first value wins, with the identity's "From" ;; trumping anything in the distcomps file. (let ((components-file (mh-bare-components mh-dist-formfile))) - (mh-mapc + (mapc (lambda (header-field) (let ((field (car header-field)) (value (cdr header-field)) @@ -1276,11 +1262,8 @@ discarded." (set-syntax-table old-syntax-table)))) (defun mh-ascii-buffer-p () - "Check if current buffer is entirely composed of ASCII. -The function doesn't work for XEmacs since `find-charset-region' -doesn't exist there." - (cl-loop for charset in (mh-funcall-if-exists - find-charset-region (point-min) (point-max)) + "Check if current buffer is entirely composed of ASCII." + (cl-loop for charset in (find-charset-region (point-min) (point-max)) unless (eq charset 'ascii) return nil finally return t)) diff --git a/lisp/mh-e/mh-compat.el b/lisp/mh-e/mh-compat.el index 839379857f..1c36c27bbf 100644 --- a/lisp/mh-e/mh-compat.el +++ b/lisp/mh-e/mh-compat.el @@ -70,13 +70,9 @@ The optional argument COMMON-SUBSTRING, if non-nil, should be a string specifying a common substring for adding the faces `completions-first-difference' and `completions-common-part' to the completions." - (cond ((< emacs-major-version 22) `(display-completion-list ,completions)) - ((fboundp 'completion-hilit-commonality) ; Emacs 23.1 and later - `(display-completion-list - (completion-hilit-commonality ,completions - ,(length common-substring) nil))) - (t ; Emacs 22 - `(display-completion-list ,completions ,common-substring)))) + `(display-completion-list + (completion-hilit-commonality ,completions + ,(length common-substring) nil))) (define-obsolete-function-alias 'mh-face-foreground #'face-foreground "29.1") diff --git a/lisp/mh-e/mh-e.el b/lisp/mh-e/mh-e.el index 09f62466b3..b02b8e0154 100644 --- a/lisp/mh-e/mh-e.el +++ b/lisp/mh-e/mh-e.el @@ -656,9 +656,6 @@ Set mark after inserted text." ;;; MH-E Customization Support Routines -;; Shush compiler (Emacs 21 and XEmacs). -(defvar customize-package-emacs-version-alist) - ;; Temporary function and data structure used customization. ;; These will be unbound after the options are defined. (defmacro mh-strip-package-version (args) @@ -1655,10 +1652,7 @@ using the Emacs 22 command \"emacsclient\" as follows: origMode polltime 10 headertime 0 - command emacsclient --eval \\='(mh-inc-spool-mh-e)\\=' - -In XEmacs, the command \"gnuclient\" is used in a similar -fashion." + command emacsclient --eval \\='(mh-inc-spool-mh-e)\\='" :type '(repeat (list (file :tag "Spool File") (string :tag "Folder") (character :tag "Key Binding"))) @@ -1813,7 +1807,7 @@ flavors of `mh-yank-behavior' or you have added a "Function to call when completing outside of address or folder fields. In the body of the message, -\\\\[mh-letter-complete] runs this function, +\\\\[completion-at-point] runs this function, which is set to \"ispell-complete-word\" by default." :type '(choice function (const nil)) :group 'mh-letter @@ -3022,15 +3016,12 @@ and off. This feature will be turned on by default if your system supports it. The first header field used, if present, is the Gnus-specific -\"Face:\" field. The \"Face:\" field appeared in GNU Emacs 21 and -XEmacs. For more information, see URL +\"Face:\" field. The \"Face:\" field appeared in Emacs 21. +For more information, see URL `https://quimby.gnus.org/circus/face/'. Next is the traditional \"X-Face:\" header field. The display of this field requires the \"uncompface\" program (see URL -`ftp://ftp.cs.indiana.edu/pub/faces/compface/compface.tar.z'). Recent -versions of XEmacs have internal support for \"X-Face:\" images. If -your version of XEmacs does not, then you'll need both \"uncompface\" -and the x-face package (see URL `https://www.jpl.org/ftp/pub/elisp/'). +`ftp://ftp.cs.indiana.edu/pub/faces/compface/compface.tar.z'). Finally, MH-E will display images referenced by the \"X-Image-URL:\" header field if neither the \"Face:\" nor the \"X-Face:\" fields are @@ -3522,14 +3513,13 @@ consumed by `defface-mh'.") (require 'cus-face) -(defvar mh-inherit-face-flag (assq :inherit custom-face-attributes) - "Non-nil means that the `defface' :inherit keyword is available. -The :inherit keyword is available on all supported versions of -GNU Emacs and XEmacs from at least 21.5.23 on.") +(defvar mh-inherit-face-flag t + "Non-nil means that the `defface' :inherit keyword is available.") +(make-obsolete-variable 'mh-inherit-face-flag nil "29.1") -(defvar mh-min-colors-defined-flag (and (not (featurep 'xemacs)) - (>= emacs-major-version 22)) +(defvar mh-min-colors-defined-flag t "Non-nil means `defface' supports min-colors display requirement.") +(make-obsolete-variable 'mh-min-colors-defined-flag nil "29.1") (defun mh-face-data (face &optional inherit) "Return spec for FACE. @@ -3540,37 +3530,10 @@ keyword, return INHERIT literally; otherwise, return spec for FACE from the variable `mh-face-data'. This isn't a perfect implementation. In the case that the :inherit keyword is not supported, any additional attributes in the inherit parameter are -not added to the returned spec. - -Furthermore, when `mh-min-colors-defined-flag' is nil, this -function finds display entries with \"min-colors\" requirements -and either removes the \"min-colors\" requirement or strips the -display entirely if the display does not support the number of -specified colors." - (let ((spec - (if (and inherit mh-inherit-face-flag) - inherit - (or (cadr (assq face mh-face-data)) - (error "Could not find %s in mh-face-data" face))))) - - (if mh-min-colors-defined-flag - spec - (let ((cells (display-color-cells)) - new-spec) - ;; Remove entries with min-colors, or delete them if we have - ;; fewer colors than they specify. - (cl-loop - for entry in (reverse spec) do - (let ((requirement (if (eq (car entry) t) - nil - (assq 'min-colors (car entry))))) - (if requirement - (when (>= cells (nth 1 requirement)) - (setq new-spec (cons (cons (delq requirement (car entry)) - (cdr entry)) - new-spec))) - (setq new-spec (cons entry new-spec))))) - new-spec)))) +not added to the returned spec." + (or inherit + (cadr (assq face mh-face-data)) + (error "Could not find %s in mh-face-data" face))) (defface-mh mh-folder-address (mh-face-data 'mh-folder-subject '((t (:inherit mh-folder-subject)))) diff --git a/lisp/mh-e/mh-folder.el b/lisp/mh-e/mh-folder.el index c59ed849b4..6e097d2b74 100644 --- a/lisp/mh-e/mh-folder.el +++ b/lisp/mh-e/mh-folder.el @@ -1545,35 +1545,35 @@ after the commands are processed." (append folders-changed (mh-index-execute-commands)))) ;; Then refile messages - (mh-mapc #'(lambda (folder-msg-list) - (let* ((dest-folder (symbol-name (car folder-msg-list))) - (last (car (mh-translate-range dest-folder "last"))) - (msgs (cdr folder-msg-list))) - (push dest-folder folders-changed) - (setq redraw-needed-flag t) - (apply #'mh-exec-cmd - "refile" "-src" folder dest-folder - (mh-coalesce-msg-list msgs)) - (mh-delete-scan-msgs msgs) - ;; Preserve sequences in destination folder... - (when mh-refile-preserves-sequences-flag - (clrhash dest-map) - (cl-loop - for i from (1+ (or last 0)) - for msg in (sort (copy-sequence msgs) #'<) - do (cl-loop for seq-name in (gethash msg seq-map) - do (push i (gethash seq-name dest-map)))) - (maphash - #'(lambda (seq msgs) - ;; Can't be run in the background, since the - ;; current folder is changed by mark this could - ;; lead to a race condition with the next refile. - (apply #'mh-exec-cmd "mark" - "-sequence" (symbol-name seq) dest-folder - "-add" (mapcar #'(lambda (x) (format "%s" x)) - (mh-coalesce-msg-list msgs)))) - dest-map)))) - mh-refile-list) + (mapc #'(lambda (folder-msg-list) + (let* ((dest-folder (symbol-name (car folder-msg-list))) + (last (car (mh-translate-range dest-folder "last"))) + (msgs (cdr folder-msg-list))) + (push dest-folder folders-changed) + (setq redraw-needed-flag t) + (apply #'mh-exec-cmd + "refile" "-src" folder dest-folder + (mh-coalesce-msg-list msgs)) + (mh-delete-scan-msgs msgs) + ;; Preserve sequences in destination folder... + (when mh-refile-preserves-sequences-flag + (clrhash dest-map) + (cl-loop + for i from (1+ (or last 0)) + for msg in (sort (copy-sequence msgs) #'<) + do (cl-loop for seq-name in (gethash msg seq-map) + do (push i (gethash seq-name dest-map)))) + (maphash + #'(lambda (seq msgs) + ;; Can't be run in the background, since the + ;; current folder is changed by mark this could + ;; lead to a race condition with the next refile. + (apply #'mh-exec-cmd "mark" + "-sequence" (symbol-name seq) dest-folder + "-add" (mapcar #'(lambda (x) (format "%s" x)) + (mh-coalesce-msg-list msgs)))) + dest-map)))) + mh-refile-list) (setq mh-refile-list ()) ;; Now delete messages diff --git a/lisp/mh-e/mh-gnus.el b/lisp/mh-e/mh-gnus.el index b096cd6b88..0e1bde71f2 100644 --- a/lisp/mh-e/mh-gnus.el +++ b/lisp/mh-e/mh-gnus.el @@ -35,10 +35,9 @@ (require 'mm-view nil t) (require 'mml nil t)) -;; Copy of function from gnus-util.el. -;; TODO This is not in Gnus 5.11. -(defun-mh mh-gnus-local-map-property gnus-local-map-property (map) +(defun mh-gnus-local-map-property (map) "Return a list suitable for a text property list specifying keymap MAP." + (declare (obsolete nil "29.1")) (list 'keymap map)) (define-obsolete-function-alias 'mh-mm-merge-handles @@ -103,8 +102,8 @@ PROMPT overrides the default one used to ask user for a file name." (defun mh-mm-text-html-renderer () "Find the renderer Gnus is using to display text/html MIME parts." - (or (and (boundp 'mm-inline-text-html-renderer) mm-inline-text-html-renderer) - (and (boundp 'mm-text-html-renderer) mm-text-html-renderer))) + (declare (obsolete mm-text-html-renderer "29.1")) + mm-text-html-renderer) (provide 'mh-gnus) diff --git a/lisp/mh-e/mh-letter.el b/lisp/mh-e/mh-letter.el index 0271edb59a..52a130dc0c 100644 --- a/lisp/mh-e/mh-letter.el +++ b/lisp/mh-e/mh-letter.el @@ -173,7 +173,7 @@ "\C-c\C-w" #'mh-check-whom "\C-c\C-y" #'mh-yank-cur-msg "\C-c\M-d" #'mh-insert-auto-fields - "\M-\t" #'mh-letter-complete + "\M-\t" #'completion-at-point "\t" #'mh-letter-next-header-field-or-indent [backtab] #'mh-letter-previous-header-field) @@ -479,29 +479,8 @@ This provides alias and folder completion in header fields according to (or (funcall func) #'ignore) mh-letter-complete-function))) -;; TODO Now that completion-at-point performs the task of -;; mh-letter-complete, perhaps mh-letter-complete along with -;; mh-complete-word should be rewritten as a more general function for -;; XEmacs, renamed to mh-completion-at-point, and moved to -;; mh-compat.el. -(defun-mh mh-letter-complete completion-at-point () - "Perform completion on header field or word preceding point. - -If the field contains addresses (for example, \"To:\" or \"Cc:\") -or folders (for example, \"Fcc:\") then this command will provide -alias completion. In the body of the message, this command runs -`mh-letter-complete-function' instead, which is set to -`ispell-complete-word' by default." - (interactive) - (let ((data (mh-letter-completion-at-point))) - (cond - ((functionp data) (funcall data)) - ((consp data) - (let ((start (nth 0 data)) - (end (nth 1 data)) - (table (nth 2 data))) - (mh-complete-word (buffer-substring-no-properties start end) - table start end)))))) +(define-obsolete-function-alias 'mh-letter-complete + #'completion-at-point "29.1") (defun mh-letter-complete-or-space (arg) "Perform completion or insert space. @@ -521,7 +500,7 @@ one space." ((> (point) end-of-prev) (self-insert-command arg)) ((let ((mh-letter-complete-function nil)) (mh-letter-completion-at-point)) - (mh-letter-complete)) + (completion-at-point)) (t (self-insert-command arg))))) (defun mh-letter-confirm-address () diff --git a/lisp/mh-e/mh-mime.el b/lisp/mh-e/mh-mime.el index 24410e6c09..d2a09037fe 100644 --- a/lisp/mh-e/mh-mime.el +++ b/lisp/mh-e/mh-mime.el @@ -137,9 +137,7 @@ ("text/html" ,(if (fboundp 'mm-inline-text-html) 'mm-inline-text-html 'mm-inline-text) (lambda (handle) - (or (and (boundp 'mm-inline-text-html-renderer) - mm-inline-text-html-renderer) - (and (boundp 'mm-text-html-renderer) mm-text-html-renderer)))) + mm-text-html-renderer)) ("text/x-vcard" mm-inline-text-vcard (lambda (handle) @@ -184,9 +182,6 @@ Set from last use.") '((mh-press-button "\r" "Toggle Display"))) (defvar mh-mime-button-map (let ((map (make-sparse-keymap))) - (unless (>= (string-to-number emacs-version) 21) - ;; XEmacs doesn't care. - (set-keymap-parent map mh-show-mode-map)) (define-key map [mouse-2] #'mh-push-button) (dolist (c mh-mime-button-commands) (define-key map (cadr c) (car c))) @@ -799,7 +794,7 @@ being used to highlight the signature in a MIME part." ((not (and (equal (mm-handle-media-supertype handle) "text") (equal (mm-handle-media-subtype handle) "html"))) "^-- $") - ((eq (mh-mm-text-html-renderer) 'lynx) "^ --$") + ((eq mm-text-html-renderer 'lynx) "^ --$") (t "^--$")))) (save-excursion (goto-char (point-max)) @@ -843,10 +838,10 @@ by commands like \"K v\" which operate on individual MIME parts." (setq begin (point)) (gnus-eval-format mh-mime-button-line-format mh-mime-button-line-format-alist - `(,@(mh-gnus-local-map-property mh-mime-button-map) - mh-callback mh-mm-display-part - mh-part ,index - mh-data ,handle))) + `(keymap ,mh-mime-button-map + mh-callback mh-mm-display-part + mh-part ,index + mh-data ,handle))) (setq end (point)) (widget-convert-button 'link begin end @@ -885,11 +880,11 @@ by commands like \"K v\" which operate on individual MIME parts." (gnus-eval-format mh-mime-security-button-line-format mh-mime-security-button-line-format-alist - `(,@(mh-gnus-local-map-property mh-mime-security-button-map) - mh-button-pressed ,mh-mime-security-button-pressed - mh-callback mh-mime-security-press-button - mh-line-format ,mh-mime-security-button-line-format - mh-data ,handle)) + `(keymap ,mh-mime-security-button-map + mh-button-pressed ,mh-mime-security-button-pressed + mh-callback mh-mime-security-press-button + mh-line-format ,mh-mime-security-button-line-format + mh-data ,handle)) (setq end (point)) (widget-convert-button 'link begin end :mime-handle handle diff --git a/lisp/mh-e/mh-seq.el b/lisp/mh-e/mh-seq.el index c8df75dbc7..06d2ec639b 100644 --- a/lisp/mh-e/mh-seq.el +++ b/lisp/mh-e/mh-seq.el @@ -781,10 +781,10 @@ If SAVE-REFILES is non-nil, then keep the sequences that note messages to be refiled." (let ((seqs ())) (cond (save-refiles - (mh-mapc (lambda (seq) ; Save the refiling sequences - (if (mh-folder-name-p (mh-seq-name seq)) - (setq seqs (cons seq seqs)))) - mh-seq-list))) + (mapc (lambda (seq) ; Save the refiling sequences + (if (mh-folder-name-p (mh-seq-name seq)) + (setq seqs (cons seq seqs)))) + mh-seq-list))) (save-excursion (if (eq 0 (mh-exec-cmd-quiet nil "mark" folder "-list")) (progn diff --git a/lisp/mh-e/mh-show.el b/lisp/mh-e/mh-show.el index 489c134a3e..057799d1ea 100644 --- a/lisp/mh-e/mh-show.el +++ b/lisp/mh-e/mh-show.el @@ -335,10 +335,9 @@ The current frame height is taken into consideration." -;; Infrastructure to generate show-buffer functions from folder functions -;; XEmacs does not have deactivate-mark? What is the equivalent of -;; transient-mark-mode for XEmacs? Should we be restoring the mark in the -;; folder buffer after the operation has been carried out. +;; Infrastructure to generate show-buffer functions from folder functions. +;; Should we be restoring the mark in the folder buffer after the +;; operation has been carried out? (defmacro mh-defun-show-buffer (function original-function &optional dont-return) "Define FUNCTION to run ORIGINAL-FUNCTION in folder buffer. diff --git a/lisp/mh-e/mh-utils.el b/lisp/mh-e/mh-utils.el index 4f211c1286..ec2bd7f67b 100644 --- a/lisp/mh-e/mh-utils.el +++ b/lisp/mh-e/mh-utils.el @@ -83,11 +83,7 @@ used in lieu of `search' in the CL package." (setq pairs (cdr (cdr pairs))))) ;;;###mh-autoload -(defun mh-mapc (function list) - "Apply FUNCTION to each element of LIST for side effects only." - (while list - (funcall function (car list)) - (setq list (cdr list)))) +(define-obsolete-function-alias 'mh-mapc #'mapc "29.1") (defvar mh-pick-regexp-chars ".*$[" "List of special characters in pick regular expressions.") @@ -716,16 +712,12 @@ See Info node `(elisp) Programmed Completion' for details." ((equal path mh-user-path) nil) (t (file-directory-p path)))))))) -;; Shush compiler. -(defvar completion-root-regexp) ;; Apparently used in XEmacs - (defun mh-folder-completing-read (prompt default allow-root-folder-flag) "Read folder name with PROMPT and default result DEFAULT. If ALLOW-ROOT-FOLDER-FLAG is non-nil then \"+\" is allowed to be a folder name corresponding to `mh-user-path'." (mh-normalize-folder-name - (let ((completion-root-regexp "^[+/]") ;FIXME: Who/what uses that? - (minibuffer-local-completion-map mh-folder-completion-map) + (let ((minibuffer-local-completion-map mh-folder-completion-map) (mh-allow-root-folder-flag allow-root-folder-flag)) (completing-read prompt 'mh-folder-completion-function nil nil nil 'mh-folder-hist default)) diff --git a/lisp/mh-e/mh-xface.el b/lisp/mh-e/mh-xface.el index 332f963a04..634d12a489 100644 --- a/lisp/mh-e/mh-xface.el +++ b/lisp/mh-e/mh-xface.el @@ -30,11 +30,9 @@ (autoload 'mail-header-parse-address "mail-parse") (autoload 'message-fetch-field "message") -(defvar mh-show-xface-function - (cond ((>= emacs-major-version 21) - #'mh-face-display-function) - (t #'ignore)) +(defvar mh-show-xface-function #'mh-face-display-function "Determine at run time what function should be called to display X-Face.") +(make-obsolete-variable 'mh-show-xface-function nil "29.1") (defvar mh-uncompface-executable (and (fboundp 'executable-find) (executable-find "uncompface"))) @@ -49,7 +47,7 @@ (when (and window-system mh-show-use-xface-flag (or mh-decode-mime-flag mh-mhl-format-file mh-clean-message-header-flag)) - (funcall mh-show-xface-function))) + (mh-face-display-function))) (defun mh-face-display-function () "Display a Face, X-Face, or X-Image-URL header field. commit cf1409db71152926767da189bf044c3a63e77128 Author: João Távora Date: Mon Oct 11 22:19:51 2021 +0100 Don't apply shorthands to punctuation-only symbols (bug#51089) This includes symbols used for arithmetic functions such as -, /=, etc. Using "-" or "/=" is still possible but doing so won't shadow those functions. * doc/lispref/symbols.texi (Shorthand, Exceptions): New subsubsection. * src/lread.c (read1): Exempt punctionation-only symbols from oblookup_considering_shorthand. * test/lisp/progmodes/elisp-mode-tests.el (elisp-dont-shadow-punctuation-only-symbols): Tweak test. diff --git a/doc/lispref/symbols.texi b/doc/lispref/symbols.texi index 9c33e2c8ec..ed7dce1c09 100644 --- a/doc/lispref/symbols.texi +++ b/doc/lispref/symbols.texi @@ -735,3 +735,20 @@ instead of @code{snu-}. ;; ("sns-" . "some-nice-string-utils-")) ;; End: @end example + +@subsection Exceptions + +There are two exceptions to rules governing Shorthand transformations: + +@itemize @bullet +@item +Symbol forms comprised entirely of symbol constituents (@pxref{Syntax +Class Table}) are exempt not transform. For example, it's possible to +use @code{-} or @code{/=} as shorthand prefixes, but that won't shadow +the arithmetic @emph{functions} that have exactly that prefix as their +full name.; + +@item +Symbol forms whose name starts with the the characters @code{#_} are +also exempted. +@end itemize diff --git a/src/lread.c b/src/lread.c index 07580d11d1..128b46aefe 100644 --- a/src/lread.c +++ b/src/lread.c @@ -3805,7 +3805,12 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list) ptrdiff_t longhand_bytes = 0; Lisp_Object tem; - if (skip_shorthand) + if (skip_shorthand || + /* The following ASCII characters are used in the + only "core" Emacs Lisp symbols that are + exclusively comprised of 'symbol constituent' + syntax. */ + strspn(read_buffer, "^*+-/<=>_|") >= nbytes) tem = oblookup (obarray, read_buffer, nchars, nbytes); else tem = oblookup_considering_shorthand (obarray, read_buffer, diff --git a/test/lisp/progmodes/elisp-mode-tests.el b/test/lisp/progmodes/elisp-mode-tests.el index e816d3c1b0..400c76c187 100644 --- a/test/lisp/progmodes/elisp-mode-tests.el +++ b/test/lisp/progmodes/elisp-mode-tests.el @@ -1094,9 +1094,8 @@ evaluation of BODY." (should (unintern "f-test4---")))) (ert-deftest elisp-dont-shadow-punctuation-only-symbols () - :expected-result :failed ; bug#51089 - (let* ((shorthanded-form '(- 42 (-foo 42))) - (expected-longhand-form '(- 42 (fooey-foo 42))) + (let* ((shorthanded-form '(/= 42 (-foo 42))) + (expected-longhand-form '(/= 42 (fooey-foo 42))) (observed (let ((read-symbol-shorthands '(("-" . "fooey-")))) (car (read-from-string commit 76d75df8e7ae19c8aca3ab9a7fbee25fc3cf1e9e Author: Stefan Kangas Date: Mon Oct 11 22:57:43 2021 +0200 Remove redundant calls to 'mh-do-in-gnu-emacs' * lisp/mh-e/mh-compat.el (mh-require): * lisp/mh-e/mh-folder.el (mh-folder-mode): * lisp/mh-e/mh-letter.el (mh-letter-mode): * lisp/mh-e/mh-mime.el (mh-mime-button-map) (mh-mime-security-button-map, mh-small-image-p) (mh-signature-highlight): * lisp/mh-e/mh-show.el (mh-show-mode): * lisp/mh-e/mh-tool-bar.el (mh-tool-bar-define): * lisp/mh-e/mh-utils.el (mh-logo-display) (mh-hidden-header-keymap): * lisp/mh-e/mh-xface.el (mh-face-display-function) (mh-picon-image-types, mh-x-image-display): Remove redundant calls to 'mh-do-in-gnu-emacs'. * lisp/mh-e/mh-acros.el (mh-do-in-gnu-emacs): * lisp/mh-e/mh-tool-bar.el: Add comment explaining an issue that stops us from making 'mh-do-in-gnu-emacs' obsolete. diff --git a/lisp/mh-e/mh-acros.el b/lisp/mh-e/mh-acros.el index 6a0342407d..3674acc6cc 100644 --- a/lisp/mh-e/mh-acros.el +++ b/lisp/mh-e/mh-acros.el @@ -47,7 +47,10 @@ ;;;###mh-autoload (defmacro mh-do-in-gnu-emacs (&rest body) "Execute BODY if in GNU Emacs." - (declare (debug t) (indent defun)) + ;; FIXME: This cannot yet be obsoleted, due to one remaining call in + ;; mh-tool-bar.el. Once that is removed, this can be obsoleted. + (declare ;; (obsolete nil "29.1") + (debug t) (indent defun)) (unless (featurep 'xemacs) `(progn ,@body))) ;;;###mh-autoload diff --git a/lisp/mh-e/mh-compat.el b/lisp/mh-e/mh-compat.el index 659c4354b1..839379857f 100644 --- a/lisp/mh-e/mh-compat.el +++ b/lisp/mh-e/mh-compat.el @@ -38,9 +38,7 @@ (eval-when-compile (require 'mh-acros)) -(mh-do-in-gnu-emacs - (define-obsolete-function-alias 'mh-require #'require "29.1")) - +(define-obsolete-function-alias 'mh-require #'require "29.1") (define-obsolete-function-alias 'mh-assoc-string #'assoc-string "29.1") (define-obsolete-function-alias 'mh-cancel-timer #'cancel-timer "29.1") diff --git a/lisp/mh-e/mh-folder.el b/lisp/mh-e/mh-folder.el index ed65395c94..c59ed849b4 100644 --- a/lisp/mh-e/mh-folder.el +++ b/lisp/mh-e/mh-folder.el @@ -576,11 +576,10 @@ region in the MH-Folder buffer, then the MH-E command will perform the operation on all messages in that region. \\{mh-folder-mode-map}" - (mh-do-in-gnu-emacs - (unless mh-folder-tool-bar-map - (mh-tool-bar-folder-buttons-init)) - (if (boundp 'tool-bar-map) - (set (make-local-variable 'tool-bar-map) mh-folder-tool-bar-map))) + (unless mh-folder-tool-bar-map + (mh-tool-bar-folder-buttons-init)) + (if (boundp 'tool-bar-map) + (set (make-local-variable 'tool-bar-map) mh-folder-tool-bar-map)) (make-local-variable 'font-lock-defaults) (setq font-lock-defaults '(mh-folder-font-lock-keywords t)) (make-local-variable 'desktop-save-buffer) diff --git a/lisp/mh-e/mh-letter.el b/lisp/mh-e/mh-letter.el index f147b7ce0d..0271edb59a 100644 --- a/lisp/mh-e/mh-letter.el +++ b/lisp/mh-e/mh-letter.el @@ -291,11 +291,10 @@ order). (make-local-variable 'mh-previous-window-config) (make-local-variable 'mh-sent-from-folder) (make-local-variable 'mh-sent-from-msg) - (mh-do-in-gnu-emacs - (unless mh-letter-tool-bar-map - (mh-tool-bar-letter-buttons-init)) - (if (boundp 'tool-bar-map) - (set (make-local-variable 'tool-bar-map) mh-letter-tool-bar-map))) + (unless mh-letter-tool-bar-map + (mh-tool-bar-letter-buttons-init)) + (if (boundp 'tool-bar-map) + (set (make-local-variable 'tool-bar-map) mh-letter-tool-bar-map)) ;; Set the local value of mh-mail-header-separator according to what is ;; present in the buffer... (set (make-local-variable 'mh-mail-header-separator) diff --git a/lisp/mh-e/mh-mime.el b/lisp/mh-e/mh-mime.el index 0dbf8f0da1..24410e6c09 100644 --- a/lisp/mh-e/mh-mime.el +++ b/lisp/mh-e/mh-mime.el @@ -187,8 +187,7 @@ Set from last use.") (unless (>= (string-to-number emacs-version) 21) ;; XEmacs doesn't care. (set-keymap-parent map mh-show-mode-map)) - (mh-do-in-gnu-emacs - (define-key map [mouse-2] #'mh-push-button)) + (define-key map [mouse-2] #'mh-push-button) (dolist (c mh-mime-button-commands) (define-key map (cadr c) (car c))) map)) @@ -211,8 +210,7 @@ Set from last use.") (unless (>= (string-to-number emacs-version) 21) (set-keymap-parent map mh-show-mode-map)) (define-key map "\r" #'mh-press-button) - (mh-do-in-gnu-emacs - (define-key map [mouse-2] #'mh-push-button)) + (define-key map [mouse-2] #'mh-push-button) map)) @@ -773,13 +771,12 @@ This is only useful if a Content-Disposition header is not present." ; this only tells us if the image is ; something that emacs can display (let ((image (mm-get-image handle))) - (mh-do-in-gnu-emacs - (let ((size (and (fboundp 'image-size) (image-size image)))) - (and size - (< (cdr size) (or mh-max-inline-image-height - (1- (window-height)))) - (< (car size) (or mh-max-inline-image-width - (window-width)))))))))) + (let ((size (and (fboundp 'image-size) (image-size image)))) + (and size + (< (cdr size) (or mh-max-inline-image-height + (1- (window-height)))) + (< (car size) (or mh-max-inline-image-width + (window-width))))))))) (defun mh-inline-vcard-p (handle) "Decide if HANDLE is a vcard that must be displayed inline." @@ -807,10 +804,9 @@ being used to highlight the signature in a MIME part." (save-excursion (goto-char (point-max)) (when (re-search-backward regexp nil t) - (mh-do-in-gnu-emacs - (let ((ov (make-overlay (point) (point-max)))) - (overlay-put ov 'face 'mh-show-signature) - (overlay-put ov 'evaporate t))))))) + (let ((ov (make-overlay (point) (point-max)))) + (overlay-put ov 'face 'mh-show-signature) + (overlay-put ov 'evaporate t)))))) diff --git a/lisp/mh-e/mh-show.el b/lisp/mh-e/mh-show.el index 25b83b2ff8..489c134a3e 100644 --- a/lisp/mh-e/mh-show.el +++ b/lisp/mh-e/mh-show.el @@ -833,9 +833,8 @@ The hook `mh-show-mode-hook' is called upon entry to this mode. See also `mh-folder-mode'. \\{mh-show-mode-map}" - (mh-do-in-gnu-emacs - (if (boundp 'tool-bar-map) - (set (make-local-variable 'tool-bar-map) mh-show-tool-bar-map))) + (if (boundp 'tool-bar-map) + (set (make-local-variable 'tool-bar-map) mh-show-tool-bar-map)) (set (make-local-variable 'mail-header-separator) mh-mail-header-separator) (setq paragraph-start (default-value 'paragraph-start)) (setq buffer-invisibility-spec '((vanish . t) t)) diff --git a/lisp/mh-e/mh-tool-bar.el b/lisp/mh-e/mh-tool-bar.el index 805408cfc7..06b94b6bf8 100644 --- a/lisp/mh-e/mh-tool-bar.el +++ b/lisp/mh-e/mh-tool-bar.el @@ -27,6 +27,8 @@ ;;; Code: (require 'mh-e) +;; FIXME: Figure out why removing the call to the `mh-do-in-gnu-emacs' +;; macro here leads to errors. (mh-do-in-gnu-emacs (require 'tool-bar)) @@ -202,79 +204,77 @@ where, (unless (memq x letter-buttons) (error "Letter defaults contains unknown button %s" x))) `(eval-and-compile - ;; GNU Emacs tool bar specific code - (mh-do-in-gnu-emacs - (defun mh-buffer-exists-p (mode) - "Test whether a buffer with major mode MODE is present." - (cl-loop for buf in (buffer-list) - when (with-current-buffer buf - (eq major-mode mode)) - return t)) - ;; Tool bar initialization functions - (defun mh-tool-bar-folder-buttons-init () - (when (mh-buffer-exists-p 'mh-folder-mode) - (let* ((load-path (image-load-path-for-library "mh-e" - "mh-logo.xpm")) - (image-load-path (cons (car load-path) - (when (boundp 'image-load-path) - image-load-path)))) - (setq mh-folder-tool-bar-map - (let ((tool-bar-map (make-sparse-keymap))) - ,@(nreverse folder-button-setter) - tool-bar-map)) - (setq mh-folder-seq-tool-bar-map - (let ((tool-bar-map (copy-keymap mh-folder-tool-bar-map))) - ,@(nreverse sequence-button-setter) - tool-bar-map)) - (setq mh-show-tool-bar-map - (let ((tool-bar-map (make-sparse-keymap))) - ,@(nreverse show-button-setter) - tool-bar-map)) - (setq mh-show-seq-tool-bar-map - (let ((tool-bar-map (copy-keymap mh-show-tool-bar-map))) - ,@(nreverse show-seq-button-setter) - tool-bar-map))))) - (defun mh-tool-bar-letter-buttons-init () - (when (mh-buffer-exists-p 'mh-letter-mode) - (let* ((load-path (image-load-path-for-library "mh-e" - "mh-logo.xpm")) - (image-load-path (cons (car load-path) - (when (boundp 'image-load-path) - image-load-path)))) - (setq mh-letter-tool-bar-map - (let ((tool-bar-map (make-sparse-keymap))) - ,@(nreverse letter-button-setter) - tool-bar-map))))) - ;; Custom setter functions - (defun mh-tool-bar-update (mode default-map sequence-map) - "Update `tool-bar-map' in all buffers of MODE. + (defun mh-buffer-exists-p (mode) + "Test whether a buffer with major mode MODE is present." + (cl-loop for buf in (buffer-list) + when (with-current-buffer buf + (eq major-mode mode)) + return t)) + ;; Tool bar initialization functions + (defun mh-tool-bar-folder-buttons-init () + (when (mh-buffer-exists-p 'mh-folder-mode) + (let* ((load-path (image-load-path-for-library "mh-e" + "mh-logo.xpm")) + (image-load-path (cons (car load-path) + (when (boundp 'image-load-path) + image-load-path)))) + (setq mh-folder-tool-bar-map + (let ((tool-bar-map (make-sparse-keymap))) + ,@(nreverse folder-button-setter) + tool-bar-map)) + (setq mh-folder-seq-tool-bar-map + (let ((tool-bar-map (copy-keymap mh-folder-tool-bar-map))) + ,@(nreverse sequence-button-setter) + tool-bar-map)) + (setq mh-show-tool-bar-map + (let ((tool-bar-map (make-sparse-keymap))) + ,@(nreverse show-button-setter) + tool-bar-map)) + (setq mh-show-seq-tool-bar-map + (let ((tool-bar-map (copy-keymap mh-show-tool-bar-map))) + ,@(nreverse show-seq-button-setter) + tool-bar-map))))) + (defun mh-tool-bar-letter-buttons-init () + (when (mh-buffer-exists-p 'mh-letter-mode) + (let* ((load-path (image-load-path-for-library "mh-e" + "mh-logo.xpm")) + (image-load-path (cons (car load-path) + (when (boundp 'image-load-path) + image-load-path)))) + (setq mh-letter-tool-bar-map + (let ((tool-bar-map (make-sparse-keymap))) + ,@(nreverse letter-button-setter) + tool-bar-map))))) + ;; Custom setter functions + (defun mh-tool-bar-update (mode default-map sequence-map) + "Update `tool-bar-map' in all buffers of MODE. Use SEQUENCE-MAP if display is limited; DEFAULT-MAP otherwise." - (cl-loop for buf in (buffer-list) - do (with-current-buffer buf - (when (eq mode major-mode) ;FIXME: derived-mode-p? - (let ((map (if mh-folder-view-stack - sequence-map - default-map))) - ;; Yes, make-local-variable is necessary since we - ;; get here during initialization when loading - ;; mh-e.el, after the +inbox buffer has been - ;; created, but before mh-folder-mode has run and - ;; created the local map. - (set (make-local-variable 'tool-bar-map) map)))))) - (defun mh-tool-bar-folder-buttons-set (symbol value) - "Construct tool bar for `mh-folder-mode' and `mh-show-mode'." - (set-default symbol value) - (mh-tool-bar-folder-buttons-init) - (mh-tool-bar-update 'mh-folder-mode mh-folder-tool-bar-map - mh-folder-seq-tool-bar-map) - (mh-tool-bar-update 'mh-show-mode mh-show-tool-bar-map - mh-show-seq-tool-bar-map)) - (defun mh-tool-bar-letter-buttons-set (symbol value) - "Construct tool bar for `mh-letter-mode'." - (set-default symbol value) - (mh-tool-bar-letter-buttons-init) - (mh-tool-bar-update 'mh-letter-mode mh-letter-tool-bar-map - mh-letter-tool-bar-map))) + (cl-loop for buf in (buffer-list) + do (with-current-buffer buf + (when (eq mode major-mode) ;FIXME: derived-mode-p? + (let ((map (if mh-folder-view-stack + sequence-map + default-map))) + ;; Yes, make-local-variable is necessary since we + ;; get here during initialization when loading + ;; mh-e.el, after the +inbox buffer has been + ;; created, but before mh-folder-mode has run and + ;; created the local map. + (set (make-local-variable 'tool-bar-map) map)))))) + (defun mh-tool-bar-folder-buttons-set (symbol value) + "Construct tool bar for `mh-folder-mode' and `mh-show-mode'." + (set-default symbol value) + (mh-tool-bar-folder-buttons-init) + (mh-tool-bar-update 'mh-folder-mode mh-folder-tool-bar-map + mh-folder-seq-tool-bar-map) + (mh-tool-bar-update 'mh-show-mode mh-show-tool-bar-map + mh-show-seq-tool-bar-map)) + (defun mh-tool-bar-letter-buttons-set (symbol value) + "Construct tool bar for `mh-letter-mode'." + (set-default symbol value) + (mh-tool-bar-letter-buttons-init) + (mh-tool-bar-update 'mh-letter-mode mh-letter-tool-bar-map + mh-letter-tool-bar-map)) ;; Declare customizable tool bars (custom-declare-variable 'mh-tool-bar-folder-buttons diff --git a/lisp/mh-e/mh-utils.el b/lisp/mh-e/mh-utils.el index 93bc7f8d39..4f211c1286 100644 --- a/lisp/mh-e/mh-utils.el +++ b/lisp/mh-e/mh-utils.el @@ -124,19 +124,18 @@ Ignores case when searching for OLD." ;;;###mh-autoload (defun mh-logo-display () "Modify mode line to display MH-E logo." - (mh-do-in-gnu-emacs - (let* ((load-path (image-load-path-for-library "mh-e" "mh-logo.xpm")) - (image-load-path (cons (car load-path) - (when (boundp 'image-load-path) - image-load-path)))) - (add-text-properties - 0 2 - `(display ,(or mh-logo-cache - (setq mh-logo-cache - (mh-funcall-if-exists - find-image '((:type xpm :ascent center - :file "mh-logo.xpm")))))) - (car mode-line-buffer-identification))))) + (let* ((load-path (image-load-path-for-library "mh-e" "mh-logo.xpm")) + (image-load-path (cons (car load-path) + (when (boundp 'image-load-path) + image-load-path)))) + (add-text-properties + 0 2 + `(display ,(or mh-logo-cache + (setq mh-logo-cache + (mh-funcall-if-exists + find-image '((:type xpm :ascent center + :file "mh-logo.xpm")))))) + (car mode-line-buffer-identification)))) @@ -910,8 +909,7 @@ Handle RFC 822 (or later) continuation lines." (defvar mh-hidden-header-keymap (let ((map (make-sparse-keymap))) - (mh-do-in-gnu-emacs - (define-key map [mouse-2] #'mh-letter-toggle-header-field-display-button)) + (define-key map [mouse-2] #'mh-letter-toggle-header-field-display-button) map)) ;;;###mh-autoload diff --git a/lisp/mh-e/mh-xface.el b/lisp/mh-e/mh-xface.el index 5983353b3d..332f963a04 100644 --- a/lisp/mh-e/mh-xface.el +++ b/lisp/mh-e/mh-xface.el @@ -74,17 +74,16 @@ in this order is used." (when type (goto-char (point-min)) (when (re-search-forward "^from:" (point-max) t) - (mh-do-in-gnu-emacs - (if (eq type 'url) - (mh-x-image-url-display url) - (mh-funcall-if-exists - insert-image (create-image - raw type t - :foreground - (face-foreground 'mh-show-xface nil t) - :background - (face-background 'mh-show-xface nil t)) - " ")))))))) + (if (eq type 'url) + (mh-x-image-url-display url) + (mh-funcall-if-exists + insert-image (create-image + raw type t + :foreground + (face-foreground 'mh-show-xface nil t) + :background + (face-background 'mh-show-xface nil t)) + " "))))))) (defun mh-face-to-png (data) "Convert base64 encoded DATA to png image." @@ -143,9 +142,8 @@ The directories are searched for in the order they appear in the list.") (defvar mh-picon-image-types (cl-loop for type in '(xpm xbm gif) - when (or (mh-do-in-gnu-emacs - (ignore-errors - (image-type-available-p type)))) + when (ignore-errors + (image-type-available-p type)) collect type)) (autoload 'message-tokenize-header "sendmail") @@ -370,8 +368,7 @@ filenames. In addition, replaces * with %2a. See URL (when (and (file-readable-p image) (not (file-symlink-p image)) (eq marker mh-x-image-marker)) (goto-char marker) - (mh-do-in-gnu-emacs - (insert-image (create-image image 'png)))) + (insert-image (create-image image 'png))) (set-buffer-modified-p buffer-modified-flag))))) (defun mh-x-image-url-fetch-image (url cache-file marker sentinel) commit 392d6708a5b0a1b291f50986cb31552c9d4786df Author: Stefan Kangas Date: Mon Oct 11 15:10:26 2021 +0200 Fontify "print" and "exec" as functions in python-mode This change was first made on master, but on closer consideration it is better to fix this bug already in Emacs 28.1. * lisp/progmodes/python.el (python-font-lock-keywords-level-2): Fontify "print" and "exec" as functions, which is the case in Python 3. (Bug#43298) Do not merge to master. diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index c58ac6f637..de6cfcb1ce 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -555,9 +555,6 @@ class declarations.") "assert" "else" "if" "pass" "yield" "break" "except" "import" "class" "in" "raise" "continue" "finally" "is" "return" "def" "for" "lambda" "try" - ;; Python 2: - "print" "exec" - ;; Python 3: ;; False, None, and True are listed as keywords on the Python 3 ;; documentation, but since they also qualify as constants they are ;; fontified like that in order to keep font-lock consistent between commit b3d0f53b296a0876ec7a55ae840868e65ed54e14 Author: Stefan Kangas Date: Mon Oct 11 21:20:55 2021 +0200 * lisp/progmodes/python.el: Bump package version to 0.28. diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index de6cfcb1ce..1b55db0950 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -4,7 +4,7 @@ ;; Author: Fabián E. Gallina ;; URL: https://github.com/fgallina/python.el -;; Version: 0.27.1 +;; Version: 0.28 ;; Package-Requires: ((emacs "24.2") (cl-lib "1.0")) ;; Maintainer: emacs-devel@gnu.org ;; Created: Jul 2010 commit 47e09d1855488a9fa4608ef6c6da64dff58fc871 Author: Juri Linkov Date: Mon Oct 11 21:27:50 2021 +0300 Copy parent face attributes to tab-line-tab-current instead of inheriting face * lisp/tab-line.el (tab-line-tab-current): Don't inherit face from 'tab-line-tab' to not inherit the face attribute :height from 'tab-line', because :height of mouse-face is added to the base face. Copy here most of the parent face attributes (bug#50798). diff --git a/lisp/tab-line.el b/lisp/tab-line.el index 890d1243e7..78c06bbb64 100644 --- a/lisp/tab-line.el +++ b/lisp/tab-line.el @@ -119,7 +119,11 @@ function `tab-line-tab-face-group'." :group 'tab-line-faces) (defface tab-line-highlight - '((t :inherit tab-line-tab)) + '((((class color) (min-colors 88)) + :box (:line-width 1 :style released-button) + :background "grey85" + :foreground "black") + (t :inverse-video nil)) "Tab line face for highlighting." :version "27.1" :group 'tab-line-faces) commit d96f8b22c01b330d773cf46eb4c21acbe153633e Author: Martin Rudalics Date: Mon Oct 11 18:58:10 2021 +0200 Another fix for 'ibuffer-shrink-to-fit' (Bug#7218, Bug#51029) * lisp/ibuffer.el (ibuffer-shrink-to-fit): Fit window only if its buffer is in 'ibuffer-mode' (Bug#7218, Bug#51029). diff --git a/lisp/ibuffer.el b/lisp/ibuffer.el index 046595a4d9..e5095455c2 100644 --- a/lisp/ibuffer.el +++ b/lisp/ibuffer.el @@ -1079,8 +1079,8 @@ a new window in the current frame, splitting vertically." ;; Make sure that redisplay is performed, otherwise there can be a ;; bad interaction with code in the window-scroll-functions hook (redisplay t) - (when (and (boundp 'ibuffer-auto-mode) ; ibuf-ext.el might not be loaded yet - (buffer-local-value 'ibuffer-auto-mode (window-buffer))) + (when (with-current-buffer (window-buffer) + (eq major-mode 'ibuffer-mode)) (fit-window-to-buffer nil (and owin (/ (frame-height) commit 2810fe6bfca182e4376d818b5510507d5ff7e1b5 Author: Michael Albinus Date: Mon Oct 11 18:44:28 2021 +0200 ; * test/src/emacs-module-tests.el: Instrument for bug#50902. diff --git a/test/src/emacs-module-tests.el b/test/src/emacs-module-tests.el index 646c7bb270..9765bb109f 100644 --- a/test/src/emacs-module-tests.el +++ b/test/src/emacs-module-tests.el @@ -32,6 +32,11 @@ (require 'help-fns) (require 'subr-x) +;; Catch information for bug#50902. +(when (getenv "EMACS_EMBA_CI") + (start-process-shell-command + "*timeout*" nil (format "sleep 60; kill -ABRT %d" (emacs-pid)))) + (defconst mod-test-emacs (expand-file-name invocation-name invocation-directory) "File name of the Emacs binary currently running.") commit 665a184f872303c6f86935e856e245be835d5554 Author: Michael Albinus Date: Mon Oct 11 10:16:06 2021 +0200 Backport: * doc/misc/tramp.texi (Bug Reports): Describe, how to activate ELPA Tramp. (cherry picked from commit 978e5339e0d4ef98575096bcf3ec2061ad530f27) diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi index 95c744eef6..c2655d6e17 100644 --- a/doc/misc/tramp.texi +++ b/doc/misc/tramp.texi @@ -4294,6 +4294,14 @@ passwords from @file{auth-source.el} (@pxref{Password handling}). The latter does not happen for the @option{sudoedit} method, otherwise it would be unusable. +If you use the GNU ELPA version of @value{tramp}, you must load it +explicitly, because @command{emacs -Q} ignores installed ELPA +packages. Call (version number adapted) + +@example +emacs -Q -l ~/.emacs.d/elpa/tramp-2.4.5.1/tramp-autoloads +@end example + When including @value{tramp}'s messages in the bug report, increase the verbosity level to 6 (@pxref{Traces and Profiles, Traces}) in the @file{~/.emacs} file before repeating steps to the bug. Include the commit 0d374b1b835c5b1edfae16d68da73ff47e75e0e2 Author: Paul Eggert Date: Mon Oct 11 09:23:47 2021 -0700 Work around GCC bug 102671 This is for --enable-gcc-warnings on GCC 11.2.1. * src/window.c, src/timefns.c: Disable -Wanalyzer-null-dereference. diff --git a/src/timefns.c b/src/timefns.c index f0e2e97f55..a9921cdc10 100644 --- a/src/timefns.c +++ b/src/timefns.c @@ -19,6 +19,11 @@ along with GNU Emacs. If not, see . */ #include +/* Work around GCC bug 102671. */ +#if 10 <= __GNUC__ +# pragma GCC diagnostic ignored "-Wanalyzer-null-dereference" +#endif + #include "systime.h" #include "blockinput.h" diff --git a/src/window.c b/src/window.c index a6e8ee0d53..ec3c941c3b 100644 --- a/src/window.c +++ b/src/window.c @@ -20,6 +20,11 @@ along with GNU Emacs. If not, see . */ #include +/* Work around GCC bug 102671. */ +#if 10 <= __GNUC__ +# pragma GCC diagnostic ignored "-Wanalyzer-null-dereference" +#endif + #include "lisp.h" #include "buffer.h" #include "keyboard.h" commit c9a8805ea4cc8748fd21e6dd9ed9cc6fdf3f0871 Author: Glenn Morris Date: Mon Oct 11 08:22:00 2021 -0700 Fix merge error for elisp-mode-tests.el * test/lisp/progmodes/elisp-mode-tests.el (test-cl-flet-indentation): Delete test mistakenly restored by merge conflict. It seems this was deleted 2021-10-01 with incomplete log message "Add more indentation tests". diff --git a/test/lisp/progmodes/elisp-mode-tests.el b/test/lisp/progmodes/elisp-mode-tests.el index 4d339934f8..a16d2921ea 100644 --- a/test/lisp/progmodes/elisp-mode-tests.el +++ b/test/lisp/progmodes/elisp-mode-tests.el @@ -1101,17 +1101,5 @@ evaluation of BODY." (emacs-lisp-mode) (indent-region (point-min) (point-max))))) -(ert-deftest test-cl-flet-indentation () - :expected-result :failed ; FIXME: bug#9622 - (should (equal - (with-temp-buffer - (emacs-lisp-mode) - (insert "(cl-flet ((bla (x)\n(* x x)))\n(bla 42))") - (indent-region (point-min) (point-max)) - (buffer-string)) - "(cl-flet ((bla (x) - (* x x))) - (bla 42))"))) - (provide 'elisp-mode-tests) ;;; elisp-mode-tests.el ends here commit 98f10f47a7da964d75a23f6912b35b6ef472b123 Merge: cc8c114b16 ac06608878 Author: Glenn Morris Date: Mon Oct 11 08:04:57 2021 -0700 Merge from origin/emacs-28 ac06608878 (origin/emacs-28) Release ERC 5.4 a1a589d07b * etc/ERC-NEWS: Announce ERC's addition to GNU ELPA. 6c7947f0a1 * etc/ERC-NEWS: Fix outline level for the recent additions. c480b68644 Add ERC entries for 'customize-package-emacs-version-alist' 4afff515c8 Expand the full file name 36a485a1af Obsolete XEmacs compat convention in 'erc-button-press-but... commit cc8c114b168e52dfb5a6091372c8a057b81c2f95 Merge: 8aceb37b47 31d60488ac Author: Glenn Morris Date: Mon Oct 11 08:04:57 2021 -0700 ; Merge from origin/emacs-28 The following commit was skipped: 31d60488ac Backport: Add ERC version to protocol log commit 8aceb37b47a8f97fc42caaaf021ac06dc9f67827 Merge: 395273773c 1a1b206a8b Author: Glenn Morris Date: Mon Oct 11 08:04:57 2021 -0700 Merge from origin/emacs-28 1a1b206a8b Adapt the recent 'num_processors' change to MS-Windows 7cb4637923 Minor fix to clarify a sentence in emacs-lisp-intro ab60144ea3 ; Pacify recent shorthand unused lexarg warnings. e9df86004f Make tty-run-terminal-initialization load the .elc file (i... 07edc28bdb Fix ert errors when there's a test that binds `debug-on-er... 96278de8ac New function num-processors 575e626105 Add symbol property 'save-some-buffers-function' (bug#46374) a3e10af95c Keep reading when typed RET in read-char-from-minibuffer a... 013e3be832 * lisp/userlock.el (ask-user-about-supersession-threat): A... ae61d7a57d Fix point positioning on mouse clicks with non-zero line-h... 4c7e74c386 Complete shorthands to longhands for symbol-completing tables c2513c5d0d Add new failing test for bug#51089 1d1e96377c ; * lisp/emacs-lisp/shortdoc.el: Fix typo. 6bf29072e9 Avoid mapping file names through 'substring' bcce93f04c Update to Org 9.5-46-gb71474 5d408f1a24 Expanded testing of MH-E with multiple MH variants b497add971 Fix Seccomp filter for newer GNU/Linux systems (Bug#51073). 75d9fbec88 Tramp code cleanup # Conflicts: # etc/NEWS # test/lisp/progmodes/elisp-mode-tests.el commit ac066088780d473f883e2afe8d178e2bf2c964fd Author: Amin Bandali Date: Mon Oct 11 10:29:35 2021 -0400 Release ERC 5.4 * lisp/erc/erc.el (Version, erc-version): Bump to 5.4. (customize-package-emacs-version-alist): Add entry for 5.4. diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index d3c8b62fb3..885d311cf3 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -12,7 +12,7 @@ ;; David Edmondson (dme@dme.org) ;; Michael Olson (mwolson@gnu.org) ;; Kelvin White (kwhite@gnu.org) -;; Version: 5.3 +;; Version: 5.4 ;; Package-Requires: ((emacs "27.1")) ;; Keywords: IRC, chat, client, Internet ;; URL: https://www.gnu.org/software/emacs/erc.html @@ -69,7 +69,7 @@ (require 'iso8601) (eval-when-compile (require 'subr-x)) -(defconst erc-version "5.3" +(defconst erc-version "5.4" "This version of ERC.") (defvar erc-official-location @@ -82,7 +82,8 @@ (add-to-list 'customize-package-emacs-version-alist '(ERC ("5.2" . "22.1") - ("5.3" . "23.1"))) + ("5.3" . "23.1") + ("5.4" . "28.1"))) (defgroup erc nil "Emacs Internet Relay Chat client." commit a1a589d07b169d56fdd78e314646d6f37167ea95 Author: Amin Bandali Date: Mon Oct 11 10:25:08 2021 -0400 * etc/ERC-NEWS: Announce ERC's addition to GNU ELPA. diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS index 5225c62e55..f533c58aa4 100644 --- a/etc/ERC-NEWS +++ b/etc/ERC-NEWS @@ -27,6 +27,13 @@ to Emacs versions before 28, to avoid modifying the NEWS file for all of those releases, the ERC NEWS entries have only been copied below, and the NEWS.* files were left intact. +** ERC is now available on GNU ELPA. +Starting with ERC 5.4, in addition to being distributed with GNU Emacs +itself, ERC is also included in GNU ELPA, allowing users to enjoy the +improvements of newer ERC versions on older Emacs versions as well. + +ERC's package page on GNU ELPA: https://elpa.gnu.org/packages/erc.html + ** New option 'erc-rename-buffers'. ** New faces 'erc-my-nick-prefix-face' and 'erc-nick-prefix-face'. commit 6c7947f0a1e4f259cce5f99d1fe66b399b684f54 Author: Amin Bandali Date: Mon Oct 11 10:13:56 2021 -0400 * etc/ERC-NEWS: Fix outline level for the recent additions. diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS index 5a2f30ad8c..5225c62e55 100644 --- a/etc/ERC-NEWS +++ b/etc/ERC-NEWS @@ -27,67 +27,67 @@ to Emacs versions before 28, to avoid modifying the NEWS file for all of those releases, the ERC NEWS entries have only been copied below, and the NEWS.* files were left intact. -*** New option 'erc-rename-buffers'. +** New option 'erc-rename-buffers'. -*** New faces 'erc-my-nick-prefix-face' and 'erc-nick-prefix-face'. +** New faces 'erc-my-nick-prefix-face' and 'erc-nick-prefix-face'. -*** 'erc-format-@nick' displays all user modes instead of only op and voice. +** 'erc-format-@nick' displays all user modes instead of only op and voice. -*** The display of irc commands in the current buffer has been disabled. +** The display of irc commands in the current buffer has been disabled. -*** 'erc-version' now follows the Emacs version. +** 'erc-version' now follows the Emacs version. -*** ERC can now hide message types by network or channel. +** ERC can now hide message types by network or channel. 'erc-hide-list' will hide all messages of the specified type, while 'erc-network-hide-list' and 'erc-channel-hide-list' will only hide the specified message types for the respective specified targets. -*** Reconnection is now asynchronous. +** Reconnection is now asynchronous. -*** Nick completion is now case-insensitive again after inadvertently +** Nick completion is now case-insensitive again after inadvertently being made case-sensitive in Emacs 24.2. -*** New variable 'erc-default-port-tls' used to connect to TLS IRC +** New variable 'erc-default-port-tls' used to connect to TLS IRC servers. -*** New hook 'erc-insert-done-hook'. +** New hook 'erc-insert-done-hook'. This hook is called after strings have been inserted into the buffer, and is free to alter point and window configurations, as it's not called from inside a 'save-excursion', as opposed to 'erc-insert-post-hook'. -*** 'erc-button-google-url' has been renamed to 'erc-button-search-url' +** 'erc-button-google-url' has been renamed to 'erc-button-search-url' and its value has been changed to Duck Duck Go. -*** 'erc-send-pre-hook' and 'erc-send-this' have been obsoleted. +** 'erc-send-pre-hook' and 'erc-send-this' have been obsoleted. The user option to use instead to alter text to be sent is now 'erc-pre-send-functions'. -*** Improve matching/highlighting of nicknames. +** Improve matching/highlighting of nicknames. Open and close parenthesis and apostrophe are not considered valid nick characters anymore, matching the given grammar in RFC 2812 section 2.3.1. This enables correct matching and highlighting of nicks when they are surrounded by parentheses, like "(nick)", and when adjacent to an apostrophe, like "nick's". -*** Set 'erc-button-url-regexp' to 'browse-url-button-regexp' +** Set 'erc-button-url-regexp' to 'browse-url-button-regexp' which better handles surrounding pair of parentheses. -*** New function 'erc-switch-to-buffer-other-window' +** New function 'erc-switch-to-buffer-other-window' which is like 'erc-switch-to-buffer', but opens the buffer in another window. -*** New function 'erc-track-switch-buffer-other-window' +** New function 'erc-track-switch-buffer-other-window' which is like 'erc-track-switch-buffer', but opens the buffer in another window. -*** NickServ passwords can now be retrieved from auth-source. +** NickServ passwords can now be retrieved from auth-source. The 'erc-use-auth-source-for-nickserv-password' user option enables querying auth-source for NickServ passwords. To enable this, add the following to your init file: (setq erc-use-auth-source-for-nickserv-password t) -*** NickServ identification now prompts for password last. +** NickServ identification now prompts for password last. When 'erc-prompt-for-nickserv-password' is non-nil, the user used to be unconditionally prompted interactively for a password, regardless of the value of 'erc-nickserv-passwords', which was effectively @@ -96,24 +96,24 @@ ignored (same for the new lifted, and the user is interactively prompted last, after the other identification methods have run. -*** The '/ignore' command will now ask for a timeout to stop ignoring the user. +** The '/ignore' command will now ask for a timeout to stop ignoring the user. Allowed inputs are seconds or ISO8601-like periods like "1h" or "4h30m". -*** ERC now recognizes 'C-]' for italic text. +** ERC now recognizes 'C-]' for italic text. Italic text is displayed in the new 'erc-italic-face'. -*** erc-match.el now supports 'message' highlight type (not including the nick). +** erc-match.el now supports 'message' highlight type (not including the nick). The 'erc-current-nick-highlight-type', 'erc-pal-highlight-type', 'erc-fool-highlight-type', 'erc-keyword-highlight-type', and 'erc-dangerous-host-highlight-type' user options now support a 'message' type for highlighting the entire message but not the sender's nick. -*** erc-status-sidebar.el is now part of ERC. +** erc-status-sidebar.el is now part of ERC. The 'erc-status-sidebar' package which provides a HexChat-like activity overview sidebar for joined IRC channels is now part of ERC. -*** erc-tls now supports specifying a TLS client certificate. +** erc-tls now supports specifying a TLS client certificate. The 'erc-tls' function has been updated to allow specifying a TLS client certificate for authentication, as an alternative to NickServ password-based authentication. This is referred to as "CertFP" (short @@ -122,7 +122,7 @@ node "(erc) Connecting" in the ERC manual for more details and examples on how to specify and use TLS client certificates with 'erc-tls'. -*** Update IRC-related references to point to Libera.Chat. +** Update IRC-related references to point to Libera.Chat. The Free Software Foundation and the GNU Project have moved their official IRC channels from the Freenode network to Libera.Chat. For the original announcement and the follow-up update, including @@ -138,18 +138,18 @@ now been updated to point to Libera.Chat. https://lists.gnu.org/archive/html/info-gnu-emacs/2021-06/msg00000.html -*** Add 'erc-track-select-mode-line-face' (obsoletes 'erc-track-find-face'). +** Add 'erc-track-select-mode-line-face' (obsoletes 'erc-track-find-face'). The 'erc-track-find-face' function of the erc-track module has been declared obsolete and rewritten as 'erc-track-select-mode-line-face', with different expected arguments (the current and old faces are now separated) and clearer documentation. -*** Add '/opme' and '/deopme' convenience commands. +** Add '/opme' and '/deopme' convenience commands. The new '/opme' convenience command asks ChanServ to set the operator status for the current nick in the current channel, and '/deopme' unsets it. -*** Add '/wii' convenience command for whois with idle time. +** Add '/wii' convenience command for whois with idle time. The new '/wii' convenience command calls the '/whois' command with the given nick as both arguments, which is useful for displaying the whois information for the nick along with idle time, even if the nick is on @@ -157,7 +157,7 @@ a different server than the one the current user is connected to. Using the given nick itself instead of the server it is connected to is not standardized, but is widely supported across IRC networks. -*** Add 'erc-bug' command for reporting ERC bugs. +** Add 'erc-bug' command for reporting ERC bugs. The new 'erc-bug' command prompts for a subject, and passes it on to 'report-emacs-bug' along with the current ERC version, and adds the ERC mailing list in Cc. commit c480b6864426a81b702b720bdacafc5ff13bdbc3 Author: Amin Bandali Date: Mon Oct 11 10:04:44 2021 -0400 Add ERC entries for 'customize-package-emacs-version-alist' * lisp/erc/erc.el (customize-package-emacs-version-alist): Add entries for existing ERC versions. diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 4a86fa712a..d3c8b62fb3 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -76,6 +76,14 @@ "https://www.gnu.org/software/emacs/erc.html (mailing list: emacs-erc@gnu.org)" "Location of the ERC client on the Internet.") +;; Map each :package-version to the associated Emacs version. +;; (This eliminates the need for explicit :version keywords on the +;; custom definitions.) +(add-to-list + 'customize-package-emacs-version-alist + '(ERC ("5.2" . "22.1") + ("5.3" . "23.1"))) + (defgroup erc nil "Emacs Internet Relay Chat client." :link '(url-link "https://www.gnu.org/software/emacs/erc.html") commit 4afff515c870339bdb3fccab4175b063770eb4bf Author: Dmitry Gutov Date: Mon Oct 11 16:37:55 2021 +0300 Expand the full file name * lisp/vc/vc-git.el (vc-git--literal-pathspec): Expand the full file name, not just the local part (bug#51112). diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el index eca8d547a9..35c0838dd6 100644 --- a/lisp/vc/vc-git.el +++ b/lisp/vc/vc-git.el @@ -242,15 +242,14 @@ included in the completions." ;;;###autoload (load "vc-git" nil t) ;;;###autoload (vc-git-registered file)))) +;; Good example of file name that needs this: "test[56].xx". (defun vc-git--literal-pathspec (file) "Prepend :(literal) path magic to FILE." - ;; Good example of file name that needs this: "test[56].xx". (when file - (let ((lname (file-local-name file))) - ;; Expand abbreviated file names. - (when (file-name-absolute-p lname) - (setq lname (expand-file-name lname))) - (concat ":(literal)" lname)))) + ;; Expand abbreviated file names. + (when (file-name-absolute-p file) + (setq file (expand-file-name file))) + (concat ":(literal)" (file-local-name file)))) (defun vc-git--literal-pathspecs (files) "Prepend :(literal) path magic to FILES." commit 36a485a1afb6b352ddb2d036d5ca430f4c6fdd10 Author: Stefan Kangas Date: Mon Oct 11 09:39:17 2021 -0400 Obsolete XEmacs compat convention in 'erc-button-press-button' * lisp/erc/erc-button.el (erc-button-press-button): Advertise new calling convention without XEmacs compatibility. diff --git a/lisp/erc/erc-button.el b/lisp/erc/erc-button.el index 17d5b6129d..69972856d1 100644 --- a/lisp/erc/erc-button.el +++ b/lisp/erc/erc-button.el @@ -389,12 +389,11 @@ REGEXP is the regular expression which matched for this button." (mouse-set-point event) (erc-button-press-button))) -;; XEmacs calls this via widget-button-press with a bunch of arguments -;; which we don't care about. (defun erc-button-press-button (&rest _ignore) "Check text at point for a callback function. If the text at point has a `erc-callback' property, call it with the value of the `erc-data' text property." + (declare (advertised-calling-convention () "28.1")) (interactive) (let* ((data (get-text-property (point) 'erc-data)) (fun (get-text-property (point) 'erc-callback))) commit 395273773cb7035358cdd7c87f9102af75e39915 Author: Amin Bandali Date: Mon Oct 11 09:34:41 2021 -0400 Revert "Obsolete XEmacs compat convention in erc-button-press-button" This reverts commit f146325bd1556d1acafe26f6c263b83a92d3cd20. This should be done in 'emacs-28', which will be merged into 'master'. diff --git a/lisp/erc/erc-button.el b/lisp/erc/erc-button.el index 2c1d7000e9..17d5b6129d 100644 --- a/lisp/erc/erc-button.el +++ b/lisp/erc/erc-button.el @@ -389,11 +389,12 @@ REGEXP is the regular expression which matched for this button." (mouse-set-point event) (erc-button-press-button))) +;; XEmacs calls this via widget-button-press with a bunch of arguments +;; which we don't care about. (defun erc-button-press-button (&rest _ignore) "Check text at point for a callback function. If the text at point has a `erc-callback' property, call it with the value of the `erc-data' text property." - (declare (advertised-calling-convention () "29.1")) (interactive) (let* ((data (get-text-property (point) 'erc-data)) (fun (get-text-property (point) 'erc-callback))) commit 31d60488ac681eddd4cc504c93047e681c9cc707 Author: F. Jason Park Date: Sat Oct 9 14:59:43 2021 +0200 Backport: Add ERC version to protocol log * lisp/erc/erc.el (erc-toggle-debug-irc-protocol): Include the erc version in the debug logs (bug#51107). (cherry picked from commit 13411346202f86e950bee076a5d528e98695fbb4) diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 3462aa4db0..4a86fa712a 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -2388,6 +2388,7 @@ If ARG is non-nil, show the *erc-protocol* buffer." (let ((inhibit-read-only t) (msg (list (concat "Version: " erc-debug-irc-protocol-version) + (concat "ERC-Version: " erc-version) (concat "Emacs-Version: " emacs-version) (erc-make-notice (concat "This buffer displays all IRC protocol " commit 9f9c9f934ac9abed84290df410431e393cd542a8 Author: Stefan Kangas Date: Mon Oct 11 15:10:26 2021 +0200 Fontify "print" and "exec" as functions in python-mode * lisp/progmodes/python.el (python-font-lock-keywords-level-2): Fontify "print" and "exec" as functions, which is the case in Python 3. (Bug#43298) diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index b1f61c89a4..4ee8c6279a 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -555,9 +555,6 @@ class declarations.") "assert" "else" "if" "pass" "yield" "break" "except" "import" "class" "in" "raise" "continue" "finally" "is" "return" "def" "for" "lambda" "try" - ;; Python 2: - "print" "exec" - ;; Python 3: ;; False, None, and True are listed as keywords on the Python 3 ;; documentation, but since they also qualify as constants they are ;; fontified like that in order to keep font-lock consistent between commit 1a1b206a8b33dc597fe2153a59fa30baacf1dcc8 Author: Eli Zaretskii Date: Mon Oct 11 15:56:31 2021 +0300 Adapt the recent 'num_processors' change to MS-Windows * nt/gnulib-cfg.mk (OMIT_GNULIB_MODULE_nproc): Omit nproc. * src/w32.c (num_processors): New function. * src/w32proc.c (Fw32_get_nproc): Remove. diff --git a/nt/gnulib-cfg.mk b/nt/gnulib-cfg.mk index f1f4c4c279..e9f00e748e 100644 --- a/nt/gnulib-cfg.mk +++ b/nt/gnulib-cfg.mk @@ -73,3 +73,4 @@ OMIT_GNULIB_MODULE_lchmod = true OMIT_GNULIB_MODULE_futimens = true OMIT_GNULIB_MODULE_utimensat = true OMIT_GNULIB_MODULE_file-has-acl = true +OMIT_GNULIB_MODULE_nproc = true diff --git a/src/w32.c b/src/w32.c index 0eb69d4b1d..9fe698d28d 100644 --- a/src/w32.c +++ b/src/w32.c @@ -39,6 +39,7 @@ along with GNU Emacs. If not, see . */ #include #include #include +#include /* Include (most) CRT headers *before* ms-w32.h. */ #include @@ -1962,6 +1963,16 @@ w32_get_nproc (void) return num_of_processors; } +/* Emulate Gnulib's 'num_processors'. We cannot use the Gnulib + version because it unconditionally calls APIs that aren't available + on old MS-Windows versions. */ +unsigned long +num_processors (enum nproc_query query) +{ + /* We ignore QUERY. */ + return w32_get_nproc (); +} + static void sample_system_load (ULONGLONG *idle, ULONGLONG *kernel, ULONGLONG *user) { diff --git a/src/w32proc.c b/src/w32proc.c index 3b7d92a2aa..360f45e9e1 100644 --- a/src/w32proc.c +++ b/src/w32proc.c @@ -3878,15 +3878,6 @@ w32_compare_strings (const char *s1, const char *s2, char *locname, return val - 2; } -/* FIXME: Remove, merging any of its special features into num-processors. */ -DEFUN ("w32-get-nproc", Fw32_get_nproc, - Sw32_get_nproc, 0, 0, 0, - doc: /* Return the number of system's processor execution units. */) - (void) -{ - return make_fixnum (w32_get_nproc ()); -} - void syms_of_ntproc (void) @@ -3921,8 +3912,6 @@ syms_of_ntproc (void) defsubr (&Sw32_get_keyboard_layout); defsubr (&Sw32_set_keyboard_layout); - defsubr (&Sw32_get_nproc); - DEFVAR_LISP ("w32-quote-process-args", Vw32_quote_process_args, doc: /* Non-nil enables quoting of process arguments to ensure correct parsing. Because Windows does not directly pass argv arrays to child processes, commit 7cb463792334d6f59cdfc89165bac2d7783e3913 Author: Stefan Kangas Date: Mon Oct 11 14:43:11 2021 +0200 Minor fix to clarify a sentence in emacs-lisp-intro * doc/lispintro/emacs-lisp-intro.texi (Simple Extension): Add the word "that" for clarity. (Bug#43965) diff --git a/doc/lispintro/emacs-lisp-intro.texi b/doc/lispintro/emacs-lisp-intro.texi index 32c39c7261..6ecd552ebb 100644 --- a/doc/lispintro/emacs-lisp-intro.texi +++ b/doc/lispintro/emacs-lisp-intro.texi @@ -17456,9 +17456,9 @@ Manual}, for more information. @findex line-to-top-of-window @cindex Simple extension in @file{.emacs} file -Here is a simple extension to Emacs that moves the line point is on to -the top of the window. I use this all the time, to make text easier -to read. +Here is a simple extension to Emacs that moves the line that point is +on to the top of the window. I use this all the time, to make text +easier to read. You can put the following code into a separate file and then load it from your @file{.emacs} file, or you can include it within your commit e63b49a30bf0993188a577715ef742f0545bbdd7 Author: Lars Ingebrigtsen Date: Mon Oct 11 14:42:33 2021 +0200 Mention --fingerprint in NEWS diff --git a/etc/NEWS b/etc/NEWS index 010a6e51e3..fe6f21fec2 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -27,6 +27,10 @@ applies, and please also update docstrings as needed. * Startup Changes in Emacs 29.1 ++++ +** Emacs now has a --fingerprint option. +This will output a string identifying the current Emacs build. + * Changes in Emacs 29.1 commit e81f1faca4382ed5c8f15fec84fb7c900a5468f9 Author: Glenn Morris Date: Mon Oct 11 14:03:26 2021 +0200 Make the installed pmdp file use a fingerprint * Makefile.in (EMACS_PDMP): Use --fingerprint. * doc/emacs/cmdargs.texi (Action Arguments): Document --fingerprint. * src/emacs.c (load_pdump): Load the fingerprinted version of the pdmp file (bug#42790). (main): Support --fingerprint. * src/pdumper.c (dump_fingerprint): Make non-static. * src/pdumper.h: Declare dump_fingerprint. diff --git a/Makefile.in b/Makefile.in index 5fc1edc7a3..c6c507fd42 100644 --- a/Makefile.in +++ b/Makefile.in @@ -313,6 +313,7 @@ TRANSFORM = @program_transform_name@ EMACS_NAME = `echo emacs | sed '$(TRANSFORM)'` EMACS = ${EMACS_NAME}${EXEEXT} EMACSFULL = `echo emacs-${version} | sed '$(TRANSFORM)'`${EXEEXT} +EMACS_PDMP = `./src/emacs${EXEEXT} --fingerprint 2>&1 | sed 's/.* //'`.pdmp # Subdirectories to make recursively. SUBDIR = $(NTDIR) lib lib-src src lisp @@ -521,7 +522,7 @@ install-arch-dep: src install-arch-indep install-etcdoc install-$(NTDIR) ifeq (${ns_self_contained},no) ${INSTALL_PROGRAM} $(INSTALL_STRIP) src/emacs${EXEEXT} "$(DESTDIR)${bindir}/$(EMACSFULL)" ifeq (${DUMPING},pdumper) - ${INSTALL_DATA} src/emacs.pdmp "$(DESTDIR)${libexecdir}/emacs/${version}/${configuration}"/emacs.pdmp + ${INSTALL_DATA} src/emacs.pdmp "$(DESTDIR)${libexecdir}/emacs/${version}/${configuration}"/emacs-${EMACS_PDMP} endif -chmod 755 "$(DESTDIR)${bindir}/$(EMACSFULL)" ifndef NO_BIN_LINK diff --git a/doc/emacs/cmdargs.texi b/doc/emacs/cmdargs.texi index d5177faea9..313682bdc3 100644 --- a/doc/emacs/cmdargs.texi +++ b/doc/emacs/cmdargs.texi @@ -185,6 +185,11 @@ successfully. @item --version @opindex --version Print Emacs version, then exit successfully. + +@item --fingerprint +@opindex --fingerprint +Print the Emacs ``fingerprint'', which is used to uniquely identify +the compiled version of Emacs. @end table @node Initial Options diff --git a/src/emacs.c b/src/emacs.c index 866e43fda9..cda7a9bf77 100644 --- a/src/emacs.c +++ b/src/emacs.c @@ -133,6 +133,7 @@ extern char etext; #endif #include "pdumper.h" +#include "fingerprint.h" #include "epaths.h" static const char emacs_version[] = PACKAGE_VERSION; @@ -255,6 +256,7 @@ Initialization options:\n\ #ifdef HAVE_PDUMPER "\ --dump-file FILE read dumped state from FILE\n\ +--fingerprint output fingerprint and exit\n\ ", #endif #if SECCOMP_USABLE @@ -830,6 +832,8 @@ load_pdump (int argc, char **argv) const char *const suffix = ".pdmp"; int result; char *emacs_executable = argv[0]; + ptrdiff_t hexbuf_size; + char *hexbuf; const char *strip_suffix = #if defined DOS_NT || defined CYGWIN ".exe" @@ -927,9 +931,15 @@ load_pdump (int argc, char **argv) /* Look for "emacs.pdmp" in PATH_EXEC. We hardcode "emacs" in "emacs.pdmp" so that the Emacs binary still works if the user copies and renames it. */ + hexbuf_size = 2 * sizeof fingerprint; + hexbuf = xmalloc (hexbuf_size + 1); + hexbuf_digest (hexbuf, (char *)fingerprint, sizeof fingerprint); + hexbuf[hexbuf_size] = '\0'; needed = (strlen (path_exec) + 1 + strlen (argv0_base) + + 1 + + strlen (hexbuf) + strlen (suffix) + 1); if (bufsize < needed) @@ -937,8 +947,8 @@ load_pdump (int argc, char **argv) xfree (dump_file); dump_file = xpalloc (NULL, &bufsize, needed - bufsize, -1, 1); } - sprintf (dump_file, "%s%c%s%s", - path_exec, DIRECTORY_SEP, argv0_base, suffix); + sprintf (dump_file, "%s%c%s-%s%s", + path_exec, DIRECTORY_SEP, argv0_base, hexbuf, suffix); #if !defined (NS_SELF_CONTAINED) /* Assume the Emacs binary lives in a sibling directory as set up by the default installation configuration. */ @@ -1387,6 +1397,23 @@ main (int argc, char **argv) exit (0); } +#ifdef HAVE_PDUMPER + if (argmatch (argv, argc, "-fingerprint", "--fingerprint", 4, + NULL, &skip_args)) + { + if (initialized) + { + dump_fingerprint ("fingerprint", (unsigned char *)fingerprint); + exit (0); + } + else + { + fputs ("Not initialized\n", stderr); + exit (1); + } + } +#endif + emacs_wd = emacs_get_current_dir_name (); #ifdef HAVE_PDUMPER if (dumped_with_pdumper_p ()) diff --git a/src/pdumper.c b/src/pdumper.c index 11c680d77b..977f4fb2a8 100644 --- a/src/pdumper.c +++ b/src/pdumper.c @@ -312,7 +312,7 @@ dump_reloc_set_offset (struct dump_reloc *reloc, dump_off offset) error ("dump relocation out of range"); } -static void +void dump_fingerprint (char const *label, unsigned char const xfingerprint[sizeof fingerprint]) { diff --git a/src/pdumper.h b/src/pdumper.h index deec9af046..bc339c42da 100644 --- a/src/pdumper.h +++ b/src/pdumper.h @@ -50,6 +50,9 @@ enum { PDUMPER_NO_OBJECT = -1 }; #define PDUMPER_REMEMBER_SCALAR(thing) \ pdumper_remember_scalar (&(thing), sizeof (thing)) +extern void dump_fingerprint (const char *label, + const unsigned char *xfingerprint); + extern void pdumper_remember_scalar_impl (void *data, ptrdiff_t nbytes); INLINE void commit 932c23f7978cf5e94ed9b6df4969b393f7551716 Author: Lars Ingebrigtsen Date: Mon Oct 11 13:17:38 2021 +0200 Fix menu display of keys when cua-mode is active * lisp/menu-bar.el (menu-bar-edit-menu): Make the menus display the correct keys for editing when cua-mode is active (bug#28930). diff --git a/lisp/menu-bar.el b/lisp/menu-bar.el index 40a1730637..7c9fc1aeba 100644 --- a/lisp/menu-bar.el +++ b/lisp/menu-bar.el @@ -514,7 +514,11 @@ (cdr yank-menu) kill-ring)) (not buffer-read-only)))) - :help "Paste (yank) text most recently cut/copied")) + :help "Paste (yank) text most recently cut/copied" + :keys (lambda () + (if cua-mode + "\\[cua-paste]" + "\\[yank]")))) (bindings--define-key menu [copy] ;; ns-win.el said: Substitute a Copy function that works better ;; under X (for GNUstep). @@ -523,14 +527,23 @@ 'kill-ring-save) :enable mark-active :help "Copy text in region between mark and current position" - :keys ,(if (featurep 'ns) - "\\[ns-copy-including-secondary]" - "\\[kill-ring-save]"))) + :keys (lambda () + (cond + ((featurep 'ns) + "\\[ns-copy-including-secondary]") + ((and cua-mode mark-active) + "\\[cua-copy-handler]") + (t + "\\[kill-ring-save]"))))) (bindings--define-key menu [cut] '(menu-item "Cut" kill-region :enable (and mark-active (not buffer-read-only)) :help - "Cut (kill) text in region between mark and current position")) + "Cut (kill) text in region between mark and current position" + :keys (lambda () + (if (and cua-mode mark-active) + "\\[cua-cut-handler]" + "\\[kill-region]")))) ;; ns-win.el said: Separate undo from cut/paste section. (if (featurep 'ns) (bindings--define-key menu [separator-undo] menu-bar-separator)) commit 237b2ecf2d1140d6789822c5de90f9bf2a8ce50c Author: Lars Ingebrigtsen Date: Mon Oct 11 13:16:57 2021 +0200 Change how cua-mode defined `C-x' and `C-c' * lisp/emulation/cua-base.el (cua-cut-handler): (cua-copy-handler): New aliases (bug#28930). (cua--init-keymaps): Use them for `C-x' and `C-c' to be able to distinguish the commands when looking them up in reverse. diff --git a/lisp/emulation/cua-base.el b/lisp/emulation/cua-base.el index 3976c1ea06..a98393fa2e 100644 --- a/lisp/emulation/cua-base.el +++ b/lisp/emulation/cua-base.el @@ -699,6 +699,11 @@ Repeating prefix key when region is active works as a single prefix key." (interactive) (cua--prefix-override-replay 0)) +;; These aliases are so that we can look up the commands and find the +;; correct keys when generating menus. +(defalias 'cua-cut-handler #'cua--prefix-override-handler) +(defalias 'cua-copy-handler #'cua--prefix-override-handler) + (defun cua--prefix-repeat-handler () "Repeating prefix key when region is active works as a single prefix key." (interactive) @@ -1258,10 +1263,8 @@ If ARG is the atom `-', scroll upward by nearly full screen." (define-key cua--cua-keys-keymap [(meta v)] #'delete-selection-repeat-replace-region)) - (define-key cua--prefix-override-keymap [(control x)] - #'cua--prefix-override-handler) - (define-key cua--prefix-override-keymap [(control c)] - #'cua--prefix-override-handler) + (define-key cua--prefix-override-keymap [(control x)] #'cua-cut-handler) + (define-key cua--prefix-override-keymap [(control c)] #'cua-copy-handler) (define-key cua--prefix-repeat-keymap [(control x) (control x)] #'cua--prefix-repeat-handler) commit 74d3a1e7d6450f226d2f942d0c0e3410eea87dfc Author: Lars Ingebrigtsen Date: Mon Oct 11 13:15:41 2021 +0200 Allow :keys in menus to be computed dynamically * doc/lispref/keymaps.texi (Extended Menu Items): Document it (bug#28930). * src/keyboard.c (parse_menu_item): Allow :keys to be a function. diff --git a/doc/lispref/keymaps.texi b/doc/lispref/keymaps.texi index 407bdca5ed..066d8b3693 100644 --- a/doc/lispref/keymaps.texi +++ b/doc/lispref/keymaps.texi @@ -2319,6 +2319,12 @@ This property specifies that @var{string} is the string to display as the keyboard equivalent for this menu item. You can use the @samp{\\[...]} documentation construct in @var{string}. +This property can also be a function (which will be called with no +arguments). This function should return a string. This function will +be called every time the menu is computed, so using a function that +takes a lot of time to compute is not a good idea, and it should +expect to be called from any context. + @item :filter @var{filter-fn} This property provides a way to compute the menu item dynamically. The property value @var{filter-fn} should be a function of one argument; diff --git a/etc/NEWS b/etc/NEWS index b91a5cbb72..010a6e51e3 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -134,6 +134,11 @@ with recent versions of Firefox. * Lisp Changes in Emacs 29.1 ++++ +** :keys in 'menu-item' can now be a function. +If so, it is called whenever the menu is computed, and can be used to +calculate the keys dynamically. + +++ ** New major mode 'clean-mode'. This is a new major mode meant for debugging. It kills absolutely all diff --git a/src/keyboard.c b/src/keyboard.c index 9a50a5e5eb..7184b1509b 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -7841,7 +7841,9 @@ parse_menu_item (Lisp_Object item, int inmenubar) else if (EQ (tem, QCkeys)) { tem = XCAR (item); - if (CONSP (tem) || STRINGP (tem)) + if (FUNCTIONP (tem)) + ASET (item_properties, ITEM_PROPERTY_KEYEQ, call0 (tem)); + else if (CONSP (tem) || STRINGP (tem)) ASET (item_properties, ITEM_PROPERTY_KEYEQ, tem); } else if (EQ (tem, QCbutton) && CONSP (XCAR (item))) commit ab60144ea3fd449aeefa2c67eb75c5ea66044bc1 Author: Basil L. Contovounesios Date: Mon Oct 11 11:55:40 2021 +0100 ; Pacify recent shorthand unused lexarg warnings. diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index 48859585bc..13da7f99a3 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -4116,7 +4116,7 @@ which is at the core of flex logic. The extra (+ (- point (length short)) (length long)))))) -(defun completion-shorthand-all-completions (string table pred _point) +(defun completion-shorthand-all-completions (_string _table _pred _point) ;; no-op: For now, we don't want shorthands to list all the possible ;; locally active longhands. For the completion categories where ;; this style is active, it could hide other more interesting commit e9df86004f9f465658207a3b427c16006f78612b Author: Lars Ingebrigtsen Date: Mon Oct 11 11:22:05 2021 +0200 Make tty-run-terminal-initialization load the .elc file (if any) * lisp/faces.el (tty-run-terminal-initialization): `locate-library' may have found the .el.gz file (bug#51116). diff --git a/lisp/faces.el b/lisp/faces.el index 7b96d938c5..327b0ac01e 100644 --- a/lisp/faces.el +++ b/lisp/faces.el @@ -2289,7 +2289,9 @@ If you set `term-file-prefix' to nil, this function does nothing." (let ((file (locate-library (concat term-file-prefix type)))) (and file (or (assoc file load-history) - (load (file-name-sans-extension file) + (load (replace-regexp-in-string + "\\.el\\(\\.gz\\)?\\'" "" + file) t t))))) type) ;; Next, try to find a matching initialization function, and call it. commit 07edc28bdbfeeaeb1008b4fe21bfda586feae562 Author: Lars Ingebrigtsen Date: Mon Oct 11 11:14:26 2021 +0200 Fix ert errors when there's a test that binds `debug-on-error' * lisp/emacs-lisp/ert.el (ert--run-test-internal): Don't infloop on errors when signalling errors (bug#51131). diff --git a/lisp/emacs-lisp/ert.el b/lisp/emacs-lisp/ert.el index 98cb1fd1cf..b7d984374c 100644 --- a/lisp/emacs-lisp/ert.el +++ b/lisp/emacs-lisp/ert.el @@ -783,6 +783,10 @@ This mainly sets up debugger-related bindings." (ert--run-test-debugger test-execution-info args))) (debug-on-error t) + ;; Don't infloop if the error being called is erroring + ;; out, and we have `debug-on-error' bound to nil inside + ;; the test. + (backtrace-on-error-noninteractive nil) (debug-on-quit t) ;; FIXME: Do we need to store the old binding of this ;; and consider it in `ert--run-test-debugger'? commit 85b8609f9572eb4d9d6d6f856097090513051ab5 Author: Lars Ingebrigtsen Date: Mon Oct 11 10:17:58 2021 +0200 Tweak how auto-fill fills after a period * lisp/textmodes/fill.el (fill-nobreak-p): Don't break immediately after a space after a period (bug#17321). diff --git a/lisp/textmodes/fill.el b/lisp/textmodes/fill.el index decce88573..73d76a8ac6 100644 --- a/lisp/textmodes/fill.el +++ b/lisp/textmodes/fill.el @@ -396,12 +396,8 @@ and `fill-nobreak-invisible'." (save-excursion (skip-chars-backward " ") (and (eq (preceding-char) ?.) - (looking-at " \\([^ ]\\|$\\)")))) - ;; Another approach to the same problem. - (save-excursion - (skip-chars-backward " ") - (and (eq (preceding-char) ?.) - (not (progn (forward-char -1) (looking-at (sentence-end)))))) + ;; There's something more after the space. + (looking-at " [^ \n]")))) ;; Don't split a line if the rest would look like a new paragraph. (unless use-hard-newlines (save-excursion diff --git a/test/lisp/textmodes/fill-tests.el b/test/lisp/textmodes/fill-tests.el index fcc2c75709..2a1195b87e 100644 --- a/test/lisp/textmodes/fill-tests.el +++ b/test/lisp/textmodes/fill-tests.el @@ -76,6 +76,28 @@ (buffer-string) "aaa = baaaaaaaa aaaaaaaaaa\n aaaaaaaaaa\n"))))) +(ert-deftest test-fill-end-period () + (should + (equal + (with-temp-buffer + (text-mode) + (auto-fill-mode) + (insert "Lorem ipsum dolor sit amet, consectetur adipisicing elit, sed do eius.") + (self-insert-command 1 ?\s) + (buffer-string)) + "Lorem ipsum dolor sit amet, consectetur adipisicing elit, sed do eius. ")) + (should + (equal + (with-temp-buffer + (text-mode) + (auto-fill-mode) + (insert "Lorem ipsum dolor sit amet, consectetur adipisicing elit, sed do eius.Foo") + (forward-char -3) + (self-insert-command 1 ?\s) + (buffer-string)) + "Lorem ipsum dolor sit amet, consectetur adipisicing elit, sed do +eius. Foo"))) + (provide 'fill-tests) ;;; fill-tests.el ends here commit 0b63b7e60ab87debb98bbd95c4b15984e4bba124 Merge: 978e5339e0 005c15cdb5 Author: Michael Albinus Date: Mon Oct 11 10:16:49 2021 +0200 Merge branch 'master' of git.sv.gnu.org:/srv/git/emacs commit 978e5339e0d4ef98575096bcf3ec2061ad530f27 Author: Michael Albinus Date: Mon Oct 11 10:16:06 2021 +0200 * doc/misc/tramp.texi (Bug Reports): Describe, how to activate ELPA Tramp. diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi index 95c744eef6..c2655d6e17 100644 --- a/doc/misc/tramp.texi +++ b/doc/misc/tramp.texi @@ -4294,6 +4294,14 @@ passwords from @file{auth-source.el} (@pxref{Password handling}). The latter does not happen for the @option{sudoedit} method, otherwise it would be unusable. +If you use the GNU ELPA version of @value{tramp}, you must load it +explicitly, because @command{emacs -Q} ignores installed ELPA +packages. Call (version number adapted) + +@example +emacs -Q -l ~/.emacs.d/elpa/tramp-2.4.5.1/tramp-autoloads +@end example + When including @value{tramp}'s messages in the bug report, increase the verbosity level to 6 (@pxref{Traces and Profiles, Traces}) in the @file{~/.emacs} file before repeating steps to the bug. Include the commit 96278de8ac2166c37925f2dfbc0eeb6d368142b9 Author: Paul Eggert Date: Sun Oct 10 13:59:16 2021 -0700 New function num-processors This addresses a FIXME comment in lisp/emacs-lisp/comp.el, relating to the number of subsidiary processes used by comp-run-async-workers in native compilation. * admin/merge-gnulib (GNULIB_MODULES): Add nproc. * doc/lispref/processes.texi (Process Information), etc/NEWS: Document num-processors. * lib/gnulib.mk.in, m4/gnulib-comp.m4: Regenerate. * lib/nproc.c, lib/nproc.h, m4/nproc.m4: New files, copied from Gnulib by admin/merge-gnulib. * lisp/emacs-lisp/comp.el (w32-get-nproc): Remove decl. (comp-effective-async-max-jobs): Use num-processors. * src/process.c: Include nproc.h. (Fnum_processors): New function. (syms_of_process): Define ‘all’, ‘current’, ‘num-processors’. * src/w32proc.c (Fw32_get_nproc): Add FIXME comment. * test/src/process-tests.el (process-num-processors): New test. diff --git a/admin/merge-gnulib b/admin/merge-gnulib index 886f37e28c..c9fe3b2f95 100755 --- a/admin/merge-gnulib +++ b/admin/merge-gnulib @@ -39,7 +39,8 @@ GNULIB_MODULES=' free-posix fstatat fsusage fsync futimens getloadavg getopt-gnu getrandom gettime gettimeofday gitlog-to-changelog ieee754-h ignore-value intprops largefile libgmp lstat - manywarnings memmem-simple mempcpy memrchr minmax mkostemp mktime nstrftime + manywarnings memmem-simple mempcpy memrchr minmax mkostemp mktime + nproc nstrftime pathmax pipe2 pselect pthread_sigmask qcopy-acl readlink readlinkat regex sig2str sigdescr_np socklen stat-time std-gnu11 stdalign stddef stdio diff --git a/doc/lispref/processes.texi b/doc/lispref/processes.texi index 90c4215637..d90097d0b0 100644 --- a/doc/lispref/processes.texi +++ b/doc/lispref/processes.texi @@ -1047,6 +1047,19 @@ This function returns a list of all processes that have not been deleted. @end smallexample @end defun +@defun num-processors &optional query +This function returns the number of processors, a positive integer. +Each usable thread execution unit counts as a processor. +By default, the count includes the number of available processors, +which you can override by setting the +@url{https://www.openmp.org/spec-html/5.1/openmpse59.html, +@env{OMP_NUM_THREADS} environment variable of OpenMP}. +If the optional argument @var{query} is @code{current}, +this function ignores @env{OMP_NUM_THREADS}; +if @var{query} is @code{all}, this function also counts processors +that are on the system but are not available to the current process. +@end defun + @defun get-process name This function returns the process named @var{name} (a string), or @code{nil} if there is none. The argument @var{name} can also be a diff --git a/etc/NEWS b/etc/NEWS index 09537d7d31..791248f7dc 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -4094,6 +4094,10 @@ Parse a string as a mail address-like string. ** New function 'make-separator-line'. Make a string appropriate for usage as a visual separator line. ++++ +** New function 'num-processors'. +Return the number of processors on the system. + +++ ** New function 'object-intervals'. This function returns a copy of the list of intervals (i.e., text diff --git a/lib/gnulib.mk.in b/lib/gnulib.mk.in index e9a1a5dc02..c7c7eb455b 100644 --- a/lib/gnulib.mk.in +++ b/lib/gnulib.mk.in @@ -129,6 +129,7 @@ # minmax \ # mkostemp \ # mktime \ +# nproc \ # nstrftime \ # pathmax \ # pipe2 \ @@ -2378,6 +2379,16 @@ EXTRA_libgnu_a_SOURCES += mktime.c endif ## end gnulib module mktime-internal +## begin gnulib module nproc +ifeq (,$(OMIT_GNULIB_MODULE_nproc)) + +libgnu_a_SOURCES += nproc.c + +EXTRA_DIST += nproc.h + +endif +## end gnulib module nproc + ## begin gnulib module nstrftime ifeq (,$(OMIT_GNULIB_MODULE_nstrftime)) diff --git a/lib/nproc.c b/lib/nproc.c new file mode 100644 index 0000000000..a9e369dd3f --- /dev/null +++ b/lib/nproc.c @@ -0,0 +1,403 @@ +/* Detect the number of processors. + + Copyright (C) 2009-2021 Free Software Foundation, Inc. + + This file is free software: you can redistribute it and/or modify + it under the terms of the GNU Lesser General Public License as + published by the Free Software Foundation; either version 2.1 of the + License, or (at your option) any later version. + + This file is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public License + along with this program. If not, see . */ + +/* Written by Glen Lenker and Bruno Haible. */ + +#include +#include "nproc.h" + +#include +#include +#include + +#if HAVE_PTHREAD_GETAFFINITY_NP && 0 +# include +# include +#endif +#if HAVE_SCHED_GETAFFINITY_LIKE_GLIBC || HAVE_SCHED_GETAFFINITY_NP +# include +#endif + +#include + +#if HAVE_SYS_PSTAT_H +# include +#endif + +#if HAVE_SYS_SYSMP_H +# include +#endif + +#if HAVE_SYS_PARAM_H +# include +#endif + +#if HAVE_SYS_SYSCTL_H && ! defined __GLIBC__ +# include +#endif + +#if defined _WIN32 && ! defined __CYGWIN__ +# define WIN32_LEAN_AND_MEAN +# include +#endif + +#include "c-ctype.h" + +#include "minmax.h" + +#define ARRAY_SIZE(a) (sizeof (a) / sizeof ((a)[0])) + +/* Return the number of processors available to the current process, based + on a modern system call that returns the "affinity" between the current + process and each CPU. Return 0 if unknown or if such a system call does + not exist. */ +static unsigned long +num_processors_via_affinity_mask (void) +{ + /* glibc >= 2.3.3 with NPTL and NetBSD 5 have pthread_getaffinity_np, + but with different APIs. Also it requires linking with -lpthread. + Therefore this code is not enabled. + glibc >= 2.3.4 has sched_getaffinity whereas NetBSD 5 has + sched_getaffinity_np. */ +#if HAVE_PTHREAD_GETAFFINITY_NP && defined __GLIBC__ && 0 + { + cpu_set_t set; + + if (pthread_getaffinity_np (pthread_self (), sizeof (set), &set) == 0) + { + unsigned long count; + +# ifdef CPU_COUNT + /* glibc >= 2.6 has the CPU_COUNT macro. */ + count = CPU_COUNT (&set); +# else + size_t i; + + count = 0; + for (i = 0; i < CPU_SETSIZE; i++) + if (CPU_ISSET (i, &set)) + count++; +# endif + if (count > 0) + return count; + } + } +#elif HAVE_PTHREAD_GETAFFINITY_NP && defined __NetBSD__ && 0 + { + cpuset_t *set; + + set = cpuset_create (); + if (set != NULL) + { + unsigned long count = 0; + + if (pthread_getaffinity_np (pthread_self (), cpuset_size (set), set) + == 0) + { + cpuid_t i; + + for (i = 0;; i++) + { + int ret = cpuset_isset (i, set); + if (ret < 0) + break; + if (ret > 0) + count++; + } + } + cpuset_destroy (set); + if (count > 0) + return count; + } + } +#elif HAVE_SCHED_GETAFFINITY_LIKE_GLIBC /* glibc >= 2.3.4 */ + { + cpu_set_t set; + + if (sched_getaffinity (0, sizeof (set), &set) == 0) + { + unsigned long count; + +# ifdef CPU_COUNT + /* glibc >= 2.6 has the CPU_COUNT macro. */ + count = CPU_COUNT (&set); +# else + size_t i; + + count = 0; + for (i = 0; i < CPU_SETSIZE; i++) + if (CPU_ISSET (i, &set)) + count++; +# endif + if (count > 0) + return count; + } + } +#elif HAVE_SCHED_GETAFFINITY_NP /* NetBSD >= 5 */ + { + cpuset_t *set; + + set = cpuset_create (); + if (set != NULL) + { + unsigned long count = 0; + + if (sched_getaffinity_np (getpid (), cpuset_size (set), set) == 0) + { + cpuid_t i; + + for (i = 0;; i++) + { + int ret = cpuset_isset (i, set); + if (ret < 0) + break; + if (ret > 0) + count++; + } + } + cpuset_destroy (set); + if (count > 0) + return count; + } + } +#endif + +#if defined _WIN32 && ! defined __CYGWIN__ + { /* This works on native Windows platforms. */ + DWORD_PTR process_mask; + DWORD_PTR system_mask; + + if (GetProcessAffinityMask (GetCurrentProcess (), + &process_mask, &system_mask)) + { + DWORD_PTR mask = process_mask; + unsigned long count = 0; + + for (; mask != 0; mask = mask >> 1) + if (mask & 1) + count++; + if (count > 0) + return count; + } + } +#endif + + return 0; +} + + +/* Return the total number of processors. Here QUERY must be one of + NPROC_ALL, NPROC_CURRENT. The result is guaranteed to be at least 1. */ +static unsigned long int +num_processors_ignoring_omp (enum nproc_query query) +{ + /* On systems with a modern affinity mask system call, we have + sysconf (_SC_NPROCESSORS_CONF) + >= sysconf (_SC_NPROCESSORS_ONLN) + >= num_processors_via_affinity_mask () + The first number is the number of CPUs configured in the system. + The second number is the number of CPUs available to the scheduler. + The third number is the number of CPUs available to the current process. + + Note! On Linux systems with glibc, the first and second number come from + the /sys and /proc file systems (see + glibc/sysdeps/unix/sysv/linux/getsysstats.c). + In some situations these file systems are not mounted, and the sysconf call + returns 1 or 2 (), + which does not reflect the reality. */ + + if (query == NPROC_CURRENT) + { + /* Try the modern affinity mask system call. */ + { + unsigned long nprocs = num_processors_via_affinity_mask (); + + if (nprocs > 0) + return nprocs; + } + +#if defined _SC_NPROCESSORS_ONLN + { /* This works on glibc, Mac OS X 10.5, FreeBSD, AIX, OSF/1, Solaris, + Cygwin, Haiku. */ + long int nprocs = sysconf (_SC_NPROCESSORS_ONLN); + if (nprocs > 0) + return nprocs; + } +#endif + } + else /* query == NPROC_ALL */ + { +#if defined _SC_NPROCESSORS_CONF + { /* This works on glibc, Mac OS X 10.5, FreeBSD, AIX, OSF/1, Solaris, + Cygwin, Haiku. */ + long int nprocs = sysconf (_SC_NPROCESSORS_CONF); + +# if __GLIBC__ >= 2 && defined __linux__ + /* On Linux systems with glibc, this information comes from the /sys and + /proc file systems (see glibc/sysdeps/unix/sysv/linux/getsysstats.c). + In some situations these file systems are not mounted, and the + sysconf call returns 1 or 2. But we wish to guarantee that + num_processors (NPROC_ALL) >= num_processors (NPROC_CURRENT). */ + if (nprocs == 1 || nprocs == 2) + { + unsigned long nprocs_current = num_processors_via_affinity_mask (); + + if (/* nprocs_current > 0 && */ nprocs_current > nprocs) + nprocs = nprocs_current; + } +# endif + + if (nprocs > 0) + return nprocs; + } +#endif + } + +#if HAVE_PSTAT_GETDYNAMIC + { /* This works on HP-UX. */ + struct pst_dynamic psd; + if (pstat_getdynamic (&psd, sizeof psd, 1, 0) >= 0) + { + /* The field psd_proc_cnt contains the number of active processors. + In newer releases of HP-UX 11, the field psd_max_proc_cnt includes + deactivated processors. */ + if (query == NPROC_CURRENT) + { + if (psd.psd_proc_cnt > 0) + return psd.psd_proc_cnt; + } + else + { + if (psd.psd_max_proc_cnt > 0) + return psd.psd_max_proc_cnt; + } + } + } +#endif + +#if HAVE_SYSMP && defined MP_NAPROCS && defined MP_NPROCS + { /* This works on IRIX. */ + /* MP_NPROCS yields the number of installed processors. + MP_NAPROCS yields the number of processors available to unprivileged + processes. */ + int nprocs = + sysmp (query == NPROC_CURRENT && getuid () != 0 + ? MP_NAPROCS + : MP_NPROCS); + if (nprocs > 0) + return nprocs; + } +#endif + + /* Finally, as fallback, use the APIs that don't distinguish between + NPROC_CURRENT and NPROC_ALL. */ + +#if HAVE_SYSCTL && ! defined __GLIBC__ && defined HW_NCPU + { /* This works on Mac OS X, FreeBSD, NetBSD, OpenBSD. */ + int nprocs; + size_t len = sizeof (nprocs); + static int const mib[][2] = { +# ifdef HW_NCPUONLINE + { CTL_HW, HW_NCPUONLINE }, +# endif + { CTL_HW, HW_NCPU } + }; + for (int i = 0; i < ARRAY_SIZE (mib); i++) + { + if (sysctl (mib[i], ARRAY_SIZE (mib[i]), &nprocs, &len, NULL, 0) == 0 + && len == sizeof (nprocs) + && 0 < nprocs) + return nprocs; + } + } +#endif + +#if defined _WIN32 && ! defined __CYGWIN__ + { /* This works on native Windows platforms. */ + SYSTEM_INFO system_info; + GetSystemInfo (&system_info); + if (0 < system_info.dwNumberOfProcessors) + return system_info.dwNumberOfProcessors; + } +#endif + + return 1; +} + +/* Parse OMP environment variables without dependence on OMP. + Return 0 for invalid values. */ +static unsigned long int +parse_omp_threads (char const* threads) +{ + unsigned long int ret = 0; + + if (threads == NULL) + return ret; + + /* The OpenMP spec says that the value assigned to the environment variables + "may have leading and trailing white space". */ + while (*threads != '\0' && c_isspace (*threads)) + threads++; + + /* Convert it from positive decimal to 'unsigned long'. */ + if (c_isdigit (*threads)) + { + char *endptr = NULL; + unsigned long int value = strtoul (threads, &endptr, 10); + + if (endptr != NULL) + { + while (*endptr != '\0' && c_isspace (*endptr)) + endptr++; + if (*endptr == '\0') + return value; + /* Also accept the first value in a nesting level, + since we can't determine the nesting level from env vars. */ + else if (*endptr == ',') + return value; + } + } + + return ret; +} + +unsigned long int +num_processors (enum nproc_query query) +{ + unsigned long int omp_env_limit = ULONG_MAX; + + if (query == NPROC_CURRENT_OVERRIDABLE) + { + unsigned long int omp_env_threads; + /* Honor the OpenMP environment variables, recognized also by all + programs that are based on OpenMP. */ + omp_env_threads = parse_omp_threads (getenv ("OMP_NUM_THREADS")); + omp_env_limit = parse_omp_threads (getenv ("OMP_THREAD_LIMIT")); + if (! omp_env_limit) + omp_env_limit = ULONG_MAX; + + if (omp_env_threads) + return MIN (omp_env_threads, omp_env_limit); + + query = NPROC_CURRENT; + } + /* Here query is one of NPROC_ALL, NPROC_CURRENT. */ + { + unsigned long nprocs = num_processors_ignoring_omp (query); + return MIN (nprocs, omp_env_limit); + } +} diff --git a/lib/nproc.h b/lib/nproc.h new file mode 100644 index 0000000000..d7659a5cad --- /dev/null +++ b/lib/nproc.h @@ -0,0 +1,46 @@ +/* Detect the number of processors. + + Copyright (C) 2009-2021 Free Software Foundation, Inc. + + This file is free software: you can redistribute it and/or modify + it under the terms of the GNU Lesser General Public License as + published by the Free Software Foundation; either version 2.1 of the + License, or (at your option) any later version. + + This file is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public License + along with this program. If not, see . */ + +/* Written by Glen Lenker and Bruno Haible. */ + +/* Allow the use in C++ code. */ +#ifdef __cplusplus +extern "C" { +#endif + +/* A "processor" in this context means a thread execution unit, that is either + - an execution core in a (possibly multi-core) chip, in a (possibly multi- + chip) module, in a single computer, or + - a thread execution unit inside a core + (hyper-threading, see ). + Which of the two definitions is used, is unspecified. */ + +enum nproc_query +{ + NPROC_ALL, /* total number of processors */ + NPROC_CURRENT, /* processors available to the current process */ + NPROC_CURRENT_OVERRIDABLE /* likewise, but overridable through the + OMP_NUM_THREADS environment variable */ +}; + +/* Return the total number of processors. The result is guaranteed to + be at least 1. */ +extern unsigned long int num_processors (enum nproc_query query); + +#ifdef __cplusplus +} +#endif /* C++ */ diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index 63d4a74b54..0052fd0f8d 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -3876,26 +3876,13 @@ processes from `comp-async-compilations'" do (remhash file-name comp-async-compilations)) (hash-table-count comp-async-compilations)) -(declare-function w32-get-nproc "w32.c") (defvar comp-num-cpus nil) (defun comp-effective-async-max-jobs () "Compute the effective number of async jobs." (if (zerop native-comp-async-jobs-number) (or comp-num-cpus (setf comp-num-cpus - ;; FIXME: we already have a function to determine - ;; the number of processors, see get_native_system_info in w32.c. - ;; The result needs to be exported to Lisp. - (max 1 (/ (cond ((eq 'windows-nt system-type) - (w32-get-nproc)) - ((executable-find "nproc") - (string-to-number - (shell-command-to-string "nproc"))) - ((eq 'berkeley-unix system-type) - (string-to-number - (shell-command-to-string "sysctl -n hw.ncpu"))) - (t 1)) - 2)))) + (max 1 (/ (num-processors) 2)))) native-comp-async-jobs-number)) (defvar comp-last-scanned-async-output nil) diff --git a/m4/gnulib-comp.m4 b/m4/gnulib-comp.m4 index a795fe7651..e314edcfb5 100644 --- a/m4/gnulib-comp.m4 +++ b/m4/gnulib-comp.m4 @@ -139,6 +139,7 @@ AC_DEFUN([gl_EARLY], # Code from module mktime-internal: # Code from module multiarch: # Code from module nocrash: + # Code from module nproc: # Code from module nstrftime: # Code from module open: # Code from module openat-h: @@ -413,6 +414,7 @@ AC_DEFUN([gl_INIT], fi gl_TIME_MODULE_INDICATOR([mktime]) gl_MULTIARCH + gl_NPROC gl_FUNC_GNU_STRFTIME gl_PATHMAX gl_FUNC_PIPE2 @@ -1221,6 +1223,8 @@ AC_DEFUN([gl_FILE_LIST], [ lib/mkostemp.c lib/mktime-internal.h lib/mktime.c + lib/nproc.c + lib/nproc.h lib/nstrftime.c lib/open.c lib/openat-priv.h @@ -1370,6 +1374,7 @@ AC_DEFUN([gl_FILE_LIST], [ m4/mode_t.m4 m4/multiarch.m4 m4/nocrash.m4 + m4/nproc.m4 m4/nstrftime.m4 m4/off_t.m4 m4/open-cloexec.m4 diff --git a/m4/nproc.m4 b/m4/nproc.m4 new file mode 100644 index 0000000000..887c66bee8 --- /dev/null +++ b/m4/nproc.m4 @@ -0,0 +1,54 @@ +# nproc.m4 serial 5 +dnl Copyright (C) 2009-2021 Free Software Foundation, Inc. +dnl This file is free software; the Free Software Foundation +dnl gives unlimited permission to copy and/or distribute it, +dnl with or without modifications, as long as this notice is preserved. + +AC_DEFUN([gl_NPROC], +[ + gl_PREREQ_NPROC +]) + +# Prerequisites of lib/nproc.c. +AC_DEFUN([gl_PREREQ_NPROC], +[ + dnl Persuade glibc to declare CPU_SETSIZE, CPU_ISSET etc. + AC_REQUIRE([AC_USE_SYSTEM_EXTENSIONS]) + + AC_CHECK_HEADERS([sys/pstat.h sys/sysmp.h sys/param.h],,, + [AC_INCLUDES_DEFAULT]) + dnl requires on OpenBSD 4.0. + AC_CHECK_HEADERS([sys/sysctl.h],,, + [AC_INCLUDES_DEFAULT + #if HAVE_SYS_PARAM_H + # include + #endif + ]) + + AC_CHECK_FUNCS([sched_getaffinity sched_getaffinity_np \ + pstat_getdynamic sysmp sysctl]) + + dnl Test whether sched_getaffinity has the expected declaration. + dnl glibc 2.3.[0-2]: + dnl int sched_getaffinity (pid_t, unsigned int, unsigned long int *); + dnl glibc 2.3.3: + dnl int sched_getaffinity (pid_t, cpu_set_t *); + dnl glibc >= 2.3.4: + dnl int sched_getaffinity (pid_t, size_t, cpu_set_t *); + if test $ac_cv_func_sched_getaffinity = yes; then + AC_CACHE_CHECK([for glibc compatible sched_getaffinity], + [gl_cv_func_sched_getaffinity3], + [AC_COMPILE_IFELSE( + [AC_LANG_PROGRAM( + [[#include + #include ]], + [[sched_getaffinity (0, 0, (cpu_set_t *) 0);]])], + [gl_cv_func_sched_getaffinity3=yes], + [gl_cv_func_sched_getaffinity3=no]) + ]) + if test $gl_cv_func_sched_getaffinity3 = yes; then + AC_DEFINE([HAVE_SCHED_GETAFFINITY_LIKE_GLIBC], [1], + [Define to 1 if sched_getaffinity has a glibc compatible declaration.]) + fi + fi +]) diff --git a/src/process.c b/src/process.c index 221d4c7f6c..746cdc0428 100644 --- a/src/process.c +++ b/src/process.c @@ -90,6 +90,7 @@ static struct rlimit nofile_limit; #include #include +#include #include #include @@ -8212,6 +8213,20 @@ integer or floating point values. return system_process_attributes (pid); } +DEFUN ("num-processors", Fnum_processors, Snum_processors, 0, 1, 0, + doc: /* Return the number of processors, a positive integer. +Each usable thread execution unit counts as a processor. +By default, count the number of available processors, +overridable via the OMP_NUM_THREADS environment variable. +If optional argument QUERY is `current', ignore OMP_NUM_THREADS. +If QUERY is `all', also count processors not available. */) + (Lisp_Object query) +{ + return make_uint (num_processors (EQ (query, Qall) ? NPROC_ALL + : EQ (query, Qcurrent) ? NPROC_CURRENT + : NPROC_CURRENT_OVERRIDABLE)); +} + #ifdef subprocesses /* Arrange to catch SIGCHLD if this hasn't already been arranged. Invoke this after init_process_emacs, and after glib and/or GNUstep @@ -8472,6 +8487,8 @@ syms_of_process (void) DEFSYM (Qpcpu, "pcpu"); DEFSYM (Qpmem, "pmem"); DEFSYM (Qargs, "args"); + DEFSYM (Qall, "all"); + DEFSYM (Qcurrent, "current"); DEFVAR_BOOL ("delete-exited-processes", delete_exited_processes, doc: /* Non-nil means delete processes immediately when they exit. @@ -8633,4 +8650,5 @@ amounts of data in one go. */); defsubr (&Sprocess_inherit_coding_system_flag); defsubr (&Slist_system_processes); defsubr (&Sprocess_attributes); + defsubr (&Snum_processors); } diff --git a/src/w32proc.c b/src/w32proc.c index 702ea122e6..3b7d92a2aa 100644 --- a/src/w32proc.c +++ b/src/w32proc.c @@ -3878,6 +3878,7 @@ w32_compare_strings (const char *s1, const char *s2, char *locname, return val - 2; } +/* FIXME: Remove, merging any of its special features into num-processors. */ DEFUN ("w32-get-nproc", Fw32_get_nproc, Sw32_get_nproc, 0, 0, 0, doc: /* Return the number of system's processor execution units. */) diff --git a/test/src/process-tests.el b/test/src/process-tests.el index e39f57d23b..44f3ea2fbb 100644 --- a/test/src/process-tests.el +++ b/test/src/process-tests.el @@ -946,5 +946,11 @@ Return nil if FILENAME doesn't exist." (when buf (kill-buffer buf))))) +(ert-deftest process-num-processors () + "Sanity checks for num-processors." + (should (equal (num-processors) (num-processors))) + (should (integerp (num-processors))) + (should (< 0 (num-processors)))) + (provide 'process-tests) ;;; process-tests.el ends here commit 575e626105b506b008eb9b0a03bb27aeecee54d4 Author: Juri Linkov Date: Sun Oct 10 20:38:12 2021 +0300 Add symbol property 'save-some-buffers-function' (bug#46374) * lisp/files.el (save-some-buffers-root): Put non-nil symbol property 'save-some-buffers-function'. (save-some-buffers): Check pred for the symbol property 'save-some-buffers-function'. (save-some-buffers-default-predicate): Mention symbol property 'save-some-buffers-function'. diff --git a/lisp/files.el b/lisp/files.el index 64c69e685c..7f9e9f5bbc 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -5745,7 +5745,9 @@ This allows you to stop `save-some-buffers' from asking about certain files that you'd usually rather not save. This function is called (with no parameters) from the buffer to -be saved." +be saved. When the function's symbol has the property +`save-some-buffers-function', the higher-order function is supposed +to return a predicate used to check buffers." :group 'auto-save ;; FIXME nil should not be a valid option, let alone the default, ;; eg so that add-function can be used. @@ -5765,6 +5767,7 @@ of the directory that was default during command invocation." (project-root (project-current))) default-directory))) (lambda () (file-in-directory-p default-directory root)))) +(put 'save-some-buffers-root 'save-some-buffers-function t) (defun save-some-buffers (&optional arg pred) "Save some modified file-visiting buffers. Asks user about each one. @@ -5796,9 +5799,10 @@ change the additional actions you can take on files." (setq pred save-some-buffers-default-predicate)) ;; Allow `pred' to be a function that returns a predicate ;; with lexical bindings in its original environment (bug#46374). - (let ((pred-fun (and (functionp pred) (funcall pred)))) - (when (functionp pred-fun) - (setq pred pred-fun))) + (when (and (symbolp pred) (get pred 'save-some-buffers-function)) + (let ((pred-fun (and (functionp pred) (funcall pred)))) + (when (functionp pred-fun) + (setq pred pred-fun)))) (let* ((switched-buffer nil) (save-some-buffers--switch-window-callback (lambda (buffer) commit a3e10af95c6267c63276fc0452ce810f19885eb6 Author: Juri Linkov Date: Sun Oct 10 20:31:15 2021 +0300 Keep reading when typed RET in read-char-from-minibuffer and y-or-n-p * lisp/subr.el (read-char-from-minibuffer-map): Remap exit-minibuffer to read-char-from-minibuffer-insert-other. (y-or-n-p-map): Remap 'exit' to y-or-n-p-insert-other. (y-or-n-p): Don't mention RET in docstring. (Bug#51101) diff --git a/lisp/subr.el b/lisp/subr.el index 78767b259d..8ff403e113 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -3035,6 +3035,7 @@ If there is a natural number at point, use it as default." (set-keymap-parent map minibuffer-local-map) (define-key map [remap self-insert-command] #'read-char-from-minibuffer-insert-char) + (define-key map [remap exit-minibuffer] #'read-char-from-minibuffer-insert-other) (define-key map [remap recenter-top-bottom] #'minibuffer-recenter-top-bottom) (define-key map [remap scroll-up-command] #'minibuffer-scroll-up-command) @@ -3152,9 +3153,10 @@ There is no need to explicitly add `help-char' to CHARS; (define-key map [remap scroll-other-window] #'minibuffer-scroll-other-window) (define-key map [remap scroll-other-window-down] #'minibuffer-scroll-other-window-down) - (define-key map [escape] #'abort-recursive-edit) - (dolist (symbol '(quit exit exit-prefix)) + (define-key map [remap exit] #'y-or-n-p-insert-other) + (dolist (symbol '(exit-prefix quit)) (define-key map (vector 'remap symbol) #'abort-recursive-edit)) + (define-key map [escape] #'abort-recursive-edit) ;; FIXME: try catch-all instead of explicit bindings: ;; (define-key map [remap t] #'y-or-n-p-insert-other) @@ -3218,7 +3220,7 @@ PROMPT is also updated to show `help-char' like \"(y, n or C-h) \", where `help-char' is automatically bound to `help-form-show'. No confirmation of the answer is requested; a single character is -enough. RET and SPC also means yes, and DEL means no. +enough. SPC also means yes, and DEL means no. To be precise, this function translates user input into responses by consulting the bindings in `query-replace-map'; see the commit 013e3be8327ee090cef101121dd8f10e992e7958 Author: David M. Koppelman Date: Sun Oct 10 20:27:29 2021 +0300 * lisp/userlock.el (ask-user-about-supersession-threat): Accept 'y' strictly. (Bug#51101) diff --git a/lisp/userlock.el b/lisp/userlock.el index 87a8b7b451..348ccc6f8e 100644 --- a/lisp/userlock.el +++ b/lisp/userlock.el @@ -194,7 +194,9 @@ really edit the buffer? (%s, %s, %s or %s) " (list "File reverted" filename))) ((eq answer ?n) (signal 'file-supersession - (list "File changed on disk" filename))))) + (list "File changed on disk" filename))) + ((eq answer ?y)) + (t (setq answer nil)))) (message "File on disk now will become a backup file if you save these changes.") (setq buffer-backed-up nil)))) commit ae61d7a57d5b722c9ca1399ac377c60de26861e2 Author: Eli Zaretskii Date: Sun Oct 10 17:14:55 2021 +0300 Fix point positioning on mouse clicks with non-zero line-height * src/xdisp.c (move_it_to): After passing a newline, reset it->override_ascent, like 'display_line' does (in 'append_space_for_newline'). (Bug#51111) diff --git a/src/xdisp.c b/src/xdisp.c index 9ddf0dd54b..d8aff5084c 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -10073,6 +10073,8 @@ move_it_to (struct it *it, ptrdiff_t to_charpos, int to_x, int to_y, int to_vpos case MOVE_NEWLINE_OR_CR: max_current_x = max (it->current_x, max_current_x); + if (!IT_OVERFLOW_NEWLINE_INTO_FRINGE (it)) + it->override_ascent = -1; set_iterator_to_next (it, true); it->continuation_lines_width = 0; break; commit 4c7e74c386219e9b20cb52176c88260709e7741d Author: João Távora Date: Wed Oct 6 11:30:29 2021 +0100 Complete shorthands to longhands for symbol-completing tables Shorthands aren't symbols, they're text forms that 'read' into symbols. As such, shorthands aren't candidates in these tables of symbols. But in some situations, if no other candidates match the pattern, we can e.g. complete "x-foo" to "xavier-foo" if the shorthand (("x-" . "xavier-")) is set up in the buffer of origin. bug#50959 * lisp/help-fns.el (help--symbol-completion-table): Report `symbol-help' category. * lisp/minibuffer.el (completion-styles-alist): New 'shorthand' style. (completion-category-defaults): Link 'symbol-help' category with 'shorthand' style. (minibuffer--original-buffer): New variable. (completing-read-default): Setup minibuffer--original-buffer. (completion-shorthand-try-completion) (completion-shorthand-all-completions): New helpers. diff --git a/lisp/help-fns.el b/lisp/help-fns.el index 6be5cd4a50..03bbc979a9 100644 --- a/lisp/help-fns.el +++ b/lisp/help-fns.el @@ -176,8 +176,11 @@ with the current prefix. The files are chosen according to completions)) (defun help--symbol-completion-table (string pred action) - (if (and completions-detailed (eq action 'metadata)) - '(metadata (affixation-function . help--symbol-completion-table-affixation)) + (if (eq action 'metadata) + `(metadata + ,@(when completions-detailed + '((affixation-function . help--symbol-completion-table-affixation))) + (category . symbol-help)) (when help-enable-completion-autoload (let ((prefixes (radix-tree-prefixes (help-definition-prefixes) string))) (help--load-prefixes prefixes))) diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index 1e1a6f852e..48859585bc 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -943,7 +943,12 @@ When completing \"foo\" the glob \"*f*o*o*\" is used, so that completion-initials-try-completion completion-initials-all-completions "Completion of acronyms and initialisms. E.g. can complete M-x lch to list-command-history -and C-x C-f ~/sew to ~/src/emacs/work.")) +and C-x C-f ~/sew to ~/src/emacs/work.") + (shorthand + completion-shorthand-try-completion completion-shorthand-all-completions + "Completion of symbol shorthands setup in `read-symbol-shorthands'. +E.g. can complete \"x-foo\" to \"xavier-foo\" if the shorthand +((\"x-\" . \"xavier-\")) is set up in the buffer of origin.")) "List of available completion styles. Each element has the form (NAME TRY-COMPLETION ALL-COMPLETIONS DOC): where NAME is the name that should be used in `completion-styles', @@ -990,7 +995,8 @@ styles for specific categories, such as files, buffers, etc." ;; e.g. one that does not anchor to bos. (project-file (styles . (substring))) (xref-location (styles . (substring))) - (info-menu (styles . (basic substring)))) + (info-menu (styles . (basic substring))) + (symbol-help (styles . (basic shorthand substring)))) "Default settings for specific completion categories. Each entry has the shape (CATEGORY . ALIST) where ALIST is an association list that can specify properties such as: @@ -1618,6 +1624,9 @@ DONT-CYCLE tells the function not to setup cycling." (defvar minibuffer--require-match nil "Value of REQUIRE-MATCH passed to `completing-read'.") +(defvar minibuffer--original-buffer nil + "Buffer that was current when `completing-read' was called.") + (defun minibuffer-complete-and-exit () "Exit if the minibuffer contains a valid completion. Otherwise, try to complete the minibuffer contents. If @@ -4080,6 +4089,40 @@ which is at the core of flex logic. The extra (let ((newstr (completion-initials-expand string table pred))) (when newstr (completion-pcm-try-completion newstr table pred (length newstr))))) + +;; Shorthand completion +;; +;; Iff there is a (("x-" . "string-library-")) shorthand setup and +;; string-library-foo is in candidates, complete x-foo to it. + +(defun completion-shorthand-try-completion (string table pred point) + "Try completion with `read-symbol-shorthands' of original buffer." + (cl-loop with expanded + for (short . long) in + (with-current-buffer minibuffer--original-buffer + read-symbol-shorthands) + for probe = + (and (> point (length short)) + (string-prefix-p short string) + (try-completion (setq expanded + (concat long + (substring + string + (length short)))) + table pred)) + when probe + do (message "Shorthand expansion") + and return (cons expanded (max (length long) + (+ (- point (length short)) + (length long)))))) + +(defun completion-shorthand-all-completions (string table pred _point) + ;; no-op: For now, we don't want shorthands to list all the possible + ;; locally active longhands. For the completion categories where + ;; this style is active, it could hide other more interesting + ;; matches from subsequent styles. + nil) + (defvar completing-read-function #'completing-read-default "The function called by `completing-read' to do its work. @@ -4111,6 +4154,7 @@ See `completing-read' for the meaning of the arguments." ;; in minibuffer-local-filename-completion-map can ;; override bindings in base-keymap. base-keymap))) + (buffer (current-buffer)) (result (minibuffer-with-setup-hook (lambda () @@ -4119,7 +4163,8 @@ See `completing-read' for the meaning of the arguments." ;; FIXME: Remove/rename this var, see the next one. (setq-local minibuffer-completion-confirm (unless (eq require-match t) require-match)) - (setq-local minibuffer--require-match require-match)) + (setq-local minibuffer--require-match require-match) + (setq-local minibuffer--original-buffer buffer)) (read-from-minibuffer prompt initial-input keymap nil hist def inherit-input-method)))) (when (and (equal result "") def) commit c2513c5d0d51159a87d7718be5cd043b6d1a7e9a Author: João Távora Date: Sun Oct 10 12:03:15 2021 +0100 Add new failing test for bug#51089 * test/lisp/progmodes/elisp-mode-tests.el (elisp-dont-shadow-punctuation-only-symbols): Add new failing test. diff --git a/test/lisp/progmodes/elisp-mode-tests.el b/test/lisp/progmodes/elisp-mode-tests.el index ad39cebfc8..e816d3c1b0 100644 --- a/test/lisp/progmodes/elisp-mode-tests.el +++ b/test/lisp/progmodes/elisp-mode-tests.el @@ -1093,6 +1093,18 @@ evaluation of BODY." (should (= 84 (funcall (intern-soft "f-test4---")))) (should (unintern "f-test4---")))) +(ert-deftest elisp-dont-shadow-punctuation-only-symbols () + :expected-result :failed ; bug#51089 + (let* ((shorthanded-form '(- 42 (-foo 42))) + (expected-longhand-form '(- 42 (fooey-foo 42))) + (observed (let ((read-symbol-shorthands + '(("-" . "fooey-")))) + (car (read-from-string + (with-temp-buffer + (print shorthanded-form (current-buffer)) + (buffer-string))))))) + (should (equal observed expected-longhand-form)))) + (ert-deftest test-cl-flet-indentation () :expected-result :failed ; FIXME: bug#9622 (should (equal commit 005c15cdb5df7cff5d7d91b858200624a2fa9100 Author: Lars Ingebrigtsen Date: Sun Oct 10 13:58:57 2021 +0200 Fix mairix-el.texi menu diff --git a/doc/misc/mairix-el.texi b/doc/misc/mairix-el.texi index 99e71b2e42..e57b5ed542 100644 --- a/doc/misc/mairix-el.texi +++ b/doc/misc/mairix-el.texi @@ -59,9 +59,9 @@ database. * Setting up the mairix interface:: Set up mairix.el. * Using:: List of interactive functions * Extending:: Support your favorite mail reader! +* GNU Free Documentation License:: The license for this documentation. * Function Index: Function Index. * Variable Index: Variable Index. -* GNU Free Documentation License:: The license for this documentation. @end menu @node About commit 1d1e96377c6228e4479c65066382681dc1887397 Author: Stefan Kangas Date: Sun Oct 10 13:52:24 2021 +0200 ; * lisp/emacs-lisp/shortdoc.el: Fix typo. diff --git a/lisp/emacs-lisp/shortdoc.el b/lisp/emacs-lisp/shortdoc.el index 51c822d21e..25bd17bdb9 100644 --- a/lisp/emacs-lisp/shortdoc.el +++ b/lisp/emacs-lisp/shortdoc.el @@ -1319,11 +1319,11 @@ function's documentation in the Info manual"))) (princ value (current-buffer)) (insert "\n")) (:eg-result - (insert " eg. " double-arrow " ") + (insert " e.g. " double-arrow " ") (prin1 value (current-buffer)) (insert "\n")) (:eg-result-string - (insert " eg. " double-arrow " ") + (insert " e.g. " double-arrow " ") (princ value (current-buffer)) (insert "\n"))))) ;; Insert the arglist after doing the evals, in case that's pulled commit 6bf29072e968401f842789c71468e624e5c913a9 Author: Dmitry Gutov Date: Sun Oct 10 04:14:35 2021 +0300 Avoid mapping file names through 'substring' * lisp/progmodes/project.el (project--files-in-directory): Avoid mapping file names through 'substring'. Reducing the amount of garbage generated. Better perf by up to 20%. Bump the package version. diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el index 3eaa789b3e..da7435cddf 100644 --- a/lisp/progmodes/project.el +++ b/lisp/progmodes/project.el @@ -1,7 +1,7 @@ ;;; project.el --- Operations on the current project -*- lexical-binding: t; -*- ;; Copyright (C) 2015-2021 Free Software Foundation, Inc. -;; Version: 0.8.0 +;; Version: 0.8.1 ;; Package-Requires: ((emacs "26.1") (xref "1.0.2")) ;; This is a GNU ELPA :core package. Avoid using functionality that @@ -316,16 +316,21 @@ to find the list of ignores for each directory." " " (shell-quote-argument ")")) ""))) - (output (with-output-to-string - (with-current-buffer standard-output - (let ((status - (process-file-shell-command command nil t))) - (unless (zerop status) - (error "File listing failed: %s" (buffer-string)))))))) + res) + (with-temp-buffer + (let ((status + (process-file-shell-command command nil t)) + (pt (point-min))) + (unless (zerop status) + (error "File listing failed: %s" (buffer-string))) + (goto-char pt) + (while (search-forward "\0" nil t) + (push (buffer-substring-no-properties (1+ pt) (1- (point))) + res) + (setq pt (point))))) (project--remote-file-names - (mapcar (lambda (s) (concat dfn (substring s 1))) - (sort (split-string output "\0" t) - #'string<))))) + (mapcar (lambda (s) (concat dfn s)) + (sort res #'string<))))) (defun project--remote-file-names (local-files) "Return LOCAL-FILES as if they were on the system of `default-directory'. commit bcce93f04c2df6a5bb5dd1a8e611de734d24aee7 Author: Kyle Meyer Date: Sat Oct 9 16:34:12 2021 -0400 Update to Org 9.5-46-gb71474 diff --git a/doc/misc/org.org b/doc/misc/org.org index 7b1277c7a2..5977f09161 100644 --- a/doc/misc/org.org +++ b/doc/misc/org.org @@ -1355,9 +1355,8 @@ you, configure the option ~org-table-auto-blank-field~. Re-align the table, move to the next field. Creates a new row if necessary. -- {{{kbd(C-c SPC)}}} (~org-table-blank-field~) :: +- {{{kbd(M-x org-table-blank-field)}}} :: - #+kindex: C-c SPC #+findex: org-table-blank-field Blank the field at point. @@ -16517,16 +16516,16 @@ keywords. :END: #+cindex: citation -As of Org 9.5, a new library =oc.el= provides tooling to handle -citations in Org via "citation processors" that offer some or all of -the following capabilities: +The =oc.el= library provides tooling to handle citations in Org via +"citation processors" that offer some or all of the following +capabilities: -- "activate" :: Fontification, tooltip preview, etc. -- "follow" :: At-point actions on citations via ~org-open-at-point~. -- "insert" :: Add and edit citations via ~org-cite-insert~. -- "export" :: Via different libraries for different target formats. +- activate :: Fontification, tooltip preview, etc. +- follow :: At-point actions on citations via ~org-open-at-point~. +- insert :: Add and edit citations via ~org-cite-insert~. +- export :: Via different libraries for different target formats. -The user can configure these with ~org-cite-active-processor~, +The user can configure these with ~org-cite-activate-processor~, ~org-cite-follow-processor~, ~org-cite-insert-processor~, and ~org-cite-export-processors~ respectively. @@ -16544,8 +16543,10 @@ more "bibliography" keywords. #+bibliography: "/some/file/with spaces/in its name.bib" #+end_example +#+kindex: C-c C-x @ +#+findex: org-cite-insert One can then insert and edit citations using ~org-cite-insert~, called -with {{{kbd(M-x org-cite-insert)}}}. +with {{{kbd(C-c C-x @)}}}. A /citation/ requires one or more citation /key(s)/, elements identifying a reference in the bibliography. @@ -16554,9 +16555,10 @@ identifying a reference in the bibliography. - Each key starts with the character =@=. -- Each key can be qualified by a /prefix/ (e.g. "see ") and/or a - /suffix/ (e.g. "p. 123"), giving informations useful or necessary fo - the comprehension of the citation but not included in the reference. +- Each key can be qualified by a /prefix/ (e.g.\nbsp{}"see ") and/or + a /suffix/ (e.g.\nbsp{}"p.\nbsp{}123"), giving informations useful or necessary + fo the comprehension of the citation but not included in the + reference. - A single citation can cite more than one reference ; the keys are separated by semicolons ; the formatting of such citation groups is @@ -16564,11 +16566,9 @@ identifying a reference in the bibliography. - One can also specify a stylistic variation for the citations by inserting a =/= and a style name between the =cite= keyword and the - colon ; this usially makes sense only for the author-year styles. + colon; this usually makes sense only for the author-year styles. -#+begin_example -[cite/style:common prefix ;prefix @key suffix; ... ; common suffix] -#+end_example +: [cite/style:common prefix ;prefix @key suffix; ... ; common suffix] The only mandatory elements are: @@ -16583,7 +16583,7 @@ Org currently includes the following export processors: - Two processors can export to a variety of formats, including =latex= (and therefore =pdf=), =html=, =odt= and plain (UTF8) text: - - basic :: a basic export processors, well adapted to situations + - basic :: a basic export processor, well adapted to situations where backward compatibility is not a requirement and formatting needs are minimal; @@ -16593,45 +16593,42 @@ Org currently includes the following export processors: - In contrast, two other processors target LaTeX and LaTeX-derived formats exclusively: - - natbib :: this export processor uses =bibtex=, the historical + - natbib :: this export processor uses BibTeX, the historical bibliographic processor used with LaTeX, thus allowing the use of - data and style files compatible with this processor (including a - large number of publishers' styles). It uses citation commands + data and style files compatible with this processor (including + a large number of publishers' styles). It uses citation commands implemented in the LaTeX package =natbib=, allowing more stylistic variants that LaTeX's =\cite= command. - biblatex :: this backend allows the use of data and formats - prepared for =biblatex=, an alternate bibliographic processor used - with LaTeX, which overcomes some serious =bibtex= limitations, but - has not (yet?) been widely adopted by publishers. + prepared for BibLaTeX, an alternate bibliographic processor used + with LaTeX, which overcomes some serious BibTeX limitations, but + has not (yet?)\nbsp{}been widely adopted by publishers. -The =#+cite_export:= keyword specifies the export processor and the +The =CITE_EXPORT= keyword specifies the export processor and the citation (and possibly reference) style(s); for example (all arguments are optional) -#+begin_example -#+cite_export: basic author author-year -#+end_example +: #+cite_export: basic author author-year +#+texinfo: @noindent specifies the "basic" export processor with citations inserted as author's name and references indexed by author's names and year; -#+begin_example -#+cite_export: csl /some/path/to/vancouver-brackets.csl -#+end_example +: #+cite_export: csl /some/path/to/vancouver-brackets.csl +#+texinfo: @noindent specifies the "csl" processor and CSL style, which in this case defines numeric citations and numeric references according to the =Vancouver= specification (as style used in many medical journals), following a typesetting variation putting citations between brackets; -#+begin_example -#+cite_export: natbib kluwer -#+end_example +: #+cite_export: natbib kluwer -specifies the "natbib" export processor with a label citation style +#+texinfo: @noindent +specifies the =natbib= export processor with a label citation style conformant to the Harvard style and the specification of the -Wolkers-Kluwer publisher; since it relies on the =bibtex= processor of +Wolkers-Kluwer publisher; since it relies on the ~bibtex~ processor of your LaTeX installation, it won't export to anything but PDF. * Working with Source Code diff --git a/lisp/org/oc-biblatex.el b/lisp/org/oc-biblatex.el index f517e39139..daf56e792a 100644 --- a/lisp/org/oc-biblatex.el +++ b/lisp/org/oc-biblatex.el @@ -165,15 +165,11 @@ INFO is the export state, as a property list." (org-cite-biblatex--atomic-arguments (list r) info)) (org-cite-get-references citation) "") - ;; According to biblatex manual, left braces or brackets + ;; According to BibLaTeX manual, left braces or brackets ;; following a multicite command could be parsed as other - ;; arguments. So we look ahead and insert a \relax if - ;; needed. - (and (let ((next (org-export-get-next-element citation info))) - (and next - (string-match (rx string-start (or "{" "[")) - (org-export-data next info)))) - "\\relax")))) + ;; arguments. So we stop any further parsing by inserting + ;; a \relax unconditionally. + "\\relax"))) (defun org-cite-biblatex--command (citation info base &optional multi no-opt) "Return biblatex command using BASE name for CITATION object. @@ -314,6 +310,7 @@ to the document, and set styles." '((("author" "a") ("caps" "c") ("full" "f") ("caps-full" "cf")) (("locators" "l") ("bare" "b") ("caps" "c") ("bare-caps" "bc")) (("noauthor" "na")) + (("nocite" "n")) (("text" "t") ("caps" "c")) (("nil") ("bare" "b") ("caps" "c") ("bare-caps" "bc")))) diff --git a/lisp/org/oc.el b/lisp/org/oc.el index bbf2195fbd..2f741768f8 100644 --- a/lisp/org/oc.el +++ b/lisp/org/oc.el @@ -89,7 +89,6 @@ (declare-function org-element-type "org-element" (element)) (declare-function org-export-derived-backend-p "org-export" (backend &rest backends)) -(declare-function org-export-get-footnote-definition "org-export" (footnote-reference info)) (declare-function org-export-get-next-element "org-export" (blob info &optional n)) (declare-function org-export-get-previous-element "org-export" (blob info &optional n)) (declare-function org-export-raw-string "org-export" (s)) @@ -152,10 +151,10 @@ triplet following the pattern (NAME BIBLIOGRAPHY-STYLE CITATION-STYLE) There, NAME is the name of a registered citation processor providing export -functionality, as a symbol. BIBLIOGRAPHY-STYLE (resp. CITATION-STYLE) is the -desired default style to use when printing a bibliography (resp. exporting a -citation), as a string or nil. Both BIBLIOGRAPHY-STYLE and CITATION-STYLE are -optional. NAME is mandatory. +functionality, as a symbol. BIBLIOGRAPHY-STYLE (respectively CITATION-STYLE) +is the desired default style to use when printing a bibliography (respectively +exporting a citation), as a string or nil. Both BIBLIOGRAPHY-STYLE and +CITATION-STYLE are optional. NAME is mandatory. The export process selects the citation processor associated to the current export back-end, or the most specific back-end the current one is derived from, @@ -502,8 +501,8 @@ This function assumes S precedes CITATION." (defun org-cite--move-punct-before (punct citation s info) "Move punctuation PUNCT before CITATION object. -String S contains PUNCT. The function assumes S follows CITATION. -Parse tree is modified by side-effect." +String S contains PUNCT. INFO is the export state, as a property list. +The function assumes S follows CITATION. Parse tree is modified by side-effect." (if (equal s punct) (org-element-extract-element s) ;it would be empty anyway (org-element-set-element s (substring s (length punct)))) @@ -799,9 +798,20 @@ INFO is the export communication channel, as a property list." ;; Do not force entering inline definitions, since ;; `org-element-map' is going to enter it anyway. ((guard (eq 'inline (org-element-property :type datum)))) + ;; Find definition for current standard + ;; footnote reference. Unlike to + ;; `org-export-get-footnote-definition', do + ;; not cache results as they would contain + ;; un-processed citation objects. (_ - (funcall search-cites - (org-export-get-footnote-definition datum info))))) + (let ((label (org-element-property :label datum))) + (funcall + search-cites + (org-element-map data 'footnote-definition + (lambda (d) + (and + (equal label (org-element-property :label d)) + (or (org-element-contents d) ""))))))))) info nil 'footnote-definition t)))) (funcall search-cites (plist-get info :parse-tree)) (let ((result (nreverse cites))) @@ -877,13 +887,16 @@ modified by side-effect." INFO is the export state, as a property list. +Optional argument RULE is the punctuation rule used, as a triplet. When nil, +rule is determined according to `org-cite-note-rules', which see. + Optional argument PUNCT is a list of punctuation marks to be considered. When nil, it defaults to `org-cite-punctuation-marks'. Parse tree is modified by side-effect. Note: when calling both `org-cite-adjust-note' and `org-cite-wrap-citation' on -the same object, call `org-cite-adjust-punctuation' first." +the same object, call `org-cite-adjust-note' first." (when org-cite-adjust-note-numbers (pcase-let* ((rule (or rule (org-cite--get-note-rule info))) (punct-re (regexp-opt (or punct org-cite-punctuation-marks))) @@ -1274,11 +1287,13 @@ by side-effect." ;; Before removing the citation, transfer its `:post-blank' ;; property to the object before, if any. (org-cite--set-previous-post-blank cite blanks info) - ;; We want to be sure any non-note citation is preceded by - ;; a space. This is particularly important when using + ;; Make sure there is a space between a quotation mark and + ;; a citation. This is particularly important when using ;; `adaptive' note rule. See `org-cite-note-rules'. - (unless (org-cite-inside-footnote-p cite t) - (org-cite--set-previous-post-blank cite 1 info)) + (let ((previous (org-export-get-previous-element cite info))) + (when (and (org-string-nw-p previous) + (string-suffix-p "\"" previous)) + (org-cite--set-previous-post-blank cite 1 info))) (pcase replacement ;; String. ((pred stringp) @@ -1384,7 +1399,8 @@ ARG is the prefix argument received when calling `org-open-at-point', or nil." ;;; Meta-command for citation insertion (insert capability) (defun org-cite--allowed-p (context) - "Non-nil when a citation can be inserted at point." + "Non-nil when a citation can be inserted at point. +CONTEXT is the element or object at point, as returned by `org-element-context'." (let ((type (org-element-type context))) (cond ;; No citation in attributes, except in parsed ones. @@ -1430,7 +1446,11 @@ ARG is the prefix argument received when calling `org-open-at-point', or nil." (skip-chars-backward " \r\t\n") (if (eq (org-element-class context) 'object) (point) (line-beginning-position 2))))) - ;; At the start of a list item is fine, as long as the bullet is unaffected. + ;; At the beginning of a footnote definition, right after the + ;; label, is OK. + ((eq type 'footnote-definition) (looking-at (rx space))) + ;; At the start of a list item is fine, as long as the bullet is + ;; unaffected. ((eq type 'item) (> (point) (+ (org-element-property :begin context) (current-indentation) diff --git a/lisp/org/ol-man.el b/lisp/org/ol-man.el new file mode 100644 index 0000000000..0d9ac7c8c7 --- /dev/null +++ b/lisp/org/ol-man.el @@ -0,0 +1,86 @@ +;;; ol-man.el --- Links to man pages -*- lexical-binding: t; -*- +;; +;; Copyright (C) 2020-2021 Free Software Foundation, Inc. +;; Author: Carsten Dominik +;; Maintainer: Bastien Guerry +;; Keywords: outlines, hypermedia, calendar, wp +;; Homepage: https://orgmode.org +;; +;; This file is part of GNU Emacs. +;; +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3, or (at your option) +;; any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;;; Commentary: + +(require 'ol) + +(org-link-set-parameters "man" + :follow #'org-man-open + :export #'org-man-export + :store #'org-man-store-link) + +(defcustom org-man-command 'man + "The Emacs command to be used to display a man page." + :group 'org-link + :type '(choice (const man) (const woman))) + +(defun org-man-open (path _) + "Visit the manpage on PATH. +PATH should be a topic that can be thrown at the man command. +If PATH contains extra ::STRING which will use `occur' to search +matched strings in man buffer." + (string-match "\\(.*?\\)\\(?:::\\(.*\\)\\)?$" path) + (let* ((command (match-string 1 path)) + (search (match-string 2 path))) + (funcall org-man-command command) + (when search + (with-current-buffer (concat "*Man " command "*") + (goto-char (point-min)) + (search-forward search))))) + +(defun org-man-store-link () + "Store a link to a README file." + (when (memq major-mode '(Man-mode woman-mode)) + ;; This is a man page, we do make this link + (let* ((page (org-man-get-page-name)) + (link (concat "man:" page)) + (description (format "Manpage for %s" page))) + (org-link-store-props + :type "man" + :link link + :description description)))) + +(defun org-man-get-page-name () + "Extract the page name from the buffer name." + ;; This works for both `Man-mode' and `woman-mode'. + (if (string-match " \\(\\S-+\\)\\*" (buffer-name)) + (match-string 1 (buffer-name)) + (error "Cannot create link to this man page"))) + +(defun org-man-export (link description format) + "Export a man page link from Org files." + (let ((path (format "http://man.he.net/?topic=%s§ion=all" link)) + (desc (or description link))) + (cond + ((eq format 'html) (format "%s" path desc)) + ((eq format 'latex) (format "\\href{%s}{%s}" path desc)) + ((eq format 'texinfo) (format "@uref{%s,%s}" path desc)) + ((eq format 'ascii) (format "%s (%s)" desc path)) + ((eq format 'md) (format "[%s](%s)" desc path)) + (t path)))) + +(provide 'ol-man) + +;;; ol-man.el ends here diff --git a/lisp/org/org-footnote.el b/lisp/org/org-footnote.el index c8c4dae800..fcc7579bad 100644 --- a/lisp/org/org-footnote.el +++ b/lisp/org/org-footnote.el @@ -281,7 +281,10 @@ otherwise." (save-excursion (goto-char (org-element-property :end context)) (skip-chars-backward " \r\t\n") (if (eq (org-element-class context) 'object) (point) - (1+ (line-beginning-position 2)))))) + (line-beginning-position 2))))) + ;; At the beginning of a footnote definition, right after the + ;; label, is OK. + ((eq type 'footnote-definition) (looking-at (rx space))) ;; Other elements are invalid. ((eq (org-element-class context) 'element) nil) ;; Just before object is fine. diff --git a/lisp/org/org-lint.el b/lisp/org/org-lint.el index 5c64c5a5c9..da5e6ae799 100644 --- a/lisp/org/org-lint.el +++ b/lisp/org/org-lint.el @@ -350,7 +350,7 @@ called with one argument, the key used for comparison." (lambda (datum name) (goto-char (org-element-property :begin datum)) (re-search-forward - (format "^[ \t]*#\\+[A-Za-z]+: +%s *$" (regexp-quote name))) + (format "^[ \t]*#\\+[A-Za-z]+:[ \t]*%s[ \t]*$" (regexp-quote name))) (match-beginning 0)) (lambda (key) (format "Duplicate NAME \"%s\"" key)))) diff --git a/lisp/org/org-version.el b/lisp/org/org-version.el index 5bccbe497c..9948008774 100644 --- a/lisp/org/org-version.el +++ b/lisp/org/org-version.el @@ -11,7 +11,7 @@ Inserted by installing Org mode or when a release is made." (defun org-git-version () "The Git version of Org mode. Inserted by installing Org or when a release is made." - (let ((org-git-version "release_9.5-30-g10dc9d")) + (let ((org-git-version "release_9.5-46-gb71474")) org-git-version)) (provide 'org-version) diff --git a/lisp/org/org.el b/lisp/org/org.el index bc0ea24bee..c2a37e6cdd 100644 --- a/lisp/org/org.el +++ b/lisp/org/org.el @@ -15362,7 +15362,7 @@ The value is a list, with zero or more of the symbols `effort', `appt', "Save all Org buffers without user confirmation." (interactive) (message "Saving all Org buffers...") - (save-some-buffers t (lambda () (derived-mode-p 'org-mode))) + (save-some-buffers t (lambda () (and (derived-mode-p 'org-mode) t))) (when (featurep 'org-id) (org-id-locations-save)) (message "Saving all Org buffers... done")) commit 5d408f1a24fd6e0fe0ea4acd6c02887332de1494 Author: Stephen Gildea Date: Sat Oct 9 11:36:03 2021 -0700 Expanded testing of MH-E with multiple MH variants * test/lisp/mh-e/mh-utils-tests.el: Environment variable TEST_MH_PATH controls which installed MH variant to test with. Moved the commentary about testing with different MH variants from above 'with-mh-test-env' definition to "Commentary" section at the top of the file. * test/lisp/mh-e/test-all-mh-variants.sh: New script to test all installed MH variants. diff --git a/test/lisp/mh-e/mh-utils-tests.el b/test/lisp/mh-e/mh-utils-tests.el index bf684dbbea..a10c29fcf7 100644 --- a/test/lisp/mh-e/mh-utils-tests.el +++ b/test/lisp/mh-e/mh-utils-tests.el @@ -17,6 +17,34 @@ ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs. If not, see . +;;; Commentary: + +;; This test suite runs tests that use and depend on MH programs +;; installed on the system. + +;; When running such tests, MH-E can use a particular MH variant +;; installed on the system, or it can use the mocks provided here. +;; (Setup is done by the `with-mh-test-env' macro.) + +;; By setting environment variable TEST_MH_PATH, you can select which of +;; the installed MH variants to use, or ignore them all and use mocks. +;; See also the script test-all-mh-variants.sh in this directory. + +;; 1. To run these tests against the default MH variant installed on +;; this system: +;; cd ../.. && make lisp/mh-e/mh-utils-tests + +;; 2. To run these tests against an MH variant installed in a +;; specific directory, set TEST_MH_PATH, as in this example: +;; cd ../.. && make lisp/mh-e/mh-utils-tests TEST_MH_PATH=/usr/local/nmh/bin + +;; 3. To search for and run these tests against all MH variants +;; installed on this system: +;; ./test-all-mh-variants.sh + +;; Setting the environment variable TEST_MH_DEBUG or the Lisp variable +;; mh-test-utils-debug-mocks logs access to the file system during the test. + ;;; Code: (require 'ert) @@ -56,34 +84,32 @@ ;; Folder names that are used by the following tests. (defvar mh-test-rel-folder "rela-folder") (defvar mh-test-abs-folder "/abso-folder") -(defvar mh-test-no-such-folder "/testdir/none" - "Name of a folder that the user does not have.") +(defvar mh-test-no-such-folder "/testdir/none" "A folder that does not exist.") + +(defvar mh-test-utils-variants nil + "The value of `mh-variants' used for these tests. +This variable allows setting `mh-variants' to a limited set for targeted +testing. Its value can be different from the normal value when +environment variable TEST_MH_PATH is set. By remembering the value, we +can log the choice only once, which makes the batch log easier to read.") (defvar mh-test-variant-logged-already nil "Whether `with-mh-test-env' has written the MH variant to the log.") -(setq mh-test-variant-logged-already nil) ;reset if buffer is re-evaluated -(defvar mh-test-utils-debug-mocks nil +(defvar mh-test-utils-debug-mocks (> (length (getenv "TEST_MH_DEBUG")) 0) "Whether to log detailed behavior of mock functions.") (defvar mh-test-call-process-real (symbol-function 'call-process)) (defvar mh-test-file-directory-p-real (symbol-function 'file-directory-p)) - -;;; This macro wraps tests that touch the file system and/or run programs. -;;; When running such tests, MH-E can use a particular MH variant -;;; installed on the system, or it can use the mocks provided below. - -;;; By setting PATH and mh-sys-path, you can select which of the -;;; installed MH variants to use or ignore them all and use mocks. +;;; The macro with-mh-test-env wraps tests that touch the file system +;;; and/or run programs. (defmacro with-mh-test-env (&rest body) "Evaluate BODY with a test mail environment. Functions that touch the file system or run MH programs are either -mocked out or pointed at a test tree. When called from Emacs's batch -testing infrastructure, this will use mocks and thus run on systems -that do not have any MH variant installed. MH-E developers can -install an MH variant and test it interactively." +mocked out or pointed at a test tree. Uses `mh-test-utils-setup' to +select which." (declare (indent defun)) `(cl-letf ((temp-home-dir nil) ;; make local bindings for things we will modify for test env @@ -93,26 +119,56 @@ install an MH variant and test it interactively." ((symbol-function 'file-directory-p)) ;; the test always gets its own sub-folders cache (mh-sub-folders-cache (make-hash-table :test #'equal)) + ;; Allow envvar TEST_MH_PATH to control mh-variants. + (mh-variants mh-test-utils-variants) ;; remember the original value + (original-mh-test-variant-logged mh-test-variant-logged-already) + (original-mh-path mh-path) + (original-mh-sys-path mh-sys-path) + (original-exec-path exec-path) + (original-mh-variant-in-use mh-variant-in-use) + (original-mh-progs mh-progs) + (original-mh-lib mh-lib) + (original-mh-lib-progs mh-lib-progs) (original-mh-envvar (getenv "MH"))) (unwind-protect (progn (setq temp-home-dir (mh-test-utils-setup)) ,@body) + (unless noninteractive + ;; If interactive, forget that we logged the variant and + ;; restore any changes TEST_MH_PATH made. + (setq mh-test-variant-logged-already original-mh-test-variant-logged + mh-path original-mh-path + mh-sys-path original-mh-sys-path + exec-path original-exec-path + mh-variant-in-use original-mh-variant-in-use + mh-progs original-mh-progs + mh-lib original-mh-lib + mh-lib-progs original-mh-lib-progs)) (if temp-home-dir (delete-directory temp-home-dir t)) (setenv "MH" original-mh-envvar)))) (defun mh-test-utils-setup () "Set dynamically bound variables needed by mock and/or variants. +Call `mh-variant-set' to look through the directories named by +envionment variable `TEST_MH_PATH' (default: `mh-path' and `mh-sys-path') +to find the MH variant to use, if any. Return the name of the root of the created directory tree, if any." + (when (getenv "TEST_MH_PATH") + ;; force mh-variants to use only TEST_MH_PATH + (setq mh-path (split-string (getenv "TEST_MH_PATH") path-separator t) + mh-sys-path nil + exec-path '("/bin" "/usr/bin"))) (unless mh-test-variant-logged-already (mh-variant-set mh-variant) + (setq mh-test-utils-variants mh-variants) (setq mh-test-variant-logged-already t)) - ;; As `call-process'' and `file-directory-p' will be redefined, the - ;; native compiler will invoke `call-process' to compile the - ;; respective trampolines. To avoid interference with the - ;; `call-process' mocking, we build these ahead of time. (when (native-comp-available-p) + ;; As `call-process'' and `file-directory-p' will be redefined, the + ;; native compiler will invoke `call-process' to compile the + ;; respective trampolines. To avoid interference with the + ;; `call-process' mocking, we build these ahead of time. (mapc #'comp-subr-trampoline-install '(call-process file-directory-p))) (if mh-variant-in-use (mh-test-utils-setup-with-variant) diff --git a/test/lisp/mh-e/test-all-mh-variants.sh b/test/lisp/mh-e/test-all-mh-variants.sh new file mode 100755 index 0000000000..e917d8155b --- /dev/null +++ b/test/lisp/mh-e/test-all-mh-variants.sh @@ -0,0 +1,104 @@ +#! /bin/bash +# Run the mh-utils-tests against all MH variants found on this system. + +# Copyright (C) 2021 Free Software Foundation, Inc. + +# This file is part of GNU Emacs. + +# GNU Emacs is free software: you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation, either version 3 of the License, or +# (at your option) any later version. + +# GNU Emacs is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. + +# You should have received a copy of the GNU General Public License +# along with GNU Emacs. If not, see . + +# Commentary: + +# By default runs all tests; test names or Emacs-style regexps may be +# given on the command line to run just those tests. +# +# Option -d turns on Emacs variable mh-test-utils-debug-mocks, which +# causes the tests to output all interactions with the file system. + +# If you want to run the tests for only one MH variant, you don't need +# to use this script, because "make" can do it. See the commentary at +# the top of ./mh-utils-tests.el for the recipe. + +debug= +if [[ "$1" = -* ]]; then + if [[ "$1" != -d ]]; then + echo "Usage: $(basename "$0") [-d] [test ...]" >&2 + exit 2 + fi + debug=t + shift +fi + +shopt -s extglob +ert_test_list=() +for tst; do + # Guess the type the test spec + case $tst in + *[\[\].*+\\]*) # Regexp: put in string quotes + ert_test_list+=("\"$tst\"") + ;; + *) # Lisp expression, keyword, or symbol: use as is + ert_test_list+=("$tst") + ;; + esac +done +if [[ ${#ert_test_list[@]} -eq 0 ]]; then + # t means true for all tests, runs everything + ert_test_list=(t) +fi + +# This script is 3 directories down in the Emacs source tree. +cd "$(dirname "$0")" +cd ../../.. +emacs=(src/emacs --batch -Q) + +# MH-E has a good list of directories where an MH variant might be installed, +# so we look in each of those. +read -r -a mh_sys_path \ + < <("${emacs[@]}" -l mh-e --eval "(princ mh-sys-path)" | sed 's/[()]//g') + +have_done_mocked_variant=false +declare -i tests_total=0 tests_passed=0 + +for path in "${mh_sys_path[@]}"; do + if [[ ! -x "$path/mhparam" ]]; then + if [[ "$have_done_mocked_variant" = false ]]; then + have_done_mocked_variant=true + else + continue + fi + fi + echo "Testing with PATH $path" + ((++tests_total)) + # The LD_LIBRARY_PATH setting is needed + # to run locally installed Mailutils. + TEST_MH_PATH=$path TEST_MH_DEBUG=$debug \ + LD_LIBRARY_PATH=/usr/local/lib HOME=/nonexistent \ + "${emacs[@]}" -l ert \ + --eval "(setq load-prefer-newer t)" \ + --eval "(load \"$PWD/test/lisp/mh-e/mh-utils-tests\" nil t)" \ + --eval "(ert-run-tests-batch-and-exit '(or ${ert_test_list[*]}))" \ + && ((++tests_passed)) +done + +if (( tests_total == 0 )); then + echo "NO tests run" + exit 1 +elif (( tests_total == tests_passed )); then + echo "All tested variants pass: $tests_passed/$tests_total" +else + echo "Tested variants passing: $tests_passed/$tests_total," \ + "FAILING: $((tests_total - tests_passed))/$tests_total" + exit 1 +fi commit b497add9719dac16696f64d5a551d2b813f0c825 Author: Philipp Stephani Date: Sat Oct 9 19:39:31 2021 +0200 Fix Seccomp filter for newer GNU/Linux systems (Bug#51073). On some systems, process startup calls prctl(PR_CAPBSET_READ) via 'cap_get_bound'. We can just return EINVAL. * lib-src/seccomp-filter.c (main): Add a rule for prctl(PR_CAPBSET_READ, ...). diff --git a/lib-src/seccomp-filter.c b/lib-src/seccomp-filter.c index d378e0b027..e7496053a8 100644 --- a/lib-src/seccomp-filter.c +++ b/lib-src/seccomp-filter.c @@ -351,6 +351,8 @@ main (int argc, char **argv) calls at startup time to set up thread-local storage. */ RULE (SCMP_ACT_ALLOW, SCMP_SYS (execve)); RULE (SCMP_ACT_ALLOW, SCMP_SYS (set_tid_address)); + RULE (SCMP_ACT_ERRNO (EINVAL), SCMP_SYS (prctl), + SCMP_A0_32 (SCMP_CMP_EQ, PR_CAPBSET_READ)); RULE (SCMP_ACT_ALLOW, SCMP_SYS (arch_prctl), SCMP_A0_32 (SCMP_CMP_EQ, ARCH_SET_FS)); RULE (SCMP_ACT_ERRNO (EINVAL), SCMP_SYS (arch_prctl), commit 75d9fbec8853c2040bbb0d5a447894cca86b9df9 Author: Michael Albinus Date: Sat Oct 9 18:42:11 2021 +0200 Tramp code cleanup * lisp/net/tramp.el (tramp-remote-path): Adapt docstring. (tramp-action-login, tramp-action-password, tramp-action-yesno) (tramp-action-yn, tramp-process-actions): Move let-binding of `enable-recursive-minibuffers' up. (tramp-handle-make-process, tramp-handle-write-region): * lisp/net/tramp-adb.el (tramp-adb-handle-write-region) (tramp-adb-handle-make-process): * lisp/net/tramp-sh.el (tramp-sh-handle-make-process) (tramp-sh-handle-write-region): * lisp/net/tramp-smb.el (tramp-smb-handle-write-region): * lisp/net/tramp-sshfs.el (tramp-sshfs-handle-write-region): Use `string-or-null-p'. diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el index d68d4c7b76..63ffb2d057 100644 --- a/lisp/net/tramp-adb.el +++ b/lisp/net/tramp-adb.el @@ -600,7 +600,7 @@ But handle the case, if the \"test\" command is not available." ;; The end. (when (and (null noninteractive) - (or (eq visit t) (null visit) (stringp visit))) + (or (eq visit t) (string-or-null-p visit))) (tramp-message v 0 "Wrote %s" filename)) (run-hooks 'tramp-handle-write-region-hook)))) @@ -933,8 +933,8 @@ implementation will be used." (stderr (plist-get args :stderr))) (unless (stringp name) (signal 'wrong-type-argument (list #'stringp name))) - (unless (or (null buffer) (bufferp buffer) (stringp buffer)) - (signal 'wrong-type-argument (list #'stringp buffer))) + (unless (or (bufferp buffer) (string-or-null-p buffer)) + (signal 'wrong-type-argument (list #'bufferp buffer))) (unless (consp command) (signal 'wrong-type-argument (list #'consp command))) (unless (or (null coding) @@ -951,7 +951,7 @@ implementation will be used." (signal 'wrong-type-argument (list #'functionp filter))) (unless (or (null sentinel) (functionp sentinel)) (signal 'wrong-type-argument (list #'functionp sentinel))) - (unless (or (null stderr) (bufferp stderr) (stringp stderr)) + (unless (or (bufferp stderr) (string-or-null-p stderr)) (signal 'wrong-type-argument (list #'bufferp stderr))) (when (and (stringp stderr) (tramp-tramp-file-p stderr) (not (tramp-equal-remote default-directory stderr))) diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index dd92f22689..8fa53cb5a2 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -2771,8 +2771,8 @@ implementation will be used." (stderr (plist-get args :stderr))) (unless (stringp name) (signal 'wrong-type-argument (list #'stringp name))) - (unless (or (null buffer) (bufferp buffer) (stringp buffer)) - (signal 'wrong-type-argument (list #'stringp buffer))) + (unless (or (bufferp buffer) (string-or-null-p buffer)) + (signal 'wrong-type-argument (list #'bufferp buffer))) (unless (or (null command) (consp command)) (signal 'wrong-type-argument (list #'consp command))) (unless (or (null coding) @@ -2789,7 +2789,7 @@ implementation will be used." (signal 'wrong-type-argument (list #'functionp filter))) (unless (or (null sentinel) (functionp sentinel)) (signal 'wrong-type-argument (list #'functionp sentinel))) - (unless (or (null stderr) (bufferp stderr) (stringp stderr)) + (unless (or (bufferp stderr) (string-or-null-p stderr)) (signal 'wrong-type-argument (list #'bufferp stderr))) (when (and (stringp stderr) (not (tramp-equal-remote default-directory stderr))) @@ -3513,7 +3513,7 @@ implementation will be used." (tramp-compat-funcall 'unlock-file lockname)) (when (and (null noninteractive) - (or (eq visit t) (null visit) (stringp visit))) + (or (eq visit t) (string-or-null-p visit))) (tramp-message v 0 "Wrote %s" filename)) (run-hooks 'tramp-handle-write-region-hook))))) diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el index 87f3665d91..49f049d3f3 100644 --- a/lisp/net/tramp-smb.el +++ b/lisp/net/tramp-smb.el @@ -1658,7 +1658,7 @@ errors for shares like \"C$/\", which are common in Microsoft Windows." ;; The end. (when (and (null noninteractive) - (or (eq visit t) (null visit) (stringp visit))) + (or (eq visit t) (string-or-null-p visit))) (tramp-message v 0 "Wrote %s" filename)) (run-hooks 'tramp-handle-write-region-hook)))) diff --git a/lisp/net/tramp-sshfs.el b/lisp/net/tramp-sshfs.el index 1bd4c5dc1c..a100786345 100644 --- a/lisp/net/tramp-sshfs.el +++ b/lisp/net/tramp-sshfs.el @@ -320,7 +320,7 @@ arguments to pass to the OPERATION." ;; The end. (when (and (null noninteractive) - (or (eq visit t) (null visit) (stringp visit))) + (or (eq visit t) (string-or-null-p visit))) (tramp-message v 0 "Wrote %s" filename)) (run-hooks 'tramp-handle-write-region-hook)))) diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index c0f1cb161e..a8ae71b147 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -1304,7 +1304,7 @@ let-bind this variable." ;; "getconf PATH" yields: ;; HP-UX: /usr/bin:/usr/ccs/bin:/opt/ansic/bin:/opt/langtools/bin:/opt/fortran/bin ;; Solaris: /usr/xpg4/bin:/usr/ccs/bin:/usr/bin:/opt/SUNWspro/bin -;; GNU/Linux (Debian, Suse, RHEL): /bin:/usr/bin +;; GNU/Linux (Debian, Suse, RHEL, Cygwin, MINGW64): /bin:/usr/bin ;; FreeBSD, DragonFly: /usr/bin:/bin:/usr/sbin:/sbin: - beware trailing ":"! ;; FreeBSD 12.1, Darwin: /usr/bin:/bin:/usr/sbin:/sbin ;; IRIX64: /usr/bin @@ -1326,9 +1326,9 @@ tilde expansion, all directory names starting with \"~\" will be ignored. the command \"getconf PATH\". It is recommended to use this entry on head of this list, because these are the default directories for POSIX compatible commands. On remote hosts which -do not offer the getconf command (like cygwin), the value -\"/bin:/usr/bin\" is used instead. This entry is represented in -the list by the special value `tramp-default-remote-path'. +do not offer the getconf command, the value \"/bin:/usr/bin\" is +used instead. This entry is represented in the list by the +special value `tramp-default-remote-path'. `Private Directories' are the settings of the $PATH environment, as given in your `~/.profile'. This entry is represented in @@ -4127,8 +4127,8 @@ substitution. SPEC-LIST is a list of char/value pairs used for (stderr (plist-get args :stderr))) (unless (stringp name) (signal 'wrong-type-argument (list #'stringp name))) - (unless (or (null buffer) (bufferp buffer) (stringp buffer)) - (signal 'wrong-type-argument (list #'stringp buffer))) + (unless (or (bufferp buffer) (string-or-null-p buffer)) + (signal 'wrong-type-argument (list #'bufferp buffer))) (unless (consp command) (signal 'wrong-type-argument (list #'consp command))) (unless (or (null coding) @@ -4564,7 +4564,7 @@ of." ;; The end. (when (and (null noninteractive) - (or (eq visit t) (null visit) (stringp visit))) + (or (eq visit t) (string-or-null-p visit))) (tramp-message v 0 "Wrote %s" filename)) (run-hooks 'tramp-handle-write-region-hook)))) @@ -4630,9 +4630,8 @@ of." (let ((user (or (tramp-file-name-user vec) (with-tramp-connection-property vec "login-as" (save-window-excursion - (let ((enable-recursive-minibuffers t)) - (pop-to-buffer (tramp-get-connection-buffer vec)) - (read-string (match-string 0)))))))) + (pop-to-buffer (tramp-get-connection-buffer vec)) + (read-string (match-string 0))))))) (with-current-buffer (tramp-get-connection-buffer vec) (tramp-message vec 6 "\n%s" (buffer-string))) (tramp-message vec 3 "Sending login name `%s'" user) @@ -4642,8 +4641,7 @@ of." (defun tramp-action-password (proc vec) "Query the user for a password." (with-current-buffer (process-buffer proc) - (let ((enable-recursive-minibuffers t) - (case-fold-search t)) + (let ((case-fold-search t)) ;; Let's check whether a wrong password has been sent already. ;; Sometimes, the process returns a new password request ;; immediately after rejecting the previous (wrong) one. @@ -4674,14 +4672,13 @@ of." Send \"yes\" to remote process on confirmation, abort otherwise. See also `tramp-action-yn'." (save-window-excursion - (let ((enable-recursive-minibuffers t)) - (pop-to-buffer (tramp-get-connection-buffer vec)) - (unless (yes-or-no-p (match-string 0)) - (kill-process proc) - (throw 'tramp-action 'permission-denied)) - (with-current-buffer (tramp-get-connection-buffer vec) - (tramp-message vec 6 "\n%s" (buffer-string))) - (tramp-send-string vec (concat "yes" tramp-local-end-of-line)))) + (pop-to-buffer (tramp-get-connection-buffer vec)) + (unless (yes-or-no-p (match-string 0)) + (kill-process proc) + (throw 'tramp-action 'permission-denied)) + (with-current-buffer (tramp-get-connection-buffer vec) + (tramp-message vec 6 "\n%s" (buffer-string))) + (tramp-send-string vec (concat "yes" tramp-local-end-of-line))) t) (defun tramp-action-yn (proc vec) @@ -4689,14 +4686,13 @@ See also `tramp-action-yn'." Send \"y\" to remote process on confirmation, abort otherwise. See also `tramp-action-yesno'." (save-window-excursion - (let ((enable-recursive-minibuffers t)) - (pop-to-buffer (tramp-get-connection-buffer vec)) - (unless (y-or-n-p (match-string 0)) - (kill-process proc) - (throw 'tramp-action 'permission-denied)) - (with-current-buffer (tramp-get-connection-buffer vec) - (tramp-message vec 6 "\n%s" (buffer-string))) - (tramp-send-string vec (concat "y" tramp-local-end-of-line)))) + (pop-to-buffer (tramp-get-connection-buffer vec)) + (unless (y-or-n-p (match-string 0)) + (kill-process proc) + (throw 'tramp-action 'permission-denied)) + (with-current-buffer (tramp-get-connection-buffer vec) + (tramp-message vec 6 "\n%s" (buffer-string))) + (tramp-send-string vec (concat "y" tramp-local-end-of-line))) t) (defun tramp-action-terminal (_proc vec) @@ -4830,7 +4826,8 @@ performed successfully. Any other value means an error." (save-restriction (with-tramp-progress-reporter proc 3 "Waiting for prompts from remote shell" - (let (exit) + (let ((enable-recursive-minibuffers t) + exit) (if timeout (with-timeout (timeout (setq exit 'timeout)) (while (not exit)