[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
feature/android 2ad50c7ff50: Merge remote-tracking branch 'origin/master
|
From: |
Po Lu |
|
Subject: |
feature/android 2ad50c7ff50: Merge remote-tracking branch 'origin/master' into feature/android |
|
Date: |
Sun, 30 Jul 2023 20:43:05 -0400 (EDT) |
branch: feature/android
commit 2ad50c7ff5093e7a1d3a5a06f042430e7d46c117
Merge: 37f68e86962 1f3995f65a0
Author: Po Lu <luangruo@yahoo.com>
Commit: Po Lu <luangruo@yahoo.com>
Merge remote-tracking branch 'origin/master' into feature/android
---
etc/themes/deeper-blue-theme.el | 8 ++--
etc/themes/leuven-dark-theme.el | 8 ++--
etc/themes/leuven-theme.el | 8 ++--
etc/themes/manoj-dark-theme.el | 4 +-
etc/themes/whiteboard-theme.el | 8 ++--
lisp/emacs-lisp/map.el | 33 ++++++++++-----
lisp/emacs-lisp/rx.el | 20 +++++----
lisp/net/tramp-compat.el | 3 +-
lisp/net/tramp-gvfs.el | 3 +-
lisp/net/tramp-message.el | 60 +++++++++++++++-----------
lisp/net/tramp.el | 88 +++++++++++----------------------------
test/lisp/emacs-lisp/map-tests.el | 59 ++++++++++++++++++++++++++
test/lisp/emacs-lisp/rx-tests.el | 20 ++++++---
13 files changed, 191 insertions(+), 131 deletions(-)
diff --git a/etc/themes/deeper-blue-theme.el b/etc/themes/deeper-blue-theme.el
index 40d5f18a011..20da432c75a 100644
--- a/etc/themes/deeper-blue-theme.el
+++ b/etc/themes/deeper-blue-theme.el
@@ -64,8 +64,8 @@
`(ediff-fine-diff-B ((,class (:background "cyan4" :foreground "white"))))
`(ediff-odd-diff-A ((,class (:background "Grey50" :foreground "White"))))
`(error ((,class (:foreground "red"))))
- `(flymake-errline ((,class (:background nil :underline "red"))))
- `(flymake-warnline ((,class (:background nil :underline "magenta3"))))
+ `(flymake-errline ((,class (:background unspecified :underline "red"))))
+ `(flymake-warnline ((,class (:background unspecified :underline
"magenta3"))))
`(font-lock-builtin-face ((,class (:foreground "LightCoral"))))
`(font-lock-comment-delimiter-face ((,class (:foreground "gray50"))))
`(font-lock-comment-face ((,class (:foreground "gray50"))))
@@ -84,7 +84,7 @@
`(highlight ((,class (:background "DodgerBlue4"))))
`(ido-first-match ((,class (:weight normal :foreground "orange"))))
`(ido-only-match ((,class (:foreground "green"))))
- `(ido-subdir ((,class (:foreground nil :inherit font-lock-keyword-face))))
+ `(ido-subdir ((,class (:foreground unspecified :inherit
font-lock-keyword-face))))
`(image-dired-thumb-flagged ((,class (:background "Red1"))))
`(image-dired-thumb-mark ((,class (:background "dodgerblue3"))))
`(info-header-node ((,class (:foreground "DeepSkyBlue1"))))
@@ -98,7 +98,7 @@
`(match ((,class (:background "DeepPink4"))))
`(minibuffer-prompt ((,class (:foreground "CadetBlue1"))))
`(mode-line ((,class (:background "gray75" :foreground "black" :box
(:line-width 1 :style released-button)))))
- `(mode-line-buffer-id ((,class (:weight bold :background nil :foreground
"blue4"))))
+ `(mode-line-buffer-id ((,class (:weight bold :background unspecified
:foreground "blue4"))))
`(mode-line-inactive ((,class (:background "gray40" :foreground "black"
:box (:line-width 1 :color "gray40" :style nil)))))
`(outline-1 ((,class (:foreground "SkyBlue1"))))
`(outline-2 ((,class (:foreground "CadetBlue1"))))
diff --git a/etc/themes/leuven-dark-theme.el b/etc/themes/leuven-dark-theme.el
index fda00f1282f..bfe5256ab97 100644
--- a/etc/themes/leuven-dark-theme.el
+++ b/etc/themes/leuven-dark-theme.el
@@ -621,11 +621,11 @@ more..."
`(helm-source-header ((,class (:weight bold :box (:line-width 1 :color
"#3d3842") :background "#433e48" :foreground "#ffffff"))))
`(helm-swoop-target-line-block-face ((,class (:background "#3833ff"
:foreground "#e0dde3"))))
`(helm-swoop-target-line-face ((,class (:background "#38330b"))))
- `(helm-swoop-target-word-face ((,class (:weight bold :foreground nil
:background "#0742d2"))))
+ `(helm-swoop-target-word-face ((,class (:weight bold :foreground
unspecified :background "#0742d2"))))
`(helm-visible-mark ((,class ,marked-line)))
`(helm-w3m-bookmarks-face ((,class (:underline t :foreground "#ff010b"))))
- `(highlight-changes ((,class (:foreground nil)))) ;; blue "#d4f754"
- `(highlight-changes-delete ((,class (:strike-through nil :foreground
nil)))) ;; red "#4ff7d7"
+ `(highlight-changes ((,class (:foreground unspecified)))) ;; blue "#d4f754"
+ `(highlight-changes-delete ((,class (:strike-through nil :foreground
unspecified)))) ;; red "#4ff7d7"
`(highlight-symbol-face ((,class (:background "#252080"))))
`(hl-line ((,class ,highlight-yellow))) ; Highlight current line.
`(hl-tags-face ((,class ,highlight-current-tag))) ; ~ Pair highlighting
(matching tags).
@@ -643,7 +643,7 @@ more..."
`(info-file ((,class (:family "Sans Serif" :height 1.8 :weight bold :box
(:line-width 1 :color "#ffff3d") :foreground "#9f6a1c" :background "#563c2a"))))
`(info-header-node ((,class (:underline t :foreground "#065aff")))) ; nodes
in header
`(info-header-xref ((,class (:underline t :foreground "#e46f0b")))) ; cross
references in header
- `(info-index-match ((,class (:weight bold :foreground nil :background
"#0742d2")))) ; when using `i'
+ `(info-index-match ((,class (:weight bold :foreground unspecified
:background "#0742d2")))) ; when using `i'
`(info-menu-header ((,class ,ol2))) ; menu titles (headers) -- major topics
`(info-menu-star ((,class (:foreground "#ffffff")))) ; every 3rd menu item
`(info-node ((,class (:underline t :foreground "#ffff0b")))) ; node names
diff --git a/etc/themes/leuven-theme.el b/etc/themes/leuven-theme.el
index 7747d1e7315..f7d454381d7 100644
--- a/etc/themes/leuven-theme.el
+++ b/etc/themes/leuven-theme.el
@@ -618,11 +618,11 @@ more..."
`(helm-source-header ((,class (:weight bold :box (:line-width 1 :color
"#C7C7C7") :background "#DEDEDE" :foreground "black"))))
`(helm-swoop-target-line-block-face ((,class (:background "#CCCC00"
:foreground "#222222"))))
`(helm-swoop-target-line-face ((,class (:background "#CCCCFF"))))
- `(helm-swoop-target-word-face ((,class (:weight bold :foreground nil
:background "#FDBD33"))))
+ `(helm-swoop-target-word-face ((,class (:weight bold :foreground
unspecified :background "#FDBD33"))))
`(helm-visible-mark ((,class ,marked-line)))
`(helm-w3m-bookmarks-face ((,class (:underline t :foreground "cyan1"))))
- `(highlight-changes ((,class (:foreground nil)))) ;; blue "#2E08B5"
- `(highlight-changes-delete ((,class (:strike-through nil :foreground
nil)))) ;; red "#B5082E"
+ `(highlight-changes ((,class (:foreground unspecified)))) ;; blue "#2E08B5"
+ `(highlight-changes-delete ((,class (:strike-through nil :foreground
unspecified)))) ;; red "#B5082E"
`(highlight-symbol-face ((,class (:background "#FFFFA0"))))
`(hl-line ((,class ,highlight-yellow))) ; Highlight current line.
`(hl-tags-face ((,class ,highlight-current-tag))) ; ~ Pair highlighting
(matching tags).
@@ -642,7 +642,7 @@ more..."
`(info-file ((,class (:family "Sans Serif" :height 1.8 :weight bold :box
(:line-width 1 :color "#0000CC") :foreground "cornflower blue" :background
"LightSteelBlue1"))))
`(info-header-node ((,class (:underline t :foreground "orange")))) ; nodes
in header
`(info-header-xref ((,class (:underline t :foreground "dodger blue")))) ;
cross references in header
- `(info-index-match ((,class (:weight bold :foreground nil :background
"#FDBD33")))) ; when using `i'
+ `(info-index-match ((,class (:weight bold :foreground unspecified
:background "#FDBD33")))) ; when using `i'
`(info-menu-header ((,class ,ol2))) ; menu titles (headers) -- major topics
`(info-menu-star ((,class (:foreground "black")))) ; every 3rd menu item
`(info-node ((,class (:underline t :foreground "blue")))) ; node names
diff --git a/etc/themes/manoj-dark-theme.el b/etc/themes/manoj-dark-theme.el
index 1c3e23908d1..26627a29c70 100644
--- a/etc/themes/manoj-dark-theme.el
+++ b/etc/themes/manoj-dark-theme.el
@@ -526,8 +526,8 @@ jarring angry fruit salad look to reduce eye fatigue."
'(widget-mouse-face ((t (:background "darkseagreen2" :foreground "blue"))))
'(highlight-beyond-fill-column-face ((t (:underline t))))
- '(highlight-changes ((t (:foreground nil :background "#382f2f"))))
- '(highlight-changes-delete ((t (:foreground nil :background "#916868"))))
+ '(highlight-changes ((t (:foreground unspecified :background "#382f2f"))))
+ '(highlight-changes-delete ((t (:foreground unspecified :background
"#916868"))))
'(holiday ((t (:background "chocolate4"))))
'(holiday-face ((t (:background "chocolate4"))))
diff --git a/etc/themes/whiteboard-theme.el b/etc/themes/whiteboard-theme.el
index adbd69f1c6f..b52996c24c0 100644
--- a/etc/themes/whiteboard-theme.el
+++ b/etc/themes/whiteboard-theme.el
@@ -44,8 +44,8 @@
`(cursor ((,class (:background "Green4"))))
`(default ((,class (:background "whitesmoke" :foreground "black"))))
`(dired-marked ((,class (:background "dodgerblue3" :foreground "white"))))
- `(flymake-errline ((,class (:background nil :underline "red"))))
- `(flymake-warnline ((,class (:background nil :underline "magenta3"))))
+ `(flymake-errline ((,class (:background unspecified :underline "red"))))
+ `(flymake-warnline ((,class (:background unspecified :underline
"magenta3"))))
`(font-lock-builtin-face ((,class (:foreground "DarkOrange3"))))
`(font-lock-comment-delimiter-face ((,class (:foreground "gray50"))))
`(font-lock-comment-face ((,class (:foreground "gray50"))))
@@ -65,7 +65,7 @@
`(highlight ((,class (:background "SkyBlue1"))))
`(ido-first-match ((,class (:weight normal :foreground "DarkOrange3"))))
`(ido-only-match ((,class (:foreground "SeaGreen4"))))
- `(ido-subdir ((,class (:foreground nil :inherit font-lock-keyword-face))))
+ `(ido-subdir ((,class (:foreground unspecified :inherit
font-lock-keyword-face))))
`(image-dired-thumb-flagged ((,class :background "Red1")))
`(image-dired-thumb-mark ((,class :background "dodgerblue3")))
`(info-header-node ((,class (:foreground "DeepSkyBlue1"))))
@@ -79,7 +79,7 @@
`(match ((,class (:background "LightPink1"))))
`(minibuffer-prompt ((,class (:foreground "DodgerBlue4"))))
`(mode-line ((,class (:background "gray75" :foreground "black" :box
(:line-width 1 :style released-button)))))
- `(mode-line-buffer-id ((,class (:weight bold :background nil :foreground
"blue4"))))
+ `(mode-line-buffer-id ((,class (:weight bold :background unspecified
:foreground "blue4"))))
`(mode-line-inactive ((,class (:background "gray40" :foreground "black"
:box (:line-width 1 :color "gray40" :style nil)))))
`(outline-1 ((,class (:foreground "Blue3"))))
`(outline-2 ((,class (:foreground "DodgerBlue"))))
diff --git a/lisp/emacs-lisp/map.el b/lisp/emacs-lisp/map.el
index 7a48ba47434..b55eb431668 100644
--- a/lisp/emacs-lisp/map.el
+++ b/lisp/emacs-lisp/map.el
@@ -50,18 +50,20 @@
ARGS is a list of elements to be matched in the map.
-Each element of ARGS can be of the form (KEY PAT), in which case KEY is
-evaluated and searched for in the map. The match fails if for any KEY
-found in the map, the corresponding PAT doesn't match the value
-associated with the KEY.
+Each element of ARGS can be of the form (KEY PAT [DEFAULT]),
+which looks up KEY in the map and matches the associated value
+against `pcase' pattern PAT. DEFAULT specifies the fallback
+value to use when KEY is not present in the map. If omitted, it
+defaults to nil. Both KEY and DEFAULT are evaluated.
Each element can also be a SYMBOL, which is an abbreviation of
a (KEY PAT) tuple of the form (\\='SYMBOL SYMBOL). When SYMBOL
is a keyword, it is an abbreviation of the form (:SYMBOL SYMBOL),
useful for binding plist values.
-Keys in ARGS not found in the map are ignored, and the match doesn't
-fail."
+An element of ARGS fails to match if PAT does not match the
+associated value or the default value. The overall pattern fails
+to match if any element of ARGS fails to match."
`(and (pred mapp)
,@(map--make-pcase-bindings args)))
@@ -71,12 +73,13 @@ fail."
KEYS can be a list of symbols, in which case each element will be
bound to the looked up value in MAP.
-KEYS can also be a list of (KEY VARNAME) pairs, in which case
-KEY is an unquoted form.
+KEYS can also be a list of (KEY VARNAME [DEFAULT]) sublists, in
+which case KEY and DEFAULT are unquoted forms.
MAP can be an alist, plist, hash-table, or array."
(declare (indent 2)
- (debug ((&rest &or symbolp ([form symbolp])) form body)))
+ (debug ((&rest &or symbolp ([form symbolp &optional form]))
+ form body)))
`(pcase-let ((,(map--make-pcase-patterns keys) ,map))
,@body))
@@ -595,11 +598,21 @@ Example:
(map-into \\='((1 . 3)) \\='(hash-table :test eql))"
(map--into-hash map (cdr type)))
+(defmacro map--pcase-map-elt (key default map)
+ "A macro to make MAP the last argument to `map-elt'.
+
+This allows using default values for `map-elt', which can't be
+done using `pcase--flip'.
+
+KEY is the key sought in the map. DEFAULT is the default value."
+ `(map-elt ,map ,key ,default))
+
(defun map--make-pcase-bindings (args)
"Return a list of pcase bindings from ARGS to the elements of a map."
(mapcar (lambda (elt)
(cond ((consp elt)
- `(app (pcase--flip map-elt ,(car elt)) ,(cadr elt)))
+ `(app (map--pcase-map-elt ,(car elt) ,(caddr elt))
+ ,(cadr elt)))
((keywordp elt)
(let ((var (intern (substring (symbol-name elt) 1))))
`(app (pcase--flip map-elt ,elt) ,var)))
diff --git a/lisp/emacs-lisp/rx.el b/lisp/emacs-lisp/rx.el
index f1eb3e308a2..19c82d9b23d 100644
--- a/lisp/emacs-lisp/rx.el
+++ b/lisp/emacs-lisp/rx.el
@@ -445,13 +445,19 @@ classes."
(setcar dash-l ?.)) ; Reduce --x to .-x
(setq items (nconc items '((?- . ?-))))))
- ;; Deal with leading ^ and range ^-x.
- (when (and (consp (car items))
- (eq (caar items) ?^)
- (cdr items))
- ;; Move ^ and ^-x to second place.
- (setq items (cons (cadr items)
- (cons (car items) (cddr items)))))
+ ;; Deal with leading ^ and range ^-x in non-negated set.
+ (when (and (eq (car-safe (car items)) ?^)
+ (not negated))
+ (if (eq (cdar items) ?^)
+ ;; single leading ^
+ (when (cdr items)
+ ;; Move the ^ to second place.
+ (setq items (cons (cadr items)
+ (cons (car items) (cddr items)))))
+ ;; Split ^-x to _-x^
+ (setq items (cons (cons ?_ (cdar items))
+ (cons '(?^ . ?^)
+ (cdr items))))))
(cond
;; Empty set: if negated, any char, otherwise match-nothing.
diff --git a/lisp/net/tramp-compat.el b/lisp/net/tramp-compat.el
index 61359562ee3..85ddb81f398 100644
--- a/lisp/net/tramp-compat.el
+++ b/lisp/net/tramp-compat.el
@@ -34,7 +34,6 @@
(require 'format-spec)
(require 'parse-time)
(require 'shell)
-(require 'subr-x)
(require 'xdg)
(declare-function tramp-error "tramp")
@@ -307,7 +306,7 @@ Also see `ignore'."
"List of characters equivalent to trailing colon in \"password\"
prompts."))
(dolist (elt (all-completions "tramp-compat-" obarray 'functionp))
- (put (intern elt) 'tramp-suppress-trace t))
+ (function-put (intern elt) 'tramp-suppress-trace t))
(add-hook 'tramp-unload-hook
(lambda ()
diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el
index 72cf4a6a4b3..71ef8215ab0 100644
--- a/lisp/net/tramp-gvfs.el
+++ b/lisp/net/tramp-gvfs.el
@@ -951,14 +951,13 @@ Return nil for null BYTE-ARRAY."
(defun tramp-dbus-function (vec func args)
"Apply a D-Bus function FUNC from dbus.el.
The call will be traced by Tramp with trace level 6."
+ (declare (tramp-suppress-trace t))
(let (result)
(tramp-message vec 6 "%s" (cons func args))
(setq result (apply func args))
(tramp-message vec 6 "%s" (tramp-gvfs-stringify-dbus-message result))
result))
-(put #'tramp-dbus-function 'tramp-suppress-trace t)
-
(defmacro with-tramp-dbus-call-method
(vec synchronous bus service path interface method &rest args)
"Apply a D-Bus call on bus BUS.
diff --git a/lisp/net/tramp-message.el b/lisp/net/tramp-message.el
index bfefd95096d..cf90db1d6b1 100644
--- a/lisp/net/tramp-message.el
+++ b/lisp/net/tramp-message.el
@@ -52,9 +52,21 @@
(declare-function tramp-compat-string-replace "tramp-compat")
(declare-function tramp-file-name-equal-p "tramp")
+(declare-function tramp-file-name-host-port "tramp")
+(declare-function tramp-file-name-user-domain "tramp")
(declare-function tramp-get-default-directory "tramp")
(defvar tramp-compat-temporary-file-directory)
+(eval-and-compile
+ (defalias 'tramp-byte-run--set-suppress-trace
+ #'(lambda (f _args val)
+ (list 'function-put (list 'quote f)
+ ''tramp-suppress-trace val)))
+
+ (add-to-list
+ 'defun-declarations-alist
+ (list 'tramp-suppress-trace #'tramp-byte-run--set-suppress-trace)))
+
;;;###tramp-autoload
(defcustom tramp-verbose 3
"Verbosity level for Tramp messages.
@@ -122,8 +134,6 @@ Point must be at the beginning of a header line.
The outline level is equal to the verbosity of the Tramp message."
(1+ (string-to-number (match-string 3))))
-(put #'tramp-debug-outline-level 'tramp-suppress-trace t)
-
;; This function takes action since Emacs 28.1, when
;; `read-extended-command-predicate' is set to
;; `command-completion-default-include-p'.
@@ -135,11 +145,11 @@ They are completed by \"M-x TAB\" only in Tramp debug
buffers."
(buffer-substring (point-min) (min (+ (point-min) 10) (point-max)))
";; Emacs:")))
-(put #'tramp-debug-buffer-command-completion-p 'tramp-suppress-trace t)
-
(defun tramp-setup-debug-buffer ()
"Function to setup debug buffers."
- ;; (declare (completion tramp-debug-buffer-command-completion-p))
+ (declare (tramp-suppress-trace t))
+ ;; (declare (completion tramp-debug-buffer-command-completion-p)
+ ;; (tramp-suppress-trace t))
(interactive)
(set-buffer-file-coding-system 'utf-8)
(setq buffer-undo-list t)
@@ -165,46 +175,40 @@ They are completed by \"M-x TAB\" only in Tramp debug
buffers."
(local-set-key "\M-n" 'clone-buffer)
(add-hook 'clone-buffer-hook #'tramp-setup-debug-buffer nil 'local))
-(put #'tramp-setup-debug-buffer 'tramp-suppress-trace t)
-
(function-put
#'tramp-setup-debug-buffer 'completion-predicate
#'tramp-debug-buffer-command-completion-p)
(defun tramp-debug-buffer-name (vec)
"A name for the debug buffer of VEC."
+ (declare (tramp-suppress-trace t))
(let ((method (tramp-file-name-method vec))
(user-domain (tramp-file-name-user-domain vec))
(host-port (tramp-file-name-host-port vec)))
- (if (or (null user-domain) (string-empty-p user-domain))
+ (if (tramp-string-empty-or-nil-p user-domain)
(format "*debug tramp/%s %s*" method host-port)
(format "*debug tramp/%s %s@%s*" method user-domain host-port))))
-(put #'tramp-debug-buffer-name 'tramp-suppress-trace t)
-
(defun tramp-get-debug-buffer (vec)
"Get the debug buffer of VEC."
+ (declare (tramp-suppress-trace t))
(with-current-buffer (get-buffer-create (tramp-debug-buffer-name vec))
(when (bobp)
(tramp-setup-debug-buffer))
(current-buffer)))
-(put #'tramp-get-debug-buffer 'tramp-suppress-trace t)
-
(defun tramp-get-debug-file-name (vec)
"Get the debug file name for VEC."
+ (declare (tramp-suppress-trace t))
(expand-file-name
(tramp-compat-string-replace "/" " " (tramp-debug-buffer-name vec))
tramp-compat-temporary-file-directory))
-(put #'tramp-get-debug-file-name 'tramp-suppress-trace t)
-
(defun tramp-trace-buffer-name (vec)
"A name for the trace buffer for VEC."
+ (declare (tramp-suppress-trace t))
(tramp-compat-string-replace "*debug" "*trace" (tramp-debug-buffer-name
vec)))
-(put #'tramp-trace-buffer-name 'tramp-suppress-trace t)
-
(defvar tramp-trace-functions nil
"A list of non-Tramp functions to be traced with `tramp-verbose' > 10.")
@@ -212,6 +216,7 @@ They are completed by \"M-x TAB\" only in Tramp debug
buffers."
"Append message to debug buffer of VEC.
Message is formatted with FMT-STRING as control string and the remaining
ARGUMENTS to actually emit the message (if applicable)."
+ (declare (tramp-suppress-trace t))
(let ((inhibit-message t)
create-lockfiles file-name-handler-alist message-log-max
signal-hook-function)
@@ -287,8 +292,6 @@ ARGUMENTS to actually emit the message (if applicable)."
(write-region
point (point-max) (tramp-get-debug-file-name vec) 'append))))))))
-(put #'tramp-debug-message 'tramp-suppress-trace t)
-
;;;###tramp-autoload
(defun tramp-message (vec-or-proc level fmt-string &rest arguments)
"Emit a message depending on verbosity level.
@@ -343,6 +346,9 @@ applicable)."
(concat (format "(%d) # " level) fmt-string)
arguments))))))
+;; We cannot declare our private symbols in loaddefs.
+(function-put 'tramp-message 'tramp-suppress-trace t)
+
(defsubst tramp-backtrace (&optional vec-or-proc force)
"Dump a backtrace into the debug buffer.
If VEC-OR-PROC is nil, the buffer *debug tramp* is used. FORCE
@@ -453,14 +459,24 @@ the resulting error message."
(progn ,@body)
(error (tramp-message ,vec-or-proc 3 ,format ,err) nil))))
+(defun tramp-test-message (fmt-string &rest arguments)
+ "Emit a Tramp message according `default-directory'."
+ (declare (tramp-suppress-trace t))
+ (cond
+ ((tramp-tramp-file-p default-directory)
+ (apply #'tramp-message
+ (tramp-dissect-file-name default-directory) 0 fmt-string arguments))
+ ((tramp-file-name-p (car tramp-current-connection))
+ (apply #'tramp-message
+ (car tramp-current-connection) 0 fmt-string arguments))
+ (t (apply #'message fmt-string arguments))))
+
(defun tramp-debug-button-action (button)
"Goto the linked message in debug buffer at place."
(when (mouse-event-p last-input-event) (mouse-set-point last-input-event))
(when-let ((point (button-get button 'position)))
(goto-char point)))
-(put #'tramp-debug-button-action 'tramp-suppress-trace t)
-
(define-button-type 'tramp-debug-button-type
'follow-link t
'mouse-face 'highlight
@@ -492,8 +508,6 @@ The link buttons are in the verbositiy level substrings."
'position (set-marker (make-marker) beg1)
'help-echo "mouse-2, RET: goto entry message"))))
-(put #'tramp-debug-link-messages 'tramp-suppress-trace t)
-
(defvar tramp-debug-nesting ""
"Indicator for debug messages nested level.
This shouldn't be changed globally, but let-bind where needed.")
@@ -515,8 +529,6 @@ Bound in `tramp-*-file-name-handler' functions.")
:type 'help-function-def
'help-args (list fun (symbol-file fun))))))
-(put #'tramp-debug-message-buttonize 'tramp-suppress-trace t)
-
;; This is used in `tramp-file-name-handler' and
`tramp-*-maybe-open-connection'.
(defmacro with-tramp-debug-message (vec message &rest body)
"Execute BODY, embedded with MESSAGE in the debug buffer of VEC.
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index 4b1be4a4d11..e83d13e3779 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -1440,49 +1440,44 @@ calling HANDLER.")
(cl-defstruct (tramp-file-name (:type list) :named)
method user domain host port localname hop))
-(put #'tramp-file-name-method 'tramp-suppress-trace t)
-(put #'tramp-file-name-user 'tramp-suppress-trace t)
-(put #'tramp-file-name-domain 'tramp-suppress-trace t)
-(put #'tramp-file-name-host 'tramp-suppress-trace t)
-(put #'tramp-file-name-port 'tramp-suppress-trace t)
-(put #'tramp-file-name-localname 'tramp-suppress-trace t)
-(put #'tramp-file-name-hop 'tramp-suppress-trace t)
+(function-put #'tramp-file-name-method 'tramp-suppress-trace t)
+(function-put #'tramp-file-name-user 'tramp-suppress-trace t)
+(function-put #'tramp-file-name-domain 'tramp-suppress-trace t)
+(function-put #'tramp-file-name-host 'tramp-suppress-trace t)
+(function-put #'tramp-file-name-port 'tramp-suppress-trace t)
+(function-put #'tramp-file-name-localname 'tramp-suppress-trace t)
+(function-put #'tramp-file-name-hop 'tramp-suppress-trace t)
;; Needed for `tramp-read-passwd' and `tramp-get-remote-null-device'.
(defconst tramp-null-hop
(make-tramp-file-name :user (user-login-name) :host tramp-system-name)
"Connection hop which identifies the virtual hop before the first one.")
-;;;###tramp-autoload
(defun tramp-file-name-user-domain (vec)
"Return user and domain components of VEC."
+ (declare (tramp-suppress-trace t))
(when (or (tramp-file-name-user vec) (tramp-file-name-domain vec))
(concat (tramp-file-name-user vec)
(and (tramp-file-name-domain vec)
tramp-prefix-domain-format)
(tramp-file-name-domain vec))))
-(put #'tramp-file-name-user-domain 'tramp-suppress-trace t)
-
-;;;###tramp-autoload
(defun tramp-file-name-host-port (vec)
"Return host and port components of VEC."
+ (declare (tramp-suppress-trace t))
(when (or (tramp-file-name-host vec) (tramp-file-name-port vec))
(concat (tramp-file-name-host vec)
(and (tramp-file-name-port vec)
tramp-prefix-port-format)
(tramp-file-name-port vec))))
-(put #'tramp-file-name-host-port 'tramp-suppress-trace t)
-
(defun tramp-file-name-port-or-default (vec)
"Return port component of VEC.
If nil, return `tramp-default-port'."
+ (declare (tramp-suppress-trace t))
(or (tramp-file-name-port vec)
(tramp-get-method-parameter vec 'tramp-default-port)))
-(put #'tramp-file-name-port-or-default 'tramp-suppress-trace t)
-
;;;###tramp-autoload
(defun tramp-file-name-unify (vec &optional localname)
"Unify VEC by removing localname and hop from `tramp-file-name' structure.
@@ -1501,7 +1496,8 @@ same connection. Make a copy in order to avoid side
effects."
(tramp-file-name-hop vec) nil))
vec))
-(put #'tramp-file-name-unify 'tramp-suppress-trace t)
+;; We cannot declare our private symbols in loaddefs.
+(function-put 'tramp-file-name-unify 'tramp-suppress-trace t)
;; Comparison of file names is performed by `tramp-equal-remote'.
(defun tramp-file-name-equal-p (vec1 vec2)
@@ -1544,8 +1540,6 @@ entry does not exist, return nil."
(string-match-p tramp-file-name-regexp name)
t))
-(put #'tramp-tramp-file-p 'tramp-suppress-trace t)
-
;; This function bypasses the file name handler approach. It is NOT
;; recommended to use it in any package if not absolutely necessary.
;; However, it is more performant than `file-local-name', and might be
@@ -1595,8 +1589,6 @@ This is METHOD, if non-nil. Otherwise, do a lookup in
result
(propertize result 'tramp-default t))))
-(put #'tramp-find-method 'tramp-suppress-trace t)
-
(defun tramp-find-user (method user host)
"Return the right user string to use depending on METHOD and HOST.
This is USER, if non-nil. Otherwise, do a lookup in
@@ -1618,8 +1610,6 @@ This is USER, if non-nil. Otherwise, do a lookup in
result
(propertize result 'tramp-default t))))
-(put #'tramp-find-user 'tramp-suppress-trace t)
-
(defun tramp-find-host (method user host)
"Return the right host string to use depending on METHOD and USER.
This is HOST, if non-nil. Otherwise, do a lookup in
@@ -1641,8 +1631,6 @@ This is HOST, if non-nil. Otherwise, do a lookup in
result
(propertize result 'tramp-default t))))
-(put #'tramp-find-host 'tramp-suppress-trace t)
-
;;;###tramp-autoload
(defun tramp-dissect-file-name (name &optional nodefault)
"Return a `tramp-file-name' structure of NAME, a remote file name.
@@ -1708,7 +1696,8 @@ default values are used."
(tramp-user-error
v "Method `%s' is not supported for multi-hops" method)))))))
-(put #'tramp-dissect-file-name 'tramp-suppress-trace t)
+;; We cannot declare our private symbols in loaddefs.
+(function-put 'tramp-dissect-file-name 'tramp-suppress-trace t)
;;;###tramp-autoload
(defun tramp-ensure-dissected-file-name (vec-or-filename)
@@ -1721,11 +1710,13 @@ If it's not a Tramp filename, return nil."
((tramp-tramp-file-p vec-or-filename)
(tramp-dissect-file-name vec-or-filename))))
-(put #'tramp-ensure-dissected-file-name 'tramp-suppress-trace t)
+;; We cannot declare our private symbols in loaddefs.
+(function-put 'tramp-ensure-dissected-file-name 'tramp-suppress-trace t)
(defun tramp-dissect-hop-name (name &optional nodefault)
"Return a `tramp-file-name' structure of `hop' part of NAME.
See `tramp-dissect-file-name' for details."
+ (declare (tramp-suppress-trace t))
(let ((v (tramp-dissect-file-name
(concat tramp-prefix-format
(replace-regexp-in-string
@@ -1740,8 +1731,7 @@ See `tramp-dissect-file-name' for details."
;; Return result.
v))
-(put #'tramp-dissect-hop-name 'tramp-suppress-trace t)
-
+;;;###tramp-autoload
(defsubst tramp-string-empty-or-nil-p (string)
"Check whether STRING is empty or nil."
(or (null string) (string= string "")))
@@ -1755,20 +1745,13 @@ See `tramp-dissect-file-name' for details."
(format "*tramp/%s %s*" method host-port)
(format "*tramp/%s %s@%s*" method user-domain host-port))))
-(put #'tramp-buffer-name 'tramp-suppress-trace t)
-
;;;###tramp-autoload
(defun tramp-make-tramp-file-name (&rest args)
"Construct a Tramp file name from ARGS.
-
-ARGS could have two different signatures. The first one is of
-type (VEC &optional LOCALNAME).
If LOCALNAME is nil, the value in VEC is used. If it is a
symbol, a null localname will be used. Otherwise, LOCALNAME is
-expected to be a string, which will be used.
-
-The other signature exists for backward compatibility. It has
-the form (METHOD USER DOMAIN HOST PORT LOCALNAME &optional HOP)."
+expected to be a string, which will be used."
+ (declare (advertised-calling-convention (vec &optional localname) "29.1"))
(let (method user domain host port localname hop)
(cond
((tramp-file-name-p (car args))
@@ -1821,9 +1804,6 @@ the form (METHOD USER DOMAIN HOST PORT LOCALNAME
&optional HOP)."
tramp-postfix-host-format
localname)))
-(set-advertised-calling-convention
- #'tramp-make-tramp-file-name '(vec &optional localname) "29.1")
-
(defun tramp-make-tramp-hop-name (vec)
"Construct a Tramp hop name from VEC."
(concat
@@ -1953,33 +1933,19 @@ does not exist, otherwise propagate the error."
(tramp-error ,vec 'file-missing ,filename)
(signal (car ,err) (cdr ,err)))))))
-(defun tramp-test-message (fmt-string &rest arguments)
- "Emit a Tramp message according `default-directory'."
- (cond
- ((tramp-tramp-file-p default-directory)
- (apply #'tramp-message
- (tramp-dissect-file-name default-directory) 0 fmt-string arguments))
- ((tramp-file-name-p (car tramp-current-connection))
- (apply #'tramp-message
- (car tramp-current-connection) 0 fmt-string arguments))
- (t (apply #'message fmt-string arguments))))
-
-(put #'tramp-test-message 'tramp-suppress-trace t)
-
;; This function provides traces in case of errors not triggered by
;; Tramp functions.
(defun tramp-signal-hook-function (error-symbol data)
"Function to be called via `signal-hook-function'."
;; `custom-initialize-*' functions provoke `void-variable' errors.
;; We don't want to see them in the backtrace.
+ (declare (tramp-suppress-trace t))
(unless (eq error-symbol 'void-variable)
(let ((inhibit-message t))
(tramp-error
(car tramp-current-connection) error-symbol
(mapconcat (lambda (x) (format "%s" x)) data " ")))))
-(put #'tramp-signal-hook-function 'tramp-suppress-trace t)
-
(defmacro with-parsed-tramp-file-name (filename var &rest body)
"Parse a Tramp filename and make components available in the body.
@@ -4669,6 +4635,7 @@ a connection-local variable."
(defun tramp-post-process-creation (proc vec)
"Apply actions after creation of process PROC."
+ (declare (tramp-suppress-trace t))
(process-put proc 'tramp-vector vec)
(process-put proc 'adjust-window-size-function #'ignore)
(set-process-query-on-exit-flag proc nil)
@@ -4676,8 +4643,6 @@ a connection-local variable."
(when (process-command proc)
(tramp-message vec 6 "%s" (string-join (process-command proc) " "))))
-(put #'tramp-post-process-creation 'tramp-suppress-trace t)
-
(defun tramp-direct-async-process-p (&rest args)
"Whether direct async `make-process' can be called."
(let ((v (tramp-dissect-file-name default-directory))
@@ -6397,6 +6362,7 @@ verbosity of 6."
(defun tramp-read-passwd (proc &optional prompt)
"Read a password from user (compat function).
Consults the auth-source package."
+ (declare (tramp-suppress-trace t))
(let* (;; If `auth-sources' contains "~/.authinfo.gpg", and
;; `exec-path' contains a relative file name like ".", it
;; could happen that the "gpg" command is not found. So we
@@ -6459,11 +6425,10 @@ Consults the auth-source package."
(setq tramp-password-save-function nil))
(tramp-set-connection-property vec "first-password-request" nil))))
-(put #'tramp-read-passwd 'tramp-suppress-trace t)
-
(defun tramp-read-passwd-without-cache (proc &optional prompt)
"Read a password from user (compat function)."
;; We suspend the timers while reading the password.
+ (declare (tramp-suppress-trace t))
(let (tramp-dont-suspend-timers)
(with-tramp-suspended-timers
(password-read
@@ -6472,10 +6437,9 @@ Consults the auth-source package."
(tramp-check-for-regexp proc tramp-password-prompt-regexp)
(match-string 0)))))))
-(put #'tramp-read-passwd-without-cache 'tramp-suppress-trace t)
-
(defun tramp-clear-passwd (vec)
"Clear password cache for connection related to VEC."
+ (declare (tramp-suppress-trace t))
(let ((method (tramp-file-name-method vec))
(user-domain (tramp-file-name-user-domain vec))
(host-port (tramp-file-name-host-port vec))
@@ -6488,8 +6452,6 @@ Consults the auth-source package."
:host ,host-port :port ,method))
(password-cache-remove (tramp-make-tramp-file-name vec 'noloc))))
-(put #'tramp-clear-passwd 'tramp-suppress-trace t)
-
(defun tramp-time-diff (t1 t2)
"Return the difference between the two times, in seconds.
T1 and T2 are time values (as returned by `current-time' for example)."
diff --git a/test/lisp/emacs-lisp/map-tests.el
b/test/lisp/emacs-lisp/map-tests.el
index 86c0e9e0503..2204743f794 100644
--- a/test/lisp/emacs-lisp/map-tests.el
+++ b/test/lisp/emacs-lisp/map-tests.el
@@ -577,6 +577,13 @@ See bug#58531#25 and bug#58563."
(should (= b 2))
(should-not c)))
+(ert-deftest test-map-let-default ()
+ (map-let (('foo a 3)
+ ('baz b 4))
+ '((foo . 1))
+ (should (equal a 1))
+ (should (equal b 4))))
+
(ert-deftest test-map-merge ()
"Test `map-merge'."
(should (equal (sort (map-merge 'list '(a 1) '((b . 2) (c . 3))
@@ -617,6 +624,58 @@ See bug#58531#25 and bug#58563."
(list one two))
'(1 2)))))
+(ert-deftest test-map-plist-pcase-default ()
+ (let ((plist '(:two 2)))
+ (should (equal (pcase-let (((map (:two two 33)
+ (:three three 44))
+ plist))
+ (list two three))
+ '(2 44)))))
+
+(ert-deftest test-map-pcase-matches ()
+ (let ((plist '(:two 2)))
+ (should (equal (pcase plist
+ ((map (:two two 33)
+ (:three three))
+ (list two three))
+ (_ 'fail))
+ '(2 nil)))
+
+ (should (equal (pcase plist
+ ((map (:two two 33)
+ (:three three 44))
+ (list two three))
+ (_ 'fail))
+ '(2 44)))
+
+ (should (equal (pcase plist
+ ((map (:two two 33)
+ (:three `(,a . ,b) '(11 . 22)))
+ (list two a b))
+ (_ 'fail))
+ '(2 11 22)))
+
+ (should (equal 'fail
+ (pcase plist
+ ((map (:two two 33)
+ (:three `(,a . ,b) 44))
+ (list two a b))
+ (_ 'fail))))
+
+ (should (equal 'fail
+ (pcase plist
+ ((map (:two two 33)
+ (:three `(,a . ,b) nil))
+ (list two a b))
+ (_ 'fail))))
+
+ (should (equal 'fail
+ (pcase plist
+ ((map (:two two 33)
+ (:three `(,a . ,b)))
+ (list two a b))
+ (_ 'fail))))))
+
(ert-deftest test-map-setf-alist-insert-key ()
(let ((alist))
(should (equal (setf (map-elt alist 'key) 'value)
diff --git a/test/lisp/emacs-lisp/rx-tests.el b/test/lisp/emacs-lisp/rx-tests.el
index 995d297ff08..4928d5adf9d 100644
--- a/test/lisp/emacs-lisp/rx-tests.el
+++ b/test/lisp/emacs-lisp/rx-tests.el
@@ -122,23 +122,33 @@
(should (equal (rx (any "]" "^") (any "]" "-") (any "-" "^")
(not (any "]" "^")) (not (any "]" "-"))
(not (any "-" "^")))
- "[]^][]-][-^][^]^][^]-][^-^]"))
+ "[]^][]-][-^][^]^][^]-][^^-]"))
(should (equal (rx (any "]" "^" "-") (not (any "]" "^" "-")))
"[]^-][^]^-]"))
+ (should (equal (rx (any "^-f") (any "^-f" "-")
+ (any "^-f" "z") (any "^-f" "z" "-"))
+ "[_-f^][_-f^-][_-f^z][_-f^z-]"))
+ (should (equal (rx (not (any "^-f")) (not (any "^-f" "-"))
+ (not (any "^-f" "z")) (not (any "^-f" "z" "-")))
+ "[^^-f][^^-f-][^^-fz][^^-fz-]"))
+ (should (equal (rx (any "^-f" word) (any "^-f" "-" word))
+ "[_-f^[:word:]][_-f^[:word:]-]"))
+ (should (equal (rx (not (any "^-f" word)) (not (any "^-f" "-" word)))
+ "[^^-f[:word:]][^^-f[:word:]-]"))
(should (equal (rx (any "-" ascii) (any "^" ascii) (any "]" ascii))
"[[:ascii:]-][[:ascii:]^][][:ascii:]]"))
(should (equal (rx (not (any "-" ascii)) (not (any "^" ascii))
(not (any "]" ascii)))
- "[^[:ascii:]-][^[:ascii:]^][^][:ascii:]]"))
+ "[^[:ascii:]-][^^[:ascii:]][^][:ascii:]]"))
(should (equal (rx (any "-]" ascii) (any "^]" ascii) (any "-^" ascii))
"[][:ascii:]-][]^[:ascii:]][[:ascii:]^-]"))
(should (equal (rx (not (any "-]" ascii)) (not (any "^]" ascii))
(not (any "-^" ascii)))
- "[^][:ascii:]-][^]^[:ascii:]][^[:ascii:]^-]"))
+ "[^][:ascii:]-][^]^[:ascii:]][^^[:ascii:]-]"))
(should (equal (rx (any "-]^" ascii) (not (any "-]^" ascii)))
"[]^[:ascii:]-][^]^[:ascii:]-]"))
(should (equal (rx (any "^" lower upper) (not (any "^" lower upper)))
- "[[:lower:]^[:upper:]][^[:lower:]^[:upper:]]"))
+ "[[:lower:]^[:upper:]][^^[:lower:][:upper:]]"))
(should (equal (rx (any "-" lower upper) (not (any "-" lower upper)))
"[[:lower:][:upper:]-][^[:lower:][:upper:]-]"))
(should (equal (rx (any "]" lower upper) (not (any "]" lower upper)))
@@ -153,7 +163,7 @@
"[]-a-][^]-a-]"))
(should (equal (rx (any "--]") (not (any "--]"))
(any "-" "^-a") (not (any "-" "^-a")))
- "[].-\\-][^].-\\-][-^-a][^-^-a]"))
+ "[].-\\-][^].-\\-][_-a^-][^^-a-]"))
(should (equal (rx (not (any "!a" "0-8" digit nonascii)))
"[^!0-8a[:digit:][:nonascii:]]"))
(should (equal (rx (any) (not (any)))