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