Merge remote-tracking branch 'origin/master' into feature/pgtk

This commit is contained in:
Po Lu 2021-12-10 08:54:56 +08:00
commit 6919d5a7c0
18 changed files with 133 additions and 119 deletions

View file

@ -379,11 +379,15 @@ quotes. You can customize it freely according to your personal
preference.
@end defopt
@defun substitute-command-keys string
@defun substitute-command-keys string &optional no-face
@vindex help-key-binding@r{ (face)}
This function scans @var{string} for the above special sequences and
replaces them by what they stand for, returning the result as a string.
This permits display of documentation that refers accurately to the
user's own customized key bindings.
user's own customized key bindings. By default, the key bindings are
given a special face @code{help-key-binding}, but if the optional
argument @var{no-face} is non-@code{nil}, the function doesn't add
this face to the produced string.
@cindex advertised binding
If a command has multiple bindings, this function normally uses the

View file

@ -4306,12 +4306,12 @@ deleted unconditionally. Otherwise, the fate of the frame is
determined by calling @code{frame-auto-hide-function} (see below) with
that frame as sole argument.
If the third element of the @code{quit-restore} parameter is a list of
buffer, window start (@pxref{Window Start and End}), and point
(@pxref{Window Point}), and that buffer is still live, the buffer will
be displayed, and start and point set accordingly. If, in addition,
@var{window}'s buffer was temporarily resized, this function will also
try to restore the original height of @var{window}.
If the second element of the @code{quit-restore} parameter is a list
of a buffer, a window start (@pxref{Window Start and End}) and a
window point (@pxref{Window Point}), and that buffer is still live,
the buffer will be displayed, and start and point set accordingly.
If, in addition, @var{window}'s buffer was temporarily resized, this
function will also try to restore the original height of @var{window}.
Otherwise, if @var{window} was previously used for displaying other
buffers (@pxref{Window History}), the most recent buffer in that

View file

@ -616,6 +616,10 @@ If this option is non-nil (the default), marking, unmarking or
flagging an image in either the thumbnail or display buffer shows the
next image.
---
*** Now shows image information in the header line.
This replaces the message shown at the bottom of the screen.
+++
*** 'image-dired-show-all-from-dir-max-files' has been increased to 500.
This option controls asking for confirmation when starting Image-Dired

View file

@ -635,7 +635,9 @@ This works like 'C-u M-x apropos-command' but is more discoverable.
*** Keybindings in 'help-mode' use the new 'help-key-binding' face.
This face is added by 'substitute-command-keys' to any "\[command]"
substitution. The return value of that function should consequently
be assumed to be a propertized string.
be assumed to be a propertized string. To prevent the function from
adding the 'help-key-binding' face, call 'substitute-command-keys'
with the new optional argument NO-FACE non-nil.
Note that the new face will also be used in tooltips. When using the
GTK toolkit, this is only true if 'x-gtk-use-system-tooltips' is t.
@ -3273,11 +3275,11 @@ The user option 'repeat-exit-timeout' (default nil, which means
forever) specifies the number of seconds of idle time after which to
break the repetition chain automatically.
When user option 'repeat-keep-prefix' is non-nil (the default), the
prefix arg of the previous command is kept. This can be used to
e.g. reverse the window navigation direction with 'C-x o M-- o o' or
to set a new step with 'C-x { C-5 { { {', which will set the window
resizing step to 5 columns.
When user option 'repeat-keep-prefix' is non-nil, the prefix arg of
the previous command is kept. This can be used to e.g. reverse the
window navigation direction with 'C-x o M-- o o' or to set a new step
with 'C-x { C-5 { { {', which will set the window resizing step to 5
columns.
'M-x describe-repeat-maps' will display a buffer showing
which commands are repeatable in 'repeat-mode'.

View file

@ -1723,7 +1723,8 @@ COMMAND is a command to run, ECHO is the help-echo text, KEY
is COMMAND's keybinding, STRING describes the binding."
(propertize (or key
(substitute-command-keys
(format "\\<calendar-mode-map>\\[%s] %s" command string)))
(format "\\<calendar-mode-map>\\[%s] %s" command string)
'hands-off-my-face))
'help-echo (format "mouse-1: %s" echo)
'mouse-face 'mode-line-highlight
'keymap (make-mode-line-mouse-map 'mouse-1 command)))

View file

