From heller at common-lisp.net  Sun May 26 08:24:01 2013
From: heller at common-lisp.net (CVS User heller)
Date: Sun, 26 May 2013 01:24:01 -0700 (PDT)
Subject: CVS slime
Message-ID: <20130526082401.C08AB356490@mail.common-lisp.net>

Update of /project/slime/cvsroot/slime
In directory alpha-cl-net:/tmp/cvs-serv429

Modified Files:
	ChangeLog 
Log Message:
Forgot to update ChangeLog.

--- /project/slime/cvsroot/slime/ChangeLog	2013/05/14 15:46:08	1.2401
+++ /project/slime/cvsroot/slime/ChangeLog	2013/05/26 08:24:01	1.2402
@@ -1,3 +1,9 @@
+2013-05-26  Lu?s Oliveira  <loliveira at common-lisp.net>
+
+	* slime-fancy-trace.el: New contrib.
+	* slime-parse.el (slime-trace-query): moved to slime-fancy-trace.
+	* slime-fancy.el: load slime-fancy-trace.
+
 2013-05-14  Martin Simmons  <martin at lispworks.com>
 
 	* swank-lispworks.lisp (lispworks-severity): Fix error when using



From heller at common-lisp.net  Sun May 26 08:20:17 2013
From: heller at common-lisp.net (CVS User heller)
Date: Sun, 26 May 2013 01:20:17 -0700 (PDT)
Subject: CVS slime/contrib
Message-ID: <20130526082017.BB72335668F@mail.common-lisp.net>

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)