Github/emacs
2
0
Fork 1
mirror of git://git.sv.gnu.org/emacs.git synced 2026-06-14 04:21:24 +00:00
Code Issues Projects Releases Packages Wiki Activity

Merge from origin/emacs-31

Browse source 
f89ff62367 Extend Tramp external operations
4dea6ea36b markdown-ts-mode: fix duplicated menu entries (bug#81201)
9cad2da66e ; Fix last change.
cd84bd6a0c vc-dir-recompute-file-state: Change directory to DEF-DIR
47bdbc8d85 Restore "interactive" when describing functions
1a5d9a4be3 Inhibit follow-link via `mouse-1' on the tab-bar (bug#81036)
c94d58ddbf Fix the tab close button appearance when clicking (bug#76...
a21614d4d6 ; Skip one vc-dir test on MS-Windows
abddd2075a ; Fix last change to vc-dir-recompute-file-state.
89bda8736a Install images with info documentation (bug#81204)
466789b511 vc-dir-recompute-file-state: Return nil state for nonexis...
This commit is contained in:
Sean Whitton 2026-06-11 16:12:15 +01:00
commit f836632aee
10 changed files with 187 additions and 75 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
Makefile.in
View file

@ -808,7 +808,7 @@ install-info: info
done; \
(cd "$${thisdir}"; \
${INSTALL_INFO} --info-dir="$(DESTDIR)${infodir}" "$(DESTDIR)${infodir}/$$elt"); \
cp elisp_type_hierarchy* $(DESTDIR)${infodir}/; \
cp *.jpg *.png $(DESTDIR)${infodir}/; \
done; \
fi

26
doc/misc/tramp.texi
View file

@ -6973,7 +6973,7 @@ If the same @var{function} shall be used for different @value{tramp}
backends, @code{tramp-add-external-operation} must be called for every
backend, respectively.
The optional argument @var{arg-type} specisfies, which argument of
The optional argument @var{arg-type} specifies, which argument of
@var{operation} shall be used in order to determine, whether the
handler @var{function} should be called. It can be
@ -6988,6 +6988,10 @@ checked. This is the default, if @var{arg-type} is @code{nil}.
@item @code{process}@*
@code{default-directory} of the process buffer of the first argument
of @var{operation}, a process, is the remote file name to be checked.
@item @code{tramp-file-name}@*
The @code{tramp-file-name} structure of the first argument of
@var{operation} is the remote file name to be checked.
@end itemize
If the first argument of @var{operation} is nil,
@ -7015,6 +7019,26 @@ The example above could be changed like this:
@end lisp
@end defun
@defun tramp-external-operation-p operation backend
This checks, whether @value{tramp}'s backend @var{backend} supports
external @var{operation}. It returns the function registered as
handler, or @code{nil}. Example:
@lisp
@group
(tramp-external-operation-p
#'my-test-operation 'tramp-sh)
@result{} my-handle-test-operation
@end group
@group
(tramp-external-operation-p
#'my-test-operation 'tramp-gvfs)
@result{} nil
@end group
@end lisp
@end defun
@defun tramp-remove-external-operation operation backend
The handler for @var{operation}, added by
@code{tramp-add-external-operation}, is removed from @var{backend}.

3
lisp/help-fns.el
View file

@ -1184,7 +1184,8 @@ Returns a list of the form (REAL-FUNCTION DEF ALIASED REAL-DEF)."
;; FIXME: If someday Emacs has a function type symbol
;; like `unicode-function' or `hour-function', this
;; will produce an ungrammatical string (bug#79469).
(concat (if (string-match-p "\\`[aeiou]" (symbol-name type))
(concat (if (and (equal beg "a ")
(string-match-p "\\`[aeiou]" typ-str))
"an "
beg)
typ-str))))))

16
lisp/mouse.el
View file