@ -1076,11 +1076,12 @@ strings done by `substitute-command-keys'."
:version "29.1"
:group 'help)
(defun substitute-command-keys (string)
(defun substitute-command-keys (string &optional no-face)
"Substitute key descriptions for command names in STRING.
Each substring of the form \\\\=[COMMAND] is replaced by either a
keystroke sequence that invokes COMMAND, or \"M-x COMMAND\" if COMMAND
is not on any keys. Keybindings will use the face `help-key-binding'.
is not on any keys. Keybindings will use the face `help-key-binding',
unless the optional argument NO-FACE is non-nil.
Each substring of the form \\\\=`KEYBINDING' will be replaced by
KEYBINDING and use the `help-key-binding' face.
@ -1177,21 +1178,27 @@ Otherwise, return a new string."
(let ((op (point)))
(insert "M-x ")
(goto-char (+ end-point 3))
(add-text-properties op (point)
'( face help-key-binding
font-lock-face help-key-binding))
(or no-face
(add-text-properties
op (point)
'( face help-key-binding
font-lock-face help-key-binding)))
(delete-char 1))
;; Function is on a key.
(delete-char (- end-point (point)))
(let ((key (help--key-description-fontified key)))
(insert (if (and help-link-key-to-documentation
help-buffer-under-preparation
(functionp fun))
;; The `fboundp' fixes bootstrap.
(if (fboundp 'help-mode--add-function-link)
(help-mode--add-function-link key fun)
key)
key))))))
(insert
(if no-face
(key-description key)
(let ((key (help--key-description-fontified key)))
(if (and help-link-key-to-documentation
help-buffer-under-preparation
(functionp fun))
;; The `fboundp' fixes bootstrap.
(if (fboundp 'help-mode--add-function-link)
(help-mode--add-function-link key fun)
key)
key)))))))
;; 1D. \{foo} is replaced with a summary of the keymap
;; (symbol-value foo).
;; \<foo> just sets the keymap used for \[cmd].

View file

@ -1282,7 +1282,7 @@ but the other way around."
(when found
(if (setq window (image-dired-thumbnail-window))
(set-window-point window (point)))
(image-dired-display-thumb-properties))))))
(image-dired-update-header-line))))))
(defun image-dired-dired-next-line (&optional arg)
"Call `dired-next-line', then track thumbnail.
@ -1309,7 +1309,7 @@ With prefix argument, move ARG lines."
(when (and (equal (current-buffer) old-buf)
(= (point) old-point))
(ignore-errors
(image-dired-display-thumb-properties))))))
(image-dired-update-header-line))))))
(defun image-dired-forward-image (&optional arg wrap-around)
"Move to next image and display properties.
@ -1332,13 +1332,13 @@ point is on the last image, move to the last one and vice versa."
(setq pos (point))
(image-dired-image-at-point-p)))
(progn (goto-char pos)
(image-dired-display-thumb-properties))
(image-dired-update-header-line))
(if wrap-around
(progn (goto-char (if (> arg 0)
(point-min)
;; There are two spaces after the last image.
(- (point-max) 2)))
(image-dired-display-thumb-properties))
(image-dired-update-header-line))
(message "At %s image" (if (> arg 0) "last" "first"))
(run-at-time 1 nil (image-dired--display-thumb-properties-fun))))))
(when image-dired-track-movement
@ -1363,7 +1363,7 @@ On reaching end or beginning of buffer, stop and show a message."
(image-dired-backward-image))
(if image-dired-track-movement
(image-dired-track-original-file))
(image-dired-display-thumb-properties))
(image-dired-update-header-line))
(defun image-dired-previous-line ()
@ -1380,7 +1380,7 @@ On reaching end or beginning of buffer, stop and show a message."
(image-dired-backward-image))
(if image-dired-track-movement
(image-dired-track-original-file))
(image-dired-display-thumb-properties))
(image-dired-update-header-line))
(defun image-dired-beginning-of-buffer ()
"Move to the first image in the buffer and display properties."
@ -1391,7 +1391,7 @@ On reaching end or beginning of buffer, stop and show a message."
(forward-char 1))
(when image-dired-track-movement
(image-dired-track-original-file))
(image-dired-display-thumb-properties))
(image-dired-update-header-line))
(defun image-dired-end-of-buffer ()
"Move to the last image in the buffer and display properties."
@ -1402,7 +1402,7 @@ On reaching end or beginning of buffer, stop and show a message."
(forward-char -1))
(when image-dired-track-movement
(image-dired-track-original-file))
(image-dired-display-thumb-properties))
(image-dired-update-header-line))
(defun image-dired-format-properties-string (buf file props comment)
"Format display properties.
@ -1417,21 +1417,23 @@ comment."
(cons ?t (or props ""))
(cons ?c (or comment "")))))
(defun image-dired-display-thumb-properties ()
"Display thumbnail properties in the echo area."
(if (not (eobp))
(let ((file-name (file-name-nondirectory (image-dired-original-file-name)))
(dired-buf (buffer-name (image-dired-associated-dired-buffer)))
(props (mapconcat #'identity (get-text-property (point) 'tags) ", "))
(comment (get-text-property (point) 'comment))
(message-log-max nil))
(if file-name
(message "%s"
(image-dired-format-properties-string
dired-buf
file-name
props
comment))))))
(defun image-dired-update-header-line ()
"Update image information in the header line."
(when (and (not (eobp))
(memq major-mode '(image-dired-thumbnail-mode
image-dired-display-image-mode)))
(let ((file-name (file-name-nondirectory (image-dired-original-file-name)))
(dired-buf (buffer-name (image-dired-associated-dired-buffer)))
(props (mapconcat #'identity (get-text-property (point) 'tags) ", "))
(comment (get-text-property (point) 'comment))
(message-log-max nil))
(if file-name
(setq header-line-format
(image-dired-format-properties-string
dired-buf
file-name
props
comment))))))
(defun image-dired-dired-file-marked-p (&optional marker)
"In Dired, return t if file on current line is marked.
@ -2231,7 +2233,7 @@ FILE-COMMENTS is an alist on the following form:
(comment (image-dired-read-comment file)))
(image-dired-write-comments (list (cons file comment)))
(image-dired-update-property 'comment comment))
(image-dired-display-thumb-properties))
(image-dired-update-header-line))
(defun image-dired-read-comment (&optional file)
"Read comment for an image.
@ -2324,7 +2326,7 @@ non-nil."
(image-dired-backward-image))
(if image-dired-track-movement
(image-dired-track-original-file))
(image-dired-display-thumb-properties))
(image-dired-update-header-line))
@ -3015,6 +3017,11 @@ Dired."
(cons (list tag file) (cdr image-dired-tag-file-list))))
(setq image-dired-tag-file-list (list (list tag file))))))
(defun image-dired-display-thumb-properties ()
"Display thumbnail properties in the echo area."
(declare (obsolete image-dired-update-header-line "29.1"))
(image-dired-update-header-line))
(defvar image-dired-slideshow-count 0
"Keeping track on number of images in slideshow.")
(make-obsolete-variable 'image-dired-slideshow-count "no longer used." "29.1")

View file

@ -748,7 +748,7 @@ To get complete usage, invoke \"emacs -batch -f batch-titdic-convert -h\"."
[Q ] [W ] [E ] [R ] [T 廿] [Y ] [U ] [I ] [O ] [P ]
[A ] [S ] [D ] [F ] [G ] [H ] [J ] [L ]
[A ] [S ] [D ] [F ] [G ] [H ] [J ] [K ] [L ]
[Z ] [X ] [C ] [V ] [B ] [N ] [M ]

View file

@ -49,8 +49,6 @@
;; an open connection. Examples: "scripts" keeps shell script
;; definitions already sent to the remote shell, "last-cmd-time" is
;; the time stamp a command has been sent to the remote process.
;; "lock-pid" is the timestamp a (network) process is created, it is
;; used instead of the pid in file locks.
;;
;; - The key is nil. These are temporary properties related to the
;; local machine. Examples: "parse-passwd" and "parse-group" keep

View file

@ -2125,9 +2125,6 @@ connection if a previous connection has died for some reason."
(process-put p 'vector vec)
(set-process-query-on-exit-flag p nil)
;; Mark process for filelock.
(tramp-set-connection-property p "lock-pid" (truncate (time-to-seconds)))
;; Set connection-local variables.
(tramp-set-connection-local-variables vec)))

