Re: [GNU ELPA] New package: tramp-locproc

["Björn Bidar" <bjorn.bidar@thaodan.de>]

Michael Albinus <michael.albinus@gmx.de> writes:

> Hi,
>
> I would like to submit a new package to GNU ELPA: tramp-locproc.
>

Why not make this a opt-in tramp-module? I wonder if a longer name would
be better as it does speak better for it self. Why not tramp-local-process?

>
> Beside the obvious advantage to run local processes over remote files,
> there is also the disadvantage that file names are adapted in order to
> reflect their local mount location.

When displayed in Emacs or for the processes executed? 

> Therefore, I would appreciate to get feedback, whether people find this
> useful.
>
> Thanks, and best regards, Michael.
>
> ;;; tramp-locproc.el --- Tramp local processes for FUSE mounts  -*- lexical-binding:t -*-
>
> ;; Copyright (C) 2025 Free Software Foundation, Inc.
>
> ;; Author: Michael Albinus <michael.albinus@gmx.de>
> ;; Keywords: comm, processes
> ;; Package: tramp-locproc
> ;; Version: 0
> ;; Package-Requires: ((tramp "2.7.2"))
>
> ;; This file is not part of GNU Emacs.
>
> ;; This program is free software: you can redistribute it and/or modify
> ;; it under the terms of the GNU General Public License as published by
> ;; the Free Software Foundation, either version 3 of the License, or
> ;; (at your option) any later version.
>
> ;; This program is distributed in the hope that it will be useful,
> ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
> ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
> ;; GNU General Public License for more details.
>
> ;; You should have received a copy of the GNU General Public License
> ;; along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.
>
> ;;; Commentary:
>
> ;; This package adds process support for "sshfs", "rclone" and all
> ;; methods defined in `tramp-gvfs-methods'.  It overwrites the remote
> ;; process support in "sshfs"; the other methods have no process
> ;; support otherwise.
>
> ;; A remote process runs as a local process, using the local mount
> ;; name of `default-directory'.  The program name is used literally,
> ;; after piping through `file-local-name'.  As a consequence, programs
> ;; on the local host are called, which might not exist on the remote
> ;; host.
>
> ;; Arguments of the process, which are an absolute file name, are
> ;; transformed to the respective local mount name.  That is, a file
> ;; name "/path/to/file" is located on the local host as
> ;; "/mount_point/path/to/file".  This is suppressed if user option
> ;; `tramp-locproc-extend-arguments' is nil.
>
> ;; Although not strictly remote, Tramp archive files are also
> ;; supported.  That is, a local process can run over the file system
> ;; which is defined by a file archive, see (info "(tramp) Archive file
> ;; names") .
>
> ;; If this package is unloaded via `M-x unload-feature RET tramp-locproc',
> ;; the original implementation of the different Tramp backends is restored.
>
> ;;; Code:
>
> (require 'tramp)
>
> (defvar tramp-locproc-unload-file-name-handler-alist nil
>   "Variable keeping unload information.")
>
> (defun tramp-locproc-massage-file-name-handler-alist (fnha)
>   "Adapt FNHA to the needs of `tramp-locproc'.
> FNHA is the variable symbol, collecting handler functions for a Tramp backend."
>   (let ((val (symbol-value fnha)))
>     ;; Prepare unloading.  This must be performed prior modifying FNHA.
>     (unless (assq fnha tramp-locproc-unload-file-name-handler-alist)
>       (add-to-list
>        'tramp-locproc-unload-file-name-handler-alist
>        `(,fnha
> 	 ,(copy-tree (assq 'exec-path val))
> 	 ,(copy-tree (assq 'make-process val))
> 	 ,(copy-tree (assq 'process-file val))
> 	 ,(copy-tree (assq 'shell-command val))
> 	 ,(copy-tree (assq 'start-file-process val))))
>       (add-hook
>        'tramp-locproc-unload-hook
>        (lambda ()
> 	 (dolist
> 	     (entry
> 	      (alist-get fnha tramp-locproc-unload-file-name-handler-alist))
> 	   (setcdr (assq (car entry) (symbol-value fnha)) (cdr entry))))))
>
>     ;; Replace handler functions.
>     (setcdr (assq 'exec-path val) #'tramp-locproc-handle-exec-path)
>     (setcdr (assq 'make-process val) #'tramp-locproc-handle-make-process)
>     (setcdr (assq 'process-file val) #'tramp-locproc-handle-process-file)
>     (setcdr (assq 'shell-command val) #'tramp-locproc-handle-shell-command)
>     (setcdr (assq 'start-file-process val) #'tramp-handle-start-file-process)))


You it be possible to make this a default or fallback action depending
on the users intention? E.g. by using a prefix arg to invert the
default.

The default then being either to call the command as a local process by
default or explicitly by using a prefix argument.

> ;; `tramp-archive-local-file-name' is introduced in Tramp 2.7.2.
> (with-eval-after-load 'tramp-archive
>   (when (fboundp 'tramp-archive-local-file-name)
>     (tramp-locproc-massage-file-name-handler-alist
>      'tramp-archive-file-name-handler-alist)))
>
> ;; `tramp-gvfs-local-file-name' is introduced in Tramp 2.7.2.
> (with-eval-after-load 'tramp-gvfs
>   (when (fboundp 'tramp-gvfs-local-file-name)
>     (tramp-locproc-massage-file-name-handler-alist
>      'tramp-gvfs-file-name-handler-alist)))
>
> (with-eval-after-load 'tramp-rclone
>   (tramp-locproc-massage-file-name-handler-alist
>    'tramp-rclone-file-name-handler-alist))
>
> (with-eval-after-load 'tramp-sshfs
>   (tramp-locproc-massage-file-name-handler-alist
>    'tramp-sshfs-file-name-handler-alist))
>
> (declare-function tramp-archive-local-file-name 'tramp-arechive)
> (declare-function tramp-fuse-local-file-name 'tramp-fuse)
> (declare-function tramp-gvfs-local-file-name 'tramp-gvfs)
>
> (defun tramp-locproc-local-file-name (filename)
>   "Return local mount name of remote FILENAME."
>   (funcall
>    (cond
>     ((tramp-archive-file-name-p filename) #'tramp-archive-local-file-name)
>     ((tramp-gvfs-file-name-p filename) #'tramp-gvfs-local-file-name)
>     (t #'tramp-fuse-local-file-name))
>    filename))
>
> (defun tramp-locproc-mount-point (filename)
>   "Return mount point of remote FILENAME."
>   (tramp-locproc-local-file-name
>    (funcall
>     (cond
>      ((tramp-archive-file-name-p filename)
>       (lambda (string)
> 	(file-name-as-directory (tramp-archive-file-name-archive string))))
>      (t #'file-remote-p))
>     filename)))
>
> (defun tramp-locproc-file-name-p (filename)
>   "Check if it’s a FILENAME handled by local processes."
>   ;; FIXME: Check, that it is activated for the repective backend.
>   (or (tramp-archive-file-name-p filename)
>       (tramp-gvfs-file-name-p filename)
>       (tramp-rclone-file-name-p filename)
>       (tramp-sshfs-file-name-p filename)))
>
> (defcustom tramp-locproc-extend-arguments t
>   "Whether to prefix arguments of remote processes by the mount-point."
>   :group 'tramp
>   :type 'boolean)
>
> (defun tramp-locproc-extend-arguments (mount-point args)
>   "Return ARGS, a list of local file names, prefixed with MOUNT-POINT.
> This can be suppressed by setting user option
> `tramp-locproc-extend-arguments' to nil."
>   (if tramp-locproc-extend-arguments
>       (mapcar
>        (lambda (file)
> 	 (if (and (stringp file) (file-name-absolute-p file))
> 	     (concat mount-point file) file))
>        args)
>     args))
>
> (defun tramp-locproc-handle-exec-path ()
>   "Like `exec-path' for Tramp files."
>   exec-path)
>
> (defun tramp-locproc-handle-make-process (&rest args)
>   "An alternative `make-process' implementation for Tramp files."
>   (let ((mount-point (tramp-locproc-mount-point default-directory))
> 	(default-directory (tramp-locproc-local-file-name default-directory))
> 	(command (plist-get args :command)))
>     ;; The car in COMMAND is the program name.  We don't manipulate it.
>     (setcdr command (tramp-locproc-extend-arguments mount-point (cdr command)))
>     (apply #'make-process (plist-put args :command command))))
>
> (defun tramp-locproc-handle-process-file
>     (program &optional infile buffer display &rest args)
>   "Like `process-file' for Tramp files."
>   (let ((mount-point (tramp-locproc-mount-point default-directory))
> 	(default-directory (tramp-locproc-local-file-name default-directory)))
>     (apply
>      #'process-file (file-local-name program) infile buffer display
>      (tramp-locproc-extend-arguments mount-point args))))
>
> (defun tramp-locproc-handle-shell-command
>     (command &optional output-buffer error-buffer)
>   "An alternative `shell-command' implementation for Tramp files."
>   (let ((mount-point (tramp-locproc-mount-point default-directory))
> 	(default-directory (tramp-locproc-local-file-name default-directory))
> 	(command (split-string command)))
>     ;; The first word in COMMAND is the program name.  We don't
>     ;; manipulate it.
>     (setcdr command (tramp-locproc-extend-arguments mount-point (cdr command)))
>     (setq command (mapconcat #'identity command " "))
>     (shell-command command output-buffer error-buffer)))
>
> ;;; Integration of compile.el:
>
> (defun tramp-locproc-compilation-mode-function ()
>   "Setup compilation buffer properly."
>   (when (and (compilation-buffer-p (current-buffer))
> 	     (tramp-locproc-file-name-p default-directory))
>     (trace-values (current-buffer) default-directory comint-file-name-prefix)
>     (setq default-directory (tramp-locproc-local-file-name default-directory))
>     (setq-local comint-file-name-prefix "")))
>
> (with-eval-after-load 'compile
>   (trace-function-background 'compilation-setup)
>   (trace-function-background 'compilation-get-file-structure)
>   (add-hook 'compilation-mode-hook
> 	    #'tramp-locproc-compilation-mode-function)
>   (add-hook 'tramp-locproc-unload-hook
> 	    (lambda ()
> 	      (remove-hook 'compilation-mode-hook
> 			   #'tramp-locproc-compilation-mode-function))))
>
> ;;; Integration of shell.el:
>
> (defun tramp-locproc-shell-function (&rest args)
>   (let ((default-directory (tramp-locproc-local-file-name default-directory)))
>     (apply args)))
>
> (with-eval-after-load 'shell
>   (trace-function-background 'shell)
>   (advice-add #'shell :around #'tramp-locproc-shell-function)
>   (add-hook 'tramp-locproc-unload-hook
> 	    (lambda ()
> 	      (advice-remove #'shell :around #'tramp-locproc-shell-function))))
>
> ;; FIXME: Do we need this?
> ;;; Integration of comint.el:
>
> ;; (defun tramp-locproc-comint-mode-function ()
> ;;  "Setup comint mode properly."
> ;;   (trace-values (current-buffer) default-directory comint-file-name-prefix)
> ;;   (setq default-directory (tramp-locproc-local-file-name default-directory))
> ;;   (setq-local comint-file-name-prefix ""))
>
> ;; (with-eval-after-load 'comint
> ;;   (add-hook 'comint-mode-hook
> ;; 	    #'tramp-locproc-comint-mode-function)
> ;;   (add-hook 'tramp-locproc-unload-hook
> ;; 	    (lambda ()
> ;; 	      (remove-hook 'comint-mode-hook
> ;; 			   #'tramp-locproc-comint-mode-function))))
>
> ;; Development settings.
> (require 'trace)
> (mapc
>  #'trace-function-background
>  (mapcar #'intern (all-completions "tramp-locproc-" obarray #'functionp)))
>
> (add-hook 'tramp-unload-hook
> 	  (lambda ()
> 	    (unload-feature 'tramp-locproc 'force)))
>
> (provide 'tramp-locproc)
>
> ;;; tramp-locproc.el ends here