From dd7d8c711c04f36cf4f2351fd2afe2c058a64b95 Mon Sep 17 00:00:00 2001 From: Kiana Sheibani Date: Sat, 14 Feb 2026 18:50:01 -0500 Subject: [PATCH] tweak(confpkg): improve `confpkg` timing window --- config.org | 277 +++++++++++++++++++++++++++-------------------------- 1 file changed, 142 insertions(+), 135 deletions(-) diff --git a/config.org b/config.org index 3e3d058..3ffe4a7 100644 --- a/config.org +++ b/config.org @@ -160,8 +160,10 @@ If you're reading the raw org file instead of the published version, the code fo (let (symbols) (while (re-search-forward (rx line-start (* (any ?\s ?\t)) "(" - (or "defun" "defmacro" "defsubst" "defgeneric" "defalias" "defvar" "defcustom" "defface" "deftheme" - "cl-defun" "cl-defmacro" "cl-defsubst" "cl-defmethod" "cl-defstruct" "cl-defgeneric" "cl-deftype") + (or "defun" "defmacro" "defsubst" "defgeneric" "defalias" + "defvar" "defcustom" "defface" "deftheme" + "cl-defun" "cl-defmacro" "cl-defsubst" "cl-defmethod" + "cl-defstruct" "cl-defgeneric" "cl-deftype") (+ (any ?\s ?\t)) (group (+ (any "A-Z" "a-z" "0-9" ?+ ?- ?* ?/ ?_ ?~ ?! ?@ ?$ ?% ?^ ?& ?= ?: ?< ?> ?{ ?}))) @@ -615,141 +617,146 @@ NODE defaults to the root node." (let ((buf (get-buffer-create "*Confpkg Load Time Report*")) (depth 0) num-pad name-pad max-time max-total-time max-depth) - (cl-labels - ((sort-records-by-time - (record) - (let ((self (assoc 'self record))) - (append (list self) - (sort (nreverse (remove self (cdr record))) - (lambda (a b) - (> (or (plist-get (alist-get 'self a) :total) 0.0) - (or (plist-get (alist-get 'self b) :total) 0.0))))))) - (print-record - (record) - (cond - ((eq (car record) 'self) + (when (zerop (buffer-size buf)) + (cl-labels + ((sort-records-by-time + (record) + (let ((self (assoc 'self record))) + (append (list self) + (sort (nreverse (remove self (cdr record))) + (lambda (a b) + (> (or (plist-get (alist-get 'self a) :total) 0.0) + (or (plist-get (alist-get 'self b) :total) 0.0))))))) + (print-record + (record) + (cond + ((eq (car record) 'self) + (insert + (propertize + (string-pad (number-to-string (plist-get (cdr record) :num)) num-pad) + 'face 'font-lock-keyword-face) + " " + (propertize + (apply #'concat + (make-list (1- depth) "• ")) + 'face 'font-lock-comment-face) + (string-pad (format "%s" (plist-get (cdr record) :name)) name-pad) + (make-string (* (- max-depth depth) 2) ?\s) + (propertize + (format "%.4fs" (plist-get (cdr record) :elapsed)) + 'face + (list :foreground + (doom-blend 'orange 'green + (/ (plist-get (cdr record) :elapsed) max-time)))) + (if (= (plist-get (cdr record) :elapsed) + (plist-get (cdr record) :total)) + "" + (concat " (Σ=" + (propertize + (format "%.3fs" (plist-get (cdr record) :total)) + 'face + (list :foreground + (doom-blend 'orange 'green + (/ (plist-get (cdr record) :total) max-total-time)))) + ")")) + "\n")) + (t + (cl-incf depth) + (mapc + #'print-record + (if sort-p + (sort-records-by-time record) + (reverse (cdr record)))) + (cl-decf depth)))) + (flatten-records + (records) + (if (eq (car records) 'self) + (list records) + (mapcan + #'flatten-records + (reverse (cdr records))))) + (tree-depth + (records &optional depth) + (if (eq (car records) 'self) + (or depth 0) + (1+ (cl-reduce #'max (cdr records) :key #'tree-depth)))) + (mapreduceprop + (list map reduce prop) + (cl-reduce + reduce list + :key + (lambda (p) (funcall map (plist-get (cdr p) prop))))) + (elaborate-timings + (record) + (if (eq (car record) 'self) + (plist-get (cdr record) :elapsed) + (let ((total (cl-reduce #'+ (cdr record) + :key #'elaborate-timings)) + (self (cdr (assoc 'self record)))) + (if (plist-get self :enclosing) + (prog1 + (plist-get self :elapsed) + (plist-put self :total (plist-get self :elapsed)) + (plist-put self :elapsed + (- (* 2 (plist-get self :elapsed)) total))) + (plist-put self :total total) + total)))) + (elaborated-timings + (record) + (let ((record (copy-tree record))) + (elaborate-timings record) + record))) + (let* ((tree + (elaborated-timings + (append '(root) + (copy-tree + (alist-get (or node 'root) + confpkg-load-time-tree + nil nil #'equal)) + '((self :num 0 :elapsed 0))))) + (flat-records + (cl-remove-if + (lambda (rec) (= (plist-get (cdr rec) :num) 0)) + (flatten-records tree)))) + (setq max-time (mapreduceprop flat-records #'identity #'max :elapsed) + max-total-time (mapreduceprop flat-records #'identity #'max :total) + name-pad (mapreduceprop flat-records #'length #'max :name) + num-pad (mapreduceprop flat-records + (lambda (n) (length (number-to-string n))) + #'max :num) + max-depth (tree-depth tree)) + (with-current-buffer buf + (erase-buffer) + (setq-local outline-regexp "[0-9]+ *\\(?:• \\)*") + (outline-minor-mode 1) + (use-local-map (make-sparse-keymap)) + (local-set-key "TAB" #'outline-toggle-children) + (local-set-key "\t" #'outline-toggle-children) + (local-set-key (kbd "") #'outline-show-subtree) + (local-set-key (kbd "C-") + (eval `(cmd! (if current-prefix-arg + (outline-show-all) + (outline-hide-sublevels (+ ,num-pad 2)))))) (insert (propertize - (string-pad (number-to-string (plist-get (cdr record) :num)) num-pad) - 'face 'font-lock-keyword-face) - " " - (propertize - (apply #'concat - (make-list (1- depth) "• ")) - 'face 'font-lock-comment-face) - (string-pad (format "%s" (plist-get (cdr record) :name)) name-pad) - (make-string (* (- max-depth depth) 2) ?\s) - (propertize - (format "%.4fs" (plist-get (cdr record) :elapsed)) - 'face - (list :foreground - (doom-blend 'orange 'green - (/ (plist-get (cdr record) :elapsed) max-time)))) - (if (= (plist-get (cdr record) :elapsed) - (plist-get (cdr record) :total)) - "" - (concat " (Σ=" - (propertize - (format "%.3fs" (plist-get (cdr record) :total)) - 'face - (list :foreground - (doom-blend 'orange 'green - (/ (plist-get (cdr record) :total) max-total-time)))) - ")")) - "\n")) - (t - (cl-incf depth) - (mapc - #'print-record - (if sort-p - (sort-records-by-time record) - (reverse (cdr record)))) - (cl-decf depth)))) - (flatten-records - (records) - (if (eq (car records) 'self) - (list records) - (mapcan - #'flatten-records - (reverse (cdr records))))) - (tree-depth - (records &optional depth) - (if (eq (car records) 'self) - (or depth 0) - (1+ (cl-reduce #'max (cdr records) :key #'tree-depth)))) - (mapreduceprop - (list map reduce prop) - (cl-reduce - reduce list - :key - (lambda (p) (funcall map (plist-get (cdr p) prop))))) - (elaborate-timings - (record) - (if (eq (car record) 'self) - (plist-get (cdr record) :elapsed) - (let ((total (cl-reduce #'+ (cdr record) - :key #'elaborate-timings)) - (self (cdr (assoc 'self record)))) - (if (plist-get self :enclosing) - (prog1 - (plist-get self :elapsed) - (plist-put self :total (plist-get self :elapsed)) - (plist-put self :elapsed - (- (* 2 (plist-get self :elapsed)) total))) - (plist-put self :total total) - total)))) - (elaborated-timings - (record) - (let ((record (copy-tree record))) - (elaborate-timings record) - record))) - (let* ((tree - (elaborated-timings - (append '(root) - (copy-tree - (alist-get (or node 'root) - confpkg-load-time-tree - nil nil #'equal)) - '((self :num 0 :elapsed 0))))) - (flat-records - (cl-remove-if - (lambda (rec) (= (plist-get (cdr rec) :num) 0)) - (flatten-records tree)))) - (setq max-time (mapreduceprop flat-records #'identity #'max :elapsed) - max-total-time (mapreduceprop flat-records #'identity #'max :total) - name-pad (mapreduceprop flat-records #'length #'max :name) - num-pad (mapreduceprop flat-records - (lambda (n) (length (number-to-string n))) - #'max :num) - max-depth (tree-depth tree)) - (with-current-buffer buf - (erase-buffer) - (setq-local outline-regexp "[0-9]+ *\\(?:• \\)*") - (outline-minor-mode 1) - (use-local-map (make-sparse-keymap)) - (local-set-key "TAB" #'outline-toggle-children) - (local-set-key "\t" #'outline-toggle-children) - (local-set-key (kbd "") #'outline-show-subtree) - (local-set-key (kbd "C-") - (eval `(cmd! (if current-prefix-arg - (outline-show-all) - (outline-hide-sublevels (+ ,num-pad 2)))))) - (insert - (propertize - (concat (string-pad "#" num-pad) " " - (string-pad "Confpkg" - (+ name-pad (* 2 max-depth) -3)) - (format " Load Time (Σ=%.3fs)\n" - (plist-get (cdr (assoc 'self tree)) :total))) - 'face '(:inherit (tab-bar-tab bold) :extend t :underline t))) - (dolist (record (if sort-p - (sort-records-by-time tree) - (reverse (cdr tree)))) - (unless (eq (car record) 'self) - (print-record record))) - (set-buffer-modified-p nil) - (goto-char (point-min))) - (pop-to-buffer buf))))) + (concat (string-pad "#" num-pad) " " + (string-pad "Confpkg" + (+ name-pad (* 2 max-depth) -3)) + (format " Load Time (Σ=%.3fs)\n" + (plist-get (cdr (assoc 'self tree)) :total))) + 'face '(:inherit (tab-bar-tab bold) :extend t :underline t))) + (dolist (record (if sort-p + (sort-records-by-time tree) + (reverse (cdr tree)))) + (unless (eq (car record) 'self) + (print-record record))) + (set-buffer-modified-p nil) + (setq buffer-read-only t) + (goto-char (point-min)))))) + (pop-to-buffer buf))) + +(set-popup-rule! "^\\*Confpkg Load Time Report\\*$" + :side 'right :size 0.5 :ttl t) #+end_src ** Source Code Patching