CVS slime/contrib
CVS User heller
heller at common-lisp.net
Sun May 26 08:20:17 UTC 2013
Update of /project/slime/cvsroot/slime/contrib
In directory alpha-cl-net:/tmp/cvs-serv31857
Modified Files:
slime-parse.el slime-fancy.el
Added Files:
slime-fancy-trace.el
Log Message:
slime-fancy-trace.el: New contrib.
--- /project/slime/cvsroot/slime/contrib/slime-parse.el 2010/09/18 20:47:29 1.39
+++ /project/slime/cvsroot/slime/contrib/slime-parse.el 2013/05/26 08:20:17 1.40
@@ -124,24 +124,44 @@
(def-slime-test form-up-to-point.1
(buffer-sexpr result-form &optional skip-trailing-test-p)
""
- '(("(char= #\\(*HERE*" ("char=" "#\\(" swank::%cursor-marker%))
- ("(char= #\\( *HERE*" ("char=" "#\\(" "" swank::%cursor-marker%))
- ("(char= #\\) *HERE*" ("char=" "#\\)" "" swank::%cursor-marker%))
- ("(char= #\\*HERE*" ("char=" "#\\" swank::%cursor-marker%) t)
- ("(defun*HERE*" ("defun" swank::%cursor-marker%))
- ("(defun foo*HERE*" ("defun" "foo" swank::%cursor-marker%))
- ("(defun foo (x y)*HERE*" ("defun" "foo" ("x" "y") swank::%cursor-marker%))
- ("(defun foo (x y*HERE*" ("defun" "foo" ("x" "y" swank::%cursor-marker%)))
- ("(apply 'foo*HERE*" ("apply" "'foo" swank::%cursor-marker%))
- ("(apply #'foo*HERE*" ("apply" "#'foo" swank::%cursor-marker%))
- ("(declare ((vector bit *HERE*" ("declare" (("vector" "bit" "" swank::%cursor-marker%))))
- ("(with-open-file (*HERE*" ("with-open-file" ("" swank::%cursor-marker%)))
- ("(((*HERE*" ((("" swank::%cursor-marker%))))
- ("(defun #| foo #| *HERE*" ("defun" "" swank::%cursor-marker%))
- ("(defun #-(and) (bar) f*HERE*" ("defun" "f" swank::%cursor-marker%))
- ("(remove-if #'(lambda (x)*HERE*" ("remove-if" ("lambda" ("x") swank::%cursor-marker%)))
- ("`(remove-if ,(lambda (x)*HERE*" ("remove-if" ("lambda" ("x") swank::%cursor-marker%)))
- ("`(remove-if ,@(lambda (x)*HERE*" ("remove-if" ("lambda" ("x") swank::%cursor-marker%))))
+ '(("(char= #\\(*HERE*"
+ ("char=" "#\\(" swank::%cursor-marker%))
+ ("(char= #\\( *HERE*"
+ ("char=" "#\\(" "" swank::%cursor-marker%))
+ ("(char= #\\) *HERE*"
+ ("char=" "#\\)" "" swank::%cursor-marker%))
+ ("(char= #\\*HERE*"
+ ("char=" "#\\" swank::%cursor-marker%) t)
+ ("(defun*HERE*"
+ ("defun" swank::%cursor-marker%))
+ ("(defun foo*HERE*"
+ ("defun" "foo" swank::%cursor-marker%))
+ ("(defun foo (x y)*HERE*"
+ ("defun" "foo"
+ ("x" "y") swank::%cursor-marker%))
+ ("(defun foo (x y*HERE*"
+ ("defun" "foo"
+ e("x" "y" swank::%cursor-marker%)))
+ ("(apply 'foo*HERE*"
+ ("apply" "'foo" swank::%cursor-marker%))
+ ("(apply #'foo*HERE*"
+ ("apply" "#'foo" swank::%cursor-marker%))
+ ("(declare ((vector bit *HERE*"
+ ("declare" (("vector" "bit" "" swank::%cursor-marker%))))
+ ("(with-open-file (*HERE*"
+ e("with-open-file" ("" swank::%cursor-marker%)))
+ ("(((*HERE*"
+ ((("" swank::%cursor-marker%))))
+ ("(defun #| foo #| *HERE*"
+ ("defun" "" swank::%cursor-marker%))
+ ("(defun #-(and) (bar) f*HERE*"
+ ("defun" "f" swank::%cursor-marker%))
+ ("(remove-if #'(lambda (x)*HERE*"
+ ("remove-if" ("lambda" ("x") swank::%cursor-marker%)))
+ ("`(remove-if ,(lambda (x)*HERE*"
+ ("remove-if" ("lambda" ("x") swank::%cursor-marker%)))
+ ("`(remove-if ,@(lambda (x)*HERE*"
+ ("remove-if" ("lambda" ("x") swank::%cursor-marker%))))
(slime-check-top-level)
(with-temp-buffer
(lisp-mode)
@@ -154,49 +174,6 @@
(slime-check-buffer-form result-form))
))
-(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
- (destructure-case 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-extract-context ()
"Parse the context for the symbol at point.
Nil is returned if there's no symbol at point. Otherwise we detect
--- /project/slime/cvsroot/slime/contrib/slime-fancy.el 2010/05/28 14:15:30 1.13
+++ /project/slime/cvsroot/slime/contrib/slime-fancy.el 2013/05/26 08:20:17 1.14
@@ -9,6 +9,7 @@
slime-c-p-c
slime-editing-commands
slime-fancy-inspector
+ slime-fancy-trace
slime-fuzzy
slime-presentations
slime-scratch
--- /project/slime/cvsroot/slime/contrib/slime-fancy-trace.el 2013/05/26 08:20:17 NONE
+++ /project/slime/cvsroot/slime/contrib/slime-fancy-trace.el 2013/05/26 08:20:17 1.1
(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 at mail.math.uni-magdeburg.de>"
"Tobias C. Rittweiler <tcr at 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
(destructure-case 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)
More information about the slime-cvs
mailing list