Merge from origin/emacs-31

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...

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
 

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}.

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))))))

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
+  (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'?

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
+   ((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
+`file' (the default), `default-directory', `process', `tramp-file-name',
-symbol.  It describes the type of the OPERATION argument to be checked.
+or a function symbol.  It describes the type of the OPERATION argument
-See the docstring of `tramp-file-name-for-operation-external' for its
+to be checked.  See the docstring of
-meaning."
+`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
+	    (tramp-compat-funcall 'directory-abbrev-apply
-	     '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-compat-funcall 'tramp-send-command
-		       '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-compat-funcall 'tramp-ssh-controlmaster-options v)))
-		  'tramp-ssh-controlmaster-options v)))
 	   (device
 	    (when adb-file-name-handler-p
-	      (tramp-compat-funcall
+	      (tramp-compat-funcall 'tramp-adb-get-device v)))
-		  '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-compat-funcall 'tramp-send-command
-	 '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
+      (if (tramp-compat-funcall 'tramp-send-command-and-check
-           'tramp-send-command-and-check
             vec (format "\\kill -%s %d" sigcode pid))
           0 -1))))
 

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
   "<return>"    #'markdown-ts-table-next-row
   "S-<return>"  #'markdown-ts-table-previous-row

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))
+  (let ((fname-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)))
+      (vc-call-backend vc-dir-backend 'registered fname))
-	 (state (vc-call-backend vc-dir-backend 'state 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)))
+                                   'status-fileinfo-extra fname-short)))
-    (list file-short state extra)))
+      ;; 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)))

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;
     }
 

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)

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
+              (let ((data (ewoc-data (ewoc-nth vc-ewoc 1))))
-                              (ewoc-data
+                (should (equal (vc-dir-fileinfo->name data)
-                               (ewoc-nth vc-ewoc 1)))
+                               (file-name-nondirectory file)))
-                             (file-name-nondirectory file))))))))))
+                (should (equal (vc-dir-fileinfo->state data)
+                               'edited))))))))))
 
 (provide 'vc-test-misc)
 ;;; vc-test-misc.el ends here