daniel/emacs-conf
1
2
Fork 0
Code Issues 7 Pull Requests Projects Releases Wiki Activity

update packages

Browse Source
This commit is contained in:
Daniel Weschke
2026-06-27 11:34:21 +02:00
parent 4be4f859c4
commit 1aaef48596
246 changed files with 7997 additions and 4359 deletions
Download Patch File Download Diff File Expand all files Collapse all files

242
lisp/transient/transient.el
View File

@@ -6,12 +6,13 @@
;; Homepage: https://github.com/magit/transient
;; Keywords: extensions
;; Package-Version: 20260401.2145
;; Package-Revision: 8b1420310795
;; Package-Version: 20260617.1137
;; Package-Revision: 9d103f338fb9
;; Package-Requires: (
;; (emacs "28.1")
;; (compat "30.1")
;; (cond-let "0.2")
;; (compat "31.0")
;; (cond-let "1.1")
;; (llama "1.0")
;; (seq "2.24"))
;; SPDX-License-Identifier: GPL-3.0-or-later
@@ -45,7 +46,7 @@
;;; Code:
(defconst transient-version "0.12.0")
(defconst transient-version "0.13.4")
(require 'cl-lib)
(require 'compat)
@@ -53,6 +54,7 @@
(require 'eieio)
(require 'edmacro)
(require 'format-spec)
(require 'llama)
(require 'pcase)
(require 'pp)
@@ -101,19 +103,6 @@ similar defect.") :emergency))
(defvar Man-notify-method)
(defvar pp-default-function) ; since Emacs 29.1
(static-if (< emacs-major-version 30)
(progn
(defun internal--build-binding@backport-e680827e814 (fn binding prev-var)
"Backport not warning about `_' not being left unused.
Backport fix for https://debbugs.gnu.org/cgi/bugreport.cgi?bug=69108,
from Emacs commit e680827e814e155cf79175d87ff7c6ee3a08b69a."
(let ((binding (funcall fn binding prev-var)))
(if (eq (car binding) '_)
(cons (make-symbol "s") (cdr binding))
binding)))
(advice-add 'internal--build-binding :around
#'internal--build-binding@backport-e680827e814)))
(define-obsolete-variable-alias
'transient-show-popup
'transient-show-menu
@@ -136,9 +125,12 @@ from Emacs commit e680827e814e155cf79175d87ff7c6ee3a08b69a."
,(macroexp-progn body))
((debug error)
(transient--emergency-exit ,id)
(static-if (fboundp 'error-type-p) ; since Emacs 31.1
(signal err)
(signal (car err) (cdr err))))))
(static-if (version< emacs-version "31.0.50")
(signal (car err) (cdr err))
(condition-case nil
(signal err)
(wrong-number-of-arguments
(signal (car err) (cdr err))))))))
(defun transient--exit-and-debug (&rest args)
(transient--emergency-exit :debugger)
@@ -871,7 +863,8 @@ See also option `transient-highlight-mismatched-keys'."
(defun transient--pp-to-file (value file)
(when (or value (file-exists-p file))
(make-directory (file-name-directory file) t)
(setq value (cl-sort (copy-sequence value) #'string< :key #'car))
(setq value (compat-call sort (copy-sequence value)
:lessp #'string< :key #'car))
(with-temp-file file
(let ((print-level nil)
(print-length nil)
@@ -906,11 +899,12 @@ should not change it manually.")
(defun transient-save-history ()
(setq transient-history
(cl-sort (mapcar (pcase-lambda (`(,key . ,val))
(cons key (seq-take (delete-dups val)
transient-history-limit)))
transient-history)
#'string< :key #'car))
(compat-call sort
(mapcar (pcase-lambda (`(,key . ,val))
(cons key (take transient-history-limit
(delete-dups val))))
transient-history)
:lessp #'string< :key #'car))
(transient--pp-to-file transient-history transient-history-file))
(defun transient-maybe-save-history ()
@@ -1250,7 +1244,7 @@ to the setup function:
(,(or class 'transient-prefix) :command ',name ,@slots))
(transient--set-layout
',name
(list ,@(mapcan (lambda (s) (transient--parse-child name s)) groups))))))
(list ,@(mapcan (##transient--parse-child name %) groups))))))
(put 'transient-define-prefix 'autoload-macro 'expand)
(defmacro transient-define-group (name &rest groups)
@@ -1264,7 +1258,7 @@ form as for `transient-define-prefix'."
(indent defun))
`(transient--set-layout
',name
(list ,@(mapcan (lambda (s) (transient--parse-child name s)) groups))))
(list ,@(mapcan (##transient--parse-child name %) groups))))
(defmacro transient-define-suffix (name arglist &rest args)
"Define NAME as a transient suffix command.
@@ -1503,7 +1497,7 @@ commands are aliases for."
('transient-column)))
(and args (cons 'list args))
(cons 'list
(mapcan (lambda (s) (transient--parse-child prefix s)) spec)))))
(mapcan (##transient--parse-child prefix %) spec)))))
(defun transient--parse-suffix (prefix spec)
(let (class args)
@@ -1540,8 +1534,8 @@ commands are aliases for."
(sym (intern
(format
"transient:%s:%s:%d" prefix
(replace-regexp-in-string (plist-get args :key) " " "")
(prog1 gensym-counter (cl-incf gensym-counter))))))
(string-replace (plist-get args :key) " " "")
(prog1 gensym-counter (incf gensym-counter))))))
(use :command
`(prog1 ',sym
(put ',sym 'interactive-only t)
@@ -1666,7 +1660,12 @@ symbol property.")
(transient--set-layout
prefix
(named-let upgrade ((spec layout))
(cond ((vectorp spec)
(cond ((and (vectorp spec)
(length= spec 3))
;; This format is used by emoji.el from Emacs <= 29.4.
(pcase-let ((`[,class ,args ,children] spec))
(vector class args (mapcar #'upgrade children))))
((vectorp spec)
(pcase-let ((`[,level ,class ,args ,children] spec))
(when level
(setq args (plist-put args :level level)))
@@ -1812,9 +1811,9 @@ layout of PREFIX."
(let* ((siblings (aref parent 2))
(pos (cl-position group siblings)))
(aset parent 2
(nconc (seq-take siblings pos)
(nconc (take pos siblings)
(transient--get-children group)
(seq-drop siblings (1+ pos))))))))
(drop (1+ pos) siblings)))))))
;;;###autoload
(defun transient-remove-suffix (prefix loc)
@@ -2171,7 +2170,7 @@ probably use this instead:
(defun transient--suffix-prototype (command)
(or (get command 'transient--suffix)
(seq-some (lambda (cmd) (get cmd 'transient--suffix))
(seq-some (##get % 'transient--suffix)
(function-alias-p command))))
;;; Keymaps
@@ -2508,14 +2507,12 @@ of the corresponding object."
(pcase this-command
('transient-update
(setq transient--showp t)
(let ((keys (listify-key-sequence (this-single-command-raw-keys))))
(setq unread-command-events (mapcar (lambda (key) (cons t key)) keys))
(let ((keys (listify-key-sequence (this-single-command-keys))))
(setq unread-command-events (mapcar (##cons t %) keys))
keys))
('transient-quit-seq
(setq unread-command-events
(butlast (listify-key-sequence
(this-single-command-raw-keys))
2))
(butlast (listify-key-sequence (this-single-command-keys)) 2))
(butlast transient--redisplay-key))
(_ nil)))
(let ((topmap (make-sparse-keymap))
@@ -2642,7 +2639,7 @@ value. Otherwise return CHILDREN as is.")
(defun transient--init-suffixes (name)
(let ((levels (alist-get name transient-levels)))
(mapcan (lambda (c) (transient--init-child levels c nil))
(mapcan (##transient--init-child levels % nil)
(append (transient--get-children name)
(and (not transient--editp)
(transient--get-children
@@ -2661,7 +2658,7 @@ value. Otherwise return CHILDREN as is.")
(defun transient--init-child (levels spec parent)
(cl-etypecase spec
(symbol (mapcan (lambda (c) (transient--init-child levels c parent))
(symbol (mapcan (##transient--init-child levels % parent)
(transient--get-children spec)))
(vector (transient--init-group levels spec parent))
(list (transient--init-suffix levels spec parent))
@@ -2677,7 +2674,7 @@ value. Otherwise return CHILDREN as is.")
(_(prog1 t
(when (transient--inapt-suffix-p obj)
(oset obj inapt t))))
(suffixes (mapcan (lambda (c) (transient--init-child levels c obj))
(suffixes (mapcan (##transient--init-child levels % obj)
(transient-setup-children obj children))))
(progn
(oset obj suffixes suffixes)
@@ -3638,8 +3635,7 @@ transient is active."
(cond
(interactivep
(setq transient--helpp t))
((lookup-key transient--transient-map
(this-single-command-raw-keys))
((lookup-key transient--transient-map (this-single-command-keys))
(setq transient--helpp nil)
(with-demoted-errors "transient-help: %S"
(transient--display-help #'transient-show-help
@@ -3680,7 +3676,7 @@ For example:
(and transient--editp
(setq command prefix)))
(list command
(let ((keys (this-single-command-raw-keys)))
(let ((keys (this-single-command-keys)))
(and (lookup-key transient--transient-map keys)
(progn
(transient--show)
@@ -3701,8 +3697,7 @@ For example:
(setq akey t))
(t
(oset (transient-suffix-object command) level level)
(when (cdr (cl-remove-if-not (lambda (obj)
(eq (oref obj command) command))
(when (cdr (cl-remove-if-not (##eq (oref % command) command)
transient--suffixes))
(setq akey (cons command (this-command-keys))))))
(setf (alist-get akey alist) level)
@@ -3833,7 +3828,7 @@ such as when suggesting a new feature or reporting an issue."
:description "Echo arguments"
:key "x"
(interactive (list (transient-args transient-current-command)))
(if (seq-every-p #'stringp arguments)
(if (all #'stringp arguments)
(message "%s: %s" (key-description (this-command-keys))
(mapconcat (lambda (arg)
(propertize (if (string-match-p " " arg)
@@ -3910,8 +3905,8 @@ Call `transient-default-value' but because that is a noop for
(string-match regexp v)
(match-string 1 v)))))
(if multi-value
(delq nil (mapcar match value))
(cl-some match value)))))))
(seq-filter match value)
(seq-some match value)))))))
(cl-defmethod transient-init-value ((obj transient-switch))
"Extract OBJ's value from the value of the prefix object."
@@ -4112,19 +4107,19 @@ stand-alone command."
(when (fboundp 'org-read-date)
(org-read-date 'with-time nil nil prompt default-time)))
(static-if (fboundp 'string-edit) ; since Emacs 29.1
(defun transient-read-string-from-buffer (prompt value _)
"Switch to a new buffer to edit STRING in a recursive edit.
(static-when (fboundp 'string-edit) ; since Emacs 29.1
(defun transient-read-string-from-buffer (prompt value _)
"Switch to a new buffer to edit STRING in a recursive edit.
Like `read-string-from-buffer' but accept an additional argument as
provided by `transient-infix-read' (but ignore it). Only available
when using Emacs 29.1 or greater."
(string-edit prompt (or value "")
(lambda (edited)
(setq value edited)
(exit-recursive-edit))
:abort-callback #'exit-recursive-edit)
(recursive-edit)
value))
(string-edit prompt (or value "")
(lambda (edited)
(setq value edited)
(exit-recursive-edit))
:abort-callback #'exit-recursive-edit)
(recursive-edit)
value))
;;;; Prompt
@@ -4419,7 +4414,7 @@ does nothing." nil)
(pcase-exhaustive (oref obj multi-value)
('nil (concat arg value))
((or 't 'rest) (cons arg value))
('repeat (mapcar (lambda (v) (concat arg v)) value))))))
('repeat (mapcar (##concat arg %) value))))))
(cl-defmethod transient-infix-value ((_ transient-variable))
"Return nil, which means \"no value\".
@@ -4446,9 +4441,8 @@ Append \"=\ to ARG to indicate that it is an option."
[match (let ((case-fold-search nil)
(re (format "\\`%s\\(?:=\\(.+\\)\\)?\\'"
(substring arg 0 -1))))
(cl-find-if (lambda (a)
(and (stringp a)
(string-match re a)))
(cl-find-if (##and (stringp %)
(string-match re %))
args))]
(match-string 1 match)))))
@@ -4458,9 +4452,10 @@ Append \"=\ to ARG to indicate that it is an option."
(when-let* ((_ transient--stack)
(command (oref obj command))
(suffix-obj (transient-suffix-object command))
(_(memq (if (slot-boundp suffix-obj 'transient)
(oref suffix-obj transient)
(oref transient-current-prefix transient-suffix))
(_(memq (cond ((slot-boundp suffix-obj 'transient)
(oref suffix-obj transient))
(transient-current-prefix
(oref transient-current-prefix transient-suffix)))
(list t 'recurse #'transient--do-recurse))))
(oset obj return t)))
@@ -4691,27 +4686,25 @@ have a history of their own.")
"%s- [%s] %s"
(key-description (this-command-keys))
(oref transient--prefix command)
(mapconcat
#'identity
(sort
(mapcan
(lambda (suffix)
(let ((key (kbd (oref suffix key))))
;; Don't list any common commands.
(and (not (memq (oref suffix command)
`(,(lookup-key transient-map key)
,(lookup-key transient-sticky-map key)
;; From transient-common-commands:
transient-set
transient-save
transient-history-prev
transient-history-next
transient-quit-one
transient-toggle-common
transient-set-level)))
(list (propertize (oref suffix key) 'face 'transient-key)))))
transient--suffixes)
#'string<)
(string-join
(sort (seq-keep
(lambda (suffix)
(let ((key (kbd (oref suffix key))))
;; Don't list any common commands.
(and (not (memq (oref suffix command)
`(,(lookup-key transient-map key)
,(lookup-key transient-sticky-map key)
;; From transient-common-commands:
transient-set
transient-save
transient-history-prev
transient-history-next
transient-quit-one
transient-toggle-common
transient-set-level)))
(propertize (oref suffix key) 'face 'transient-key))))
transient--suffixes)
#'string<)
(propertize "|" 'face 'transient-delimiter)))))
(defun transient--insert-menu (setup)
@@ -4938,14 +4931,14 @@ as a button."
(let ((len (length transient--redisplay-key))
(seq (cl-coerce (edmacro-parse-keys key t) 'list)))
(cond
((member (seq-take seq len)
((member (take len seq)
(list transient--redisplay-key
(thread-last transient--redisplay-key
(cl-substitute ?- 'kp-subtract)
(cl-substitute ?= 'kp-equal)
(cl-substitute ?+ 'kp-add))))
(let ((pre (key-description (vconcat (seq-take seq len))))
(suf (key-description (vconcat (seq-drop seq len)))))
(let ((pre (key-description (vconcat (take len seq))))
(suf (key-description (vconcat (drop len seq)))))
(setq pre (string-replace "RET" "C-m" pre))
(setq pre (string-replace "TAB" "C-i" pre))
(setq suf (string-replace "RET" "C-m" suf))
@@ -5181,8 +5174,8 @@ apply the face `transient-unreachable' to the complete string."
(defun transient--key-unreachable-p (obj)
(and transient--redisplay-key
(let ((key (oref obj key)))
(not (or (equal (seq-take (cl-coerce (edmacro-parse-keys key t) 'list)
(length transient--redisplay-key))
(not (or (equal (take (length transient--redisplay-key)
(cl-coerce (edmacro-parse-keys key t) 'list))
transient--redisplay-key)
(transient--lookup-key transient-sticky-map (kbd key)))))))
@@ -5202,26 +5195,32 @@ apply the face `transient-unreachable' to the complete string."
(length (oref suffix key))))
(oref group suffixes))))))
(defun transient--pixel-width (string)
(save-window-excursion
(static-if (fboundp 'string-pixel-width) ; since Emacs 29.1
(progn ; See https://github.com/magit/magit/issues/5557.
(defalias 'transient--string-pixel-width #'string-pixel-width))
;; c22b735f0c6 and 61c254cafc9 cannot be backported. Some later
;; commits could be ported, but users should instead update Emacs.
(defun transient--string-pixel-width (string)
(with-temp-buffer
(insert string)
(set-window-dedicated-p nil nil)
(set-window-buffer nil (current-buffer))
(car (window-text-pixel-size
nil (line-beginning-position) (point))))))
(save-window-excursion
(set-window-dedicated-p nil nil)
(set-window-buffer nil (current-buffer))
(car (window-text-pixel-size
nil (line-beginning-position) (point)))))))
(defun transient--column-stops (columns)
(let* ((var-pitch (or transient-align-variable-pitch
(oref transient--prefix variable-pitch)))
(char-width (and var-pitch (transient--pixel-width " "))))
(char-width (and var-pitch (transient--string-pixel-width " "))))
(transient--seq-reductions-from
(apply-partially #'+ (* 2 (if var-pitch char-width 1)))
(transient--mapn
(lambda (cells min)
(apply #'max
(if min (if var-pitch (* min char-width) min) 0)
(mapcar (if var-pitch #'transient--pixel-width #'length) cells)))
(mapcar (if var-pitch #'transient--string-pixel-width #'length)
cells)))
columns
(oref transient--prefix column-widths))
0)))
@@ -5632,14 +5631,16 @@ search instead."
lisp-imenu-generic-expression :test #'equal)
(defun transient--suspend-text-conversion-style ()
(static-if (boundp 'overriding-text-conversion-style) ; since Emacs 30.1
(when text-conversion-style
(letrec ((suspended overriding-text-conversion-style)
(fn (lambda ()
(setq overriding-text-conversion-style nil)
(remove-hook 'transient-exit-hook fn))))
(setq overriding-text-conversion-style suspended)
(add-hook 'transient-exit-hook fn)))))
(when (and (bound-and-true-p text-conversion-style)
(bound-and-true-p overriding-text-conversion-style)
;; Somehow the above does not silence the compiler.
(boundp 'overriding-text-conversion-style))
(letrec ((suspended overriding-text-conversion-style)
(fn (lambda ()
(setq overriding-text-conversion-style nil)
(remove-hook 'transient-exit-hook fn))))
(setq overriding-text-conversion-style suspended)
(add-hook 'transient-exit-hook fn))))
(declare-function which-key-mode "ext:which-key" (&optional arg))
@@ -5700,7 +5701,7 @@ Like `cl-mapcar' but while that stops when the shortest list
is exhausted, continue until the longest list is, using nil
as stand-in for elements of exhausted lists."
(let (result)
(while (catch 'more (mapc (lambda (l) (and l (throw 'more t))) lists) nil)
(while (catch 'more (mapc (##and % (throw 'more t)) lists) nil)
(push (apply function (mapcar #'car-safe lists)) result)
(setq lists (mapcar #'cdr lists)))
(nreverse result)))
@@ -5792,11 +5793,16 @@ as stand-in for elements of exhausted lists."
;; (cond . 0)
;; (interactive . 0))
;; read-symbol-shorthands: (
;; ("and$" . "cond-let--and$")
;; ("and-let" . "cond-let--and-let")
;; ("if-let" . "cond-let--if-let")
;; ("when$" . "cond-let--when$")
;; ("when-let" . "cond-let--when-let")
;; ("while-let" . "cond-let--while-let"))
;; ("and$" . "cond-let--and$")
;; ("thread$" . "cond-let--thread$")
;; ("when$" . "cond-let--when$")
;; ("and-let*" . "cond-let--and-let*")
;; ("and-let" . "cond-let--and-let")
;; ("if-let*" . "cond-let--if-let*")
;; ("if-let" . "cond-let--if-let")
;; ("when-let*" . "cond-let--when-let*")
;; ("when-let" . "cond-let--when-let")
;; ("while-let*" . "cond-let--while-let*")
;; ("while-let" . "cond-let--while-let"))
;; End:
;;; transient.el ends here