View file

@ -368,10 +368,6 @@ connection if a previous connection has died for some reason."
(process-put p 'vector vec)
(set-process-query-on-exit-flag p nil)
;; Mark process for filelock.
(tramp-set-connection-property
p "lock-pid" (truncate (time-to-seconds)))
;; Set connection-local variables.
(tramp-set-connection-local-variables vec)))

View file

@ -345,9 +345,6 @@ connection if a previous connection has died for some reason."
(process-put p 'vector vec)
(set-process-query-on-exit-flag p nil)
;; Mark process for filelock.
(tramp-set-connection-property p "lock-pid" (truncate (time-to-seconds)))
;; Set connection-local variables.
(tramp-set-connection-local-variables vec)))

View file

@ -336,7 +336,7 @@ absolute file names."
(if (and delete-by-moving-to-trash trash)
(move-file-to-trash filename)
(unless (tramp-sudoedit-send-command
v "rm" (tramp-compat-file-name-unquote localname))
v "rm" "-f" (tramp-compat-file-name-unquote localname))
;; Propagate the error.
(with-current-buffer (tramp-get-connection-buffer v)
(goto-char (point-min))
@ -788,9 +788,6 @@ connection if a previous connection has died for some reason."
(process-put p 'vector vec)
(set-process-query-on-exit-flag p nil)
;; Mark process for filelock.
(tramp-set-connection-property p "lock-pid" (truncate (time-to-seconds)))
;; Set connection-local variables.
(tramp-set-connection-local-variables vec)

View file

@ -2233,10 +2233,14 @@ the resulting error message."
(defun tramp-test-message (fmt-string &rest arguments)
"Emit a Tramp message according `default-directory'."
(if (tramp-tramp-file-p default-directory)
(apply #'tramp-message
(tramp-dissect-file-name default-directory) 0 fmt-string arguments)
(apply #'message fmt-string arguments)))
(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)
@ -3958,16 +3962,19 @@ Return nil when there is no lockfile."
(insert-file-contents-literally lockname)
(buffer-string))))))
(defvar tramp-lock-pid nil
"A random nunber local for every connection.
Do not set it manually, it is used buffer-local in `tramp-get-lock-pid'")
(defun tramp-get-lock-pid (file)
"Determine pid for lockfile of FILE."
;; Some Tramp methods do not offer a connection process, but just a
;; network process as a place holder. Those processes use the
;; "lock-pid" connection property as fake pid, in fact it is the
;; time stamp the process is created.
(let ((p (tramp-get-process (tramp-dissect-file-name file))))
(number-to-string
(or (process-id p)
(tramp-get-connection-property p "lock-pid" (emacs-pid))))))
;; Not all Tramp methods use an own process. So we use a random
;; number, which is as good as a process id.
(with-current-buffer
(tramp-get-connection-buffer (tramp-dissect-file-name file))
(or tramp-lock-pid
(setq-local
tramp-lock-pid (number-to-string (random most-positive-fixnum))))))
(defconst tramp-lock-file-info-regexp
;; USER@HOST.PID[:BOOT_TIME]

View file

@ -153,6 +153,12 @@ Nil means to not interpolate such scrolls."
:type 'float
:version "29.1")
(defcustom pixel-scroll-precision-interpolation-between-scroll 0.001
"The number of seconds between each step of an interpolated scroll."
:group 'mouse
:type 'float
:version "29.1")
(defun pixel-scroll-in-rush-p ()
"Return non-nil if next scroll should be non-smooth.
When scrolling request is delivered soon after the previous one,
@ -400,7 +406,9 @@ window, and the pixel height of that line."
(if (bobp)
(point-min)
(vertical-motion -1)
(setq line-height (line-pixel-height))
(setq line-height
(cdr (window-text-pixel-size nil (point)
pos0)))
(point)))))
;; restore initial position
(set-window-start nil pos0 t)
@ -430,7 +438,10 @@ the height of the current window."
(window-header-line-height))))
(object (posn-object desired-pos))
(desired-start (posn-point desired-pos))
(desired-vscroll (cdr (posn-object-x-y desired-pos)))
(scroll-area-total-height (cdr (window-text-pixel-size nil
(window-start)
(1- desired-start))))
(desired-vscroll (- delta scroll-area-total-height))
(edges (window-edges nil t))
(usable-height (- (nth 3 edges)
(nth 1 edges)))
@ -453,6 +464,14 @@ the height of the current window."
(set-window-vscroll nil (+ (window-vscroll nil t)
delta)
t)
(when (and (or (< (point) next-pos))
(let ((pos-visibility (pos-visible-in-window-p next-pos nil t)))
(and pos-visibility
(or (eq (length pos-visibility) 2)
(when-let* ((posn (posn-at-point next-pos)))
(> (cdr (posn-object-width-height posn))
usable-height))))))
(goto-char next-pos))
(set-window-start nil (if (zerop (window-hscroll))
desired-start
(save-excursion
@ -460,15 +479,7 @@ the height of the current window."
(beginning-of-visual-line)
(point)))
t)
(set-window-vscroll nil desired-vscroll t))
(if (and (or (< (point) next-pos))
(let ((pos-visibility (pos-visible-in-window-p next-pos nil t)))
(and pos-visibility
(or (eq (length pos-visibility) 2)
(when-let* ((posn (posn-at-point next-pos)))
(> (cdr (posn-object-width-height posn))
usable-height))))))
(goto-char next-pos))))
(set-window-vscroll nil desired-vscroll t))))
(defun pixel-scroll-precision-scroll-down (delta)
"Scroll the current window down by DELTA pixels."
@ -521,21 +532,7 @@ the height of the current window."
(goto-char (car position)))
(setq delta (- delta (cdr position)))))
(when (< delta 0)
(if-let* ((desired-pos (posn-at-x-y 0 (+ (- delta)
(window-tab-line-height)
(window-header-line-height))))
(desired-start (posn-point desired-pos))
(desired-vscroll (cdr (posn-object-x-y desired-pos))))
(progn
(set-window-start nil (if (zerop (window-hscroll))
desired-start
(save-excursion
(goto-char desired-start)
(beginning-of-visual-line)
(point)))
t)
(set-window-vscroll nil desired-vscroll t))
(set-window-vscroll nil (abs delta) t)))))))
(set-window-vscroll nil (- delta) t))))))
(defun pixel-scroll-precision-interpolate (delta)
"Interpolate a scroll of DELTA pixels.
@ -546,7 +543,7 @@ animation."
(factor pixel-scroll-precision-interpolation-factor)
(last-time (float-time))
(time-elapsed 0.0)
(between-scroll 0.001)
(between-scroll pixel-scroll-precision-interpolation-between-scroll)
(rem (window-parameter nil 'interpolated-scroll-remainder))
(time (window-parameter nil 'interpolated-scroll-remainder-time)))
(when (and rem time

View file

@ -203,7 +203,7 @@ by `grep-compute-defaults'; to change the default value, use
:version "22.1")
(defcustom grep-files-aliases
'(("all" . "* .[!.]* ..?*") ;; Don't match `..'. See bug#22577
'(("all" . "* .*")
("el" . "*.el")
("ch" . "*.[ch]")
("c" . "*.c")

View file

@ -18082,13 +18082,14 @@ compute_window_start_on_continuation_line (struct window *w)
row, DEFAULT_FACE_ID);
reseat_at_previous_visible_line_start (&it);
/* If the line start is "too far" away from the window start,
say it takes too much time to compute a new window start.
Also, give up if the line start is after point, as in that
case point will not be visible with any window start we
/* Give up (by not using the code in the block below) and say it
takes too much time to compute a new window start, if the
line start is "too far" away from the window start. Also,
give up if the line start is after point, as in that case
point will not be visible with any window start we
compute. */
if (IT_CHARPOS (it) <= PT
|| (CHARPOS (start_pos) - IT_CHARPOS (it)
&& (CHARPOS (start_pos) - IT_CHARPOS (it)
/* PXW: Do we need upper bounds here? */
< WINDOW_TOTAL_LINES (w) * WINDOW_TOTAL_COLS (w)))
{

View file

@ -239,8 +239,7 @@ is greater than 10.
(unwind-protect
(progn ,@body)
(tramp--test-message
"%s %f sec"
,message (float-time (time-subtract nil start))))))
"%s %f sec" ,message (float-time (time-subtract nil start))))))
;; `always' is introduced with Emacs 28.1.
(defalias 'tramp--test-always
@ -2291,7 +2290,7 @@ This checks also `file-name-as-directory', `file-name-directory',
"Check that Tramp abbreviates file names correctly."
(skip-unless (tramp--test-enabled))
(skip-unless (tramp--test-emacs29-p))
(skip-unless (tramp--test-ange-ftp-p))
(skip-unless (not (tramp--test-ange-ftp-p)))
(let* ((remote-host (file-remote-p tramp-test-temporary-file-directory))
;; Not all methods can expand "~".