Merge remote-tracking branch 'origin/master' into feature/android
This commit is contained in:
Po Lu
commit
2ad50c7ff5
13 changed files with 191 additions and 131 deletions
|
|
@ -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"))))
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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"))))
|
||||
|
|
|
|||
|
|
@ -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"))))
|
||||
|
|
|
|||
|
|
@ -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)))
|
||||
|
|
|
|||
|
|
@ -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.
|
||||
|
|
|
|||
|
|
@ -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 ()
|
||||
|
|
|
|||
|
|
@ -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.
|
||||
|
|
|
|||
|
|
@ -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.
|
||||
|
|
|
|||
|
|
@ -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)."
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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)))
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue