code.delx.au - gnu-emacs-elpa/blob - multishell-list.el

   1 ;;; multishell-list.el --- tabulated-list-mode for multishell shell buffers
   2
   3 ;; Copyright (C) 2016 Free Software Foundation, Inc. and Ken Manheimer
   4
   5 ;; Author: Ken Manheimer <ken.manheimer@gmail.com>
   6 ;; Version: 1.1.2
   7 ;; Created: 2016 -- first public availability
   8 ;; Keywords: processes
   9 ;; URL: https://github.com/kenmanheimer/EmacsMultishell
  10
  11 ;; See multishell.el for commentary, change log, etc.
  12
  13 (require 'tabulated-list)
  14
  15 (defun multishell-list-open-pop (&optional arg)
  16   "Pop to current entry's shell in separate window.
  17
  18 The shell is started if it's not already going, unless this is
  19 invoked with optional `universal-argument'. In that case we
  20 pop to the buffer but don't change its run state."
  21   (interactive "P")
  22   (let ((list-buffer (current-buffer))
  23         (entry (tabulated-list-get-id)))
  24     (if arg
  25         (pop-to-buffer
  26          (multishell-bracket (multishell-name-from-entry entry)))
  27       (multishell-pop-to-shell nil entry))
  28     (with-current-buffer list-buffer
  29       (revert-buffer))))
  30 (defun multishell-list-open-as-default ()
  31   "Pop to current entry's shell, and set as the default shell."
  32   (interactive)
  33   (let ((list-buffer (current-buffer)))
  34     (message "%s <==" (multishell-name-from-entry (tabulated-list-get-id)))
  35     (multishell-pop-to-shell '(16) (tabulated-list-get-id))
  36     (with-current-buffer list-buffer
  37       (revert-buffer))))
  38 (defun multishell-list-open-here (&optional arg)
  39   "Switch to current entry's shell buffer.
  40
  41 The shell is started if it's not already going, unless this is
  42 invoked with optional `universal-argument'. In that case we
  43 switch to the buffer but don't activate (or deactivate) it it."
  44   (interactive "P")
  45   (let* ((list-buffer (current-buffer))
  46          (entry  (tabulated-list-get-id)))
  47     (if arg
  48         (switch-to-buffer
  49          (multishell-bracket (multishell-name-from-entry entry)))
  50       (multishell-pop-to-shell nil entry 'here))
  51     (with-current-buffer list-buffer
  52       (revert-buffer))))
  53
  54 (defun multishell-list-delete (&optional arg)
  55   "Remove current shell entry, and prompt for buffer-removal if present."
  56   (interactive "P")
  57   (let* ((entry (tabulated-list-get-id))
  58          (name (multishell-name-from-entry entry))
  59          (name-bracketed (multishell-bracket name))
  60          (buffer (get-buffer name-bracketed)))
  61     (when (multishell-delete-history-name name)
  62       (and buffer
  63            ;; If the process is live, let shell-mode get confirmation:
  64            (or (comint-check-proc (current-buffer))
  65                (y-or-n-p (format "Kill buffer %s? " name-bracketed)))
  66            (kill-buffer name-bracketed)))
  67     (tabulated-list-delete-entry)))
  68
  69 (defun multishell-list-edit-entry (&optional arg)
  70   "Edit the value of current shell entry.
  71
  72 Submitting the change will not launch the entry, unless this is
  73 invoked with optional `universal-argument'. In the latter case,
  74 submitting the entry will pop to the shell in a new window,
  75 starting it if it's not already going."
  76
  77   (interactive "P")
  78   (let* ((where (save-excursion (beginning-of-line) (point)))
  79          (list-buffer (current-buffer))
  80          (entry (tabulated-list-get-id))
  81          (name (multishell-name-from-entry entry))
  82          (revised (multishell-read-unbracketed-entry
  83                    (format "Edit shell spec for %s: " name)
  84                    entry
  85                    'no-record))
  86          (revised-name (multishell-name-from-entry revised))
  87          buffer)
  88     (when (not (string= revised entry))
  89       (multishell-replace-entry entry revised)
  90       (when (and (not (string= name revised-name))
  91                  (setq buffer (get-buffer (multishell-bracket name))))
  92         (with-current-buffer buffer
  93           (rename-buffer (multishell-bracket revised-name)))))
  94     (when arg
  95       (multishell-pop-to-shell nil revised-name))
  96     (with-current-buffer list-buffer
  97       (revert-buffer)
  98       (goto-char where))))
  99
 100 (defun multishell-list-clone-entry (&optional arg)
 101   "Create a new list entry, edited from the current one, ready to launch.
 102
 103 If you provide an optional `universal-argument', the new entry
 104 will be launched when it's created.
 105
 106 The already existing original entry is left untouched."
 107   (interactive "P")
 108   (let* ((prototype (tabulated-list-get-id))
 109          (name (multishell-name-from-entry prototype))
 110          (new (multishell-read-unbracketed-entry
 111                (format "Clone new shell spec from %s: " name)
 112                prototype
 113                'no-record))
 114          (new-name (multishell-name-from-entry new))
 115          (new-path (cadr (multishell-split-entry new))))
 116     (when (not (string= new prototype))
 117       (multishell-register-name-to-path new-name new-path)
 118       (revert-buffer)
 119       (multishell-list-goto-item-by-entry new)
 120       (when arg
 121         (multishell-pop-to-shell nil new-name)))))
 122
 123 (defun multishell-list-placeholder (value default)
 124   "Return VALUE if non-empty string, else DEFAULT."
 125   (if (or (not value) (string= value ""))
 126       default
 127     value))
 128 (defconst multishell-list-active-flag "+")
 129 (defconst multishell-list-inactive-flag ".")
 130 (defconst multishell-list-absent-flag "x")
 131
 132 (defun multishell-list-entries ()
 133   "Generate multishell name/path-spec entries list for tabulated-list."
 134   (let ((recency 0))
 135     (mapcar #'(lambda (entry)
 136                 (setq recency (1+ recency))
 137                 (let* ((splat (multishell-split-entry entry))
 138                        (name (car splat))
 139                        (buffer (and name
 140                                     (get-buffer
 141                                      (multishell-bracket name))))
 142                        (status (cond ((not buffer)
 143                                       multishell-list-absent-flag)
 144                                      ((comint-check-proc buffer)
 145                                       multishell-list-active-flag)
 146                                      (t multishell-list-inactive-flag)))
 147                        (rest (cadr splat))
 148                        (dir (or (file-remote-p rest 'localname)
 149                                 rest))
 150                        (hops (and (file-remote-p rest 'localname)
 151                                   (substring
 152                                    rest 0 (- (length rest) (length dir))))))
 153                   (when (not name)
 154                     (setq name (multishell-name-from-entry entry)))
 155                   (list entry
 156                         (vector (format "%d" recency)
 157                                 status
 158                                 name
 159                                 (multishell-list-placeholder hops "-")
 160                                 (multishell-list-placeholder dir "~")))))
 161             (multishell-all-entries))))
 162
 163 (defun multishell-list-goto-item-by-entry (entry)
 164   "Position at beginning of line of tabulated list item for ENTRY."
 165   (goto-char (point-min))
 166   (while (and (not (eobp))
 167               (not (string= (tabulated-list-get-id) entry)))
 168     (forward-line 1)))
 169
 170 (defun compare-strings-as-numbers (a b)
 171   (let ((a (aref (cadr a) 0))
 172         (b (aref (cadr b) 0)))
 173     (> (string-to-number a) (string-to-number b))))
 174
 175 (defvar multishell-list-mode-map
 176   (let ((map (make-sparse-keymap)))
 177     (define-key map (kbd "c") 'multishell-list-clone-entry)
 178     (define-key map (kbd "d") 'multishell-list-delete)
 179     (define-key map (kbd "\C-k") 'multishell-list-delete)
 180     (define-key map (kbd "k") 'multishell-list-delete)
 181     (define-key map (kbd "e") 'multishell-list-edit-entry)
 182     (define-key map (kbd "o") 'multishell-list-open-pop)
 183     (define-key map (kbd " ") 'multishell-list-open-pop)
 184     (define-key map (kbd "O") 'multishell-list-open-as-default)
 185     (define-key map (kbd "RET") 'multishell-list-open-here)
 186     map))
 187 (define-derived-mode multishell-list-mode
 188     tabulated-list-mode "Shells"
 189   "Major mode for listing current and historically registered shells.
 190
 191 Initial sort is from most to least recently used:
 192
 193 - First active shells, flagged with '+' a plus sign
 194 - Then, inactive shells, flagged with '.' a period
 195 - Then historical shells that currently have no buffer, flagged with 'x' an ex
 196
 197 \\{multishell-list-mode-map\}"
 198   (setq tabulated-list-format
 199         [;; (name width sort '(:right-align nil :pad-right nil))
 200          ("#" 0 compare-strings-as-numbers :pad-right 1)
 201          ("! " 1 t :pad-right 1)
 202          ("Name" 15 t)
 203          ("Hops" 30 t)
 204          ("Directory" 30 t)]
 205         tabulated-list-sort-key '("#" . t)
 206         tabulated-list-entries #'multishell-list-entries)
 207   (tabulated-list-init-header))
 208
 209 ;;;###autoload
 210 (defun multishell-list ()
 211   "Edit your current and historic list of shell buffers.
 212
 213 Hit ? for a list of commands.
 214
 215 You can get to this shell listing manager by
 216 recursively invoking \\[multishell-pop-to-shell] at either of the
 217 `multishell-pop-to-shell' universal argument prompts."
 218   (interactive)
 219   (let ((buffer (get-buffer-create "*Shells*")))
 220     (pop-to-buffer buffer)
 221     (multishell-list-mode)
 222     (tabulated-list-print)))
 223
 224 (provide 'multishell-list)
 225 (require 'multishell)
 226
 227 ;;; multishell-list.el ends here