Make eshell-starship.el more efficient
This commit is contained in:
parent
c2001ae2b3
commit
09914fc3a9
GPG Key ID:
5FD0394ADBD72730
@ -64,6 +64,22 @@ 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)
|
||||
@ -168,18 +184,56 @@ reloaded. Current possible values are:
|
||||
: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)))
|
||||
: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 (symbol-name name) eshell-starship--module-cache))))
|
||||
(remhash str-name eshell-starship--module-cache))))
|
||||
(eshell-starship--register-module-lookups module)
|
||||
;; This returns module
|
||||
(puthash (symbol-name name) module eshell-starship-modules)))
|
||||
(puthash str-name module eshell-starship-modules)))
|
||||
|
||||
(defmacro eshell-starship-defmodule (name &rest opts)
|
||||
"Create a new eshell-starship named NAME module with OPTS."
|
||||
@ -405,7 +459,8 @@ For example, a revert. If there is no current operation, return nil."
|
||||
:color "medium purple"
|
||||
:icon " "
|
||||
:reload-on 'always
|
||||
:action 'eshell-starship--git-status)
|
||||
:action 'eshell-starship--git-status
|
||||
:doc "The working directory's status as a git repository.")
|
||||
|
||||
|
||||
;;; Non-git VC module
|
||||
@ -502,6 +557,7 @@ For example, a revert. If there is no current operation, return nil."
|
||||
|
||||
(eshell-starship-defmodule cmake
|
||||
:files '("CMakeLists.txt" "CMakeCache.txt")
|
||||
:extensions '("cmake")
|
||||
:prefix "via "
|
||||
:icon " "
|
||||
:color "blue"
|
||||
@ -600,6 +656,7 @@ For example, a revert. If there is no current operation, return nil."
|
||||
:extensions '("js" "mjs" "cjs" "ts" "mts" "cts")
|
||||
:files '("package.json" ".node-version" ".nvmrc")
|
||||
:dirs '("node_modules")
|
||||
:prefix "via "
|
||||
:icon " "
|
||||
:color "green"
|
||||
:allow-remote nil
|
||||
@ -634,7 +691,6 @@ For example, a revert. If there is no current operation, return nil."
|
||||
|
||||
|
||||
;;; 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."
|
||||
@ -652,43 +708,51 @@ If any of flags is t, clear all 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--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--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--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--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)))
|
||||
(defun eshell-starship--modules-for-dir (dir)
|
||||
"Return a list of modules that are applicable to DIR."
|
||||
(seq-uniq
|
||||
(nconc
|
||||
(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))
|
||||
(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)))))))
|
||||
(cl-loop for (name is-dir module) in eshell-starship--extra-module-files
|
||||
when (and is-dir (file-directory-p name))
|
||||
collect module
|
||||
when (and (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 (funcall predicate)
|
||||
collect module)))
|
||||
'eq))
|
||||
|
||||
(defun eshell-starship--propertize-face (str append &rest faces)
|
||||
"Copy STR and add FACES to its text properties.
|
||||
@ -728,19 +792,23 @@ Also cache the time it took to run it and its output."
|
||||
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 being the hash-values of eshell-starship-modules
|
||||
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 (when (eshell-starship--display-module-p module)
|
||||
(if (and (not (member 'always reload-on)) (car cache-entry))
|
||||
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)))
|
||||
(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)))
|
||||
@ -908,9 +976,8 @@ If NO-OUTPUT is non-nil, don't insert the modules previous output."
|
||||
'face 'font-lock-keyword-face)
|
||||
doc))
|
||||
(unless no-output
|
||||
(unless (eshell-starship--display-module-p
|
||||
module
|
||||
(buffer-local-value 'default-directory
|
||||
(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))
|
||||
|
||||
Loading…
Reference in New Issue
Block a user