X-Git-Url: https://code.delx.au/gnu-emacs-elpa/blobdiff_plain/8f6fe36e1ad23834e9b772e8fcdfe85d5eb47356..b19288e6ef625e22bf4dda36578eebe157662ad5:/packages/multishell/multishell.el diff --git a/packages/multishell/multishell.el b/packages/multishell/multishell.el index 2f4375290..8056669c0 100644 --- a/packages/multishell/multishell.el +++ b/packages/multishell/multishell.el @@ -1,9 +1,9 @@ -;;; multishell.el --- facilitate multiple local and remote shell buffers +;;; multishell.el --- Easily use multiple shell buffers, local and remote. -;; Copyright (C) 1999-2016 Free Software Foundation, Inc. and Ken Manheimer +;; Copyright (C) 1999-2016 Free Software Foundation, Inc. ;; Author: Ken Manheimer -;; Version: 1.0.8 +;; Version: 1.1.4 ;; Created: 1999 -- first public availability ;; Keywords: processes ;; URL: https://github.com/kenmanheimer/EmacsMultishell @@ -43,7 +43,9 @@ ;; * Thanks to tramp, file visits from the shell will seamlessly be in ;; the auspices of the target account, and relative to the current ;; directory, on the host where the shell is running. -;; +;; +;; * Manage your list of shells, current and past, as a collection. +;; ;; See the `multishell-pop-to-shell` docstring for details. ;; ;; Customize-group `multishell' to select and activate a keybinding and set @@ -57,17 +59,49 @@ ;; ;; Change Log: ;; -;; * XXX 1.0.9 Ken Manheimer: -;; - Allow existing shell buffers names as completions, even though they -;; duplicate the names with paths. The different behavior for entries -;; with existing buffers is actually useful. And in accord with actual -;; behavior, where changing path for existing shells doesn't, actually. -;; - Add paths to buffers started without one, if multishell history dir +;; * 2016-02-11 1.1.4 Ken Manheimer: +;; - hookup multishell-list as completion help buffer. +;; Mouse and keyboard selections from help listing properly exits +;; minibuffer. +;; * 2016-02-09 1.1.3 Ken Manheimer: +;; multishell-list: +;; - add some handy operations, like cloning new entry from existing +;; - add optional behaviors to existing operations for returning to +;; stopped shells without restarting them. +;; - solidify maintaining focus on current entry +;; - fix miscellaneous. +;; * 2016-01-31 1.1.2 Ken Manheimer: +;; - Settle puzzling instability of multishell-all-entries +;; - The accumulations was putting items going from more to less active +;; categories to be put at the end, not beginning. +;; - Also, using history for prompting changes history - implement +;; no-record option to avoid this when needed. +;; - Implement simple edit-in-place multishell-replace-entry and use in +;; multishell-list-edit-entry. +;; - Remove now unnecessary multishell-list-revert-buffer-kludge. +;; - Rectify byte compiler offenses, and other fixes - thanks to Stefan +;; Monnier for pointing out many of the corrections. +;; - Avoid directly calling tramp functions unnecessarily. +;; * 2016-01-30 1.1.1 Ken Manheimer: +;; - shake out initial multishell-list glitches: +;; - (Offer to) delete shell buffer, if present, when deleting entry. +;; - Set recency (numeric rank) as initial sort field +;; - Recompute list on most operations that affect the order, and try to +;; preserve stability. (Kludgy solution, needs work.) +;; - Set version to 1.1.1 - multishell-list addition should have been 1.1.0. +;; * 2016-01-30 1.0.9 Ken Manheimer: +;; - Add multishell-list for managing the collection of current and +;; history-registered shells: edit, delete, and switch/pop to entries. +;; Easy access by invoking `multishell-pop-to-shell' from in the +;; `multishell-pop-to-shell' universal arg prompts. +;; - Duplicate existing shell buffer names in completions, for distinction. +;; - Add paths to buffers started without one, when multishell history dir ;; tracking is enabled. -;; - Substantial code cleanup: -;; - simplify multishell-start-shell-in-buffer, in particular using +;; - Major code cleanup: +;; - Simplify multishell-start-shell-in-buffer, in particular using ;; shell function, rather than unnecessarily going underneath it. -;; - fallback to eval-after-load in emacs, that lack +;; - Establish multishell-name-from-entry as canonical name resolver. +;; - Fallback to eval-after-load in emacs versions that lack ;; with-eval-after-load (eg, emacs 23). ;; - save-match-data, where match-string is used ;; - resituate some helpers @@ -104,43 +138,25 @@ ;; ;; TODO and Known Issues: ;; -;; * Find suitable, internally consistent ways to tidy completions, eg: -;; - first list completions for active shells, then present but inactive, -;; then historical -;; - some way for user to toggle between presenting just buffer names vs -;; full buffer/path -;; - without cutting user off from easy editing of path -;; - maybe use keybindings that wrap minibuffer completion keys -;; - minibuffer-local-completion-map, minibuffer-local-must-match-map -;; - setup minibuffer with these vars just before doing completions -;; - minibuffer exit reverts these vars, if necessary -;; - toggles between name and name/path if repeat count provided -;; - and an instruction about toggling in the completion buffer -;; - eventually? "multishell-list-all", based on tabulated-list-mode -;; - list-environment package is small, tidy, may be an easy template? -;; - sort based on existing vs just historical -;; - launch -;; - rename, change path, and remove history entries -;; - could we use it as the transient completions help window? +;; * Add custom shell launch prep actions +;; - for, eg, port knocking, interface activations +;; - shell commands to execute when shell name or path matches a regexp +;; - list of (regexp, which - name, path, or both, command) ;; * Investigate whether we can recognize and provide for failed hops. ;; - Tramp doesn't provide useful reactions for any hop but the first ;; - Might be stuff we can do to detect and convey failures? ;; - Might be no recourse but to seek tramp changes. -;; * Add custom shell launch prep actions -;; - shell commands to execute when shell name or path matches a regexp -;; - list of [regexp, which (name, path, or both), command] -;; - for, eg, knock commands or interface activations, whatever ;; * Try minibuffer field boundary at beginning of tramp path, to see whether ;; the field boundary magically enables tramp path completion. -;; * Assess whether deletion of history entry via kill-buffer is sufficient. ;;; Code: (require 'comint) (require 'shell) (require 'savehist) +(require 'multishell-list) -(defvar multishell-version "1.0.8") +(defvar multishell-version "1.1.3") (defun multishell-version (&optional here) "Return string describing the loaded multishell version." (interactive "P") @@ -162,14 +178,13 @@ with allout-mode." You can instead manually bind `multishell-pop-to-shell` using emacs lisp, eg: (global-set-key \"\\M- \" 'multishell-pop-to-shell)." - :type 'key-sequence - :group 'multishell) + :type 'key-sequence) (defvar multishell--responsible-for-command-key nil "Coordination for multishell key assignment.") (defun multishell-activate-command-key-setter (symbol setting) "Implement `multishell-activate-command-key' choice." - (set-default 'multishell-activate-command-key setting) + (set-default symbol setting) (when (or setting multishell--responsible-for-command-key) (multishell-implement-command-key-choice (not setting)))) (defun multishell-implement-command-key-choice (&optional unbind) @@ -195,15 +210,14 @@ If optional UNBIND is true, globally unbind the key. You can instead manually bind `multishell-pop-to-shell` using emacs lisp, eg: (global-set-key \"\\M- \" 'multishell-pop-to-shell)." :type 'boolean - :set 'multishell-activate-command-key-setter - :group 'multishell) + :set 'multishell-activate-command-key-setter) ;; Implement the key customization whenever the package is loaded: (if (fboundp 'with-eval-after-load) (with-eval-after-load "multishell" (multishell-implement-command-key-choice)) (eval-after-load "multishell" - (multishell-implement-command-key-choice))) + '(multishell-implement-command-key-choice))) (defcustom multishell-pop-to-frame nil "*If non-nil, jump to a frame already showing the shell, if another one is. @@ -214,22 +228,18 @@ current frame. \(Use `pop-up-windows' to change multishell other-window vs current-window behavior.)" - :type 'boolean - :group 'multishell) + :type 'boolean) (defcustom multishell-history-entry-tracks-current-directory t "Maintain shell's current directory in its multishell history entry. When set, the history entry for shells started with explicit -paths will track the shell's current working directory. (Explicit -paths will not be added to local shells started without one, -however.) +paths will track the shell's current working directory. If `savehist-save-minibuffer-history' is enabled, the current -working directory of shells \(that were started with an explicit -path) will be conveyed between emacs sessions." - :type 'boolean - :group 'multishell) +working directory of shells will be conveyed between emacs +sessions." + :type 'boolean) (defvar multishell-history nil "Name/path entries, most recent first.") @@ -251,6 +261,10 @@ one emacs session to be resumed at the next, customize `savehist-additional-variables' to include the `multishell-primary-name'.") +(defvar multishell-completing-read nil + "Internal use, conveying whether or not we're in the midst of a multishell +completing-read.") + ;; Multiple entries happen because completion also adds name to history. (defun multishell-register-name-to-path (name path) "Add or replace entry associating NAME with PATH in `multishell-history'. @@ -269,27 +283,51 @@ Promote added/changed entry to the front of the list." (setq multishell-history (push (concat name path) multishell-history)))) +(defun multishell-replace-entry (entry revised) + "Replace every instance of ENTRY in `multishell-history' with REVISED. + +Revised entry is situated where former one was. + +Returns non-nil iff any changes were made." + (let ((candidates multishell-history) + did-revisions) + (while (setq candidates (member entry candidates)) + (setcar candidates revised) + (setq candidates (cdr candidates) + did-revisions t)) + did-revisions)) + (defun multishell-history-entries (name) "Return `multishell-history' entry that starts with NAME, or nil if none." - (save-match-data - (let ((match-expr (concat "^" name "\\\(/.*$\\\)?$")) - got) - (dolist (entry multishell-history) - (when (and (string-match match-expr entry) - (not (member entry got))) - (setq got (cons entry got)))) - got))) - -(defun multishell-pop-to-shell (&optional arg) + (let (got) + (dolist (entry multishell-history) + (when (and (string-equal name (multishell-name-from-entry entry)) + (not (member entry got))) + (push entry got))) + got)) + +;;;###autoload +(defun multishell-pop-to-shell (&optional arg name here) "Easily navigate to and within multiple shell buffers, local and remote. -Use universal arguments to launch and choose between alternate -shell buffers and to select which is default. Append a path to -a new shell name to launch a shell in that directory, and use -Emacs tramp syntax to launch a remote shell. +Use a single `universal-argument' (\\[universal-argument]) to launch and choose between +nalternate shell buffers, and a doubled universal argument to also set your +choice as the ongoing default. Append a path to a new shell name to launch +a shell in that directory, and use Emacs tramp syntax to launch a remote +shell. There is a shortcut to manage your list of current and +historical shells, collectively, using `multishell-list' - see below. Customize-group `multishell' to set up a key binding and tweak behaviors. +Manage your collection of current and historical shells by +recursively invoking \\[multishell-pop-to-shell] at the +`multishell-pop-to-shell' universal argument prompts, eg: + + \\[universal-argument] \\[multishell-pop-to-shell] \\[multishell-pop-to-shell] + +\(That will be just a few keys if you do the above +customization.) Hit ? in the listing buffer for editing commands. + ==== Basic operation: - If the current buffer is shell-mode (or shell-mode derived) @@ -317,8 +355,9 @@ was disconnected or otherwise stopped, it's resumed. ===== Universal arg to start and select between named shell buffers: -You can name alternate shell buffers to create or return to using -single or doubled universal arguments: +You can name alternate shell buffers to create or return to, by +prefixing your \\[multishell-pop-to-shell] invocation with single or double +`universal-argument', \\[universal-argument]: - With a single universal argument, prompt for the buffer name to use (without the asterisks that shell mode will put around @@ -336,6 +375,12 @@ single or doubled universal arguments: See `multishell-primary-name' for info about preserving the setting across emacs restarts. + - Manage your collection of current and historical shells by + recursively invoking \\[multishell-pop-to-shell] at either of the + `multishell-pop-to-shell' universal argument prompts, or at any + time via \\[multishell-list]. Hit ? in the listing buffer for + editing commands. + ===== Select starting directory and remote host: The shell buffer name you give to the prompt for a universal arg @@ -379,9 +424,27 @@ customize the savehist group to activate savehist." (interactive "P") + (let ((token '(token))) + (if (window-minibuffer-p) + (throw 'multishell-minibuffer-exit token) + (let ((got (catch 'multishell-minibuffer-exit + (multishell-pop-to-shell-worker arg name here)))) + ;; Handle catch or plain fall-through - see cond comments for protocol. + (cond + ;; Caught token from recursive invocation in minibuffer: + ((equal token got) (multishell-list)) + ;; Caught specifaction of multishell args, eg from multishell-list: + ((listp got) (multishell-pop-to-shell-worker (nth 2 got) + (nth 0 got) + (nth 1 got))) + ;; Regular fallthrough - just relay the result: + (t got)))))) + +(defun multishell-pop-to-shell-worker (&optional arg name here) + "Do real work of `multishell-pop-to-shell', which see." (let* ((from-buffer (current-buffer)) (from-buffer-is-shell (derived-mode-p 'shell-mode)) - (primary-name-unbracketed (multishell-unbracket-asterisks + (primary-name-unbracketed (multishell-unbracket multishell-primary-name)) (fallthrough-name (if from-buffer-is-shell (buffer-name from-buffer) @@ -389,14 +452,14 @@ customize the savehist group to activate savehist." (doublearg (equal arg '(16))) (target-name-and-path (multishell-resolve-target-name-and-path - (if arg - (or (multishell-read-bare-shell-buffer-name - (format "Shell buffer name [%s]%s " - primary-name-unbracketed - (if doublearg " <==" ":")) - primary-name-unbracketed) - primary-name-unbracketed) - fallthrough-name))) + (cond (name name) + (arg + (or (multishell-read-unbracketed-entry + (format "Shell buffer name [%s]%s " + primary-name-unbracketed + (if doublearg " <==" ":"))) + primary-name-unbracketed)) + (t fallthrough-name)))) (use-path (cadr target-name-and-path)) (target-shell-buffer-name (car target-name-and-path)) (target-buffer (get-buffer target-shell-buffer-name)) @@ -405,7 +468,7 @@ customize the savehist group to activate savehist." already-there) ;; Register early so the entry is pushed to the front: - (multishell-register-name-to-path (multishell-unbracket-asterisks + (multishell-register-name-to-path (multishell-unbracket target-shell-buffer-name) use-path) @@ -433,7 +496,9 @@ customize the savehist group to activate savehist." ;; No preexisting shell buffer, or not in a visible window: (when (not (get-buffer target-shell-buffer-name)) (message "Creating new shell buffer '%s'" target-shell-buffer-name)) - (pop-to-buffer target-shell-buffer-name pop-up-windows)) + (if here + (switch-to-buffer target-shell-buffer-name) + (pop-to-buffer target-shell-buffer-name pop-up-windows))) ;; Buffer exists and already has a window - jump to it: (t (if (and multishell-pop-to-frame @@ -443,13 +508,14 @@ customize the savehist group to activate savehist." (select-frame-set-input-focus (window-frame inwin))) (if (not (string= (buffer-name (current-buffer)) target-shell-buffer-name)) - (pop-to-buffer target-shell-buffer-name t)))) + (if here + (switch-to-buffer target-shell-buffer-name) + (pop-to-buffer target-shell-buffer-name t))))) ;; We're in the buffer. Activate: (if (not (comint-check-proc (current-buffer))) - (multishell-start-shell-in-buffer (buffer-name (current-buffer)) - use-path)) + (multishell-start-shell-in-buffer use-path)) ;; If the destination buffer has a stopped process, resume it: (let ((process (get-buffer-process (current-buffer)))) @@ -462,6 +528,21 @@ customize the savehist group to activate savehist." (and (get-buffer-process from-buffer) (goto-char (process-mark (get-buffer-process from-buffer))))))) +(defun multishell-delete-history-name (name &optional ask) + "Remove all multishell history entries for NAME. + +if optional ask is non-nil (default nil), ask before each deletion. + +Return the last entry deleted." + (let (got) + (dolist (entry (multishell-history-entries name) got) + (when (and entry + (or (not ask) + (y-or-n-p (format "Remove multishell history entry `%s'? " + entry)))) + (setq got entry + multishell-history (delete entry multishell-history)))))) + (defun multishell-kill-buffer-query-function () "Offer to remove multishell-history entry for buffer." ;; Removal choice is crucial, so users can, eg, kill a shell with huge @@ -478,14 +559,10 @@ customize the savehist group to activate savehist." ;; (Use condition-case to avoid inadvertant disruption of kill-buffer ;; activity. kill-buffer happens behind the scenes a whole lot.) (condition-case err - (dolist (entry (and (derived-mode-p 'shell-mode) - (multishell-history-entries - (multishell-unbracket-asterisks (buffer-name))))) - (when (and entry - (y-or-n-p (format "Remove multishell history entry `%s'? " - entry))) - (setq multishell-history - (delete entry multishell-history)))) + (and (derived-mode-p 'shell-mode) + (multishell-delete-history-name + (multishell-unbracket (buffer-name)) + t)) (error (message "multishell-kill-buffer-query-function error: %s" err))) t) @@ -505,26 +582,54 @@ customize the savehist group to activate savehist." nil 'visible) nil)) -(defun multishell-read-bare-shell-buffer-name (prompt default) - "PROMPT for shell buffer name, sans asterisks. Indicate DEFAULT in prompt. - -Return the supplied name, if provided, else return nil." - (let* ((candidates - (append - ;; Plain shell buffer names appended with names from name/path hist: - (remq nil - (mapcar (lambda (buffer) - (let* ((name (multishell-unbracket-asterisks - (buffer-name buffer)))) - (and (buffer-live-p buffer) - (with-current-buffer buffer - ;; Shell mode buffers. - (and (derived-mode-p 'shell-mode) - (comint-check-proc (current-buffer)))) - name))) - (buffer-list))) - multishell-history)) - (got (completing-read prompt +(defun multishell-all-entries (&optional active-duplicated) + "Return multishell history, with active buffers listed first. + +Optional ACTIVE-DUPLICATED will return a copy of +`multishell-history' with unbracketed names of active buffers, +sans paths, appended to the list, so they have short and long +completions." + ;; Reorder so active lead present lead historical entries: + (let (active-entries active-names present past splat name buffer) + (dolist (entry multishell-history) + (setq splat (multishell-split-entry entry) + name (car splat) + buffer (and name (get-buffer (multishell-bracket name)))) + (if (buffer-live-p buffer) + (if (comint-check-proc buffer) + (setq active-entries (push entry active-entries) + active-names (push name active-names)) + (setq present (push entry present))) + (setq past (push entry past)))) + ;; Reverse present and past lists + (setq multishell-history (append (reverse active-entries) + (reverse present) + (reverse past))) + (if active-duplicated + (append multishell-history active-names) + multishell-history))) + +(defun multishell-read-unbracketed-entry (prompt &optional initial no-record) + "PROMPT for shell buffer name, sans asterisks. + +Optional INITIAL is preliminary value to be edited. + +Optional NO-RECORD prevents changes to `multishell-history' +across the activity. + +Input and completion can include associated path, if any. + +Return what's provided, if anything, else nil." + (let* ((was-multishell-history multishell-history) + (candidates (multishell-all-entries 'active-duplicated)) + (multishell-completing-read t) + (got + ;; Use `cl-letf' to dynamically bind multishell-list to + ;; display-completion-list, so multishell-list is used when doing + ;; minibuffer-completion-help. + (cl-letf (((symbol-function 'display-completion-list) + #'multishell-list)) + (completing-read prompt ;; COLLECTION: (reverse candidates) ;; PREDICATE: @@ -532,67 +637,96 @@ Return the supplied name, if provided, else return nil." ;; REQUIRE-MATCH: 'confirm ;; INITIAL-INPUT - nil + initial ;; HIST: - 'multishell-history))) + 'multishell-history)))) + (when no-record + (setq multishell-history was-multishell-history)) (if (not (string= got "")) got nil))) -(defun multishell-resolve-target-name-and-path (path-ish) - "Given name/tramp-path PATH-ISH, resolve buffer name and initial directory. +(defun multishell-resolve-target-name-and-path (shell-spec) + "Given name/tramp-style address shell spec, resolve buffer name and directory. The name is the part of the string up to the first '/' slash, if any. Missing pieces are filled in from remote path elements, if -any, and multishell history. Given a path and no name, either the -host-name, domain-name, final directory name, or local host name -is used. - -Return them as a list (name path), with name asterisk-bracketed -and path nil if none resolved." - (let* ((splat (multishell-split-entry (or path-ish ""))) - (name (car splat)) - (path (cadr splat))) - (if path - (if (not name) - (setq name - (if (file-remote-p path) - (let ((vec (tramp-dissect-file-name path))) - (or (tramp-file-name-host vec) - (tramp-file-name-domain vec) - (tramp-file-name-localname vec) - system-name)) - multishell-primary-name))) - ;; No path - get one from history, if present. - (when (not name) - (setq name multishell-primary-name)) - (mapcar #'(lambda (entry) - (when (or (not path) (string= path "")) - (setq path (cadr (multishell-split-entry entry))))) - (multishell-history-entries - (multishell-unbracket-asterisks name)))) - (list (multishell-bracket-asterisks name) path))) - -(defun multishell-start-shell-in-buffer (buffer-name path) +any, and multishell history. Given a tramp-style remote address +and no name part, either the user@host is used for the buffer +name, if a user is specified, or just the host. + +Return them as a list: (name path), with name asterisk-bracketed +and path nil if none is resolved." + (let* ((splat (multishell-split-entry (or shell-spec ""))) + (path (cadr splat)) + (name (or (car splat) (multishell-name-from-entry path)))) + (when (not path) + ;; Get path from history, if present. + (dolist (entry + (multishell-history-entries + (multishell-unbracket name))) + (when (or (not path) (string= path "")) + (setq path (cadr (multishell-split-entry entry)))))) + (list (multishell-bracket name) path))) + +(defun multishell-name-from-entry (entry) + "Derive a name for a shell buffer according to ENTRY." + (if (not entry) + (multishell-unbracket multishell-primary-name) + (let* ((splat (multishell-split-entry entry)) + (name (car splat)) + (path (cadr splat))) + (or name + (if (file-remote-p path) + (let ((host (file-remote-p path 'host)) + (user (file-remote-p path 'user))) + (cond ((and host user) + (format "%s@%s" user host)) + (host host) + (user user) + ((system-name)))) + (multishell-unbracket multishell-primary-name)))))) + +(declare-function tramp-dissect-file-name "tramp") +(declare-function tramp-cleanup-connection "tramp") + +(defun multishell-start-shell-in-buffer (path) "Start, restart, or continue a shell in BUFFER-NAME on PATH." - (let* ((buffer (get-buffer buffer-name)) - is-remote is-active) - - (set-buffer buffer) - (setq is-active (comint-check-proc buffer)) + (let* ((is-active (comint-check-proc (current-buffer)))) (when (and path (not is-active)) (when (and (derived-mode-p 'shell-mode) (file-remote-p path)) - ;; Returning to disconnected remote shell - do some tidying: + ;; Returning to disconnected remote shell - do some tidying. + ;; Without this cleanup, occasionally restarting a disconnected + ;; remote session, particularly one that includes sudo, results in + ;; an untraceable "Args out of range" error. That never happens if + ;; we precedeed connection attempts with this cleanup - + ;; prophylactic. (tramp-cleanup-connection (tramp-dissect-file-name default-directory 'noexpand) 'keep-debug 'keep-password)) - (message "Connecting to %s" path) + (when (file-remote-p path) (message "Connecting to %s" path)) (cd path)) - (shell buffer))) + (shell (current-buffer)))) + +(defun multishell-homedir-shorthand-p (dirpath) + "t if dirpath is an unexpanded remote homedir spec." + ;; Workaround to recognize tramp-style homedir shorthand, "...:" and "...:~". + (let ((localname (file-remote-p dirpath 'localname))) + (and localname + (or + ;; No directory path and no connection to expand homedir: + (string= localname "") + ;; Original path doesn't equal expanded homedir: + (save-match-data + (not (string-match (concat (regexp-quote localname) "/?$") + dirpath))))))) +;; (assert (multishell-homedir-shorthand-p "/ssh:myhost.net:") +;; (assert (not (multishell-homedir-shorthand-p "/home/klm"))) +;; (assert (not (multishell-homedir-shorthand-p "/ssh:myhost.net:/home/me"))) (defun multishell-track-dirchange (name newpath) "Change multishell history entry to track current directory." @@ -602,35 +736,27 @@ and path nil if none resolved." (name (car name-path)) (path (or (cadr name-path) ""))) (when path - (let* ((is-remote (file-remote-p path)) - (vec (and is-remote (tramp-dissect-file-name path nil))) - (localname (if is-remote - (tramp-file-name-localname vec) - path)) - (newlocalname - (replace-regexp-in-string (if (string= localname "") - "$" - (regexp-quote localname)) - ;; REP - newpath - ;; STRING - localname - ;; FIXEDCASE - t - ;; LITERAL - t - )) - (newpath (if is-remote - (tramp-make-tramp-file-name (aref vec 0) - (aref vec 1) - (aref vec 2) - newlocalname - (aref vec 4)) - newpath)) - (newentry (concat name newpath)) + (let* ((old-localname (or (file-remote-p path 'localname) + path)) + (newentry + (if (multishell-homedir-shorthand-p path) + (concat entry newpath) + (replace-regexp-in-string (concat (regexp-quote + old-localname) + "$") + ;; REPLACEMENT + newpath + ;; STRING + entry + ;; FIXEDCASE + t + ;; LITERAL + t + ))) (membership (member entry multishell-history))) (when membership (setcar membership newentry)))))))) + (defvar multishell-was-default-directory () "Provide for tracking directory changes.") (make-variable-buffer-local 'multishell-was-default-directory) @@ -641,18 +767,16 @@ and path nil if none resolved." (when (and multishell-history-entry-tracks-current-directory (derived-mode-p 'shell-mode)) (let ((curdir (if (file-remote-p default-directory) - (tramp-file-name-localname - (tramp-dissect-file-name default-directory)) + (file-remote-p default-directory 'localname) default-directory))) (when (not (string= curdir (or multishell-was-default-directory ""))) - (multishell-track-dirchange (multishell-unbracket-asterisks - (buffer-name)) + (multishell-track-dirchange (multishell-unbracket (buffer-name)) curdir)) (setq multishell-was-default-directory curdir))) ;; To avoid disruption as a pervasive hook function, swallow all errors: (error (message "multishell-post-command-business error: %s" err)))) -(add-hook 'post-command-hook 'multishell-post-command-business) +(add-hook 'post-command-hook #'multishell-post-command-business) (defun multishell-split-entry (entry) "Given multishell name/path ENTRY, return the separated name and path pair. @@ -665,14 +789,14 @@ Returns nil for empty parts, rather than the empty string." (and (string= name "") (setq name nil)) (and (string= path "") (setq path nil)) (list name path)))) -(defun multishell-bracket-asterisks (name) +(defun multishell-bracket (name) "Return a copy of name, ensuring it has an asterisk at the beginning and end." (if (not (string= (substring name 0 1) "*")) (setq name (concat "*" name))) (if (not (string= (substring name -1) "*")) (setq name (concat name "*"))) name) -(defun multishell-unbracket-asterisks (name) +(defun multishell-unbracket (name) "Return a copy of name, removing asterisks, if any, at beginning and end." (if (string= (substring name 0 1) "*") (setq name (substring name 1)))