From 09914fc3a9210116356f60447dabf880d93665aa Mon Sep 17 00:00:00 2001 From: Alexander Rosenberg Date: Sun, 22 Dec 2024 05:22:45 -0800 Subject: [PATCH] Make eshell-starship.el more efficient --- elisp/eshell-starship.el | 165 +++++++++++++++++++++++++++------------ init.el | 1 + 2 files changed, 117 insertions(+), 49 deletions(-) diff --git a/elisp/eshell-starship.el b/elisp/eshell-starship.el index f38cb2d..6667160 100644 --- a/elisp/eshell-starship.el +++ b/elisp/eshell-starship.el @@ -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))) - (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--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)) + (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)) - (puthash name (cl-second cache-entry) output) - (puthash name (eshell-starship--execute-module module) output))) + 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))) @@ -908,10 +976,9 @@ 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 - eshell-starship--explain-eshell-buffer)) + (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") diff --git a/init.el b/init.el index 219cfbb..b88fdb9 100644 --- a/init.el +++ b/init.el @@ -514,6 +514,7 @@ directory. Otherwise, run `find-file' on that file." ("C-c o" . evil-cp-open-below-form)) :custom (evil-cleverparens-use-s-and-S nil) + (evil-cleverparens-complete-parens-in-yanked-region t) :config (eldoc-add-command 'paredit-RET 'paredit-open-round