1027 lines
39 KiB
EmacsLisp
1027 lines
39 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)
|
||
|
||
;;; 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" "cwd" "vc" t "cmd-time" "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)
|
||
|
||
|
||
;;; 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.")
|
||
(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 'ignore
|
||
: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--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)))
|
||
(dolist (buffer (buffer-list))
|
||
(with-current-buffer buffer
|
||
(when (hash-table-p eshell-starship--module-cache)
|
||
(remhash (symbol-name name) eshell-starship--module-cache))))
|
||
;; This returns module
|
||
(puthash (symbol-name 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))))
|
||
|
||
|
||
;;; 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 (if-let ((worktree (vc-root-dir))
|
||
(parent (file-name-parent-directory worktree)))
|
||
(file-relative-name default-directory parent)
|
||
(eshell-starship--replace-home-with-tilda default-directory)))
|
||
'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.")
|
||
|
||
|
||
;;; VC (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)))
|
||
(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")) ")"))))))))
|
||
|
||
(defun eshell-starship--vc-status ()
|
||
"Get vc status for `eshell-starship--prompt-function'."
|
||
(if-let (backend (vc-responsible-backend default-directory t))
|
||
(if (eq backend 'Git)
|
||
(let ((status (eshell-starship--git-status)))
|
||
(and (not (zerop (length status))) status))
|
||
(propertize
|
||
(concat " " (downcase (symbol-name backend)))
|
||
'face '(:foreground "purple")))))
|
||
|
||
(eshell-starship-defmodule vc
|
||
:predicate 'always
|
||
:allow-remote nil
|
||
:reload-on 'always
|
||
:action 'eshell-starship--vc-status
|
||
:doc "The working directory's version control status.")
|
||
|
||
|
||
;;; 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
|
||
(eshell-starship-format-span (- eshell-starship--last-end-time
|
||
eshell-starship--last-start-time)))
|
||
(setq eshell-starship--last-start-time nil)))
|
||
|
||
(eshell-starship-defmodule cmd-time
|
||
: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)))
|
||
:predicate (lambda ()
|
||
(and eshell-starship--last-start-time
|
||
eshell-starship--last-end-time
|
||
(<= 3 (- eshell-starship--last-end-time
|
||
eshell-starship--last-start-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")
|
||
: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")
|
||
: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.")
|
||
|
||
(eshell-starship-defmodule python
|
||
:extensions '("py" "ipynb")
|
||
: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-find-version-function
|
||
("python" "--version")
|
||
"^Python \\([0-9.]+\\)"
|
||
"v" (match-string 1))
|
||
: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")
|
||
: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 ()
|
||
(file-remote-p default-directory))
|
||
:doc "A small icon if the working directory is remote.")
|
||
|
||
(eshell-starship-defmodule arrow
|
||
:predicate 'always
|
||
:reload-on 'always
|
||
:action (lambda ()
|
||
(concat
|
||
(propertize "\n" 'read-only t 'rear-nonsticky t)
|
||
(propertize
|
||
"❯ " 'face `(:foreground
|
||
,(if (= eshell-last-command-status 0)
|
||
"lime green"
|
||
"red"))
|
||
'rear-nonsticky t)))
|
||
: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-let (((or force-clear
|
||
(cl-intersection (ensure-list reload-on) flags)))
|
||
(cur-entry (gethash name
|
||
eshell-starship--module-cache)))
|
||
(setf (car cur-entry) nil)))))
|
||
|
||
(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--exts-exist-p (&rest exts)
|
||
"Test if any files with EXTS at the end of their name exist.
|
||
The test is performed relative to `default-directory'."
|
||
(catch 'found
|
||
(dolist (ext exts)
|
||
(when (seq-filter #'(lambda (name)
|
||
(not (string-prefix-p "." name)))
|
||
(file-expand-wildcards (concat "*." ext)))
|
||
(throw 'found t)))))
|
||
|
||
(defun eshell-starship--files-exist-p (&rest names)
|
||
"Test if any of NAMES exist and are normal files.
|
||
The test is performed relative to `default-directory'."
|
||
(catch 'found
|
||
(dolist (name names)
|
||
(when (file-exists-p name)
|
||
(throw 'found t)))))
|
||
|
||
(defun eshell-starship--dirs-exist-p (&rest names)
|
||
"Test if any of NAMES exist and are directories.
|
||
The test is performed relative to `default-directory'."
|
||
(catch 'found
|
||
(dolist (name names)
|
||
(when (file-directory-p name)
|
||
(throw 'found t)))))
|
||
|
||
(cl-defun eshell-starship--display-module-p (module &optional
|
||
(dir default-directory))
|
||
"Return non-nil if MODULE should be displayed while in DIR."
|
||
(with-slots (name predicate files dirs extensions allow-remote) module
|
||
(and (not (cl-member name eshell-starship-disabled-modules :test 'equal))
|
||
(or allow-remote (not (file-remote-p dir)))
|
||
(let ((default-directory dir))
|
||
(or (and files (apply 'eshell-starship--files-exist-p files))
|
||
(and dirs (apply' eshell-starship--dirs-exist-p dirs))
|
||
(and extensions (apply' eshell-starship--exts-exist-p extensions))
|
||
(and predicate (funcall predicate)))))))
|
||
|
||
(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
|
||
(if color
|
||
(propertize (concat icon result)
|
||
'face `(:foreground ,color))
|
||
(concat icon result))
|
||
postfix)))
|
||
(puthash name (list t output (cons (- end-time start-time)
|
||
(take 9 oldtimes)))
|
||
eshell-starship--module-cache)
|
||
output))))
|
||
|
||
(defun eshell-starship--execute-modules ()
|
||
"Execute all the modules in `eshell-starship-modules'.
|
||
Return a hash table mapping module names to their output."
|
||
(cl-loop
|
||
with output = (make-hash-table :test 'equal)
|
||
for module being the hash-values of eshell-starship-modules
|
||
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 (when (eshell-starship--display-module-p module)
|
||
(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)))
|
||
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))))
|
||
(mapconcat 'identity
|
||
(nconc (nreverse pre) (hash-table-values output) (nreverse post))
|
||
" ")))
|
||
|
||
(defun eshell-starship--render-prompt ()
|
||
"Actually produce the prompt."
|
||
(concat
|
||
(unless (< (line-number-at-pos) 3)
|
||
"\n")
|
||
(eshell-starship--build-module-string)))
|
||
|
||
(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 (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-prompt-regexp "^❯ "
|
||
eshell-highlight-prompt nil)
|
||
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 (eshell-starship--display-module-p
|
||
module
|
||
(buffer-local-value 'default-directory
|
||
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
|