Zander671/emacs-config
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity
b6ddcd03c0
emacs-config/elisp/eshell-starship.el

1063 lines
40 KiB
EmacsLisp
Raw Blame History

This file contains invisible Unicode characters

This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

This file contains Unicode characters that might be confused with other characters. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

;;; 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)
(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")
;;; 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.")
;;; 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)
;;; 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
(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
: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--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))))
(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
Reference in New Issue View Git Blame Copy Permalink