multishell.el 34 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813
  1. ;;; multishell.el --- Easily use multiple shell buffers, local and remote.
  2. ;; Copyright (C) 1999-2016 Free Software Foundation, Inc.
  3. ;; Author: Ken Manheimer <ken.manheimer@gmail.com>
  4. ;; Version: 1.1.5
  5. ;; Created: 1999 -- first public availability
  6. ;; Keywords: processes
  7. ;; URL: https://github.com/kenmanheimer/EmacsMultishell
  8. ;;
  9. ;;; Commentary:
  10. ;;
  11. ;; Easily use and navigate multiple shell buffers, including remote shells.
  12. ;; Fundamentally, multishell is the function `multishell-pop-to-shell' -
  13. ;; a la `pop-to-buffer' - plus a keybinding. Together, they enable you to:
  14. ;;
  15. ;; * Get to the input point from wherever you are in a shell buffer,
  16. ;; ... or to any of your shell buffers, from anywhere inside emacs.
  17. ;;
  18. ;; * Use universal arguments to launch and choose among alternate shell buffers,
  19. ;; ... and change which is the current default.
  20. ;;
  21. ;; * Easily restart disconnected shells, or shells from prior sessions
  22. ;; ... the latter from Emacs builtin savehist minibuf history persistence
  23. ;;
  24. ;; * Append a path to a new shell name to launch a shell in that directory,
  25. ;; ... and use a path with Emacs tramp syntax to launch a remote shell -
  26. ;; for example:
  27. ;;
  28. ;; * `#root/sudo:root@localhost:/etc` for a buffer named "*#root*" with a
  29. ;; root shell starting in /etc.
  30. ;;
  31. ;; * `/ssh:example.net:` for a shell buffer in your homedir on example.net.
  32. ;; The buffer will be named "*example.net*".
  33. ;;
  34. ;; * `#ex/ssh:example.net|sudo:root@example.net:/var/log` for a root shell
  35. ;; starting in /var/log on example.net named "*#ex*".
  36. ;;
  37. ;; * 'interior/ssh:gateway.corp.com|ssh:interior.corp.com:' to go via
  38. ;; gateway.corp.com to your homedir on interior.corp.com. The buffer
  39. ;; will be named "*interior*". You could append a sudo hop, and so on.
  40. ;;
  41. ;; * Thanks to tramp, file visits from the shell will seamlessly be in
  42. ;; the auspices of the target account, and relative to the current
  43. ;; directory, on the host where the shell is running.
  44. ;;
  45. ;; * Manage your list of shells, current and past, as a collection.
  46. ;;
  47. ;; See the `multishell-pop-to-shell` docstring for details.
  48. ;;
  49. ;; Customize-group `multishell' to select and activate a keybinding and set
  50. ;; various behaviors. Customize-group `savehist' to preserve buffer
  51. ;; names/paths across emacs restarts.
  52. ;;
  53. ;; Please use
  54. ;; [the multishell repository](https://github.com/kenmanheimer/EmacsMultishell)
  55. ;; issue tracker to report problems, suggestions, etc, and see that
  56. ;; repository for a bit more documentation.
  57. ;;
  58. ;; Change Log:
  59. ;;
  60. ;; * 2016-02-11 1.1.5 Ken Manheimer:
  61. ;; - Rectify multishell list sorting to preserve recentness
  62. ;; - Increment the actual multishell-version setting, neglected for 1.1.4.
  63. ;; * 2016-02-11 1.1.4 Ken Manheimer:
  64. ;; - hookup multishell-list as completion help buffer.
  65. ;; Mouse and keyboard selections from help listing properly exits
  66. ;; minibuffer.
  67. ;; * 2016-02-09 1.1.3 Ken Manheimer:
  68. ;; multishell-list:
  69. ;; - add some handy operations, like cloning new entry from existing
  70. ;; - add optional behaviors to existing operations for returning to
  71. ;; stopped shells without restarting them.
  72. ;; - solidify maintaining focus on current entry
  73. ;; - fix miscellaneous.
  74. ;; * 2016-01-31 1.1.2 Ken Manheimer:
  75. ;; - Settle puzzling instability of multishell-all-entries
  76. ;; - The accumulations was putting items going from more to less active
  77. ;; categories to be put at the end, not beginning.
  78. ;; - Also, using history for prompting changes history - implement
  79. ;; no-record option to avoid this when needed.
  80. ;; - Implement simple edit-in-place multishell-replace-entry and use in
  81. ;; multishell-list-edit-entry.
  82. ;; - Remove now unnecessary multishell-list-revert-buffer-kludge.
  83. ;; - Rectify byte compiler offenses, and other fixes - thanks to Stefan
  84. ;; Monnier for pointing out many of the corrections.
  85. ;; - Avoid directly calling tramp functions unnecessarily.
  86. ;; * 2016-01-30 1.1.1 Ken Manheimer:
  87. ;; - shake out initial multishell-list glitches:
  88. ;; - (Offer to) delete shell buffer, if present, when deleting entry.
  89. ;; - Set recency (numeric rank) as initial sort field
  90. ;; - Recompute list on most operations that affect the order, and try to
  91. ;; preserve stability. (Kludgy solution, needs work.)
  92. ;; - Set version to 1.1.1 - multishell-list addition should have been 1.1.0.
  93. ;; * 2016-01-30 1.0.9 Ken Manheimer:
  94. ;; - Add multishell-list for managing the collection of current and
  95. ;; history-registered shells: edit, delete, and switch/pop to entries.
  96. ;; Easy access by invoking `multishell-pop-to-shell' from in the
  97. ;; `multishell-pop-to-shell' universal arg prompts.
  98. ;; - Duplicate existing shell buffer names in completions, for distinction.
  99. ;; - Add paths to buffers started without one, when multishell history dir
  100. ;; tracking is enabled.
  101. ;; - Major code cleanup:
  102. ;; - Simplify multishell-start-shell-in-buffer, in particular using
  103. ;; shell function, rather than unnecessarily going underneath it.
  104. ;; - Establish multishell-name-from-entry as canonical name resolver.
  105. ;; - Fallback to eval-after-load in emacs versions that lack
  106. ;; with-eval-after-load (eg, emacs 23).
  107. ;; - save-match-data, where match-string is used
  108. ;; - resituate some helpers
  109. ;; * 2016-01-24 1.0.8 Ken Manheimer:
  110. ;; - Work around the shell/tramp mishandling of remote+sudo+homedir problem!
  111. ;; The work around is clean and simple, basically using high-level `cd'
  112. ;; API and not messing with the low-level default-directory setting.
  113. ;; (Turns out the problem was not in my local config. Good riddance to the
  114. ;; awkward failure handler!)
  115. ;; - Clean up code resolving the destination shell, starting to document the
  116. ;; decision tree in the process. See getting-to-a-shell.md in the
  117. ;; multishell repository, https://github.com/kenmanheimer/EmacsMultishell
  118. ;; - There may be some shake-out on resolving the destination shell, but
  119. ;; this release gets the fundamental functionality soundly in place.
  120. ;; * 2016-01-23 1.0.7 Ken Manheimer:
  121. ;; - Remove notes about tramp remote+sudo+homedir problem. Apparently it's
  122. ;; due to something in my local site configuration (happens with -q but
  123. ;; not -Q).
  124. ;; * 2016-01-22 1.0.6 Ken Manheimer:
  125. ;; - Add multishell-version function.
  126. ;; - Tweak commentary/comments/docstrings.
  127. ;; - Null old multishell-buffer-name-history var, if present.
  128. ;; * 2016-01-16 1.0.5 Ken Manheimer:
  129. ;; - History now includes paths, when designated.
  130. ;; - Actively track current directory in history entries that have a path.
  131. ;; Custom control: multishell-history-entry-tracks-current-directory
  132. ;; - Offer to remove shell's history entry when buffer is killed.
  133. ;; (Currently the only UI mechanism to remove history entries.)
  134. ;; - Fix - prevent duplicate entries for same name but different paths
  135. ;; - Fix - recognize and respect tramp path syntax to start in home dir
  136. ;; - Simplify history var name, migrate existing history if any from old name
  137. ;; * 2016-01-04 1.0.4 Ken Manheimer - Released to ELPA
  138. ;; * 2016-01-02 Ken Manheimer - working on this in public, but not yet released.
  139. ;;
  140. ;; TODO and Known Issues:
  141. ;;
  142. ;; * Add custom shell launch prep actions
  143. ;; - for, eg, port knocking, interface activations
  144. ;; - shell commands to execute when shell name or path matches a regexp
  145. ;; - list of (regexp, which - name, path, or both, command)
  146. ;; * Investigate whether we can recognize and provide for failed hops.
  147. ;; - Tramp doesn't provide useful reactions for any hop but the first
  148. ;; - Might be stuff we can do to detect and convey failures?
  149. ;; - Might be no recourse but to seek tramp changes.
  150. ;; * Try minibuffer field boundary at beginning of tramp path, to see whether
  151. ;; the field boundary magically enables tramp path completion.
  152. ;;; Code:
  153. (require 'comint)
  154. (require 'shell)
  155. (require 'savehist)
  156. (require 'multishell-list)
  157. (defvar multishell-version "1.1.5")
  158. (defun multishell-version (&optional here)
  159. "Return string describing the loaded multishell version."
  160. (interactive "P")
  161. (let ((msg (concat "Multishell " multishell-version)))
  162. (if here (insert msg)
  163. (if (called-interactively-p 'interactive)
  164. (message "%s" msg)
  165. msg))))
  166. (defgroup multishell nil
  167. "Allout extension that highlights outline structure graphically.
  168. Customize `allout-widgets-auto-activation' to activate allout-widgets
  169. with allout-mode."
  170. :group 'shell)
  171. (defcustom multishell-command-key "\M- "
  172. "The key to use if `multishell-activate-command-key' is true.
  173. You can instead manually bind `multishell-pop-to-shell` using emacs
  174. lisp, eg: (global-set-key \"\\M- \" 'multishell-pop-to-shell)."
  175. :type 'key-sequence)
  176. (defvar multishell--responsible-for-command-key nil
  177. "Coordination for multishell key assignment.")
  178. (defun multishell-activate-command-key-setter (symbol setting)
  179. "Implement `multishell-activate-command-key' choice."
  180. (set-default symbol setting)
  181. (when (or setting multishell--responsible-for-command-key)
  182. (multishell-implement-command-key-choice (not setting))))
  183. (defun multishell-implement-command-key-choice (&optional unbind)
  184. "If settings dicate, implement binding of multishell command key.
  185. If optional UNBIND is true, globally unbind the key.
  186. * `multishell-activate-command-key' - Set this to get the binding or not.
  187. * `multishell-command-key' - The key to use for the binding, if appropriate."
  188. (cond (unbind
  189. (when (and (boundp 'multishell-command-key) multishell-command-key)
  190. (global-unset-key multishell-command-key)))
  191. ((not (and (boundp 'multishell-activate-command-key)
  192. (boundp 'multishell-command-key)))
  193. nil)
  194. ((and multishell-activate-command-key multishell-command-key)
  195. (setq multishell--responsible-for-command-key t)
  196. (global-set-key multishell-command-key 'multishell-pop-to-shell))))
  197. (defcustom multishell-activate-command-key nil
  198. "Set this to impose the `multishell-command-key' binding.
  199. You can instead manually bind `multishell-pop-to-shell` using emacs
  200. lisp, eg: (global-set-key \"\\M- \" 'multishell-pop-to-shell)."
  201. :type 'boolean
  202. :set 'multishell-activate-command-key-setter)
  203. ;; Implement the key customization whenever the package is loaded:
  204. (if (fboundp 'with-eval-after-load)
  205. (with-eval-after-load "multishell"
  206. (multishell-implement-command-key-choice))
  207. (eval-after-load "multishell"
  208. '(multishell-implement-command-key-choice)))
  209. (defcustom multishell-pop-to-frame nil
  210. "*If non-nil, jump to a frame already showing the shell, if another one is.
  211. Otherwise, disregard already-open windows on the shell if they're
  212. in another frame, and open a new window on the shell in the
  213. current frame.
  214. \(Use `pop-up-windows' to change multishell other-window vs
  215. current-window behavior.)"
  216. :type 'boolean)
  217. (defcustom multishell-history-entry-tracks-current-directory t
  218. "Maintain shell's current directory in its multishell history entry.
  219. When set, the history entry for shells started with explicit
  220. paths will track the shell's current working directory.
  221. If `savehist-save-minibuffer-history' is enabled, the current
  222. working directory of shells will be conveyed between emacs
  223. sessions."
  224. :type 'boolean)
  225. (defvar multishell-history nil
  226. "Name/path entries, most recent first.")
  227. ;; Migrate the few pre 1.0.5 users to changed history var:
  228. (when (and (not multishell-history)
  229. (boundp 'multishell-buffer-name-history)
  230. multishell-buffer-name-history)
  231. (setq multishell-history multishell-buffer-name-history
  232. multishell-buffer-name-history nil))
  233. (defvar multishell-primary-name "*shell*"
  234. "Default shell name for un-modified multishell-pop-to-shell buffer target.
  235. This is set by `multishell-pop-to-shell' as the current default,
  236. when invoked with doubled universal argument.
  237. If you want the designated primary that you have at the end of
  238. one emacs session to be resumed at the next, customize
  239. `savehist-additional-variables' to include the
  240. `multishell-primary-name'.")
  241. (defvar multishell-completing-read nil
  242. "Internal use, conveying whether or not we're in the midst of a multishell
  243. completing-read.")
  244. ;; Multiple entries happen because completion also adds name to history.
  245. (defun multishell-register-name-to-path (name path)
  246. "Add or replace entry associating NAME with PATH in `multishell-history'.
  247. If NAME already had a PATH and new PATH is empty, retain the prior one.
  248. Promote added/changed entry to the front of the list."
  249. ;; Add or promote to the front, tracking path changes in the process.
  250. (let* ((entries (multishell-history-entries name))
  251. (path (or path "")))
  252. (dolist (entry entries)
  253. (when (string= path "")
  254. ;; Retain explicit established path.
  255. (setq path (cadr (multishell-split-entry entry))))
  256. (setq multishell-history (delete entry multishell-history)))
  257. (setq multishell-history (push (concat name path)
  258. multishell-history))))
  259. (defun multishell-replace-entry (entry revised)
  260. "Replace every instance of ENTRY in `multishell-history' with REVISED.
  261. Revised entry is situated where former one was.
  262. Returns non-nil iff any changes were made."
  263. (let ((candidates multishell-history)
  264. did-revisions)
  265. (while (setq candidates (member entry candidates))
  266. (setcar candidates revised)
  267. (setq candidates (cdr candidates)
  268. did-revisions t))
  269. did-revisions))
  270. (defun multishell-history-entries (name)
  271. "Return `multishell-history' entry that starts with NAME, or nil if none."
  272. (let (got)
  273. (dolist (entry multishell-history)
  274. (when (and (string-equal name (multishell-name-from-entry entry))
  275. (not (member entry got)))
  276. (push entry got)))
  277. got))
  278. ;;;###autoload
  279. (defun multishell-pop-to-shell (&optional arg name here)
  280. "Easily navigate to and within multiple shell buffers, local and remote.
  281. Use a single `universal-argument' (\\[universal-argument]) to launch and choose between
  282. nalternate shell buffers, and a doubled universal argument to also set your
  283. choice as the ongoing default. Append a path to a new shell name to launch
  284. a shell in that directory, and use Emacs tramp syntax to launch a remote
  285. shell. There is a shortcut to manage your list of current and
  286. historical shells, collectively, using `multishell-list' - see below.
  287. Customize-group `multishell' to set up a key binding and tweak behaviors.
  288. Manage your collection of current and historical shells by
  289. recursively invoking \\[multishell-pop-to-shell] at the
  290. `multishell-pop-to-shell' universal argument prompts, eg:
  291. \\[universal-argument] \\[multishell-pop-to-shell] \\[multishell-pop-to-shell]
  292. \(That will be just a few keys if you do the above
  293. customization.) Hit ? in the listing buffer for editing commands.
  294. ==== Basic operation:
  295. - If the current buffer is shell-mode (or shell-mode derived)
  296. buffer then focus is moved to the process input point.
  297. \(You can use a universal argument go to a different shell
  298. buffer when already in a buffer that has a process - see
  299. below.)
  300. - If not in a shell buffer (or with universal argument), go to a
  301. window that is already showing the (a) shell buffer, if any.
  302. In this case, the cursor is left in its prior position in the
  303. shell buffer. Repeating the command will then go to the
  304. process input point, per the first item in this list.
  305. We respect `pop-up-windows', so you can adjust it to set the
  306. other-buffer/same-buffer behavior.
  307. - Otherwise, start a new shell buffer, using the current
  308. directory as the working directory.
  309. If a buffer with the resulting name exists and its shell process
  310. was disconnected or otherwise stopped, it's resumed.
  311. ===== Universal arg to start and select between named shell buffers:
  312. You can name alternate shell buffers to create or return to, by
  313. prefixing your \\[multishell-pop-to-shell] invocation with single or double
  314. `universal-argument', \\[universal-argument]:
  315. - With a single universal argument, prompt for the buffer name
  316. to use (without the asterisks that shell mode will put around
  317. the name), defaulting to 'shell'.
  318. Completion is available.
  319. This combination makes it easy to start and switch across
  320. multiple shell restarts.
  321. - A double universal argument will prompt for the name *and* set
  322. the default to that name, so the target shell becomes the
  323. primary.
  324. See `multishell-primary-name' for info about preserving the
  325. setting across emacs restarts.
  326. - Manage your collection of current and historical shells by
  327. recursively invoking \\[multishell-pop-to-shell] at either of the
  328. `multishell-pop-to-shell' universal argument prompts, or at any
  329. time via \\[multishell-list]. Hit ? in the listing buffer for
  330. editing commands.
  331. ===== Select starting directory and remote host:
  332. The shell buffer name you give to the prompt for a universal arg
  333. can include an appended path. That will be used for the startup
  334. directory. You can use tramp remote syntax to specify a remote
  335. shell. If there is an element after a final '/', that's used for
  336. the buffer name. Otherwise, the host, domain, or path is used.
  337. For example:
  338. * '#root/sudo:root@localhost:/etc' for a buffer named \"*#root*\" with a
  339. root shell starting in /etc.
  340. * '/ssh:example.net:' for a shell buffer in your homedir on example.net.
  341. The buffer will be named \"*example.net*\".
  342. * '#ex/ssh:example.net|sudo:root@example.net:/var/log' for a root shell
  343. starting in /var/log on example.net named \"*#ex*\".
  344. * 'interior/ssh:gateway.corp.com|ssh:interior.corp.com:' to go
  345. via gateway.corp.com to your homedir on interior.corp.com. The
  346. buffer will be named \"*interior*\". You could append a sudo
  347. hop to the path, combining the previous example, and so on.
  348. File visits from the shell, and many common emacs activities like
  349. dired, will be on the host where the shell is running, in the
  350. auspices of the target account, and relative to the current
  351. directory.
  352. You can change the startup path for a shell buffer by editing it
  353. at the completion prompt. The new path will not take effect for
  354. an already-running shell.
  355. To remove a shell buffer's history entry, kill the buffer and
  356. affirm removal of the entry when prompted.
  357. ===== Activate savehist to retain shell buffer names and paths across Emacs restarts:
  358. To have emacs maintain your history of shell buffer names and paths,
  359. customize the savehist group to activate savehist."
  360. (interactive "P")
  361. (let ((token '(token)))
  362. (if (window-minibuffer-p)
  363. (throw 'multishell-minibuffer-exit token)
  364. (let ((got (catch 'multishell-minibuffer-exit
  365. (multishell-pop-to-shell-worker arg name here))))
  366. ;; Handle catch or plain fall-through - see cond comments for protocol.
  367. (cond
  368. ;; Caught token from recursive invocation in minibuffer:
  369. ((equal token got) (multishell-list))
  370. ;; Caught specifaction of multishell args, eg from multishell-list:
  371. ((listp got) (multishell-pop-to-shell-worker (nth 2 got)
  372. (nth 0 got)
  373. (nth 1 got)))
  374. ;; Regular fallthrough - just relay the result:
  375. (t got))))))
  376. (defun multishell-pop-to-shell-worker (&optional arg name here)
  377. "Do real work of `multishell-pop-to-shell', which see."
  378. (let* ((from-buffer (current-buffer))
  379. (from-buffer-is-shell (derived-mode-p 'shell-mode))
  380. (primary-name-unbracketed (multishell-unbracket
  381. multishell-primary-name))
  382. (fallthrough-name (if from-buffer-is-shell
  383. (buffer-name from-buffer)
  384. primary-name-unbracketed))
  385. (doublearg (equal arg '(16)))
  386. (target-name-and-path
  387. (multishell-resolve-target-name-and-path
  388. (cond (name name)
  389. (arg
  390. (or (multishell-read-unbracketed-entry
  391. (format "Shell buffer name [%s]%s "
  392. primary-name-unbracketed
  393. (if doublearg " <==" ":")))
  394. primary-name-unbracketed))
  395. (t fallthrough-name))))
  396. (use-path (cadr target-name-and-path))
  397. (target-shell-buffer-name (car target-name-and-path))
  398. (target-buffer (get-buffer target-shell-buffer-name))
  399. (curr-buff-proc (get-buffer-process from-buffer))
  400. inwin
  401. already-there)
  402. ;; Register early so the entry is pushed to the front:
  403. (multishell-register-name-to-path (multishell-unbracket
  404. target-shell-buffer-name)
  405. use-path)
  406. (when doublearg
  407. (setq multishell-primary-name target-shell-buffer-name))
  408. ;; Situate:
  409. (cond
  410. ((and (or curr-buff-proc from-buffer-is-shell)
  411. (not arg)
  412. (eq from-buffer target-buffer)
  413. (not (eq target-shell-buffer-name (buffer-name from-buffer))))
  414. ;; In a shell buffer, but not named - stay in buffer, but go to end.
  415. (setq already-there t))
  416. ((string= (buffer-name) target-shell-buffer-name)
  417. ;; Already in the specified shell buffer:
  418. (setq already-there t))
  419. ((or (not target-buffer)
  420. (not (setq inwin
  421. (multishell-get-visible-window-for-buffer target-buffer))))
  422. ;; No preexisting shell buffer, or not in a visible window:
  423. (when (not (get-buffer target-shell-buffer-name))
  424. (message "Creating new shell buffer '%s'" target-shell-buffer-name))
  425. (if here
  426. (switch-to-buffer target-shell-buffer-name)
  427. (pop-to-buffer target-shell-buffer-name pop-up-windows)))
  428. ;; Buffer exists and already has a window - jump to it:
  429. (t (if (and multishell-pop-to-frame
  430. inwin
  431. (not (equal (window-frame (selected-window))
  432. (window-frame inwin))))
  433. (select-frame-set-input-focus (window-frame inwin)))
  434. (if (not (string= (buffer-name (current-buffer))
  435. target-shell-buffer-name))
  436. (if here
  437. (switch-to-buffer target-shell-buffer-name)
  438. (pop-to-buffer target-shell-buffer-name t)))))
  439. ;; We're in the buffer. Activate:
  440. (if (not (comint-check-proc (current-buffer)))
  441. (multishell-start-shell-in-buffer use-path))
  442. ;; If the destination buffer has a stopped process, resume it:
  443. (let ((process (get-buffer-process (current-buffer))))
  444. (if (and process (equal 'stop (process-status process)))
  445. (continue-process process)))
  446. (when (or already-there
  447. (equal (current-buffer) from-buffer))
  448. (goto-char (point-max))
  449. (and (get-buffer-process from-buffer)
  450. (goto-char (process-mark (get-buffer-process from-buffer)))))))
  451. (defun multishell-delete-history-name (name &optional ask)
  452. "Remove all multishell history entries for NAME.
  453. if optional ask is non-nil (default nil), ask before each deletion.
  454. Return the last entry deleted."
  455. (let (got)
  456. (dolist (entry (multishell-history-entries name) got)
  457. (when (and entry
  458. (or (not ask)
  459. (y-or-n-p (format "Remove multishell history entry `%s'? "
  460. entry))))
  461. (setq got entry
  462. multishell-history (delete entry multishell-history))))))
  463. (defun multishell-kill-buffer-query-function ()
  464. "Offer to remove multishell-history entry for buffer."
  465. ;; Removal choice is crucial, so users can, eg, kill a shell with huge
  466. ;; output backlog, while keeping the history entry to easily restart it.
  467. ;;
  468. ;; We use kill-buffer-query-functions instead of kill-buffer-hook because:
  469. ;;
  470. ;; 1. It enables the user to remove the history without actually killing a
  471. ;; running buffer, by not confirming the subsequent running-proc query.
  472. ;; 2. kill-buffer-hooks often fails to run when killing shell buffers!
  473. ;; It's probably due to failures in other hooks - beyond our control -
  474. ;; and anyway, I like the first reason well enough.
  475. ;; (Use condition-case to avoid inadvertant disruption of kill-buffer
  476. ;; activity. kill-buffer happens behind the scenes a whole lot.)
  477. (condition-case err
  478. (and (derived-mode-p 'shell-mode)
  479. (multishell-delete-history-name
  480. (multishell-unbracket (buffer-name))
  481. t))
  482. (error
  483. (message "multishell-kill-buffer-query-function error: %s" err)))
  484. t)
  485. (add-hook 'kill-buffer-query-functions 'multishell-kill-buffer-query-function)
  486. (defun multishell-get-visible-window-for-buffer (buffer)
  487. "Return visible window containing buffer."
  488. (catch 'got-a-vis
  489. (walk-windows
  490. (function (lambda (win)
  491. (if (and (eq (window-buffer win) buffer)
  492. (equal (frame-parameter
  493. (selected-frame) 'display)
  494. (frame-parameter
  495. (window-frame win) 'display)))
  496. (throw 'got-a-vis win))))
  497. nil 'visible)
  498. nil))
  499. (defun multishell-all-entries (&optional active-duplicated)
  500. "Return multishell history, with active buffers listed first.
  501. Optional ACTIVE-DUPLICATED will return a copy of
  502. `multishell-history' with unbracketed names of active buffers,
  503. sans paths, appended to the list, so they have short and long
  504. completions."
  505. ;; Reorder so active lead present lead historical entries:
  506. (let (active-entries active-names present past splat name buffer)
  507. (dolist (entry multishell-history)
  508. (setq splat (multishell-split-entry entry)
  509. name (car splat)
  510. buffer (and name (get-buffer (multishell-bracket name))))
  511. (if (buffer-live-p buffer)
  512. (if (comint-check-proc buffer)
  513. (setq active-entries (push entry active-entries)
  514. active-names (push name active-names))
  515. (setq present (push entry present)))
  516. (setq past (push entry past))))
  517. ;; Reverse present and past lists
  518. (setq multishell-history (append (reverse active-entries)
  519. (reverse present)
  520. (reverse past)))
  521. (if active-duplicated
  522. (append multishell-history active-names)
  523. multishell-history)))
  524. (defun multishell-read-unbracketed-entry (prompt &optional initial no-record)
  525. "PROMPT for shell buffer name, sans asterisks.
  526. Optional INITIAL is preliminary value to be edited.
  527. Optional NO-RECORD prevents changes to `multishell-history'
  528. across the activity.
  529. Input and completion can include associated path, if any.
  530. Return what's provided, if anything, else nil."
  531. (let* ((was-multishell-history multishell-history)
  532. (candidates (multishell-all-entries 'active-duplicated))
  533. (multishell-completing-read t)
  534. (got
  535. ;; Use `cl-letf' to dynamically bind multishell-list to
  536. ;; display-completion-list, so multishell-list is used when doing
  537. ;; minibuffer-completion-help.
  538. (cl-letf (((symbol-function 'display-completion-list)
  539. #'multishell-list))
  540. (completing-read prompt
  541. ;; COLLECTION:
  542. (reverse candidates)
  543. ;; PREDICATE:
  544. nil
  545. ;; REQUIRE-MATCH:
  546. 'confirm
  547. ;; INITIAL-INPUT
  548. initial
  549. ;; HIST:
  550. 'multishell-history))))
  551. (when no-record
  552. (setq multishell-history was-multishell-history))
  553. (if (not (string= got ""))
  554. got
  555. nil)))
  556. (defun multishell-resolve-target-name-and-path (shell-spec)
  557. "Given name/tramp-style address shell spec, resolve buffer name and directory.
  558. The name is the part of the string up to the first '/' slash, if
  559. any. Missing pieces are filled in from remote path elements, if
  560. any, and multishell history. Given a tramp-style remote address
  561. and no name part, either the user@host is used for the buffer
  562. name, if a user is specified, or just the host.
  563. Return them as a list: (name path), with name asterisk-bracketed
  564. and path nil if none is resolved."
  565. (let* ((splat (multishell-split-entry (or shell-spec "")))
  566. (path (cadr splat))
  567. (name (or (car splat) (multishell-name-from-entry path))))
  568. (when (not path)
  569. ;; Get path from history, if present.
  570. (dolist (entry
  571. (multishell-history-entries
  572. (multishell-unbracket name)))
  573. (when (or (not path) (string= path ""))
  574. (setq path (cadr (multishell-split-entry entry))))))
  575. (list (multishell-bracket name) path)))
  576. (defun multishell-name-from-entry (entry)
  577. "Derive a name for a shell buffer according to ENTRY."
  578. (if (not entry)
  579. (multishell-unbracket multishell-primary-name)
  580. (let* ((splat (multishell-split-entry entry))
  581. (name (car splat))
  582. (path (cadr splat)))
  583. (or name
  584. (if (file-remote-p path)
  585. (let ((host (file-remote-p path 'host))
  586. (user (file-remote-p path 'user)))
  587. (cond ((and host user)
  588. (format "%s@%s" user host))
  589. (host host)
  590. (user user)
  591. ((system-name))))
  592. (multishell-unbracket multishell-primary-name))))))
  593. (declare-function tramp-dissect-file-name "tramp")
  594. (declare-function tramp-cleanup-connection "tramp")
  595. (defun multishell-start-shell-in-buffer (path)
  596. "Start, restart, or continue a shell in BUFFER-NAME on PATH."
  597. (let* ((is-active (comint-check-proc (current-buffer))))
  598. (when (and path (not is-active))
  599. (when (and (derived-mode-p 'shell-mode) (file-remote-p path))
  600. ;; Returning to disconnected remote shell - do some tidying.
  601. ;; Without this cleanup, occasionally restarting a disconnected
  602. ;; remote session, particularly one that includes sudo, results in
  603. ;; an untraceable "Args out of range" error. That never happens if
  604. ;; we precedeed connection attempts with this cleanup -
  605. ;; prophylactic.
  606. (tramp-cleanup-connection
  607. (tramp-dissect-file-name default-directory 'noexpand)
  608. 'keep-debug 'keep-password))
  609. (when (file-remote-p path) (message "Connecting to %s" path))
  610. (cd path))
  611. (shell (current-buffer))))
  612. (defun multishell-homedir-shorthand-p (dirpath)
  613. "t if dirpath is an unexpanded remote homedir spec."
  614. ;; Workaround to recognize tramp-style homedir shorthand, "...:" and "...:~".
  615. (let ((localname (file-remote-p dirpath 'localname)))
  616. (and localname
  617. (or
  618. ;; No directory path and no connection to expand homedir:
  619. (string= localname "")
  620. ;; Original path doesn't equal expanded homedir:
  621. (save-match-data
  622. (not (string-match (concat (regexp-quote localname) "/?$")
  623. dirpath)))))))
  624. ;; (assert (multishell-homedir-shorthand-p "/ssh:myhost.net:")
  625. ;; (assert (not (multishell-homedir-shorthand-p "/home/klm")))
  626. ;; (assert (not (multishell-homedir-shorthand-p "/ssh:myhost.net:/home/me")))
  627. (defun multishell-track-dirchange (name newpath)
  628. "Change multishell history entry to track current directory."
  629. (let* ((entries (multishell-history-entries name)))
  630. (dolist (entry entries)
  631. (let* ((name-path (multishell-split-entry entry))
  632. (name (car name-path))
  633. (path (or (cadr name-path) "")))
  634. (when path
  635. (let* ((old-localname (or (file-remote-p path 'localname)
  636. path))
  637. (newentry
  638. (if (multishell-homedir-shorthand-p path)
  639. (concat entry newpath)
  640. (replace-regexp-in-string (concat (regexp-quote
  641. old-localname)
  642. "$")
  643. ;; REPLACEMENT
  644. newpath
  645. ;; STRING
  646. entry
  647. ;; FIXEDCASE
  648. t
  649. ;; LITERAL
  650. t
  651. )))
  652. (membership (member entry multishell-history)))
  653. (when membership
  654. (setcar membership newentry))))))))
  655. (defvar multishell-was-default-directory ()
  656. "Provide for tracking directory changes.")
  657. (make-variable-buffer-local 'multishell-was-default-directory)
  658. (defun multishell-post-command-business ()
  659. "Do multishell bookkeeping."
  660. ;; Update multishell-history with dir changes.
  661. (condition-case err
  662. (when (and multishell-history-entry-tracks-current-directory
  663. (derived-mode-p 'shell-mode))
  664. (let ((curdir (if (file-remote-p default-directory)
  665. (file-remote-p default-directory 'localname)
  666. default-directory)))
  667. (when (not (string= curdir (or multishell-was-default-directory "")))
  668. (multishell-track-dirchange (multishell-unbracket (buffer-name))
  669. curdir))
  670. (setq multishell-was-default-directory curdir)))
  671. ;; To avoid disruption as a pervasive hook function, swallow all errors:
  672. (error
  673. (message "multishell-post-command-business error: %s" err))))
  674. (add-hook 'post-command-hook #'multishell-post-command-business)
  675. (defun multishell-split-entry (entry)
  676. "Given multishell name/path ENTRY, return the separated name and path pair.
  677. Returns nil for empty parts, rather than the empty string."
  678. (save-match-data
  679. (string-match "^\\([^/]*\\)\\(/?.*\\)?" entry)
  680. (let ((name (match-string 1 entry))
  681. (path (match-string 2 entry)))
  682. (and (string= name "") (setq name nil))
  683. (and (string= path "") (setq path nil))
  684. (list name path))))
  685. (defun multishell-bracket (name)
  686. "Return a copy of name, ensuring it has an asterisk at the beginning and end."
  687. (if (not (string= (substring name 0 1) "*"))
  688. (setq name (concat "*" name)))
  689. (if (not (string= (substring name -1) "*"))
  690. (setq name (concat name "*")))
  691. name)
  692. (defun multishell-unbracket (name)
  693. "Return a copy of name, removing asterisks, if any, at beginning and end."
  694. (if (string= (substring name 0 1) "*")
  695. (setq name (substring name 1)))
  696. (if (string= (substring name -1) "*")
  697. (setq name (substring name 0 -1)))
  698. name)
  699. (provide 'multishell)
  700. ;;; multishell.el ends here