1281 lines
49 KiB
EmacsLisp
1281 lines
49 KiB
EmacsLisp
;;; eshell-starship.el --- Starship-like (https://starship.rs) prompt for eshell -*- lexical-binding: t; -*-
|
||
;;; Commentary:
|
||
;;; Code:
|
||
(require 'vc)
|
||
(require 'vc-git)
|
||
(require 'eshell)
|
||
(require 'cl-lib)
|
||
(require 'tramp)
|
||
(eval-when-compile (require 'rx))
|
||
|
||
;;; Configuration options
|
||
(defgroup eshell-starship nil
|
||
"Starship-like (starship.rs) prompt for `eshell'."
|
||
:version "0.0.1"
|
||
:prefix 'eshell-starship-
|
||
:group 'eshell)
|
||
|
||
(defvar-local eshell-starship--current-explain-buffer nil
|
||
"The eshell-starship explain buffer for this eshell buffer.")
|
||
|
||
(defcustom eshell-starship-explain-auto-update t
|
||
"Non-nil if eshell-starship explain buffers shoul auto-update."
|
||
:group 'eshell-starship
|
||
:tag "Auto-update explain buffers"
|
||
:type 'boolean)
|
||
|
||
(defun eshell-starship--defcustom-setter (sym val)
|
||
"Set SYM to VAL (using `set-default-toplevel-value').
|
||
This will also update all eshell-starship explain buffers that need updating."
|
||
(set-default-toplevel-value sym val)
|
||
(dolist (buffer (buffer-list))
|
||
(with-current-buffer buffer
|
||
(when (and (derived-mode-p 'eshell-mode)
|
||
(buffer-live-p eshell-starship--current-explain-buffer))
|
||
(with-current-buffer eshell-starship--current-explain-buffer
|
||
(when eshell-starship-explain-auto-update
|
||
(revert-buffer)))))))
|
||
|
||
(defcustom eshell-starship-module-order
|
||
'("remote" "root" "cwd" "git" "vc" t "cmd-time" "newline" "container" "arrow")
|
||
"The order of modules for eshell-starship.
|
||
This is a list with each element being a module name. The special value t can
|
||
appear at most once to denote \"all remaining modules\"."
|
||
:group 'eshell-starship
|
||
:tag "Module order"
|
||
:type '(repeat (choice (const :tag "Remaining modules" t)
|
||
(string :tag "Module")))
|
||
:set 'eshell-starship--defcustom-setter)
|
||
|
||
(defcustom eshell-starship-disabled-modules '()
|
||
"List of disabled eshell-starship modules."
|
||
:group 'eshell-starship
|
||
:tag "Disabled modules"
|
||
:type '(repeat (string :tag "Module"))
|
||
:set 'eshell-starship--defcustom-setter)
|
||
|
||
(defcustom eshell-starship-explain-suppress-refresh-messages nil
|
||
"Weather to suppress messages during eshell-starship explore refreshes."
|
||
:group 'eshell-starship
|
||
:tag "Suppress eshell-starship explore refresh messages"
|
||
:type 'boolean)
|
||
|
||
(defcustom eshell-starship-overridden-remote-methods
|
||
'("docker" "podman" "kubernetes" "doas" "su" "sudo" "sudoedit" "dockercp"
|
||
"podmancp" "toolbox" "distrobox" "flatpak" "apptainer" "nspawn" "run0")
|
||
"List of `file-remote-p' mwthods that should NOT be considered remote.
|
||
Any eshell buffer with a `default-directory' managed by one of these methods
|
||
will not be considered remote and all modules that would be disabled because of
|
||
the remote directory will work as usual."
|
||
:group 'eshell-starship
|
||
:tag "Overridden Remote Methods"
|
||
:type '(repeat (string :tag "Method")))
|
||
|
||
(defcustom eshell-starship-verbose-tramp 1
|
||
"Tramp verbosity level when rendering the prompt."
|
||
:group 'eshell-starship
|
||
:tag "Tramp Verbosity Level"
|
||
:type 'integer)
|
||
|
||
(defface eshell-starship-icon-face '((t :inherit default))
|
||
"Face to use when drawing module icons.
|
||
Note that the foreground color will be overridden by the module."
|
||
:group 'eshell-starship
|
||
:tag "Icon face")
|
||
|
||
(defvar eshell-starship--modules-by
|
||
(list :extensions (make-hash-table :test 'equal)
|
||
:dirs (make-hash-table :test 'equal)
|
||
:files (make-hash-table :test 'equal))
|
||
"An alist hash tables that map various fields to lists of modules.")
|
||
|
||
(defun eshell-starship--module-by (field key)
|
||
"Lookup a list of modules with a FIELD corresponding to KEY.
|
||
FIELD should be one of the keys in `eshell-starship--modules-by'."
|
||
(when-let ((table (plist-get eshell-starship--modules-by field)))
|
||
(gethash key table)))
|
||
|
||
(defvar eshell-starship--extra-module-files ()
|
||
"A list of (NAME IS-DIR MODULE).
|
||
These represent files that cannot be stored in `eshell-starship--module-by'.")
|
||
|
||
(defvar-local eshell-starship--is-first-prompt t
|
||
"Non-nil if we have never printed a prompt in this buffer.")
|
||
|
||
|
||
;;; Module API
|
||
(defvar eshell-starship-modules (make-hash-table :test 'equal)
|
||
"List of modules used by eshell-starship.")
|
||
|
||
(defvar-local eshell-starship--module-cache nil
|
||
"Hash table mapping modules to a list of their last output.
|
||
The entries of this hash table are of the the form (VALID OUTPUT LAST-TIMES).
|
||
LAST-TIMES is a list of the 10 last execution times for this module.")
|
||
|
||
(defclass eshell-starship-module ()
|
||
((name :initarg :name
|
||
:accessor eshell-starship-module-name
|
||
:type string
|
||
:documentation "The name of this module.")
|
||
(precmd-action :initarg :precmd-action
|
||
:initform nil
|
||
:accessor eshell-starship-module-precmd-action
|
||
:type (or function null)
|
||
:documentation
|
||
"A function to run before each command is run.")
|
||
(postcmd-action :initarg :postcmd-action
|
||
:initform nil
|
||
:accessor eshell-starship-module-postcmd-action
|
||
:type (or function null)
|
||
:documentation
|
||
"A function to run after each command is run.")
|
||
(predicate :initarg :predicate
|
||
:initform 'ignore
|
||
:accessor eshell-starship-module-predicate
|
||
:type function
|
||
:documentation
|
||
"A function that should return non-nil if the module should be run.")
|
||
(files :initarg :files
|
||
:initform nil
|
||
:accessor eshell-starship-module-files
|
||
:type list
|
||
:documentation
|
||
"A list of files that indicate that the module should be run.")
|
||
(dirs :initarg :dirs
|
||
:initform nil
|
||
:accessor eshell-starship--module-dirs
|
||
:type list
|
||
:documentation
|
||
"A list of directories that indicate that the module should be run.")
|
||
(extensions :initarg :extensions
|
||
:initform nil
|
||
:accessor eshell-starship-module-extensions
|
||
:type list
|
||
:documentation
|
||
"A list of extensions that indicate that the module should be run.")
|
||
(extensions-excluded-files :initarg :extensions-excluded-files
|
||
:initform nil
|
||
:accessor eshell-starship-module-extensions-excluded-files
|
||
:type list
|
||
:documentation
|
||
"A list of files that are ignored when searching for extensions.")
|
||
(prefix :initarg :prefix
|
||
:initform ""
|
||
:accessor eshell-starship-module-prefix
|
||
:type string
|
||
:documentation "Text to be placed before the module's icon. This is
|
||
not colored.")
|
||
(icon :initarg :icon
|
||
:initform ""
|
||
:accessor eshell-starship-module-icon
|
||
:type string
|
||
:documentation "The modules icon. This is colored.")
|
||
(postfix :initarg :postfix
|
||
:initform ""
|
||
:accessor eshell-starship-module-prefix
|
||
:type string
|
||
:documentation "Text to be placed after the module's content. This is
|
||
not colored.")
|
||
(color :initarg :color
|
||
:initform nil
|
||
:accessor eshell-starship-module-color
|
||
:type (or null string)
|
||
:documentation "The color to give the module's icon and main text.
|
||
Use `list-colors-display' to get a list of some possible values. This can also
|
||
be nil.")
|
||
(allow-remote :initarg :allow-remote
|
||
:initform t
|
||
:accessor eshell-starship-module-allow-remote-p
|
||
:type boolean
|
||
:documentation "Weather the module should be run if
|
||
`default-directory' is a `file-remote-p'.")
|
||
(action :initarg :action
|
||
:initform 'string
|
||
:accessor eshell-starship-module-action
|
||
:type function
|
||
:documentation "A function that produces the main text for the
|
||
module.")
|
||
(reload-on :initarg :reload-on
|
||
:initform 'never
|
||
:accessor eshell-starship-module-reload-on
|
||
:type (or (member never always cwd)
|
||
(list-of (member never always cwd)))
|
||
:documentation "A list of times when this module should be
|
||
reloaded. Current possible values are:
|
||
- never (or an empty list): don't ever re-run this module
|
||
- always: re-run this module every time the prompt is updated
|
||
- cwd: re-run this module when the CWD changes")
|
||
(doc :initarg :doc
|
||
:initform "No documentation provided."
|
||
:accessor eshell-starship-module-doc
|
||
:type string
|
||
:documentation "The documentation for this module."))
|
||
(:documentation "Class for eshell-starship modules."))
|
||
|
||
(defun eshell-starship--remove-module-lookups (name)
|
||
"Unregistered module named NAME (a string) in `eshell-starship--modules-by'."
|
||
(cl-loop
|
||
for table in (cdr eshell-starship--modules-by) by 'cddr
|
||
do (maphash (lambda (k v)
|
||
(puthash k (cl-delete-if (lambda (module)
|
||
(with-slots ((cur-mod-name name))
|
||
module
|
||
(equal cur-mod-name name)))
|
||
v)
|
||
table))
|
||
table))
|
||
(setq eshell-starship--extra-module-files
|
||
(cl-delete-if (lambda (entry)
|
||
(with-slots ((cur-mod-name name)) (cl-third entry)
|
||
(equal cur-mod-name name)))
|
||
eshell-starship--extra-module-files)))
|
||
|
||
(defun eshell-starship--register-module-lookups (module)
|
||
"Register MODULE in `eshell-starship--modules-by'."
|
||
(let ((exts-table (plist-get eshell-starship--modules-by :extensions))
|
||
(dirs-table (plist-get eshell-starship--modules-by :dirs))
|
||
(files-table (plist-get eshell-starship--modules-by :files)))
|
||
(with-slots (name dirs extensions files) module
|
||
(eshell-starship--remove-module-lookups name)
|
||
(dolist (dir dirs)
|
||
(if (cl-find ?/ dir)
|
||
(push (list dir t module) eshell-starship--extra-module-files))
|
||
(push module (gethash dir dirs-table)))
|
||
(dolist (file files)
|
||
(if (cl-find ?/ file)
|
||
(push (list file nil module) eshell-starship--extra-module-files)
|
||
(push module (gethash file files-table))))
|
||
(dolist (ext extensions)
|
||
(push module (gethash ext exts-table))))))
|
||
|
||
(defun eshell-starship--defmodule-real (name &rest opts)
|
||
"Do the work of `eshell-starship-defmodule'.
|
||
NAME is the module name (a symbol) and OPTS is the list of options to pass to
|
||
the module's constructor."
|
||
(let ((module (apply 'make-instance 'eshell-starship-module
|
||
:name (symbol-name name) opts))
|
||
(str-name (symbol-name name)))
|
||
(dolist (buffer (buffer-list))
|
||
(with-current-buffer buffer
|
||
(when (hash-table-p eshell-starship--module-cache)
|
||
(remhash str-name eshell-starship--module-cache))))
|
||
(eshell-starship--register-module-lookups module)
|
||
;; This returns module
|
||
(puthash str-name module eshell-starship-modules)))
|
||
|
||
(defmacro eshell-starship-defmodule (name &rest opts)
|
||
"Create a new eshell-starship named NAME module with OPTS."
|
||
(declare (indent defun))
|
||
`(eshell-starship--defmodule-real ',name ,@opts))
|
||
|
||
|
||
;;; Utility functions
|
||
(cl-defmacro eshell-starship-find-version-function (command pattern
|
||
&rest format)
|
||
"Return a version finding function for COMMAND.
|
||
COMMAND is in the form of (exec args...). The temp buffer that was used to run
|
||
COMMAND will then have `re-search-forward' run with PATTERN. FORMAT will then
|
||
be passed verbatim as the arguments to `concat'."
|
||
(declare (indent defun))
|
||
`(lambda ()
|
||
(with-temp-buffer
|
||
(when (zerop (process-file ,(car command) nil t nil ,@(cdr command)))
|
||
(goto-char (point-min))
|
||
(when (re-search-forward ,pattern nil t)
|
||
(concat ,@format))))))
|
||
|
||
(cl-defun eshell-starship-format-span (span &optional (places 0))
|
||
"Format SPAN (in seconds) as \"XhXmXs\".
|
||
The number is rounded to PLACES before being rendered."
|
||
(let* ((ispan (round span))
|
||
(hours (/ ispan 3600))
|
||
(mins (% (/ ispan 60) 60))
|
||
(secs (mod span 60)))
|
||
(concat (when (/= hours 0)
|
||
(format "%dh" hours))
|
||
(when (or (/= mins 0) (/= hours 0))
|
||
(format "%dm" mins))
|
||
(format (format "%%.%dfs" places) secs))))
|
||
|
||
(defun eshell-starship-clear-cache-for (modules)
|
||
"Clear the cache for each of MODULES.
|
||
MODULES can also be a single module."
|
||
(dolist (module (ensure-list modules))
|
||
(when (symbolp module) (setq module (symbol-name module)))
|
||
(when-let ((cur-entry (gethash module eshell-starship--module-cache)))
|
||
(setf (car cur-entry) nil))))
|
||
|
||
|
||
;;; CWD Module
|
||
(defun eshell-starship--replace-home-with-tilda (path)
|
||
"If PATH beings with $HOME (the environment variable), replace it with ~."
|
||
(let ((home (getenv "HOME")))
|
||
(if (equal home path)
|
||
"~"
|
||
(setq home (file-name-as-directory home))
|
||
(if (string-prefix-p home path)
|
||
(concat "~/" (seq-subseq path (length home)))
|
||
path))))
|
||
|
||
(defun eshell-starship--limit-path-parts (num path)
|
||
"Cut PATH down to NUM components.
|
||
Example:
|
||
/this/is/a/path 3-> is/a/path"
|
||
(let ((parts (string-split path "/" t nil)))
|
||
(concat
|
||
(when (and (file-name-absolute-p path)
|
||
(not (equal "~" (car parts)))
|
||
(<= (length parts) num))
|
||
"/")
|
||
(string-join (last parts num) "/"))))
|
||
|
||
(defun eshell-starship--get-current-dir ()
|
||
"Get dir for `eshell-starship--prompt-function'."
|
||
(concat
|
||
(propertize
|
||
(eshell-starship--limit-path-parts
|
||
3 (let ((cwd (or (file-remote-p default-directory 'localname)
|
||
default-directory)))
|
||
(if-let ((worktree (vc-root-dir))
|
||
(parent (file-name-parent-directory worktree)))
|
||
(file-relative-name cwd (or (file-remote-p parent 'localname)
|
||
parent))
|
||
(eshell-starship--replace-home-with-tilda cwd))))
|
||
'face '(:foreground "dark turquoise"))
|
||
(unless (file-writable-p default-directory)
|
||
" ")))
|
||
|
||
(eshell-starship-defmodule cwd
|
||
:predicate 'always
|
||
:reload-on 'cwd
|
||
:action 'eshell-starship--get-current-dir
|
||
:doc "The current working directory.")
|
||
|
||
|
||
;;; Git module
|
||
(defun eshell-starship--git-parse-status-headers ()
|
||
"Parse the status headers (read from the current buffer).
|
||
The headers are as described in the porcelain v2 section of the git-status(3)
|
||
man page.
|
||
|
||
The return value is a list of the form (oid head upstream ahead behind stash)"
|
||
(let ((oid nil)
|
||
(head nil)
|
||
(upstream nil)
|
||
(ahead nil)
|
||
(behind nil)
|
||
(stash nil))
|
||
(while (and (char-after) (= (char-after) ?#))
|
||
(forward-char 2)
|
||
(cond
|
||
((looking-at "branch\\.oid ")
|
||
(setq oid (buffer-substring-no-properties
|
||
(match-end 0)
|
||
(pos-eol))))
|
||
((looking-at "branch\\.head ")
|
||
(setq head (buffer-substring-no-properties
|
||
(match-end 0)
|
||
(pos-eol))))
|
||
((looking-at "branch\\.upstream ")
|
||
(setq upstream (buffer-substring-no-properties
|
||
(match-end 0)
|
||
(pos-eol))))
|
||
((looking-at "branch\\.ab ")
|
||
(let ((ab-str (buffer-substring-no-properties
|
||
(match-end 0)
|
||
(pos-eol))))
|
||
(when (string-match "\\(+[0-9]+\\) \\(-[0-9]+\\)$"
|
||
ab-str)
|
||
(setq ahead (string-to-number (match-string 1 ab-str))
|
||
behind (string-to-number (match-string 2 ab-str))))))
|
||
((looking-at "stash ")
|
||
(setq stash (string-to-number (buffer-substring-no-properties
|
||
(match-end 0)
|
||
(pos-eol))))))
|
||
(forward-line))
|
||
(list oid head upstream (or ahead 0) (or behind 0) stash)))
|
||
|
||
(defun eshell-starship--git-interpret-file-status (x y)
|
||
"Return the prompt character for the status X and Y.
|
||
A description of X and Y can be found in the git-status(3) man page."
|
||
(cond
|
||
((or (= x ?D) (= y ?D))
|
||
?)
|
||
((or (= x ?R) (= y ?R))
|
||
?»)
|
||
((= y ?M)
|
||
?!)
|
||
((or (= x ?A) (= x ?M))
|
||
?+)))
|
||
|
||
(defun eshell-starship--git-interpret-branch-status (ahead behind)
|
||
"Get the status char for the current branch and its remote.
|
||
AHEAD should evaluate to t if the current branch is ahead of its remote, and
|
||
BEHIND should evaluate to t if the current branch is behind its remote."
|
||
(cond
|
||
((and ahead behind) "")
|
||
(ahead "")
|
||
(behind "")))
|
||
|
||
(defun eshell-starship--git-file-status (stash ahead behind)
|
||
"Get the file status string for the git prompt module.
|
||
STASH should be t if there is current stashed data stash. AHEAD and BEHIND
|
||
should be as for `eshell-starship--git-interpret-branch-status'."
|
||
(let ((merge-conflicts nil)
|
||
(status-chars nil))
|
||
(while (not (eobp))
|
||
(cond
|
||
((= (char-after) ??)
|
||
(push ?? status-chars))
|
||
((= (char-after) ?u)
|
||
(setq merge-conflicts t))
|
||
((or (= (char-after) ?1)
|
||
(= (char-after) ?2))
|
||
(push (eshell-starship--git-interpret-file-status
|
||
(char-after (+ 2 (point)))
|
||
(char-after (+ 3 (point))))
|
||
status-chars)))
|
||
(forward-line))
|
||
(concat (eshell-starship--git-interpret-branch-status (not (zerop ahead))
|
||
(not (zerop behind)))
|
||
(when merge-conflicts "=")
|
||
(when stash "$")
|
||
(apply 'string (sort (seq-uniq status-chars))))))
|
||
|
||
(defun eshell-starship--git-current-operation ()
|
||
"Return the current git operation.
|
||
For example, a revert. If there is no current operation, return nil."
|
||
(let ((git-dir (expand-file-name ".git" (vc-git-root default-directory))))
|
||
(cond
|
||
((file-exists-p (expand-file-name "rebase-apply/applying" git-dir))
|
||
"AM")
|
||
((file-exists-p (expand-file-name "rebase-apply/rebasing" git-dir))
|
||
"REBASE")
|
||
((file-exists-p (expand-file-name "rebase-apply" git-dir))
|
||
"AM/REBASE")
|
||
((file-exists-p (expand-file-name "rebase-merge" git-dir))
|
||
"REBASING")
|
||
((file-exists-p (expand-file-name "CHERRY_PICK_HEAD" git-dir))
|
||
"CHERRY-PICKING")
|
||
((file-exists-p (expand-file-name "MERGE_HEAD" git-dir))
|
||
"MERGING")
|
||
((file-exists-p (expand-file-name "BISECT_LOG" git-dir))
|
||
"BISECTING")
|
||
((file-exists-p (expand-file-name "REVERT_HEAD" git-dir))
|
||
"REVERTING"))))
|
||
|
||
(defun eshell-starship--git-status ()
|
||
"Return the text for the git module for `eshell-starship--prompt-function'."
|
||
(with-temp-buffer
|
||
(when (zerop (vc-git-command t nil nil "status" "--porcelain=v2"
|
||
"--branch" "--show-stash"))
|
||
(goto-char (point-min))
|
||
(cl-destructuring-bind (oid head _upstream ahead behind stash)
|
||
(eshell-starship--git-parse-status-headers)
|
||
(let* ((file-status (eshell-starship--git-file-status stash ahead
|
||
behind))
|
||
(operation (eshell-starship--git-current-operation))
|
||
(output
|
||
(concat
|
||
(if (string= "(detached)" head)
|
||
(propertize (concat " (" (substring oid 0 7) ")")
|
||
'face '(:foreground "lawn green"))
|
||
(propertize (concat head)
|
||
'face '(:foreground "medium purple")))
|
||
(unless (string-empty-p file-status)
|
||
(propertize (concat " [" file-status "]")
|
||
'face '(:foreground "red")))
|
||
(when operation
|
||
(concat " (" (propertize
|
||
operation 'face
|
||
'(:inherit bold :foreground "yellow"))
|
||
")")))))
|
||
(unless (zerop (length output))
|
||
output))))))
|
||
|
||
(eshell-starship-defmodule git
|
||
:predicate (lambda ()
|
||
(eq (vc-responsible-backend default-directory t) 'Git))
|
||
:color "medium purple"
|
||
:icon " "
|
||
:reload-on 'always
|
||
:action 'eshell-starship--git-status
|
||
:doc "The working directory's status as a git repository.")
|
||
|
||
|
||
;;; Non-git VC module
|
||
(defun eshell-starship--vc-status ()
|
||
"Get vc status for `eshell-starship--prompt-function'."
|
||
(when-let ((backend (vc-responsible-backend default-directory t))
|
||
((not (eq backend 'Git))))
|
||
(downcase (symbol-name backend))))
|
||
|
||
(eshell-starship-defmodule vc
|
||
:predicate 'always
|
||
:allow-remote nil
|
||
:reload-on 'always
|
||
:color "purple"
|
||
:icon " "
|
||
:action 'eshell-starship--vc-status
|
||
:doc "The working directory's version control status (other than git).")
|
||
|
||
|
||
;;; Timer module
|
||
(defvar-local eshell-starship--last-start-time nil
|
||
"Start time of last eshell command.")
|
||
|
||
(defvar-local eshell-starship--last-end-time nil
|
||
"End time of last eshell command.")
|
||
|
||
(defun eshell-starship--last-command-time ()
|
||
"Return the prompt component for the time of the last command."
|
||
(prog1
|
||
(and eshell-starship--last-start-time
|
||
eshell-starship--last-end-time
|
||
;; this must be here (not in a predicate) to ensure these values get
|
||
;; cleared
|
||
(<= 3 (- eshell-starship--last-end-time
|
||
eshell-starship--last-start-time))
|
||
(eshell-starship-format-span (- eshell-starship--last-end-time
|
||
eshell-starship--last-start-time)))
|
||
(setq eshell-starship--last-start-time nil
|
||
eshell-starship--last-end-time nil)))
|
||
|
||
(eshell-starship-defmodule cmd-time
|
||
:predicate 'always
|
||
:prefix "took "
|
||
:color "gold1"
|
||
:reload-on 'always
|
||
:precmd-action (lambda ()
|
||
(setq eshell-starship--last-start-time (float-time)))
|
||
:postcmd-action (lambda ()
|
||
(setq eshell-starship--last-end-time (float-time)))
|
||
:action 'eshell-starship--last-command-time
|
||
:doc "The amount of time it took the last command to execute.")
|
||
|
||
|
||
;;; Language modules
|
||
(eshell-starship-defmodule cc
|
||
:extensions '("c" "h")
|
||
:prefix "via "
|
||
:icon "C "
|
||
:color "spring green"
|
||
:allow-remote nil
|
||
:reload-on 'cwd
|
||
:action (eshell-starship-find-version-function
|
||
("cc" "-v")
|
||
"^\\([-a-zA-Z]+\\) version \\([0-9]+\\.[0-9]+\\.[0-9]+\\)"
|
||
"v" (match-string 2) "-" (match-string 1))
|
||
:doc "Your C compiler version.")
|
||
|
||
(eshell-starship-defmodule c++
|
||
:extensions '("cpp" "cc" "cxx" "hpp" "hh" "hxx")
|
||
:prefix "via "
|
||
:icon " "
|
||
:color "royal blue"
|
||
:allow-remote nil
|
||
:reload-on 'cwd
|
||
:action (eshell-starship-find-version-function
|
||
("cpp" "--version")
|
||
"\\(GCC\\|clang\\).+?\\([0-9]+\\.[0-9]+\\.[0-9]+\\)"
|
||
"v" (match-string 2) "-" (downcase (match-string 1)))
|
||
:doc "Your C++ compiler version.")
|
||
|
||
(eshell-starship-defmodule rust
|
||
:extensions '("rs")
|
||
:files '("Cargo.toml")
|
||
:prefix "via "
|
||
:icon "🦀 "
|
||
:color "red"
|
||
:allow-remote nil
|
||
:reload-on 'cwd
|
||
:action (eshell-starship-find-version-function
|
||
("rustc" "--version")
|
||
"^rustc \\([0-9]+\\.[0-9]+\\.[0-9]+\\)"
|
||
"v" (match-string 1))
|
||
:doc "Your Rust compiler version.")
|
||
|
||
(eshell-starship-defmodule cmake
|
||
:files '("CMakeLists.txt" "CMakeCache.txt")
|
||
:extensions '("cmake")
|
||
:prefix "via "
|
||
:icon " "
|
||
:color "blue"
|
||
:allow-remote nil
|
||
:reload-on 'cwd
|
||
:action (eshell-starship-find-version-function
|
||
("cmake" "--version")
|
||
"cmake version \\([0-9]+\\.[0-9]+\\.[0-9]+\\)"
|
||
"v" (match-string 1))
|
||
:doc "Your CMake version.")
|
||
|
||
(require 'inf-lisp nil t)
|
||
(when (featurep 'inf-lisp)
|
||
(eshell-starship-defmodule common-lisp
|
||
:extensions '("asd" "lisp")
|
||
:prefix "via "
|
||
:icon " "
|
||
:color "green yellow"
|
||
:allow-remote nil
|
||
:reload-on 'cwd
|
||
:action (eshell-starship-find-version-function
|
||
(inferior-lisp-program "--version")
|
||
"[a-zA-Z]+ [0-9.]+"
|
||
(match-string 0))
|
||
:doc "Your current inferior-lisp program."))
|
||
|
||
(eshell-starship-defmodule elisp
|
||
:extensions '("el" "elc" "eln")
|
||
:extensions-excluded-files '(".dir-locals.el" ".dir-locals2.el")
|
||
:prefix "via "
|
||
:icon " "
|
||
:color "dark orchid"
|
||
:allow-remote nil
|
||
:reload-on 'never
|
||
:action (lambda ()
|
||
emacs-version)
|
||
:doc "The current emacs-version.")
|
||
|
||
(eshell-starship-defmodule java
|
||
:extensions '("java" "class" "gradle" "jar" "clj" "cljc")
|
||
:files '("pom.xml" "build.gradle.kts" "build.sbt" ".java-version" "deps.edn"
|
||
"project.clj" "build.boot" ".sdkmanrc")
|
||
:prefix "via "
|
||
:icon "☕ "
|
||
:color "dark red"
|
||
:allow-remote nil
|
||
:reload-on 'cwd
|
||
:action (eshell-starship-find-version-function
|
||
("java" "-version")
|
||
"version \"\\([0-9]+\\)\""
|
||
"v" (match-string 1))
|
||
:doc "Your Java version.")
|
||
|
||
(eshell-starship-defmodule zig
|
||
:extensions '("zig")
|
||
:prefix "via "
|
||
:icon "↯ "
|
||
:color "yellow"
|
||
:allow-remote nil
|
||
:reload-on 'cwd
|
||
:action (eshell-starship-find-version-function
|
||
("zig" "version")
|
||
".+"
|
||
"v" (match-string 0))
|
||
:doc "Your Zig version.")
|
||
|
||
(defun eshell-starship--current-venv ()
|
||
"Return the name of the prompt string for the current venv.
|
||
This requires pyvenv.el or pyenv-mode to work."
|
||
(concat
|
||
(and (bound-and-true-p pyvenv-virtual-env-name)
|
||
(format " (%s)" pyvenv-virtual-env-name))
|
||
(and (fboundp 'pyenv-mode-version)
|
||
(when-let ((ver (pyenv-mode-version)))
|
||
(format " (%s)" ver)))))
|
||
|
||
(defun eshell-starship--python-status ()
|
||
"Return the prompt string for the python module."
|
||
(when-let
|
||
((python-exec (or (bound-and-true-p python-interpreter) "python"))
|
||
(output (process-lines-ignore-status python-exec "--version"))
|
||
((string-match "^Python \\([0-9.]+\\)" (car output))))
|
||
(concat "v" (match-string 1 (car output)) (eshell-starship--current-venv))))
|
||
|
||
(defvar-local eshell-starship--python-last-pyvenv nil
|
||
"The previous `pyvenv-virtual-env' value.
|
||
This does not mean anything if pyvenv.el is not installed.")
|
||
|
||
(defvar-local eshell-starship--python-last-pyenv nil
|
||
"The return value of the last `pyenv-mode-version'.
|
||
This does not mean anything if pyenv-mode is not installed.")
|
||
|
||
(defun eshell-starship--python-postcmd-action ()
|
||
"The postcmd action for the python module."
|
||
(let ((need-clear nil))
|
||
(when (and (boundp 'pyvenv-virtual-env)
|
||
(not (equal eshell-starship--python-last-pyvenv
|
||
pyvenv-virtual-env)))
|
||
(setq eshell-starship--python-last-pyvenv pyvenv-virtual-env
|
||
need-clear t))
|
||
(when (fboundp 'pyenv-mode-version)
|
||
(let ((cur-ver (pyenv-mode-version)))
|
||
(when (not (equal eshell-starship--python-last-pyenv cur-ver))
|
||
(setq eshell-starship--python-last-pyenv cur-ver
|
||
need-clear t))))
|
||
(when need-clear
|
||
(eshell-starship-clear-cache-for 'python))))
|
||
|
||
(eshell-starship-defmodule python
|
||
:extensions '("py" "ipynb")
|
||
:predicate (lambda ()
|
||
(or (bound-and-true-p pyvenv-virtual-env)
|
||
(and (fboundp 'pyenv-mode-version)
|
||
(pyenv-mode-version))))
|
||
:files '(".python-version" "Pipfile" "__init__.py" "pyproject.toml"
|
||
"requirements.txt" "setup.py" "tox.ini" "pixi.toml")
|
||
:prefix "via "
|
||
:icon "🐍 "
|
||
:color "#CECB00"
|
||
:allow-remote nil
|
||
:reload-on 'cwd
|
||
:action #'eshell-starship--python-status
|
||
:postcmd-action #'eshell-starship--python-postcmd-action
|
||
:doc "Your current system-wide Python version.")
|
||
|
||
(eshell-starship-defmodule php
|
||
:extensions '("php")'
|
||
:files '("composer.json" ".php-version")
|
||
:prefix "via "
|
||
:icon "🐘 "
|
||
:color "#AFAFFF"
|
||
:allow-remote nil
|
||
:reload-on 'cwd
|
||
:action (eshell-starship-find-version-function
|
||
("php" "--version")
|
||
"^PHP \\([0-9.]+\\)"
|
||
"v" (match-string 1))
|
||
:doc "Your current PHP version.")
|
||
|
||
(eshell-starship-defmodule node
|
||
:extensions '("js" "mjs" "cjs" "ts" "mts" "cts")
|
||
:files '("package.json" ".node-version" ".nvmrc")
|
||
:dirs '("node_modules")
|
||
:prefix "via "
|
||
:icon " "
|
||
:color "green"
|
||
:allow-remote nil
|
||
:reload-on 'cwd
|
||
:action (eshell-starship-find-version-function
|
||
("node" "--version")
|
||
".+" (match-string 0))
|
||
:doc "Your current NodeJS version.")
|
||
|
||
|
||
;;; Misc modules
|
||
(eshell-starship-defmodule remote
|
||
:icon "🌐 "
|
||
:color "light blue"
|
||
:predicate
|
||
(lambda ()
|
||
(eshell-starship--remote-for-modules-p default-directory))
|
||
:action
|
||
(lambda ()
|
||
(or (file-remote-p default-directory 'host) ""))
|
||
:reload-on 'cwd
|
||
:doc "A small icon if the working directory is remote.")
|
||
|
||
(eshell-starship-defmodule root
|
||
:predicate
|
||
(lambda ()
|
||
(member (file-remote-p default-directory 'method)
|
||
'("doas" "sudo" "su" "sudoedit" "run0")))
|
||
:action
|
||
(lambda ()
|
||
(format "%s in"
|
||
(propertize (file-remote-p default-directory 'user)
|
||
'face '(:weight bold :foreground "red"))))
|
||
:reload-on 'cwd
|
||
:doc "Show the current sudo or doas user.")
|
||
|
||
(eshell-starship-defmodule newline
|
||
:predicate 'always
|
||
:action (lambda () (progn "\n"))
|
||
:doc "A newline in the prompt.")
|
||
|
||
(eshell-starship-defmodule container
|
||
:icon "⬢ "
|
||
:color "firebrick"
|
||
:predicate (lambda ()
|
||
(member (file-remote-p default-directory 'method)
|
||
'("docker" "podman" "kubernetes" "dockercp" "podmancp"
|
||
"toolbox" "distrobox" "flatpak" "apptainer" "nspawn")))
|
||
:action (lambda ()
|
||
(format "[%s]" (file-remote-p default-directory 'host)))
|
||
:reload-on 'cwd
|
||
:doc "The name of the current container.")
|
||
|
||
(eshell-starship-defmodule arrow
|
||
:predicate 'always
|
||
:reload-on 'always
|
||
:action (lambda ()
|
||
(propertize
|
||
"❯ " 'face `(:foreground
|
||
,(if (= eshell-last-command-status 0)
|
||
"lime green"
|
||
"red"))))
|
||
:doc "An arrow that appears next to where you type.")
|
||
|
||
|
||
;;; Driver code
|
||
(defun eshell-starship-clear-cache (&rest flags)
|
||
"Clear each cache entry with a \\=:reload-on of FLAGS.
|
||
If any of flags is t, clear all caches."
|
||
(interactive '(t) eshell-starship)
|
||
(cl-loop with force-clear = (member t flags)
|
||
for module being the hash-values of eshell-starship-modules
|
||
do (with-slots (name reload-on) module
|
||
(when (or force-clear
|
||
(cl-intersection (ensure-list reload-on) flags))
|
||
(eshell-starship-clear-cache-for name)))))
|
||
|
||
(defun eshell-starship--cwd-clear-caches ()
|
||
"Clear caches that should be cleared on cwd for eshell-starship."
|
||
(eshell-starship-clear-cache 'cwd))
|
||
|
||
(defun eshell-starship--permute-extension (ext)
|
||
"Permute EXT for lookup up modules.
|
||
That is, if EXT is \"pkg.tar.gz\", this will return
|
||
\(\"pkg.tar.gz\" \"tar.gz\" \"gz\")."
|
||
(cl-maplist (lambda (parts)
|
||
(mapconcat 'identity parts "."))
|
||
(string-split ext "\\.")))
|
||
|
||
(defun eshell-starship--file-name-extension (name)
|
||
"Return the extension for a file name NAME."
|
||
(if-let ((start (if (string-prefix-p "." name) 1 0))
|
||
(idx (cl-position ?. name :start start :test '=)))
|
||
(substring name (1+ idx))
|
||
""))
|
||
|
||
(defun eshell-starship--remote-for-modules-p (file)
|
||
"Return non-nil if FILE is remote for the purpose of running modules."
|
||
(let ((method (file-remote-p file 'method)))
|
||
(and method
|
||
(not (member method eshell-starship-overridden-remote-methods)))))
|
||
|
||
(defun eshell-starship--extension-modules-for-file (file)
|
||
"Return a list of modules that should be run due the exteions of FILE."
|
||
(mapcar (lambda (ext)
|
||
(cl-delete-if
|
||
(lambda (mod)
|
||
(cl-find file (eshell-starship-module-extensions-excluded-files mod)
|
||
:test #'equal))
|
||
(copy-sequence (eshell-starship--module-by
|
||
:extensions ext))))
|
||
(eshell-starship--permute-extension
|
||
(eshell-starship--file-name-extension file))))
|
||
|
||
(defun eshell-starship--modules-for-dir (dir)
|
||
"Return a list of modules that are applicable to DIR."
|
||
(let ((is-remote (eshell-starship--remote-for-modules-p dir)))
|
||
(seq-uniq
|
||
(nconc
|
||
(cl-delete-if
|
||
(lambda (module)
|
||
(and is-remote (not (eshell-starship-module-allow-remote-p module))))
|
||
(mapcan
|
||
(lambda (entry)
|
||
(let ((name (car entry))
|
||
(is-dir (eq t (file-attribute-type (cdr entry)))))
|
||
(if is-dir
|
||
(copy-sequence (eshell-starship--module-by :dirs name))
|
||
(apply 'append
|
||
(eshell-starship--module-by :files name)
|
||
(eshell-starship--extension-modules-for-file name)))))
|
||
(directory-files-and-attributes dir nil nil t)))
|
||
(let ((default-directory dir))
|
||
(cl-loop for (name is-dir module) in eshell-starship--extra-module-files
|
||
when (and (or (not is-remote)
|
||
(eshell-starship-module-allow-remote-p module))
|
||
is-dir (file-directory-p name))
|
||
collect module
|
||
when (and (or (not is-remote)
|
||
(eshell-starship-module-allow-remote-p module))
|
||
(not is-dir) (file-exists-p name))
|
||
collect module))
|
||
(let ((default-directory dir))
|
||
(cl-loop for module being the hash-values of eshell-starship-modules
|
||
for predicate = (eshell-starship-module-predicate module)
|
||
when (and (or (not is-remote)
|
||
(eshell-starship-module-allow-remote-p module))
|
||
(funcall predicate))
|
||
collect module)))
|
||
'eq)))
|
||
|
||
(defun eshell-starship--propertize-face (str append &rest faces)
|
||
"Copy STR and add FACES to its text properties.
|
||
This uses `add-face-text-property' internally, so it will add to existing `face'
|
||
properties. If STR is nil, return an empty string. If APPEND, give priority to
|
||
existing faces."
|
||
(if (not str)
|
||
""
|
||
(let ((copy (copy-sequence str)))
|
||
(dolist (face faces copy)
|
||
(add-face-text-property 0 (length copy) face append copy)))))
|
||
|
||
(defun eshell-starship--execute-module (module)
|
||
"Run the module MODULE and return its output.
|
||
Also cache the time it took to run it and its output."
|
||
(with-slots (name action prefix postfix icon color) module
|
||
(let ((oldtimes (cl-third (gethash name eshell-starship--module-cache)))
|
||
start-time result end-time)
|
||
(setq start-time (float-time)
|
||
result (funcall action)
|
||
end-time (float-time))
|
||
(when-let ((result)
|
||
(output
|
||
(concat prefix
|
||
(eshell-starship--propertize-face
|
||
icon t
|
||
(when color
|
||
(list (list :foreground color)))
|
||
'eshell-starship-icon-face)
|
||
(if color
|
||
(eshell-starship--propertize-face
|
||
result t (list :foreground color))
|
||
result)
|
||
postfix)))
|
||
(puthash name (list t output (cons (- end-time start-time)
|
||
(take 9 oldtimes)))
|
||
eshell-starship--module-cache)
|
||
output))))
|
||
|
||
(defvar-local eshell-starship--last-prompt-modules nil
|
||
"The list of the modules that where shown in the last prompt.")
|
||
|
||
(defun eshell-starship--execute-modules ()
|
||
"Execute all the modules in `eshell-starship-modules'.
|
||
Return a hash table mapping module names to their output."
|
||
(setq eshell-starship--last-prompt-modules nil)
|
||
(cl-loop
|
||
with output = (make-hash-table :test 'equal)
|
||
for module in (eshell-starship--modules-for-dir default-directory)
|
||
for name = (eshell-starship-module-name module)
|
||
for reload-on = (ensure-list (eshell-starship-module-reload-on module))
|
||
for cache-entry = (gethash name eshell-starship--module-cache)
|
||
do (if (and (not (member 'always reload-on)) (car cache-entry))
|
||
(puthash name (cl-second cache-entry) output)
|
||
(puthash name (eshell-starship--execute-module module) output))
|
||
do (push module eshell-starship--last-prompt-modules)
|
||
finally (maphash (lambda (k v)
|
||
(unless v
|
||
(remhash k output)))
|
||
output)
|
||
finally return output))
|
||
|
||
(defun eshell-starship--run-module-precmd-actions ()
|
||
"Run the pre-command action for each module."
|
||
(cl-loop for module being the hash-values of eshell-starship-modules
|
||
for precmd-action = (eshell-starship-module-precmd-action module)
|
||
when precmd-action
|
||
do (funcall precmd-action)))
|
||
|
||
(defun eshell-starship--run-module-postcmd-actions ()
|
||
"Run the post-command action for each module."
|
||
(cl-loop for module being the hash-values of eshell-starship-modules
|
||
for postcmd-action = (eshell-starship-module-postcmd-action module)
|
||
when postcmd-action
|
||
do (funcall postcmd-action)))
|
||
|
||
(defun eshell-starship--build-module-string ()
|
||
"Build a space-separated string of module outputs."
|
||
(let ((output (eshell-starship--execute-modules))
|
||
pre post found-rest)
|
||
(dolist (cur-name (mapcar (lambda (name)
|
||
(if (and (not (eq name t)) (symbolp name))
|
||
(symbol-name name)
|
||
name))
|
||
eshell-starship-module-order))
|
||
(cond
|
||
((and (eq cur-name t) found-rest)
|
||
(warn "t appears more than once in `eshell-starship-module-order"))
|
||
((eq cur-name t)
|
||
(setq found-rest t))
|
||
((not (gethash cur-name output))
|
||
;; skip
|
||
)
|
||
(found-rest
|
||
(push (gethash cur-name output) post)
|
||
(remhash cur-name output))
|
||
(t
|
||
(push (gethash cur-name output) pre)
|
||
(remhash cur-name output))))
|
||
(cl-loop for (part . rest) = (nconc (nreverse pre)
|
||
(hash-table-values output)
|
||
(nreverse post))
|
||
then rest
|
||
while part
|
||
concat part
|
||
unless (or (string-suffix-p "\n" part)
|
||
(string-empty-p part)
|
||
(not (car rest))
|
||
(string-prefix-p "\n" (car rest)))
|
||
concat " ")))
|
||
|
||
(defun eshell-starship--render-prompt ()
|
||
"Actually produce the prompt."
|
||
(concat
|
||
(prog1
|
||
(unless (or eshell-starship--is-first-prompt
|
||
(zerop (buffer-size)))
|
||
"\n")
|
||
(setq eshell-starship--is-first-prompt nil))
|
||
(let ((mods (eshell-starship--build-module-string)))
|
||
(add-face-text-property 0 (length mods) 'default t mods)
|
||
mods)))
|
||
|
||
(defvar-local eshell-starship--last-prompt-info nil
|
||
"A list of the last prompt and the time it took to render it.")
|
||
|
||
(defun eshell-starship--prompt-function ()
|
||
"Function for `eshell-prompt-function'."
|
||
(let ((tramp-verbose eshell-starship-verbose-tramp)
|
||
start-time prompt end-time)
|
||
(setq start-time (float-time)
|
||
prompt (eshell-starship--render-prompt)
|
||
end-time (float-time)
|
||
eshell-starship--last-prompt-info
|
||
(list prompt (- end-time start-time)))
|
||
(when (buffer-live-p eshell-starship--current-explain-buffer)
|
||
(with-current-buffer eshell-starship--current-explain-buffer
|
||
(when eshell-starship-explain-auto-update
|
||
(let ((eshell-starship-explain-suppress-refresh-messages t))
|
||
(revert-buffer)))))
|
||
prompt))
|
||
|
||
(defvar-local eshell-starship--restore-state nil
|
||
"State of various variables set by `eshell-starship-prompt-mode'.")
|
||
|
||
(defvar-local eshell-starship--explain-eshell-buffer nil
|
||
"The eshell buffer backing this eshell-starship-explain buffer.")
|
||
|
||
(defun eshell-starship--enable ()
|
||
"Enable eshell-starship."
|
||
(setq-local eshell-starship--restore-state
|
||
(buffer-local-set-state
|
||
eshell-prompt-function 'eshell-starship--prompt-function)
|
||
eshell-starship--module-cache (make-hash-table :test 'equal))
|
||
(add-hook 'eshell-pre-command-hook
|
||
#'eshell-starship--run-module-precmd-actions nil t)
|
||
(add-hook 'eshell-post-command-hook
|
||
#'eshell-starship--run-module-postcmd-actions nil t)
|
||
(add-hook 'eshell-directory-change-hook #'eshell-starship--cwd-clear-caches
|
||
nil t))
|
||
|
||
(defun eshell-starship--disable ()
|
||
"Disable eshell-starship."
|
||
(when eshell-starship--current-explain-buffer
|
||
(with-current-buffer eshell-starship--current-explain-buffer
|
||
(setq eshell-starship--explain-eshell-buffer nil)))
|
||
(setq-local eshell-starship--module-cache nil
|
||
eshell-starship--current-explain-buffer nil)
|
||
(buffer-local-restore-state eshell-starship--restore-state)
|
||
(remove-hook 'eshell-pre-command-hook
|
||
#'eshell-starship--run-module-precmd-actions t)
|
||
(remove-hook 'eshell-post-command-hook
|
||
#'eshell-starship--run-module-postcmd-actions t)
|
||
(remove-hook 'eshell-directory-change-hook #'eshell-starship--cwd-clear-caches
|
||
t))
|
||
|
||
;;;###autoload
|
||
(define-minor-mode eshell-starship-prompt-mode
|
||
"Minor mode to make eshell prompts look like starship (https://starship.rs)."
|
||
:global nil
|
||
:init-value nil
|
||
:interactive (eshell-mode)
|
||
(if eshell-starship-prompt-mode
|
||
(eshell-starship--enable)
|
||
(eshell-starship--disable)))
|
||
|
||
|
||
;;; Explain buffer
|
||
(defface eshell-starship--heading
|
||
'((t (:height 1.2 :weight bold) ))
|
||
"Face for showing headings in `eshell-starship-explain' buffers.")
|
||
|
||
(defun eshell-starship--insert-prompt-string (str &optional prefix first-prefix)
|
||
"Insert STR, a prompt string, into the current buffer.
|
||
This just cleans up STR a bit before inserting it. Also, if PREFIX is non-nil,
|
||
it will be inserted at the start of each line. If FIRST-PREFIX is non-nil, it
|
||
will be used specially as the first line's prefix."
|
||
(cl-loop with first-line = t
|
||
with blank-count = 0
|
||
with found-start = nil
|
||
for line in (string-lines str)
|
||
for empty = (zerop (length line))
|
||
while line
|
||
do
|
||
(if empty
|
||
(when found-start
|
||
(cl-incf blank-count))
|
||
(setq found-start t)
|
||
(dotimes (_ blank-count)
|
||
(insert "\n"))
|
||
(if (and first-line first-prefix)
|
||
(progn
|
||
(insert first-prefix)
|
||
(setq first-line nil))
|
||
(insert prefix))
|
||
(insert line)
|
||
(insert "\n"))))
|
||
|
||
(defun eshell-starship--explain-insert-module (module &optional no-output)
|
||
"Insert information about MODULE at point.
|
||
If NO-OUTPUT is non-nil, don't insert the modules previous output."
|
||
(with-slots (name doc) module
|
||
(let ((bullet-char (if (char-displayable-p ?\•)
|
||
?\•
|
||
?\-))
|
||
(cache-entry (gethash
|
||
name (buffer-local-value
|
||
'eshell-starship--module-cache
|
||
eshell-starship--explain-eshell-buffer))))
|
||
(insert (format " %c %s - %s\n"
|
||
bullet-char
|
||
(propertize name
|
||
'face 'font-lock-keyword-face)
|
||
doc))
|
||
(unless no-output
|
||
(unless (member module
|
||
(buffer-local-value 'eshell-starship--last-prompt-modules
|
||
eshell-starship--explain-eshell-buffer))
|
||
(insert " (This module is hidden.)\n"))
|
||
(if (not (cl-first cache-entry))
|
||
(insert " This module has no cached output.\n")
|
||
(insert " Last output was:\n")
|
||
(eshell-starship--insert-prompt-string (cl-second cache-entry)
|
||
" "
|
||
" \"")
|
||
(forward-line -1)
|
||
(end-of-line)
|
||
(insert "\"")
|
||
(forward-line)
|
||
(insert (format " It took %s.\n"
|
||
(eshell-starship-format-span
|
||
(car (cl-third cache-entry)) 3))))
|
||
(insert "\n")))))
|
||
|
||
(defun eshell-starship--explain-insert-enabled ()
|
||
"Insert an explanation of enabled modules at point."
|
||
(let ((rest-modules (copy-hash-table eshell-starship-modules))
|
||
rest-point)
|
||
(dolist (cur-name eshell-starship-module-order)
|
||
(unless (cl-member cur-name eshell-starship-disabled-modules
|
||
:test 'equal)
|
||
(if (eq cur-name t)
|
||
(setq rest-point (point))
|
||
(when-let ((module (gethash cur-name eshell-starship-modules)))
|
||
(eshell-starship--explain-insert-module module)
|
||
(remhash cur-name rest-modules)))))
|
||
(save-excursion
|
||
(goto-char rest-point)
|
||
(cl-loop for module being the hash-values of rest-modules
|
||
using (hash-keys name)
|
||
unless (cl-member name eshell-starship-disabled-modules
|
||
:test 'equal)
|
||
do (eshell-starship--explain-insert-module module)))))
|
||
|
||
(defun eshell-starship--explain-format-buffer ()
|
||
"Fill the current buffer with content for `eshell-starship-explain'."
|
||
(unless (buffer-live-p eshell-starship--explain-eshell-buffer)
|
||
(error "Parent Eshell buffer is gone (or no longer using eshell-starship)"))
|
||
(erase-buffer)
|
||
(cl-flet ((heading (txt)
|
||
(propertize txt 'face 'eshell-starship--heading)))
|
||
(cl-destructuring-bind (&optional last-prompt last-time)
|
||
(buffer-local-value 'eshell-starship--last-prompt-info
|
||
eshell-starship--explain-eshell-buffer)
|
||
(when (and last-prompt last-time)
|
||
(insert "The last prompt was:\n")
|
||
(eshell-starship--insert-prompt-string last-prompt " ")
|
||
(insert
|
||
(format "\nIt was rendered in %s.\n\n"
|
||
(eshell-starship-format-span last-time 3)))))
|
||
(insert (heading "The following modules are enabled:\n"))
|
||
(eshell-starship--explain-insert-enabled)
|
||
(if (null eshell-starship-disabled-modules)
|
||
(insert (heading "There are no disabled modules."))
|
||
(insert (heading "The following modules are disabled:\n"))
|
||
(dolist (name eshell-starship-disabled-modules)
|
||
(when-let ((module (gethash name eshell-starship-modules)))
|
||
(eshell-starship--explain-insert-module module t)))
|
||
;; get rid of newline
|
||
(delete-char -1))))
|
||
|
||
(defun eshell-starship--explain-revert (_ignore-auto _noconfirm)
|
||
"Revert function for eshell-starship explain buffers.
|
||
_IGNORE-AUTO and _NOCONFIRM are ignored."
|
||
(let ((save (point))
|
||
(inhibit-read-only t))
|
||
(eshell-starship--explain-format-buffer)
|
||
(goto-char save))
|
||
(unless eshell-starship-explain-suppress-refresh-messages
|
||
(message "Refreshed eshell-starship explain buffer")))
|
||
|
||
;;;###autoload
|
||
(defun eshell-starship-explain-toggle-auto-update-mode (&optional arg)
|
||
"Toggle `eshell-starship-explain-auto-update' in the current buffer.
|
||
If ARG is negative, disable it. If ARG is positive, enable it. Otherwise,
|
||
toggle it."
|
||
(interactive "P" eshell-starship-explain-mode)
|
||
(unless (derived-mode-p 'eshell-starship-explain-mode)
|
||
(error "Not an eshell-starship explain buffer"))
|
||
(if (not arg)
|
||
(cl-callf not eshell-starship-explain-auto-update)
|
||
(let ((num (prefix-numeric-value arg)))
|
||
(setq eshell-starship-explain-auto-update (<= 0 num))))
|
||
(when eshell-starship-explain-auto-update
|
||
(revert-buffer))
|
||
(force-mode-line-update)
|
||
(message "%s auto-updating."
|
||
(if eshell-starship-explain-auto-update
|
||
"Enabled"
|
||
"Disabled")))
|
||
|
||
;;;###autoload
|
||
(defvar-keymap eshell-starship-explain-mode-map
|
||
:doc "Keymap for `eshell-starship-explain-mode'."
|
||
:parent special-mode-map
|
||
:suppress t
|
||
"a" #'eshell-starship-explain-toggle-auto-update-mode
|
||
"r" #'revert-buffer)
|
||
|
||
(define-derived-mode eshell-starship-explain-mode nil
|
||
"Eshell-Starship Explain"
|
||
"Major mode for `eshell-starship-explain' buffers."
|
||
:group 'eshell-starship
|
||
:interactive nil
|
||
(setq-local mode-name
|
||
'("Eshell-Starship Explain"
|
||
(eshell-starship-explain-auto-update "/a"))
|
||
display-line-numbers nil
|
||
revert-buffer-function
|
||
'eshell-starship--explain-revert))
|
||
|
||
;;;###autoload
|
||
(defun eshell-starship-setup-evil-keybindings ()
|
||
"Setup keybindings for `evil-mode' for eshell-starship."
|
||
(require 'evil)
|
||
(when (fboundp 'evil-define-key*)
|
||
(evil-define-key* '(motion normal) eshell-starship-explain-mode-map
|
||
"a" #'eshell-starship-explain-toggle-auto-update-mode
|
||
"r" #'revert-buffer)))
|
||
|
||
;;;###autoload
|
||
(defun eshell-starship-explain ()
|
||
"Show some information about the current prompt."
|
||
(interactive nil eshell-mode)
|
||
(unless (derived-mode-p 'eshell-mode)
|
||
(error "Current buffer is not in eshell-mode. Nothing to explain"))
|
||
(let ((eshell-buffer (current-buffer))
|
||
(explain-buffer (get-buffer-create "*Eshell-Starship Explain*")))
|
||
(dolist (buffer (buffer-list))
|
||
(with-current-buffer buffer
|
||
(cond
|
||
((eq buffer eshell-buffer)
|
||
(setq eshell-starship--current-explain-buffer explain-buffer))
|
||
((derived-mode-p 'eshell-mode)
|
||
(setq eshell-starship--current-explain-buffer nil)))))
|
||
(with-current-buffer explain-buffer
|
||
(unless (derived-mode-p 'eshell-starship-explain-mode)
|
||
(eshell-starship-explain-mode))
|
||
(setq eshell-starship--explain-eshell-buffer eshell-buffer)
|
||
(save-excursion
|
||
(let ((inhibit-read-only t))
|
||
(eshell-starship--explain-format-buffer)))
|
||
(pop-to-buffer (current-buffer)))))
|
||
|
||
(provide 'eshell-starship)
|
||
;;; eshell-starship.el ends here
|