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)
|
(let (symbols)
|
||||||
(while (re-search-forward
|
(while (re-search-forward
|
||||||
(rx line-start (* (any ?\s ?\t)) "("
|
(rx line-start (* (any ?\s ?\t)) "("
|
||||||
(or "defun" "defmacro" "defsubst" "defgeneric" "defalias" "defvar" "defcustom" "defface" "deftheme"
|
(or "defun" "defmacro" "defsubst" "defgeneric" "defalias"
|
||||||
"cl-defun" "cl-defmacro" "cl-defsubst" "cl-defmethod" "cl-defstruct" "cl-defgeneric" "cl-deftype")
|
"defvar" "defcustom" "defface" "deftheme"
|
||||||
|
"cl-defun" "cl-defmacro" "cl-defsubst" "cl-defmethod"
|
||||||
|
"cl-defstruct" "cl-defgeneric" "cl-deftype")
|
||||||
(+ (any ?\s ?\t))
|
(+ (any ?\s ?\t))
|
||||||
(group (+ (any "A-Z" "a-z" "0-9"
|
(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*"))
|
(let ((buf (get-buffer-create "*Confpkg Load Time Report*"))
|
||||||
(depth 0)
|
(depth 0)
|
||||||
num-pad name-pad max-time max-total-time max-depth)
|
num-pad name-pad max-time max-total-time max-depth)
|
||||||
(cl-labels
|
(when (zerop (buffer-size buf))
|
||||||
((sort-records-by-time
|
(cl-labels
|
||||||
(record)
|
((sort-records-by-time
|
||||||
(let ((self (assoc 'self record)))
|
(record)
|
||||||
(append (list self)
|
(let ((self (assoc 'self record)))
|
||||||
(sort (nreverse (remove self (cdr record)))
|
(append (list self)
|
||||||
(lambda (a b)
|
(sort (nreverse (remove self (cdr record)))
|
||||||
(> (or (plist-get (alist-get 'self a) :total) 0.0)
|
(lambda (a b)
|
||||||
(or (plist-get (alist-get 'self b) :total) 0.0)))))))
|
(> (or (plist-get (alist-get 'self a) :total) 0.0)
|
||||||
(print-record
|
(or (plist-get (alist-get 'self b) :total) 0.0)))))))
|
||||||
(record)
|
(print-record
|
||||||
(cond
|
(record)
|
||||||
((eq (car record) 'self)
|
(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
|
(insert
|
||||||
(propertize
|
(propertize
|
||||||
(string-pad (number-to-string (plist-get (cdr record) :num)) num-pad)
|
(concat (string-pad "#" num-pad) " "
|
||||||
'face 'font-lock-keyword-face)
|
(string-pad "Confpkg"
|
||||||
" "
|
(+ name-pad (* 2 max-depth) -3))
|
||||||
(propertize
|
(format " Load Time (Σ=%.3fs)\n"
|
||||||
(apply #'concat
|
(plist-get (cdr (assoc 'self tree)) :total)))
|
||||||
(make-list (1- depth) "• "))
|
'face '(:inherit (tab-bar-tab bold) :extend t :underline t)))
|
||||||
'face 'font-lock-comment-face)
|
(dolist (record (if sort-p
|
||||||
(string-pad (format "%s" (plist-get (cdr record) :name)) name-pad)
|
(sort-records-by-time tree)
|
||||||
(make-string (* (- max-depth depth) 2) ?\s)
|
(reverse (cdr tree))))
|
||||||
(propertize
|
(unless (eq (car record) 'self)
|
||||||
(format "%.4fs" (plist-get (cdr record) :elapsed))
|
(print-record record)))
|
||||||
'face
|
(set-buffer-modified-p nil)
|
||||||
(list :foreground
|
(setq buffer-read-only t)
|
||||||
(doom-blend 'orange 'green
|
(goto-char (point-min))))))
|
||||||
(/ (plist-get (cdr record) :elapsed) max-time))))
|
(pop-to-buffer buf)))
|
||||||
(if (= (plist-get (cdr record) :elapsed)
|
|
||||||
(plist-get (cdr record) :total))
|
(set-popup-rule! "^\\*Confpkg Load Time Report\\*$"
|
||||||
""
|
:side 'right :size 0.5 :ttl t)
|
||||||
(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)))))
|
|
||||||
#+end_src
|
#+end_src
|
||||||
|
|
||||||
** Source Code Patching
|
** Source Code Patching
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue