commit e6f3a4dc6cd4ffca9b8b2ea0c9271f832df07e3e (HEAD, refs/remotes/origin/master) Author: João Távora Date: Sun Aug 15 09:12:23 2021 +0100 Fix bug#50063 when using icomplete-fido-kill with C-x p p C-x p p utilizes a completion table "category" which is 'project-file' icomplete-fido-kill only functioned for 'buffer' and 'file', and failed with a non-informative message when something else was used. * lisp/icomplete.el (icomplete-fido-kill): Support 'project-file' class. Use cl-case, instead of pcase. diff --git a/lisp/icomplete.el b/lisp/icomplete.el index adea1505fd..cd1979d04a 100644 --- a/lisp/icomplete.el +++ b/lisp/icomplete.el @@ -298,18 +298,21 @@ require user confirmation." (call-interactively 'kill-line) (let* ((all (completion-all-sorted-completions)) (thing (car all)) + (cat (icomplete--category)) (action - (pcase (icomplete--category) - (`buffer + (cl-case cat + (buffer (lambda () (when (yes-or-no-p (concat "Kill buffer " thing "? ")) (kill-buffer thing)))) - (`file + ((project-file file) (lambda () (let* ((dir (file-name-directory (icomplete--field-string))) (path (expand-file-name thing dir))) (when (yes-or-no-p (concat "Delete file " path "? ")) - (delete-file path) t))))))) + (delete-file path) t)))) + (t + (error "Sorry, don't know how to kill things for `%s'" cat))))) (when (let (;; Allow `yes-or-no-p' to work and don't let it ;; `icomplete-exhibit' anything. (enable-recursive-minibuffers t) commit 3572613550f5d1d0b3392dbc809b32f3989e2981 Author: Wolfgang Scherer Date: Sun Aug 15 04:02:23 2021 +0300 Fix vc-git-state for filenames with wildcards * lisp/vc/vc-git.el: (vc-git--literal-pathspec-inner), (vc-git--literal-pathspec), (vc-git--literal-pathspecs) new functions to add ":(literal)" pathspec magic (bug#39452). (vc-git-registered), (vc-git-state), (vc-git-dir-status-goto-stage), (vc-git-register), (vc-git-unregister), (vc-git-checkin), (vc-git-find-revision), (vc-git-checkout), (vc-git-revert), (vc-git-conflicted-files), (vc-git-print-log), (vc-git-diff), (vc-git-previous-revision), (vc-git-next-revision), (vc-git-delete-file), (vc-git-rename-file) functions vc-git--literal-pathspec, vc-git--literal-pathspecs applied. diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el index 5828a83deb..ffe1e6832c 100644 --- a/lisp/vc/vc-git.el +++ b/lisp/vc/vc-git.el @@ -242,6 +242,15 @@ included in the completions." ;;;###autoload (load "vc-git" nil t) ;;;###autoload (vc-git-registered file)))) +(defun vc-git--literal-pathspec (pathspec) + "Prepend :(literal) path magic to PATHSPEC." + ;; Good example of PATHSPEC that needs this: "test[56].xx". + (and pathspec (concat ":(literal)" pathspec))) + +(defun vc-git--literal-pathspecs (pathspecs) + "Prepend :(literal) path magic to PATHSPECS." + (mapcar #'vc-git--literal-pathspec pathspecs)) + (defun vc-git-registered (file) "Check whether FILE is registered with git." (let ((dir (vc-git-root file))) @@ -255,12 +264,12 @@ included in the completions." (name (file-relative-name file dir)) (str (with-demoted-errors "Error: %S" (cd dir) - (vc-git--out-ok "ls-files" "-c" "-z" "--" name) + (vc-git--out-ok "ls-files" "-c" "-z" "--" (vc-git--literal-pathspec name)) ;; If result is empty, use ls-tree to check for deleted ;; file. (when (eq (point-min) (point-max)) (vc-git--out-ok "ls-tree" "--name-only" "-z" "HEAD" - "--" name)) + "--" (vc-git--literal-pathspec name))) (buffer-string)))) (and str (> (length str) (length name)) @@ -342,7 +351,7 @@ in the order given by `git status'." ,@(when (version<= "1.7.6.3" (vc-git--program-version)) '("--ignored")) "--")) - (status (apply #'vc-git--run-command-string file args))) + (status (apply #'vc-git--run-command-string (vc-git--literal-pathspec file) args))) (if (null status) ;; If status is nil, there was an error calling git, likely because ;; the file is not in a git repo. @@ -620,28 +629,28 @@ or an empty string if none." (pcase (vc-git-dir-status-state->stage git-state) ('update-index (if files - (vc-git-command (current-buffer) 'async files "add" "--refresh" "--") + (vc-git-command (current-buffer) 'async (vc-git--literal-pathspecs files) "add" "--refresh" "--") (vc-git-command (current-buffer) 'async nil "update-index" "--refresh"))) ('ls-files-added - (vc-git-command (current-buffer) 'async files + (vc-git-command (current-buffer) 'async (vc-git--literal-pathspecs files) "ls-files" "-z" "-c" "-s" "--")) ('ls-files-up-to-date - (vc-git-command (current-buffer) 'async files + (vc-git-command (current-buffer) 'async (vc-git--literal-pathspecs files) "ls-files" "-z" "-c" "-s" "--")) ('ls-files-conflict - (vc-git-command (current-buffer) 'async files + (vc-git-command (current-buffer) 'async (vc-git--literal-pathspecs files) "ls-files" "-z" "-u" "--")) ('ls-files-unknown - (vc-git-command (current-buffer) 'async files + (vc-git-command (current-buffer) 'async (vc-git--literal-pathspecs files) "ls-files" "-z" "-o" "--exclude-standard" "--")) ('ls-files-ignored - (vc-git-command (current-buffer) 'async files + (vc-git-command (current-buffer) 'async (vc-git--literal-pathspecs files) "ls-files" "-z" "-o" "-i" "--directory" "--no-empty-directory" "--exclude-standard" "--")) ;; --relative added in Git 1.5.5. ('diff-index - (vc-git-command (current-buffer) 'async files + (vc-git-command (current-buffer) 'async (vc-git--literal-pathspecs files) "diff-index" "--relative" "-z" "-M" "HEAD" "--"))) (vc-run-delayed (vc-git-after-dir-status-stage git-state)))) @@ -867,14 +876,14 @@ The car of the list is the current branch." (push crt dlist) (push crt flist))) (when flist - (vc-git-command nil 0 flist "update-index" "--add" "--")) + (vc-git-command nil 0 (vc-git--literal-pathspecs flist) "update-index" "--add" "--")) (when dlist - (vc-git-command nil 0 dlist "add")))) + (vc-git-command nil 0 (vc-git--literal-pathspecs dlist) "add")))) (defalias 'vc-git-responsible-p #'vc-git-root) (defun vc-git-unregister (file) - (vc-git-command nil 0 file "rm" "-f" "--cached" "--")) + (vc-git-command nil 0 (vc-git--literal-pathspec file) "rm" "-f" "--cached" "--")) (declare-function log-edit-mode "log-edit" ()) (declare-function log-edit-toggle-header "log-edit" (header value)) @@ -941,7 +950,7 @@ It is based on `log-edit-mode', and has Git-specific extensions.") (lambda (value) (when (equal value "yes") (list argument))))) ;; When operating on the whole tree, better pass "-a" than ".", since "." ;; fails when we're committing a merge. - (apply #'vc-git-command nil 0 (if only files) + (apply #'vc-git-command nil 0 (if only (vc-git--literal-pathspecs files)) (nconc (if msg-file (list "commit" "-F" (file-local-name msg-file)) (list "commit" "-m")) @@ -968,7 +977,7 @@ It is based on `log-edit-mode', and has Git-specific extensions.") (coding-system-for-write 'binary) (fullname (let ((fn (vc-git--run-command-string - file "ls-files" "-z" "--full-name" "--"))) + (vc-git--literal-pathspec file) "ls-files" "-z" "--full-name" "--"))) ;; ls-files does not return anything when looking for a ;; revision of a file that has been renamed or removed. (if (string= fn "") @@ -985,14 +994,14 @@ It is based on `log-edit-mode', and has Git-specific extensions.") (vc-git-root file))) (defun vc-git-checkout (file &optional rev) - (vc-git-command nil 0 file "checkout" (or rev "HEAD"))) + (vc-git-command nil 0 (vc-git--literal-pathspec file) "checkout" (or rev "HEAD"))) (defun vc-git-revert (file &optional contents-done) "Revert FILE to the version stored in the git repository." (if contents-done (vc-git-command nil 0 file "update-index" "--") - (vc-git-command nil 0 file "reset" "-q" "--") - (vc-git-command nil nil file "checkout" "-q" "--"))) + (vc-git-command nil 0 (vc-git--literal-pathspec file) "reset" "-q" "--") + (vc-git-command nil nil (vc-git--literal-pathspec file) "checkout" "-q" "--"))) (defvar vc-git-error-regexp-alist '(("^ \\(.+\\)\\> *|" 1 nil nil 0)) @@ -1076,7 +1085,7 @@ This prompts for a branch to merge from." (defun vc-git-conflicted-files (directory) "Return the list of files with conflicts in DIRECTORY." (let* ((status - (vc-git--run-command-string directory "status" "--porcelain" "--")) + (vc-git--run-command-string (vc-git--literal-pathspec directory) "status" "--porcelain" "--")) (lines (when status (split-string status "\n" 'omit-nulls))) files) (dolist (line lines files) @@ -1157,7 +1166,7 @@ If LIMIT is a revision string, use it as an end-revision." (let ((inhibit-read-only t)) (with-current-buffer buffer (apply #'vc-git-command buffer - 'async files + 'async (vc-git--literal-pathspecs files) (append '("log" "--no-color") (when (and vc-git-print-log-follow @@ -1408,7 +1417,7 @@ This requires git 1.8.4 or later, for the \"-L\" option of \"git log\"." (if vc-git-diff-switches (apply #'vc-git-command (or buffer "*vc-diff*") 1 ; bug#21969 - files + (vc-git--literal-pathspecs files) command "--exit-code" (append (vc-switches 'git 'diff) @@ -1493,7 +1502,7 @@ This requires git 1.8.4 or later, for the \"-L\" option of \"git log\"." (let* ((fname (file-relative-name file)) (prev-rev (with-temp-buffer (and - (vc-git--out-ok "rev-list" "-2" rev "--" fname) + (vc-git--out-ok "rev-list" "-2" rev "--" (vc-git--literal-pathspec fname)) (goto-char (point-max)) (bolp) (zerop (forward-line -1)) @@ -1521,7 +1530,7 @@ This requires git 1.8.4 or later, for the \"-L\" option of \"git log\"." (current-rev (with-temp-buffer (and - (vc-git--out-ok "rev-list" "-1" rev "--" file) + (vc-git--out-ok "rev-list" "-1" rev "--" (vc-git--literal-pathspec file)) (goto-char (point-max)) (bolp) (zerop (forward-line -1)) @@ -1533,7 +1542,7 @@ This requires git 1.8.4 or later, for the \"-L\" option of \"git log\"." (and current-rev (with-temp-buffer (and - (vc-git--out-ok "rev-list" "HEAD" "--" file) + (vc-git--out-ok "rev-list" "HEAD" "--" (vc-git--literal-pathspec file)) (goto-char (point-min)) (search-forward current-rev nil t) (zerop (forward-line -1)) @@ -1543,13 +1552,13 @@ This requires git 1.8.4 or later, for the \"-L\" option of \"git log\"." (or (vc-git-symbolic-commit next-rev) next-rev))) (defun vc-git-delete-file (file) - (vc-git-command nil 0 file "rm" "-f" "--")) + (vc-git-command nil 0 (vc-git--literal-pathspecs file) "rm" "-f" "--")) (defun vc-git-rename-file (old new) - (vc-git-command nil 0 (list old new) "mv" "-f" "--")) + (vc-git-command nil 0 (vc-git--literal-pathspecs (list old new)) "mv" "-f" "--")) (defun vc-git-mark-resolved (files) - (vc-git-command nil 0 files "add")) + (vc-git-command nil 0 (vc-git--literal-pathspecs files) "add")) (defvar vc-git-extra-menu-map (let ((map (make-sparse-keymap))) commit d1dbf7fc9e64add642f3cfe22231afebac62cad2 Author: Dmitry Gutov Date: Sun Aug 15 03:45:42 2021 +0300 Revert "Bind the GIT_LITERAL_PATHSPECS environment variable" This reverts commit a2d0ff26005c5c10ffe0d84bd8b458a06828be82. It was found to break a certain use case, and we decided to go with the other solution (bug#39452). diff --git a/etc/NEWS b/etc/NEWS index a3a2543628..09ace73f5d 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -961,12 +961,6 @@ keys, add the following to your init file: ** Change Logs and VC -*** vc-git now sets the 'GIT_LITERAL_PATHSPECS' environment variable. -This ensures that Git operations on files containing wildcard -characters work as they're supposed to. However, this also affects -scripts running from Git hooks, and these have to "unset -GIT_LITERAL_PATHSPECS" to work as before. - *** More VC commands can be used from non-file buffers. The relevant commands are those that don't change the VC state. The non-file buffers which can use VC commands are those that have diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el index 143087122f..5828a83deb 100644 --- a/lisp/vc/vc-git.el +++ b/lisp/vc/vc-git.el @@ -1772,7 +1772,6 @@ The difference to vc-do-command is that this function always invokes (process-environment (append `("GIT_DIR" - "GIT_LITERAL_PATHSPECS=1" ;; Avoid repository locking during background operations ;; (bug#21559). ,@(when revert-buffer-in-progress-p @@ -1807,7 +1806,6 @@ The difference to vc-do-command is that this function always invokes (process-environment (append `("GIT_DIR" - "GIT_LITERAL_PATHSPECS=1" ;; Avoid repository locking during background operations ;; (bug#21559). ,@(when revert-buffer-in-progress-p commit 31ab12e26168c272b291fe91c009cc53b3e55492 Author: Lars Ingebrigtsen Date: Sat Aug 14 21:37:32 2021 +0200 Mark auto-revert-test02-auto-revert-deleted-file as unstable * test/lisp/autorevert-tests.el (auto-revert-test02-auto-revert-deleted-file): This tests fails about 30% of the time for me. diff --git a/test/lisp/autorevert-tests.el b/test/lisp/autorevert-tests.el index 449dabf987..96169c75d3 100644 --- a/test/lisp/autorevert-tests.el +++ b/test/lisp/autorevert-tests.el @@ -286,7 +286,7 @@ This expects `auto-revert--messages' to be bound by ;; Repeated unpredictable failures, bug#32645. ;; Unlikely to be hydra-specific? ; (skip-unless (not (getenv "EMACS_HYDRA_CI"))) - + :tags '(:unstable) (with-auto-revert-test (let ((tmpfile (make-temp-file "auto-revert-test")) ;; Try to catch bug#32645. commit 9c5dc3cbe03f0e814d8a31cf2e2033a489bc1c3b Author: Eli Zaretskii Date: Sat Aug 14 20:38:05 2021 +0300 * src/w32.c (_sys_read_ahead): Pacify a silly compiler warning. diff --git a/src/w32.c b/src/w32.c index 180c73aa0f..0eb69d4b1d 100644 --- a/src/w32.c +++ b/src/w32.c @@ -8758,7 +8758,7 @@ int _sys_read_ahead (int fd) { child_process * cp; - int rc; + int rc = 0; if (fd < 0 || fd >= MAXDESC) return STATUS_READ_ERROR; commit bf55b5ac17cd5a40ad5ff2e25af7e050602180bb Author: Stefan Monnier Date: Sat Aug 14 12:22:57 2021 -0400 * lisp/emacs-lisp/easymenu.el (easy-menu-do-define): Fix bug#50051 This corrects the quite confused conversion to closure done in commit a070bd1c8b5213ad469d41dd80d392f924644aed. diff --git a/lisp/emacs-lisp/easymenu.el b/lisp/emacs-lisp/easymenu.el index f6661541a1..360e685ea0 100644 --- a/lisp/emacs-lisp/easymenu.el +++ b/lisp/emacs-lisp/easymenu.el @@ -175,16 +175,14 @@ This is expected to be bound to a mouse event." (set symbol keymap) (defalias symbol (lambda (event) (:documentation doc) (interactive "@e") - ;; FIXME: XEmacs uses popup-menu which calls the binding - ;; while x-popup-menu only returns the selection. (x-popup-menu event - (or (and (symbolp symbol) + (or (and (symbolp keymap) (funcall - (or (plist-get (get symbol 'menu-prop) + (or (plist-get (get keymap 'menu-prop) :filter) #'identity) - (symbol-function symbol))) - symbol)))) + (symbol-function keymap))) + keymap)))) ;; These symbols are commands, but not interesting for users ;; to `M-x TAB'. (function-put symbol 'completion-predicate #'ignore)) @@ -257,7 +255,7 @@ possibly preceded by keyword pairs as described in `easy-menu-define'." ;; anyway, so we'd better not convert it at all (it will ;; be converted on the fly by easy-menu-filter-return). menu-items - (append menu (mapcar 'easy-menu-convert-item menu-items)))) + (append menu (mapcar #'easy-menu-convert-item menu-items)))) (when prop (setq menu (easy-menu-make-symbol menu 'noexp)) (put menu 'menu-prop prop)) @@ -667,7 +665,7 @@ In some cases we use that to select between the local and global maps." (let* ((name (if path (format "%s" (car (reverse path))))) (newmap (make-sparse-keymap name))) (define-key (or map (current-local-map)) - (apply 'vector (mapcar 'easy-menu-intern path)) + (apply #'vector (mapcar #'easy-menu-intern path)) (if name (cons name newmap) newmap)) newmap)))) (or (keymapp map) (error "Malformed menu in easy-menu: (%s)" map)) commit e3205eaeef9c7c8a5616c4e4158ecc11aea2cb18 Author: Alan Mackenzie Date: Sat Aug 14 14:42:55 2021 +0000 * lisp/progmodes/cc-engine.el (c-ml-string-in-end-delim): Rewrite function diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el index 4222dbefa9..7f7175f74f 100644 --- a/lisp/progmodes/cc-engine.el +++ b/lisp/progmodes/cc-engine.el @@ -7393,29 +7393,51 @@ multi-line strings (but not C++, for example)." (save-excursion (goto-char beg) (when open-delim + ;; If BEG is in an opener, move back to a position we know to be "safe". (if (<= beg (cadr open-delim)) (goto-char (cadr open-delim)) (c-ml-string-back-to-neutral (car open-delim)))) - (or (and c-ml-string-back-closer-re - (looking-at c-ml-string-any-closer-re) - (eq (c-in-literal) 'string) - (goto-char (match-end 0))) - (progn - (while - (and - (search-forward-regexp - c-ml-string-any-closer-re - (min (+ end c-ml-string-max-closer-len-no-leader) (point-max)) - t) - (save-excursion - (goto-char (match-end 1)) - (not (c-in-literal))) - (<= (point) beg) - (not (save-excursion - (goto-char (match-beginning 2)) - (c-literal-start))))))) - - (unless (or (and (not (eobp)) + + (let (saved-match-data) + (or + ;; If we might be in the middle of "context" bytes at the start of a + ;; closer, move to after the closer. + (and c-ml-string-back-closer-re + (looking-at c-ml-string-any-closer-re) + (eq (c-in-literal) 'string) + (setq saved-match-data (match-data)) + (goto-char (match-end 0))) + + ;; Otherwise, move forward over closers while we haven't yet reached END, + ;; until we're after BEG. + (progn + (while + (let (found) + (while ; Go over a single real closer. + (and + (search-forward-regexp + c-ml-string-any-closer-re + (min (+ end c-ml-string-max-closer-len-no-leader) + (point-max)) + t) + (save-excursion + (goto-char (match-end 1)) + (if (c-in-literal) ; a psuedo closer. + t + (setq saved-match-data (match-data)) + (setq found t) + nil)))) + (and found + (<= (point) beg)) + ;; (not (save-excursion + ;; (goto-char (match-beginning 2)) + ;; (c-literal-start))) + )))) + (set-match-data saved-match-data)) + + ;; Test whether we've found the sought closing delimiter. + (unless (or (null (match-data)) + (and (not (eobp)) (<= (point) beg)) (> (match-beginning 0) beg) (progn (goto-char (match-beginning 2)) commit 482049e54277f0a429efdcd660286e9e7b465033 Author: Eli Zaretskii Date: Sat Aug 14 17:39:38 2021 +0300 Fix 'random' on MS-Windows when integers are wider than 30 bits * src/w32.c (random): Provide more random bits for MS-Windows builds with EMACS_INT that is wider than 32 bits. (Bug#32605) diff --git a/src/w32.c b/src/w32.c index 968b4bbe48..180c73aa0f 100644 --- a/src/w32.c +++ b/src/w32.c @@ -2389,8 +2389,13 @@ rand_as183 (void) int random (void) { - /* rand_as183 () gives us 15 random bits...hack together 30 bits. */ + /* rand_as183 () gives us 15 random bits...hack together 30 bits for + Emacs with 32-bit EMACS_INT, and at least 31 bit for wider EMACS_INT. */ +#if EMACS_INT_MAX > INT_MAX + return ((rand_as183 () << 30) | (rand_as183 () << 15) | rand_as183 ()); +#else return ((rand_as183 () << 15) | rand_as183 ()); +#endif } void commit e5cb6d3fd1875e425be31fd885519326ba2304b8 Author: Lars Ingebrigtsen Date: Sat Aug 14 16:08:48 2021 +0200 Add a test for netrc folding parsing (bug#25769) diff --git a/test/lisp/net/netrc-resources/netrc-folding b/test/lisp/net/netrc-resources/netrc-folding new file mode 100644 index 0000000000..85e5e324cd --- /dev/null +++ b/test/lisp/net/netrc-resources/netrc-folding @@ -0,0 +1,6 @@ +# Foo +machine XM login XL password XP + +machine YM + login YL + password YP diff --git a/test/lisp/net/netrc-tests.el b/test/lisp/net/netrc-tests.el index 1328b19149..f75328a59f 100644 --- a/test/lisp/net/netrc-tests.el +++ b/test/lisp/net/netrc-tests.el @@ -48,6 +48,13 @@ (should (equal (netrc-credentials "ftp.example.org") '("jrh" "*baz*"))))) +(ert-deftest test-netrc-credentials () + (let ((netrc-file (ert-resource-file "netrc-folding"))) + (should + (equal (netrc-parse netrc-file) + '((("machine" . "XM") ("login" . "XL") ("password" . "XP")) + (("machine" . "YM")) (("login" . "YL")) (("password" . "YP"))))))) + (provide 'netrc-tests) ;;; netrc-tests.el ends here commit 3c053ef14248742726e4a44dc4a809874ce76c72 Author: Lars Ingebrigtsen Date: Sat Aug 14 15:50:55 2021 +0200 Filter out -L foo labels in diff-hunk-file-names * lisp/vc/diff-mode.el (diff-hunk-file-names): Filter out "-L foo" labels (bug#10160). diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el index bb1c46c070..eeb32f8fe5 100644 --- a/lisp/vc/diff-mode.el +++ b/lisp/vc/diff-mode.el @@ -969,11 +969,11 @@ If the OLD prefix arg is passed, tell the file NAME of the old file." (list (match-string 1))) header-files ;; this assumes that there are no spaces in filenames - (when (re-search-backward - "^diff \\(-\\S-+ +\\)*\\(\\S-+\\)\\( +\\(\\S-+\\)\\)?" - nil t) - (list (if old (match-string 2) (match-string 4)) - (if old (match-string 4) (match-string 2))))))))) + (and (re-search-backward "^diff " nil t) + (looking-at + "^diff \\(-[^ \t\nL]+ +\\)*\\(-L +\\S-+ +\\)*\\(\\S-+\\)\\( +\\(\\S-+\\)\\)?") + (list (if old (match-string 3) (match-string 5)) + (if old (match-string 4) (match-string 3))))))))) (defun diff-find-file-name (&optional old noprompt prefix) "Return the file corresponding to the current patch. diff --git a/test/lisp/vc/diff-mode-tests.el b/test/lisp/vc/diff-mode-tests.el index 5bc4ad6dac..521865906e 100644 --- a/test/lisp/vc/diff-mode-tests.el +++ b/test/lisp/vc/diff-mode-tests.el @@ -468,4 +468,16 @@ baz")))) (114 131 (diff-mode syntax face font-lock-string-face)) (134 140 (diff-mode syntax face font-lock-keyword-face)))))))) +(ert-deftest test-hunk-file-names () + (with-temp-buffer + (insert "diff -c /tmp/ange-ftp13518wvE.el /tmp/ange-ftp1351895K.el\n") + (goto-char (point-min)) + (should (equal (diff-hunk-file-names) + '("/tmp/ange-ftp1351895K.el" "/tmp/ange-ftp13518wvE.el")))) + (with-temp-buffer + (insert "diff -c -L /ftp\:slbhao\:/home/albinus/src/tramp/lisp/tramp.el -L /ftp\:slbhao\:/home/albinus/src/emacs/lisp/net/tramp.el /tmp/ange-ftp13518wvE.el /tmp/ange-ftp1351895K.el\n") + (goto-char (point-min)) + (should (equal (diff-hunk-file-names) + '("/tmp/ange-ftp1351895K.el" "/tmp/ange-ftp13518wvE.el"))))) + (provide 'diff-mode-tests) commit 3fd0cc85a58775e0a09efb88649bea9dd28c5491 Author: Lars Ingebrigtsen Date: Sat Aug 14 15:30:17 2021 +0200 Revert "Add macro `seq-setq`." This reverts commit a8a3fd8f8e27089ac46bf98e534529ff03f679a5. The same patch was applied twice. Remove the second instance. diff --git a/doc/lispref/sequences.texi b/doc/lispref/sequences.texi index 257f5d162e..20816ce8ca 100644 --- a/doc/lispref/sequences.texi +++ b/doc/lispref/sequences.texi @@ -1128,23 +1128,6 @@ assigned to variables as if by @code{setq} instead of as in a @end example @end defmac -@defmac seq-setq var-sequence val-sequence -@cindex sequence destructuring - This macro works similarly to @code{seq-let}, except that values are -assigned to variables as if by @code{setq} instead of as in a -@code{let} binding. - -@example -@group -(let ((a nil) - (b nil)) - (seq-setq (_ a _ b) '(1 2 3 4)) - (list a b)) -@result{} (2 4) -@end group -@end example -@end defmac - @defun seq-random-elt sequence This function returns an element of @var{sequence} taken at random. diff --git a/test/lisp/emacs-lisp/seq-tests.el b/test/lisp/emacs-lisp/seq-tests.el index 5217921d3d..44e855e2cf 100644 --- a/test/lisp/emacs-lisp/seq-tests.el +++ b/test/lisp/emacs-lisp/seq-tests.el @@ -407,30 +407,6 @@ Evaluate BODY for each created sequence. (should (null b)) (should (null c)))) -(ert-deftest test-seq-setq () - (with-test-sequences (seq '(1 2 3 4)) - (let (a b c d e) - (seq-setq (a b c d e) seq) - (should (= a 1)) - (should (= b 2)) - (should (= c 3)) - (should (= d 4)) - (should (null e))) - (let (a b others) - (seq-setq (a b &rest others) seq) - (should (= a 1)) - (should (= b 2)) - (should (same-contents-p others (seq-drop seq 2))))) - (let ((a) - (seq '(1 (2 (3 (4)))))) - (seq-setq (_ (_ (_ (a)))) seq) - (should (= a 4))) - (let (seq a b c) - (seq-setq (a b c) seq) - (should (null a)) - (should (null b)) - (should (null c)))) - (ert-deftest test-seq-min-max () (with-test-sequences (seq '(4 5 3 2 0 4)) (should (= (seq-min seq) 0)) commit 22d8e71d0462be77cb1c7999b36713d0bdfd65af Author: Lars Ingebrigtsen Date: Sat Aug 14 15:23:29 2021 +0200 Make lm-crack-address less strict * lisp/emacs-lisp/lisp-mnt.el (lm-crack-address): Use mail-header-parse-address-lax (bug#50049). diff --git a/lisp/emacs-lisp/lisp-mnt.el b/lisp/emacs-lisp/lisp-mnt.el index 4d1b42e43f..df14a5cd49 100644 --- a/lisp/emacs-lisp/lisp-mnt.el +++ b/lisp/emacs-lisp/lisp-mnt.el @@ -111,6 +111,8 @@ ;;; Code: +(require 'mail-parse) + ;;; Variables: (defgroup lisp-mnt nil @@ -359,19 +361,9 @@ Return argument is of the form (\"HOLDER\" \"YEAR1\" ... \"YEARN\")" (defun lm-crack-address (x) "Split up email address(es) X into full name and real email address. The value is a list of elements of the form (FULLNAME . ADDRESS)." - (cond ((string-match - (concat "[,\s\t]*\\(?:" - "\\(.+?\\) +[(<]\\(\\S-+@\\S-+\\)[>)]" - "\\|" - "\\(?2:\\S-+@\\S-+\\) +[(<]\\(?1:[^,]*\\)[>)]" - "\\|" - "\\(?2:\\S-+@\\S-+\\)" - "\\)") - x) - `((,(string-trim-right (match-string 1 x)) . ,(match-string 2 x)) - . ,(lm-crack-address (substring x (match-end 0))))) - ((string-match "\\`[,\s\t]*\\'" x) nil) - (t `((,x))))) + (mapcar (lambda (elem) + (cons (cdr elem) (car elem))) + (mail-header-parse-addresses-lax x))) (defun lm-authors (&optional file) "Return the author list of file FILE, or current buffer if FILE is nil. commit e91b574bf8b14c0d8cc33242570bffa8ddc38760 Author: Lars Ingebrigtsen Date: Sat Aug 14 15:20:59 2021 +0200 Add new functions for lax mail address splitting * lisp/emacs-lisp/subr-x.el (string-clean-whitespace): Autoload. * lisp/mail/mail-parse.el (mail-header-parse-addresses-lax) (mail-header-parse-address-lax): New functions. diff --git a/etc/NEWS b/etc/NEWS index a321ffd81f..a3a2543628 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2443,6 +2443,15 @@ images are marked. ** Miscellaneous +--- +*** New function 'mail-header-parse-addresses-lax'. +This takes a comma-separated string and returns a list of mail/name +pairs. + +--- +*** New function 'mail-header-parse-address-lax'. +Parse a string as a mail address-like string. + --- *** 'shell-script-mode' now supports 'outline-minor-mode'. The outline headings have lines that start with "###". diff --git a/lisp/emacs-lisp/subr-x.el b/lisp/emacs-lisp/subr-x.el index 468d124c0e..4204d20249 100644 --- a/lisp/emacs-lisp/subr-x.el +++ b/lisp/emacs-lisp/subr-x.el @@ -240,6 +240,7 @@ carriage return." (substring string 0 (- (length string) (length suffix))) string)) +;;;###autoload (defun string-clean-whitespace (string) "Clean up whitespace in STRING. All sequences of whitespaces in STRING are collapsed into a diff --git a/lisp/mail/mail-extr.el b/lisp/mail/mail-extr.el index 88fb086685..24d8311f64 100644 --- a/lisp/mail/mail-extr.el +++ b/lisp/mail/mail-extr.el @@ -707,7 +707,10 @@ This function is primarily meant for when you're displaying the result to the user: Many prettifications are applied to the result returned. If you want to decode an address for further non-display use, you should probably use -`mail-header-parse-address' instead." +`mail-header-parse-address' instead. Also see +`mail-header-parse-address-lax' for a function that's less strict +than `mail-header-parse-address', but does less post-processing +to the results." (let ((canonicalization-buffer (get-buffer-create " *canonical address*")) (extraction-buffer (get-buffer-create " *extract address components*")) value-list) diff --git a/lisp/mail/mail-parse.el b/lisp/mail/mail-parse.el index e72ed82849..212fadf382 100644 --- a/lisp/mail/mail-parse.el +++ b/lisp/mail/mail-parse.el @@ -71,6 +71,45 @@ (defalias 'mail-decode-encoded-address-region 'rfc2047-decode-address-region) (defalias 'mail-decode-encoded-address-string 'rfc2047-decode-address-string) +(defun mail-header-parse-addresses-lax (string) + "Parse STRING as a comma-separated list of mail addresses. +The return value is a list with mail/name pairs." + (delq nil + (mapcar (lambda (elem) + (or (mail-header-parse-address elem) + (mail-header-parse-address-lax elem))) + (mail-header-parse-addresses string t)))) + +(defun mail-header-parse-address-lax (string) + "Parse STRING as a mail address. +Returns a mail/name pair. + +This function will first try to parse STRING as a +standards-compliant address string, and if that fails, try to use +heuristics to determine the email address and the name in the +string." + (with-temp-buffer + (insert (string-clean-whitespace string)) + ;; Find the bit with the @ and guess that that's the mail. + (goto-char (point-max)) + (when (search-backward "@" nil t) + (if (re-search-backward " " nil t) + (forward-char 1) + (goto-char (point-min))) + (let* ((start (point)) + (mail (buffer-substring + start (or (re-search-forward " " nil t) + (goto-char (point-max)))))) + (delete-region start (point)) + ;; We've now removed the email bit, so the rest of the stuff + ;; has to be the name. + (cons (string-trim mail "[<]+" "[>]+") + (let ((name (string-trim (buffer-string) + "[ \t\n\r(]+" "[ \t\n\r)]+"))) + (if (length= name 0) + nil + name))))))) + (provide 'mail-parse) ;;; mail-parse.el ends here diff --git a/test/lisp/mail/mail-parse-tests.el b/test/lisp/mail/mail-parse-tests.el new file mode 100644 index 0000000000..70de92df45 --- /dev/null +++ b/test/lisp/mail/mail-parse-tests.el @@ -0,0 +1,54 @@ +;;; mail-parse-tests.el --- tests for mail-parse.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 'mail-parse) +(require 'subr-x) + +(ert-deftest test-mail-header-parse-address-lax () + (should (equal (mail-header-parse-address-lax + "Lars Ingebrigtsen ") + '("larsi@gnus.org" . "Lars Ingebrigtsen"))) + (should (equal (mail-header-parse-address-lax + "Lars Ingebrigtsen larsi@gnus.org>") + '("larsi@gnus.org" . "Lars Ingebrigtsen"))) + (should (equal (mail-header-parse-address-lax + "Lars Ingebrigtsen larsi@gnus.org") + '("larsi@gnus.org" . "Lars Ingebrigtsen"))) + (should (equal (mail-header-parse-address-lax + "larsi@gnus.org (Lars Ingebrigtsen)") + '("larsi@gnus.org " . "Lars Ingebrigtsen"))) + (should (equal (mail-header-parse-address-lax "larsi@gnus.org") + '("larsi@gnus.org"))) + (should (equal (mail-header-parse-address-lax "foo") + nil))) + +(ert-deftest test-mail-header-parse-addresses-lax () + (should (equal (mail-header-parse-addresses-lax + "Bob Weiner , Mats Lidell ") + '(("rsw@gnu.org" . "Bob Weiner") + ("matsl@gnu.org" . "Mats Lidell"))))) + +(provide 'mail-parse-tests) + +;;; mail-parse-tests.el ends here commit a8a3fd8f8e27089ac46bf98e534529ff03f679a5 Author: Earl Hyatt Date: Sat Aug 14 14:17:55 2021 +0200 Add macro `seq-setq`. * doc/lispref/sequences.texi (seq-setq): Document this macro. * test/lisp/emacs-lisp/seq-tests.el (test-seq-setq): Test this macro (bug#50053). diff --git a/doc/lispref/sequences.texi b/doc/lispref/sequences.texi index 20816ce8ca..257f5d162e 100644 --- a/doc/lispref/sequences.texi +++ b/doc/lispref/sequences.texi @@ -1128,6 +1128,23 @@ assigned to variables as if by @code{setq} instead of as in a @end example @end defmac +@defmac seq-setq var-sequence val-sequence +@cindex sequence destructuring + This macro works similarly to @code{seq-let}, except that values are +assigned to variables as if by @code{setq} instead of as in a +@code{let} binding. + +@example +@group +(let ((a nil) + (b nil)) + (seq-setq (_ a _ b) '(1 2 3 4)) + (list a b)) +@result{} (2 4) +@end group +@end example +@end defmac + @defun seq-random-elt sequence This function returns an element of @var{sequence} taken at random. diff --git a/test/lisp/emacs-lisp/seq-tests.el b/test/lisp/emacs-lisp/seq-tests.el index 44e855e2cf..5217921d3d 100644 --- a/test/lisp/emacs-lisp/seq-tests.el +++ b/test/lisp/emacs-lisp/seq-tests.el @@ -407,6 +407,30 @@ Evaluate BODY for each created sequence. (should (null b)) (should (null c)))) +(ert-deftest test-seq-setq () + (with-test-sequences (seq '(1 2 3 4)) + (let (a b c d e) + (seq-setq (a b c d e) seq) + (should (= a 1)) + (should (= b 2)) + (should (= c 3)) + (should (= d 4)) + (should (null e))) + (let (a b others) + (seq-setq (a b &rest others) seq) + (should (= a 1)) + (should (= b 2)) + (should (same-contents-p others (seq-drop seq 2))))) + (let ((a) + (seq '(1 (2 (3 (4)))))) + (seq-setq (_ (_ (_ (a)))) seq) + (should (= a 4))) + (let (seq a b c) + (seq-setq (a b c) seq) + (should (null a)) + (should (null b)) + (should (null c)))) + (ert-deftest test-seq-min-max () (with-test-sequences (seq '(4 5 3 2 0 4)) (should (= (seq-min seq) 0)) commit c58f8dda2b2282302cf47ef3e7df6523bde606f5 Author: Earl Hyatt Date: Sat Aug 14 14:17:12 2021 +0200 Add macro `seq-setq`. * doc/lispref/sequences.texi (seq-setq): Document this macro. * lisp/emacs-lisp/seq.el (seq-setq): New macro. * test/lisp/emacs-lisp/seq-tests.el (test-seq-setq): Test this macro (bug#50053). diff --git a/doc/lispref/sequences.texi b/doc/lispref/sequences.texi index 545fd408f8..20816ce8ca 100644 --- a/doc/lispref/sequences.texi +++ b/doc/lispref/sequences.texi @@ -1111,6 +1111,23 @@ The @code{pcase} patterns provide an alternative facility for destructuring binding, see @ref{Destructuring with pcase Patterns}. @end defmac +@defmac seq-setq var-sequence val-sequence +@cindex sequence destructuring + This macro works similarly to @code{seq-let}, except that values are +assigned to variables as if by @code{setq} instead of as in a +@code{let} binding. + +@example +@group +(let ((a nil) + (b nil)) + (seq-setq (_ a _ b) '(1 2 3 4)) + (list a b)) +@result{} (2 4) +@end group +@end example +@end defmac + @defun seq-random-elt sequence This function returns an element of @var{sequence} taken at random. diff --git a/lisp/emacs-lisp/seq.el b/lisp/emacs-lisp/seq.el index e8fc4a2814..f0dc283f57 100644 --- a/lisp/emacs-lisp/seq.el +++ b/lisp/emacs-lisp/seq.el @@ -93,6 +93,14 @@ name to be bound to the rest of SEQUENCE." (declare (indent 2) (debug (sexp form body))) `(pcase-let ((,(seq--make-pcase-patterns args) ,sequence)) ,@body)) + +(defmacro seq-setq (args sequence) + "Assign to the variables in ARGS the elements of SEQUENCE. + +ARGS can also include the `&rest' marker followed by a variable +name to be bound to the rest of SEQUENCE." + (declare (debug (sexp form))) + `(pcase-setq ,(seq--make-pcase-patterns args) ,sequence)) ;;; Basic seq functions that have to be implemented by new sequence types diff --git a/test/lisp/emacs-lisp/seq-tests.el b/test/lisp/emacs-lisp/seq-tests.el index 05c7fbe781..44e855e2cf 100644 --- a/test/lisp/emacs-lisp/seq-tests.el +++ b/test/lisp/emacs-lisp/seq-tests.el @@ -383,6 +383,30 @@ Evaluate BODY for each created sequence. (should (null b)) (should (null c))))) +(ert-deftest test-seq-setq () + (with-test-sequences (seq '(1 2 3 4)) + (let (a b c d e) + (seq-setq (a b c d e) seq) + (should (= a 1)) + (should (= b 2)) + (should (= c 3)) + (should (= d 4)) + (should (null e))) + (let (a b others) + (seq-setq (a b &rest others) seq) + (should (= a 1)) + (should (= b 2)) + (should (same-contents-p others (seq-drop seq 2))))) + (let ((a) + (seq '(1 (2 (3 (4)))))) + (seq-setq (_ (_ (_ (a)))) seq) + (should (= a 4))) + (let (seq a b c) + (seq-setq (a b c) seq) + (should (null a)) + (should (null b)) + (should (null c)))) + (ert-deftest test-seq-min-max () (with-test-sequences (seq '(4 5 3 2 0 4)) (should (= (seq-min seq) 0)) commit adb6c3f1a4cc5ec3d26bfb2311dfc87b965153a0 Author: Yikai Zhao Date: Sat Aug 14 13:46:30 2021 +0200 Fix memory-report counting of vector/hash table sizes * lisp/emacs-lisp/memory-report.el (memory-report--object-size-1): Count element values in vectors and hash tables. Copyright-paperwork-exempt: yes diff --git a/lisp/emacs-lisp/memory-report.el b/lisp/emacs-lisp/memory-report.el index 1125dde405..aee2a0079c 100644 --- a/lisp/emacs-lisp/memory-report.el +++ b/lisp/emacs-lisp/memory-report.el @@ -230,8 +230,7 @@ by counted more than once." (let ((total (+ (memory-report--size 'vector) (* (memory-report--size 'object) (length value))))) (cl-loop for elem across value - do (setf (gethash elem counted) t) - (cl-incf total (memory-report--object-size counted elem))) + do (cl-incf total (memory-report--object-size counted elem))) total)) (cl-defmethod memory-report--object-size-1 (counted (value hash-table)) @@ -239,8 +238,6 @@ by counted more than once." (* (memory-report--size 'object) (hash-table-size value))))) (maphash (lambda (key elem) - (setf (gethash key counted) t) - (setf (gethash elem counted) t) (cl-incf total (memory-report--object-size counted key)) (cl-incf total (memory-report--object-size counted elem))) value) diff --git a/test/lisp/emacs-lisp/memory-report-tests.el b/test/lisp/emacs-lisp/memory-report-tests.el index da5f4f5700..0c0297b5fc 100644 --- a/test/lisp/emacs-lisp/memory-report-tests.el +++ b/test/lisp/emacs-lisp/memory-report-tests.el @@ -45,6 +45,7 @@ (should (equal (memory-report-object-size (list 'foo)) 16)) + (should (equal (memory-report-object-size (vector 1 2 3)) 64)) (should (equal (memory-report-object-size (vector 1 2 3 4)) 80)) (should (equal (memory-report-object-size "") 32)) @@ -52,6 +53,21 @@ (should (equal (memory-report-object-size (propertize "a" 'face 'foo)) 81))) +(ert-deftest memory-report-sizes-vectors () + (should (= (memory-report--object-size + (make-hash-table :test #'eq) + ["long string that should be at least 40 bytes"]) + 108)) + (let ((string "long string that should be at least 40 bytes")) + (should (= (memory-report--object-size + (make-hash-table :test #'eq) + (vector string)) + 108)) + (should (= (memory-report--object-size + (make-hash-table :test #'eq) + (vector string string)) + 124)))) + (provide 'memory-report-tests) ;;; memory-report-tests.el ends here commit 37d48edf6d406a4730caa0393f7695de2bfadfcc Author: Basil L. Contovounesios Date: Wed Aug 4 00:48:50 2021 +0100 Fix merging of ambiguous nil maps * lisp/emacs-lisp/map.el: Bump version to 3.1. (map--merge): New merging subroutine that uses a hash table in place of lists, for both efficiency and avoiding ambiguities (bug#49848). (map-merge): Rewrite in terms of map--merge. (map-merge-with): Ditto. This ensures that FUNCTION is called whenever two keys are merged, even if they are not eql (which could happen until now). It also makes map-merge-with consistent with map-merge, thus achieving greater overall predictability. * etc/NEWS: Announce this weakening of guarantees. * test/lisp/emacs-lisp/map-tests.el (test-map-merge) (test-map-merge-with): Don't depend on specific orderings. Test that nil is correctly merged into a plist. diff --git a/etc/NEWS b/etc/NEWS index 366ea1abd6..a321ffd81f 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1636,6 +1636,14 @@ This is a slightly deeper copy than the previous 'copy-sequence'. --- *** The function 'map-contains-key' now supports plists. +--- +*** More consistent duplicate key handling in 'map-merge-with'. +Until now, 'map-merge-with' promised to call its function argument +whenever multiple maps contained 'eql' keys. However, this did not +always coincide with the keys that were actually merged, which could +be 'equal' instead. The function argument is now called whenever keys +are merged, for greater consistency with 'map-merge' and 'map-elt'. + ** Package --- diff --git a/lisp/emacs-lisp/map.el b/lisp/emacs-lisp/map.el index c59342875d..988a62a4e3 100644 --- a/lisp/emacs-lisp/map.el +++ b/lisp/emacs-lisp/map.el @@ -5,7 +5,7 @@ ;; Author: Nicolas Petton ;; Maintainer: emacs-devel@gnu.org ;; Keywords: extensions, lisp -;; Version: 3.0 +;; Version: 3.1 ;; Package-Requires: ((emacs "26")) ;; This file is part of GNU Emacs. @@ -371,37 +371,51 @@ The default implementation delegates to `map-do'." map) t)) +(defun map--merge (merge type &rest maps) + "Merge into a map of TYPE all the key/value pairs in MAPS. +MERGE is a function that takes the target MAP, a KEY, and a +VALUE, merges KEY and VALUE into MAP, and returns the result. +MAP may be of a type other than TYPE." + ;; Use a hash table internally if `type' is a list. This avoids + ;; both quadratic lookup behavior and the type ambiguity of nil. + (let* ((tolist (memq type '(list alist plist))) + (result (map-into (pop maps) + ;; Use same testfn as `map-elt' gv setter. + (cond ((eq type 'plist) '(hash-table :test eq)) + (tolist '(hash-table :test equal)) + (type))))) + (dolist (map maps) + (map-do (lambda (key value) + (setq result (funcall merge result key value))) + map)) + ;; Convert internal representation to desired type. + (if tolist (map-into result type) result))) + (defun map-merge (type &rest maps) "Merge into a map of TYPE all the key/value pairs in MAPS. See `map-into' for all supported values of TYPE." - (let ((result (map-into (pop maps) type))) - (while maps - ;; FIXME: When `type' is `list', we get an O(N^2) behavior. - ;; For small tables, this is fine, but for large tables, we - ;; should probably use a hash-table internally which we convert - ;; to an alist in the end. - (map-do (lambda (key value) - (setf (map-elt result key) value)) - (pop maps))) - result)) + (apply #'map--merge + (lambda (result key value) + (setf (map-elt result key) value) + result) + type maps)) (defun map-merge-with (type function &rest maps) "Merge into a map of TYPE all the key/value pairs in MAPS. -When two maps contain the same (`eql') key, call FUNCTION on the two +When two maps contain the same key, call FUNCTION on the two values and use the value returned by it. Each of MAPS can be an alist, plist, hash-table, or array. See `map-into' for all supported values of TYPE." - (let ((result (map-into (pop maps) type)) - (not-found (list nil))) - (while maps - (map-do (lambda (key value) - (cl-callf (lambda (old) - (if (eql old not-found) - value - (funcall function old value))) - (map-elt result key not-found))) - (pop maps))) - result)) + (let ((not-found (list nil))) + (apply #'map--merge + (lambda (result key value) + (cl-callf (lambda (old) + (if (eql old not-found) + value + (funcall function old value))) + (map-elt result key not-found)) + result) + type maps))) (cl-defgeneric map-into (map type) "Convert MAP into a map of TYPE.") diff --git a/test/lisp/emacs-lisp/map-tests.el b/test/lisp/emacs-lisp/map-tests.el index a04c6bef02..658ed2e711 100644 --- a/test/lisp/emacs-lisp/map-tests.el +++ b/test/lisp/emacs-lisp/map-tests.el @@ -446,16 +446,24 @@ Evaluate BODY for each created map." (ert-deftest test-map-merge () "Test `map-merge'." - (should (equal (map-merge 'list '(a 1) '((b . 2) (c . 3)) - #s(hash-table data (c 4))) - '((c . 4) (b . 2) (a . 1))))) + (should (equal (sort (map-merge 'list '(a 1) '((b . 2) (c . 3)) + #s(hash-table data (c 4))) + (lambda (x y) (string< (car x) (car y)))) + '((a . 1) (b . 2) (c . 4)))) + (should (equal (map-merge 'list () '(:a 1)) '((:a . 1)))) + (should (equal (map-merge 'alist () '(:a 1)) '((:a . 1)))) + (should (equal (map-merge 'plist () '(:a 1)) '(:a 1)))) (ert-deftest test-map-merge-with () - (should (equal (map-merge-with 'list #'+ - '((1 . 2)) - '((1 . 3) (2 . 4)) - '((1 . 1) (2 . 5) (3 . 0))) - '((3 . 0) (2 . 9) (1 . 6))))) + (should (equal (sort (map-merge-with 'list #'+ + '((1 . 2)) + '((1 . 3) (2 . 4)) + '((1 . 1) (2 . 5) (3 . 0))) + #'car-less-than-car) + '((1 . 6) (2 . 9) (3 . 0)))) + (should (equal (map-merge-with 'list #'+ () '(:a 1)) '((:a . 1)))) + (should (equal (map-merge-with 'alist #'+ () '(:a 1)) '((:a . 1)))) + (should (equal (map-merge-with 'plist #'+ () '(:a 1)) '(:a 1)))) (ert-deftest test-map-merge-empty () "Test merging of empty maps." commit 1bfbb2b706db6a7ca9420b27d22a737deccdd5b0 Author: Mattias Engdegård Date: Fri Aug 13 12:47:39 2021 +0200 Add font-lock-doc-markup-face (bug#50041) This face is intended for mark-up syntax and constructs inside text using font-lock-doc-face; ie, documentation comments and strings in programming modes. * lisp/font-lock.el (font-lock-doc-markup-face): New face. * lisp/cus-theme.el (custom-theme--listed-faces): Add it to the list. * doc/lispref/modes.texi (Faces for Font Lock): Document it. * etc/NEWS: Mention it. diff --git a/doc/lispref/modes.texi b/doc/lispref/modes.texi index d48c9cc1af..4274810cba 100644 --- a/doc/lispref/modes.texi +++ b/doc/lispref/modes.texi @@ -3444,9 +3444,17 @@ for string constants. @item font-lock-doc-face @vindex font-lock-doc-face -for documentation strings in the code. This inherits, by default, from +for documentation embedded in program code inside specially-formed +comments or strings. This face inherits, by default, from @code{font-lock-string-face}. +@item font-lock-doc-markup-face +@vindex font-lock-doc-markup-face +for mark-up elements in text using @code{font-lock-doc-face}. +It is typically used for the mark-up constructs in documentation embedded +in program code, following conventions such as Haddock, Javadoc or Doxygen. +This face inherits, by default, from @code{font-lock-constant-face}. + @item font-lock-negation-char-face @vindex font-lock-negation-char-face for easily-overlooked negation characters. diff --git a/etc/NEWS b/etc/NEWS index 19eddb7277..366ea1abd6 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -149,6 +149,15 @@ invoked with the '--declarations' command-line option. ** New command 'font-lock-update', bound to 'C-x x f'. This command updates the syntax highlighting in this buffer. ++++ +** A new standard face 'font-lock-doc-markup-face'. +Intended for documentation mark-up syntax and tags inside text that +uses 'font-lock-doc-face', with which it should harmonise. It would +typically be used in structured documentation comments in program +source code by language-specific modes, for mark-up conventions like +Haddock, Javadoc or Doxygen. By default this face inherits from +'font-lock-constant-face'. + ** The new NonGNU ELPA archive is enabled by default alongside GNU ELPA. +++ diff --git a/lisp/cus-theme.el b/lisp/cus-theme.el index f4885d0f52..7457d9e323 100644 --- a/lisp/cus-theme.el +++ b/lisp/cus-theme.el @@ -66,7 +66,7 @@ Do not call this mode function yourself. It is meant for internal use." shadow secondary-selection trailing-whitespace font-lock-builtin-face font-lock-comment-delimiter-face font-lock-comment-face font-lock-constant-face - font-lock-doc-face font-lock-function-name-face + font-lock-doc-face font-lock-doc-markup-face font-lock-function-name-face font-lock-keyword-face font-lock-negation-char-face font-lock-preprocessor-face font-lock-regexp-grouping-backslash font-lock-regexp-grouping-construct font-lock-string-face diff --git a/lisp/font-lock.el b/lisp/font-lock.el index 4dc42d9cf6..c00a62a160 100644 --- a/lisp/font-lock.el +++ b/lisp/font-lock.el @@ -312,6 +312,9 @@ If a number, only buffers greater than this size have fontification messages." (defvar font-lock-doc-face 'font-lock-doc-face "Face name to use for documentation.") +(defvar font-lock-doc-markup-face 'font-lock-doc-markup-face + "Face name to use for documentation mark-up.") + (defvar font-lock-keyword-face 'font-lock-keyword-face "Face name to use for keywords.") @@ -2003,7 +2006,16 @@ Sets various variables using `font-lock-defaults' and (defface font-lock-doc-face '((t :inherit font-lock-string-face)) - "Font Lock mode face used to highlight documentation." + "Font Lock mode face used to highlight documentation embedded in program code. +It is typically used for special documentation comments or strings." + :group 'font-lock-faces) + +(defface font-lock-doc-markup-face + '((t :inherit font-lock-constant-face)) + "Font Lock mode face used to highlight embedded documentation mark-up. +It is meant for mark-up elements in text that uses `font-lock-doc-face', such +as the constructs of Haddock, Javadoc and similar systems." + :version "28.1" :group 'font-lock-faces) (defface font-lock-keyword-face