[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
master ab67009: Merge from origin/emacs-28
|
From: |
Michael Albinus |
|
Subject: |
master ab67009: Merge from origin/emacs-28 |
|
Date: |
Sat, 6 Nov 2021 12:31:14 -0400 (EDT) |
branch: master
commit ab6700949eccb235938616b5ed58ead5eb6cf74d
Merge: 75a264e 5e9b4e7
Author: Michael Albinus <michael.albinus@gmx.de>
Commit: Michael Albinus <michael.albinus@gmx.de>
Merge from origin/emacs-28
5e9b4e70ab Fix dbus-test04-register-method on CentOS (Bug#51369)
d96de23510 * lisp/transient.el: Update to package version v0.3.7-11-g...
7343b0d0e4 ; * etc/NEWS: Native compilation is more picky about missi...
0d6b2b0b9d ; * etc/PROBLEMS: Move entry about LLVM plugin to the righ...
# Conflicts:
# etc/NEWS
---
etc/NEWS.28 | 6 ++
etc/PROBLEMS | 28 +++---
lisp/transient.el | 235 +++++++++++++++++++++++++-------------------
test/lisp/net/dbus-tests.el | 22 ++---
4 files changed, 166 insertions(+), 125 deletions(-)
diff --git a/etc/NEWS.28 b/etc/NEWS.28
index cc4cdfe..9ed340a 100644
--- a/etc/NEWS.28
+++ b/etc/NEWS.28
@@ -36,6 +36,12 @@ to configure with the '--without-compress-install' option,
so that the
installed *.el files are not compressed; otherwise, you will not be
able to use JIT native compilation of the installed *.el files.
+Note that JIT native compilation is done in a fresh session of Emacs
+that is run in a subprocess, so it can legitimately report some
+warnings and errors that aren't uncovered by byte-compilation. We
+recommend examining any such warnings before you decide they are
+false.
+
** The Cairo graphics library is now used by default if present.
'--with-cairo' is now the default, if the appropriate development files
are found by 'configure'. Note that building with Cairo means using
diff --git a/etc/PROBLEMS b/etc/PROBLEMS
index 95f57e5..b069cce 100644
--- a/etc/PROBLEMS
+++ b/etc/PROBLEMS
@@ -1125,20 +1125,6 @@ you want to use fcitx with Emacs, you have two choices.
Toggle fcitx
by another key (e.g. C-\) by modifying ~/.fcitx/config, or be
accustomed to use C-@ for 'set-mark-command'.
-*** Link-time optimization with clang doesn't work on Fedora 20.
-
-As of May 2014, Fedora 20 has broken LLVMgold.so plugin support in clang
-(tested with clang-3.4-6.fc20) - 'clang --print-file-name=LLVMgold.so'
-prints 'LLVMgold.so' instead of full path to plugin shared library, and
-'clang -flto' is unable to find the plugin with the following error:
-
-/bin/ld: error: /usr/bin/../lib/LLVMgold.so: could not load plugin library:
-/usr/bin/../lib/LLVMgold.so: cannot open shared object file: No such file
-or directory
-
-The only way to avoid this is to build your own clang from source code
-repositories, as described at http://clang.llvm.org/get_started.html.
-
*** M-SPC seems to be ignored as input.
See if your X server is set up to use this as a command
@@ -2785,6 +2771,20 @@ above example).
** Compilation
+*** Link-time optimization with clang doesn't work on Fedora 20.
+
+As of May 2014, Fedora 20 has broken LLVMgold.so plugin support in clang
+(tested with clang-3.4-6.fc20) - 'clang --print-file-name=LLVMgold.so'
+prints 'LLVMgold.so' instead of full path to plugin shared library, and
+'clang -flto' is unable to find the plugin with the following error:
+
+/bin/ld: error: /usr/bin/../lib/LLVMgold.so: could not load plugin library:
+/usr/bin/../lib/LLVMgold.so: cannot open shared object file: No such file
+or directory
+
+The only way to avoid this is to build your own clang from source code
+repositories, as described at http://clang.llvm.org/get_started.html.
+
*** Building Emacs over NFS fails with "Text file busy".
This was reported to happen when building Emacs on a GNU/Linux system
diff --git a/lisp/transient.el b/lisp/transient.el
index d0ba854..f80e6af 100644
--- a/lisp/transient.el
+++ b/lisp/transient.el
@@ -598,12 +598,14 @@ If `transient-save-history' is nil, then do nothing."
(history :initarg :history :initform nil)
(history-pos :initarg :history-pos :initform 0)
(history-key :initarg :history-key :initform nil)
- (man-page :initarg :man-page :initform nil)
+ (show-help :initarg :show-help :initform nil)
(info-manual :initarg :info-manual :initform nil)
+ (man-page :initarg :man-page :initform nil)
(transient-suffix :initarg :transient-suffix :initform nil)
(transient-non-suffix :initarg :transient-non-suffix :initform nil)
(incompatible :initarg :incompatible :initform nil)
- (suffix-description :initarg :suffix-description))
+ (suffix-description :initarg :suffix-description)
+ (variable-pitch :initarg :variable-pitch :initform nil))
"Transient prefix command.
Each transient prefix command consists of a command, which is
@@ -665,6 +667,7 @@ slot is non-nil."
(transient :initarg :transient)
(format :initarg :format :initform " %k %d")
(description :initarg :description :initform nil)
+ (show-help :initarg :show-help :initform nil)
(inapt :initform nil)
(inapt-if
:initarg :inapt-if
@@ -739,8 +742,12 @@ slot is non-nil."
(argument-regexp :initarg :argument-regexp))
"Class used for sets of mutually exclusive command-line switches.")
-(defclass transient-files (transient-infix) ()
- "Class used for the \"--\" argument.
+(defclass transient-files (transient-option) ()
+ ((key :initform "--")
+ (argument :initform "--")
+ (multi-value :initform rest)
+ (reader :initform transient-read-files))
+ "Class used for the \"--\" argument or similar.
All remaining arguments are treated as files.
They become the value of this argument.")
@@ -2460,30 +2467,30 @@ Otherwise call the primary method according to object's
class."
default)
nil)))))
+(cl-defmethod transient-init-value ((obj transient-argument))
+ (oset obj value
+ (let ((value (oref transient--prefix value))
+ (argument (and (slot-boundp obj 'argument)
+ (oref obj argument)))
+ (multi-value (oref obj multi-value))
+ (regexp (if (slot-exists-p obj 'argument-regexp)
+ (oref obj argument-regexp)
+ (format "\\`%s\\(.*\\)" (oref obj argument)))))
+ (if (memq multi-value '(t rest))
+ (cdr (assoc argument value))
+ (let ((match (lambda (v)
+ (and (stringp v)
+ (string-match regexp v)
+ (match-string 1 v)))))
+ (if multi-value
+ (delq nil (mapcar match value))
+ (cl-some match value)))))))
+
(cl-defmethod transient-init-value ((obj transient-switch))
(oset obj value
(car (member (oref obj argument)
(oref transient--prefix value)))))
-(cl-defmethod transient-init-value ((obj transient-option))
- (oset obj value
- (transient--value-match (format "\\`%s\\(.*\\)" (oref obj argument)))))
-
-(cl-defmethod transient-init-value ((obj transient-switches))
- (oset obj value
- (transient--value-match (oref obj argument-regexp))))
-
-(defun transient--value-match (re)
- (when-let ((match (cl-find-if (lambda (v)
- (and (stringp v)
- (string-match re v)))
- (oref transient--prefix value))))
- (match-string 1 match)))
-
-(cl-defmethod transient-init-value ((obj transient-files))
- (oset obj value
- (cdr (assoc "--" (oref transient--prefix value)))))
-
;;;; Read
(cl-defgeneric transient-infix-read (obj)
@@ -2733,7 +2740,7 @@ If the current command was invoked from the transient
prefix
command PREFIX, then return the active infix arguments. If
the current command was not invoked from PREFIX, then return
the set, saved or default value for PREFIX."
- (delq nil (mapcar #'transient-infix-value (transient-suffixes prefix))))
+ (cl-mapcan #'transient--get-wrapped-value (transient-suffixes prefix)))
(defun transient-suffixes (prefix)
"Return the suffix objects of the transient prefix command PREFIX."
@@ -2745,11 +2752,19 @@ the set, saved or default value for PREFIX."
(defun transient-get-value ()
(transient--with-emergency-exit
- (delq nil (mapcar (lambda (obj)
- (and (or (not (slot-exists-p obj 'unsavable))
- (not (oref obj unsavable)))
- (transient-infix-value obj)))
- transient-current-suffixes))))
+ (cl-mapcan (lambda (obj)
+ (and (or (not (slot-exists-p obj 'unsavable))
+ (not (oref obj unsavable)))
+ (transient--get-wrapped-value obj)))
+ transient-current-suffixes)))
+
+(defun transient--get-wrapped-value (obj)
+ (when-let ((value (transient-infix-value obj)))
+ (cl-ecase (and (slot-exists-p obj 'multi-value)
+ (oref obj multi-value))
+ ((nil) (list value))
+ ((t rest) (list value))
+ (repeat value))))
(cl-defgeneric transient-infix-value (obj)
"Return the value of the suffix object OBJ.
@@ -2781,13 +2796,13 @@ does nothing." nil)
(oref obj value))
(cl-defmethod transient-infix-value ((obj transient-option))
- "Return (concat ARGUMENT VALUE) or nil.
-
-ARGUMENT and VALUE are the values of the respective slots of OBJ.
-If VALUE is nil, then return nil. VALUE may be the empty string,
-which is not the same as nil."
+ "Return ARGUMENT and VALUE as a unit or nil if the latter is nil."
(when-let ((value (oref obj value)))
- (concat (oref obj argument) value)))
+ (let ((arg (oref obj argument)))
+ (cl-ecase (oref obj multi-value)
+ ((nil) (concat arg value))
+ ((t rest) (cons arg value))
+ (repeat (mapcar (lambda (v) (concat arg v)) value))))))
(cl-defmethod transient-infix-value ((_ transient-variable))
"Return nil, which means \"no value\".
@@ -2797,15 +2812,6 @@ value of the variable. I.e. this is a side-effect and
does not
contribute to the value of the transient."
nil)
-(cl-defmethod transient-infix-value ((obj transient-files))
- "Return (cons ARGUMENT VALUE) or nil.
-
-ARGUMENT and VALUE are the values of the respective slots of OBJ.
-If VALUE is nil, then return nil. VALUE may be the empty string,
-which is not the same as nil."
- (when-let ((value (oref obj value)))
- (cons (oref obj argument) value)))
-
;;;; Utilities
(defun transient-arg-value (arg args)
@@ -2922,16 +2928,16 @@ have a history of their own.")
'transient-separator)))
(insert (propertize "__" 'face face 'display '(space :height (1))))
(insert (propertize "\n" 'face face 'line-height t))))
- (goto-char (point-min))
(when transient-force-fixed-pitch
- (transient--force-fixed-pitch))
- (when transient-enable-popup-navigation
- (transient--goto-button focus)))
+ (transient--force-fixed-pitch)))
(unless (window-live-p transient--window)
(setq transient--window
(display-buffer buf transient-display-buffer-action)))
(when (window-live-p transient--window)
(with-selected-window transient--window
+ (goto-char (point-min))
+ (when transient-enable-popup-navigation
+ (transient--goto-button focus))
(magit--fit-window-to-buffer transient--window)))))
(defun magit--fit-window-to-buffer (window)
@@ -2989,11 +2995,17 @@ have a history of their own.")
(push desc rows))
rows))
(oref group suffixes)))
+ (vp (oref transient--prefix variable-pitch))
(rs (apply #'max (mapcar #'length columns)))
(cs (length columns))
- (cw (mapcar (lambda (col) (apply #'max (mapcar #'length col)))
+ (cw (mapcar (lambda (col)
+ (apply #'max
+ (mapcar (if vp #'transient--pixel-width #'length)
+ col)))
columns))
- (cc (transient--seq-reductions-from (apply-partially #'+ 3) cw 0)))
+ (cc (transient--seq-reductions-from
+ (apply-partially #'+ (* 3 (if vp (transient--pixel-width " ")
1)))
+ cw 0)))
(if transient-force-single-column
(dotimes (c cs)
(dotimes (r rs)
@@ -3004,11 +3016,28 @@ have a history of their own.")
(insert ?\n)))
(dotimes (r rs)
(dotimes (c cs)
- (insert (make-string (- (nth c cc) (current-column)) ?\s))
- (when-let ((cell (nth r (nth c columns))))
- (insert cell))
- (when (= c (1- cs))
- (insert ?\n)))))))
+ (if vp
+ (progn
+ (when-let ((cell (nth r (nth c columns))))
+ (insert cell))
+ (if (= c (1- cs))
+ (insert ?\n)
+ (insert (propertize " " 'display
+ `(space :align-to (,(nth (1+ c) cc)))))))
+ (insert (make-string (- (nth c cc) (current-column)) ?\s))
+ (when-let ((cell (nth r (nth c columns))))
+ (insert cell))
+ (when (= c (1- cs))
+ (insert ?\n))))))))
+
+(defun transient--pixel-width (string)
+ (save-window-excursion
+ (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))))))
(cl-defmethod transient--insert-group ((group transient-subgroups))
(let* ((subgroups (oref group suffixes))
@@ -3195,14 +3224,17 @@ If the OBJ's `key' is currently unreachable, then apply
the face
'transient-inactive-argument)))
(cl-defmethod transient-format-value ((obj transient-option))
- (let ((value (oref obj value)))
- (propertize (concat (oref obj argument)
- (if (listp value)
- (mapconcat #'identity value ",")
- value))
- 'face (if value
- 'transient-value
- 'transient-inactive-value))))
+ (let ((argument (oref obj argument)))
+ (if-let ((value (oref obj value)))
+ (propertize
+ (cl-ecase (oref obj multi-value)
+ ((nil) (concat argument value))
+ ((t rest) (concat argument
+ (and (not (string-suffix-p " " argument)) " ")
+ (mapconcat #'prin1-to-string value " ")))
+ (repeat (mapconcat (lambda (v) (concat argument v)) value " ")))
+ 'face 'transient-value)
+ (propertize argument 'face 'transient-inactive-value))))
(cl-defmethod transient-format-value ((obj transient-switches))
(with-slots (value argument-format choices) obj
@@ -3222,15 +3254,6 @@ If the OBJ's `key' is currently unreachable, then apply
the face
(propertize "|" 'face 'transient-inactive-value))
(propertize "]" 'face 'transient-inactive-value)))))
-(cl-defmethod transient-format-value ((obj transient-files))
- (let ((argument (oref obj argument)))
- (if-let ((value (oref obj value)))
- (propertize (concat argument " "
- (mapconcat (lambda (f) (format "%S" f))
- (oref obj value) " "))
- 'face 'transient-argument)
- (propertize argument 'face 'transient-inactive-argument))))
-
(defun transient--key-unreachable-p (obj)
(and transient--redisplay-key
(let ((key (oref obj key)))
@@ -3274,42 +3297,58 @@ a prefix command, while porting a regular keymap to a
transient."
;;; Help
(cl-defgeneric transient-show-help (obj)
- "Show help for OBJ's command.")
+ "Show documentation for the command represented by OBJ.")
(cl-defmethod transient-show-help ((obj transient-prefix))
- "Show the info manual, manpage or command doc-string.
-Show the first one that is specified."
- (if-let ((manual (oref obj info-manual)))
- (info manual)
- (if-let ((manpage (oref obj man-page)))
- (transient--show-manpage manpage)
- (transient--describe-function (oref obj command)))))
+ "Call `show-help' if non-nil, else show `info-manual',
+if non-nil, else show the `man-page' if non-nil, else use
+`describe-function'."
+ (with-slots (show-help info-manual man-page command) obj
+ (cond (show-help (funcall show-help obj))
+ (info-manual (transient--show-manual info-manual))
+ (man-page (transient--show-manpage man-page))
+ (t (transient--describe-function command)))))
(cl-defmethod transient-show-help ((obj transient-suffix))
- "Show the command doc-string."
- (if (eq this-command 'transient-help)
- (if-let ((manpage (oref transient--prefix man-page)))
- (transient--show-manpage manpage)
- (transient--describe-function (oref transient--prefix command)))
- (if-let ((prefix (get (transient--suffix-command obj) 'transient--prefix))
- (manpage (oref prefix man-page))
- (- (not (eq this-command (oref transient--prefix command)))))
- (transient--show-manpage manpage)
- (transient--describe-function this-original-command))))
+ "Call `show-help' if non-nil, else use `describe-function'.
+Also used to dispatch showing documentation for the current
+prefix. If the suffix is a sub-prefix, then also call the
+prefix method."
+ (cond
+ ((eq this-command 'transient-help)
+ (transient-show-help transient--prefix))
+ ((let ((prefix (get (transient--suffix-command obj)
+ 'transient--prefix)))
+ (and prefix (not (eq (oref transient--prefix command) this-command))
+ (prog1 t (transient-show-help prefix)))))
+ (t (if-let ((show-help (oref obj show-help)))
+ (funcall show-help obj)
+ (transient--describe-function this-command)))))
(cl-defmethod transient-show-help ((obj transient-infix))
- "Show the manpage if defined or the command doc-string.
-If the manpage is specified, then try to jump to the correct
-location."
- (if-let ((manpage (oref transient--prefix man-page)))
- (transient--show-manpage manpage (ignore-errors (oref obj argument)))
- (transient--describe-function this-original-command)))
+ "Call `show-help' if non-nil, else show the `man-page'
+if non-nil, else use `describe-function'. When showing the
+manpage, then try to jump to the correct location."
+ (if-let ((show-help (oref obj show-help)))
+ (funcall show-help obj)
+ (if-let ((man-page (oref transient--prefix man-page))
+ (argument (and (slot-boundp obj 'argument)
+ (oref obj argument))))
+ (transient--show-manpage man-page argument)
+ (transient--describe-function this-command))))
;; `cl-generic-generalizers' doesn't support `command' et al.
(cl-defmethod transient-show-help (cmd)
"Show the command doc-string."
(transient--describe-function cmd))
+(defun transient--describe-function (fn)
+ (describe-function fn)
+ (select-window (get-buffer-window (help-buffer))))
+
+(defun transient--show-manual (manual)
+ (info manual))
+
(defun transient--show-manpage (manpage &optional argument)
(require 'man)
(let* ((Man-notify-method 'meek)
@@ -3321,10 +3360,6 @@ location."
(when argument
(transient--goto-argument-description argument))))
-(defun transient--describe-function (fn)
- (describe-function fn)
- (select-window (get-buffer-window (help-buffer))))
-
(defun transient--goto-argument-description (arg)
(goto-char (point-min))
(let ((case-fold-search nil)
diff --git a/test/lisp/net/dbus-tests.el b/test/lisp/net/dbus-tests.el
index 71ca353..cfc380d 100644
--- a/test/lisp/net/dbus-tests.el
+++ b/test/lisp/net/dbus-tests.el
@@ -631,18 +631,18 @@ This includes initialization and closing the bus."
dbus--test-interface method1 "foo" "bar"))
`(dbus-error ,dbus-error-invalid-args "Wrong arguments (foo bar)")))
;; Three arguments, D-Bus error activated by `dbus-error'
- ;; signal. On hydra, it is not guaranteed which format the
+ ;; signal. On CentOS, it is not guaranteed which format the
;; error message arises. (Bug#51369)
- (unless (getenv "EMACS_HYDRA_CI")
- (should
- (equal
- (should-error
- (dbus-call-method
- :session dbus--test-service dbus--test-path
- dbus--test-interface method1 "foo" "bar" "baz"))
- `(dbus-error
- ,dbus-error-failed
- "D-Bus error: \"D-Bus signal\", \"foo\", \"bar\", \"baz\""))))
+ (should
+ (member
+ (should-error
+ (dbus-call-method
+ :session dbus--test-service dbus--test-path
+ dbus--test-interface method1 "foo" "bar" "baz"))
+ `((dbus-error "D-Bus signal" "foo" "bar" "baz")
+ (dbus-error
+ ,dbus-error-failed
+ "D-Bus error: \"D-Bus signal\", \"foo\", \"bar\", \"baz\""))))
;; Unregister method.
(should (dbus-unregister-object registered))