Update all my elpa files
This commit is contained in:
Mateus Pinto Rodrigues
224
elpa/slime-20180413.1720/contrib/slime-sprof.el
Normal file
224
elpa/slime-20180413.1720/contrib/slime-sprof.el
Normal file
@@ -0,0 +1,224 @@
|
||||
(require 'slime)
|
||||
(require 'cl-lib)
|
||||
(eval-when-compile (require 'cl)) ; lexical-let*
|
||||
|
||||
(define-slime-contrib slime-sprof
|
||||
"Integration with SBCL's sb-sprof."
|
||||
(:authors "Juho Snellman"
|
||||
"Stas Boukarev")
|
||||
(:license "MIT")
|
||||
(:swank-dependencies swank-sprof)
|
||||
(:on-load
|
||||
(let ((C '(and (slime-connected-p)
|
||||
(equal (slime-lisp-implementation-type) "SBCL"))))
|
||||
(setf (cdr (last (assoc "Profiling" slime-easy-menu)))
|
||||
`("--"
|
||||
[ "Start sb-sprof" slime-sprof-start ,C ]
|
||||
[ "Stop sb-sprof" slime-sprof-stop ,C ]
|
||||
[ "Report sb-sprof" slime-sprof-report ,C ])))))
|
||||
|
||||
(defvar slime-sprof-exclude-swank nil
|
||||
"*Display swank functions in the report.")
|
||||
|
||||
(define-derived-mode slime-sprof-browser-mode fundamental-mode
|
||||
"slprof"
|
||||
"Mode for browsing profiler data\
|
||||
\\<slime-sprof-browser-mode-map>\
|
||||
\\{slime-sprof-browser-mode-map}"
|
||||
:syntax-table lisp-mode-syntax-table
|
||||
(setq buffer-read-only t))
|
||||
|
||||
(set-keymap-parent slime-sprof-browser-mode-map slime-parent-map)
|
||||
|
||||
(slime-define-keys slime-sprof-browser-mode-map
|
||||
("h" 'describe-mode)
|
||||
("d" 'slime-sprof-browser-disassemble-function)
|
||||
("g" 'slime-sprof-browser-go-to)
|
||||
("v" 'slime-sprof-browser-view-source)
|
||||
("s" 'slime-sprof-toggle-swank-exclusion)
|
||||
((kbd "RET") 'slime-sprof-browser-toggle))
|
||||
|
||||
;; Start / stop profiling
|
||||
|
||||
(cl-defun slime-sprof-start (&optional (mode :cpu))
|
||||
(interactive)
|
||||
(slime-eval `(swank:swank-sprof-start :mode ,mode)))
|
||||
|
||||
(defun slime-sprof-start-alloc ()
|
||||
(interactive)
|
||||
(slime-sprof-start :alloc))
|
||||
|
||||
(defun slime-sprof-start-time ()
|
||||
(interactive)
|
||||
(slime-sprof-start :time))
|
||||
|
||||
(defun slime-sprof-stop ()
|
||||
(interactive)
|
||||
(slime-eval `(swank:swank-sprof-stop)))
|
||||
|
||||
;; Reporting
|
||||
|
||||
(defun slime-sprof-format (graph)
|
||||
(with-current-buffer (slime-buffer-name :sprof)
|
||||
(let ((inhibit-read-only t))
|
||||
(erase-buffer)
|
||||
(insert (format "%4s %-54s %6s %6s %6s\n"
|
||||
"Rank"
|
||||
"Name"
|
||||
"Self%"
|
||||
"Cumul%"
|
||||
"Total%"))
|
||||
(dolist (data graph)
|
||||
(slime-sprof-browser-insert-line data 54))))
|
||||
(forward-line 2))
|
||||
|
||||
(cl-defun slime-sprof-update (&optional (exclude-swank slime-sprof-exclude-swank))
|
||||
(slime-eval-async `(swank:swank-sprof-get-call-graph
|
||||
:exclude-swank ,exclude-swank)
|
||||
'slime-sprof-format))
|
||||
|
||||
(defalias 'slime-sprof-browser 'slime-sprof-report)
|
||||
|
||||
(defun slime-sprof-report ()
|
||||
(interactive)
|
||||
(slime-with-popup-buffer ((slime-buffer-name :sprof)
|
||||
:connection t
|
||||
:select t
|
||||
:mode 'slime-sprof-browser-mode)
|
||||
(slime-sprof-update)))
|
||||
|
||||
(defun slime-sprof-toggle-swank-exclusion ()
|
||||
(interactive)
|
||||
(setq slime-sprof-exclude-swank
|
||||
(not slime-sprof-exclude-swank))
|
||||
(slime-sprof-update))
|
||||
|
||||
(defun slime-sprof-browser-insert-line (data name-length)
|
||||
(cl-destructuring-bind (index name self cumul total)
|
||||
data
|
||||
(if index
|
||||
(insert (format "%-4d " index))
|
||||
(insert " "))
|
||||
(slime-insert-propertized
|
||||
(slime-sprof-browser-name-properties)
|
||||
(format (format "%%-%ds " name-length)
|
||||
(slime-sprof-abbreviate-name name name-length)))
|
||||
(insert (format "%6.2f " self))
|
||||
(when cumul
|
||||
(insert (format "%6.2f " cumul))
|
||||
(when total
|
||||
(insert (format "%6.2f" total))))
|
||||
(when index
|
||||
(slime-sprof-browser-add-line-text-properties
|
||||
`(profile-index ,index expanded nil)))
|
||||
(insert "\n")))
|
||||
|
||||
(defun slime-sprof-abbreviate-name (name max-length)
|
||||
(cl-subseq name 0 (min (length name) max-length)))
|
||||
|
||||
;; Expanding / collapsing
|
||||
|
||||
(defun slime-sprof-browser-toggle ()
|
||||
(interactive)
|
||||
(let ((index (get-text-property (point) 'profile-index)))
|
||||
(when index
|
||||
(save-excursion
|
||||
(if (slime-sprof-browser-line-expanded-p)
|
||||
(slime-sprof-browser-collapse)
|
||||
(slime-sprof-browser-expand))))))
|
||||
|
||||
(defun slime-sprof-browser-collapse ()
|
||||
(let ((inhibit-read-only t))
|
||||
(slime-sprof-browser-add-line-text-properties '(expanded nil))
|
||||
(forward-line)
|
||||
(cl-loop until (or (eobp)
|
||||
(get-text-property (point) 'profile-index))
|
||||
do
|
||||
(delete-region (point-at-bol) (point-at-eol))
|
||||
(unless (eobp)
|
||||
(delete-char 1)))))
|
||||
|
||||
(defun slime-sprof-browser-expand ()
|
||||
(lexical-let* ((buffer (current-buffer))
|
||||
(point (point))
|
||||
(index (get-text-property point 'profile-index)))
|
||||
(slime-eval-async `(swank:swank-sprof-expand-node ,index)
|
||||
(lambda (data)
|
||||
(with-current-buffer buffer
|
||||
(save-excursion
|
||||
(destructuring-bind (&key callers calls)
|
||||
data
|
||||
(slime-sprof-browser-add-expansion callers
|
||||
"Callers"
|
||||
0)
|
||||
(slime-sprof-browser-add-expansion calls
|
||||
"Calls"
|
||||
0))))))))
|
||||
|
||||
(defun slime-sprof-browser-add-expansion (data type nesting)
|
||||
(when data
|
||||
(let ((inhibit-read-only t))
|
||||
(slime-sprof-browser-add-line-text-properties '(expanded t))
|
||||
(end-of-line)
|
||||
(insert (format "\n %s" type))
|
||||
(dolist (node data)
|
||||
(cl-destructuring-bind (index name cumul) node
|
||||
(insert (format (format "\n%%%ds" (+ 7 (* 2 nesting))) ""))
|
||||
(slime-insert-propertized
|
||||
(slime-sprof-browser-name-properties)
|
||||
(let ((len (- 59 (* 2 nesting))))
|
||||
(format (format "%%-%ds " len)
|
||||
(slime-sprof-abbreviate-name name len))))
|
||||
(slime-sprof-browser-add-line-text-properties
|
||||
`(profile-sub-index ,index))
|
||||
(insert (format "%6.2f" cumul)))))))
|
||||
|
||||
(defun slime-sprof-browser-line-expanded-p ()
|
||||
(get-text-property (point) 'expanded))
|
||||
|
||||
(defun slime-sprof-browser-add-line-text-properties (properties)
|
||||
(add-text-properties (point-at-bol)
|
||||
(point-at-eol)
|
||||
properties))
|
||||
|
||||
(defun slime-sprof-browser-name-properties ()
|
||||
'(face sldb-restart-number-face))
|
||||
|
||||
;; "Go to function"
|
||||
|
||||
(defun slime-sprof-browser-go-to ()
|
||||
(interactive)
|
||||
(let ((sub-index (get-text-property (point) 'profile-sub-index)))
|
||||
(when sub-index
|
||||
(let ((pos (text-property-any
|
||||
(point-min) (point-max) 'profile-index sub-index)))
|
||||
(when pos (goto-char pos))))))
|
||||
|
||||
;; Disassembly
|
||||
|
||||
(defun slime-sprof-browser-disassemble-function ()
|
||||
(interactive)
|
||||
(let ((index (or (get-text-property (point) 'profile-index)
|
||||
(get-text-property (point) 'profile-sub-index))))
|
||||
(when index
|
||||
(slime-eval-describe `(swank:swank-sprof-disassemble
|
||||
,index)))))
|
||||
|
||||
;; View source
|
||||
|
||||
(defun slime-sprof-browser-view-source ()
|
||||
(interactive)
|
||||
(let ((index (or (get-text-property (point) 'profile-index)
|
||||
(get-text-property (point) 'profile-sub-index))))
|
||||
(when index
|
||||
(slime-eval-async
|
||||
`(swank:swank-sprof-source-location ,index)
|
||||
(lambda (source-location)
|
||||
(slime-dcase source-location
|
||||
((:error message)
|
||||
(message "%s" message)
|
||||
(ding))
|
||||
(t
|
||||
(slime-show-source-location source-location))))))))
|
||||
|
||||
(provide 'slime-sprof)
|
||||
Reference in New Issue
Block a user