diff --git a/Makefile.in b/Makefile.in index 87a1a633cc5..c0b9803ec21 100644 --- a/Makefile.in +++ b/Makefile.in @@ -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 diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi index 6daa2b010cf..7bee92a94d5 100644 --- a/doc/misc/tramp.texi +++ b/doc/misc/tramp.texi @@ -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}. diff --git a/lisp/help-fns.el b/lisp/help-fns.el index b7292eafb8a..af5a64f9e9c 100644 --- a/lisp/help-fns.el +++ b/lisp/help-fns.el @@ -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)))))) diff --git a/lisp/mouse.el b/lisp/mouse.el index 1ff79e3833e..b6f167d8d87 100644 --- a/lisp/mouse.el +++ b/lisp/mouse.el @@ -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 - (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 [follow-link] nil t pos))))) + (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) + (when area + (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'? diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 75a8eb16621..87ec55def37 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -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 - '(tramp-get-home-directory tramp-get-remote-gid - tramp-get-remote-groups tramp-get-remote-uid)) - (tramp-make-tramp-file-name (nth 0 args))) + ((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,9 +4291,8 @@ Let-bind it when necessary.") (tramp-get-connection-property vec "~")))) (when home-dir (setq home-dir - (tramp-compat-funcall - 'directory-abbrev-apply - (tramp-make-tramp-file-name vec home-dir)))) + (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. (setq filename (tramp-compat-funcall 'directory-abbrev-apply filename)) @@ -4864,22 +4890,21 @@ 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 - v - (cond - ((and beg end) - (format "dd bs=1 skip=%d if=%s count=%d of=%s" - beg (tramp-shell-quote-argument localname) - (- end beg) remote-copy)) - (beg - (format "dd bs=1 skip=%d if=%s of=%s" - beg (tramp-shell-quote-argument localname) - remote-copy)) - (end - (format "dd bs=1 count=%d if=%s of=%s" - end (tramp-shell-quote-argument localname) - remote-copy)))) + (tramp-compat-funcall 'tramp-send-command + v + (cond + ((and beg end) + (format "dd bs=1 skip=%d if=%s count=%d of=%s" + beg (tramp-shell-quote-argument localname) + (- end beg) remote-copy)) + (beg + (format "dd bs=1 skip=%d if=%s of=%s" + beg (tramp-shell-quote-argument localname) + remote-copy)) + (end + (format "dd bs=1 count=%d if=%s of=%s" + end (tramp-shell-quote-argument localname) + remote-copy)))) (setq tramp-temp-buffer-file-name nil beg nil end nil)) ;; `insert-file-contents-literally' takes care to @@ -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,13 +7498,12 @@ 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 - (process-get proc 'tramp-vector) - (format "(\\kill -2 -%d || \\kill -2 %d) 2>%s" - pid pid - (tramp-get-remote-null-device - (process-get proc 'tramp-vector)))) + (tramp-compat-funcall 'tramp-send-command + (process-get proc 'tramp-vector) + (format "(\\kill -2 -%d || \\kill -2 %d) 2>%s" + pid pid + (tramp-get-remote-null-device + (process-get proc 'tramp-vector)))) ;; Wait, until the process has disappeared. If it doesn't, ;; fall back to the default implementation. (while (tramp-accept-process-output proc)) @@ -7531,9 +7553,8 @@ 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 - vec (format "\\kill -%s %d" sigcode pid)) + (if (tramp-compat-funcall 'tramp-send-command-and-check + vec (format "\\kill -%s %d" sigcode pid)) 0 -1)))) ;; `signal-process-functions' exists since Emacs 29.1. diff --git a/lisp/textmodes/markdown-ts-mode.el b/lisp/textmodes/markdown-ts-mode.el index ff889efa49b..703909fdc63 100644 --- a/lisp/textmodes/markdown-ts-mode.el +++ b/lisp/textmodes/markdown-ts-mode.el @@ -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 "" #'markdown-ts-table-next-row "S-" #'markdown-ts-table-previous-row diff --git a/lisp/vc/vc-dir.el b/lisp/vc/vc-dir.el index d179ed25009..a7c6dc9eb01 100644 --- a/lisp/vc/vc-dir.el +++ b/lisp/vc/vc-dir.el @@ -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 - (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)) - (extra (vc-call-backend vc-dir-backend - 'status-fileinfo-extra fname))) - (list file-short state extra))) + (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)) + (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-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))) diff --git a/src/xdisp.c b/src/xdisp.c index 7a2f1187152..67fe2295dc2 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -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; } diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 3577388aa62..0aaf7d36dfa 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -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) diff --git a/test/lisp/vc/vc-tests/vc-test-misc.el b/test/lisp/vc/vc-tests/vc-test-misc.el index bb2ee8af1f7..066c49df324 100644 --- a/test/lisp/vc/vc-tests/vc-test-misc.el +++ b/test/lisp/vc/vc-tests/vc-test-misc.el @@ -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