diff options
| -rw-r--r-- | README.md | 14 | ||||
| -rw-r--r-- | terminal-here.el | 52 | ||||
| -rw-r--r-- | test/terminal-here-test.el | 32 |
3 files changed, 72 insertions, 26 deletions
@@ -52,6 +52,20 @@ Requires setting `terminal-here-terminal-command` before use: If you have problems just set `terminal-here-terminal-command` as described above. +## Remote directories + +`terminal-here` can run ssh to open terminals in remote directories for files +opened with [tramp](https://www.gnu.org/software/tramp/#Overview). This may +require additional setup because of inconsistencies between different terminals. + +If your terminal has a flag to treat the rest of the command line as the command +to run inside the terminal, you just need to set `terminal-here-command-flag` to +this flag. If not it may be impossible to get ssh support. Some examples are: + +* `xterm`, `urxvt`: `-e` (this is the default) +* `gnome-terminal`: `-x` + + ## Alternatives There are lots of built in ways to run terminals *inside* emacs (`shell`, diff --git a/terminal-here.el b/terminal-here.el index 4dc8cef..fc48529 100644 --- a/terminal-here.el +++ b/terminal-here.el @@ -67,15 +67,37 @@ buffer is not in a project." :group 'terminal-here :type 'function) +(defcustom terminal-here-command-flag + "-e" + "The flag to tell your terminal to treat the rest of the line as a command to run +Typically this is -e, gnome-terminal uses -x." + :group 'terminal-here + :type 'string) + +(defun terminal-here--parse-ssh-dir (dir) + (when (string-prefix-p "/ssh:" dir) + (cdr (split-string dir ":")))) + +(defun terminal-here--ssh-command (remote dir) + (append (terminal-here--term-command "") (list terminal-here-command-flag "ssh" "-t" remote "cd" dir "&&" "exec" "$SHELL" "-"))) + +(defun terminal-here--term-command (dir) + (let ((ssh-data (terminal-here--parse-ssh-dir dir))) + (cond + (ssh-data (terminal-here--ssh-command (car ssh-data) (cadr ssh-data))) + (t (if (functionp terminal-here-terminal-command) + (funcall terminal-here-terminal-command dir) + terminal-here-terminal-command))))) + (defun terminal-here-launch-in-directory (dir) "Launch a terminal in directory DIR. Handles tramp paths sensibly." - (terminal-here--do-launch (or (terminal-here-maybe-tramp-path-to-directory dir) - dir))) - + (let ((term-command (terminal-here--term-command dir))) + (terminal-here--run-command term-command + (or (terminal-here-maybe-tramp-path-to-directory dir) dir)))) (defun terminal-here-maybe-tramp-path-to-directory (dir) "Extract the local part of a local tramp path. @@ -84,34 +106,28 @@ Given a tramp path returns the local part, otherwise returns nil." (when (tramp-tramp-file-p dir) (let ((file-name-struct (tramp-dissect-file-name dir))) (cond + ;; sudo: just strip the extra tramp stuff ((equal (tramp-file-name-method file-name-struct) "sudo") (tramp-file-name-localname file-name-struct)) - (t (user-error "Terminal here cannot currently handle tramp files other than sudo")))))) + ;; ssh: run with a custom command handled later + ((equal (tramp-file-name-method file-name-struct) "ssh") dir) + (t (user-error "Terminal here cannot currently handle tramp files other than sudo and ssh")))))) -(defun terminal-here--do-launch (dir) - "Internal function to launch the terminal in directory DIR. - -For launching a terminal from emacs lisp you almost almost -certainly want to call `terminal-here-launch-in-directory' which -also handles tramp mappings." - (let* ((term-command (if (functionp terminal-here-terminal-command) - (funcall terminal-here-terminal-command dir) - terminal-here-terminal-command)) - (process-name (car term-command)) - (default-directory dir) - (proc (apply #'start-process process-name nil term-command))) +(defun terminal-here--run-command (command dir) + (let* ((default-directory dir) + (process-name (car command)) + (proc (apply #'start-process process-name nil command))) (set-process-sentinel proc (lambda (proc _) (when (and (eq (process-status proc) 'exit) (/= (process-exit-status proc) 0)) (message "Error: in terminal here, command `%s` exited with error code %d" - (mapconcat #'identity term-command " ") + (mapconcat #'identity command " ") (process-exit-status proc))))) ;; Don't close when emacs closes, seems to only be necessary on Windows. (set-process-query-on-exit-flag proc nil))) - ;;;###autoload (defun terminal-here-launch () "Launch a terminal in the current working directory. diff --git a/test/terminal-here-test.el b/test/terminal-here-test.el index e92f92d..849f18d 100644 --- a/test/terminal-here-test.el +++ b/test/terminal-here-test.el @@ -67,7 +67,7 @@ (let ((project-root-finder (lambda () "" "vc-root"))) (validate-setq terminal-here-project-root-function project-root-finder) (with-terminal-here-mocks - (mock (terminal-here--do-launch "vc-root")) + (mock (terminal-here--run-command * "vc-root")) (terminal-here-project-launch)))) (ert-deftest project-root-finds-nothing () @@ -78,18 +78,34 @@ (ert-deftest sudo-tramp () (with-terminal-here-mocks - (mock (terminal-here--do-launch "/etc/emacs/")) + (mock (terminal-here--run-command * "/etc/emacs/")) (terminal-here-launch-in-directory "/sudo:root@localhost:/etc/emacs/")) (with-terminal-here-mocks - (mock (terminal-here--do-launch "/etc/emacs/")) + (mock (terminal-here--run-command * "/etc/emacs/")) (terminal-here-launch-in-directory "/sudo:postgres@localhost:/etc/emacs/")) (with-terminal-here-mocks - (mock (terminal-here--do-launch "/etc/emacs/")) + (mock (terminal-here--run-command * "/etc/emacs/")) (terminal-here-launch-in-directory "/sudo:root@127.0.0.1:/etc/emacs/"))) -(ert-deftest other-tramp-paths-not-handled () - (should-error - (terminal-here-launch-in-directory "/ssh:foo@bar.com:/home/foo/my-file") - :type 'user-error)) + + +(ert-deftest parse-ssh-dir () + (should (equal (terminal-here--parse-ssh-dir "/ssh:buildbot:/home/buildbot/") (list "buildbot" "/home/buildbot/"))) + (should (equal (terminal-here--parse-ssh-dir "/ssh:david@pi:/home/pi/") (list "david@pi" "/home/pi/"))) + (should (equal (terminal-here--parse-ssh-dir "/ssh:root@192.168.0.1:/etc/hosts") (list "root@192.168.0.1" "/etc/hosts"))) + + (should-not (terminal-here--parse-ssh-dir "/home/buildbot/")) + (should-not (terminal-here--parse-ssh-dir "/ssh/foo/bar"))) + +(ert-deftest ssh-tramp () + (cl-letf* ((launch-command nil) + ((symbol-function 'terminal-here--run-command) + (lambda (command _dir) + (setq launch-command command)))) + (validate-setq terminal-here-command-flag "-k") + (terminal-here-launch-in-directory "/ssh:david@pi:/home/pi/") + (should (equal (car launch-command) "x-terminal-emulator")) + (should (equal (cadr launch-command) "-k")) + (should (equal (caddr launch-command) "ssh")))) |