@ -1864,18 +1864,26 @@ click is the local or global binding of that event.
- Otherwise, the mouse-1 event is translated into a mouse-2 event
at the same position."
(let ((action
(let* ((area (and (consp pos) (posn-area pos)))
(action
(and (or (not (consp pos))
mouse-1-click-in-non-selected-windows
(eq (selected-window) (posn-window pos)))
(or (mouse-posn-property pos 'follow-link)
(let ((area (posn-area pos)))
(when area
(key-binding (vector area 'follow-link) nil t pos)))
(key-binding (vector area 'follow-link) nil t pos))
(key-binding [follow-link] nil t pos)))))
(cond
((eq action 'mouse-face)
(and (mouse-posn-property pos 'mouse-face) t))
;; Inhibit follow-link when `mouse-1' is clicked on the tab-bar to
;; prevent misdirected clicks in `dired-mode'. This does not prevent
;; remapping `mouse-1' to `mouse-2' on the tab-bar. See bug#49247
;; bug#81036.
;; FIXME: The tab-bar is not associated with a buffer so a better fix
;; might be not to honor the current buffer's keymap when considering
;; tab-bar mouse clicks,
(and (not (eq area 'tab-bar))
(mouse-posn-property pos 'mouse-face) t))
((functionp action)
;; FIXME: This seems questionable if the click is not in a buffer.
;; Should we instead decide that `action' takes a `posn'?

57
lisp/net/tramp.el
View file

@ -2447,6 +2447,8 @@ symbol
checked.
- `process': `default-directory' of the process buffer of the first
argument of OPERATION is the remote file name to be checked.
- `tramp-file-name': the first argument of OPERATION, a
`tramp-file-name' structure, is the remote file name to be checked.
If the first argument of OPERATION is nil, `default-directory' is the
remote file name to be checked in case of `file' and `process'.
@ -2500,8 +2502,10 @@ Must be handled by the callers."
(if (and (stringp (nth 0 args)) (file-name-absolute-p (nth 0 args)))
(nth 0 args)
default-directory))
;; STRING FILE.
((eq operation 'make-symbolic-link) (nth 1 args))
;; FILE DIRECTORY resp FILE1 FILE2.
((memq operation
'(add-name-to-file copy-directory copy-file
@ -2512,23 +2516,27 @@ Must be handled by the callers."
((tramp-tramp-file-p (nth 0 args)) (nth 0 args))
((file-name-absolute-p (nth 1 args)) (nth 1 args))
(t default-directory)))
;; FILE DIRECTORY resp FILE1 FILE2.
((eq operation 'expand-file-name)
(cond
((file-name-absolute-p (nth 0 args)) (nth 0 args))
((tramp-tramp-file-p (nth 1 args)) (nth 1 args))
(t default-directory)))
;; START END FILE.
((eq operation 'write-region)
(if (file-name-absolute-p (nth 2 args))
(nth 2 args)
default-directory))
;; BUFFER.
((memq operation
'(make-auto-save-file-name
set-visited-file-modtime verify-visited-file-modtime))
(buffer-file-name
(if (bufferp (nth 0 args)) (nth 0 args) (current-buffer))))
;; COMMAND.
((or
(memq operation
@ -2541,6 +2549,7 @@ Must be handled by the callers."
(eq (alist-get operation tramp-file-name-for-operation-external)
'default-directory))
default-directory)
;; PROC or BUFFER.
((or
(memq operation '(file-notify-rm-watch file-notify-valid-p))
@ -2557,16 +2566,25 @@ Must be handled by the callers."
(or (get-process (nth 0 args)) (get-buffer (nth 0 args)))))))
(tramp-get-default-directory buf))
""))
;; VEC.
((memq operation
((or
(memq operation
'(tramp-get-home-directory tramp-get-remote-gid
tramp-get-remote-groups tramp-get-remote-uid))
(eq (alist-get operation tramp-file-name-for-operation-external)
'tramp-file-name))
(or
(and (tramp-file-name-p (nth 0 args))
(tramp-make-tramp-file-name (nth 0 args)))
""))
;; A function.
((functionp (alist-get operation tramp-file-name-for-operation-external))
(apply
(alist-get operation tramp-file-name-for-operation-external)
operation args))
;; Unknown file primitive.
(t (unless (memq 'remote-file-error debug-ignored-errors)
(tramp-error
@ -2601,17 +2619,17 @@ OPERATION must not be one of the magic operations listed in Info
node `(elisp) Magic File Names'. FUNCTION must have the same argument
list as OPERATION. BACKEND, a symbol, must be one of the Tramp backend
packages like `tramp-sh' (except `tramp-ftp'). ARG-TYPE is either
`file' (the default), `default-directory', `process' or a function
symbol. It describes the type of the OPERATION argument to be checked.
See the docstring of `tramp-file-name-for-operation-external' for its
meaning."
`file' (the default), `default-directory', `process', `tramp-file-name',
or a function symbol. It describes the type of the OPERATION argument
to be checked. See the docstring of
`tramp-file-name-for-operation-external' for its meaning."
(require backend)
(when-let* ((fnha
(intern-soft
(concat (symbol-name backend) "-file-name-handler-alist")))
((boundp fnha))
(arg-type (or arg-type 'file)))
(unless (or (memq arg-type '(file default-directory process))
(unless (or (memq arg-type '(file default-directory process tramp-file-name))
(functionp arg-type))
(tramp-error nil 'remote-file-error "Unknown arg type: %s" arg-type))
;; Make BACKEND aware of the new operation.
@ -2635,6 +2653,15 @@ meaning."
(apply orig-fun args)))
`((name . ,(concat "tramp-advice-" (symbol-name operation))))))))
(defun tramp-external-operation-p (operation backend)
"Check, whether Tramp BACKEND supports external OPERATION.
It returns the function registered as handler, or nil."
(and-let* ((fnha
(intern-soft
(concat (symbol-name backend) "-file-name-handler-alist")))
((boundp fnha))
((alist-get operation (symbol-value fnha))))))
(defun tramp-remove-external-operation (operation backend)
"Remove OPERATION from Tramp BACKEND as handler for OPERATION.
OPERATION must not be one of the magic operations listed in Info
@ -4264,8 +4291,7 @@ Let-bind it when necessary.")
(tramp-get-connection-property vec "~"))))
(when home-dir
(setq home-dir
(tramp-compat-funcall
'directory-abbrev-apply
(tramp-compat-funcall 'directory-abbrev-apply
(tramp-make-tramp-file-name vec home-dir))))
;; If any elt of `directory-abbrev-alist' matches this name,
;; abbreviate accordingly.
@ -4864,8 +4890,7 @@ existing) are returned."
(setq remote-copy (tramp-make-tramp-temp-file v))
;; This is defined in tramp-sh.el. Let's assume
;; this is loaded already.
(tramp-compat-funcall
'tramp-send-command
(tramp-compat-funcall 'tramp-send-command
v
(cond
((and beg end)
@ -5565,12 +5590,10 @@ processes."
(tramp-compat-make-temp-name))))
(options
(when sh-file-name-handler-p
(tramp-compat-funcall
'tramp-ssh-controlmaster-options v)))
(tramp-compat-funcall 'tramp-ssh-controlmaster-options v)))
(device
(when adb-file-name-handler-p
(tramp-compat-funcall
'tramp-adb-get-device v)))
(tramp-compat-funcall 'tramp-adb-get-device v)))
(pta (unless (eq connection-type 'pipe) "-t"))
login-args p)
@ -7475,8 +7498,7 @@ name of a process or buffer, or nil to default to the current buffer."
;; This is for tramp-sh.el. Other backends do not support this (yet).
;; Not all "kill" implementations support process groups by
;; negative pid, so we try both variants.
(tramp-compat-funcall
'tramp-send-command
(tramp-compat-funcall 'tramp-send-command
(process-get proc 'tramp-vector)
(format "(\\kill -2 -%d || \\kill -2 %d) 2>%s"
pid pid
@ -7531,8 +7553,7 @@ SIGCODE may be an integer, or a symbol whose name is a signal name."
(tramp-message
vec 5 "Send signal %s to process %s with pid %s" sigcode process pid)
;; This is for tramp-sh.el. Other backends do not support this (yet).
(if (tramp-compat-funcall
'tramp-send-command-and-check
(if (tramp-compat-funcall 'tramp-send-command-and-check
vec (format "\\kill -%s %d" sigcode pid))
0 -1))))

2
lisp/textmodes/markdown-ts-mode.el
View file

@ -5116,7 +5116,6 @@ On a heading, call `outline-cycle'. Otherwise do nothing."
:doc "Keymap for `markdown-ts-code-block-in-context-mode'.
These override keys in `markdown-ts-mode-map' to support executing their
commands in a code-block context."
:parent markdown-ts-mode-map
:menu nil
"M-." #'markdown-ts--code-block-xref-find-definitions
"TAB" #'indent-for-tab-command
@ -5129,7 +5128,6 @@ commands in a code-block context."
:doc "Keymap for `markdown-ts-in-table-mode'.
These override keys in `markdown-ts-mode-map' to support executing their
commands in a table context."
:parent markdown-ts-mode-map
:menu nil
"<return>" #'markdown-ts-table-next-row
"S-<return>" #'markdown-ts-table-previous-row

17
lisp/vc/vc-dir.el
View file

@ -1270,16 +1270,20 @@ that file."
(defun vc-dir-recompute-file-state (fname def-dir)
"Compute state of FNAME known to live inside DEF-DIR."
(let* ((file-short (file-relative-name fname def-dir))
(_remove-me-when-CVS-works
(let ((fname-short (file-relative-name fname def-dir)))
(when (eq vc-dir-backend 'CVS)
;; FIXME: Warning: UGLY HACK. The CVS backend caches the state
;; info, this forces the backend to update it.
(vc-call-backend vc-dir-backend 'registered fname)))
(state (vc-call-backend vc-dir-backend 'state fname))
(vc-call-backend vc-dir-backend 'registered fname))
(let* ((default-directory def-dir)
(state (vc-call-backend vc-dir-backend 'state fname-short))
(extra (vc-call-backend vc-dir-backend
'status-fileinfo-extra fname)))
(list file-short state extra)))
'status-fileinfo-extra fname-short)))
;; Ensure we return a nil state if the file does not exist and is
;; not tracked so that it disappears from VC-Dir (bug#81191).
(if (and (eq state 'up-to-date) (not (file-exists-p fname)))
(list fname-short nil nil)
(list fname-short state extra)))))
(defun vc-dir-find-child-files (dirname)
;; Give a DIRNAME string return the list of all child files shown in
@ -1338,6 +1342,7 @@ that file."
(vc-dir-resync-directory-files file)
(vc-dir--set-header ddir))
(let* ((complete-state
;; Pass two truenames (bug#80803, bug#80967).
(vc-dir-recompute-file-state file
(file-truename ddir)))
(state (cadr complete-state)))

16
src/xdisp.c
View file

@ -15321,16 +15321,24 @@ handle_tab_bar_click (struct frame *f, int x, int y, bool down_p,
if (down_p)
{
/* Show the clicked button in pressed state. */
/* Show the clicked button in pressed state, but only when
the click was on the close button. Clicking elsewhere on
the tab should not change the close button's appearance,
so just keep the ordinary mouse-face highlight. */
if (!NILP (Vmouse_highlight))
show_mouse_face (hlinfo, DRAW_IMAGE_SUNKEN, true);
show_mouse_face (hlinfo, close_p ? DRAW_IMAGE_SUNKEN : DRAW_MOUSE_FACE,
true);
f->last_tab_bar_item = prop_idx; /* record the pressed tab */
}
else
{
/* Show item in released state. */
/* Show item in released state. Only change the close button's
appearance when the click was on it. Elsewhere keep the
ordinary mouse-face highlight to avoid the close button
blinking on release. */
if (!NILP (Vmouse_highlight))
show_mouse_face (hlinfo, DRAW_IMAGE_RAISED, true);
show_mouse_face (hlinfo, close_p ? DRAW_IMAGE_RAISED : DRAW_MOUSE_FACE,
true);
f->last_tab_bar_item = -1;
}

44
test/lisp/net/tramp-tests.el
View file

@ -8920,6 +8920,9 @@ process sentinels. They shall not disturb each other."
(intern
(string-remove-suffix
"-file-name-handler" (symbol-name file-name-handler)))))
;; Cleanup.
(tramp-remove-external-operation #'tramp--test-operation backend)
(tramp-remove-external-operation #'process-id backend)
;; There is no backend specific code.
(should-not
@ -8950,6 +8953,9 @@ process sentinels. They shall not disturb each other."
;; This doesn't hurt.
(tramp-add-external-operation
#'tramp--test-operation #'tramp--handle-test-operation backend 'file)
(should
(eq #'tramp--handle-test-operation
(tramp-external-operation-p #'tramp--test-operation backend)))
;; The backend specific function is called.
(should
@ -8977,6 +8983,7 @@ process sentinels. They shall not disturb each other."
(tramp-remove-external-operation #'tramp--test-operation backend)
;; There is no backend specific code.
(should-not (tramp-external-operation-p #'tramp--test-operation backend))
(should-not
(string-equal (tramp--test-operation ert-remote-temporary-file-directory)
(tramp--handle-test-operation
@ -9004,6 +9011,9 @@ process sentinels. They shall not disturb each other."
(tramp-add-external-operation
#'tramp--test-operation #'tramp--handle-test-operation
backend 'default-directory)
(should
(eq #'tramp--handle-test-operation
(tramp-external-operation-p #'tramp--test-operation backend)))
;; The backend specific function is called.
(let ((default-directory ert-remote-temporary-file-directory))
@ -9017,6 +9027,7 @@ process sentinels. They shall not disturb each other."
(tramp-remove-external-operation #'tramp--test-operation backend)
;; There is no backend specific code.
(should-not (tramp-external-operation-p #'tramp--test-operation backend))
(let ((default-directory ert-remote-temporary-file-directory))
(should-not
(string-equal (tramp--test-operation)
@ -9048,16 +9059,48 @@ process sentinels. They shall not disturb each other."
(should (natnump (setq id (process-id proc))))
(tramp-add-external-operation
#'process-id #'tramp--handle-process-id backend 'process)
(should
(eq #'tramp--handle-process-id
(tramp-external-operation-p #'process-id backend)))
(should (= (process-id proc) (1+ id))))
;; Cleanup.
(tramp-remove-external-operation #'process-id backend)
(should-not (tramp-external-operation-p #'process-id backend))
(ignore-errors (delete-process proc)))))
;; Test `tramp-file-name' arg type.
(tramp-add-external-operation
#'tramp--test-operation #'tramp--handle-test-operation
backend 'tramp-file-name)
(should
(eq #'tramp--handle-test-operation
(tramp-external-operation-p #'tramp--test-operation backend)))
;; The backend specific function is called.
(should
(string-equal (tramp--test-operation tramp-test-vec)
(tramp--handle-test-operation tramp-test-vec)))
(let ((vec (copy-tramp-file-name tramp-test-vec)))
(setf (tramp-file-name-method vec) (if (tramp--test-sh-p) "sftp" "sudo"))
(should-not
(string-equal (tramp--test-operation vec)
(tramp--handle-test-operation vec))))
(tramp-remove-external-operation #'tramp--test-operation backend)
;; There is no backend specific code.
(should-not (tramp-external-operation-p #'tramp--test-operation backend))
(should-not
(string-equal (tramp--test-operation tramp-test-vec)
(tramp--handle-test-operation tramp-test-vec)))
;; Test function arg type.
(tramp-add-external-operation
#'tramp--test-operation #'tramp--handle-test-operation
backend #'tramp--test-operation-file-name-for-operation)
(should
(eq #'tramp--handle-test-operation
(tramp-external-operation-p #'tramp--test-operation backend)))
;; The backend specific function is called.
(let ((default-directory ert-remote-temporary-file-directory))
@ -9071,6 +9114,7 @@ process sentinels. They shall not disturb each other."
(tramp-remove-external-operation #'tramp--test-operation backend)
;; There is no backend specific code.
(should-not (tramp-external-operation-p #'tramp--test-operation backend))
(let ((default-directory ert-remote-temporary-file-directory))
(should-not
(string-equal (tramp--test-operation)

11
test/lisp/vc/vc-tests/vc-test-misc.el
View file

@ -253,6 +253,8 @@
(ert-deftest vc-test-vc-dir-on-symlink ()
"Test VC-Dir on a symlink to a repository.
See bug#80803 and bug#80967."
;; Git for Windows could fail in a symlinked tree.
(skip-when (eq system-type 'windows-nt))
(skip-unless (executable-find vc-git-program))
(vc-test--with-author-identity 'Git
(let ((vc-handled-backends '(Git)))
@ -290,10 +292,11 @@ See bug#80803 and bug#80967."
(basic-save-buffer))
(dolist (buf (list truename-dir symlink-dir))
(with-current-buffer buf
(should (equal (vc-dir-fileinfo->name
(ewoc-data
(ewoc-nth vc-ewoc 1)))
(file-name-nondirectory file))))))))))
(let ((data (ewoc-data (ewoc-nth vc-ewoc 1))))
(should (equal (vc-dir-fileinfo->name data)
(file-name-nondirectory file)))
(should (equal (vc-dir-fileinfo->state data)
'edited))))))))))
(provide 'vc-test-misc)
;;; vc-test-misc.el ends here