sly-fancy-trace.el (3015B)
1 ;; -*- lexical-binding: t; -*- 2 (require 'sly) 3 (require 'sly-parse "lib/sly-parse") 4 5 (define-sly-contrib sly-fancy-trace 6 "Enhanced version of sly-trace capable of tracing local functions, 7 methods, setf functions, and other entities supported by specific 8 slynk:slynk-toggle-trace backends. Invoke via C-u C-t." 9 (:authors "Matthias Koeppe <mkoeppe@mail.math.uni-magdeburg.de>" 10 "Tobias C. Rittweiler <tcr@freebits.de>") 11 (:license "GPL")) 12 13 (defun sly-trace-query (spec) 14 "Ask the user which function to trace; SPEC is the default. 15 The result is a string." 16 (cond ((null spec) 17 (sly-read-from-minibuffer "(Un)trace: ")) 18 ((stringp spec) 19 (sly-read-from-minibuffer "(Un)trace: " spec)) 20 ((symbolp spec) ; `sly-extract-context' can return symbols. 21 (sly-read-from-minibuffer "(Un)trace: " (prin1-to-string spec))) 22 (t 23 (sly-dcase spec 24 ((setf n) 25 (sly-read-from-minibuffer "(Un)trace: " (prin1-to-string spec))) 26 ((:defun n) 27 (sly-read-from-minibuffer "(Un)trace: " (prin1-to-string n))) 28 ((:defgeneric n) 29 (let* ((name (prin1-to-string n)) 30 (answer (sly-read-from-minibuffer "(Un)trace: " name))) 31 (cond ((and (string= name answer) 32 (y-or-n-p (concat "(Un)trace also all " 33 "methods implementing " 34 name "? "))) 35 (prin1-to-string `(:defgeneric ,n))) 36 (t 37 answer)))) 38 ((:defmethod &rest _) 39 (sly-read-from-minibuffer "(Un)trace: " (prin1-to-string spec))) 40 ((:call caller callee) 41 (let* ((callerstr (prin1-to-string caller)) 42 (calleestr (prin1-to-string callee)) 43 (answer (sly-read-from-minibuffer "(Un)trace: " 44 calleestr))) 45 (cond ((and (string= calleestr answer) 46 (y-or-n-p (concat "(Un)trace only when " calleestr 47 " is called by " callerstr "? "))) 48 (prin1-to-string `(:call ,caller ,callee))) 49 (t 50 answer)))) 51 (((:labels :flet) &rest _) 52 (sly-read-from-minibuffer "(Un)trace local function: " 53 (prin1-to-string spec))) 54 (t (error "Don't know how to trace the spec %S" spec)))))) 55 56 (defun sly-toggle-fancy-trace (&optional using-context-p) 57 "Toggle trace." 58 (interactive "P") 59 (let* ((spec (if using-context-p 60 (sly-extract-context) 61 (sly-symbol-at-point))) 62 (spec (sly-trace-query spec))) 63 (sly-message "%s" (sly-eval `(slynk:slynk-toggle-trace ,spec))))) 64 65 ;; override sly-toggle-trace-fdefinition 66 (define-key sly-prefix-map "\C-t" 'sly-toggle-fancy-trace) 67 68 (provide 'sly-fancy-trace)