commit ec574a72f7198d9793b466f33382fff397ac4ce1 (HEAD, refs/remotes/origin/master) Author: Tom Gillespie Date: Wed May 12 23:31:23 2021 +0200 Fix evaluation order for hack-local-variables * lisp/files.el (hack-local-variables): Fix the ordering which local variables are evaluated by `hack-local-variables' so that prop-line local variables are evaluated first. There is a hidden nreverse lurking in `hack-local-variables-apply' which means that the prop line variables must come second in order to be evaluated before the end of file variables. diff --git a/lisp/files.el b/lisp/files.el index 47c5fc133c..60f72660f3 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -3771,8 +3771,8 @@ inhibited." (with-demoted-errors "Directory-local variables error: %s" ;; Note this is a no-op if enable-local-variables is nil. (hack-dir-local-variables)) - (let ((result (append (hack-local-variables-prop-line) - (hack-local-variables--find-variables)))) + (let ((result (append (hack-local-variables--find-variables) + (hack-local-variables-prop-line)))) (if (and enable-local-variables (not (inhibit-local-variables-p))) (progn commit 0d55a8ad286bb346cfe44ee8c9682f6bfd1ae559 Author: Philip K Date: Wed May 12 20:00:15 2021 +0200 Don't mark interactive commands as internal functions * lisp/epa-ks.el (epa-ks-search-mode-map): Rename commands from "--" to "-" throughout. diff --git a/lisp/epa-ks.el b/lisp/epa-ks.el index af2398c128..a33025b112 100644 --- a/lisp/epa-ks.el +++ b/lisp/epa-ks.el @@ -68,9 +68,9 @@ This is used when reverting a buffer to restart search.") (defvar epa-ks-search-mode-map (let ((map (make-sparse-keymap))) (suppress-keymap map) - (define-key map (kbd "f") #'epa-ks--mark-key-to-fetch) - (define-key map (kbd "i") #'epa-ks--inspect-key-to-fetch) - (define-key map (kbd "u") #'epa-ks--unmark-key-to-fetch) + (define-key map (kbd "f") #'epa-ks-mark-key-to-fetch) + (define-key map (kbd "i") #'epa-ks-inspect-key-to-fetch) + (define-key map (kbd "u") #'epa-ks-unmark-key-to-fetch) (define-key map (kbd "x") #'epa-ks-do-key-to-fetch) map)) @@ -89,19 +89,19 @@ This is used when reverting a buffer to restart search.") nil t) (tabulated-list-init-header)) -(defun epa-ks--inspect-key-to-fetch () +(defun epa-ks-inspect-key-to-fetch () "Display full ID of key under point in the minibuffer." (interactive) (message "Full ID: %s" (epa-ks-key-id (car (tabulated-list-get-id))))) -(defun epa-ks--unmark-key-to-fetch () +(defun epa-ks-unmark-key-to-fetch () "Remove fetch mark for key under point. If a region is active, unmark all keys in active region." (interactive) - (epa-ks--mark-key-to-fetch "")) + (epa-ks-mark-key-to-fetch "")) -(defun epa-ks--mark-key-to-fetch (tag) +(defun epa-ks-mark-key-to-fetch (tag) "Add fetch-mark to key under point. If a region is active, mark all keys in active region. @@ -109,7 +109,7 @@ If a region is active, mark all keys in active region. When all keys have been selected, use \\[epa-ks-do-key-to-fetch] to actually import the keys. -When called interactively, `epa-ks--mark-key-to-fetch' will always +When called interactively, `epa-ks-mark-key-to-fetch' will always add a \"F\" tag. Non-interactivly the tag must be specified by setting the TAG parameter." (interactive (list "F")) @@ -125,7 +125,7 @@ setting the TAG parameter." (defun epa-ks-do-key-to-fetch () "Fetch all marked keys from keyserver and import them. -Keys are marked using `epa-ks--mark-key-to-fetch'." +Keys are marked using `epa-ks-mark-key-to-fetch'." (interactive) (save-excursion (let (keys) commit f1b98d39f0f47a1934482821ec3834f5c409fa1d Author: Michael Albinus Date: Wed May 12 19:50:01 2021 +0200 ; Rearrange EasyPG entry in etc/NEWS diff --git a/etc/NEWS b/etc/NEWS index 2a428391c5..205f43ce52 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2377,14 +2377,15 @@ 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 Modes and Packages in Emacs 28.1 - -** Key Server Client added ++++ +** EasyPG GPG key servers can now be queried for keys with the -`M-x epa-search-keys' command. Keys can then be added to your +'M-x epa-search-keys' command. Keys can then be added to your personal key ring. + +* New Modes and Packages in Emacs 28.1 + ** Lisp Data mode The new command 'lisp-data-mode' enables a major mode for buffers composed of Lisp symbolic expressions that do not form a computer commit e27ccea298e0832ec5330988bad8e753529507a0 Merge: 4aadbab5be 43da7f838f Author: Eli Zaretskii Date: Wed May 12 20:03:32 2021 +0300 Merge branch 'master' of git.savannah.gnu.org:/srv/git/emacs commit 4aadbab5be427d44085e1cd4322b46a929299d23 Author: Eli Zaretskii Date: Wed May 12 20:02:28 2021 +0300 Improve doc strings and prompt in epa-ks.el * lisp/epa-ks.el (epa-ks--mark-key-to-fetch, epa-ks--fetch-key) (epa-search-keys): Doc fixes. (epa-ks-do-key-to-fetch): Better wording for the fetch prompt. diff --git a/lisp/epa-ks.el b/lisp/epa-ks.el index d07aa5482c..af2398c128 100644 --- a/lisp/epa-ks.el +++ b/lisp/epa-ks.el @@ -110,7 +110,7 @@ When all keys have been selected, use \\[epa-ks-do-key-to-fetch] to actually import the keys. When called interactively, `epa-ks--mark-key-to-fetch' will always -add a \"F\" tag. Non-interactivly the tag must be specified by +add a \"F\" tag. Non-interactivly the tag must be specified by setting the TAG parameter." (interactive (list "F")) (if (region-active-p) @@ -135,14 +135,14 @@ Keys are marked using `epa-ks--mark-key-to-fetch'." (push (epa-ks-key-id (car (tabulated-list-get-id))) keys)) (forward-line)) - (when (yes-or-no-p (format "Proceed fetching all %d key(s)? " + (when (yes-or-no-p (format "Proceed with fetching all %d key(s)? " (length keys)))) (dolist (id keys) (epa-ks--fetch-key id)))) (tabulated-list-clear-all-tags)) (defun epa-ks--fetch-key (id) - "Send request to import key with id ID." + "Send request to import key with specified ID." (url-retrieve (format "https://%s/pks/lookup?%s" epa-keyserver @@ -209,10 +209,10 @@ KEYS is a list of `epa-ks-key' structures, as parsed by The keyserver to be used is specified by `epa-keyserver'. -If EXACT is non-nil require exact matches. Interactively, this -can be provoked using a prefix argument. +If EXACT is non-nil (interactively, prefix argument), require +exact matches. -Note that the request may fail, is the query is not specific +Note that the request may fail if the query is not specific enough, since keyservers have strict timeout settings." (interactive (list (read-string "Search for: ") current-prefix-arg)) commit 43da7f838f7132340fe241298193ac4f6ae2fe09 Author: Lars Ingebrigtsen Date: Wed May 12 19:01:53 2021 +0200 Even further `text-property-search-forward' clarifications * lisp/emacs-lisp/text-property-search.el (text-property-search-forward): Further doc string clarifications. diff --git a/lisp/emacs-lisp/text-property-search.el b/lisp/emacs-lisp/text-property-search.el index 1f2dcfe9dd..7da02a9cb2 100644 --- a/lisp/emacs-lisp/text-property-search.el +++ b/lisp/emacs-lisp/text-property-search.el @@ -31,7 +31,7 @@ (defun text-property-search-forward (property &optional value predicate not-current) - "Search for the next region of text whose PROPERTY matches VALUE. + "Search for the next region of text where PREDICATE is true. PREDICATE is used to decide whether a value of PROPERTY should be considered as matching VALUE. @@ -42,16 +42,18 @@ non-nil if these two values are to be considered a match. Two special values of PREDICATE can also be used: If PREDICATE is t, that means a value must `equal' VALUE to be considered a match. -If PREDICATE is nil, a value will match if is not `equal' to -VALUE. Furthermore, the match region is ended if the value -changes. For instance, this means that if you loop with +If PREDICATE is nil (which is the default value), a value will +match if is not `equal' to VALUE. Furthermore, a nil PREDICATE +means that the match region is ended if the value changes. For +instance, this means that if you loop with (while (setq prop (text-property-search-forward 'face)) ...) -you will get all distinct regions with different `face' values in +you will get all distinct regions with non-nil `face' values in the buffer, and the `prop' object will have the details about the -match. +match. See the manual for more details and examples about how +VALUE and PREDICATE interact. If NOT-CURRENT is non-nil, the function will search for the first region that doesn't include point and has a value of PROPERTY commit fb93afa1000344f3074a131ab39d2e259bbfc7d8 Author: Lars Ingebrigtsen Date: Wed May 12 18:57:07 2021 +0200 Update email address in epa-ks.el diff --git a/lisp/epa-ks.el b/lisp/epa-ks.el index 094537fd67..d07aa5482c 100644 --- a/lisp/epa-ks.el +++ b/lisp/epa-ks.el @@ -2,7 +2,7 @@ ;; Copyright (C) 2021 Free Software Foundation, Inc. -;; Author: Philip K. +;; Author: Philip K. ;; Keywords: PGP, GnuPG ;; This file is part of GNU Emacs. commit 6ca599f291d556433d604685008c03ab810b7ef0 Author: Philip K Date: Wed May 12 18:44:43 2021 +0200 All a GPG key server client * lisp/epa-ks.el (epa-keyserver): New file (bug#39886). * doc/misc/epa.texi (Quick start): Mention it. (Querying a key server): Document it. diff --git a/doc/misc/epa.texi b/doc/misc/epa.texi index cca0d300fa..00db3c5fa3 100644 --- a/doc/misc/epa.texi +++ b/doc/misc/epa.texi @@ -94,6 +94,8 @@ EasyPG Assistant commands are prefixed by @samp{epa-}. For example, @item To create a cleartext signature of the region, type @kbd{M-x epa-sign-region} @item To encrypt a file, type @kbd{M-x epa-encrypt-file} + +@item To query a key server for keys, type @kbd{M-x epa-search-keys} @end itemize EasyPG Assistant provides several cryptographic features which can be @@ -112,6 +114,7 @@ This chapter introduces various commands for typical use cases. * Dired integration:: * Mail-mode integration:: * Encrypting/decrypting gpg files:: +* Querying a key server:: @end menu @node Key management, Cryptographic operations on regions, Commands, Commands @@ -440,6 +443,21 @@ If non-@code{nil}, disable auto-saving when opening an encrypted file. The default value is @code{t}. @end defvar +@node Querying a key server, , Mail-mode integration, Commands +@section Querying a key server + +The @code{epa-search-keys} command can be used to query a +@acronym{GPG} key server. Emacs will then pop up a buffer that lists +the matches, and you can then fetch (and add) keys to your personal +key ring. + +In the key search buffer, you can use the @kbd{f} command to mark keys +for fetching, and then @kbd{x} to fetch the keys (and incorporate them +into your key ring). + +The @code{epa-keyserver} variable says which server to query. + + @node GnuPG version compatibility, Caching Passphrases, Commands, Top @chapter GnuPG version compatibility diff --git a/etc/NEWS b/etc/NEWS index de3779cd73..2a428391c5 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2380,6 +2380,11 @@ step to 5 columns. * New Modes and Packages in Emacs 28.1 +** Key Server Client added +GPG key servers can now be queried for keys with the +`M-x epa-search-keys' command. Keys can then be added to your +personal key ring. + ** Lisp Data mode The new command 'lisp-data-mode' enables a major mode for buffers composed of Lisp symbolic expressions that do not form a computer diff --git a/lisp/epa-ks.el b/lisp/epa-ks.el new file mode 100644 index 0000000000..094537fd67 --- /dev/null +++ b/lisp/epa-ks.el @@ -0,0 +1,337 @@ +;;; epa-ks.el --- EasyPG Key Server Client -*- lexical-binding: t -*- + +;; Copyright (C) 2021 Free Software Foundation, Inc. + +;; Author: Philip K. +;; Keywords: PGP, GnuPG + +;; 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: + +;; Keyserver client in Emacs. + +;;; Code: + +(require 'cl-lib) +(require 'epa) +(require 'subr-x) +(require 'tabulated-list) +(require 'url) +(require 'url-http) + +(defgroup epa-ks nil + "The EasyPG Assistant Keyserver client." + :version "28.1" + :group 'epa) + +(defcustom epa-keyserver "pgp.mit.edu" + "Domain of keyserver. + +This is used by `epa-ks-lookup-key', for looking up public keys." + :type '(choice :tag "Keyserver" + (const random) + (const "keyring.debian.org") + (const "keys.gnupg.net") + (const "keyserver.ubuntu.com") + (const "pgp.mit.edu") + (const "pool.sks-keyservers.net") + (const "zimmermann.mayfirst.org") + (string :tag "Custom keyserver")) + :version "28.1") + +(cl-defstruct epa-ks-key + "Structure to hold key data." + id algo len created expires names flags) + +(cl-defstruct epa-ks-name + "Structure to hold user associated with keys data." + uid created expires flags) + +(defvar epa-ks-last-query nil + "List of arguments to pass to `epa-search-keys'. +This is used when reverting a buffer to restart search.") + +(defvar epa-ks-search-mode-map + (let ((map (make-sparse-keymap))) + (suppress-keymap map) + (define-key map (kbd "f") #'epa-ks--mark-key-to-fetch) + (define-key map (kbd "i") #'epa-ks--inspect-key-to-fetch) + (define-key map (kbd "u") #'epa-ks--unmark-key-to-fetch) + (define-key map (kbd "x") #'epa-ks-do-key-to-fetch) + map)) + +(define-derived-mode epa-ks-search-mode tabulated-list-mode "Keyserver" + "Major mode for listing public key search results." + (buffer-disable-undo) + (setq tabulated-list-format [("ID" 8 t) + ("Algo." 5 nil) + ("Created" 10 t) + ("Expires" 10 t) + ("User" 0 t)] + tabulated-list-sort-key '("User" . nil) + tabulated-list-padding 2) + (add-hook 'tabulated-list-revert-hook + #'epa-ks--restart-search + nil t) + (tabulated-list-init-header)) + +(defun epa-ks--inspect-key-to-fetch () + "Display full ID of key under point in the minibuffer." + (interactive) + (message "Full ID: %s" (epa-ks-key-id (car (tabulated-list-get-id))))) + +(defun epa-ks--unmark-key-to-fetch () + "Remove fetch mark for key under point. + +If a region is active, unmark all keys in active region." + (interactive) + (epa-ks--mark-key-to-fetch "")) + +(defun epa-ks--mark-key-to-fetch (tag) + "Add fetch-mark to key under point. + +If a region is active, mark all keys in active region. + +When all keys have been selected, use \\[epa-ks-do-key-to-fetch] to +actually import the keys. + +When called interactively, `epa-ks--mark-key-to-fetch' will always +add a \"F\" tag. Non-interactivly the tag must be specified by +setting the TAG parameter." + (interactive (list "F")) + (if (region-active-p) + (save-mark-and-excursion + (save-restriction + (narrow-to-region (region-beginning) (1- (region-end))) + (goto-char (point-min)) + (while (not (eobp)) + (tabulated-list-put-tag tag t)))) + (tabulated-list-put-tag tag t))) + +(defun epa-ks-do-key-to-fetch () + "Fetch all marked keys from keyserver and import them. + +Keys are marked using `epa-ks--mark-key-to-fetch'." + (interactive) + (save-excursion + (let (keys) + (goto-char (point-min)) + (while (not (eobp)) + (when (looking-at-p (rx bol "F")) + (push (epa-ks-key-id (car (tabulated-list-get-id))) + keys)) + (forward-line)) + (when (yes-or-no-p (format "Proceed fetching all %d key(s)? " + (length keys)))) + (dolist (id keys) + (epa-ks--fetch-key id)))) + (tabulated-list-clear-all-tags)) + +(defun epa-ks--fetch-key (id) + "Send request to import key with id ID." + (url-retrieve + (format "https://%s/pks/lookup?%s" + epa-keyserver + (url-build-query-string + `(("search" ,(concat "0x" (url-hexify-string id))) + ("options" "mr") + ("op" "get")))) + (lambda (status) + (when (plist-get status :error) + (error "Request failed: %s" + (caddr (assq (caddr (plist-get status :error)) + url-http-codes)))) + (forward-paragraph) + (save-excursion + (goto-char (point-max)) + (while (memq (char-before) '(?\s ?\t ?\n)) + (forward-char -1)) + (delete-region (point) (point-max))) + (let ((epa-popup-info-window nil)) + (epa-import-armor-in-region (point) (point-max))) + (kill-buffer)))) + +(defun epa-ks--display-keys (buf keys) + "Prepare KEYS for `tabulated-list-mode', for buffer BUF. + +KEYS is a list of `epa-ks-key' structures, as parsed by +`epa-ks-parse-result'." + (when (buffer-live-p buf) + (let (entries) + (dolist (key keys) + (dolist (name (epa-ks-key-names key)) + (push (list (cons key name) + (vector + (substring (epa-ks-key-id key) -8) + (cdr (epa-ks-key-algo key)) + (if (epa-ks-key-created key) + (format-time-string "%F" (epa-ks-key-created key)) + "N/A") + (if (epa-ks-key-expires key) + (let* ((date (epa-ks-key-expires key)) + (str (format-time-string "%F" date))) + (when (< 0 (time-to-seconds (time-since date))) + (setq str (propertize str 'face + 'font-lock-warning-face))) + str) + (propertize "N/A" 'face 'shadow)) + (decode-coding-string + (epa-ks-name-uid name) + (select-safe-coding-system (epa-ks-name-uid name) + nil 'utf-8)))) + entries))) + (with-current-buffer buf + (setq tabulated-list-entries entries) + (tabulated-list-print t t)) + (message "Press `f' to mark a key, `x' to fetch all marked keys.")))) + +(defun epa-ks--restart-search () + (when epa-ks-last-query + (apply #'epa-search-keys epa-ks-last-query))) + +;;;###autoload +(defun epa-search-keys (query exact) + "Ask a keyserver for all keys matching QUERY. + +The keyserver to be used is specified by `epa-keyserver'. + +If EXACT is non-nil require exact matches. Interactively, this +can be provoked using a prefix argument. + +Note that the request may fail, is the query is not specific +enough, since keyservers have strict timeout settings." + (interactive (list (read-string "Search for: ") + current-prefix-arg)) + (when (string-empty-p query) + (user-error "No query")) + (let ((buf (get-buffer-create "*Key search*"))) + (with-current-buffer buf + (let ((inhibit-read-only t)) + (erase-buffer)) + (epa-ks-search-mode)) + (url-retrieve + (format "https://%s/pks/lookup?%s" + epa-keyserver + (url-build-query-string + (append `(("search" ,query) + ("options" "mr") + ("op" "index")) + (and exact '(("exact" "on")))))) + (lambda (status) + (when (plist-get status :error) + (when buf + (kill-buffer buf)) + (error "Request failed: %s" + (caddr (assq (caddr (plist-get status :error)) + url-http-codes)))) + (goto-char (point-min)) + (while (search-forward "\r\n" nil t) + (replace-match "\n" t t)) + (goto-char (point-min)) + (re-search-forward "\n\n") + (let (keys) + (save-match-data + (setq keys (epa-ks--parse-buffer)) + (kill-buffer (current-buffer))) + (when buf + (epa-ks--display-keys buf keys) keys)))) + (pop-to-buffer buf) + (setq epa-ks-last-query (list query exact))) + (message "Searching keys...")) + +(defun epa-ks--parse-buffer () + ;; parse machine readable response according to + ;; https://tools.ietf.org/html/draft-shaw-openpgp-hkp-00#section-5.2 + (when (looking-at (rx bol "info:" (group (+ digit)) + ":" (* digit) eol)) + (unless (string= (match-string 1) "1") + (error "Unsupported keyserver version"))) + (forward-line 1) + (let (key keys) + (while (and (not (eobp)) + (not (looking-at "[ \t]*\n"))) + (cond + ((looking-at (rx bol "pub:" (group (+ alnum)) + ":" (group (* digit)) + ":" (group (* digit)) + ":" (group (* digit)) + ":" (group (* digit)) + ":" (group (* (any ?r ?d ?e))) + eol)) + (setq key + (make-epa-ks-key + :id (match-string 1) + :algo + (and (match-string 2) + (not (string-empty-p (match-string 2))) + (assoc (string-to-number (match-string 2)) + epg-pubkey-algorithm-alist)) + :len + (and (match-string 3) + (not (string-empty-p (match-string 3))) + (string-to-number (match-string 3))) + :created + (and (match-string 4) + (not (string-empty-p (match-string 4))) + (seconds-to-time + (string-to-number (match-string 4)))) + :expires + (and (match-string 5) + (not (string-empty-p (match-string 5))) + (seconds-to-time + (string-to-number (match-string 5)))) + :flags + (mapcar (lambda (flag) + (cdr (assq flag '((?r revoked) + (?d disabled) + (?e expired))))) + (match-string 6)))) + (push key keys)) + ((looking-at (rx bol "uid:" (group (+ (not ":"))) + ":" (group (* digit)) + ":" (group (* digit)) + ":" (group (* (any ?r ?d ?e))) + eol)) + (push (make-epa-ks-name + :uid (url-unhex-string (match-string 1) t) + :created + (and (match-string 2) + (not (string-empty-p (match-string 2))) + (decode-time (seconds-to-time + (string-to-number + (match-string 2))))) + :expires + (and (match-string 3) + (not (string-empty-p (match-string 3))) + (decode-time (seconds-to-time + (string-to-number + (match-string 3))))) + :flags + (mapcar (lambda (flag) + (cdr (assq flag '((?r revoked) + (?d disabled) + (?e expired))))) + (match-string 4))) + (epa-ks-key-names key))) + ((looking-at-p (rx bol "uat:")) + ;; user attribute fields are ignored + nil) + (t (error "Invalid server response"))) + (forward-line)) + keys)) + +;;; epa-ks.el ends here commit 11a9d8fce625c7fdfd067a8443fb215fc1a938d0 Author: Glenn Morris Date: Wed May 12 09:38:57 2021 -0700 ; Comment fix diff --git a/lisp/mail/rmail.el b/lisp/mail/rmail.el index 06bb3bd013..7ef3754dad 100644 --- a/lisp/mail/rmail.el +++ b/lisp/mail/rmail.el @@ -3357,7 +3357,7 @@ removing prefixes such as Re:, Fwd: and so on and mailing list tags such as [tag]." (let ((subject (or (rmail-get-header "Subject" msgnum) "")) (regexp "\\`[ \t\n]*\\(\\(\\w\\{1,4\\}\u00a0*[:：]\\|\\[[^]]+]\\)[ \t\n]+\\)*")) - ;; Debbugs sometimes adds `[External] :'; if that happened, + ;; Corporate mailing systems sometimes add `[External] :'; if that happened, ;; delete everything up thru there. Empirically, that deletion makes ;; the Subject match the other messages in the thread. (if (string-match "[[]external][ \t\n]*:" subject) commit 417d53db2bcafeab54b37c59667f8dee63ffd0fb Author: Lars Ingebrigtsen Date: Wed May 12 17:36:24 2021 +0200 Fix `uniquify-managed' unbounded growth * lisp/uniquify.el (uniquify-rationalize-file-buffer-names): Protect against exponential `uniquify-managed' growth when reverting several (more than two) buffers that have the same file name (bug#36877). diff --git a/lisp/uniquify.el b/lisp/uniquify.el index 7cc01687f4..ffb5ecc902 100644 --- a/lisp/uniquify.el +++ b/lisp/uniquify.el @@ -246,7 +246,14 @@ this rationalization." (if (buffer-live-p (uniquify-item-buffer item)) item)) items))) - (setq fix-list (append fix-list items)))) + ;; Other buffer's `uniquify-managed' lists may share + ;; elements. Ensure that we don't add these elements more + ;; than once to this buffer's `uniquify-managed' list. + (let ((new-items nil)) + (dolist (item items) + (unless (memq item fix-list) + (push item new-items))) + (setq fix-list (append fix-list new-items))))) ;; selects buffers whose names may need changing, and others that ;; may conflict, then bring conflicting names together (uniquify-rationalize fix-list)))) commit bc1a01172e2725503628914f019192c0e59260a3 Author: Lars Ingebrigtsen Date: Wed May 12 16:17:50 2021 +0200 Further corrections for the text-property-search doc strings * lisp/emacs-lisp/text-property-search.el (text-property-search-forward): Correct doc string. (text-property-search-backward): Ditto. diff --git a/lisp/emacs-lisp/text-property-search.el b/lisp/emacs-lisp/text-property-search.el index 49e196d3bf..1f2dcfe9dd 100644 --- a/lisp/emacs-lisp/text-property-search.el +++ b/lisp/emacs-lisp/text-property-search.el @@ -46,18 +46,19 @@ If PREDICATE is nil, a value will match if is not `equal' to VALUE. Furthermore, the match region is ended if the value changes. For instance, this means that if you loop with - (while (text-property-search-forward 'face) + (while (setq prop (text-property-search-forward 'face)) ...) you will get all distinct regions with different `face' values in -the buffer. +the buffer, and the `prop' object will have the details about the +match. If NOT-CURRENT is non-nil, the function will search for the first region that doesn't include point and has a value of PROPERTY that matches VALUE. If no matches can be found, return nil and don't move point. -If found, move point to the start of the region and return a +If found, move point to the end of the region and return a `prop-match' object describing the match. To access the details of the match, use `prop-match-beginning' and `prop-match-end' for the buffer positions that limit the region, and @@ -134,7 +135,7 @@ the buffer positions that limit the region, and "Search for the previous region of text whose PROPERTY matches VALUE. Like `text-property-search-forward', which see, but searches backward, -and if a matching region is found, place point at its end." +and if a matching region is found, place point at the start of the region." (interactive (list (let ((string (completing-read "Search for property: " obarray))) commit 1b0dc15a0ac0715166fbce4b23cd0a3644a90714 Author: Lars Ingebrigtsen Date: Wed May 12 15:41:26 2021 +0200 Tweak indentation of #foo in js-mode * lisp/progmodes/js.el (js--proper-indentation): Indent #define (etc) to column 0, but otherwise indent #foo normally (bug#47488). diff --git a/lisp/progmodes/js.el b/lisp/progmodes/js.el index fac0d39b69..1ab0459d70 100644 --- a/lisp/progmodes/js.el +++ b/lisp/progmodes/js.el @@ -2861,6 +2861,11 @@ return nil." ((nth 3 parse-status) 0) ; inside string ((when (and js-jsx-syntax (not js-jsx--indent-col)) (save-excursion (js-jsx--indentation parse-status)))) + ((and (eq (char-after) ?#) + (save-excursion + (forward-char 1) + (looking-at-p cpp-font-lock-keywords-source-directives))) + 0) ((save-excursion (js--beginning-of-macro)) 4) ;; Indent array comprehension continuation lines specially. ((let ((bracket (nth 1 parse-status)) commit df2a23777539b29ebbd3288e756ace56f7df0d8d Author: Lars Ingebrigtsen Date: Wed May 12 14:15:36 2021 +0200 Remove unused variable in rmail.el * lisp/mail/rmail.el (rmail-reply): Remove unused lexical variable introduced in previous patch. diff --git a/lisp/mail/rmail.el b/lisp/mail/rmail.el index f60581a11c..06bb3bd013 100644 --- a/lisp/mail/rmail.el +++ b/lisp/mail/rmail.el @@ -3767,7 +3767,7 @@ use \\[mail-yank-original] to yank the original message into it." (rmail-apply-in-message rmail-current-message (lambda () - (let ((beg (point-min)) (end (point-max)) + (let ((end (point-max)) subheader) ;; Find the message's real header. (search-forward "\n\n" nil 'move) commit 98e5639c3c3caf2424f35e4a9f9c53ff48f43897 Author: Eli Zaretskii Date: Wed May 12 16:41:03 2021 +0300 Fix the tests for 'string-limit' * test/lisp/emacs-lisp/subr-x-tests.el (subr-string-limit-coding): Fix the expected results of string-limit when encoding with UTF-16. Add tests for UTF-8 with BOM. (Bug#48324) * lisp/emacs-lisp/subr-x.el (string-limit): Add FIXME comment about the current implementation, which is faulty by design. diff --git a/lisp/emacs-lisp/subr-x.el b/lisp/emacs-lisp/subr-x.el index 9c8c967ee9..5a8885c042 100644 --- a/lisp/emacs-lisp/subr-x.el +++ b/lisp/emacs-lisp/subr-x.el @@ -289,6 +289,18 @@ than this function." (let ((result nil) (result-length 0) (index (if end (1- (length string)) 0))) + ;; FIXME: This implementation, which uses encode-coding-char + ;; to encode the string one character at a time, is in general + ;; incorrect: coding-systems that produce prefix or suffix + ;; bytes, such as ISO-2022-based or UTF-8/16 with BOM, will + ;; produce those bytes for each character, instead of just + ;; once for the entire string. encode-coding-char attempts to + ;; remove those extra bytes at least in some situations, but + ;; it cannot do that in all cases. And in any case, producing + ;; what is supposed to be a UTF-16 or ISO-2022-CN encoded + ;; string which lacks the BOM bytes at the beginning and the + ;; charset designation sequences at the head and tail of the + ;; result will definitely surprise the callers in some cases. (while (let ((encoded (encode-coding-char (aref string index) coding-system))) (and (<= (+ (length encoded) result-length) length) diff --git a/test/lisp/emacs-lisp/subr-x-tests.el b/test/lisp/emacs-lisp/subr-x-tests.el index 112f3c1dac..ef04cde386 100644 --- a/test/lisp/emacs-lisp/subr-x-tests.el +++ b/test/lisp/emacs-lisp/subr-x-tests.el @@ -607,18 +607,21 @@ (should (equal (string-limit "foó" 4 nil 'utf-8) "fo\303\263")) (should (equal (string-limit "foóa" 4 nil 'utf-8) "fo\303\263")) (should (equal (string-limit "foóá" 4 nil 'utf-8) "fo\303\263")) + (should (equal (string-limit "foóá" 4 nil 'utf-8-with-signature) + "fo\303\263")) (should (equal (string-limit "foóa" 4 nil 'iso-8859-1) "fo\363a")) (should (equal (string-limit "foóá" 4 nil 'iso-8859-1) "fo\363\341")) - (should (equal (string-limit "foóá" 4 nil 'utf-16) "\376\377\000f")) + (should (equal (string-limit "foóá" 4 nil 'utf-16) "\000f\000o")) (should (equal (string-limit "foó" 10 t 'utf-8) "fo\303\263")) (should (equal (string-limit "foó" 3 t 'utf-8) "o\303\263")) (should (equal (string-limit "foó" 4 t 'utf-8) "fo\303\263")) (should (equal (string-limit "foóa" 4 t 'utf-8) "o\303\263a")) (should (equal (string-limit "foóá" 4 t 'utf-8) "\303\263\303\241")) + (should (equal (string-limit "foóá" 2 t 'utf-8-with-signature) "\303\241")) (should (equal (string-limit "foóa" 4 t 'iso-8859-1) "fo\363a")) (should (equal (string-limit "foóá" 4 t 'iso-8859-1) "fo\363\341")) - (should (equal (string-limit "foóá" 4 t 'utf-16) "\376\377\000\341"))) + (should (equal (string-limit "foóá" 4 t 'utf-16) "\000\363\000\341"))) (ert-deftest subr-string-lines () (should (equal (string-lines "foo") '("foo"))) commit d2034296a906bf444472c02b958dba21cbaae762 Author: Jim Porter Date: Wed May 12 10:47:07 2021 +0200 Abbreviate rgrep command on MS Windows (bug#48302) * lisp/progmodes/grep.el (grep-mode-font-lock-keywords): Adapt regexp to match MS Windows-style shell-quoting. * test/lisp/progmodes/grep-tests.el: New file. diff --git a/lisp/progmodes/grep.el b/lisp/progmodes/grep.el index e9fbcbbfcd..80c3e7840f 100644 --- a/lisp/progmodes/grep.el +++ b/lisp/progmodes/grep.el @@ -473,7 +473,7 @@ buffer `default-directory'." (1 (if (eq (char-after (match-beginning 1)) ?\0) `(face nil display ,(match-string 2))))) ;; Hide excessive part of rgrep command - ("^find \\(\\. -type d .*\\\\)\\)" + ("^find \\(\\. -type d .*\\(?:\\\\)\\|\")\"\\)\\)" (1 (if grep-find-abbreviate grep-find-abbreviate-properties '(face nil abbreviated-command t)))) ;; Hide excessive part of lgrep command diff --git a/test/lisp/progmodes/grep-tests.el b/test/lisp/progmodes/grep-tests.el new file mode 100644 index 0000000000..205982238f --- /dev/null +++ b/test/lisp/progmodes/grep-tests.el @@ -0,0 +1,69 @@ +;;; grep-tests.el --- Test suite for grep.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 'grep) + +(defconst grep-tests--ellipsis (if (char-displayable-p ?…) "[…]" "[...]") + "The form that the ellipsis takes in `grep-find-abbreviate-properties'.") + +(defun grep-tests--get-rgrep-abbreviation () + "Get the `display' property of the excessive part of the rgrep command." + (with-temp-buffer + (grep-compute-defaults) + (insert (rgrep-default-command "search" "*" nil)) + (grep-mode) + (font-lock-mode) + (font-lock-ensure) + (goto-char (point-min)) + (re-search-forward "find ") + (get-text-property (point) 'display))) + +(defun grep-tests--check-rgrep-abbreviation () + "Check that the excessive part of the rgrep command is abbreviated iff +`grep-find-abbreviate' is non-nil." + (let ((grep-find-abbreviate t)) + (should (equal (grep-tests--get-rgrep-abbreviation) + grep-tests--ellipsis))) + (let ((grep-find-abbreviate nil)) + (should-not (grep-tests--get-rgrep-abbreviation)))) + +(ert-deftest grep-tests--rgrep-abbreviate-properties-gnu-linux () + (let ((system-type 'gnu/linux)) + (grep-tests--check-rgrep-abbreviation))) + +(ert-deftest grep-tests--rgrep-abbreviate-properties-darwin () + (let ((system-type 'darwin)) + (grep-tests--check-rgrep-abbreviation))) + +(ert-deftest grep-tests--rgrep-abbreviate-properties-windows-nt-dos-semantics () + (let ((system-type 'windows-nt)) + (cl-letf (((symbol-function 'w32-shell-dos-semantics) #'always)) + (grep-tests--check-rgrep-abbreviation)))) + +(ert-deftest grep-tests--rgrep-abbreviate-properties-windows-nt-sh-semantics () + (let ((system-type 'windows-nt)) + (cl-letf (((symbol-function 'w32-shell-dos-semantics) #'ignore)) + (grep-tests--check-rgrep-abbreviation)))) + +;;; grep-tests.el ends here