path: root/eshell-conf.el

;;; eshell-conf.el --- My configurations for Eshell  -*- lexical-binding: t; -*-

;; Copyright (C) 2021  李俊緯

;; Author: 李俊緯 <mmemmew@gmail.com>
;; Keywords: terminals, tools, convenience

;; 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 <https://www.gnu.org/licenses/>.

;;; Commentary:

;; This is my configuration file for Eshell, the shell emulation
;; written in Emacs Lisp.

;;; Code:

(eval-when-compile
  (require 'cl-lib)
  (require 'esh-mode)
  (require 'eshell))
(require 'esh-util)
(require 'em-term)
(require 'em-ls)
(require 'ring)
(require 'type-break)

;;; Measure time of commands and display automatically.

;;;###autoload
(defvar-local eshell-current-command-start-time nil
  "The time of the start of the current command.")

;;;###autoload
(defvar-local eshell-prompt-time-string ""
  "The string displaying the time of the last command, if any.")

;;;###autoload
(defun eshell-current-command-start ()
  "Record the start time of the command."
  (setq-local eshell-current-command-start-time (current-time)))

;;;###autoload
(defun eshell-current-command-stop ()
  "Record the stop time of the last command."
  (cond
   ((timep eshell-current-command-start-time)
    (let* ((elapsed-time (time-since eshell-current-command-start-time))
           (elapsed-time-list (time-convert elapsed-time 'list))
           (elapsed-time-int (time-convert elapsed-time 'integer))
           (format-seconds-string
            (cond ((> elapsed-time-int 0)
                   (format-seconds
                    "%yy %dd %hh %mm %ss%z"
                    elapsed-time-int))))
           (microseconds (caddr elapsed-time-list))
           (micro-str
            (cond ((or (>= elapsed-time-int 1) (> microseconds 10000))
                   (format "%dμs" microseconds)))))
      (setq eshell-prompt-time-string
            (mapconcat #'identity
                       (delq nil (list format-seconds-string
                                       micro-str))
                       " ")))
    (setq eshell-current-command-start-time nil))))

;;;###autoload
(defun eshell-current-command-time-track ()
  "Add hooks to track command times."
  (add-hook 'eshell-pre-command-hook #'eshell-current-command-start nil t)
  (add-hook 'eshell-post-command-hook #'eshell-current-command-stop nil t))

;;;###autoload
(defun eshell-start-track-command-time ()
  "Start tracking the time of commands."
  (cond
   ((derived-mode-p 'eshell-mode)
    (eshell-current-command-time-track)))
  (add-hook 'eshell-mode-hook #'eshell-current-command-time-track))

;;;###autoload
(defun eshell-stop-track-command-time ()
  "Stop tracking the execution times of commands."
  (remove-hook 'eshell-pre-command-hook #'eshell-current-command-start t)
  (remove-hook 'eshell-post-command-hook #'eshell-current-command-stop t)
  (remove-hook 'eshell-mode-hook #'eshell-current-command-time-track))

;;;###autoload
(defun durand-eshell-emit-prompt ()
  "Emit a prompt if eshell is being used interactively.
Add a time information at the beginning.  -- Modified by Durand."
  (when (boundp 'ansi-color-context-region)
    (setq ansi-color-context-region nil))
  (run-hooks 'eshell-before-prompt-hook)
  (if (not eshell-prompt-function)
      (set-marker eshell-last-output-end (point))
    (let ((prompt (funcall eshell-prompt-function)))
      (and eshell-highlight-prompt
	   (add-text-properties 0 (length prompt)
				'(read-only t
				  font-lock-face eshell-prompt
				  front-sticky (font-lock-face read-only)
				  rear-nonsticky (font-lock-face read-only))
				prompt))
      (eshell-interactive-print
       (mapconcat #'identity
                  (delq
                   nil
                   (list
                    (cond ((> (length eshell-prompt-time-string) 0)
                           (propertize eshell-prompt-time-string
                                       'font-lock-face 'modus-themes-heading-1
                                       'read-only t
                                       'front-sticky '(font-lock-face read-only)
				       'rear-nonsticky '(font-lock-face read-only))) )
                    prompt))
                  " "))
      (setq eshell-prompt-time-string "")))
  (run-hooks 'eshell-after-prompt-hook))

(advice-add #'eshell-emit-prompt :override #'durand-eshell-emit-prompt)

;;; Eshell sets the keymap in the major mode function

;;;###autoload
(add-hook 'eshell-mode-hook #'durand-set-eshell-keys)

;;;###autoload
(defun durand-set-eshell-keys ()
  "Set my key-bindings."
  (define-key eshell-mode-map (vector #xf) ; C-o
    #'eshell-clear))

;;; YouTube URL

;;;###autoload
(defun eshell/yt-url (&rest args)
  "Run `durand-convert-youtube-video-to-url' on the first of ARGS."
  (eshell-eval-using-options
   "yt-url" args
   '((?o "open" nil open-p "Open in the default external browser.")
     (?h "help" nil nil "Print this help message.")
     :parse-leading-options-only
     :usage "[-ho] video-name"
     :show-usage)
   (eshell-yt-url args open-p)))

;;;###autoload
(defun eshell-yt-url (&optional video-name open-p)
  "Save the URL of a video downloaded from YouTube to the `kill-ring'.
The video is given by VIDEO-NAME.

If OPEN-P is non-nil, then open the video in the default external
browser instead."
  (let ((url (durand-convert-youtube-video-to-url
              (eshell-flatten-and-stringify video-name))))
    (cond
     ((string= url "")
      (user-error "Please specify VIDEO-NAME"))
     (open-p (browse-url-default-browser url))
     ((kill-new url)))))

;;; Clear screen

;;;###autoload
(defun eshell-clear (num)
  "Deletes the buffer.
Do NUM times `eshell-previous-prompt' before deleting."
  (interactive
   (list (cond ((null current-prefix-arg) 0)
               ((prefix-numeric-value current-prefix-arg)))))
  (let ((inhibit-read-only t))
    (delete-region
     (point-min)
     (save-excursion
       (eshell-previous-prompt num)
       (line-beginning-position)))))

;;; Jump

;; NOTE: This should be replaced by the bookmarks of Emacs.

;;;###autoload
(defun eshell/j (&rest args)
  "Implementation of `j'.
See `eshell-j' for the actual functionality and for the format of
ARGS."
  (eshell-eval-using-options
   "j" args
   '((?r "recent" 'exclusive use-recent-p "Find in recent directories instead of symbolic links.")
     (?a "all" nil use-recent-p "Find both in recent directories and in symbolic links.")
     (?h "help" nil nil "Print this help message.")
     :usage "[-hra] [short-cut]")
   (eshell-j args use-recent-p)))

;;;###autoload
(defun eshell/mark (&rest args)
  "Add symbolic links to `eshell-mark-directory'.
The argument ARGS should be list of one string which names the
link name.  If no argument is given, the base name of the current
directory is used."
  ;; (setq args (cons default-directory args))
  ;; (setq args (durand-eshell-delete-dups args :test #'string=))
  (setq args (cond
              ((consp args) (car (flatten-tree args)))
              ((file-name-nondirectory
                (directory-file-name
                 (file-name-directory default-directory))))))
  (eshell-command-result
   (format "ln -sf \"%s\" \"%s\""
           default-directory (expand-file-name args eshell-mark-directory))))

;;;###autoload
(defun eshell/marks ()
  "List all symbolic links.
Just for the completeness."
  (let* ((dirs (directory-files eshell-mark-directory nil
                                (rx-to-string '(seq bos (or (not ".")
                                                         (seq "." (not ".")))))))
         (max-length (apply #'max (mapcar #'length dirs))))
  (mapconcat
   (function
    (lambda (mark)
      (concat (propertize mark 'font-lock-face 'modus-themes-mark-sel)
              (make-string (- max-length (length mark)) #x20)
              " -> "
              (file-truename (expand-file-name mark eshell-mark-directory)))))
   dirs "\n")))

;;;###autoload
(defun durand-eshell-delete-dups (sequence &rest args)
  "Return a copy of SEQUENCE with duplicate elements removed.
ARGS should be a property list specifying tests and keys.

If the keyword argument TEST is non-nil, it should be a function
with two arguments which tests for equality of elements in the
sequence.  The default is the function `equal'.

If the keyword argument KEY is non-nil, it should be a function
with one argument which returns the key of the element in the
sequence to be compared by the test function.  The default is the
function `identity'.

Note that this function is not supposed to change global state,
including match data, so the functions in TEST and KEY are
supposed to leave the global state alone as well.

\(fn SEQUENCE &key TEST KEY)"
  (declare (pure t) (side-effect-free t))
  (let* ((len (length sequence))
         (temp-obarray (obarray-make len))
         (valid-key-num (+ (cond ((plist-member args :key) 1) (0))
                           (cond ((plist-member args :test) 1) (0))))
         (key (cond ((cadr (plist-member args :key)))
                    (#'identity)))
         (test-fn (cond ((cadr (plist-member args :test)))
                        (#'equal)))
         found-table result)
    (cond ((or (= (mod (length args) 2) 1)
               (> (length args) (* 2 valid-key-num)))
           (user-error "Invalid keyword arguments.  Only :key and :test are allowed, but got %S"
                       args)))
    ;; Note: This just puts a property to the symbol.
    (define-hash-table-test 'durand-delete-dups-test
      test-fn (function (lambda (obj) (intern (format "%S" obj) temp-obarray))))
    (setq found-table (make-hash-table :test 'durand-delete-dups-test :size len))
    (mapc
     (function
      (lambda (element)
        (cond ((gethash (funcall key element) found-table))
              ;; Abuse the fact that `puthash' always returns VALUE.
              ((puthash (funcall key element) t found-table)
               (setq result (cons element result))))))
     sequence)
    (nreverse result)))

;;;###autoload
(defvar eshell-mark-directory (expand-file-name "~/.marks")
  "The directory that stores links to other directories.")

;;;###autoload
(defun eshell-j (&optional short-cut use-recent-p)
  "Jump to SHORT-CUT.
Where this jumps to is determined by the symbolic links in the
directory `eshell-mark-directory'.  If USE-RECENT-P is non-nil, then
also include recent directories in the list of candidates.  Moreover,
if USE-RECENT-P is 'exclusive, then only list the recent
directories as candidates, unless there are no recent
directories, in which case it falls back to use the marks as the
candidates."
  (let* ((mark-directory eshell-mark-directory)
         (short-cut (eshell-flatten-and-stringify short-cut))
         (links (delq nil
                      (mapcar
                       (function
                        (lambda (name)
                          (cond
                           ((or (string= "." (file-name-nondirectory name))
                                (string= ".." (file-name-nondirectory name)))
                            nil)
                           (name))))
                       (directory-files mark-directory t short-cut t))))
         (candidates (cond
                      ((and use-recent-p
                            (not (eq use-recent-p 'exclusive))
                            (ring-p eshell-last-dir-ring)
                            (not (ring-empty-p eshell-last-dir-ring)))
                       (append (mapcar (function
                                        (lambda (file)
                                          (cons (file-name-nondirectory file)
                                                file)))
                                       links)
                               (cond
                                ((string-match-p short-cut mark-directory)
                                 (list (cons mark-directory mark-directory))))
                               (mapcar (function (lambda (file) (cons file file)))
                                       (ring-elements eshell-last-dir-ring))))
                      ((and use-recent-p
                            (eq use-recent-p 'exclusive)
                            (ring-p eshell-last-dir-ring)
                            (not (ring-empty-p eshell-last-dir-ring)))
                       (mapcar (function (lambda (file) (cons file file)))
                               (ring-elements eshell-last-dir-ring)))
                      ((append
                        (mapcar (function
                                 (lambda (file)
                                   (cons (file-name-nondirectory file)
                                         file)))
                                links)
                        (cond
                         ((string-match-p short-cut mark-directory)
                          (list (cons mark-directory mark-directory))))))))
         ;; Delete duplicate items
         (candidates
          (durand-eshell-delete-dups
           candidates
           :test #'string=
           ;; In Haskell this woule be a simple function composition.
           :key (function (lambda (ls) (file-truename (cdr ls))))))
         ;; Delete non-matching ones
         (candidates
          (delq
           nil
           (mapcar
            (lambda (cand)
              (cond ((string-match-p short-cut (cdr cand)) cand)))
            candidates))))
    (cond
     ((null candidates)
      (user-error "No candidates matching %s found" short-cut))
     ((null (cdr candidates))
      ;; Only one candidate
      (eshell/cd (file-truename (cdar candidates))))
     ((eshell/cd (file-truename
                  (cdr
                   (assoc
                    (let ((completion-regexp-list
                           (cons short-cut completion-regexp-list)))
                      (completing-read
                       "Choose a link: " candidates nil t))
                    candidates #'string=))))))))

;;; Custom ls

(defvar dir-literal nil)
(defvar show-recursive nil)
(defvar sort-method nil)
(defvar show-all nil)
(defvar show-almost-all nil)
(defvar listing-style nil)
(defvar human-readable nil)
(defvar numeric-uid-gid nil)
(defvar block-size nil)
(defvar reverse-list nil)
(defvar show-size nil)
(defvar insert-func nil)
(defvar flush-func nil)
(defvar error-func nil)
(defvar dereference-links nil)
(defvar dired-flag nil)

;;;; Convenient wrapper

(defun eshell/l (&rest args)
  "Equivalent with \"dl -alhg ARGS\"."
  (eshell/dl "-alhg" (or args ".")))

;;;; Enhanced command

(defun eshell/dl (&rest args)
  "My enhanced implementation of \"ls\" in Emacs Lisp, with ARGS.
See `eshell/ls' for the original version.

I added the option of \"g\" for grouping directories first."
  (let ((insert-func 'eshell-buffered-print)
        (error-func 'eshell-error)
        (flush-func 'eshell-flush))
    (funcall flush-func -1)
    ;; Process the command arguments, and begin listing files.
    (eshell-eval-using-options
     "ls" (if eshell-ls-initial-args
	      (list eshell-ls-initial-args args)
	    args)
     '((?a "all" nil show-all
        "do not ignore entries starting with .")
       (?A "almost-all" nil show-almost-all
        "do not list implied . and ..")
       (?c nil by-ctime sort-method
        "sort by last status change time")
       (?d "directory" nil dir-literal
        "list directory entries instead of contents")
       (?k "kilobytes" 1024 block-size
        "using 1024 as the block size")
       (?h "human-readable" 1024 human-readable
        "print sizes in human readable format")
       (?H "si" 1000 human-readable
        "likewise, but use powers of 1000 not 1024")
       (?I "ignore" t ignore-pattern
        "do not list implied entries matching pattern")
       (?l nil long-listing listing-style
        "use a long listing format")
       (?n "numeric-uid-gid" nil numeric-uid-gid
        "list numeric UIDs and GIDs instead of names")
       (?r "reverse" nil reverse-list
        "reverse order while sorting")
       (?s "size" nil show-size
        "print size of each file, in blocks")
       (?t nil by-mtime sort-method
        "sort by modification time")
       (?u nil by-atime sort-method
        "sort by last access time")
       (?x nil by-lines listing-style
        "list entries by lines instead of by columns")
       (?C nil by-columns listing-style
        "list entries by columns")
       (?L "dereference" nil dereference-links
        "list entries pointed to by symbolic links")
       (?R "recursive" nil show-recursive
        "list subdirectories recursively")
       (?g "group-directories-first" nil durand-eshell-ls-dirs-first
        "group directories first")
       (?S nil by-size sort-method
        "sort by file size")
       (?U nil unsorted sort-method
        "do not sort; list entries in directory order")
       (?X nil by-extension sort-method
        "sort alphabetically by entry extension")
       (?1 nil single-column listing-style
        "list one file per line")
       (nil "dired" nil dired-flag
        "Here for compatibility with GNU ls.")
       (nil "help" nil nil
        "show this usage display")
       :external "ls"
       :usage "[OPTION]... [FILE]...
List information about the FILEs (the current directory by default).
Sort entries alphabetically across.")
     ;; setup some defaults, based on what the user selected
     (unless block-size
       (setq block-size eshell-ls-default-blocksize))
     (unless listing-style
       (setq listing-style 'by-columns))
     (unless args
       (setq args (list ".")))
     (let ((eshell-ls-exclude-regexp eshell-ls-exclude-regexp))
       (when ignore-pattern
         (unless (eshell-using-module 'eshell-glob)
	   (error (concat "-I option requires that `eshell-glob'"
			  " be a member of `eshell-modules-list'")))
         (set-text-properties 0 (length ignore-pattern) nil ignore-pattern)
         (setq eshell-ls-exclude-regexp
	       (if eshell-ls-exclude-regexp
		   (concat "\\(" eshell-ls-exclude-regexp "\\|"
			   (eshell-glob-regexp ignore-pattern) "\\)")
	         (eshell-glob-regexp ignore-pattern))))
       ;; list the files!
       (eshell-ls-entries
        (mapcar (lambda (arg)
		  (cons (if (and (eshell-under-windows-p)
			         (file-name-absolute-p arg))
			    (expand-file-name arg)
			  arg)
		        (eshell-file-attributes
		         arg (if numeric-uid-gid 'integer 'string))))
	        args)
        t (expand-file-name default-directory)))
     (funcall flush-func))))

;;;; Group directories first in `eshell/ls'

(defvar durand-eshell-ls-dirs-first nil
  "The variable that controls whether
`durand-eshell-ls-sort-entries' puts directories first.")

(defun durand-eshell-ls-sort-entries (old-fun entries)
  "An advice around `eshell-ls-sort-entries'.
OLD-FUN should be `eshell-ls-sort-entries'.

ENTRIES will be split into two lists, one for directories, and
the other for non-directory files.  Then each list is passed to
OLD-FUN separately.  The two results are then concatenated.

This can preserve the original sorting method."
  (cond
   (durand-eshell-ls-dirs-first
    (let (durand-dir-files durand-other-files)
      (mapc
       (lambda (file)
         (cond
          ((cond
            ((stringp file) (file-directory-p file))
            ((consp file) (eshell-ls-filetype-p (cdr file) ?d))
            ((user-error "Invalid file: %S" file)))
           (setq durand-dir-files (cons file durand-dir-files)))
          ((setq durand-other-files (cons file durand-other-files)))))
       entries)
      (append
       (funcall old-fun durand-dir-files)
       (funcall old-fun durand-other-files))))
   ((funcall old-fun entries))))

(advice-add #'eshell-ls-sort-entries
            :around #'durand-eshell-ls-sort-entries)


;;; Integration with Tramp

(add-to-list 'eshell-modules-list 'eshell-tramp)

;;; Substitute commands

;;;###autoload
(defun eshell/r (&rest args)
  "Replace the last command by the specifications in ARGS."
  (eshell-eval-using-options
   "r" args
   '((?h "help" nil nil "Print this help message")
     (?n "number" t last-number "Which last command to replace")
     :usage "[-n number] [replacement specifications...]
REPLACEMENT SPECIFICATIONS are pairs of the form MATCH=REPLACE.
This command will find the last command, or the last N-th command
if given the option -n, and replace any match of MATCH by
REPLACE."
     :preserve-args
     :parse-leading-options-only
     :show-usage)
   (eshell-r args last-number)))

;;;###autoload
(defun eshell-r (args &optional last-number)
  "Replace the LAST-NUMBER th command by ARGS.
ARGS are pairs of the form MATCH=REPLACE.  This command will find
the last command, or the LAST-NUMBER-th command if LAST-NUMBER is
non-nil, and replace the first match of MATCH by REPLACE.

LAST-NUMBER is passed to `prefix-numeric-value': If it is nil,
then it means 1; if it is a minus sign, then it means -1; if it
is a cons cell, and its `car' is an integer, then it means its
`car'; if it is an integer, then it means that integer; and any
other value means 1."
  (let* ((last-number (prefix-numeric-value last-number))
         (args (mapcar (lambda (pair)
                         (split-string pair "="))
                       args))
         (nth-last-command (ring-ref eshell-history-ring last-number))
         temp)
    ;; Transform ARGS to the required format.
    
    ;; NOTE; Using `mapc' is recommended by the manual.
    (mapc
     (function
      (lambda (arg)
        (cond
         ((and (consp arg)
               (= (length arg) 2)
               (stringp (car arg))
               (stringp (cadr arg)))
          (setq temp (cons arg temp)))
         ((and (consp arg)
               (= (length arg) 1)
               (stringp (car arg)))
          (setq temp (cons
                      (list (caar temp)
                            (concat (cadar temp) (cons 32 nil) (car arg)))
                      (cdr temp))))
         ((user-error "Wrong specification: MATCH=REPLACE required, but got %S" arg)))))
     args)
    (setq args (nreverse temp))
    ;; Replace the command
    (save-match-data
      (while (consp args)
        (setq temp (car args))
        (cond
         ;; Cannot use `string-match-p' here.
         ((string-match (car temp) nth-last-command)
          (setq nth-last-command (replace-match
                                  (or (cadr temp) "")
                                  t nil nth-last-command))))
        (setq args (cdr args))))
    ;; Let the user know what the result of substitution is.
    (eshell-printn nth-last-command)
    ;; Check we don't do another r command.
    (cond
     ((and (/= (length nth-last-command) 0)
           (= (aref nth-last-command 0) ?r)
           (or (= (length nth-last-command) 1)
               (= (aref nth-last-command 1) 32)))
      (user-error "Repeating a repeating command.  This is probably not what you want")))
    (eshell-command-result nth-last-command)))

;;; Expand history

(add-to-list 'eshell-expand-input-functions
             #'eshell-expand-history-references)

;;; Expand multiple dots

(defun durand-eshell-expand-dots (beg end)
  "Expand multiple dots in BEG and END.
For example, \"...\" expands into \"../..\"."
  (save-excursion
    (save-match-data
      (let ((str (buffer-substring beg end))
            (start 0))
        (while (string-match (rx ".." (1+ ".")) str start)
          (let* ((matched (match-string 0 str))
                 (len (length matched)))
            (setq
             str
             (replace-match
              (let ((result "..")
                    (index 2))
                (while (< index len)
                  (setq index (1+ index))
                  (setq
                   result
                   (concat result "/..")))
                result)
              nil nil str))
            (setq start (+ (match-end 0)
                           (lsh (- len 2) 1)))))
        (goto-char beg)
        (delete-region beg end)
        (insert str)))))

(add-to-list 'eshell-expand-input-functions
             #'durand-eshell-expand-dots)

;;; Visual commands

(add-to-list 'eshell-visual-commands
             "mpv" nil #'string=)

(add-to-list 'eshell-visual-commands
             "btm" nil #'string=)

(add-to-list 'eshell-visual-subcommands
             (list "git" "log" "diff" "show" "help"))

;;; List files after changing directories

(defun eshell-directory-ls ()
  "Call \"dl -g eshell-last-arguments\" after \"cd\"."
  (eshell/dl "--group-directories-first" (cdr eshell-last-arguments)))

(add-hook 'eshell-directory-change-hook #'eshell-directory-ls)

;;; Eshell bookmark handler

(defun durand-eshell-bookmark-jump (bookmark)
  "Handle Eshell BOOKMARK in my preferred way."
  (let ((handler (bookmark-get-handler bookmark))
        (location (bookmark-prop-get bookmark 'location))
        (eshell-buffers
         (delq
          nil
          (mapcar
           (lambda (buffer)
             (cond
              ((provided-mode-derived-p
                (buffer-local-value
                 'major-mode buffer)
                'eshell-mode)
               buffer)))
           (buffer-list)))))
    (cond
     ((and (stringp location)
           (not (string= location ""))
           (memq handler (list #'eshell-bookmark-jump
                               #'durand-eshell-bookmark-jump)))
      (let (reuse-p)
        (mapc
         (lambda (buffer)
           (cond
            ((string= (buffer-local-value 'default-directory
                                          buffer)
                      location)
             (setq reuse-p buffer))))
         eshell-buffers)
        ;; Don't switch to that buffer, otherwise it will cause
        ;; problems if we want to open the bookmark in another window.
        (cond
         (reuse-p (set-buffer reuse-p))
         ;; eshell will pop the buffer
         ((let ((buffer (generate-new-buffer eshell-buffer-name)))
            (with-current-buffer buffer
              (setq-local default-directory location)
              (eshell-mode))
            (set-buffer buffer))))))
     ((user-error "Cannot jump to this bookmark")))))

(advice-add #'eshell-bookmark-jump
            :override
            #'durand-eshell-bookmark-jump)

;;; Handle graphviz commands

;; It is convenient to be able to compile multiple GraphViz files or
;; delete multiple image files simultaneously.

;;;; A convenient Command

(require 'vc)

(defun eshell/gv (&rest args)
  "Compile GraphViz files into images, or delete images, depending \
on `args'."
  (eshell-eval-using-options
   "gv" args
   '((?h "help" nil nil "Print this help message")
     (?f "format" t image-format "Which image format to output")
     (?r "remove" nil removep "Whether to remove images or not")
     (?R "remove-all" nil remove-allp "Whether to remove images and sources or not")
     (?d "root" t dir "Set the directory that contains the output directory")
     (?v "vertical" nil verticalp "Set the drawing direction to be from top to bottom")
     :usage "[-f format] [-r|-R] [-v] [-d directory] [graphviz file names...]
This little command can perform two tasks:

- Compile multiple GraphViz files.
- Remove output image files.

The file names should not include any extension."
     :preserve-args
     :parse-leading-options-only
     :show-usage)
   (let ((removep (cond (remove-allp 'all) (removep))))
     (eshell-gv image-format removep dir verticalp args))))

(defun eshell-gv (image-format removep dir verticalp &rest args)
  "Internal function for `eshell/gv'."
  (let* ((args (car args))
         (args (cond ((listp (car args)) (car args)) (args)))
         (image-format (cond (image-format) ("png")))
         (root-dir
          (expand-file-name "output" (cond (dir) ((vc-root-dir))))))
    (cond
     (removep
      (mapc
       (lambda (arg)
         (cond
          ((memq ?* (mapcar #'identity arg))
           (let* ((splitted (split-string arg "*"))
                  (matching-re (format "%s.*%s\\.%s"
                                       (car splitted)
                                       (apply #'concat (cdr splitted))
                                       image-format))
                  (source-matching-re
                   (format "%s.*%s\\.gv"
                           (car splitted)
                           (apply #'concat (cdr splitted))))
                  (files
                   (directory-files
                    default-directory t matching-re t))
                  (source-files
                   (directory-files
                    root-dir t source-matching-re t)))
             (mapc #'delete-file files)
             (cond
              ((eq removep 'all) (mapc #'delete-file source-files)))))
          (t
           (let* ((arg (file-name-base arg))
                  (file-name
                   (expand-file-name
                    (format "%s.%s" arg image-format)))
                  (source-file-name (format "%s.gv" arg))
                  (source-file-name
                   (expand-file-name source-file-name root-dir)))
             (delete-file file-name)
             (cond
              ((eq removep 'all) (delete-file source-file-name)))))))
       args))
     ((mapc
       (lambda (arg)
         (cond
          ((memq ?* (mapcar #'identity arg))
           (let* ((splitted (split-string arg "*"))
                  (matching-re
                   (format "%s.*%s\\.gv"
                           (car splitted)
                           (apply #'concat (cdr splitted))))
                  (source-files
                   (directory-files root-dir t matching-re t))
                  (len (length source-files))
                  (count 0)
                  (reporter (make-progress-reporter "gv" 0 len ))
                  inhibit-message)
             (mapc
              (lambda (file)
                (progress-reporter-update reporter count)
                (setq count (1+ count))
                (let ((output-file-name
                       (expand-file-name
                        (concat
                         (file-name-base file) "." image-format))))
                  (with-temp-buffer
                    (insert-file-contents file)
                    (goto-char (point-min))
                    (search-forward "rankdir=" nil t)
                    (delete-char 2)
                    (cond (verticalp (insert ?T ?B))
                          ((insert ?L ?R)))
                    (write-region nil nil file nil 'silent))
                  (make-process
                   :name "gv"
                   :command
                   (list
                    "dot"
                    "-T"
                    image-format
                    file
                    "-o"
                    output-file-name)
                   :buffer nil
                   :filter #'ignore
                   :sentinel #'ignore)))
              source-files)
             (progress-reporter-done reporter)))
          (t
           (let* ((arg (file-name-base arg))
                  (out-file-name (format "%s.%s" arg image-format))
                  (source-file-name (format "%s.gv" arg))
                  (source-file-name
                   (expand-file-name source-file-name root-dir))
                  (inhibit-message t))
             (with-temp-buffer
               (insert-file-contents source-file-name)
               (goto-char (point-min))
               (search-forward "rankdir=" nil t)
               (delete-char 2)
               (cond (verticalp (insert ?T ?B))
                     ((insert ?L ?R)))
               (write-region nil nil source-file-name))
             (eshell-command-result
              (format
               "dot -T%s \"%s\" -o \"%s\""
               image-format
               source-file-name
               out-file-name))))))
       args))))
  nil)

;;;; Completion

(defun gv-complete-switches ()
  "Return a completion table for the switches of the gv command."
  (pcomplete-from-help
   (list
    "emacs" "-Q" "-l" "~/.emacs.d/eshell-conf.el" "--batch" "--eval" "(eshell/gv)")
   :narrow-end "mapbacktrace"
   :narrow-start "extension."))

(defun gv-complete-files (dir)
  "Return a completion table for the file arguments of the gv \
command."
  (lambda (string pred action)
    (let ((default-directory (expand-file-name "output" dir))
          (pred (lambda (name) (string-suffix-p ".gv" name)))
          (filter (lambda (result)
                    (cond
                     ((string-suffix-p ".gv" result)
                      (substring result 0 -3))
                     (result)))))
      (cond
       ((eq action t)
        (let ((results
               (completion-table-with-predicate
                #'completion-file-name-table
                pred 'strict string pred action)))
          (mapcar filter results)))
       ((null action)
        (funcall filter (completion-table-with-predicate
                         #'completion-file-name-table
                         pred 'strict string pred action)))
       ((completion-table-with-predicate
         #'completion-file-name-table
         pred 'strict string pred action))))))

(defun pcomplete/gv ()
  "Completion for `eshell/gv'."
  (let (finding-dir continue-loop)
    (while (or (string-prefix-p "-" (pcomplete-arg)) continue-loop)
      (let ((arg (pcomplete-arg)))
        (pcomplete-here (cond
                         ((eq finding-dir t) (pcomplete-dirs))
                         (continue-loop
                          (list "png" "jpeg" "jpg" "svg"))
                         ((gv-complete-switches))))
        (cond
         ((eq finding-dir t)
          (setq finding-dir arg)
          (setq continue-loop nil))
         (continue-loop (setq continue-loop nil))
         ((string-prefix-p "-d" arg)
          (setq finding-dir
                (cond
                 ((string= arg "-d") (setq continue-loop t))
                 ((substring-no-properties arg 2)))))
         ((string= "--format" arg)
          (setq continue-loop t))
         ((string= "--root" arg)
          (setq finding-dir (setq continue-loop t)))
         ((setq continue-loop nil)))))
    (while (pcomplete-here (gv-complete-files finding-dir)))))

(provide 'eshell-conf)
;;; eshell-conf.el ends here