commit 129119aef1c850de9d20ecc828c889801f3e668f (HEAD, refs/remotes/origin/master) Author: Eli Zaretskii Date: Sun Oct 5 18:32:16 2025 +0300 Fix rare breakage of 'revert-buffer' in 'archive-mode' * lisp/arc-mode.el (archive--mode-revert): Avoid deletion of some region of the reverted buffer by 'archive-desummarize'. (Bug#79574) diff --git a/lisp/arc-mode.el b/lisp/arc-mode.el index 0c5d3475aa6..66cb89c3342 100644 --- a/lisp/arc-mode.el +++ b/lisp/arc-mode.el @@ -1648,6 +1648,12 @@ as a relative change like \"g+rw\" as for chmod(2)." (defun archive--mode-revert (orig-fun &rest args) (let ((no (archive-get-lineno))) (setq archive-files nil) + ;; 'orig-fun' will indirectly call 'archive-desummarize', which will + ;; delete the region between point-min and + ;; 'archive-proper-file-start'. But the latter will be invalidated + ;; by 'orig-fun' (which actually reverts the buffer), so by setting + ;; it to 1 we prevent the damage from that deletion. + (setq archive-proper-file-start 1) (let ((coding-system-for-read 'no-conversion)) (apply orig-fun t t (cddr args))) (archive-mode) commit a142cc262ecac539dbfb412b9fb09e8205b2bc3e Author: Michael Albinus Date: Sun Oct 5 17:14:59 2025 +0200 Add fallback backend in auth-sources * etc/NEWS: Describe effect of auth-sources being nil. * lisp/auth-source.el (auth-sources): Add const nil. (auth-source-ignored-keys): New defconst. (auth-source-backends, auth-source-keys) (auth-source-search-keys, auth-source-returned-keys) (auth-source-search-spec): New macros. (auth-source-file-name-p, auth-source-search) (auth-source-specmatchp, auth-source-netrc-create) (auth-source-secrets-search, auth-source-secrets-create) (auth-source-macos-keychain-search) (auth-source-plstore-search, auth-source-plstore-create): Use them (auth-source-read-passwd-search, auth-source-read-passwd-create): New defuns. * test/lisp/auth-source-tests.el (auth-source-backend-parse-plstore-string) (auth-source-backend-parse-json-string) (auth-source-backend-parse-fallback) (auth-source-test-read-passwd-create-secret): New tests. diff --git a/etc/NEWS b/etc/NEWS index 0c0ee8aa4eb..5e02f43296b 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -216,14 +216,14 @@ different values for completion-affecting variables like applies for the styles configuration in 'completion-category-overrides' and 'completion-category-defaults'. -+++++ ++++ *** Navigating "*Completions*" now accommodates 'completions-format'. -When 'completions-format' is set to 'vertical', typing 'n', '' or +When 'completions-format' is set to 'vertical', typing 'n', 'TAB' or 'M-' in the "*Completions*" buffer (the latter also in the minibuffer) now moves point to the completion candidate in the next line in the current column, and wraps to the next column when typed on the last completion candidate of the current column. Likewise, typing 'p', -'S-' or 'M-' moves point to the completion candidate in the +'S-TAB' or 'M-' moves point to the completion candidate in the previous line or wraps to the previous column. Previously, these keys ignored the vertical format, i.e., moved point only to the item in the same line of the next or previous column, in accordance with the default @@ -272,7 +272,7 @@ but as a plain Lisp variable, not a user option.) --- *** New mode 'minibuffer-nonselected-mode'. -This mode enabled by default directs the attention to the active +This mode, enabled by default, directs the attention to the active minibuffer window using the 'minibuffer-nonselected' face in case when the minibuffer window is no longer selected, but the minibuffer is still waiting for input. @@ -280,7 +280,7 @@ is still waiting for input. ** Mouse *** New mode 'mouse-shift-adjust-mode' extends selection with 'S-'. -When enabled, you can use the left mouse button with the modifier +When enabled, you can use the left mouse button with the '' modifier to extend the boundaries of the active region by dragging the mouse pointer. --- @@ -750,7 +750,7 @@ pair: '("/*" " */" t)'. --- ** New user option 'electric-indent-actions'. -This user options specifies a list of actions to reindent. The possible +This user option specifies a list of actions to reindent. The possible elements for this list are: 'yank', reindent the yanked text; 'before-save', indent the whole buffer before saving it. @@ -810,6 +810,9 @@ in such a file; the first usable entry of ‘auth-sources’ is selected as target. If you want also not existing files to be selected, set the user option ‘auth-source-ignore-non-existing-file’ to nil. +--- +*** 'auth-sources' set to nil means using the password cache only. + ** Autoinsert +++ @@ -823,7 +826,7 @@ with finer grained control. +++ *** New functions 'buffer-to-register' and 'file-to-register'. -These allow users to interactively store file and buffers in registers. +These allow users to interactively store files and buffers in registers. Killed buffers stored in a register using 'buffer-to-register' are automatically converted to a file-query value if the buffer was visiting a file. @@ -1010,28 +1013,27 @@ next to the ellipsis. By default this is disabled. +++ *** New user option 'hs-show-indicators'. -This user option determines if hideshow should display indicators to +This user option determines if Hideshow should display indicators to show and toggle the block hiding. If non-nil, the indicators are enabled. - By default this is disabled. *** New user option 'hs-indicator-maximum-buffer-size'. -This user option limits the display of hideshow indicators to buffers +This user option limits the display of Hideshow indicators to buffers that are not too large. By default, buffers larger than 2MB have the indicators disabled; the value of nil will activate the indicators regardless of the buffer size. +++ *** New user option 'hs-indicator-type'. -This user option determine which indicator type should be used for the +This user option determines which indicator type should be used for the block indicators. The possible values can be: 'fringe', display the indicators in the fringe (the default); 'margin', display the indicators in the margin; nil, display the indicators at end-of-line. -The new icons 'hs-indicator-show' and 'hs-indicator-hide', can be used -for customize the indicators appearance, only if 'hs-indicator-type' is +The new icons 'hs-indicator-show' and 'hs-indicator-hide' can be used +to customize the indicators appearance only if 'hs-indicator-type' is set to 'margin' or nil. ** C-ts mode @@ -1043,9 +1045,9 @@ are highlighted like other comments. When non-nil, Doxygen comment blocks are syntax-highlighted if the Doxygen grammar library is available. -** Csharp-ts-mode +** Csharp-ts mode -*** Renamed feature in 'treesit-font-lock-feature-list' +*** Renamed feature in 'treesit-font-lock-feature-list'. The feature 'property' has been renamed to 'attribute', since this is what it is called in the general C# community. @@ -1491,8 +1493,8 @@ It removes all the buttons in the specified region. You can now bookmark local and remote shell buffers using the bookmark menu 'bookmark-bmenu-list', or by using the command 'bookmark-set'. Shell bookmarks can be loaded via the menu and by using the command -'bookmark-jump', which open a bookmarked shell, restore its buffer name, -its current directory, and create a remote connection, if necessary. +'bookmark-jump', which opens a bookmarked shell, restores its buffer name, +its current directory, and creates a remote connection, if necessary. You can customize 'shell-bookmark-name-function'. *** New command to complete the shell history. @@ -3019,8 +3021,8 @@ commands '{next,previous}-column-completion', depending on the value of 'completions-format'. The latter two commands improve and extend the previous implementations of '{next,previous}-completion', which better reflect that they only take the (default) horizontal completions format -into account. Any external code using '{next,previous}-completion' that -assumes the previous implementation must be adjusted accordingly; see +into account. Any external code using '{next,previous}-completion', that +assumes the previous implementation, must be adjusted accordingly; see 'minibuffer-next-completion' for an example of such an adjustment in Emacs core. diff --git a/lisp/auth-source.el b/lisp/auth-source.el index e7c8f43b7f9..1cef682af82 100644 --- a/lisp/auth-source.el +++ b/lisp/auth-source.el @@ -234,10 +234,14 @@ EPA/EPG set up, the file will be encrypted and decrypted automatically. See Info node `(epa)Encrypting/decrypting gpg files' for details. +If this option is nil, no authentication source is used but the local +password cache. + It's best to customize this with \\[customize-variable] because the choices can get pretty complex." :version "26.1" ; neither new nor changed default - :type `(repeat :tag "Authentication Sources" + :type `(choice (const :tag "Password cache" nil) + (repeat :tag "Authentication Sources" (choice (string :tag "Just a file") (const :tag "Default Secrets API Collection" default) @@ -301,7 +305,7 @@ the choices can get pretty complex." (const :tag "Any" t) (string :tag "Name")))))) - (sexp :tag "A data structure (external provider)"))) + (sexp :tag "A data structure (external provider)")))) :link '(custom-manual "(auth) Help for users")) (defcustom auth-source-gpg-encrypt-to t @@ -370,6 +374,44 @@ soon as a function returns non-nil.") :type 'ignore))) (auth-source-backend-parse-parameters entry backend))) +(defmacro auth-source-backends () + "List of usable backends from `auth-sources'. +A fallback backend is added to ensure, that at least `read-passwd' is called." + `(or (mapcar #'auth-source-backend-parse auth-sources) + ;; Fallback. + (list (auth-source-backend + :source "" + :type 'read-passwd + :search-function #'auth-source-read-passwd-search + :create-function #'auth-source-read-passwd-create)))) + +(defmacro auth-source-keys (spec) + "Return keys from SPEC." + `(cl-loop for i below (length ,spec) by 2 + collect (nth i ,spec))) + +(defconst auth-source-ignored-keys + '(:create :delete :max :backend :label :require :type) + "List of meta keys to be ignored in data stores.") + +(defmacro auth-source-search-keys (spec) + "Filter out ignored keys from SPEC." + `(seq-difference (auth-source-keys ,spec) auth-source-ignored-keys)) + +(defmacro auth-source-returned-keys (spec) + "Needed keys (always including host, login, port, and secret)." + `(seq-union '(:host :login :port :secret) (auth-source-search-keys ,spec))) + +(defmacro auth-source-search-spec (spec) + "Build a search spec without the ignored keys. +If a search key is nil or t (match anything), skip it." + `(seq-keep + (lambda (k) + (and-let* ((v (plist-get ,spec k)) + ((not (eq t v))) + ((cons k (auth-source-ensure-strings v)))))) + (auth-source-search-keys spec))) + (defcustom auth-source-ignore-non-existing-file t "If set non-nil, file-based backends are ignored if the file does not exist. Consequently, no newly created entry is saved in such a backend when @@ -424,7 +466,8 @@ Supported backend types are `netrc', `plstore' and `json'." :create-function #'auth-source-netrc-create))))) ;; Note this function should be last in the parser functions, so we add it first -(add-hook 'auth-source-backend-parser-functions #'auth-source-backends-parser-file) +(add-hook 'auth-source-backend-parser-functions + #'auth-source-backends-parser-file) (defun auth-source-backends-parser-macos-keychain (entry) ;; take macos-keychain-{internet,generic}:XYZ and use it as macOS @@ -470,7 +513,8 @@ Supported backend types are `netrc', `plstore' and `json'." :search-function #'auth-source-macos-keychain-search :create-function #'auth-source-macos-keychain-create))))) -(add-hook 'auth-source-backend-parser-functions #'auth-source-backends-parser-macos-keychain) +(add-hook 'auth-source-backend-parser-functions + #'auth-source-backends-parser-macos-keychain) (defun auth-source-backends-parser-secrets (entry) ;; take secrets:XYZ and use it as Secrets API collection "XYZ" @@ -515,7 +559,8 @@ Supported backend types are `netrc', `plstore' and `json'." :source "" :type 'ignore)))))) -(add-hook 'auth-source-backend-parser-functions #'auth-source-backends-parser-secrets) +(add-hook 'auth-source-backend-parser-functions + #'auth-source-backends-parser-secrets) (defun auth-source-backend-parse-parameters (entry backend) "Fill in the extra `auth-source-backend' parameters of ENTRY. @@ -537,7 +582,7 @@ parameters." (defun auth-source-file-name-p (file) "Say whether FILE is used by `auth-sources'." - (let* ((backends (mapcar #'auth-source-backend-parse auth-sources)) + (let* ((backends (auth-source-backends)) (files (mapcar (lambda (x) (when (member (slot-value x 'type) '(json netrc plstore)) @@ -695,12 +740,8 @@ actually useful. So the caller must arrange to call this function. The token's :secret key can hold a function. In that case you must call it to obtain the actual value." - (let* ((backends (mapcar #'auth-source-backend-parse auth-sources)) + (let* ((backends (auth-source-backends)) (max (or max 1)) - (ignored-keys '(:require :create :delete :max)) - (keys (cl-loop for i below (length spec) by 2 - unless (memq (nth i spec) ignored-keys) - collect (nth i spec))) (cached (auth-source-remembered-p spec)) ;; note that we may have cached results but found is still nil ;; (there were no results from the search) @@ -722,7 +763,7 @@ must call it to obtain the actual value." (setq filtered-backends (copy-sequence backends)) (dolist (backend backends) - (cl-dolist (key keys) + (cl-dolist (key (auth-source-search-keys spec)) ;; ignore invalid slots (condition-case nil (unless (auth-source-search-collection @@ -837,6 +878,7 @@ Returns the deleted entries." (defun auth-source-format-cache-entry (spec) "Format SPEC entry to put it in the password cache." `(auth-source . ,spec)) + ;; `(auth-source . ,(auth-source-search-spec spec))) (defun auth-source-remember (spec found) "Remember FOUND search results for SPEC." @@ -880,8 +922,7 @@ while \(:host t) would find all host entries." count)) (defun auth-source-specmatchp (spec stored) - (let ((keys (cl-loop for i below (length spec) by 2 - collect (nth i spec)))) + (let ((keys (auth-source-keys spec))) (not (eq (cl-dolist (key keys) (unless (auth-source-search-collection (plist-get stored key) @@ -898,7 +939,8 @@ while \(:host t) would find all host entries." (defun auth-source-pick-first-password (&rest spec) "Pick the first secret found by applying `auth-source-search' to SPEC." - (auth-info-password (car (apply #'auth-source-search (plist-put spec :max 1))))) + (auth-info-password + (car (apply #'auth-source-search (plist-put spec :max 1))))) (defun auth-source-format-prompt (prompt alist) "Format PROMPT using %x (for any character x) specifiers in ALIST. @@ -923,8 +965,6 @@ Remove trailing \": \"." value)) values))) -;;; Backend specific parsing: netrc/authinfo backend - (defun auth-source--aput-1 (alist key val) (let ((seen ()) (rest alist)) @@ -940,6 +980,123 @@ Remove trailing \": \"." (defun auth-source--aget (alist key) (cdr (assoc key alist))) +;;; Backend specific parsing: just read the password + +(cl-defun auth-source-read-passwd-search (&rest spec + &key backend create delete + &allow-other-keys) + "Search in password cache; spec is like `auth-source'." + + ;; TODO + (cl-assert + (not delete) nil + "The `read-passwd' auth-source backend doesn't support deletion yet") + + (let ((found (auth-source-recall (auth-source-search-spec spec)))) + (cond + (found (list found)) + (create (apply (slot-value backend 'create-function) spec))))) + +(cl-defun auth-source-read-passwd-create (&rest spec + &key host port user + &allow-other-keys) + (let* ((base-required '(host user port secret)) + ;; we know (because of an assertion in auth-source-search) that the + ;; :create parameter is either t or a list (which includes nil) + (current-data (car (auth-source-search :max 1 + :host host + :user user + :port port))) + ;; `valist' is an alist + valist + ;; `artificial' will be returned if no creation is needed + artificial) + + ;; only for base required elements (defined as function parameters): + ;; fill in the valist with whatever data we may have from the search + ;; we complete the first value if it's a list and use the value otherwise + (dolist (br base-required) + (let ((val (plist-get spec (auth-source--symbol-keyword br)))) + (when val + (let ((br-choice (cond + ;; all-accepting choice (predicate is t) + ((eq t val) nil) + ;; just the value otherwise + (t val)))) + (when br-choice + (auth-source--aput valist br br-choice)))))) + + ;; for each required element + (dolist (r base-required) + (let* ((data (auth-source--aget valist r)) + ;; take the first element if the data is a list + (data (or (auth-source-netrc-element-or-first data) + (plist-get current-data + (auth-source--symbol-keyword r)))) + ;; this is the default to be offered + (given-default (auth-source--aget + auth-source-creation-defaults r)) + ;; the default supplementals are simple: + ;; for the user, try `given-default' and then (user-login-name); + ;; otherwise take `given-default' + (default (cond + ((and (not given-default) (eq r 'user)) + (user-login-name)) + (t given-default))) + (printable-defaults (list + (cons 'user + (or + (auth-source-netrc-element-or-first + (auth-source--aget valist 'user)) + (plist-get artificial :user) + "[any user]")) + (cons 'host + (or + (auth-source-netrc-element-or-first + (auth-source--aget valist 'host)) + (plist-get artificial :host) + "[any host]")) + (cons 'port + (or + (auth-source-netrc-element-or-first + (auth-source--aget valist 'port)) + (plist-get artificial :port) + "[any port]")))) + (prompt (or (auth-source--aget auth-source-creation-prompts r) + (cl-case r + (secret "%p password for %u@%h") + (user "%p user name for %h") + (host "%p host name for user %u") + (port "%p port for %u@%h")) + (format "Enter %s (%%u@%%h:%%p)" r))) + (prompt (auth-source-format-prompt + prompt + `((?u ,(auth-source--aget printable-defaults 'user)) + (?h ,(auth-source--aget printable-defaults 'host)) + (?p ,(auth-source--aget printable-defaults 'port)))))) + + ;; Store the data, prompting for the password if needed. + (setq data (or data + (if (eq r 'secret) + (or (eval default) + (read-passwd (format-prompt prompt nil))) + (if (and (stringp default) auth-source-save-behavior) + (read-string + (format-prompt prompt default) nil nil default) + (eval default))))) + + (when data + (setq artificial (plist-put artificial + (auth-source--symbol-keyword r) + (if (eq r 'secret) + (let ((data data)) + (lambda () data)) + data)))))) + + (list artificial))) + +;;; Backend specific parsing: netrc/authinfo backend + ;;;###autoload (defun auth-source-netrc-parse-all (file) "Parse FILE and return all entries." @@ -1360,8 +1517,7 @@ See `auth-source-search' for details on SPEC." ;; for extra required elements, see if the spec includes a value for them (dolist (er create-extra) (let ((k (auth-source--symbol-keyword er)) - (keys (cl-loop for i below (length spec) by 2 - collect (nth i spec)))) + (keys (auth-source-keys spec))) (when (memq k keys) (auth-source--aput valist er (plist-get spec k))))) @@ -1645,30 +1801,11 @@ authentication tokens: (let* ((coll (oref backend source)) (max (or max 5000)) ; sanity check: default to stop at 5K - (ignored-keys '(:create :delete :max :backend :label :require :type)) - (search-keys (cl-loop for i below (length spec) by 2 - unless (memq (nth i spec) ignored-keys) - collect (nth i spec))) - ;; build a search spec without the ignored keys - ;; if a search key is nil or t (match anything), we skip it - (search-specs (auth-source-secrets-listify-pattern - (apply #'append (mapcar - (lambda (k) - (let ((v (plist-get spec k))) - (if (or (null v) - (eq t v)) - nil - (list - k - (auth-source-ensure-strings v))))) - search-keys)))) - ;; needed keys (always including host, login, port, and secret) - (returned-keys (delete-dups (append - '(:host :login :port :secret) - search-keys))) (items (cl-loop - for search-spec in search-specs + for search-spec in + (apply #'auth-source-secrets-listify-pattern + (auth-source-search-spec spec)) nconc (cl-loop for item in (apply #'secrets-search-items coll search-spec) unless (and (stringp label) @@ -1690,7 +1827,7 @@ authentication tokens: (list (car entry) (cdr entry))) (secrets-get-attributes coll item))))) items)) - ;; ensure each item has each key in `returned-keys' + ;; Ensure each item has each key in `auth-source-returned-keys'. (items (mapcar (lambda (plist) (append (apply #'append @@ -1698,7 +1835,7 @@ authentication tokens: (if (plist-get plist req) nil (list req nil))) - returned-keys)) + (auth-source-returned-keys spec))) plist)) items))) (cond @@ -1758,8 +1895,7 @@ authentication tokens: ;; for extra required elements, see if the spec includes a value for them (dolist (er create-extra) (let ((k (auth-source--symbol-keyword er)) - (keys (cl-loop for i below (length spec) by 2 - collect (nth i spec)))) + (keys (auth-source-keys spec))) (when (memq k keys) (auth-source--aput valist er (plist-get spec k))))) @@ -1854,7 +1990,8 @@ authentication tokens: (if (not (eq r 'label)) ;; append the key (the symbol name of r) ;; and the value in r - (setq args (append args (list (auth-source--symbol-keyword r) data)))))))) + (setq args (append args (list (auth-source--symbol-keyword r) + data)))))))) (when save-function (plist-put @@ -1956,25 +2093,8 @@ entries for git.gnus.org: (let* ((coll (oref backend source)) (max (or max 5000)) ; sanity check: default to stop at 5K - ;; Filter out ignored keys from the spec - (ignored-keys '(:create :delete :max :backend :label :host :port)) - ;; Build a search spec without the ignored keys - ;; FIXME make this loop a function? it's used in at least 3 places - (search-keys (cl-loop for i below (length spec) by 2 - unless (memq (nth i spec) ignored-keys) - collect (nth i spec))) - ;; If a search key value is nil or t (match anything), we skip it - (search-spec (apply #'append (mapcar - (lambda (k) - (if (or (null (plist-get spec k)) - (eq t (plist-get spec k))) - nil - (list k (plist-get spec k)))) - search-keys))) - ;; needed keys (always including host, login, port, and secret) - (returned-keys (delete-dups (append - '(:host :login :port :secret) - search-keys))) + (auth-source-ignored-keys + (seq-union auth-source-ignored-keys '(:host :port))) ;; Extract host, port and user from spec (hosts (plist-get spec :host)) (hosts (if (consp hosts) hosts `(,hosts))) @@ -1996,11 +2116,11 @@ entries for git.gnus.org: type max host port user - search-spec))) + (auth-source-search-spec spec)))) (when items (throw 'match items)))))))) - ;; ensure each item has each key in `returned-keys' + ;; ensure each item has each key in `auth-source-returned-keys'. (items (mapcar (lambda (plist) (append (apply #'append @@ -2008,7 +2128,7 @@ entries for git.gnus.org: (if (plist-get plist req) nil (list req nil))) - returned-keys)) + (auth-source-returned-keys spec))) plist)) items))) items)) @@ -2120,27 +2240,7 @@ entries for git.gnus.org: "Search the PLSTORE; SPEC is like `auth-source'." (let* ((store (oref backend data)) (max (or max 5000)) ; sanity check: default to stop at 5K - (ignored-keys '(:create :delete :max :backend :label :require :type)) - (search-keys (cl-loop for i below (length spec) by 2 - unless (memq (nth i spec) ignored-keys) - collect (nth i spec))) - ;; build a search spec without the ignored keys - ;; if a search key is nil or t (match anything), we skip it - (search-spec (apply #'append (mapcar - (lambda (k) - (let ((v (plist-get spec k))) - (if (or (null v) - (eq t v)) - nil - (list - k - (auth-source-ensure-strings v))))) - search-keys))) - ;; needed keys (always including host, login, port, and secret) - (returned-keys (delete-dups (append - '(:host :login :port :secret) - search-keys))) - (items (plstore-find store search-spec)) + (items (plstore-find store (auth-source-search-spec spec))) (item-names (mapcar #'car items)) (items (take max items)) ;; convert the item to a full plist @@ -2156,7 +2256,7 @@ entries for git.gnus.org: (lambda () v))))) plist)) items)) - ;; ensure each item has each key in `returned-keys' + ;; ensure each item has each key in `auth-source-returned-keys'. (items (mapcar (lambda (plist) (append (apply #'append @@ -2164,7 +2264,7 @@ entries for git.gnus.org: (if (plist-get plist req) nil (list req nil))) - returned-keys)) + (auth-source-returned-keys spec))) plist)) items))) (cond @@ -2230,8 +2330,7 @@ entries for git.gnus.org: (auth-source--aput valist br br-choice)))))) ;; for extra required elements, see if the spec includes a value for them - (let ((keys (cl-loop for i below (length spec) by 2 - collect (nth i spec))) + (let ((keys (auth-source-keys spec)) k) (dolist (er create-extra) (setq k (auth-source--symbol-keyword er)) @@ -2591,7 +2690,8 @@ by doing (clear-string STRING)." (second (read-passwd "Confirm password: " nil default))) (if (equal first second) (progn - (and (arrayp second) (not (eq first second)) (clear-string second)) + (and (arrayp second) (not (eq first second)) + (clear-string second)) (setq success first)) (and (arrayp first) (clear-string first)) (and (arrayp second) (clear-string second)) diff --git a/test/lisp/auth-source-tests.el b/test/lisp/auth-source-tests.el index d6845b0af37..4d4786f4ca9 100644 --- a/test/lisp/auth-source-tests.el +++ b/test/lisp/auth-source-tests.el @@ -32,6 +32,13 @@ (require 'auth-source) (require 'secrets) +;; (dolist +;; (elt +;; (append +;; (mapcar #'intern (all-completions "auth-" obarray #'functionp)) +;; (mapcar #'intern (all-completions "password-" obarray #'functionp)))) +;; (trace-function-background elt)) + (defun auth-source-ensure-ignored-backend (source) (auth-source-validate-backend source '((source . "") (type . ignore)))) @@ -103,6 +110,14 @@ (create-function . auth-source-plstore-create)))) +(ert-deftest auth-source-backend-parse-plstore-string () + (auth-source-validate-backend "foo.plist" + '((source . "foo.plist") + (type . plstore) + (search-function . auth-source-plstore-search) + (create-function + . auth-source-plstore-create)))) + (ert-deftest auth-source-backend-parse-netrc () (auth-source-validate-backend '(:source "foo") '((source . "foo") @@ -129,6 +144,16 @@ ;; . auth-source-json-create)))) . ignore)))) +(ert-deftest auth-source-backend-parse-json-string () + (auth-source-validate-backend "foo.json" + '((source . "foo.json") + (type . json) + (search-function . auth-source-json-search) + (create-function + ;; To be implemented: + ;; . auth-source-json-create)))) + . ignore)))) + (ert-deftest auth-source-backend-parse-secrets () (provide 'secrets) ; simulates the presence of the `secrets' package (let ((secrets-enabled t)) @@ -198,6 +223,20 @@ (auth-source-ensure-ignored-backend '(:source '(foo))) (auth-source-ensure-ignored-backend '(:source nil)))) +(ert-deftest auth-source-backend-parse-fallback () + (let* (auth-sources + (backends (auth-source-backends)) + (backend (car backends)) + (validation-alist + '((source . "") + (type . read-passwd) + (search-function . auth-source-read-passwd-search) + (create-function . auth-source-read-passwd-create)))) + (should (length= backends 1)) + (should (auth-source-backend-p backend)) + (dolist (pair validation-alist) + (should (equal (eieio-oref backend (car pair)) (cdr pair)))))) + (defun auth-source--test-netrc-parse-entry (entry host user port) "Parse a netrc entry from buffer." (auth-source-forget-all-cached) @@ -434,6 +473,35 @@ (should (string-equal auth-passwd passwd)) (should (search-forward host nil 'noerror))))))))) +(ert-deftest auth-source-test-read-passwd-create-secret () + (let (auth-sources auth-info auth-passwd host) + (auth-source-forget-all-cached) + (dolist (passwd '("foo" "" nil)) + (unwind-protect + ;; Redefine `read-*' in order to avoid interactive input. + (cl-letf (((symbol-function 'read-passwd) (lambda (_) passwd)) + ((symbol-function 'read-string) + (lambda (_prompt &optional _initial _history default + _inherit-input-method) + default))) + (setq host + (md5 (concat (prin1-to-string process-environment) passwd)) + auth-info + (car (auth-source-search + :max 1 :host host :require '(:user :secret) :create t)) + auth-passwd (auth-info-password auth-info)) + (should (string-equal (plist-get auth-info :user) (user-login-name))) + (should (string-equal (plist-get auth-info :host) host)) + (should (equal auth-passwd passwd)) + (should-not (plist-get auth-info :save-function)) + + ;; Check, that the item hasn't been created persistently. + (auth-source-forget+ :host t) + (should-not (auth-source-search :host host))) + + ;; Cleanup. + t)))) + (ert-deftest auth-source-delete () (ert-with-temp-file netrc-file :suffix "auth-source-test" :text "\ commit 5c459c6084cd91b8b83bae94dd6709a815797c81 Author: Sean Whitton Date: Sun Oct 5 15:29:31 2025 +0100 ; Tweak wording of a NEWS entry. diff --git a/etc/NEWS b/etc/NEWS index 09497e499ab..0c0ee8aa4eb 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2403,10 +2403,10 @@ In addition, a new command 'U' removes all marks. +++ *** New command 'w' in Log View mode. -The new command 'log-view-copy-revision-as-kill', by default bound to -'w' in Log View mode, copies to the kill ring the ID of the revision at -point in the log entry. If there are marked revisions, it copies the -IDs of those, instead. +The new command 'log-view-copy-revision-as-kill', bound to 'w' in Log +View mode, copies to the kill ring the ID of the revision at point in +the log entry. If there are marked revisions, it copies the IDs of +those, instead. ** Diff mode commit d3c4679acd68fc2ecb9d42b8417a8399346b0259 Author: Sean Whitton Date: Tue Sep 9 15:01:47 2025 +0100 VC: Use symbolic names for the working revision * lisp/vc/vc-hg.el (vc-hg-diff): When OLDVERS is ".", behave the same as if OLDVERS was the actual working revision. (vc-hg-previous-revision): Return ".~1" for input ".", ".~3" for input ".^^" et cetera. Also, when passed non-symbolic revisions, use "REV~1" instead of "REV^" for MS-Windows compatibility. (vc-hg-working-revision-symbol): * lisp/vc/vc-git.el (vc-git-working-revision-symbol): * lisp/vc/vc-hooks.el (vc-symbolic-working-revision): New functions. (vc-default-mode-line-string): * lisp/vc/ediff-vers.el (ediff-vc-merge-internal): * test/lisp/vc/vc-tests/vc-tests.el (vc-test--checkin-patch): * lisp/vc/vc.el (vc-diff-build-argument-list-internal) (vc-diff-outgoing, vc-revision-other-window, vc-default-revert): Call vc-symbolic-working-revision. (vc-buffer-revision): Specify that this should always be a revision number/hash, not a symbolic name. * lisp/vc/vc-git.el (vc-git-previous-revision): Return "HEAD~1" for input "HEAD", "HEAD~3" for input "HEAD^^" et cetera. diff --git a/lisp/vc/ediff-vers.el b/lisp/vc/ediff-vers.el index 60ea5ae1cd8..f50c28be586 100644 --- a/lisp/vc/ediff-vers.el +++ b/lisp/vc/ediff-vers.el @@ -152,9 +152,9 @@ With prefix argument, prompts for a revision name." (setq buf2 (current-buffer))) (if ancestor-rev (save-excursion - (if (string= ancestor-rev "") - (setq ancestor-rev (vc-working-revision - buffer-file-name))) + (if (string-empty-p ancestor-rev) + (setq ancestor-rev + (vc-symbolic-working-revision buffer-file-name))) (vc-revision-other-window ancestor-rev) (setq ancestor-buf (current-buffer))))) (if ancestor-rev diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el index 54475542ac4..0c06bc298d0 100644 --- a/lisp/vc/vc-git.el +++ b/lisp/vc/vc-git.el @@ -1140,6 +1140,8 @@ It is based on `log-edit-mode', and has Git-specific extensions." (defalias 'vc-git-async-checkins #'always) +(defalias 'vc-git-working-revision-symbol (cl-constantly "HEAD")) + (defun vc-git--checkin (comment &optional files patch-string) "Workhorse routine for `vc-git-checkin' and `vc-git-checkin-patch'. COMMENT is the commit message; must be non-nil. @@ -2073,26 +2075,31 @@ This requires git 1.8.4 or later, for the \"-L\" option of \"git log\"." (defun vc-git-previous-revision (file rev) "Git-specific version of `vc-previous-revision'." - (if file - (let* ((fname (file-relative-name file)) - (prev-rev (with-temp-buffer - (and - (vc-git--out-ok "rev-list" - (vc-git--maybe-abbrev) - "-2" rev "--" fname) - (goto-char (point-max)) - (bolp) - (zerop (forward-line -1)) - (not (bobp)) - (buffer-substring-no-properties - (point) - (1- (point-max))))))) - (or (vc-git-symbolic-commit prev-rev) prev-rev)) - ;; We used to use "^" here, but that fails on MS-Windows if git is - ;; invoked via a batch file, in which case cmd.exe strips the "^" - ;; because it is a special character for cmd which process-file - ;; does not (and cannot) quote. - (vc-git--rev-parse (concat rev "~1")))) + (cond ((string-match "\\`HEAD\\(\\^*\\)\\'" rev) + (format "HEAD~%d" (1+ (length (match-string 1 rev))))) + ((string-match "\\`HEAD~\\([0-9]+\\)\\'" rev) + (format "HEAD~%d" (1+ (string-to-number (match-string 1 rev))))) + (file + (let* ((fname (file-relative-name file)) + (prev-rev (with-temp-buffer + (and + (vc-git--out-ok "rev-list" + (vc-git--maybe-abbrev) + "-2" rev "--" fname) + (goto-char (point-max)) + (bolp) + (zerop (forward-line -1)) + (not (bobp)) + (buffer-substring-no-properties + (point) + (1- (point-max))))))) + (or (vc-git-symbolic-commit prev-rev) prev-rev))) + (t + ;; We used to use "^" here, but that fails on MS-Windows if git + ;; is invoked via a batch file, in which case cmd.exe strips + ;; the "^" because it is a special character for cmd which + ;; process-file does not (and cannot) quote. + (vc-git--rev-parse (concat rev "~1"))))) (defun vc-git--rev-parse (rev) (with-temp-buffer diff --git a/lisp/vc/vc-hg.el b/lisp/vc/vc-hg.el index 0d1f1703081..fe977df6aae 100644 --- a/lisp/vc/vc-hg.el +++ b/lisp/vc/vc-hg.el @@ -557,7 +557,7 @@ This requires hg 4.4 or later, for the \"-L\" option of \"hg log\"." "Get a difference report using hg between two revisions of FILES." (let* ((firstfile (car files)) (working (and firstfile (vc-working-revision firstfile 'Hg)))) - (when (and (not newvers) (equal oldvers working)) + (when (and (not newvers) (member oldvers (list working "."))) (setq oldvers nil)) (when (and newvers (not oldvers)) (setq oldvers working)) @@ -1137,13 +1137,22 @@ hg binary." ;;; Miscellaneous (defun vc-hg-previous-revision (_file rev) - ;; We can't simply decrement by 1, because that revision might be - ;; e.g. on a different branch (bug#22032). - (with-temp-buffer - (and (eq 0 - (vc-hg-command t nil nil "id" "-n" "-r" (concat rev "^"))) - ;; Trim the trailing newline. - (buffer-substring (point-min) (1- (point-max)))))) + ;; Prefer to return values with tildes not carets because that's more + ;; compatible with MS-Windows (see `vc-git-previous-revision'). + ;; + ;; See for reference. + (cond ((string-match "\\`\\.\\(\\^*\\)\\'" rev) + (format ".~%d" (1+ (length (match-string 1 rev))))) + ((string-match "\\`\\.~\\([0-9]+\\)\\'" rev) + (format ".~%d" (1+ (string-to-number (match-string 1 rev))))) + (t + ;; We can't simply decrement by 1, because that revision might + ;; be e.g. on a different branch (bug#22032). + (with-temp-buffer + (and (zerop (vc-hg-command t nil nil "id" "-n" + "-r" (concat rev "~1"))) + ;; Trim the trailing newline. + (buffer-substring (point-min) (1- (point-max)))))))) (defun vc-hg-next-revision (_file rev) (let ((newrev (1+ (string-to-number rev))) @@ -1213,6 +1222,8 @@ It is based on `log-edit-mode', and has Hg-specific extensions.") (defalias 'vc-hg-async-checkins #'always) +(defalias 'vc-hg-working-revision-symbol (cl-constantly ".")) + (defun vc-hg--checkin (comment &optional files patch-string) "Workhorse routine for `vc-hg-checkin' and `vc-hg-checkin-patch'. COMMENT is the commit message; nil if it should come from PATCH-STRING. diff --git a/lisp/vc/vc-hooks.el b/lisp/vc/vc-hooks.el index 48e84d6aee1..ab4b10a10a1 100644 --- a/lisp/vc/vc-hooks.el +++ b/lisp/vc/vc-hooks.el @@ -545,14 +545,42 @@ status of this file. Otherwise, the value returned is one of: (defun vc-working-revision (file &optional backend) "Return the repository version from which FILE was checked out. -If FILE is not registered, this function always returns nil." +If FILE is not registered, this function always returns nil. + +This function does not return nil without first confirming with the +underlying VCS that FILE is unregistered; this is in contrast to +`vc-symbolic-working-revision'." (or (vc-file-getprop file 'vc-working-revision) (let ((default-directory (file-name-directory file))) - (setq backend (or backend (vc-backend file))) - (when backend - (vc-file-setprop file 'vc-working-revision - (vc-call-backend - backend 'working-revision file)))))) + (and (setq backend (or backend (vc-backend file))) + (vc-file-setprop file 'vc-working-revision + (vc-call-backend backend 'working-revision + file)))))) + +(defun vc-symbolic-working-revision (file &optional backend) + "Return BACKEND's symbolic name for FILE's working revision. +If FILE is not registered according to cached information, return nil. +If BACKEND does not have a symbolic name for the working revision or +Emacs doesn't know what it is, call `vc-working-revision' instead. + +Prefer this function to `vc-working-revision' whenever a symbolic name +will do, for it avoids a call out to the underlying VCS." + ;; Returning nil if the file is unregistered (which is why we call + ;; `vc-backend' even if BACKEND is non-nil here) makes us closer to a + ;; drop-in replacement for `vc-working-revision'. Don't actually + ;; query the VCS because the point of this function is to avoid such + ;; queries. Code that purely wants to map BACKEND to a symbolic name + ;; can call the backend API function directly. + ;; (If we don't check whether FILE is registered, then whether this + ;; function is sensitive to FILE being registered depends on whether + ;; BACKEND implements `working-revision-symbol' (because we would be + ;; sensitive to whether FILE is registered if and only if we defer to + ;; `vc-working-revision'), which would be a strange interdependence.) + (and-let* ((cached-backend (vc-backend file))) + (let* ((backend (or backend cached-backend)) + (fn (vc-find-backend-function backend + 'working-revision-symbol))) + (if fn (funcall fn) (vc-working-revision file backend))))) (defvar vc-use-short-revision nil "If non-nil, VC backend functions should return short revisions if possible. @@ -825,12 +853,13 @@ Format: This function assumes that the file is registered." (pcase-let* ((backend-name (symbol-name backend)) (state (vc-state file backend)) - (rev (vc-working-revision file backend)) + (rev (vc-symbolic-working-revision file backend)) (`(,state-echo ,face ,indicator) (vc-mode-line-state state)) - (state-string (concat (unless (eq vc-display-status 'no-backend) - backend-name) - indicator rev))) + (state-string + (concat (and (not (eq vc-display-status 'no-backend)) + backend-name) + indicator rev))) (propertize state-string 'face face 'help-echo (concat state-echo " under the " backend-name " version control system")))) diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el index 7c28e4092dd..6c56b3b0ecd 100644 --- a/lisp/vc/vc.el +++ b/lisp/vc/vc.el @@ -124,6 +124,16 @@ ;; ;; Takes no arguments. Backends that return non-nil can (and do) ;; perform async checkins when `vc-async-checkin' is non-nil. +;; +;; - working-revision-symbol +;; +;; Symbolic name for the/a working revision, a constant string. If +;; defined, backend API functions that take revision numbers, revision +;; hashes or branch names can also take this string in place of those. +;; Emacs passes this name without first having to look up the working +;; revision, which is a small performance improvement. +;; In addition, using a name instead of a number or hash makes it +;; easier to edit backend commands with `vc-edit-next-command'. ;; STATE-QUERYING FUNCTIONS ;; @@ -597,8 +607,14 @@ ;; ;; - previous-revision (file rev) ;; -;; Return the revision number that precedes REV for FILE, or nil if no such -;; revision exists. +;; Return the revision number/hash that precedes REV for FILE, or nil +;; if no such revision exists. If the working-revision-symbol +;; function is defined for this backend and that symbol, or a symbolic +;; name involving that symbol, is passed to this function as REV, this +;; function may return a symbolic name. +;; +;; Possible future extension: make REV an optional argument, and if +;; nil, default it to FILE's working revision. ;; ;; - file-name-changes (rev) ;; @@ -1313,7 +1329,8 @@ STATE-MODEL-ONLY-FILES argument to `vc-deduce-fileset' is nil.") "VCS revision to which this buffer's contents corresponds. Lisp code which sets this should also set `vc-buffer-overriding-fileset' such that the buffer's local variables also specify a VC backend, -rendering the value of this variable unambiguous.") +rendering the value of this variable unambiguous. +Should never be a symbolic name but always a revision number/hash.") (defun vc-deduce-backend () (cond ((car vc-buffer-overriding-fileset)) @@ -2584,7 +2601,7 @@ INITIAL-INPUT are passed on to `vc-read-revision' directly." (t (push (ignore-errors ;If `previous-revision' doesn't work. (vc-call-backend backend 'previous-revision first - (vc-working-revision first backend))) + (vc-symbolic-working-revision first backend))) rev1-default) (when (member (car rev1-default) '("" nil)) (setq rev1-default nil)))) ;; construct argument list @@ -2806,10 +2823,8 @@ global binding." ;; 'revision-granularity) ;; 'repository) ;; (ignore-errors - ;; (vc-call-backend backend 'working-revision - ;; (caadr fileset))) - (vc-call-backend backend 'working-revision - (caadr fileset)) + ;; (vc-symbolic-working-revision (caadr fileset))) + (vc-symbolic-working-revision (caadr fileset)) (called-interactively-p 'interactive)))) ;; For the following two commands, the default meaning for @@ -2980,8 +2995,8 @@ If `F.~REV~' already exists, use it instead of checking it out again." (set-buffer (or (buffer-base-buffer) (current-buffer))) (vc-ensure-vc-buffer) (let* ((file buffer-file-name) - (revision (if (string-equal rev "") - (vc-working-revision file) + (revision (if (string-empty-p rev) + (vc-symbolic-working-revision file) rev))) (switch-to-buffer-other-window (vc-find-revision file revision)))) @@ -4522,7 +4537,7 @@ to provide the `find-revision' operation instead." (defun vc-default-revert (backend file contents-done) (unless contents-done - (let ((rev (vc-working-revision file)) + (let ((rev (vc-symbolic-working-revision file)) (file-buffer (or (get-file-buffer file) (current-buffer)))) (message "Checking out %s..." file) (let ((failed t) diff --git a/test/lisp/vc/vc-tests/vc-tests.el b/test/lisp/vc/vc-tests/vc-tests.el index f61de1ac5d1..b4192555efd 100644 --- a/test/lisp/vc/vc-tests/vc-tests.el +++ b/test/lisp/vc/vc-tests/vc-tests.el @@ -815,7 +815,7 @@ This checks also `vc-backend' and `vc-responsible-backend'." (cl-flet ((get-patch-string () "Get patch corresponding to most recent commit to FILE." - (let* ((rev (vc-call-backend backend 'working-revision file)) + (let* ((rev (vc-symbolic-working-revision file backend)) (patch (vc-call-backend backend 'prepare-patch rev))) (with-current-buffer (plist-get patch :buffer) (buffer-substring-no-properties (point-min)