emacs-config/elisp/eshell-starship.el

;;; 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")
  "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'.")


;;; 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 '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")
  :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")))
  :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 () (propertize "\n" 'read-only t 'rear-nonsticky t))
  :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")))
  :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"))
             '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 (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--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 'nconc
                     (eshell-starship--module-by :files name)
                     (mapcar (lambda (ext)
                               (copy-sequence (eshell-starship--module-by
                                               :extensions ext)))
                             (eshell-starship--permute-extension
                              (eshell-starship--file-name-extension 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
   (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 ((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
               ;; temporary fix until the next version where eshell uses fields
               eshell-prompt-regexp (rx bol (? "⬢ [" (+ any) "] ") "❯ ")
               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 (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