my-emacs-d/elpa/emamux-20160602.653/emamux.el
2016-09-22 17:10:30 +02:00

577 lines
19 KiB
EmacsLisp

;;; emamux.el --- Interact with tmux -*- lexical-binding: t; -*-
;; Copyright (C) 2016 by Syohei YOSHIDA
;; Author: Syohei YOSHIDA <syohex@gmail.com>
;; URL: https://github.com/syohex/emacs-emamux
;; Package-Version: 20160602.653
;; Version: 0.13
;; Package-Requires: ((emacs "24") (cl-lib "0.5"))
;; 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 this program. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; emamux makes you interact emacs and tmux.
;; emamux is inspired by `vimux' and `tslime.vim'.
;;
;; To use emamux, add the following code into your init.el or .emacs:
;;
;; (require 'emamux)
;;
;; Please see https://github.com/syohex/emacs-emamux/
;; for more information.
;;; Code:
(eval-when-compile
(defvar helm-mode))
(require 'cl-lib)
(require 'tramp)
(defgroup emamux nil
"tmux manipulation from Emacs"
:prefix "emamux:"
:group 'processes)
(defcustom emamux:default-orientation 'vertical
"Orientation of spliting runner pane"
:type '(choice (const :tag "Split pane vertial" vertical)
(const :tag "Split pane horizonal" horizonal)))
(defcustom emamux:runner-pane-height 20
"Orientation of spliting runner pane"
:type 'integer)
(defcustom emamux:use-nearest-pane nil
"Use nearest pane for runner pane"
:type 'boolean)
(defsubst emamux:helm-mode-enabled-p ()
(and (featurep 'helm) helm-mode))
(defcustom emamux:completing-read-type (if ido-mode
'ido
(if (emamux:helm-mode-enabled-p)
'helm
'normal))
"Function type to call for completing read.
For helm completion use either `normal' or `helm' and turn on `helm-mode'."
:type '(choice (const :tag "Using completing-read" 'normal)
(const :tag "Using ido-completing-read" 'ido)
(const :tag "Using helm completion" 'helm)))
(defvar emamux:last-command nil
"Last emit command")
(defvar emamux:session nil)
(defvar emamux:window nil)
(defvar emamux:pane nil)
(defsubst emamux:tmux-running-p ()
(zerop (process-file "tmux" nil nil nil "has-session")))
(defun emamux:tmux-run-command (output &rest args)
(let ((retval (apply 'process-file "tmux" nil output nil args)))
(unless (zerop retval)
(error (format "Failed: %s(status = %d)"
(mapconcat 'identity (cons "tmux" args) " ")
retval)))))
(defun emamux:set-parameters ()
(emamux:set-parameter-session)
(emamux:set-parameter-window)
(emamux:set-parameter-pane))
(defun emamux:unset-parameters ()
(setq emamux:session nil emamux:window nil emamux:pane nil))
(defun emamux:set-parameters-p ()
(and emamux:session emamux:window emamux:pane))
(defun emamux:select-completing-read-function ()
(cl-case emamux:completing-read-type
((normal helm) 'completing-read)
(ido 'ido-completing-read)))
(defun emamux:mode-function ()
(cl-case emamux:completing-read-type
((normal ido) 'ignore)
(helm (if (emamux:helm-mode-enabled-p) 'ignore 'helm-mode))))
(defun emamux:completing-read (prompt &rest args)
(let ((mode-function (emamux:mode-function)))
(unwind-protect
(progn
(funcall mode-function +1)
(apply (emamux:select-completing-read-function) prompt args))
(funcall mode-function -1))))
(defun emamux:read-parameter-session ()
(let ((candidates (emamux:get-sessions)))
(if (= (length candidates) 1)
(car candidates)
(emamux:completing-read "Session: " candidates nil t))))
(defun emamux:set-parameter-session ()
(setq emamux:session (emamux:read-parameter-session)))
(defun emamux:read-parameter-window ()
(let* ((candidates (emamux:get-window))
(selected (if (= (length candidates) 1)
(car candidates)
(emamux:completing-read "Window: " candidates nil t))))
(car (split-string selected ":"))))
(defun emamux:set-parameter-window ()
(setq emamux:window (emamux:read-parameter-window)))
(defun emamux:read-parameter-pane ()
(let ((candidates (emamux:get-pane)))
(if (= (length candidates) 1)
(car candidates)
(emamux:completing-read "Input pane: " candidates))))
(defun emamux:set-parameter-pane ()
(setq emamux:pane (emamux:read-parameter-pane)))
(cl-defun emamux:target-session (&optional (session emamux:session)
(window emamux:window)
(pane emamux:pane))
(format "%s:%s.%s" session window pane))
(defun emamux:get-sessions ()
(with-temp-buffer
(emamux:tmux-run-command t "list-sessions")
(goto-char (point-min))
(let (sessions)
(while (re-search-forward "^\\([^:]+\\):" nil t)
(push (match-string-no-properties 1) sessions))
sessions)))
(defun emamux:get-buffers ()
(with-temp-buffer
(emamux:tmux-run-command t "list-buffers")
(goto-char (point-min))
(cl-loop for count from 0 while
(re-search-forward
"^\\([0-9]+\\): +\\([0-9]+\\) +\\(bytes\\): +[\"]\\(.*\\)[\"]" nil t)
collect (cons (replace-regexp-in-string
"\\s\\" "" (match-string-no-properties 4))
count))))
(defun emamux:show-buffer (index)
(with-temp-buffer
(emamux:tmux-run-command t "show-buffer" "-b" (number-to-string index))
(buffer-substring-no-properties (point-min) (point-max))))
(defun emamux:get-window ()
(with-temp-buffer
(emamux:tmux-run-command t "list-windows" "-t" emamux:session)
(goto-char (point-min))
(let (windows)
(while (re-search-forward "^\\([0-9]+: [^ ]+\\)" nil t)
(push (match-string-no-properties 1) windows))
(reverse windows))))
(defun emamux:get-pane ()
(with-temp-buffer
(let ((pane-id (concat emamux:session ":" emamux:window)))
(emamux:tmux-run-command t "list-panes" "-t" pane-id))
(goto-char (point-min))
(let (panes)
(while (re-search-forward "^\\([0-9]+\\):" nil t)
(push (match-string-no-properties 1) panes))
(reverse panes))))
(defun emamux:read-command (prompt use-last-cmd)
(let ((cmd (read-shell-command prompt (and use-last-cmd emamux:last-command))))
(setq emamux:last-command cmd)
cmd))
(defun emamux:check-tmux-running ()
(unless (emamux:tmux-running-p)
(error "'tmux' does not run on this machine!!")))
;;;###autoload
(defun emamux:send-command ()
"Send command to target-session of tmux"
(interactive)
(emamux:check-tmux-running)
(condition-case nil
(progn
(if (or current-prefix-arg (not (emamux:set-parameters-p)))
(emamux:set-parameters))
(let* ((target (emamux:target-session))
(prompt (format "Command [Send to (%s)]: " target))
(input (emamux:read-command prompt t)))
(emamux:reset-prompt target)
(emamux:send-keys input)))
(quit (emamux:unset-parameters))))
;;;###autoload
(defun emamux:send-region (beg end)
"Send region to target-session of tmux"
(interactive "r")
(emamux:check-tmux-running)
(condition-case nil
(progn
(if (or current-prefix-arg (not (emamux:set-parameters-p)))
(emamux:set-parameters))
(let ((target (emamux:target-session))
(input (buffer-substring-no-properties beg end)))
(setq emamux:last-command input)
(emamux:reset-prompt target)
(emamux:send-keys input)))
(quit (emamux:unset-parameters))))
;;;###autoload
(defun emamux:copy-kill-ring (arg)
"Set (car kill-ring) to tmux buffer"
(interactive "P")
(emamux:check-tmux-running)
(when (null kill-ring)
(error "kill-ring is nil!!"))
(let ((index (or arg 0))
(data (substring-no-properties (car kill-ring))))
(emamux:set-buffer data index)))
;;;###autoload
(defun emamux:yank-from-list-buffers ()
(interactive)
(emamux:check-tmux-running)
(let* ((candidates (emamux:get-buffers))
(index (assoc-default
(emamux:completing-read
"Buffers: " (mapcar 'car candidates))
candidates)))
(insert (emamux:show-buffer index))))
;;;###autoload
(defun emamux:kill-session ()
"Kill tmux session"
(interactive)
(emamux:check-tmux-running)
(let ((session (emamux:read-parameter-session)))
(emamux:tmux-run-command nil "kill-session" "-t" session)))
(defsubst emamux:escape-semicolon (str)
(replace-regexp-in-string ";\\'" "\\\\;" str))
(cl-defun emamux:send-keys (input &optional (target (emamux:target-session)))
(let ((escaped (emamux:escape-semicolon input)))
(emamux:tmux-run-command nil "send-keys" "-t" target escaped "C-m")))
(defun emamux:set-buffer-argument (index data)
(if (zerop index)
(list data)
(list "-b" (number-to-string index) data)))
(defun emamux:set-buffer (data index)
(let ((args (emamux:set-buffer-argument index data)))
(apply 'emamux:tmux-run-command nil "set-buffer" args)))
(defun emamux:in-tmux-p ()
(and (not (display-graphic-p))
(getenv "TMUX")))
(defvar emamux:runner-pane-id-map nil)
(defun emamux:gc-runner-pane-map ()
(let ((alive-window-ids (emamux:window-ids))
ret)
(dolist (entry emamux:runner-pane-id-map)
(if (and (member (car entry) alive-window-ids))
(setq ret (cons entry ret))))
(setq emamux:runner-pane-id-map ret)))
;;;###autoload
(defun emamux:run-command (cmd &optional cmddir)
"Run command"
(interactive
(list (emamux:read-command "Run command: " nil)))
(emamux:check-tmux-running)
(unless (emamux:in-tmux-p)
(error "You are not in 'tmux'"))
(emamux:gc-runner-pane-map)
(let ((current-pane (emamux:current-active-pane-id)))
(unless (emamux:runner-alive-p)
(emamux:setup-runner-pane)
(emamux:chdir-pane cmddir))
(emamux:send-keys cmd (emamux:get-runner-pane-id))
(emamux:select-pane current-pane)))
;;;###autoload
(defun emamux:run-last-command ()
(interactive)
(unless emamux:last-command
(error "You have never run command"))
(emamux:run-command emamux:last-command))
(defun emamux:reset-prompt (pane)
(emamux:tmux-run-command nil "send-keys" "-t" pane "q" "C-u"))
(defun emamux:chdir-pane (dir)
(let ((chdir-cmd (format " cd %s" (or dir default-directory))))
(emamux:send-keys chdir-cmd (emamux:get-runner-pane-id))))
(defun emamux:get-runner-pane-id ()
(assoc-default (emamux:current-active-window-id) emamux:runner-pane-id-map))
(defun emamux:add-to-assoc (key value alist-variable)
(let* ((alist (symbol-value alist-variable))
(entry (assoc key alist)))
(if entry (setcdr entry value)
(set alist-variable
(cons (cons key value) alist)))))
(defun emamux:setup-runner-pane ()
(let ((nearest-pane-id (emamux:nearest-inactive-pane-id (emamux:list-panes))))
(if (and emamux:use-nearest-pane nearest-pane-id)
(progn
(emamux:select-pane nearest-pane-id)
(emamux:reset-prompt nearest-pane-id))
(emamux:split-runner-pane))
(emamux:add-to-assoc
(emamux:current-active-window-id)
(emamux:current-active-pane-id)
'emamux:runner-pane-id-map)))
(defun emamux:select-pane (target)
(emamux:tmux-run-command nil "select-pane" "-t" target))
(defconst emamux:orientation-option-alist
'((vertical . "-v") (horizonal . "-h")))
(defun emamux:split-runner-pane ()
(let ((orient-option (assoc-default emamux:default-orientation
emamux:orientation-option-alist)))
(emamux:tmux-run-command nil
"split-window" "-p"
(number-to-string emamux:runner-pane-height)
orient-option)))
(defun emamux:list-panes ()
(with-temp-buffer
(emamux:tmux-run-command t "list-panes")
(cl-loop initially (goto-char (point-min))
while (re-search-forward "^\\(.+\\)$" nil t)
collect (match-string-no-properties 1))))
(defun emamux:active-pane-id (panes)
(cl-loop for pane in panes
when (string-match "\\([^ ]+\\) (active)\\'" pane)
return (match-string-no-properties 1 pane)))
(defun emamux:current-active-pane-id ()
(emamux:active-pane-id (emamux:list-panes)))
(defun emamux:nearest-inactive-pane-id (panes)
(cl-loop for pane in panes
when (and (not (string-match-p "(active)\\'" pane))
(string-match " \\([^ ]+\\)\\'" pane))
return (match-string-no-properties 1 pane)))
;;;###autoload
(defun emamux:close-runner-pane ()
"Close runner pane"
(interactive)
(let ((window-id (emamux:current-active-window-id)))
(emamux:kill-pane window-id)
(delete (assoc window-id emamux:runner-pane-id-map) emamux:runner-pane-id-map)))
;;;###autoload
(defun emamux:close-panes ()
"Close all panes except current pane"
(interactive)
(when (> (length (emamux:list-panes)) 1)
(emamux:kill-all-panes)))
(defun emamux:kill-all-panes ()
(emamux:tmux-run-command nil "kill-pane" "-a"))
(defun emamux:kill-pane (target)
(emamux:tmux-run-command nil "kill-pane" "-t" target))
(defsubst emamux:pane-alive-p (target)
(zerop (process-file "tmux" nil nil nil "list-panes" "-t" target)))
(defun emamux:runner-alive-p ()
(let ((pane-id
(assoc-default
(emamux:current-active-window-id)
emamux:runner-pane-id-map)))
(and pane-id (emamux:pane-alive-p pane-id))))
(defun emamux:check-runner-alive ()
(unless (emamux:runner-alive-p)
(error "There is no runner pane")))
;;;###autoload
(defun emamux:inspect-runner ()
"Enter copy-mode in runner pane"
(interactive)
(emamux:check-runner-alive)
(emamux:select-pane (emamux:get-runner-pane-id))
(emamux:tmux-run-command nil "copy-mode"))
;;;###autoload
(defun emamux:interrupt-runner ()
"Send SIGINT to runner pane"
(interactive)
(emamux:check-runner-alive)
(emamux:tmux-run-command nil "send-keys" "-t" (emamux:get-runner-pane-id) "^c"))
;;;###autoload
(defun emamux:clear-runner-history ()
"Clear history of runner pane"
(interactive)
(emamux:check-runner-alive)
(emamux:tmux-run-command nil "clear-history" (emamux:get-runner-pane-id)))
;;;###autoload
(defun emamux:zoom-runner ()
"Zoom runner pane. This feature requires tmux 1.8 or higher"
(interactive)
(emamux:check-runner-alive)
(emamux:tmux-run-command nil "resize-pane" "-Z" "-t" (emamux:get-runner-pane-id)))
(defmacro emamux:ensure-ssh-and-cd (&rest body)
"Do whatever the operation, and send keys of ssh and cd according to the `default-directory'."
(cl-declare (special localname host))
`(let (cd-to ssh-to)
(if (file-remote-p default-directory)
(with-parsed-tramp-file-name
default-directory nil
(setq cd-to localname)
(unless (string-match tramp-local-host-regexp host)
(setq ssh-to host)))
(setq cd-to default-directory))
(let ((default-directory (expand-file-name "~")))
,@body
(let ((new-pane-id (emamux:current-active-pane-id))
(chdir-cmd (format " cd %s" cd-to)))
(if ssh-to
(emamux:send-keys (format " ssh %s" ssh-to) new-pane-id))
(emamux:send-keys chdir-cmd new-pane-id)))))
;;;###autoload
(defun emamux:new-window ()
"Create new window by cd-ing to current directory.
With prefix-arg, use '-a' option to insert the new window next to current index."
(interactive)
(emamux:ensure-ssh-and-cd
(apply 'emamux:tmux-run-command nil "new-window"
(and current-prefix-arg '("-a")))))
(defun emamux:list-windows ()
(with-temp-buffer
(emamux:tmux-run-command t "list-windows")
(cl-loop initially (goto-char (point-min))
while (re-search-forward "^\\(.+\\)$" nil t)
collect (match-string-no-properties 1))))
(defun emamux:window-ids ()
(with-temp-buffer
(emamux:tmux-run-command t "list-windows" "-F" "#{window_id}")
(split-string (buffer-string))))
(defun emamux:active-window-id (windows)
(cl-loop for window in windows
when (string-match "\\([^ ]+\\) (active)\\'" window)
return (match-string-no-properties 1 window)))
(defun emamux:current-active-window-id ()
(emamux:active-window-id (emamux:list-windows)))
(defvar emamux:cloning-window-state nil)
;;;###autoload
(defun emamux:clone-current-frame ()
"Clones current frame into a new tmux window.
With prefix-arg, use '-a' option to insert the new window next to current index."
(interactive)
(setq emamux:cloning-window-state (window-state-get (frame-root-window)))
(apply 'emamux:tmux-run-command nil
"new-window" (and current-prefix-arg '("-a")))
(let ((new-window-id (emamux:current-active-window-id))
(chdir-cmd (format " cd %s" default-directory))
(emacsclient-cmd " emacsclient -t -e '(run-with-timer 0.01 nil (lambda () (window-state-put emamux:cloning-window-state nil (quote safe))))'"))
(emamux:send-keys chdir-cmd new-window-id)
(emamux:send-keys emacsclient-cmd new-window-id)))
;;;###autoload
(defun emamux:split-window ()
(interactive)
(emamux:ensure-ssh-and-cd
(emamux:tmux-run-command nil "split-window")))
;;;###autoload
(defun emamux:split-window-horizontally ()
(interactive)
(emamux:ensure-ssh-and-cd
(emamux:tmux-run-command nil "split-window" "-h")))
;;;###autoload
(defun emamux:run-region (beg end)
"Send region to runner pane."
(interactive "r")
(let ((input (buffer-substring-no-properties beg end)))
(emamux:run-command input)))
(defvar emamux:keymap
(let ((map (make-sparse-keymap)))
(define-key map "\C-s" #'emamux:send-command)
(define-key map "\C-y" #'emamux:yank-from-list-buffers)
(when (emamux:in-tmux-p)
(define-key map "\M-!" #'emamux:run-command)
(define-key map "\M-r" #'emamux:run-last-command)
(define-key map "\M-s" #'emamux:run-region)
(define-key map "\C-i" #'emamux:inspect-runner)
(define-key map "\C-k" #'emamux:close-panes)
(define-key map "\C-c" #'emamux:interrupt-runner)
(define-key map "\M-k" #'emamux:clear-runner-history)
(define-key map "c" #'emamux:new-window)
(define-key map "C" #'emamux:clone-current-frame)
(define-key map "2" #'emamux:split-window)
(define-key map "3" #'emamux:split-window-horizontally))
map)
"Default keymap for emamux commands. Use like
\(global-set-key (kbd \"M-g\") emamux:keymap\)
Keymap:
| Key | Command |
|-----+----------------------------------|
| C-s | emamux:send-command |
| C-y | emamux:yank-from-list-buffers |
| M-! | emamux:run-command |
| M-r | emamux:run-last-command |
| M-s | emamux:region |
| C-i | emamux:inspect-runner |
| C-k | emamux:close-panes |
| C-c | emamux:interrupt-runner |
| M-k | emamux:clear-runner-history |
| c | emamux:new-window |
| C | emamux:clone-current-frame |
| 2 | emamux:split-window |
| 3 | emamux:split-window-horizontally |
")
(provide 'emamux)
;;; emamux.el ends here