tweak(confpkg): improve confpkg timing window
This commit is contained in:
parent
3cc3479741
commit
dd7d8c711c
GPG key ID:
6CB106C25E86A9F7
1 changed files with 142 additions and 135 deletions
277
config.org
277
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 "<backtab>") #'outline-show-subtree)
|
||||
(local-set-key (kbd "C-<iso-lefttab>")
|
||||
(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 "<backtab>") #'outline-show-subtree)
|
||||
(local-set-key (kbd "C-<iso-lefttab>")
|
||||
(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
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue