From sboukarev at common-lisp.net  Mon Nov  2 00:24:52 2009
From: sboukarev at common-lisp.net (CVS User sboukarev)
Date: Sun, 01 Nov 2009 19:24:52 -0500
Subject: [slime-cvs] CVS slime
Message-ID: <E1N4kj6-0004qf-Ix@common-lisp.net>

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

Modified Files:
	ChangeLog swank.lisp 
Log Message:
* swank.lisp (tokenize-symbol-thoroughly): Return NIL
instead of throwing an error.
(parse-symbol): Handle null result of tokenize-symbol-thoroughly.

This fixes a bug reported by Derrell Piper.


--- /project/slime/cvsroot/slime/ChangeLog	2009/10/31 22:41:03	1.1903
+++ /project/slime/cvsroot/slime/ChangeLog	2009/11/02 00:24:52	1.1904
@@ -1,3 +1,11 @@
+2009-11-02  Stas Boukarev  <stassats at gmail.com>
+
+	* swank.lisp (tokenize-symbol-thoroughly): Return NIL
+	instead of throwing an error.
+	(parse-symbol): Handle null result of tokenize-symbol-thoroughly.
+
+	This fixes a bug reported by Derrell Piper.
+
 2009-10-31  Tobias C. Rittweiler <tcr at freebits.de>
 
 	* slime.el (slime-bug): Deleted.
--- /project/slime/cvsroot/slime/swank.lisp	2009/10/31 22:13:55	1.669
+++ /project/slime/cvsroot/slime/swank.lisp	2009/11/02 00:24:52	1.670
@@ -2014,7 +2014,7 @@
              (vector-push-extend char token))
             ((char= char #\:)
              (cond ((and package internp)
-                    (error "More than two colons in ~S" string))
+                    (return-from tokenize-symbol-thoroughly))
                    (package
                     (setq internp t))
                    (t
@@ -2024,9 +2024,8 @@
                                             :fill-pointer 0)))))
             (t
              (vector-push-extend (casify-char char) token))))
-    (when vertical
-      (error "Unclosed vertical bar in ~S" string))
-    (values token package (or (not package) internp))))
+    (unless vertical
+          (values token package (or (not package) internp)))))
 
 (defun untokenize-symbol (package-name internal-p symbol-name)
   "The inverse of TOKENIZE-SYMBOL.
@@ -2061,16 +2060,17 @@
 Return the symbol and a flag indicating whether the symbols was found."
   (multiple-value-bind (sname pname internalp)
       (tokenize-symbol-thoroughly string)
-    (let ((package (cond ((string= pname "") keyword-package)
-                         (pname              (find-package pname))
-                         (t                  package))))
-      (if package
-          (multiple-value-bind (symbol flag)
-              (if internalp
-                  (find-symbol sname package)
-                  (find-symbol-with-status sname ':external package))
-            (values symbol flag sname package))
-          (values nil nil nil nil)))))
+    (when sname
+     (let ((package (cond ((string= pname "") keyword-package)
+                          (pname              (find-package pname))
+                          (t                  package))))
+       (if package
+           (multiple-value-bind (symbol flag)
+               (if internalp
+                   (find-symbol sname package)
+                   (find-symbol-with-status sname ':external package))
+             (values symbol flag sname package))
+           (values nil nil nil nil))))))
 
 (defun parse-symbol-or-lose (string &optional (package *package*))
   (multiple-value-bind (symbol status) (parse-symbol string package)




From heller at common-lisp.net  Mon Nov  2 07:47:02 2009
From: heller at common-lisp.net (CVS User heller)
Date: Mon, 02 Nov 2009 02:47:02 -0500
Subject: [slime-cvs] CVS slime
Message-ID: <E1N4rd0-00010I-Nx@common-lisp.net>

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

Modified Files:
	ChangeLog swank-ccl.lisp 
Log Message:
CCL's lap-functions don't have source-notes but the name often
has.  E.g. ccl::%fixnum-truncate.  Use names as last resort.

* swank-ccl.lisp (function-name-source-note): New function.
(pc-source-location): Use it.

--- /project/slime/cvsroot/slime/ChangeLog	2009/11/02 00:24:52	1.1904
+++ /project/slime/cvsroot/slime/ChangeLog	2009/11/02 07:47:02	1.1905
@@ -1,3 +1,11 @@
+2009-11-02  Helmut Eller  <heller at common-lisp.net>
+
+	CCL's lap-functions don't have source-notes but the name often
+	has.  E.g. ccl::%fixnum-truncate.  Use names as last resort.
+
+	* swank-ccl.lisp (function-name-source-note): New function.
+	(pc-source-location): Use it.
+
 2009-11-02  Stas Boukarev  <stassats at gmail.com>
 
 	* swank.lisp (tokenize-symbol-thoroughly): Return NIL
--- /project/slime/cvsroot/slime/swank-ccl.lisp	2009/10/31 08:22:56	1.10
+++ /project/slime/cvsroot/slime/swank-ccl.lisp	2009/11/02 07:47:02	1.11
@@ -537,7 +537,8 @@
 
 (defun function-source-location (function)
   (source-note-to-source-location
-   (ccl:function-source-note function)
+   (or (ccl:function-source-note function)
+       (function-name-source-note function))
    (lambda ()
      (format nil "Function has no source note: ~A" function))
    (ccl:function-name function)))
@@ -545,11 +546,19 @@
 (defun pc-source-location (function pc)
   (source-note-to-source-location
    (or (ccl:find-source-note-at-pc function pc)
-       (ccl:function-source-note function))
+       (ccl:function-source-note function)
+       (function-name-source-note function))
    (lambda ()
      (format nil "No source note at PC: ~a[~d]" function pc))
    (ccl:function-name function)))
 
+(defun function-name-source-note (fun)
+  (let ((defs (ccl:find-definition-sources (ccl:function-name fun) 'function)))
+    (and defs
+         (destructuring-bind ((type . name) srcloc . srclocs) (car defs)
+           (declare (ignore type name srclocs))
+           srcloc))))
+
 (defun source-note-to-source-location (source if-nil-thunk &optional name)
   (labels ((filename-to-buffer (filename)
              (cond ((gethash filename *temp-file-map*)
@@ -720,14 +729,9 @@
   (queue '() :type list))
 
 (defimplementation spawn (fun &key name)
-  (flet ((entry ()
-           (handler-bind ((ccl:process-reset (lambda (c) 
-                                               (return-from entry c))))
-             (funcall fun))))
-    (ccl:process-run-function 
-     (or name "Anonymous (Swank)")
-     #'entry)))
-  
+  (ccl:process-run-function (or name "Anonymous (Swank)")
+                            fun))
+
 (defimplementation thread-id (thread)
   (ccl:process-serial-number thread))
 




From heller at common-lisp.net  Mon Nov  2 09:20:34 2009
From: heller at common-lisp.net (CVS User heller)
Date: Mon, 02 Nov 2009 04:20:34 -0500
Subject: [slime-cvs] CVS slime
Message-ID: <E1N4t5W-0007UF-Ab@common-lisp.net>

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

Modified Files:
	ChangeLog swank-abcl.lisp swank-allegro.lisp 
	swank-backend.lisp swank-ccl.lisp swank-clisp.lisp 
	swank-cmucl.lisp swank-lispworks.lisp swank-sbcl.lisp 
	swank-scl.lisp swank.lisp 
Log Message:
* swank.lisp (without-interrupts): Removed. No longer used.
* swank-backend.lisp (call-without-interrupts): Removed.
Update backends accoringly.

--- /project/slime/cvsroot/slime/ChangeLog	2009/11/02 07:47:02	1.1905
+++ /project/slime/cvsroot/slime/ChangeLog	2009/11/02 09:20:33	1.1906
@@ -1,5 +1,11 @@
 2009-11-02  Helmut Eller  <heller at common-lisp.net>
 
+	* swank.lisp (without-interrupts): Removed. No longer used.
+	* swank-backend.lisp (call-without-interrupts): Removed.
+	Update backends accoringly.
+
+2009-11-02  Helmut Eller  <heller at common-lisp.net>
+
 	CCL's lap-functions don't have source-notes but the name often
 	has.  E.g. ccl::%fixnum-truncate.  Use names as last resort.
 
--- /project/slime/cvsroot/slime/swank-abcl.lisp	2009/10/31 08:54:46	1.75
+++ /project/slime/cvsroot/slime/swank-abcl.lisp	2009/11/02 09:20:33	1.76
@@ -183,9 +183,6 @@
 
 ;;;; Unix signals
 
-(defimplementation call-without-interrupts (fn)
-  (funcall fn))
-
 (defimplementation getpid ()
   (handler-case 
       (let* ((runtime 
--- /project/slime/cvsroot/slime/swank-allegro.lisp	2009/06/21 07:22:56	1.128
+++ /project/slime/cvsroot/slime/swank-allegro.lisp	2009/11/02 09:20:33	1.129
@@ -71,9 +71,6 @@
 
 ;;;; Unix signals
 
-(defimplementation call-without-interrupts (fn)
-  (excl:without-interrupts (funcall fn)))
-
 (defimplementation getpid ()
   (excl::getpid))
 
--- /project/slime/cvsroot/slime/swank-backend.lisp	2009/10/31 08:54:46	1.183
+++ /project/slime/cvsroot/slime/swank-backend.lisp	2009/11/02 09:20:33	1.184
@@ -308,10 +308,6 @@
 
 (defconstant +sigint+ 2)
 
-(definterface call-without-interrupts (fn)
-  "Call FN in a context where interrupts are disabled."
-  (funcall fn))
-
 (definterface getpid ()
   "Return the (Unix) process ID of this superior Lisp.")
 
--- /project/slime/cvsroot/slime/swank-ccl.lisp	2009/11/02 07:47:02	1.11
+++ /project/slime/cvsroot/slime/swank-ccl.lisp	2009/11/02 09:20:33	1.12
@@ -155,12 +155,6 @@
 
 ;;; Unix signals
 
-(defimplementation call-without-interrupts (fn)
-  ;; This prevents the current thread from being interrupted, but it doesn't
-  ;; keep other threads from running concurrently, so it's not an appropriate
-  ;; replacement for locking.
-  (ccl:without-interrupts (funcall fn)))
-
 (defimplementation getpid ()
   (ccl::getpid))
 
--- /project/slime/cvsroot/slime/swank-clisp.lisp	2009/07/30 17:05:19	1.91
+++ /project/slime/cvsroot/slime/swank-clisp.lisp	2009/11/02 09:20:33	1.92
@@ -65,28 +65,6 @@
   (:documentation
    "Dummy class created so that swank.lisp will compile and load."))
 
-;; #+#.(cl:if (cl:find-package "LINUX") '(and) '(or))
-;; (progn
-;;   (defmacro with-blocked-signals ((&rest signals) &body body)
-;;     (ext:with-gensyms ("SIGPROCMASK" ret mask)
-;;       `(multiple-value-bind (,ret ,mask)
-;;            (linux:sigprocmask-set-n-save
-;;             ,linux:SIG_BLOCK
-;;             ,(do ((sigset (linux:sigset-empty)
-;;                           (linux:sigset-add sigset (the fixnum (pop signals)))))
-;;                  ((null signals) sigset)))
-;;          (linux:check-res ,ret 'linux:sigprocmask-set-n-save)
-;;          (unwind-protect
-;;               (progn , at body)
-;;            (linux:sigprocmask-set ,linux:SIG_SETMASK ,mask nil)))))
-
-;;   (defimplementation call-without-interrupts (fn)
-;;     (with-blocked-signals (#.linux:SIGINT) (funcall fn))))
-
-;; #+#.(cl:if (cl:find-package "LINUX") '(or) '(and))
-(defimplementation call-without-interrupts (fn)
-  (funcall fn))
-
 (let ((getpid (or (find-symbol "PROCESS-ID" :system)
                   ;; old name prior to 2005-03-01, clisp <= 2.33.2
                   (find-symbol "PROGRAM-ID" :system)
--- /project/slime/cvsroot/slime/swank-cmucl.lisp	2009/08/10 19:30:22	1.213
+++ /project/slime/cvsroot/slime/swank-cmucl.lisp	2009/11/02 09:20:33	1.214
@@ -1478,9 +1478,6 @@
 (defimplementation default-directory ()
   (namestring (ext:default-directory)))
 
-(defimplementation call-without-interrupts (fn)
-  (sys:without-interrupts (funcall fn)))
-
 (defimplementation getpid ()
   (unix:unix-getpid))
 
--- /project/slime/cvsroot/slime/swank-lispworks.lisp	2009/10/20 16:13:02	1.134
+++ /project/slime/cvsroot/slime/swank-lispworks.lisp	2009/11/02 09:20:34	1.135
@@ -169,9 +169,6 @@
                                (declare (ignore args))
                                (mp:process-interrupt self handler)))))
 
-(defimplementation call-without-interrupts (fn)
-  (error "Don't use without-interrupts -- consider without-slime-interrupts instead."))
-  
 (defimplementation getpid ()
   #+win32 (win32:get-current-process-id)
   #-win32 (system::getpid))
--- /project/slime/cvsroot/slime/swank-sbcl.lisp	2009/10/19 23:23:45	1.253
+++ /project/slime/cvsroot/slime/swank-sbcl.lisp	2009/11/02 09:20:34	1.254
@@ -282,11 +282,6 @@
             (return (sb-bsd-sockets:socket-accept socket))
           (sb-bsd-sockets:interrupted-error ()))))
 
-(defimplementation call-without-interrupts (fn)
-  (declare (type function fn))
-  (sb-sys:without-interrupts (funcall fn)))
-
-
 
 ;;;; Support for SBCL syntax
 
--- /project/slime/cvsroot/slime/swank-scl.lisp	2009/08/10 19:30:22	1.34
+++ /project/slime/cvsroot/slime/swank-scl.lisp	2009/11/02 09:20:34	1.35
@@ -1315,9 +1315,6 @@
 (defimplementation pathname-to-filename (pathname)
   (ext:unix-namestring pathname nil))
 
-(defimplementation call-without-interrupts (fn)
-  (funcall fn))
-
 (defimplementation getpid ()
   (unix:unix-getpid))
 
--- /project/slime/cvsroot/slime/swank.lisp	2009/11/02 00:24:52	1.670
+++ /project/slime/cvsroot/slime/swank.lisp	2009/11/02 09:20:34	1.671
@@ -457,11 +457,6 @@
   (check-type msg string)
   `(call-with-retry-restart ,msg #'(lambda () , at body)))
 
-;;; FIXME: Can this be removed with the introduction of
-;;;        WITH/WITHOUT-SLIME-INTERRUPTS.
-(defmacro without-interrupts (&body body)
-  `(call-without-interrupts (lambda () , at body)))
-
 (defmacro destructure-case (value &rest patterns)
   "Dispatch VALUE to one of PATTERNS.
 A cross between `case' and `destructuring-bind'.




From sboukarev at common-lisp.net  Mon Nov  2 12:02:27 2009
From: sboukarev at common-lisp.net (CVS User sboukarev)
Date: Mon, 02 Nov 2009 07:02:27 -0500
Subject: [slime-cvs] CVS slime/contrib
Message-ID: <E1N4vcB-0002Qs-Am@common-lisp.net>

Update of /project/slime/cvsroot/slime/contrib
In directory cl-net:/tmp/cvs-serv9351/contrib

Modified Files:
	ChangeLog slime-parse.el 
Log Message:
* contrib/slime-parse.el (slime-incomplete-form-at-point): Concatenate " )"
not just ")", because the form's last char may be \, and the parenthesis
will be escaped.
That fixes a bug reported by Ariel Badichi.


--- /project/slime/cvsroot/slime/contrib/ChangeLog	2009/10/31 22:41:04	1.267
+++ /project/slime/cvsroot/slime/contrib/ChangeLog	2009/11/02 12:02:27	1.268
@@ -1,3 +1,10 @@
+2009-11-02  Stas Boukarev  <stassats at gmail.com>
+
+	* slime-parse.el (slime-incomplete-form-at-point): Concatenate " )"
+	not just ")", because the form's last char may be \, and the parenthesis
+	will be escaped.
+	That fixes a bug reported by Ariel Badichi.
+
 2009-10-31  Tobias C. Rittweiler  <tcr at freebits.de>
 
 	* slime-fontifying-fu.el (slime-search-suppressed-forms-internal):
--- /project/slime/cvsroot/slime/contrib/slime-parse.el	2009/10/31 22:13:55	1.25
+++ /project/slime/cvsroot/slime/contrib/slime-parse.el	2009/11/02 12:02:27	1.26
@@ -9,7 +9,7 @@
 
 (defun slime-incomplete-form-at-point ()
   (slime-make-form-spec-from-string 
-   (concat (slime-incomplete-sexp-at-point) ")")))
+   (concat (slime-incomplete-sexp-at-point) " )")))
 
 (defun slime-parse-sexp-at-point (&optional n skip-blanks-p)
   "Returns the sexps at point as a list of strings, otherwise nil.




From trittweiler at common-lisp.net  Mon Nov  2 16:17:48 2009
From: trittweiler at common-lisp.net (CVS User trittweiler)
Date: Mon, 02 Nov 2009 11:17:48 -0500
Subject: [slime-cvs] CVS slime
Message-ID: <E1N4zbI-00064w-IS@common-lisp.net>

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

Modified Files:
	ChangeLog slime.el 
Log Message:
	* slime.el (slime-end-of-symbol): Make sure not to move on #'foo.
		([test] sexp-at-point.1): New test case.


--- /project/slime/cvsroot/slime/ChangeLog	2009/11/02 09:20:33	1.1906
+++ /project/slime/cvsroot/slime/ChangeLog	2009/11/02 16:17:48	1.1907
@@ -1,3 +1,8 @@
+2009-11-02  Tobias C. Rittweiler <tcr at freebits.de>
+
+	* slime.el (slime-end-of-symbol): Make sure not to move on #'foo.
+	([test] sexp-at-point.1): New test case.
+
 2009-11-02  Helmut Eller  <heller at common-lisp.net>
 
 	* swank.lisp (without-interrupts): Removed. No longer used.
--- /project/slime/cvsroot/slime/slime.el	2009/10/31 22:41:03	1.1245
+++ /project/slime/cvsroot/slime/slime.el	2009/11/02 16:17:48	1.1246
@@ -7470,10 +7470,26 @@
   slime-test-symbols
   (slime-check-symbol-at-point "#+" sym ""))
 
-(def-slime-test symbol-at-point.17 (sym)
-  "symbol-at-point after #-"
-  slime-test-symbols
-  (slime-check-symbol-at-point "#-" sym ""))
+
+(def-slime-test sexp-at-point.1 (string)
+  "symbol-at-point after #'"
+  '(("foo")
+    ("#:foo")
+    ("#'foo")
+    ("#'(lambda (x) x)")
+    ("#\\space")
+    ("#\\(")
+    ("#\\)"))
+  (with-temp-buffer
+    (lisp-mode)
+    (insert string)
+    (goto-char (point-min))
+    (slime-test-expect (format "Check sexp `%s' (at %d)..."
+                               (buffer-string) (point))
+                       string
+                       (slime-sexp-at-point)
+                       #'equal)))
+
 
 (def-slime-test narrowing ()
     "Check that narrowing is properly sustained."
@@ -8363,7 +8379,7 @@
 
 (defun slime-end-of-symbol ()
   "Move to the end of the CL-style symbol at point."
-  (re-search-forward "\\=\\(\\sw\\|\\s_\\|\\s\\.\\|[#@|]\\)*"))
+  (re-search-forward "\\=\\(\\sw\\|\\s_\\|\\s\\.\\|#:\\|[@|]\\)*"))
 
 (put 'slime-symbol 'end-op 'slime-end-of-symbol)
 (put 'slime-symbol 'beginning-op 'slime-beginning-of-symbol)




From trittweiler at common-lisp.net  Mon Nov  2 16:24:45 2009
From: trittweiler at common-lisp.net (CVS User trittweiler)
Date: Mon, 02 Nov 2009 11:24:45 -0500
Subject: [slime-cvs] CVS slime/contrib
Message-ID: <E1N4zi1-0006nR-C1@common-lisp.net>

Update of /project/slime/cvsroot/slime/contrib
In directory cl-net:/tmp/cvs-serv26074

Modified Files:
	ChangeLog slime-parse.el 
Log Message:
	* slime-parse.el (slime-make-form-spec-from-string): Break out of
	the loop if we're at unbalanced parentheses.
	(slime-compare-character-syntax): New helper.
	(slime-parse-form-upto-point): Use it.
	(slime-incomplete-form-at-point): Revert change.
	([test] form-upto-point.1): New test case.


--- /project/slime/cvsroot/slime/contrib/ChangeLog	2009/11/02 12:02:27	1.268
+++ /project/slime/cvsroot/slime/contrib/ChangeLog	2009/11/02 16:24:45	1.269
@@ -1,3 +1,12 @@
+2009-11-02  Tobias C. Rittweiler  <tcr at freebits.de>
+
+	* slime-parse.el (slime-make-form-spec-from-string): Break out of
+	the loop if we're at unbalanced parentheses.
+	(slime-compare-character-syntax): New helper.
+	(slime-parse-form-upto-point): Use it.
+	(slime-incomplete-form-at-point): Revert change.
+	([test] form-upto-point.1): New test case.
+
 2009-11-02  Stas Boukarev  <stassats at gmail.com>
 
 	* slime-parse.el (slime-incomplete-form-at-point): Concatenate " )"
--- /project/slime/cvsroot/slime/contrib/slime-parse.el	2009/11/02 12:02:27	1.26
+++ /project/slime/cvsroot/slime/contrib/slime-parse.el	2009/11/02 16:24:45	1.27
@@ -8,8 +8,8 @@
 ;;
 
 (defun slime-incomplete-form-at-point ()
-  (slime-make-form-spec-from-string 
-   (concat (slime-incomplete-sexp-at-point) " )")))
+  (slime-make-form-spec-from-string
+   (concat (slime-incomplete-sexp-at-point) ")")))
 
 (defun slime-parse-sexp-at-point (&optional n skip-blanks-p)
   "Returns the sexps at point as a list of strings, otherwise nil.
@@ -39,8 +39,9 @@
 
 (defun slime-incomplete-sexp-at-point (&optional n)
   (interactive "p") (or n (setq n 1))
-  (buffer-substring-no-properties (save-excursion (backward-up-list n) (point))
-                                  (point)))
+  (buffer-substring-no-properties 
+   (save-excursion (backward-up-list n) (point))
+   (point)))
 
 
 (defun slime-parse-extended-operator-name (user-point forms indices points)
@@ -191,54 +192,9 @@
           0))))
 
 (defun slime-make-form-spec-from-string (string &optional strip-operator-p)
-  "If STRIP-OPERATOR-P is T and STRING is the string
-representation of a form, the string representation of this form
-is stripped from the form. This can be important to avoid mutual
-recursion between this function, `slime-enclosing-form-specs' and
-`slime-parse-extended-operator-name'.
+  "Example: \"(foo (bar 1 (baz :quux)) 'toto)\" 
 
-Examples:
-
-  \"(foo (bar 1 (baz :quux)) 'toto)\" 
-
-      => (\"foo\" (\"bar\" \"1\" (\"baz\" \":quux\")) \"'toto\")
-"
-  (cond ((slime-length= string 0) "")                    ; ""
-	((equal string "()") '())                        ; "()"
-	((eql (char-syntax (aref string 0)) ?\') string) ; "'(foo)", "#(foo)" &c
-	((not (eql (aref string 0) ?\()) string)         ; "foo"
-	(t                                               ; "(op arg1 arg2 ...)"
-	 (with-temp-buffer
-	   ;; Do NEVER ever try to activate `lisp-mode' here with
-	   ;; `slime-use-autodoc-mode' enabled, as this function is used
-	   ;; to compute the current autodoc itself.
-           (set-syntax-table lisp-mode-syntax-table)
-	   (erase-buffer)
-	   (insert string)
-	   (when strip-operator-p ; `(OP arg1 arg2 ...)' ==> `(arg1 arg2 ...)'
-	     (goto-char (point-min))
-	     (when (string= (thing-at-point 'char) "(")
-	       (ignore-errors (forward-char 1)
-			      (forward-sexp)
-			      (slime-forward-blanks))
-	       (delete-region (point-min) (point))
-	       (insert "(")))
-	   (goto-char (1- (point-max))) ; `(OP arg1 ... argN|)'
-	   (assert (eql (char-after) ?\)))
-	   (multiple-value-bind (forms indices points)
-	       (slime-enclosing-form-specs 1)
-	     (if (null forms)
-		 string
-                (let ((n (first (last indices))))
-		  (goto-char (1+ (point-min))) ; `(|OP arg1 ... argN)'
-		  (let ((subsexps (slime-parse-sexp-at-point (1+ n) t)))
-		    (mapcar #'(lambda (s)
-				(assert (not (equal s string)))       ; trap against
-				(slime-make-form-spec-from-string s)) ;  endless recursion.
-			    subsexps
-			    )))))))))
-
-(defun slime-make-form-spec-from-string (string &optional strip-operator-p)
+            => (\"foo\" (\"bar\" \"1\" (\"baz\" \":quux\")) \"'toto\")"
   (cond ((slime-length= string 0) "")                    ; ""
 	((equal string "()") '())                        ; "()"
 	((eql (char-syntax (aref string 0)) ?\') string) ; "'(foo)", "#(foo)" &c
@@ -253,7 +209,12 @@
 	   (insert string)
 	   (goto-char (1+ (point-min)))
 	   (let ((subsexps))
-	     (while (ignore-errors (slime-forward-sexp) t)
+	     (while (condition-case nil 
+			(slime-point-moves-p (slime-forward-sexp))
+		      (scan-error nil)	; can't move any further
+		      (error t))        ; unknown feature expression etc.
+	       ;; We first move back for (FOO)'BAR where point is at
+	       ;; the quote character.
 	       (backward-sexp)
 	       (push (slime-sexp-at-point) subsexps)
 	       (forward-sexp))
@@ -364,48 +325,61 @@
      (nreverse arg-indices)
      (nreverse points))))
 
+(defun slime-compare-char-syntax (get-char-fn syntax &optional unescaped)
+  "Returns t if the character that `get-char-fn' yields has
+characer syntax of `syntax'. If `unescaped' is true, it's ensured
+that the character is not escaped."
+  (let ((char        (funcall get-char-fn (point)))
+	(char-before (funcall get-char-fn (1- (point)))))
+    (if (and char (eq (char-syntax char) (coerce syntax 'character)))
+	(if unescaped
+	    (or (null char-before)
+		(not (eq (char-syntax char-before) ?\\)))
+	    t)
+        nil)))
+
+(defconst slime-cursor-marker 'swank::%cursor-marker%)
+
 (defun slime-parse-form-upto-point (&optional max-levels)
   ;; We assert this, because `slime-incomplete-form-at-point' blows up
   ;; inside a comment.
   (assert (not (slime-inside-string-or-comment-p)))
   (save-excursion
-    (let ((char-after  (char-after))
-          (char-before (char-before))
-          (marker-suffix (list 'swank::%cursor-marker%)))
-      (cond ((and char-after (eq (char-syntax char-after) ?\())
-             ;; We're at the start of some expression, so make sure
-             ;; that SWANK::%CURSOR-MARKER% will come after that
-             ;; expression.
-             (ignore-errors (forward-sexp)))
-            ((and char-before (eq (char-syntax char-before) ?\ ))
-             ;; We're after some expression, so we have to make sure
-             ;; that %CURSOR-MARKER% does not come directly after that
-             ;; expression.
-             (push "" marker-suffix))
-            ((and char-before (eq (char-syntax char-before) ?\())
-             ;; We're directly after an opening parenthesis, so we
-             ;; have to make sure that something comes before
-             ;; %CURSOR-MARKER%..
-             (push "" marker-suffix))
-            (t
-             ;; We're at a symbol, so make sure we get the whole symbol.
-             (slime-end-of-symbol)))
+    (let ((suffix (list slime-cursor-marker)))
+      (cond ((slime-compare-char-syntax #'char-after "(" t)
+	     ;; We're at the start of some expression, so make sure
+	     ;; that SWANK::%CURSOR-MARKER% will come after that
+	     ;; expression.
+	     (ignore-errors (forward-sexp)))
+	    ((slime-compare-char-syntax #'char-before " " t)
+	     ;; We're after some expression, so we have to make sure
+	     ;; that %CURSOR-MARKER% does not come directly after that
+	     ;; expression.
+	     (push "" suffix))
+	    ((slime-compare-char-syntax #'char-before "(" t)
+	     ;; We're directly after an opening parenthesis, so we
+	     ;; have to make sure that something comes before
+	     ;; %CURSOR-MARKER%..
+	     (push "" suffix))
+	    (t
+	     ;; We're at a symbol, so make sure we get the whole symbol.
+	     (slime-end-of-symbol)))
       (let ((forms '())
-            (levels (or max-levels 5)))
-        (condition-case nil
-            (let ((form (slime-incomplete-form-at-point)))
-              (setq forms (list (nconc form marker-suffix)))
-              (up-list -1)
-              (dotimes (i (1- levels))
-                (push (slime-incomplete-form-at-point) forms)
-                (up-list -1)))
-          ;; At head of toplevel form.
-          (scan-error nil))
-        (when forms
-          ;; Squeeze list of forms into tree structure again
-          (reduce #'(lambda (form tree)
-                      (nconc form (list tree)))
-                  forms :from-end t))))))
+	    (levels (or max-levels 5)))
+	(condition-case nil
+	    (let ((form (slime-incomplete-form-at-point)))
+	      (setq forms (list (nconc form suffix)))
+	      (up-list -1)
+	      (dotimes (i (1- levels))
+		(push (slime-incomplete-form-at-point) forms)
+		(up-list -1)))
+	  ;; At head of toplevel form.
+	  (scan-error nil))
+	(when forms
+	  ;; Squeeze list of forms into tree structure again
+	  (reduce #'(lambda (form tree)
+		      (nconc form (list tree)))
+		  forms :from-end t))))))
 
 
 (defun slime-ensure-list (thing)
@@ -461,7 +435,38 @@
     (slime-check-enclosing-form-specs wished-form-specs)      
     ))
 
-
+(defun slime-check-buffer-form (result-form)
+  (slime-test-expect 
+   (format "Buffer form correct in `%s' (at %d)" (buffer-string) (point))
+   result-form
+   (slime-parse-form-upto-point 10)))
+
+(def-slime-test form-up-to-point.1
+    (buffer-sexpr result-form)
+    ""
+    '(("(char= #\\(*HERE*"            ("char=" "#\\(" swank::%cursor-marker%))
+      ("(char= #\\( *HERE*"           ("char=" "#\\(" "" swank::%cursor-marker%))
+      ("(char= #\\) *HERE*"           ("char=" "#\\)" "" swank::%cursor-marker%))
+                                      ;; The #\) here is an accident of 
+                                      ;; the implementation.
+      ("(char= #\\*HERE*"             ("char=" "#\\)" swank::%cursor-marker%))
+      ("(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%)))))
+  (slime-check-top-level)
+  (with-temp-buffer
+    (lisp-mode)
+    (insert buffer-sexpr)
+    (search-backward "*HERE*")
+    (delete-region (match-beginning 0) (match-end 0))
+    (slime-check-buffer-form result-form)
+    (insert ")") (backward-char)
+    (slime-check-buffer-form result-form)      
+    ))
 
 (provide 'slime-parse)
 




From sboukarev at common-lisp.net  Tue Nov  3 14:33:32 2009
From: sboukarev at common-lisp.net (CVS User sboukarev)
Date: Tue, 03 Nov 2009 09:33:32 -0500
Subject: [slime-cvs] CVS slime
Message-ID: <E1N5KRw-0001P8-4a@common-lisp.net>

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

Modified Files:
	ChangeLog slime.el swank.lisp 
Log Message:
* slime.el (sldb-backward-frame): If the point is at the end of the buffer,
there is no property, handle this case.

* swank.lisp (collect-notes): LOAD returns generalized boolean,
not just boolean, but make-compilation-result accepts only booleans
for its second argument.

Both bugs reported by Derrell Piper.


--- /project/slime/cvsroot/slime/ChangeLog	2009/11/02 16:17:48	1.1907
+++ /project/slime/cvsroot/slime/ChangeLog	2009/11/03 14:33:31	1.1908
@@ -1,3 +1,14 @@
+2009-11-03  Stas Boukarev  <stassats at gmail.com>
+
+	* slime.el (sldb-backward-frame): If the point is at the end of the buffer,
+	there is no property, handle this case.
+
+	* swank.lisp (collect-notes): LOAD returns generalized boolean,
+	not just boolean, but make-compilation-result accepts only booleans
+	for its second argument.
+	
+	Both bugs reported by Derrell Piper.
+
 2009-11-02  Tobias C. Rittweiler <tcr at freebits.de>
 
 	* slime.el (slime-end-of-symbol): Make sure not to move on #'foo.
--- /project/slime/cvsroot/slime/slime.el	2009/11/02 16:17:48	1.1246
+++ /project/slime/cvsroot/slime/slime.el	2009/11/03 14:33:31	1.1247
@@ -5649,7 +5649,9 @@
 (defun sldb-backward-frame ()
   (when (> (point) sldb-backtrace-start-marker)
     (goto-char (previous-single-char-property-change
-                (car (sldb-frame-region))
+                (if (get-text-property (point) 'frame)
+                    (car (sldb-frame-region))
+                    (point))
                 'frame
                 nil sldb-backtrace-start-marker))))
 
--- /project/slime/cvsroot/slime/swank.lisp	2009/11/02 09:20:34	1.671
+++ /project/slime/cvsroot/slime/swank.lisp	2009/11/03 14:33:31	1.672
@@ -2783,8 +2783,7 @@
         (handler-bind ((compiler-condition
                         (lambda (c) (push (make-compiler-note c) notes))))
           (measure-time-interval function))
-      (check-type successp boolean)
-      (make-compilation-result (reverse notes) successp seconds))))
+      (make-compilation-result (reverse notes) (and successp t) seconds))))
 
 (defslimefun compile-file-for-emacs (filename load-p &optional options)
   "Compile FILENAME and, when LOAD-P, load the result.




From sboukarev at common-lisp.net  Tue Nov  3 14:35:31 2009
From: sboukarev at common-lisp.net (CVS User sboukarev)
Date: Tue, 03 Nov 2009 09:35:31 -0500
Subject: [slime-cvs] CVS slime
Message-ID: <E1N5KTr-0001Vt-G4@common-lisp.net>

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

Modified Files:
	ChangeLog 
Log Message:
Fix changelog formatting.


--- /project/slime/cvsroot/slime/ChangeLog	2009/11/03 14:33:31	1.1908
+++ /project/slime/cvsroot/slime/ChangeLog	2009/11/03 14:35:31	1.1909
@@ -6,7 +6,7 @@
 	* swank.lisp (collect-notes): LOAD returns generalized boolean,
 	not just boolean, but make-compilation-result accepts only booleans
 	for its second argument.
-	
+
 	Both bugs reported by Derrell Piper.
 
 2009-11-02  Tobias C. Rittweiler <tcr at freebits.de>




From sboukarev at common-lisp.net  Tue Nov  3 15:14:41 2009
From: sboukarev at common-lisp.net (CVS User sboukarev)
Date: Tue, 03 Nov 2009 10:14:41 -0500
Subject: [slime-cvs] CVS slime
Message-ID: <E1N5L5l-0005Kk-Mv@common-lisp.net>

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

Modified Files:
	ChangeLog slime.el 
Log Message:
* slime.el (sldb-setup): Do (set-syntax-table lisp-mode-syntax-table)
otherwise functions used by autodoc do not work properly.


--- /project/slime/cvsroot/slime/ChangeLog	2009/11/03 14:35:31	1.1909
+++ /project/slime/cvsroot/slime/ChangeLog	2009/11/03 15:14:41	1.1910
@@ -1,7 +1,12 @@
 2009-11-03  Stas Boukarev  <stassats at gmail.com>
 
-	* slime.el (sldb-backward-frame): If the point is at the end of the buffer,
-	there is no property, handle this case.
+	* slime.el (sldb-setup): Do (set-syntax-table lisp-mode-syntax-table)
+	otherwise functions used by autodoc do not work properly.
+
+2009-11-03  Stas Boukarev  <stassats at gmail.com>
+
+	* slime.el (sldb-backward-frame): If the point is at the end of
+	the buffer, there is no property, handle this case.
 
 	* swank.lisp (collect-notes): LOAD returns generalized boolean,
 	not just boolean, but make-compilation-result accepts only booleans
--- /project/slime/cvsroot/slime/slime.el	2009/11/03 14:33:31	1.1247
+++ /project/slime/cvsroot/slime/slime.el	2009/11/03 15:14:41	1.1248
@@ -5444,7 +5444,8 @@
         (if frames 
             (sldb-insert-frames (sldb-prune-initial-frames frames) t)
           (insert "[No backtrace]")))
-      (run-hooks 'sldb-hook))
+      (run-hooks 'sldb-hook)
+      (set-syntax-table lisp-mode-syntax-table))
     (slime-display-popup-buffer t)
     (sldb-recenter-region (point-min) (point))
     (setq buffer-read-only t)




From heller at common-lisp.net  Tue Nov  3 18:22:59 2009
From: heller at common-lisp.net (CVS User heller)
Date: Tue, 03 Nov 2009 13:22:59 -0500
Subject: [slime-cvs] CVS slime
Message-ID: <E1N5O1z-0001Ue-3l@common-lisp.net>

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

Modified Files:
	ChangeLog swank-cmucl.lisp 
Log Message:
Ask gdb for source lines of foreign functions.

* swank-cmucl.lisp (frame-source-location): Handle foreign
frames with gdb.
(frame-ip): Handle bogus frames (on x86)
(disassemble-frame): Use gdb for foreign frames.
(foreign-frame-p, foreign-frame-source-location): New functions.
(gdb-command, gdb-exec, parse-gdb-line-info, read-word)
(whitespacep, with-temporary-file, call/temporary-file): New
helpers.

--- /project/slime/cvsroot/slime/ChangeLog	2009/11/03 15:14:41	1.1910
+++ /project/slime/cvsroot/slime/ChangeLog	2009/11/03 18:22:58	1.1911
@@ -1,3 +1,16 @@
+2009-11-03  Helmut Eller  <heller at common-lisp.net>
+
+	Ask gdb for source lines of foreign functions.
+
+	* swank-cmucl.lisp (frame-source-location): Handle foreign
+	frames with gdb.
+	(frame-ip): Handle bogus frames (on x86)
+	(disassemble-frame): Use gdb for foreign frames.
+	(foreign-frame-p, foreign-frame-source-location): New functions.
+	(gdb-command, gdb-exec, parse-gdb-line-info, read-word)
+	(whitespacep, with-temporary-file, call/temporary-file): New
+	helpers.
+
 2009-11-03  Stas Boukarev  <stassats at gmail.com>
 
 	* slime.el (sldb-setup): Do (set-syntax-table lisp-mode-syntax-table)
--- /project/slime/cvsroot/slime/swank-cmucl.lisp	2009/11/02 09:20:33	1.214
+++ /project/slime/cvsroot/slime/swank-cmucl.lisp	2009/11/03 18:22:58	1.215
@@ -1535,7 +1535,9 @@
         (ignore-errors (princ e stream))))))
 
 (defimplementation frame-source-location (index)
-  (code-location-source-location (di:frame-code-location (nth-frame index))))
+  (let ((frame (nth-frame index)))
+    (cond ((foreign-frame-p frame) (foreign-frame-source-location frame))
+          ((code-location-source-location (di:frame-code-location frame))))))
 
 (defimplementation eval-in-frame (form index)
   (di:eval-in-frame (nth-frame index) form))
@@ -1807,8 +1809,14 @@
                        (sys:sap-int
                         (sys:sap+ (kernel:code-instructions component) pc)))))
              (values ip pc)))
-          ((or di::bogus-debug-function di::interpreted-debug-function)
-           -1)))))
+          (di::interpreted-debug-function -1)
+          (di::bogus-debug-function
+           #-x86 -1
+           #+x86
+           (let ((fp (di::frame-pointer (di:frame-up frame))))
+             (multiple-value-bind (ra ofp) (di::x86-call-context fp)
+               (declare (ignore ofp))
+               (values ra 0))))))))
 
 (defun frame-registers (frame)
   "Return the lisp registers CSP, CFP, IP, OCFP, LRA for FRAME-NUMBER."
@@ -1825,16 +1833,16 @@
                          (integer p)
                          (sys:system-area-pointer (sys:sap-int p)))))
       (apply #'format t "~
-CSP  =  ~X
-CFP  =  ~X
-IP   =  ~X
-OCFP =  ~X
-LRA  =  ~X~%" (mapcar #'fixnum 
+~8X  Stack Pointer
+~8X  Frame Pointer
+~8X  Instruction Pointer
+~8X  Saved Frame Pointer
+~8X  Saved Instruction Pointer~%" (mapcar #'fixnum 
                       (multiple-value-list (frame-registers frame)))))))
 
+(defvar *gdb-program-name* "/usr/bin/gdb")
 
 (defimplementation disassemble-frame (frame-number)
-  "Return a string with the disassembly of frames code."
   (print-frame-registers frame-number)
   (terpri)
   (let* ((frame (di::frame-real-frame (nth-frame frame-number)))
@@ -1847,7 +1855,84 @@
              (disassemble fun)
              (disassem:disassemble-code-component component))))
       (di::bogus-debug-function
-       (format t "~%[Disassembling bogus frames not implemented]")))))
+       (cond ((probe-file *gdb-program-name*)
+              (let ((ip (sys:sap-int (frame-ip frame))))
+                (princ (gdb-command "disas 0x~x" ip))))
+             (t
+              (format t "~%[Disassembling bogus frames not implemented]")))))))
+
+(defmacro with-temporary-file ((stream filename) &body body)
+  `(call/temporary-file (lambda (,stream ,filename) . ,body)))
+  
+(defun call/temporary-file (fun)
+  (let ((name (system::pick-temporary-file-name)))
+    (unwind-protect
+         (with-open-file (stream name :direction :output :if-exists :supersede)
+           (funcall fun stream name))
+      (delete-file name))))
+
+(defun gdb-command (format-string &rest args)
+  (let ((str (gdb-exec (format nil "attach ~d~%~a~%detach" 
+                               (getpid)
+                               (apply #'format nil format-string args)))))
+    (subseq str (1+ (position #\newline str)))))
+
+(defun gdb-exec (cmd)
+  (with-temporary-file (file filename)
+    (write-string cmd file)
+    (force-output file)
+    (let* ((output (make-string-output-stream))
+           (proc (ext:run-program "gdb" `("-batch" "-x" ,filename) 
+                                  :wait t
+                                  :output output)))
+      (assert (eq (ext:process-status proc) :exited))
+      (assert (eq (ext:process-exit-code proc) 0))
+      (get-output-stream-string output))))
+
+(defun foreign-frame-p (frame)
+  #-x86 nil
+  #+x86 (let ((ip (frame-ip frame)))
+          (and (sys:system-area-pointer-p ip)
+               (multiple-value-bind (pc code)
+                   (di::compute-lra-data-from-pc ip)
+                 (declare (ignore pc))
+                 (not code)))))
+
+(defun foreign-frame-source-location (frame)
+  (let ((ip (sys:sap-int (frame-ip frame))))
+    (cond ((probe-file *gdb-program-name*)
+           (parse-gdb-line-info (gdb-command "info line *0x~x" ip)))
+          (t `(:error "no srcloc available for ~a" frame)))))
+
+;; The output of gdb looks like:
+;; Line 215 of "../../src/lisp/x86-assem.S" 
+;;    starts at address 0x805318c <Ldone+11>
+;;    and ends at 0x805318e <Ldone+13>.
+;; The ../../ are fixed up with the "target:" search list which might
+;; be wrong sometimes.
+(defun parse-gdb-line-info (string)
+  (with-input-from-string (*standard-input* string)
+    (let ((w1 (read-word)))
+      (cond ((equal w1 "Line")
+             (let ((line (read-word)))
+               (assert (equal (read-word) "of"))
+               (let ((file (read-word)))
+                 (make-location (list :file 
+                                      (unix-truename 
+                                       (merge-pathnames 
+                                        (read-from-string file)
+                                        (format nil "~a/lisp/"
+                                                (unix-truename "target:")))))
+                                (list :line (parse-integer line))))))
+            (t `(:error ,string))))))
+
+(defun read-word (&optional (stream *standard-input*))
+  (peek-char t stream)
+  (concatenate 'string (loop until (whitespacep (peek-char nil stream))
+                             collect (read-char stream))))
+
+(defun whitespacep (char)
+  (member char '(#\space #\newline)))
 
 
 ;;;; Inspecting




From trittweiler at common-lisp.net  Tue Nov  3 22:14:20 2009
From: trittweiler at common-lisp.net (CVS User trittweiler)
Date: Tue, 03 Nov 2009 17:14:20 -0500
Subject: [slime-cvs] CVS slime/contrib
Message-ID: <E1N5Rds-0007Il-5k@common-lisp.net>

Update of /project/slime/cvsroot/slime/contrib
In directory cl-net:/tmp/cvs-serv28066

Modified Files:
	swank-arglists.lisp ChangeLog 
Log Message:
	* swank-arglists.lisp (do-decoded-arglists): Remove L-V-T.


--- /project/slime/cvsroot/slime/contrib/swank-arglists.lisp	2009/10/31 22:13:55	1.38
+++ /project/slime/cvsroot/slime/contrib/swank-arglists.lisp	2009/11/03 22:14:19	1.39
@@ -170,7 +170,7 @@
   (assert (loop for clause in clauses
 		thereis (member (car clause) +lambda-list-keywords+)))
   (flet ((parse-clauses (clauses)
-	   (let* ((size    (load-time-value (length +lambda-list-keywords+)))
+	   (let* ((size    (length +lambda-list-keywords+))
 		  (initial (make-hash-table :test #'eq :size size))
 		  (main    (make-hash-table :test #'eq :size size))
 		  (final   (make-hash-table :test #'eq :size size)))
--- /project/slime/cvsroot/slime/contrib/ChangeLog	2009/11/02 16:24:45	1.269
+++ /project/slime/cvsroot/slime/contrib/ChangeLog	2009/11/03 22:14:19	1.270
@@ -1,5 +1,9 @@
 2009-11-02  Tobias C. Rittweiler  <tcr at freebits.de>
 
+	* swank-arglists.lisp (do-decoded-arglists): Remove L-V-T.
+
+2009-11-02  Tobias C. Rittweiler  <tcr at freebits.de>
+
 	* slime-parse.el (slime-make-form-spec-from-string): Break out of
 	the loop if we're at unbalanced parentheses.
 	(slime-compare-character-syntax): New helper.




From trittweiler at common-lisp.net  Thu Nov  5 16:43:05 2009
From: trittweiler at common-lisp.net (CVS User trittweiler)
Date: Thu, 05 Nov 2009 11:43:05 -0500
Subject: [slime-cvs] CVS slime
Message-ID: <E1N65QP-0003qL-OI@common-lisp.net>

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

Modified Files:
	ChangeLog slime.el 
Log Message:
	Make C-c C-c operate on region if mark is active (and Transient
	Mark mode is enabled.)

	* slime.el (slime-compile-defun): Operate on region if
	transient-mark-mode is active.


--- /project/slime/cvsroot/slime/ChangeLog	2009/11/03 18:22:58	1.1911
+++ /project/slime/cvsroot/slime/ChangeLog	2009/11/05 16:43:05	1.1912
@@ -1,3 +1,11 @@
+2009-11-05  Tobias C. Rittweiler <tcr at freebits.de>
+
+	Make C-c C-c operate on region if mark is active (and Transient
+	Mark mode is enabled.)
+
+	* slime.el (slime-compile-defun): Operate on region if
+	transient-mark-mode is active.
+
 2009-11-03  Helmut Eller  <heller at common-lisp.net>
 
 	Ask gdb for source lines of foreign functions.
--- /project/slime/cvsroot/slime/slime.el	2009/11/03 15:14:41	1.1248
+++ /project/slime/cvsroot/slime/slime.el	2009/11/05 16:43:05	1.1249
@@ -2615,7 +2615,9 @@
 compile with a debug setting of that number."
   (interactive "P")
   (let ((slime-compilation-policy (slime-compute-policy raw-prefix-arg)))
-    (apply #'slime-compile-region (slime-region-for-defun-at-point))))
+    (if (use-region-p)
+        (slime-compile-region (region-beginning) (region-end))
+        (apply #'slime-compile-region (slime-region-for-defun-at-point)))))
 
 (defun slime-compile-region (start end)
   "Compile the region."
@@ -8573,6 +8575,15 @@
 (defun slime-local-variable-p (var &optional buffer)
   (local-variable-p var (or buffer (current-buffer)))) ; XEmacs
 
+(slime-DEFUN-if-undefined region-active-p ()
+  (and transient-mark-mode mark-active))
+
+(if (featurep 'xemacs)
+    (slime-DEFUN-if-undefined use-region-p ()
+      (region-active-p))
+    (slime-DEFUN-if-undefined use-region-p ()
+      (and transient-mark-mode mark-active)))
+
 (slime-DEFUN-if-undefined next-single-char-property-change
     (position prop &optional object limit)
   (let ((limit (typecase limit




From trittweiler at common-lisp.net  Thu Nov  5 17:33:41 2009
From: trittweiler at common-lisp.net (CVS User trittweiler)
Date: Thu, 05 Nov 2009 12:33:41 -0500
Subject: [slime-cvs] CVS slime/contrib
Message-ID: <E1N66DN-0007PP-Ix@common-lisp.net>

Update of /project/slime/cvsroot/slime/contrib
In directory cl-net:/tmp/cvs-serv28480/contrib

Modified Files:
	ChangeLog slime-autodoc.el swank-arglists.lisp 
Log Message:
	* swank-arglists.lisp (print-decoded-arglist): Fix printing of
	&any and &key parameters.
	(test-print-arglist): Slightly adapted.

	* slime-autodoc ([test] autodoc.1): Slightly adapted.


--- /project/slime/cvsroot/slime/contrib/ChangeLog	2009/11/03 22:14:19	1.270
+++ /project/slime/cvsroot/slime/contrib/ChangeLog	2009/11/05 17:33:41	1.271
@@ -1,3 +1,11 @@
+2009-11-05  Tobias C. Rittweiler  <tcr at freebits.de>
+
+	* swank-arglists.lisp (print-decoded-arglist): Fix printing of
+	&any and &key parameters.
+	(test-print-arglist): Slightly adapted.
+
+	* slime-autodoc ([test] autodoc.1): Slightly adapted.
+
 2009-11-02  Tobias C. Rittweiler  <tcr at freebits.de>
 
 	* swank-arglists.lisp (do-decoded-arglists): Remove L-V-T.
--- /project/slime/cvsroot/slime/contrib/slime-autodoc.el	2009/10/31 22:13:55	1.22
+++ /project/slime/cvsroot/slime/contrib/slime-autodoc.el	2009/11/05 17:33:41	1.23
@@ -293,10 +293,10 @@
        "(symbol-status symbol &optional ===> (package (symbol-package symbol)) <===)")
 
       ("(apply 'swank::eval-for-emacs*HERE*"
-       "(apply ===> 'eval-for-emacs <=== &optional form buffer-package id &rest args)")
+       "(apply 'eval-for-emacs &optional form buffer-package id &rest args)")
 
       ("(apply #'swank::eval-for-emacs*HERE*"
-       "(apply ===> #'eval-for-emacs <=== &optional form buffer-package id &rest args)")
+       "(apply #'eval-for-emacs &optional form buffer-package id &rest args)")
 
       ("(apply 'swank::eval-for-emacs foo *HERE*"
        "(apply 'eval-for-emacs &optional form ===> buffer-package <=== id &rest args)")
--- /project/slime/cvsroot/slime/contrib/swank-arglists.lisp	2009/11/03 22:14:19	1.39
+++ /project/slime/cvsroot/slime/contrib/swank-arglists.lisp	2009/11/05 17:33:41	1.40
@@ -257,18 +257,18 @@
     (let ((index 0))
       (pprint-logical-block (nil nil :prefix "(" :suffix ")")
         (when operator
-          (print-arg operator))
+          (princ-arg operator))
         (do-decoded-arglist (remove-given-args arglist provided-args)
           (&provided (arg)
              (space)
-             (print-arg arg)
+             (princ-arg arg)
              (incf index))
           (&required (arg)
              (space)
              (if (arglist-p arg)
                  (print-arglist-recursively arg :index index)
                  (with-highlighting (:index index)
-                   (print-arg arg)))
+                   (princ-arg arg)))
              (incf index))
           (&optional :initially
              (when (arglist.optional-args arglist)
@@ -280,7 +280,7 @@
                  (print-arglist-recursively arg :index index)
                  (with-highlighting (:index index)
                    (if (null init-value)
-                       (print-arg arg)
+                       (princ-arg arg)
                        (format t "~:@<~A ~S~@:>" arg init-value))))
              (incf index))
           (&key :initially
@@ -293,9 +293,14 @@
                    (prin1 keyword) (space)
                    (print-arglist-recursively arg :index keyword))
                  (with-highlighting (:index keyword)
-                   (if init
-                       (format t "~:@<~A ~S~@:>" (if keyword keyword arg) init)
-                       (print-arg keyword)))))
+                   (cond ((and init (keywordp keyword))
+                          (format t "~:@<~A ~S~@:>" arg init))
+                         (init
+                          (format t "~:@<(~S ..) ~S~@:>" keyword init))
+                         ((not (keywordp keyword))
+                          (format t "~:@<~S ..~@:>" keyword))
+                         (t
+                          (princ-arg keyword))))))
           (&key :finally
              (when (arglist.allow-other-keys-p arglist)
                (space)
@@ -306,7 +311,7 @@
                (princ '&any)))
           (&any (arg)
              (space)
-             (print-arg arg))
+             (prin1-arg arg))
           (&rest (args bodyp)
              (space)
              (princ (if bodyp '&body '&rest))
@@ -314,15 +319,20 @@
              (if (arglist-p args)
                  (print-arglist-recursively args :index index)
                  (with-highlighting (:index index)
-                   (print-arg args))))
+                   (princ-arg args))))
           ;; FIXME: add &UNKNOWN-JUNK?
           )))))
 
-(defun print-arg (arg)
+(defun princ-arg (arg)
   (princ (if (arglist-dummy-p arg)
              (arglist-dummy.string-representation arg)
              arg)))
 
+(defun prin1-arg (arg)
+  (if (arglist-dummy-p arg)
+      (princ (arglist-dummy.string-representation arg))
+      (prin1 arg)))
+
 (defun print-decoded-arglist-as-template (decoded-arglist &key
                                           (prefix "(") (suffix ")"))
   (let ((first-p t))
@@ -1343,7 +1353,7 @@
     (test '(&whole x y z) "(y z)")
     (test '(x &aux y z) "(x)")
     (test '(x &environment env y) "(x y)")
-    (test '(&key ((function f))) "(&key ((function f)))")
+    (test '(&key ((function f))) "(&key ((function ..)))")
     (test '(eval-when (&any :compile-toplevel :load-toplevel :execute) &body body)
 	  "(eval-when (&any :compile-toplevel :load-toplevel :execute) &body body)")
     (test '(declare (optimize &any (speed 1) (safety 1)))




From trittweiler at common-lisp.net  Thu Nov  5 17:47:09 2009
From: trittweiler at common-lisp.net (CVS User trittweiler)
Date: Thu, 05 Nov 2009 12:47:09 -0500
Subject: [slime-cvs] CVS slime/contrib
Message-ID: <E1N66QP-0000SR-M7@common-lisp.net>

Update of /project/slime/cvsroot/slime/contrib
In directory cl-net:/tmp/cvs-serv1759/contrib

Modified Files:
	swank-arglists.lisp 
Log Message:
Oops really fix printing


--- /project/slime/cvsroot/slime/contrib/swank-arglists.lisp	2009/11/05 17:33:41	1.40
+++ /project/slime/cvsroot/slime/contrib/swank-arglists.lisp	2009/11/05 17:47:09	1.41
@@ -298,7 +298,7 @@
                          (init
                           (format t "~:@<(~S ..) ~S~@:>" keyword init))
                          ((not (keywordp keyword))
-                          (format t "~:@<~S ..~@:>" keyword))
+                          (format t "~:@<(~S ..)~@:>" keyword))
                          (t
                           (princ-arg keyword))))))
           (&key :finally




From sboukarev at common-lisp.net  Fri Nov  6 16:30:00 2009
From: sboukarev at common-lisp.net (CVS User sboukarev)
Date: Fri, 06 Nov 2009 11:30:00 -0500
Subject: [slime-cvs] CVS slime
Message-ID: <E1N6RhI-0001sv-V5@common-lisp.net>

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

Modified Files:
	ChangeLog swank-ecl.lisp 
Log Message:
* swank-ecl.lisp (grovel-docstring-for-arglist): ECL's arglists
for macros include macro name at the first place, unlike arglists
for functions. cdr arglists only for macros and special operators.
Reported by Andy Hefner.


--- /project/slime/cvsroot/slime/ChangeLog	2009/11/05 16:43:05	1.1912
+++ /project/slime/cvsroot/slime/ChangeLog	2009/11/06 16:30:00	1.1913
@@ -1,3 +1,10 @@
+2009-11-06  Stas Boukarev  <stassats at gmail.com>
+
+	* swank-ecl.lisp (grovel-docstring-for-arglist): ECL's arglists
+	for macros include macro name at the first place, unlike arglists
+	for functions. cdr arglists only for macros and special operators.
+	Reported by Andy Hefner.
+
 2009-11-05  Tobias C. Rittweiler <tcr at freebits.de>
 
 	Make C-c C-c operate on region if mark is active (and Transient
--- /project/slime/cvsroot/slime/swank-ecl.lisp	2009/07/27 04:08:41	1.45
+++ /project/slime/cvsroot/slime/swank-ecl.lisp	2009/11/06 16:30:00	1.46
@@ -198,7 +198,11 @@
                 (values (read-from-string docstring t nil :start pos)))
             (if (or errorp (not (listp arglist)))
                 :not-available
-                (cdr arglist)))
+                ; ECL for some reason includes macro name at the first place
+                (if (or (macro-function name)
+                        (special-operator-p name)) 
+                    (cdr arglist)
+                    arglist)))
           :not-available ))))
 
 (defimplementation arglist (name)




From sboukarev at common-lisp.net  Fri Nov  6 17:59:22 2009
From: sboukarev at common-lisp.net (CVS User sboukarev)
Date: Fri, 06 Nov 2009 12:59:22 -0500
Subject: [slime-cvs] CVS slime
Message-ID: <E1N6T5m-00074b-QA@common-lisp.net>

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

Modified Files:
	ChangeLog swank-ecl.lisp 
Log Message:
swank-ecl.lisp(find-source-location): Missing comma before error message formatting.
Patch by Andy Hefner.


--- /project/slime/cvsroot/slime/ChangeLog	2009/11/06 16:30:00	1.1913
+++ /project/slime/cvsroot/slime/ChangeLog	2009/11/06 17:59:22	1.1914
@@ -4,6 +4,8 @@
 	for macros include macro name at the first place, unlike arglists
 	for functions. cdr arglists only for macros and special operators.
 	Reported by Andy Hefner.
+	(find-source-location): Missing comma before error message formatting.
+	Patch by Andy Hefner.
 
 2009-11-05  Tobias C. Rittweiler <tcr at freebits.de>
 
--- /project/slime/cvsroot/slime/swank-ecl.lisp	2009/11/06 16:30:00	1.46
+++ /project/slime/cvsroot/slime/swank-ecl.lisp	2009/11/06 17:59:22	1.47
@@ -495,7 +495,7 @@
                                  (skip-toplevel-forms pos s)
                                  (skip-comments-and-whitespace s)
                                  (read-snippet s))))))))
-   `(:error (format nil "Source definition of ~S not found" obj))))
+   `(:error ,(format nil "Source definition of ~S not found" obj))))
 
 ;;;; Profiling
 




From trittweiler at common-lisp.net  Fri Nov  6 19:08:39 2009
From: trittweiler at common-lisp.net (CVS User trittweiler)
Date: Fri, 06 Nov 2009 14:08:39 -0500
Subject: [slime-cvs] CVS slime/contrib
Message-ID: <E1N6UAp-0004ri-9F@common-lisp.net>

Update of /project/slime/cvsroot/slime/contrib
In directory cl-net:/tmp/cvs-serv18701/contrib

Modified Files:
	slime-c-p-c.el slime-autodoc.el ChangeLog 
Log Message:
	* slime-autodoc.el (slime-arglist): Adapted to new code.
	(slime-retrieve-arglist): New.

	* slime-c-p-c.el (slime-get-arglist): Deleted.
	(slime-complete-symbol*-fancy-bit): Use `slime-retrieve-arglist'.


--- /project/slime/cvsroot/slime/contrib/slime-c-p-c.el	2009/10/31 22:13:55	1.14
+++ /project/slime/cvsroot/slime/contrib/slime-c-p-c.el	2009/11/06 19:08:39	1.15
@@ -21,6 +21,7 @@
 (require 'slime)
 (require 'slime-parse)
 (require 'slime-editing-commands)
+(require 'slime-autodoc)
 
 (defcustom slime-c-p-c-unambiguous-prefix-p t
   "If true, set point after the unambigous prefix.
@@ -83,7 +84,7 @@
 (defun slime-complete-symbol*-fancy-bit ()
   "Do fancy tricks after completing a symbol.
 \(Insert a space or close-paren based on arglist information.)"
-  (let ((arglist (slime-get-arglist (slime-symbol-at-point))))
+  (let ((arglist (slime-retrieve-arglist (slime-symbol-at-point))))
     (when arglist
       (let ((args
              ;; Don't intern these symbols
@@ -102,10 +103,6 @@
                        (not (minibuffer-window-active-p (minibuffer-window))))
               (slime-echo-arglist))))))))
 
-(defun slime-get-arglist (symbol-name)
-  "Return the argument list for SYMBOL-NAME."
-  (slime-eval `(swank:arglist-for-echo-area (quote (,symbol-name)))))
-
 (defun* slime-contextual-completions (beg end) 
   "Return a list of completions of the token from BEG to END in the
 current buffer."
@@ -173,7 +170,6 @@
 (defvar slime-c-p-c-init-undo-stack nil)
 
 (defun slime-c-p-c-init ()
-  (slime-require :swank-arglists)
   ;; save current state for unload
   (push 
    `(progn
--- /project/slime/cvsroot/slime/contrib/slime-autodoc.el	2009/11/05 17:33:41	1.23
+++ /project/slime/cvsroot/slime/contrib/slime-autodoc.el	2009/11/06 19:08:39	1.24
@@ -37,14 +37,26 @@
   :group 'slime-ui)
 
 
-;;; FIXME: unused?
+
 (defun slime-arglist (name)
   "Show the argument list for NAME."
-  (interactive (list (slime-read-symbol-name "Arglist of: ")))
-  (let ((arglist (slime-eval `(swank:arglist-for-echo-area '((,name))))))
-    (if arglist
-        (message "%s" (slime-fontify-string arglist))
-        (error "Arglist not available"))))
+  (interactive (list (slime-read-symbol-name "Arglist of: " t)))
+  (let ((arglist (slime-eval `(swank:arglist-for-echo-area 
+                               '(,name ,slime-cursor-marker)))))
+    (if (eq arglist :not-available)
+        (and errorp (error "Arglist not available"))
+        (message "%s" (slime-fontify-string arglist)))))
+
+(defun slime-retrieve-arglist (name)
+  (let* ((name (etypecase name
+                 (string name)
+                 (symbol (symbol-name name))))
+         (arglist 
+          (slime-eval `(swank:arglist-for-echo-area 
+                        '(,name ,slime-cursor-marker)))))
+    (if (eq arglist :not-available)
+        nil
+        arglist)))
 
 
 ;;;; Autodocs (automatic context-sensitive help)
--- /project/slime/cvsroot/slime/contrib/ChangeLog	2009/11/05 17:33:41	1.271
+++ /project/slime/cvsroot/slime/contrib/ChangeLog	2009/11/06 19:08:39	1.272
@@ -1,10 +1,18 @@
+2009-11-06  Tobias C. Rittweiler  <tcr at freebits.de>
+
+	* slime-autodoc.el (slime-arglist): Adapted to new code.
+	(slime-retrieve-arglist): New.
+
+	* slime-c-p-c.el (slime-get-arglist): Deleted.
+	(slime-complete-symbol*-fancy-bit): Use `slime-retrieve-arglist'.
+
 2009-11-05  Tobias C. Rittweiler  <tcr at freebits.de>
 
 	* swank-arglists.lisp (print-decoded-arglist): Fix printing of
 	&any and &key parameters.
 	(test-print-arglist): Slightly adapted.
 
-	* slime-autodoc ([test] autodoc.1): Slightly adapted.
+	* slime-autodoc.el ([test] autodoc.1): Slightly adapted.
 
 2009-11-02  Tobias C. Rittweiler  <tcr at freebits.de>
 




From sboukarev at common-lisp.net  Sat Nov  7 02:04:56 2009
From: sboukarev at common-lisp.net (CVS User sboukarev)
Date: Fri, 06 Nov 2009 21:04:56 -0500
Subject: [slime-cvs] CVS slime/contrib
Message-ID: <E1N6afg-0001ej-7A@common-lisp.net>

Update of /project/slime/cvsroot/slime/contrib
In directory cl-net:/tmp/cvs-serv6366/contrib

Modified Files:
	ChangeLog slime-package-fu.el 
Log Message:
* contrib/slime-package-fu.el (slime-find-package-definition-regexp): Go
one sexp backward to the defpackage beginning.


--- /project/slime/cvsroot/slime/contrib/ChangeLog	2009/11/06 19:08:39	1.272
+++ /project/slime/cvsroot/slime/contrib/ChangeLog	2009/11/07 02:04:56	1.273
@@ -1,3 +1,8 @@
+2009-11-07  Stas Boukarev  <stassats at gmail.com>
+
+	* slime-package-fu.el (slime-find-package-definition-regexp): Go
+	one sexp backward to the defpackage beginning.
+
 2009-11-06  Tobias C. Rittweiler  <tcr at freebits.de>
 
 	* slime-autodoc.el (slime-arglist): Adapted to new code.
--- /project/slime/cvsroot/slime/contrib/slime-package-fu.el	2009/02/27 17:37:14	1.5
+++ /project/slime/cvsroot/slime/contrib/slime-package-fu.el	2009/11/07 02:04:56	1.6
@@ -26,7 +26,9 @@
       (block nil
 	(while (re-search-forward slime-defpackage-regexp nil t)
 	  (when (slime-package-equal package (slime-sexp-at-point))
-	    (return (make-slime-file-location (buffer-file-name) (point)))))))))
+            (backward-sexp)
+	    (return (make-slime-file-location (buffer-file-name)
+                                              (1- (point))))))))))
 
 (defun slime-package-equal (designator1 designator2)
   ;; First try to be lucky and compare the strings themselves (for the




From sboukarev at common-lisp.net  Fri Nov 13 19:39:16 2009
From: sboukarev at common-lisp.net (CVS User sboukarev)
Date: Fri, 13 Nov 2009 14:39:16 -0500
Subject: [slime-cvs] CVS slime
Message-ID: <E1N91zI-0003I1-Vh@common-lisp.net>

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

Modified Files:
	ChangeLog swank-ecl.lisp 
Log Message:
* swank-ecl.lisp (function-name): Use clos:generic-function-name
for generic functions.
(arglist): Check fro symbol before calling special-operator-p and
macro-function.
Patch by Andy Hefner.


--- /project/slime/cvsroot/slime/ChangeLog	2009/11/06 17:59:22	1.1914
+++ /project/slime/cvsroot/slime/ChangeLog	2009/11/13 19:39:16	1.1915
@@ -1,3 +1,11 @@
+2009-11-13  Stas Boukarev  <stassats at gmail.com>
+
+	* swank-ecl.lisp (function-name): Use clos:generic-function-name
+	for generic functions.
+	(arglist): Check fro symbol before calling special-operator-p and
+	macro-function.
+	Patch by Andy Hefner.
+
 2009-11-06  Stas Boukarev  <stassats at gmail.com>
 
 	* swank-ecl.lisp (grovel-docstring-for-arglist): ECL's arglists
--- /project/slime/cvsroot/slime/swank-ecl.lisp	2009/11/06 17:59:22	1.47
+++ /project/slime/cvsroot/slime/swank-ecl.lisp	2009/11/13 19:39:16	1.48
@@ -206,9 +206,9 @@
           :not-available ))))
 
 (defimplementation arglist (name)
-  (cond ((special-operator-p name)
+  (cond ((and (symbolp name) (special-operator-p name))
          (grovel-docstring-for-arglist name 'function))
-        ((macro-function name)
+        ((and (symbolp name) (macro-function name))
          (grovel-docstring-for-arglist name 'function))
         ((or (functionp name) (fboundp name))
          (multiple-value-bind (name fndef)
@@ -228,7 +228,9 @@
         (t :not-available)))
 
 (defimplementation function-name (f)
-  (si:compiled-function-name f))
+  (typecase f
+    (generic-function (clos:generic-function-name f))
+    (function (si:compiled-function-name f))))
 
 (defimplementation macroexpand-all (form)
   ;;; FIXME! This is not the same as a recursive macroexpansion!




From sboukarev at common-lisp.net  Fri Nov 13 19:55:04 2009
From: sboukarev at common-lisp.net (CVS User sboukarev)
Date: Fri, 13 Nov 2009 14:55:04 -0500
Subject: [slime-cvs] CVS slime
Message-ID: <E1N92Ea-0005Dk-KW@common-lisp.net>

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

Modified Files:
	ChangeLog swank-ecl.lisp 
Log Message:
* swank-ecl.lisp (swank-mop:compute-applicable-methods-using-classes):
Add a dummy function. ECL doesn't have it, but some contribs are using it.
Patch by Andy Hefner.


--- /project/slime/cvsroot/slime/ChangeLog	2009/11/13 19:39:16	1.1915
+++ /project/slime/cvsroot/slime/ChangeLog	2009/11/13 19:55:04	1.1916
@@ -1,5 +1,11 @@
 2009-11-13  Stas Boukarev  <stassats at gmail.com>
 
+	* swank-ecl.lisp (swank-mop:compute-applicable-methods-using-classes):
+	Add a dummy function. ECL doesn't have it, but some contribs are using it.
+	Patch by Andy Hefner.
+
+2009-11-13  Stas Boukarev  <stassats at gmail.com>
+
 	* swank-ecl.lisp (function-name): Use clos:generic-function-name
 	for generic functions.
 	(arglist): Check fro symbol before calling special-operator-p and
--- /project/slime/cvsroot/slime/swank-ecl.lisp	2009/11/13 19:39:16	1.48
+++ /project/slime/cvsroot/slime/swank-ecl.lisp	2009/11/13 19:55:04	1.49
@@ -15,16 +15,20 @@
 (defvar *tmp*)
 
 (eval-when (:compile-toplevel :load-toplevel :execute)
-(if (find-package :gray)
-  (import-from :gray *gray-stream-symbols* :swank-backend)
-  (import-from :ext *gray-stream-symbols* :swank-backend))
-
-(swank-backend::import-swank-mop-symbols :clos
- '(:eql-specializer
-   :eql-specializer-object
-   :generic-function-declarations
-   :specializer-direct-methods
-   :compute-applicable-methods-using-classes)))
+  (if (find-package :gray)
+      (import-from :gray *gray-stream-symbols* :swank-backend)
+      (import-from :ext *gray-stream-symbols* :swank-backend))
+
+  (swank-backend::import-swank-mop-symbols :clos
+    '(:eql-specializer
+      :eql-specializer-object
+      :generic-function-declarations
+      :specializer-direct-methods
+      :compute-applicable-methods-using-classes)))
+
+(defun swank-mop:compute-applicable-methods-using-classes (gf classes)
+  (declare (ignore gf classes))
+  (values nil nil))
 
 
 ;;;; TCP Server




From sboukarev at common-lisp.net  Fri Nov 13 20:23:57 2009
From: sboukarev at common-lisp.net (CVS User sboukarev)
Date: Fri, 13 Nov 2009 15:23:57 -0500
Subject: [slime-cvs] CVS slime
Message-ID: <E1N92gX-0007rp-6n@common-lisp.net>

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

Modified Files:
	ChangeLog swank.lisp 
Log Message:
* swank.lisp (classify-symbol): Check fboundp before calling fdefinition,
ECL doesn't like (fdefinition nil).


--- /project/slime/cvsroot/slime/ChangeLog	2009/11/13 19:55:04	1.1916
+++ /project/slime/cvsroot/slime/ChangeLog	2009/11/13 20:23:57	1.1917
@@ -1,5 +1,8 @@
 2009-11-13  Stas Boukarev  <stassats at gmail.com>
 
+	* swank.lisp (classify-symbol): Check fbound before calling fdefinition,
+	ECL doesn't like (fdefinition nil).
+
 	* swank-ecl.lisp (swank-mop:compute-applicable-methods-using-classes):
 	Add a dummy function. ECL doesn't have it, but some contribs are using it.
 	Patch by Andy Hefner.
--- /project/slime/cvsroot/slime/swank.lisp	2009/11/03 14:33:31	1.672
+++ /project/slime/cvsroot/slime/swank.lisp	2009/11/13 20:23:57	1.673
@@ -701,8 +701,9 @@
       (when (macro-function symbol)     (push :macro result))
       (when (special-operator-p symbol) (push :special-operator result))
       (when (find-package symbol)       (push :package result))
-      (when (typep (ignore-errors (fdefinition symbol))
-                   'generic-function)
+      (when (and (fboundp symbol)
+                 (typep (ignore-errors (fdefinition symbol))
+                        'generic-function))
         (push :generic-function result))
 
       result)))




From trittweiler at common-lisp.net  Fri Nov 13 21:04:26 2009
From: trittweiler at common-lisp.net (CVS User trittweiler)
Date: Fri, 13 Nov 2009 16:04:26 -0500
Subject: [slime-cvs] CVS slime/contrib
Message-ID: <E1N93Ji-0003Gr-6h@common-lisp.net>

Update of /project/slime/cvsroot/slime/contrib
In directory cl-net:/tmp/cvs-serv12573

Modified Files:
	swank-arglists.lisp ChangeLog 
Log Message:
	* swank-arglists.lisp (extra-keywords/make-instance)
	(extra-keywords/change-class): Wrap call to CLASS-PROTOTYPE in an
	IGNORE-ERRORS because computing a class-prototype involves
	evaluating initforms which may be calls to ERROR.


--- /project/slime/cvsroot/slime/contrib/swank-arglists.lisp	2009/11/05 17:47:09	1.41
+++ /project/slime/cvsroot/slime/contrib/swank-arglists.lisp	2009/11/13 21:04:25	1.42
@@ -758,11 +758,13 @@
               (applicable-methods-keywords
                #'allocate-instance (list class))
             (multiple-value-bind (initialize-instance-keywords ii-aokp)
-                (applicable-methods-keywords
-                 #'initialize-instance (list (swank-mop:class-prototype class)))
-              (multiple-value-bind (shared-initialize-keywords si-aokp)
+                (ignore-errors
                   (applicable-methods-keywords
-                   #'shared-initialize (list (swank-mop:class-prototype class) t))
+                   #'initialize-instance (list (swank-mop:class-prototype class))))
+              (multiple-value-bind (shared-initialize-keywords si-aokp)
+                  (ignore-errors
+                    (applicable-methods-keywords
+                     #'shared-initialize (list (swank-mop:class-prototype class) t)))
                 (values (append slot-init-keywords
                                 allocate-instance-keywords
                                 initialize-instance-keywords
@@ -780,8 +782,9 @@
             (extra-keywords/slots class)
           (declare (ignore class-aokp))
           (multiple-value-bind (shared-initialize-keywords si-aokp)
-              (applicable-methods-keywords
-               #'shared-initialize (list (swank-mop:class-prototype class) t))
+              (ignore-errors
+                (applicable-methods-keywords
+                 #'shared-initialize (list (swank-mop:class-prototype class) t)))
             ;; FIXME: much as it would be nice to include the
             ;; applicable keywords from
             ;; UPDATE-INSTANCE-FOR-DIFFERENT-CLASS, I don't really see
--- /project/slime/cvsroot/slime/contrib/ChangeLog	2009/11/07 02:04:56	1.273
+++ /project/slime/cvsroot/slime/contrib/ChangeLog	2009/11/13 21:04:26	1.274
@@ -1,3 +1,10 @@
+2009-11-13  Tobias C. Rittweiler  <tcr at freebits.de>
+
+	* swank-arglists.lisp (extra-keywords/make-instance)
+	(extra-keywords/change-class): Wrap call to CLASS-PROTOTYPE in an
+	IGNORE-ERRORS because computing a class-prototype involves
+	evaluating initforms which may be calls to ERROR.
+
 2009-11-07  Stas Boukarev  <stassats at gmail.com>
 
 	* slime-package-fu.el (slime-find-package-definition-regexp): Go




From sboukarev at common-lisp.net  Mon Nov 16 15:47:55 2009
From: sboukarev at common-lisp.net (CVS User sboukarev)
Date: Mon, 16 Nov 2009 10:47:55 -0500
Subject: [slime-cvs] CVS slime/contrib
Message-ID: <E1NA3o3-0003Cp-5k@common-lisp.net>

Update of /project/slime/cvsroot/slime/contrib
In directory cl-net:/tmp/cvs-serv12324/contrib

Modified Files:
	ChangeLog slime-asdf.el swank-asdf.lisp 
Log Message:
* swank-asdf.lisp (asdf-determine-system): New function
for determining to what system a file belongs.

* slime-asdf.el (slime-rgrep-system): New function.


--- /project/slime/cvsroot/slime/contrib/ChangeLog	2009/11/13 21:04:26	1.274
+++ /project/slime/cvsroot/slime/contrib/ChangeLog	2009/11/16 15:47:54	1.275
@@ -1,3 +1,10 @@
+2009-11-16  Stas Boukarev  <stassats at gmail.com>
+
+	* swank-asdf.lisp (asdf-determine-system): New function for
+	determining to what system a file belongs.
+
+	* slime-asdf.el (slime-rgrep-system): New function.
+
 2009-11-13  Tobias C. Rittweiler  <tcr at freebits.de>
 
 	* swank-arglists.lisp (extra-keywords/make-instance)
--- /project/slime/cvsroot/slime/contrib/slime-asdf.el	2009/10/21 19:38:49	1.12
+++ /project/slime/cvsroot/slime/contrib/slime-asdf.el	2009/11/16 15:47:55	1.13
@@ -87,14 +87,19 @@
 (defun slime-browse-system (name)
   "Browse files in an ASDF system using Dired."
   (interactive (list (slime-read-system-name)))
-  (slime-eval-async 
-   `(cl:directory-namestring
-     (cl:truename
-      (asdf:system-definition-pathname (asdf:find-system ,name))))
+  (slime-eval-async `(asdf-system-directory ,name)
    (lambda (directory)
      (when directory
        (dired directory)))))
 
+(defun slime-rgrep-system (system-name regexp)
+  (interactive (list (slime-read-system-name
+                      nil
+                      (slime-eval `(swank:asdf-determine-system ,(buffer-file-name))))
+                     (grep-read-regexp)))
+  (rgrep regexp "*.lisp"
+         (slime-eval `(swank:asdf-system-directory ,system-name))))
+
 (defslime-repl-shortcut slime-repl-load/force-system ("force-load-system")
   (:handler (lambda ()
               (interactive)
--- /project/slime/cvsroot/slime/contrib/swank-asdf.lisp	2009/10/21 19:38:49	1.10
+++ /project/slime/cvsroot/slime/contrib/swank-asdf.lisp	2009/11/16 15:47:55	1.11
@@ -73,18 +73,29 @@
                  (asdf-module-files component))))
           (asdf:module-components module)))
 
-(defslimefun asdf-system-files (system)
+(defslimefun asdf-system-files (name)
   (let* ((files (mapcar #'namestring
-                        (asdf-module-files (asdf:find-system system))))
-         (main-file (find system files
+                        (asdf-module-files (asdf:find-system name))))
+         (main-file (find name files
                           :test #'string-equal
                           :key #'pathname-name)))
     (if main-file
         (cons main-file (remove main-file files :test #'equalp))
         files)))
 
-(defslimefun asdf-system-loaded-p (system)
+(defslimefun asdf-system-loaded-p (name)
   (gethash 'asdf:load-op
-           (asdf::component-operation-times (asdf:find-system system))))
+           (asdf::component-operation-times (asdf:find-system name))))
+
+(defslimefun asdf-system-directory (name)
+  (cl:directory-namestring
+   (cl:truename
+    (asdf:system-definition-pathname (asdf:find-system name)))))
+
+(defslimefun asdf-determine-system (file)
+  (find-if (lambda (system)
+             (member file (asdf-system-files system)
+                     :test #'equal))
+           (list-all-systems-known-to-asdf)))
 
 (provide :swank-asdf)




From sboukarev at common-lisp.net  Tue Nov 17 10:13:40 2009
From: sboukarev at common-lisp.net (CVS User sboukarev)
Date: Tue, 17 Nov 2009 05:13:40 -0500
Subject: [slime-cvs] CVS slime/contrib
Message-ID: <E1NAL48-0007C6-Fi@common-lisp.net>

Update of /project/slime/cvsroot/slime/contrib
In directory cl-net:/tmp/cvs-serv27652/contrib

Modified Files:
	ChangeLog swank-asdf.lisp 
Log Message:
* contrib/swank-asdf.lisp (asdf-determine-system): Rewritten to be much
faster and to cons less (and look ugly).


--- /project/slime/cvsroot/slime/contrib/ChangeLog	2009/11/16 15:47:54	1.275
+++ /project/slime/cvsroot/slime/contrib/ChangeLog	2009/11/17 10:13:40	1.276
@@ -1,3 +1,8 @@
+2009-11-17  Stas Boukarev  <stassats at gmail.com>
+
+	* swank-asdf.lisp (asdf-determine-system): Rewritten to be much
+	faster and to cons less (and look ugly).
+
 2009-11-16  Stas Boukarev  <stassats at gmail.com>
 
 	* swank-asdf.lisp (asdf-determine-system): New function for
--- /project/slime/cvsroot/slime/contrib/swank-asdf.lisp	2009/11/16 15:47:55	1.11
+++ /project/slime/cvsroot/slime/contrib/swank-asdf.lisp	2009/11/17 10:13:40	1.12
@@ -9,6 +9,7 @@
 
 (in-package :swank)
 
+#-asdf
 (eval-when (:compile-toplevel :load-toplevel :execute)
   (require :asdf))
 
@@ -65,12 +66,12 @@
           :test #'string=))
 
 (defun asdf-module-files (module)
-  (mapcan #'(lambda (component)
-              (typecase component
-                (asdf:cl-source-file
-                 (list (asdf:component-pathname component)))
-                (asdf:module
-                 (asdf-module-files component))))
+  (mapcan (lambda (component)
+            (typecase component
+              (asdf:cl-source-file
+               (list (asdf:component-pathname component)))
+              (asdf:module
+               (asdf-module-files component))))
           (asdf:module-components module)))
 
 (defslimefun asdf-system-files (name)
@@ -92,10 +93,25 @@
    (cl:truename
     (asdf:system-definition-pathname (asdf:find-system name)))))
 
+;;; This looks a little bit ugly, but it needs to be fast because
+;;; there can be many systems with many files
+(defun system-contains-file-p (module pathname pathname-name)
+  (dolist (component (asdf:module-components module))
+    (typecase component
+      (asdf:cl-source-file
+       (when (and (equal pathname-name
+                         (pathname-name
+                          (asdf:component-relative-pathname component)))
+                  (equal pathname (asdf:component-pathname component)))
+         (return t)))
+      (asdf:module
+       (system-contains-file-p component pathname pathname-name)))))
+
 (defslimefun asdf-determine-system (file)
-  (find-if (lambda (system)
-             (member file (asdf-system-files system)
-                     :test #'equal))
-           (list-all-systems-known-to-asdf)))
+  (loop with pathname = (pathname file)
+        with pathname-name = (pathname-name pathname)
+        for (nil . system) being the hash-value of asdf::*defined-systems*
+        when (system-contains-file-p system pathname pathname-name)
+        return (asdf:component-name system)))
 
 (provide :swank-asdf)




From trittweiler at common-lisp.net  Tue Nov 17 20:38:22 2009
From: trittweiler at common-lisp.net (CVS User trittweiler)
Date: Tue, 17 Nov 2009 15:38:22 -0500
Subject: [slime-cvs] CVS slime/contrib
Message-ID: <E1NAUog-0000Fx-Ql@common-lisp.net>

Update of /project/slime/cvsroot/slime/contrib
In directory cl-net:/tmp/cvs-serv979

Modified Files:
	ChangeLog slime-asdf.el 
Log Message:
	M-x slime-isearch-system will run `isearch-forward' on all files
	pertaining to an ASDF system.

	M-x slime-query-replace-system will run `query-replace' on all
	files pertaining to an ASDF system.

	* slime-asdf.el (slime-read-system-name): Refactored so callers
	have choice over how the default value is computed.
	(slime-find-asd-file): Renamed from `slime-find-asd'.
	(slime-determine-asdf-system): New helper.
	(slime-isearch-system): New function. Depends on functionality
	only available on GNU Emacs 23.1.x.
	(slime-query-replace-system): New function.


--- /project/slime/cvsroot/slime/contrib/ChangeLog	2009/11/17 10:13:40	1.276
+++ /project/slime/cvsroot/slime/contrib/ChangeLog	2009/11/17 20:38:22	1.277
@@ -1,3 +1,19 @@
+2009-11-17  Tobias C. Rittweiler  <tcr at freebits.de>
+
+	M-x slime-isearch-system will run `isearch-forward' on all files
+	pertaining to an ASDF system.
+
+	M-x slime-query-replace-system will run `query-replace' on all
+	files pertaining to an ASDF system.
+
+	* slime-asdf.el (slime-read-system-name): Refactored so callers
+	have choice over how the default value is computed.
+	(slime-find-asd-file): Renamed from `slime-find-asd'.
+	(slime-determine-asdf-system): New helper.
+	(slime-isearch-system): New function. Depends on functionality
+	only available on GNU Emacs 23.1.x.
+	(slime-query-replace-system): New function.
+
 2009-11-17  Stas Boukarev  <stassats at gmail.com>
 
 	* swank-asdf.lisp (asdf-determine-system): Rewritten to be much
--- /project/slime/cvsroot/slime/contrib/slime-asdf.el	2009/11/16 15:47:55	1.13
+++ /project/slime/cvsroot/slime/contrib/slime-asdf.el	2009/11/17 20:38:22	1.14
@@ -20,23 +20,28 @@
 (require 'slime-repl)
 (slime-require :swank-asdf)
 
-(defun slime-load-system (&optional system)
-  "Compile and load an ASDF system.  
-
-Default system name is taken from first file matching *.asd in current
-buffer's working directory"
-  (interactive (list (slime-read-system-name)))
-  (slime-oos system "LOAD-OP"))
+;;; Utilities
 
 (defvar slime-system-history nil
   "History list for ASDF system names.")
 
-(defun slime-read-system-name (&optional prompt default-value)
-  "Read a system name from the minibuffer, prompting with PROMPT."
+(defun slime-read-system-name (&optional prompt 
+                                         default-value
+                                         determine-default-accurately)
+  "Read a system name from the minibuffer, prompting with PROMPT.
+If no `default-value' is given, one is tried to be determined: if
+`determine-default-accurately' is true, by an RPC request which
+grovels through all defined systems; if it's not true, by looking
+in the directory of the current buffer."
   (let* ((completion-ignore-case nil)
          (prompt (or prompt "System"))
          (system-names (slime-eval `(swank:list-asdf-systems)))
-         (default-value (or default-value (slime-find-asd system-names)))
+         (default-value (or default-value 
+                            (if determine-default-accurately
+                                (slime-determine-asdf-system (buffer-file-name))
+                                (slime-find-asd-file (or default-directory
+                                                         (buffer-file-name))
+                                                     system-names))))
          (prompt (concat prompt (if default-value
                                     (format " (default `%s'): " default-value)
                                     ": "))))
@@ -44,21 +49,24 @@
                      nil nil nil
                      'slime-system-history default-value)))
 
-(defun slime-find-asd (system-names)
-  "Tries to find an ASDF system definition in the default
-directory or in the directory belonging to the current buffer and
-returns it if it's in `system-names'."
-  (let ((asdf-systems-in-directory
-         (directory-files
-          (file-name-directory (or default-directory
-                                   (buffer-file-name)))
-          nil "\.asd$")))
-    (loop for system in asdf-systems-in-directory
+
+
+(defun slime-find-asd-file (directory system-names)
+  "Tries to find an ASDF system definition file in the
+`directory' and returns it if it's in `system-names'."
+  (let ((asd-files
+         (directory-files (file-name-directory directory) nil "\.asd$")))
+    (loop for system in asd-files
           for candidate = (file-name-sans-extension system)
           when (find candidate system-names :test #'string-equal)
             do (return candidate))))
 
+(defun slime-determine-asdf-system (filename)
+  "Try to determine the asdf system that `filename' belongs to."
+  (slime-eval `(swank:asdf-determine-system ,filename)))
+
 (defun slime-oos (system operation &rest keyword-args)
+  "Operate On System."
   (slime-save-some-lisp-buffers)
   (slime-display-output-buffer)
   (message "Performing ASDF %S%s on system %S"
@@ -68,6 +76,17 @@
    `(swank:operate-on-system-for-emacs ,system ,operation , at keyword-args)
    #'slime-compilation-finished))
 
+
+;;; Interactive functions
+
+(defun slime-load-system (&optional system)
+  "Compile and load an ASDF system.  
+
+Default system name is taken from first file matching *.asd in current
+buffer's working directory"
+  (interactive (list (slime-read-system-name)))
+  (slime-oos system "LOAD-OP"))
+
 (defun slime-open-system (name &optional load)
   "Open all files in an ASDF system."
   (interactive (list (slime-read-system-name)))
@@ -87,18 +106,58 @@
 (defun slime-browse-system (name)
   "Browse files in an ASDF system using Dired."
   (interactive (list (slime-read-system-name)))
-  (slime-eval-async `(asdf-system-directory ,name)
+  (slime-eval-async `(swank:asdf-system-directory ,name)
    (lambda (directory)
      (when directory
        (dired directory)))))
 
-(defun slime-rgrep-system (system-name regexp)
-  (interactive (list (slime-read-system-name
-                      nil
-                      (slime-eval `(swank:asdf-determine-system ,(buffer-file-name))))
+(defun slime-rgrep-system (sys-name regexp)
+  "Run `rgrep' on the base directory of an ASDF system."
+  (interactive (list (slime-read-system-name nil nil t)
                      (grep-read-regexp)))
   (rgrep regexp "*.lisp"
-         (slime-eval `(swank:asdf-system-directory ,system-name))))
+         (slime-eval `(swank:asdf-system-directory ,sys-name))))
+
+(if (boundp 'multi-isearch-next-buffer-function)
+
+    (defun slime-isearch-system (sys-name)
+      "Run `isearch-forward' on the files of an ASDF system."
+      (interactive (list (slime-read-system-name nil nil t)))
+      (let* ((files (slime-eval `(swank:asdf-system-files ,sys-name)))
+             (multi-isearch-next-buffer-function
+              (lexical-let* 
+                  ((buffers-forward  (mapcar #'find-file-noselect files))
+                   (buffers-backward (reverse buffers-forward)))
+                #'(lambda (current-buffer wrap)
+                    ;; Contrary to the the docstring of
+                    ;; `multi-isearch-next-buffer-function', the first
+                    ;; arg is not necessarily a buffer. Report sent
+                    ;; upstream. (2009-11-17)
+                    (setq current-buffer (or current-buffer (current-buffer)))
+                    (let* ((buffers (if isearch-forward
+                                        buffers-forward
+                                        buffers-backward)))
+                      (if wrap
+                          (car buffers)
+                          (second (memq current-buffer buffers))))))))
+        (isearch-forward)))
+
+    (defun slime-isearch-system ()
+      (interactive)
+      (error "This command is only supported on GNU Emacs >23.1.x.")))
+
+(defun slime-query-replace-system (name from to &optional delimited)
+  "Run `query-replace' on an ASDF system."
+  (interactive 
+   (let* ((system (slime-read-system-name nil nil t))
+          (common (query-replace-read-args 
+                   (format "Query replace throughout `%s'" system) t t)))
+     (list system (nth 0 common) (nth 1 common) (nth 2 common))))
+  (tags-query-replace from to delimited 
+                      '(slime-eval `(swank:asdf-system-files ,name))))
+
+
+;;; REPL shortcuts
 
 (defslime-repl-shortcut slime-repl-load/force-system ("force-load-system")
   (:handler (lambda ()
@@ -149,6 +208,9 @@
               (call-interactively 'slime-browse-system)))
   (:one-liner "Browse files in an ASDF system using Dired."))
 
+
+;;; Initialization
+
 (defun slime-asdf-on-connect ()
   (slime-eval-async '(swank:swank-require :swank-asdf)))
 




From heller at common-lisp.net  Wed Nov 18 10:51:34 2009
From: heller at common-lisp.net (CVS User heller)
Date: Wed, 18 Nov 2009 05:51:34 -0500
Subject: [slime-cvs] CVS slime/doc
Message-ID: <E1NAi8M-0006RK-Df@common-lisp.net>

Update of /project/slime/cvsroot/slime/doc
In directory cl-net:/tmp/cvs-serv24695

Modified Files:
	Makefile slime.texi 
Log Message:
* slime.texi: Recommend slime-repl and slime-fancy in the Loading
  Contribs section.

* Makefile (publish): New target



--- /project/slime/cvsroot/slime/doc/Makefile	2009/07/11 15:35:12	1.14
+++ /project/slime/cvsroot/slime/doc/Makefile	2009/11/18 10:51:34	1.15
@@ -36,6 +36,12 @@
 html.tgz: html/index.html
 	tar -czf $@ html
 
+DOCDIR=/project/slime/public_html/doc
+# invoke this like: make CLUSER=heller publish
+publish: html.tgz
+	scp html.tgz $(CLUSER)@common-lisp.net:$(DOCDIR)
+	ssh $(CLUSER)@common-lisp.net "cd $(DOCDIR); tar -zxf html.tgz"
+
 slime.pdf: $(TEXI)
 	texi2pdf $<
 
--- /project/slime/cvsroot/slime/doc/slime.texi	2009/10/21 14:32:57	1.85
+++ /project/slime/cvsroot/slime/doc/slime.texi	2009/11/18 10:51:34	1.86
@@ -12,7 +12,7 @@
 @set EDITION 3.0-alpha
 @set SLIMEVER 3.0-alpha
 @c @set UPDATED @today{}
- at set UPDATED @code{$Date: 2009/10/21 14:32:57 $}
+ at set UPDATED @code{$Date: 2009/11/18 10:51:34 $}
 @set TITLE SLIME User Manual
 @settitle @value{TITLE}, version @value{EDITION}
 
@@ -676,9 +676,10 @@
 The buffer @code{*inferior-lisp*} contains the Lisp process's own
 top-level. This direct access to Lisp is useful for troubleshooting,
 and some degree of @SLIME{} integration is available using the
- at code{inferior-slime-mode}. However, in normal use we recommend using
-the fully-integrated @SLIME{} @REPL{} (@pxref{REPL}) and ignoring the
- at code{*inferior-lisp*} buffer.
+inferior-slime-mode.  Many people load the better integrated @SLIME{}
+ at REPL{} contrib module (@pxref{REPL}) and ignore
+the @code{*inferior-lisp*} buffer.  (@pxref{Loading Contribs} for
+information on how to enable the REPL.)
 
 @c ----------------------- 
 @node Multithreading
@@ -2126,6 +2127,22 @@
 After starting SLIME, the commands of both packages should be
 available.
 
+The REPL and @code{slime-fancy} modules deserve special mention.  Many
+users consider the REPL (@pxref{REPL}) essential
+while @code{slime-fancy} (@pxref{slime-fancy}) loads the REPL and
+almost all of the popular contribs.  So, if you aren't sure what to
+choose start with:
+
+ at example
+(slime-setup '(slime-repl)) ; repl only
+ at end example
+
+If you like what you see try this:
+
+ at example
+(slime-setup '(slime-fancy)) ; almost everything
+ at end example
+
 @c ----------------------- 
 @node REPL
 @section REPL: the ``top level''




From trittweiler at common-lisp.net  Thu Nov 19 13:37:44 2009
From: trittweiler at common-lisp.net (CVS User trittweiler)
Date: Thu, 19 Nov 2009 08:37:44 -0500
Subject: [slime-cvs] CVS slime
Message-ID: <E1NB7Ci-0001Kb-OQ@common-lisp.net>

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

Modified Files:
	ChangeLog slime.el 
Log Message:
	* slime.el (slime-minibuffer-map): Nee `slime-read-expression-map'
	(slime-minibuffer-history): Nee `slime-read-expression-history'
	(slime-minibuffer-setup-hook): Extracted.
	(slime-read-from-minibuffer): Adapted accordingly.

	* slime-asdf.el (slime-query-replace-system): Enable TAB
	completion of symbol names.

	* slime-fuzzy.el (slime-fuzzy-completions): Do not use
	`slime-find-buffer-package' it's an internal operation of
	`slime-current-buffer'.


--- /project/slime/cvsroot/slime/ChangeLog	2009/11/13 20:23:57	1.1917
+++ /project/slime/cvsroot/slime/ChangeLog	2009/11/19 13:37:44	1.1918
@@ -1,3 +1,10 @@
+2009-11-19  Tobias C. Rittweiler <tcr at freebits.de>
+
+	* slime.el (slime-minibuffer-map): Nee `slime-read-expression-map'
+	(slime-minibuffer-history): Nee `slime-read-expression-history'
+	(slime-minibuffer-setup-hook): Extracted.
+	(slime-read-from-minibuffer): Adapted accordingly.
+
 2009-11-13  Stas Boukarev  <stassats at gmail.com>
 
 	* swank.lisp (classify-symbol): Check fbound before calling fdefinition,
--- /project/slime/cvsroot/slime/slime.el	2009/11/05 16:43:05	1.1249
+++ /project/slime/cvsroot/slime/slime.el	2009/11/19 13:37:44	1.1250
@@ -3743,7 +3743,7 @@
             ((memq (char-before) '(?\t ?\ ))
              (slime-echo-arglist))))))
 
-(defvar slime-read-expression-map
+(defvar slime-minibuffer-map
   (let ((map (make-sparse-keymap)))
     (set-keymap-parent map minibuffer-local-map)
     (define-key map "\t" 'slime-complete-symbol)
@@ -3751,23 +3751,25 @@
     map)
   "Minibuffer keymap used for reading CL expressions.")
 
-(defvar slime-read-expression-history '()
+(defvar slime-minibuffer-history '()
   "History list of expressions read from the minibuffer.")
  
-(defun slime-read-from-minibuffer (prompt &optional initial-value)
+(defun slime-minibuffer-setup-hook ()
+  (cons (lexical-let ((package (slime-current-package))
+                      (connection (slime-connection)))
+          (lambda ()
+            (setq slime-buffer-package package)
+            (setq slime-buffer-connection connection)
+            (set-syntax-table lisp-mode-syntax-table)))
+        minibuffer-setup-hook))
+
+(defun slime-read-from-minibuffer (prompt &optional initial-value history)
   "Read a string from the minibuffer, prompting with PROMPT.  
 If INITIAL-VALUE is non-nil, it is inserted into the minibuffer before
 reading input.  The result is a string (\"\" if no input was given)."
-  (let ((minibuffer-setup-hook 
-         (cons (lexical-let ((package (slime-current-package))
-                             (connection (slime-connection)))
-                 (lambda ()
-                   (setq slime-buffer-package package)
-                   (setq slime-buffer-connection connection)
-                   (set-syntax-table lisp-mode-syntax-table)))
-	       minibuffer-setup-hook)))
-    (read-from-minibuffer prompt initial-value slime-read-expression-map
-			  nil 'slime-read-expression-history)))
+  (let ((minibuffer-setup-hook (slime-minibuffer-setup-hook)))
+    (read-from-minibuffer prompt initial-value slime-minibuffer-map
+			  nil 'slime-minibuffer-history)))
 
 (defun slime-bogus-completion-alist (list)
   "Make an alist out of list.




From trittweiler at common-lisp.net  Thu Nov 19 13:37:45 2009
From: trittweiler at common-lisp.net (CVS User trittweiler)
Date: Thu, 19 Nov 2009 08:37:45 -0500
Subject: [slime-cvs] CVS slime/contrib
Message-ID: <E1NB7Cj-0001Kq-4H@common-lisp.net>

Update of /project/slime/cvsroot/slime/contrib
In directory cl-net:/tmp/cvs-serv5112/contrib

Modified Files:
	ChangeLog slime-asdf.el slime-fuzzy.el 
Log Message:
	* slime.el (slime-minibuffer-map): Nee `slime-read-expression-map'
	(slime-minibuffer-history): Nee `slime-read-expression-history'
	(slime-minibuffer-setup-hook): Extracted.
	(slime-read-from-minibuffer): Adapted accordingly.

	* slime-asdf.el (slime-query-replace-system): Enable TAB
	completion of symbol names.

	* slime-fuzzy.el (slime-fuzzy-completions): Do not use
	`slime-find-buffer-package' it's an internal operation of
	`slime-current-buffer'.


--- /project/slime/cvsroot/slime/contrib/ChangeLog	2009/11/17 20:38:22	1.277
+++ /project/slime/cvsroot/slime/contrib/ChangeLog	2009/11/19 13:37:45	1.278
@@ -1,3 +1,12 @@
+2009-11-19  Tobias C. Rittweiler  <tcr at freebits.de>
+
+	* slime-asdf.el (slime-query-replace-system): Enable TAB
+	completion of symbol names.
+
+	* slime-fuzzy.el (slime-fuzzy-completions): Do not use
+	`slime-find-buffer-package' it's an internal operation of
+	`slime-current-buffer'.
+
 2009-11-17  Tobias C. Rittweiler  <tcr at freebits.de>
 
 	M-x slime-isearch-system will run `isearch-forward' on all files
--- /project/slime/cvsroot/slime/contrib/slime-asdf.el	2009/11/17 20:38:22	1.14
+++ /project/slime/cvsroot/slime/contrib/slime-asdf.el	2009/11/19 13:37:45	1.15
@@ -149,12 +149,14 @@
 (defun slime-query-replace-system (name from to &optional delimited)
   "Run `query-replace' on an ASDF system."
   (interactive 
-   (let* ((system (slime-read-system-name nil nil t))
+   (let* ((minibuffer-setup-hook (slime-minibuffer-setup-hook))
+	  (minibuffer-local-map slime-minibuffer-map)
+	  (system (slime-read-system-name nil nil t))
           (common (query-replace-read-args 
                    (format "Query replace throughout `%s'" system) t t)))
      (list system (nth 0 common) (nth 1 common) (nth 2 common))))
   (tags-query-replace from to delimited 
-                      '(slime-eval `(swank:asdf-system-files ,name))))
+		      '(slime-eval `(swank:asdf-system-files ,name))))
 
 
 ;;; REPL shortcuts
--- /project/slime/cvsroot/slime/contrib/slime-fuzzy.el	2009/08/09 14:07:48	1.12
+++ /project/slime/cvsroot/slime/contrib/slime-fuzzy.el	2009/11/19 13:37:45	1.13
@@ -226,7 +226,6 @@
 		  (string prefix))))
     (slime-eval `(swank:fuzzy-completions ,prefix 
                                           ,(or default-package
-                                               (slime-find-buffer-package)
                                                (slime-current-package))
                   :limit ,slime-fuzzy-completion-limit
                   :time-limit-in-msec ,slime-fuzzy-completion-time-limit-in-msec))))




From sboukarev at common-lisp.net  Fri Nov 20 15:48:18 2009
From: sboukarev at common-lisp.net (CVS User sboukarev)
Date: Fri, 20 Nov 2009 10:48:18 -0500
Subject: [slime-cvs] CVS slime/contrib
Message-ID: <E1NBVic-00024M-Cz@common-lisp.net>

Update of /project/slime/cvsroot/slime/contrib
In directory cl-net:/tmp/cvs-serv7952/contrib

Modified Files:
	ChangeLog slime-repl.el 
Log Message:
contrib/slime-repl.el:
(slime-repl-position-in-history): Add new optional
parameter `exclude-string'.
(slime-repl-history-replace): Don't replace history item if it's exactly
matching the current input, search for the next match instead.


--- /project/slime/cvsroot/slime/contrib/ChangeLog	2009/11/19 13:37:45	1.278
+++ /project/slime/cvsroot/slime/contrib/ChangeLog	2009/11/20 15:48:18	1.279
@@ -1,3 +1,10 @@
+2009-11-20  Stas Boukarev  <stassats at gmail.com>
+
+	* slime-repl.el (slime-repl-position-in-history): Add new optional
+	parameter `exclude-string'.
+	(slime-repl-history-replace): Don't replace history item if it's exactly
+	matching the current input, search for the next match instead.
+
 2009-11-19  Tobias C. Rittweiler  <tcr at freebits.de>
 
 	* slime-asdf.el (slime-query-replace-system): Enable TAB
--- /project/slime/cvsroot/slime/contrib/slime-repl.el	2009/10/15 16:40:38	1.29
+++ /project/slime/cvsroot/slime/contrib/slime-repl.el	2009/11/20 15:48:18	1.30
@@ -896,7 +896,8 @@
          (pos0 (cond ((slime-repl-history-search-in-progress-p)
                       slime-repl-input-history-position)
                      (t min-pos)))
-         (pos (slime-repl-position-in-history pos0 direction (or regexp "")))
+         (pos (slime-repl-position-in-history pos0 direction (or regexp "")
+                                              (slime-repl-current-input)))
          (msg nil))
     (cond ((and (< min-pos pos) (< pos max-pos))
            (slime-repl-replace-input (nth pos slime-repl-input-history))
@@ -922,9 +923,11 @@
 (defun slime-repl-terminate-history-search ()
   (setq last-command this-command))
 
-(defun slime-repl-position-in-history (start-pos direction regexp)
-  "Return the position of the history item matching regexp.
-Return -1 resp. the length of the history if no item matches"
+(defun slime-repl-position-in-history (start-pos direction regexp
+                                       &optional exclude-string)
+  "Return the position of the history item matching REGEXP.
+Return -1 resp. the length of the history if no item matches.
+If EXCLUDE-STRING is specified then it's excluded from the search."
   ;; Loop through the history list looking for a matching line
   (let* ((step (ecase direction
                  (forward -1)
@@ -934,7 +937,10 @@
     (loop for pos = (+ start-pos step) then (+ pos step)
           if (< pos 0) return -1
           if (<= len pos) return len
-          if (string-match regexp (nth pos history)) return pos)))
+          for history-item = (nth pos history)
+          if (and (string-match regexp history-item)
+                  (not (equal history-item exclude-string)))
+          return pos)))
 
 (defun slime-repl-previous-input ()
   "Cycle backwards through input history.




From trittweiler at common-lisp.net  Sat Nov 21 16:27:56 2009
From: trittweiler at common-lisp.net (CVS User trittweiler)
Date: Sat, 21 Nov 2009 11:27:56 -0500
Subject: [slime-cvs] CVS slime/contrib
Message-ID: <E1NBsoW-0006nn-2z@common-lisp.net>

Update of /project/slime/cvsroot/slime/contrib
In directory cl-net:/tmp/cvs-serv26148/contrib

Modified Files:
	swank-asdf.lisp slime-asdf.el ChangeLog 
Log Message:
	* swank-asdf.lisp (asdf-determine-system): Also try to determine
	the current system by looking at the buffer-package.

	* slime-asdf (slime-read-system-name): Adapted accordingly.


--- /project/slime/cvsroot/slime/contrib/swank-asdf.lisp	2009/11/17 10:13:40	1.12
+++ /project/slime/cvsroot/slime/contrib/swank-asdf.lisp	2009/11/21 16:27:55	1.13
@@ -107,11 +107,23 @@
       (asdf:module
        (system-contains-file-p component pathname pathname-name)))))
 
-(defslimefun asdf-determine-system (file)
-  (loop with pathname = (pathname file)
-        with pathname-name = (pathname-name pathname)
-        for (nil . system) being the hash-value of asdf::*defined-systems*
-        when (system-contains-file-p system pathname pathname-name)
-        return (asdf:component-name system)))
+(defslimefun asdf-determine-system (file buffer-package-name)
+  ;; First try to grovel through all defined systems to find a system
+  ;; which contains FILE.
+  (when file
+    (loop with pathname      = (pathname file)
+          with pathname-name = (pathname-name pathname)
+          for (nil . system) being the hash-value of asdf::*defined-systems*
+          when (system-contains-file-p system pathname pathname-name)
+            do (return-from asdf-determine-system
+                 (asdf:component-name system))))
+  ;; If we couldn't find a system by that, we now try if there's a
+  ;; system that's named like BUFFER-PACKAGE-NAME.
+  (let ((package (guess-buffer-package buffer-package-name)))
+    (dolist (name (package-names package))
+      (let ((system (asdf:find-system (string-downcase name) nil)))
+        (when system
+          (return-from asdf-determine-system
+            (asdf:component-name system)))))))
 
 (provide :swank-asdf)
--- /project/slime/cvsroot/slime/contrib/slime-asdf.el	2009/11/19 13:37:45	1.15
+++ /project/slime/cvsroot/slime/contrib/slime-asdf.el	2009/11/21 16:27:55	1.16
@@ -38,7 +38,8 @@
          (system-names (slime-eval `(swank:list-asdf-systems)))
          (default-value (or default-value 
                             (if determine-default-accurately
-                                (slime-determine-asdf-system (buffer-file-name))
+                                (slime-determine-asdf-system (buffer-file-name)
+                                                             (slime-current-package))
                                 (slime-find-asd-file (or default-directory
                                                          (buffer-file-name))
                                                      system-names))))
@@ -61,9 +62,9 @@
           when (find candidate system-names :test #'string-equal)
             do (return candidate))))
 
-(defun slime-determine-asdf-system (filename)
+(defun slime-determine-asdf-system (filename buffer-package)
   "Try to determine the asdf system that `filename' belongs to."
-  (slime-eval `(swank:asdf-determine-system ,filename)))
+  (slime-eval `(swank:asdf-determine-system ,filename ,buffer-package)))
 
 (defun slime-oos (system operation &rest keyword-args)
   "Operate On System."
--- /project/slime/cvsroot/slime/contrib/ChangeLog	2009/11/20 15:48:18	1.279
+++ /project/slime/cvsroot/slime/contrib/ChangeLog	2009/11/21 16:27:55	1.280
@@ -1,3 +1,10 @@
+2009-11-21  Tobias C. Rittweiler  <tcr at freebits.de>
+
+	* swank-asdf.lisp (asdf-determine-system): Also try to determine
+	the current system by looking at the buffer-package.
+
+	* slime-asdf (slime-read-system-name): Adapted accordingly.
+
 2009-11-20  Stas Boukarev  <stassats at gmail.com>
 
 	* slime-repl.el (slime-repl-position-in-history): Add new optional




From trittweiler at common-lisp.net  Sat Nov 21 21:32:29 2009
From: trittweiler at common-lisp.net (CVS User trittweiler)
Date: Sat, 21 Nov 2009 16:32:29 -0500
Subject: [slime-cvs] CVS slime
Message-ID: <E1NBxZF-0003AJ-1U@common-lisp.net>

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

Modified Files:
	swank-backend.lisp ChangeLog 
Log Message:
	* swank-sbcl.lisp (who-specializes): Implement.
	Requires SBCL 1.0.32.


--- /project/slime/cvsroot/slime/swank-backend.lisp	2009/11/02 09:20:33	1.184
+++ /project/slime/cvsroot/slime/swank-backend.lisp	2009/11/21 21:32:28	1.185
@@ -951,11 +951,14 @@
      (:newline) (:newline)
      ,(with-output-to-string (desc) (describe object desc))))
 
+
 ;;; Utilities for inspector methods.
 ;;; 
+
 (defun label-value-line (label value &key (newline t))
   "Create a control list which prints \"LABEL: VALUE\" in the inspector.
 If NEWLINE is non-NIL a `(:newline)' is added to the result."
+  
   (list* (princ-to-string label) ": " `(:value ,value)
          (if newline '((:newline)) nil)))
 
--- /project/slime/cvsroot/slime/ChangeLog	2009/11/19 13:37:44	1.1918
+++ /project/slime/cvsroot/slime/ChangeLog	2009/11/21 21:32:28	1.1919
@@ -1,3 +1,8 @@
+2009-11-21  Tobias C. Rittweiler <tcr at freebits.de>
+
+	* swank-sbcl.lisp (who-specializes): Implement.
+	Requires SBCL 1.0.32.
+
 2009-11-19  Tobias C. Rittweiler <tcr at freebits.de>
 
 	* slime.el (slime-minibuffer-map): Nee `slime-read-expression-map'




From trittweiler at common-lisp.net  Sat Nov 21 21:32:57 2009
From: trittweiler at common-lisp.net (CVS User trittweiler)
Date: Sat, 21 Nov 2009 16:32:57 -0500
Subject: [slime-cvs] CVS slime
Message-ID: <E1NBxZh-0003B8-CV@common-lisp.net>

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

Modified Files:
	swank-sbcl.lisp 
Log Message:
	* swank-sbcl.lisp (who-specializes): Implement.
	Requires SBCL 1.0.32.


--- /project/slime/cvsroot/slime/swank-sbcl.lisp	2009/11/02 09:20:34	1.254
+++ /project/slime/cvsroot/slime/swank-sbcl.lisp	2009/11/21 21:32:57	1.255
@@ -834,19 +834,22 @@
   
 #+#.(swank-backend::sbcl-with-xref-p)
 (progn
-  (defmacro defxref (name)
+  (defmacro defxref (name &optional fn-name)
     `(defimplementation ,name (what)
        (sanitize-xrefs   
         (mapcar #'source-location-for-xref-data
-                (,(find-symbol (symbol-name name) "SB-INTROSPECT")
+                (,(find-symbol (symbol-name (if fn-name
+                                                fn-name
+                                                name))
+                               "SB-INTROSPECT")
                   what)))))
   (defxref who-calls)
   (defxref who-binds)
   (defxref who-sets)
   (defxref who-references)
   (defxref who-macroexpands)
-  #+#.(swank-backend::with-symbol 'who-specializes 'sb-introspect)
-  (defxref who-specializes))
+  #+#.(swank-backend::with-symbol 'who-specializes-directly 'sb-introspect)
+  (defxref who-specializes who-specializes-directly))
 
 (defun source-location-for-xref-data (xref-data)
   (let ((name (car xref-data))




From trittweiler at common-lisp.net  Sun Nov 22 10:12:17 2009
From: trittweiler at common-lisp.net (CVS User trittweiler)
Date: Sun, 22 Nov 2009 05:12:17 -0500
Subject: [slime-cvs] CVS slime/contrib
Message-ID: <E1NC9QX-0001Fp-DR@common-lisp.net>

Update of /project/slime/cvsroot/slime/contrib
In directory cl-net:/tmp/cvs-serv4822/contrib

Modified Files:
	ChangeLog slime-fontifying-fu.el slime-parse.el 
Log Message:
	* slime-fontifying-fu.el (slime-compute-region-for-font-lock): Set
	an upper limit for the starting point of searching for suppressed
	forms.

	* slime-parse.el (slime-make-form-spec-from-string): Minor
	optimizations.
	(slime-parse-form-upto-point): Refactored to not use `reduce' but
	bultins.
	(slime-make-form-spec-from-string, slime-parse-form-upto-point)
	(slime-compare-char-syntax): Byte-compile.


--- /project/slime/cvsroot/slime/contrib/ChangeLog	2009/11/21 16:27:55	1.280
+++ /project/slime/cvsroot/slime/contrib/ChangeLog	2009/11/22 10:12:17	1.281
@@ -1,3 +1,16 @@
+2009-11-22  Tobias C. Rittweiler  <tcr at freebits.de>
+
+	* slime-fontifying-fu.el (slime-compute-region-for-font-lock): Set
+	an upper limit for the starting point of searching for suppressed
+	forms.
+
+	* slime-parse.el (slime-make-form-spec-from-string): Minor
+	optimizations.
+	(slime-parse-form-upto-point): Refactored to not use `reduce' but
+	bultins.
+	(slime-make-form-spec-from-string, slime-parse-form-upto-point)
+	(slime-compare-char-syntax): Byte-compile.
+
 2009-11-21  Tobias C. Rittweiler  <tcr at freebits.de>
 
 	* swank-asdf.lisp (asdf-determine-system): Also try to determine
--- /project/slime/cvsroot/slime/contrib/slime-fontifying-fu.el	2009/10/31 22:41:04	1.16
+++ /project/slime/cvsroot/slime/contrib/slime-fontifying-fu.el	2009/11/22 10:12:17	1.17
@@ -168,9 +168,10 @@
     (goto-char beg)
     (inline (slime-beginning-of-tlf))
     (assert (not (plusp (nth 0 (slime-current-parser-state)))))
-    (setq beg (let ((pt (point))) 
-                (or (slime-search-directly-preceding-reader-conditional)
-                    pt)))
+    (setq beg (let ((pt (point)))
+                (cond ((> (- beg pt) 20000) beg)
+                      ((slime-search-directly-preceding-reader-conditional))
+                      (t pt))))
     (goto-char end)
     (while (search-backward-regexp slime-reader-conditionals-regexp beg t)
       (setq end (max end (save-excursion 
--- /project/slime/cvsroot/slime/contrib/slime-parse.el	2009/11/02 16:24:45	1.27
+++ /project/slime/cvsroot/slime/contrib/slime-parse.el	2009/11/22 10:12:17	1.28
@@ -200,24 +200,27 @@
 	((eql (char-syntax (aref string 0)) ?\') string) ; "'(foo)", "#(foo)" &c
 	((not (eql (aref string 0) ?\()) string)         ; "foo"
 	(t                                               ; "(op arg1 arg2 ...)"
-	 (with-temp-buffer
-	   ;; Do NEVER ever try to activate `lisp-mode' here with
-	   ;; `slime-use-autodoc-mode' enabled, as this function is used
-	   ;; to compute the current autodoc itself.
-	   (set-syntax-table lisp-mode-syntax-table)
-	   (erase-buffer)
-	   (insert string)
-	   (goto-char (1+ (point-min)))
-	   (let ((subsexps))
-	     (while (condition-case nil 
-			(slime-point-moves-p (slime-forward-sexp))
-		      (scan-error nil)	; can't move any further
-		      (error t))        ; unknown feature expression etc.
-	       ;; We first move back for (FOO)'BAR where point is at
-	       ;; the quote character.
-	       (backward-sexp)
-	       (push (slime-sexp-at-point) subsexps)
-	       (forward-sexp))
+         (with-current-buffer (get-buffer-create " *slime-make-form-spec-buffer*")
+           ;; Do NEVER ever try to activate `lisp-mode' here with
+           ;; `slime-use-autodoc-mode' enabled, as this function is used
+           ;; to compute the current autodoc itself.
+           (set-syntax-table lisp-mode-syntax-table)
+           (erase-buffer)
+           (insert string)
+           (goto-char (1+ (point-min)))
+           (let ((subsexps)
+                 (end))
+             (while (condition-case nil 
+                        (slime-point-moves-p (slime-forward-sexp))
+                      (scan-error nil)  ; can't move any further
+                      (error t))        ; unknown feature expression etc.
+               ;; We first move back for (FOO)'BAR where point is at
+               ;; the quote character.
+               (setq end (point))               
+               (push (buffer-substring-no-properties 
+                      (save-excursion (backward-sexp) (point)) 
+                      end) 
+                     subsexps))
              (mapcar #'(lambda (s)
                          (assert (not (equal s string)))      
                          (slime-make-form-spec-from-string s))
@@ -331,7 +334,7 @@
 that the character is not escaped."
   (let ((char        (funcall get-char-fn (point)))
 	(char-before (funcall get-char-fn (1- (point)))))
-    (if (and char (eq (char-syntax char) (coerce syntax 'character)))
+    (if (and char (eq (char-syntax char) (aref syntax 0)))
 	(if unescaped
 	    (or (null char-before)
 		(not (eq (char-syntax char-before) ?\\)))
@@ -344,42 +347,45 @@
   ;; We assert this, because `slime-incomplete-form-at-point' blows up
   ;; inside a comment.
   (assert (not (slime-inside-string-or-comment-p)))
-  (save-excursion
-    (let ((suffix (list slime-cursor-marker)))
-      (cond ((slime-compare-char-syntax #'char-after "(" t)
-	     ;; We're at the start of some expression, so make sure
-	     ;; that SWANK::%CURSOR-MARKER% will come after that
-	     ;; expression.
-	     (ignore-errors (forward-sexp)))
-	    ((slime-compare-char-syntax #'char-before " " t)
-	     ;; We're after some expression, so we have to make sure
-	     ;; that %CURSOR-MARKER% does not come directly after that
-	     ;; expression.
-	     (push "" suffix))
-	    ((slime-compare-char-syntax #'char-before "(" t)
-	     ;; We're directly after an opening parenthesis, so we
-	     ;; have to make sure that something comes before
-	     ;; %CURSOR-MARKER%..
-	     (push "" suffix))
-	    (t
-	     ;; We're at a symbol, so make sure we get the whole symbol.
-	     (slime-end-of-symbol)))
-      (let ((forms '())
-	    (levels (or max-levels 5)))
-	(condition-case nil
-	    (let ((form (slime-incomplete-form-at-point)))
-	      (setq forms (list (nconc form suffix)))
-	      (up-list -1)
-	      (dotimes (i (1- levels))
-		(push (slime-incomplete-form-at-point) forms)
-		(up-list -1)))
-	  ;; At head of toplevel form.
-	  (scan-error nil))
-	(when forms
-	  ;; Squeeze list of forms into tree structure again
-	  (reduce #'(lambda (form tree)
-		      (nconc form (list tree)))
-		  forms :from-end t))))))
+  (save-restriction
+    ;; Don't parse more than 15000 characters before point, so we
+    ;; don't spend too much time.
+    (narrow-to-region (max (point-min) (- (point) 15000)) (point-max))
+    (save-excursion
+      (let ((suffix (list slime-cursor-marker)))
+        (cond ((slime-compare-char-syntax #'char-after "(" t)
+               ;; We're at the start of some expression, so make sure
+               ;; that SWANK::%CURSOR-MARKER% will come after that
+               ;; expression.
+               (ignore-errors (forward-sexp)))
+              ((slime-compare-char-syntax #'char-before " " t)
+               ;; We're after some expression, so we have to make sure
+               ;; that %CURSOR-MARKER% does not come directly after that
+               ;; expression.
+               (push "" suffix))
+              ((slime-compare-char-syntax #'char-before "(" t)
+               ;; We're directly after an opening parenthesis, so we
+               ;; have to make sure that something comes before
+               ;; %CURSOR-MARKER%..
+               (push "" suffix))
+              (t
+               ;; We're at a symbol, so make sure we get the whole symbol.
+               (slime-end-of-symbol)))
+        (let ((result-form '())
+              (levels (or max-levels 5)))
+          (condition-case nil
+              ;; We unroll the first iteration of the loop because
+              ;; `suffix' must be merged into the first form rather
+              ;; than onto.
+              (let ((form (slime-incomplete-form-at-point)))
+                (setq result-form (nconc form suffix))
+                (up-list -1)
+                (dotimes (i (1- levels))
+                  (let ((next (slime-incomplete-form-at-point)))
+                    (setq result-form (nconc next (list result-form))))
+                  (up-list -1)))
+            (scan-error nil)) ; At head of toplevel form.
+          result-form)))))
 
 
 (defun slime-ensure-list (thing)
@@ -470,3 +476,9 @@
 
 (provide 'slime-parse)
 
+(let ((byte-compile-warnings '()))
+  (mapc #'byte-compile
+        '(slime-make-form-spec-from-string
+          slime-parse-form-upto-point
+          slime-compare-char-syntax
+          )))
\ No newline at end of file




From sboukarev at common-lisp.net  Sun Nov 22 13:03:12 2009
From: sboukarev at common-lisp.net (CVS User sboukarev)
Date: Sun, 22 Nov 2009 08:03:12 -0500
Subject: [slime-cvs] CVS slime/contrib
Message-ID: <E1NCC5w-00088z-QR@common-lisp.net>

Update of /project/slime/cvsroot/slime/contrib
In directory cl-net:/tmp/cvs-serv31207/contrib

Modified Files:
	ChangeLog slime-repl.el 
Log Message:
contrib/slime-repl.el:
(slime-repl-history-remove-duplicates): New variable,
if set to T previous matching history entries are removed before
appending a new item. Default value is NIL.
(slime-repl-history-trim-whitespaces): New variable, when T remove
whitespaces at the beginning and end of a new history item.
Default value is NIL.
(slime-repl-add-to-input-history): Implement behaviour of the variables
above.
(slime-string-trim): New function, works like cl:string-trim.


--- /project/slime/cvsroot/slime/contrib/ChangeLog	2009/11/22 10:12:17	1.281
+++ /project/slime/cvsroot/slime/contrib/ChangeLog	2009/11/22 13:03:10	1.282
@@ -1,3 +1,15 @@
+2009-11-22  Stas Boukarev  <stassats at gmail.com>
+
+	* slime-repl.el (slime-repl-history-remove-duplicates): New variable,
+	if set to T previous matching history entries are removed before
+	appending a new item. Default value is NIL.
+	(slime-repl-history-trim-whitespaces): New variable, when T remove
+	whitespaces at the beginning and end of a new history item.
+	Default value is NIL.
+	(slime-repl-add-to-input-history): Implement behaviour of the variables
+	above.
+	(slime-string-trim): New function, works like cl:string-trim.
+
 2009-11-22  Tobias C. Rittweiler  <tcr at freebits.de>
 
 	* slime-fontifying-fu.el (slime-compute-region-for-font-lock): Set
--- /project/slime/cvsroot/slime/contrib/slime-repl.el	2009/11/20 15:48:18	1.30
+++ /project/slime/cvsroot/slime/contrib/slime-repl.el	2009/11/22 13:03:11	1.31
@@ -690,7 +690,7 @@
 
 (defun slime-repl-return (&optional end-of-input)
   "Evaluate the current input string, or insert a newline.  
-Send the current input ony if a whole expression has been entered,
+Send the current input only if a whole expression has been entered,
 i.e. the parenthesis are matched. 
 
 With prefix argument send the input even if the parenthesis are not
@@ -865,16 +865,41 @@
   :type 'boolean
   :group 'slime-repl)
 
+(defcustom slime-repl-history-remove-duplicates nil
+  "*When T all duplicates are removed except the last one."
+  :type 'boolean
+  :group 'slime-repl)
+
+(defcustom slime-repl-history-trim-whitespaces nil
+  "*When T strip all whitespaces from the beginning and end."
+  :type 'boolean
+  :group 'slime-repl)
+
 (make-variable-buffer-local
  (defvar slime-repl-input-history '()
    "History list of strings read from the REPL buffer."))
 
+(defun slime-string-trim (character-bag string)
+  (flet ((find-bound (&optional from-end)
+           (position-if-not (lambda (char) (memq char character-bag))
+                            string :from-end from-end)))
+    (let ((start (find-bound))
+          (end (find-bound t)))
+      (if start
+          (subseq string start (1+ end))
+          ""))))
+
 (defun slime-repl-add-to-input-history (string)
   "Add STRING to the input history.
 Empty strings and duplicates are ignored."
-  (unless (or (equal string "")
-              (equal string (car slime-repl-input-history)))
-    (push string slime-repl-input-history)))
+  (when slime-repl-history-trim-whitespaces
+    (setq string (slime-string-trim '(?\n ?\ ?\t) string)))
+  (unless (equal string "")
+    (when slime-repl-history-remove-duplicates
+      (setq slime-repl-input-history
+            (remove string slime-repl-input-history)))
+    (unless (equal string (car slime-repl-input-history))
+      (push string slime-repl-input-history))))
 
 ;; These two vars contain the state of the last history search.  We
 ;; only use them if `last-command' was 'slime-repl-history-replace,




From trittweiler at common-lisp.net  Mon Nov 23 09:56:02 2009
From: trittweiler at common-lisp.net (CVS User trittweiler)
Date: Mon, 23 Nov 2009 04:56:02 -0500
Subject: [slime-cvs] CVS slime/contrib
Message-ID: <E1NCVeM-00051z-Gm@common-lisp.net>

Update of /project/slime/cvsroot/slime/contrib
In directory cl-net:/tmp/cvs-serv19339/contrib

Modified Files:
	ChangeLog swank-asdf.lisp 
Log Message:
	* swank-asdf.lisp (system-contains-file-p): Previous definition
	didn't properly propagate positive return value of recursive
	call. Fix that.


--- /project/slime/cvsroot/slime/contrib/ChangeLog	2009/11/22 13:03:10	1.282
+++ /project/slime/cvsroot/slime/contrib/ChangeLog	2009/11/23 09:56:02	1.283
@@ -1,3 +1,9 @@
+2009-11-23  Tobias C. Rittweiler  <tcr at freebits.de>
+
+	* swank-asdf.lisp (system-contains-file-p): Previous definition
+	didn't properly propagate positive return value of recursive
+	call. Fix that.
+
 2009-11-22  Stas Boukarev  <stassats at gmail.com>
 
 	* slime-repl.el (slime-repl-history-remove-duplicates): New variable,
--- /project/slime/cvsroot/slime/contrib/swank-asdf.lisp	2009/11/21 16:27:55	1.13
+++ /project/slime/cvsroot/slime/contrib/swank-asdf.lisp	2009/11/23 09:56:02	1.14
@@ -93,19 +93,21 @@
    (cl:truename
     (asdf:system-definition-pathname (asdf:find-system name)))))
 
-;;; This looks a little bit ugly, but it needs to be fast because
-;;; there can be many systems with many files
 (defun system-contains-file-p (module pathname pathname-name)
-  (dolist (component (asdf:module-components module))
-    (typecase component
-      (asdf:cl-source-file
-       (when (and (equal pathname-name
-                         (pathname-name
-                          (asdf:component-relative-pathname component)))
-                  (equal pathname (asdf:component-pathname component)))
-         (return t)))
-      (asdf:module
-       (system-contains-file-p component pathname pathname-name)))))
+  (some #'(lambda (component)
+	    (typecase component
+	      (asdf:cl-source-file 
+	       ;; We first compare the relative names because
+	       ;; retrieving the full pathname is somewhat costy; this
+	       ;; function is called a lot, and its performance
+	       ;; translates directly into response time to the user.
+	       (and (equal pathname-name
+			   (pathname-name
+			    (asdf:component-relative-pathname component)))
+		    (equal pathname (asdf:component-pathname component))))
+	      (asdf:module 
+	       (system-contains-file-p component pathname pathname-name))))
+	(asdf:module-components module)))
 
 (defslimefun asdf-determine-system (file buffer-package-name)
   ;; First try to grovel through all defined systems to find a system




From trittweiler at common-lisp.net  Mon Nov 23 12:23:35 2009
From: trittweiler at common-lisp.net (CVS User trittweiler)
Date: Mon, 23 Nov 2009 07:23:35 -0500
Subject: [slime-cvs] CVS slime/contrib
Message-ID: <E1NCXx9-0007lP-Gz@common-lisp.net>

Update of /project/slime/cvsroot/slime/contrib
In directory cl-net:/tmp/cvs-serv29843

Modified Files:
	ChangeLog slime-asdf.el swank-asdf.lisp 
Log Message:
	* swank-asdf.lisp (operate-on-system-for-emacs),
	(operate-on-system): Muffle ASDF:COMPILE-ERROR because we reuse
	Slime's compilation error reportery anyway, and sldb popping up is
	just annoying.


--- /project/slime/cvsroot/slime/contrib/ChangeLog	2009/11/23 09:56:02	1.283
+++ /project/slime/cvsroot/slime/contrib/ChangeLog	2009/11/23 12:23:35	1.284
@@ -1,5 +1,12 @@
 2009-11-23  Tobias C. Rittweiler  <tcr at freebits.de>
 
+	* swank-asdf.lisp (operate-on-system-for-emacs),
+	(operate-on-system): Muffle ASDF:COMPILE-ERROR because we reuse
+	Slime's compilation error reportery anyway, and sldb popping up is
+	just annoying.
+
+2009-11-23  Tobias C. Rittweiler  <tcr at freebits.de>
+
 	* swank-asdf.lisp (system-contains-file-p): Previous definition
 	didn't properly propagate positive return value of recursive
 	call. Fix that.
--- /project/slime/cvsroot/slime/contrib/slime-asdf.el	2009/11/21 16:27:55	1.16
+++ /project/slime/cvsroot/slime/contrib/slime-asdf.el	2009/11/23 12:23:35	1.17
@@ -1,8 +1,10 @@
 ;;; slime-asdf.el -- ASDF support
 ;;
-;; Authors: Daniel Barlow  <dan at telent.net>
-;;          Marco Baringer <mb at bese.it>
-;;          Edi Weitz <edi at agharta.de>
+;; Authors: Daniel Barlow       <dan at telent.net>
+;;          Marco Baringer      <mb at bese.it>
+;;          Edi Weitz           <edi at agharta.de>
+;;          Stas Boukarev       <stassats at gmail.com>
+;;          Tobias C Rittweiler <tcr at freebits.de>
 ;;          and others 
 ;; License: GNU GPL (same license as Emacs)
 ;;
@@ -130,7 +132,7 @@
                   ((buffers-forward  (mapcar #'find-file-noselect files))
                    (buffers-backward (reverse buffers-forward)))
                 #'(lambda (current-buffer wrap)
-                    ;; Contrary to the the docstring of
+                    ;; Contrarily to the the docstring of
                     ;; `multi-isearch-next-buffer-function', the first
                     ;; arg is not necessarily a buffer. Report sent
                     ;; upstream. (2009-11-17)
--- /project/slime/cvsroot/slime/contrib/swank-asdf.lisp	2009/11/23 09:56:02	1.14
+++ /project/slime/cvsroot/slime/contrib/swank-asdf.lisp	2009/11/23 12:23:35	1.15
@@ -18,19 +18,21 @@
 Record compiler notes signalled as `compiler-condition's."
    (collect-notes
     (lambda ()
-      (apply #'operate-on-system system-name operation keywords)
-      t)))
+      (apply #'operate-on-system system-name operation keywords))))
 
 (defun operate-on-system (system-name operation-name &rest keyword-args)
   "Perform OPERATION-NAME on SYSTEM-NAME using ASDF.
 The KEYWORD-ARGS are passed on to the operation.
 Example:
 \(operate-on-system \"SWANK\" \"COMPILE-OP\" :force t)"
-  (with-compilation-hooks ()
-    (let ((operation (find-symbol operation-name :asdf)))
-      (when (null operation)
-        (error "Couldn't find ASDF operation ~S" operation-name))
-      (apply #'asdf:operate operation system-name keyword-args))))
+  (handler-case 
+      (with-compilation-hooks ()
+	(let ((operation (find-symbol operation-name :asdf)))
+	  (when (null operation)
+	    (error "Couldn't find ASDF operation ~S" operation-name))
+	  (apply #'asdf:operate operation system-name keyword-args)
+	  t))
+    (asdf:compile-error () nil)))
 
 (defun asdf-central-registry ()
   asdf:*central-registry*)




From trittweiler at common-lisp.net  Mon Nov 23 12:25:42 2009
From: trittweiler at common-lisp.net (CVS User trittweiler)
Date: Mon, 23 Nov 2009 07:25:42 -0500
Subject: [slime-cvs] CVS slime/contrib
Message-ID: <E1NCXzC-0007nw-RJ@common-lisp.net>

Update of /project/slime/cvsroot/slime/contrib
In directory cl-net:/tmp/cvs-serv29998

Modified Files:
	ChangeLog slime-repl.el 
Log Message:
	* slime-repl.el (slime-repl-previous-matching-input)
	(slime-repl-next-matching-input): Read input by means of
	`slime-read-from-minibuffer' so TAB will complete symbols for us.


--- /project/slime/cvsroot/slime/contrib/ChangeLog	2009/11/23 12:23:35	1.284
+++ /project/slime/cvsroot/slime/contrib/ChangeLog	2009/11/23 12:25:42	1.285
@@ -1,5 +1,11 @@
 2009-11-23  Tobias C. Rittweiler  <tcr at freebits.de>
 
+	* slime-repl.el (slime-repl-previous-matching-input)
+	(slime-repl-next-matching-input): Read input by means of
+	`slime-read-from-minibuffer' so TAB will complete symbols for us.
+
+2009-11-23  Tobias C. Rittweiler  <tcr at freebits.de>
+
 	* swank-asdf.lisp (operate-on-system-for-emacs),
 	(operate-on-system): Muffle ASDF:COMPILE-ERROR because we reuse
 	Slime's compilation error reportery anyway, and sldb popping up is
--- /project/slime/cvsroot/slime/contrib/slime-repl.el	2009/11/22 13:03:11	1.31
+++ /project/slime/cvsroot/slime/contrib/slime-repl.el	2009/11/23 12:25:42	1.32
@@ -992,12 +992,14 @@
   (slime-repl-history-replace 'backward (slime-repl-history-pattern)))
 
 (defun slime-repl-previous-matching-input (regexp)
-  (interactive "sPrevious element matching (regexp): ")
+  (interactive (list (slime-read-from-minibuffer
+		      "Previous element matching (regexp): ")))
   (slime-repl-terminate-history-search)
   (slime-repl-history-replace 'backward regexp))
 
 (defun slime-repl-next-matching-input (regexp)
-  (interactive "sNext element matching (regexp): ")
+  (interactive (list (slime-read-from-minibuffer
+		      "Next element matching (regexp): ")))
   (slime-repl-terminate-history-search)
   (slime-repl-history-replace 'forward regexp))
 




From sboukarev at common-lisp.net  Mon Nov 23 19:54:56 2009
From: sboukarev at common-lisp.net (CVS User sboukarev)
Date: Mon, 23 Nov 2009 14:54:56 -0500
Subject: [slime-cvs] CVS slime
Message-ID: <E1NCezw-0003IK-A7@common-lisp.net>

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

Modified Files:
	ChangeLog slime.el 
Log Message:
slime.el(slime-set-connection-info): Set slime-current-thread to t
before doing anything. Solves a bug reported by Slawek Zak.


--- /project/slime/cvsroot/slime/ChangeLog	2009/11/21 21:32:28	1.1919
+++ /project/slime/cvsroot/slime/ChangeLog	2009/11/23 19:54:55	1.1920
@@ -1,3 +1,8 @@
+2009-11-23  Stas Boukarev  <stassats at gmail.com>
+
+	* slime.el (slime-set-connection-info): Set slime-current-thread to t
+	before doing anything. Solves a bug reported by Slawek Zak.
+
 2009-11-21  Tobias C. Rittweiler <tcr at freebits.de>
 
 	* swank-sbcl.lisp (who-specializes): Implement.
--- /project/slime/cvsroot/slime/slime.el	2009/11/19 13:37:44	1.1250
+++ /project/slime/cvsroot/slime/slime.el	2009/11/23 19:54:56	1.1251
@@ -1916,11 +1916,12 @@
   ;; first command.
   (let ((slime-current-thread t))
     (slime-eval-async '(swank:connection-info)
-                    (slime-curry #'slime-set-connection-info proc))))
+                      (slime-curry #'slime-set-connection-info proc))))
 
 (defun slime-set-connection-info (connection info)
   "Initialize CONNECTION with INFO received from Lisp."
-  (let ((slime-dispatching-connection connection))
+  (let ((slime-dispatching-connection connection)
+        (slime-current-thread t))
     (destructuring-bind (&key pid style lisp-implementation machine
                               features package version modules
                               &allow-other-keys) info




From trittweiler at common-lisp.net  Mon Nov 23 21:48:52 2009
From: trittweiler at common-lisp.net (CVS User trittweiler)
Date: Mon, 23 Nov 2009 16:48:52 -0500
Subject: [slime-cvs] CVS slime/contrib
Message-ID: <E1NCgmC-00032e-V7@common-lisp.net>

Update of /project/slime/cvsroot/slime/contrib
In directory cl-net:/tmp/cvs-serv11691

Modified Files:
	ChangeLog slime-asdf.el 
Log Message:
	* slime-asdf.el (slime-rgrep-system): Conditionalize on whether
	`rgrep' is available (it isn't on Emacs 21.) Also make sure to
	call `grep-compute-defaults' before `grep-read-regexp' because the
	former does some necessary setup. (Seems to be of a problem on
	Emacs from CVS.)


--- /project/slime/cvsroot/slime/contrib/ChangeLog	2009/11/23 12:25:42	1.285
+++ /project/slime/cvsroot/slime/contrib/ChangeLog	2009/11/23 21:48:52	1.286
@@ -1,5 +1,13 @@
 2009-11-23  Tobias C. Rittweiler  <tcr at freebits.de>
 
+	* slime-asdf.el (slime-rgrep-system): Conditionalize on whether
+	`rgrep' is available (it isn't on Emacs 21.) Also make sure to
+	call `grep-compute-defaults' before `grep-read-regexp' because the
+	former does some necessary setup. (Seems to be of a problem on
+	Emacs from CVS.)
+
+2009-11-23  Tobias C. Rittweiler  <tcr at freebits.de>
+
 	* slime-repl.el (slime-repl-previous-matching-input)
 	(slime-repl-next-matching-input): Read input by means of
 	`slime-read-from-minibuffer' so TAB will complete symbols for us.
--- /project/slime/cvsroot/slime/contrib/slime-asdf.el	2009/11/23 12:23:35	1.17
+++ /project/slime/cvsroot/slime/contrib/slime-asdf.el	2009/11/23 21:48:52	1.18
@@ -114,15 +114,19 @@
      (when directory
        (dired directory)))))
 
-(defun slime-rgrep-system (sys-name regexp)
-  "Run `rgrep' on the base directory of an ASDF system."
-  (interactive (list (slime-read-system-name nil nil t)
-                     (grep-read-regexp)))
-  (rgrep regexp "*.lisp"
-         (slime-eval `(swank:asdf-system-directory ,sys-name))))
+(if (fboundp 'rgrep)
+    (defun slime-rgrep-system (sys-name regexp)
+      "Run `rgrep' on the base directory of an ASDF system."
+      (interactive (progn (grep-compute-defaults)
+                          (list (slime-read-system-name nil nil t)
+                                (grep-read-regexp))))
+      (rgrep regexp "*.lisp"
+             (slime-eval `(swank:asdf-system-directory ,sys-name))))
+    (defun slime-rgrep-system ()
+      (interactive)
+      (error "This command is only supported on GNU Emacs >21.x.")))
 
 (if (boundp 'multi-isearch-next-buffer-function)
-
     (defun slime-isearch-system (sys-name)
       "Run `isearch-forward' on the files of an ASDF system."
       (interactive (list (slime-read-system-name nil nil t)))
@@ -144,7 +148,6 @@
                           (car buffers)
                           (second (memq current-buffer buffers))))))))
         (isearch-forward)))
-
     (defun slime-isearch-system ()
       (interactive)
       (error "This command is only supported on GNU Emacs >23.1.x.")))




From trittweiler at common-lisp.net  Tue Nov 24 13:17:01 2009
From: trittweiler at common-lisp.net (CVS User trittweiler)
Date: Tue, 24 Nov 2009 08:17:01 -0500
Subject: [slime-cvs] CVS slime/contrib
Message-ID: <E1NCvGP-00018o-AY@common-lisp.net>

Update of /project/slime/cvsroot/slime/contrib
In directory cl-net:/tmp/cvs-serv4385

Modified Files:
	ChangeLog slime-parse.el swank-arglists.lisp 
Log Message:
	Fix a few edge cases in new arglist code.

	* slime-parse.el (slime-parse-form-upto-point): Regard
	beginning-of-line as whitespace, and DTRT.

	* swank-arglists.lisp (empty-arg-p): Input may not only be an
	arglist-dummy.
	(print-decoded-arglist-as-template): Do not print superfluuous
	newline before &body.
	(arglist-for-echo-area): Catch errors.
	(find-subform-with-arglist): Deal properly with NIL as argument.
	(find-immediately-containing-arglist): Do not erroneously complete
	form with an unsuited arglist of the parent form.
	(last-arg): New helper.
	(arglist-path-to-nested-arglist): Use it.

	Reported by Ariel Badichi.


--- /project/slime/cvsroot/slime/contrib/ChangeLog	2009/11/23 21:48:52	1.286
+++ /project/slime/cvsroot/slime/contrib/ChangeLog	2009/11/24 13:17:00	1.287
@@ -1,3 +1,23 @@
+2009-11-24  Tobias C. Rittweiler  <tcr at freebits.de>
+
+	Fix a few edge cases in new arglist code.
+
+	* slime-parse.el (slime-parse-form-upto-point): Regard
+	beginning-of-line as whitespace, and DTRT.
+
+	* swank-arglists.lisp (empty-arg-p): Input may not only be an
+	arglist-dummy.
+	(print-decoded-arglist-as-template): Do not print superfluuous
+	newline before &body.
+	(arglist-for-echo-area): Catch errors.
+	(find-subform-with-arglist): Deal properly with NIL as argument.
+	(find-immediately-containing-arglist): Do not erroneously complete
+	form with an unsuited arglist of the parent form.
+	(last-arg): New helper.
+	(arglist-path-to-nested-arglist): Use it.
+
+	Reported by Ariel Badichi.
+
 2009-11-23  Tobias C. Rittweiler  <tcr at freebits.de>
 
 	* slime-asdf.el (slime-rgrep-system): Conditionalize on whether
--- /project/slime/cvsroot/slime/contrib/slime-parse.el	2009/11/22 10:12:17	1.28
+++ /project/slime/cvsroot/slime/contrib/slime-parse.el	2009/11/24 13:17:00	1.29
@@ -358,7 +358,7 @@
                ;; that SWANK::%CURSOR-MARKER% will come after that
                ;; expression.
                (ignore-errors (forward-sexp)))
-              ((slime-compare-char-syntax #'char-before " " t)
+              ((or (bolp) (slime-compare-char-syntax #'char-before " " t))
                ;; We're after some expression, so we have to make sure
                ;; that %CURSOR-MARKER% does not come directly after that
                ;; expression.
--- /project/slime/cvsroot/slime/contrib/swank-arglists.lisp	2009/11/13 21:04:25	1.42
+++ /project/slime/cvsroot/slime/contrib/swank-arglists.lisp	2009/11/24 13:17:00	1.43
@@ -159,7 +159,8 @@
   string-representation)
 
 (defun empty-arg-p (dummy)
-  (zerop (length (arglist-dummy.string-representation dummy))))
+  (and (arglist-dummy-p dummy)
+       (zerop (length (arglist-dummy.string-representation dummy)))))
 
 
 (eval-when (:compile-toplevel :load-toplevel :execute)
@@ -362,12 +363,10 @@
             (pprint-newline :linear))
           (&any (arg)
             (space) (print-arg-or-pattern arg))
-          (&rest (args body-p)
+          (&rest (args)
             (when (or (not (arglist.keyword-args decoded-arglist))
                       (arglist.allow-other-keys-p decoded-arglist))
-              (if body-p
-                  (pprint-newline :mandatory)
-                  (space))
+              (space)
               (format t "~A..." args))))))))
 
 (defvar *arglist-pprint-bindings*
@@ -1053,7 +1052,7 @@
   
 (defslimefun variable-desc-for-echo-area (variable-name)
   "Return a short description of VARIABLE-NAME, or NIL."
-    (with-buffer-syntax ()
+  (with-buffer-syntax ()
     (let ((sym (parse-symbol variable-name)))
       (if (and sym (boundp sym))
           (let ((*print-pretty* t) (*print-level* 4)
@@ -1088,26 +1087,34 @@
   "Return a string representing the arglist for the deepest subform in
 RAW-FORM that does have an arglist. The highlighted parameter is
 wrapped in ===> X <===."
-  (with-buffer-syntax ()
-    (multiple-value-bind (form arglist)
-        (find-subform-with-arglist (parse-raw-form raw-form))
-      (with-available-arglist (arglist) arglist
-        (destructuring-bind (operator . args) form
-          (decoded-arglist-to-string
-           arglist
-           :print-right-margin print-right-margin
-           :print-lines print-lines
-           :operator operator
-           :highlight (arglist-path-to-parameter arglist args)))))))
+  (handler-case
+      (with-buffer-syntax ()
+        (multiple-value-bind (form arglist)
+            (find-subform-with-arglist (parse-raw-form raw-form))
+          (with-available-arglist (arglist) arglist
+            (destructuring-bind (operator . args) form
+              (decoded-arglist-to-string
+               arglist
+               :print-right-margin print-right-margin
+               :print-lines print-lines
+               :operator operator
+               :highlight (arglist-path-to-parameter arglist args))))))
+    (serious-condition (c)
+      (let ((*print-right-margin* print-right-margin)
+            (*print-lines* print-lines))
+        (format nil "Arglist Error: \"~A\"" c)))))
 
 (defslimefun complete-form (raw-form)
-    "Read FORM-STRING in the current buffer package, then complete it
+  "Read FORM-STRING in the current buffer package, then complete it
   by adding a template for the missing arguments."
-    (with-buffer-syntax ()
+  ;; We do not catch errors here because COMPLETE-FORM is an
+  ;; interactive command, not automatically run in the background like
+  ;; ARGLIST-FOR-ECHO-AREA.
+  (with-buffer-syntax ()
     (multiple-value-bind (arglist provided-args)
         (find-immediately-containing-arglist (parse-raw-form raw-form))
       (with-available-arglist (arglist) arglist
-        (decoded-arglist-to-template-string 
+        (decoded-arglist-to-template-string
          (delete-given-args arglist 
                             (remove-if #'empty-arg-p provided-args
                                        :from-end t :count 1))
@@ -1142,8 +1149,8 @@
 (defparameter +cursor-marker+ '%cursor-marker%)
 
 (defun find-subform-with-arglist (form)
-  "Returns two values: the appropriate subform of FORM which is
-closest to the +CURSOR-MARKER+ and whose operator is valid and has an
+  "Returns two values: the appropriate subform of FORM which is close
+to the +CURSOR-MARKER+ and whose operator is valid and has an
 arglist. Second value is the arglist. The +CURSOR-MARKER+ is removed
 from the subform returned.
 
@@ -1192,28 +1199,49 @@
                (t
                 (multiple-value-or (grovel-form last-subform local-ops)
                                    (yield form local-ops))))))))
-    (grovel-form form '())))
+    (if (null form)
+        (values nil :not-available)
+        (grovel-form form '()))))
 
 (defun extract-local-op-arglists (form)
   ;; FIXME: Take recursive scope of LABELS into account.
-  (if (null (cddr form))
-      nil
-      (loop for (name arglist . nil) in (second form)
-            when arglist
-              collect (cons name arglist))))
+  (cond ((null (cddr form)) nil)        ; `(flet ((foo (x) |'
+        ((atom (second form)) nil)      ; `(flet ,foo (|'
+        (t
+         (let* ((defs (second form))
+                (defs (remove-if-not #'(lambda (x)
+                                        ;; Well-formed FLET/LABELS def?
+                                        (and (consp x) (second x)))
+                                    defs)))
+           (loop for (name arglist . nil) in defs
+                 collect (cons name arglist))))))
 
 (defun find-immediately-containing-arglist (form)
-  "Returns the arglist closest to +CURSOR-MARKER+ in form. This may be
-an implicit, nested arglist; e.g. on (WITH-OPEN-FILE (X))."
+  "Returns the arglist of the form immediately containing
++CURSOR-MARKER+ in form. Notice, however, as +CURSOR-MARKER+ may be in
+a nested arglist \(e.g. `(WITH-OPEN-FILE (|'\), the appropriate parent
+form may in fact be considered."
   (multiple-value-bind (form arglist) (find-subform-with-arglist form)
     (if (eql arglist :not-available)
         (values :not-available nil)
-        (destructuring-bind (operator . args) form
-          (declare (ignore operator))
-          (let* ((path (arglist-path-to-nested-arglist arglist args))
-                 (argl (apply #'arglist-ref arglist path))
-                 (args (apply #'provided-arguments-ref args arglist path)))
-            (values argl args))))))
+        (let ((provided-args (cdr form)))
+          (multiple-value-bind (last-arg last-provd-arg)
+              (last-arg arglist provided-args)
+            (cond
+              ;; Are we stuck in a nested arglist?
+              ((and (arglist-p last-arg) (listp last-provd-arg))
+               (let* ((path (arglist-path-to-nested-arglist arglist provided-args))
+                      (argl (apply #'arglist-ref arglist path))
+                      (args (apply #'provided-arguments-ref
+                                   provided-args arglist path)))
+                 (values argl args)))
+              ;; We aren't in a nested arglist, so we couldn't
+              ;; actually find any arglist for the form that the
+              ;; cursor is immediately contained in.
+              ((consp last-provd-arg)
+               (values :not-available nil))
+              (t
+               (values arglist provided-args))))))))
 
 (defun arglist-path-to-parameter (arglist provided-args)
   "Returns a path to the arglist parameter that the last argument in
@@ -1223,17 +1251,21 @@
          (provided-arg (apply #'provided-arguments-ref provided-args arglist path)))
     (nconc path (list (compute-arglist-index argl provided-arg)))))
 
-
 (defun arglist-path-to-nested-arglist (arglist provided-args)
   "Returns a path to the (nested) arglist that still contains the last
 argument in PROVIDED-ARGS."
+  (multiple-value-bind (last-arg last-provd-arg idx)
+      (last-arg arglist provided-args)
+    (if (and (arglist-p last-arg) (listp last-provd-arg))
+        (cons idx (arglist-path-to-nested-arglist last-arg last-provd-arg))
+        nil)))
+
+(defun last-arg (arglist provided-args)
   (let ((idx (compute-arglist-index arglist provided-args)))
     (when idx
-      (let ((arg (arglist-ref arglist idx))
-            (provided-arg (provided-arguments-ref provided-args arglist idx)))
-        (if (and (arglist-p arg) (listp provided-arg))
-            (cons idx (arglist-path-to-nested-arglist arg provided-arg))
-            nil)))))
+      (values (arglist-ref arglist idx)
+              (provided-arguments-ref provided-args arglist idx)
+              idx))))
 
 (defun compute-arglist-index (arglist provided-args)
   "Returns the index of ARGLIST pertaining to the last argument in




From mevenson at common-lisp.net  Thu Nov 26 07:06:50 2009
From: mevenson at common-lisp.net (CVS User mevenson)
Date: Thu, 26 Nov 2009 02:06:50 -0500
Subject: [slime-cvs] CVS slime
Message-ID: <E1NDYRG-0005wE-PH@common-lisp.net>

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

Modified Files:
	ChangeLog swank-abcl.lisp 
Log Message:
swank-abcl.lisp (arglist):  Fixes for functions with non-nil
arglist and for generic functions with empty argument lists.

Contributed by Matthias.



--- /project/slime/cvsroot/slime/ChangeLog	2009/11/23 19:54:55	1.1920
+++ /project/slime/cvsroot/slime/ChangeLog	2009/11/26 07:06:50	1.1921
@@ -1,3 +1,10 @@
+2009-11-26  Mark Evenson  <evenson at panix.com>>
+
+	* swank-abcl.lisp (arglist):  Fixes for functions with non-nil
+	arglist and for generic functions with empty argument lists.
+
+	Contributed by Matthias.
+
 2009-11-23  Stas Boukarev  <stassats at gmail.com>
 
 	* slime.el (slime-set-connection-info): Set slime-current-thread to t
--- /project/slime/cvsroot/slime/swank-abcl.lisp	2009/11/02 09:20:33	1.76
+++ /project/slime/cvsroot/slime/swank-abcl.lisp	2009/11/26 07:06:50	1.77
@@ -229,13 +229,16 @@
 
 (defimplementation arglist (fun)
   (cond ((symbolp fun)
-         (multiple-value-bind (arglist present) 
-             (or (sys::arglist fun)
-                 (and (fboundp fun)
-                      (typep (symbol-function fun) 'standard-generic-function)
-                      (let ((it (mop::generic-function-lambda-list (symbol-function fun))))
-                        (values it it))))
-           (if present arglist :not-available)))
+          (multiple-value-bind (arglist present) 
+              (sys::arglist fun)
+            (when (and (not present)
+                       (fboundp fun)
+                       (typep (symbol-function fun) 'standard-generic-function))
+              (setq arglist
+                    (mop::generic-function-lambda-list (symbol-function fun))
+                    present
+                    t))
+            (if present arglist :not-available)))
         (t :not-available)))
 
 (defimplementation function-name (function)




From mevenson at common-lisp.net  Thu Nov 26 10:58:08 2009
From: mevenson at common-lisp.net (CVS User mevenson)
Date: Thu, 26 Nov 2009 05:58:08 -0500
Subject: [slime-cvs] CVS slime
Message-ID: <E1NDc36-0004Mo-If@common-lisp.net>

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

Modified Files:
	ChangeLog 
Log Message:
Correctly attribute contribution.


--- /project/slime/cvsroot/slime/ChangeLog	2009/11/26 07:06:50	1.1921
+++ /project/slime/cvsroot/slime/ChangeLog	2009/11/26 10:58:08	1.1922
@@ -3,7 +3,7 @@
 	* swank-abcl.lisp (arglist):  Fixes for functions with non-nil
 	arglist and for generic functions with empty argument lists.
 
-	Contributed by Matthias.
+	Diagnosed and cured by Matthias H?lzl.
 
 2009-11-23  Stas Boukarev  <stassats at gmail.com>
 




From heller at common-lisp.net  Mon Nov 30 14:47:18 2009
From: heller at common-lisp.net (CVS User heller)
Date: Mon, 30 Nov 2009 09:47:18 -0500
Subject: [slime-cvs] CVS slime
Message-ID: <E1NF7X4-0007IG-Im@common-lisp.net>

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

Modified Files:
	ChangeLog slime.el 
Log Message:
Add a slime-editing-map as suggested by Attila Lendvai.  The main
purpose it's to create a keymap that's shared by the REPL and
other modes so that adding custom bindings get's a bit easier.

* slime.el (slime-editing-map, slime-mode-indirect-map): New variables.
(slime-init-keymaps): Clear out any existing bindings before
building the new keymaps.
(slime-init-keymap): New helper.
(slime-bind-keys): Renamed&extended from
slime-define-both-key-bindings.

--- /project/slime/cvsroot/slime/ChangeLog	2009/11/26 10:58:08	1.1922
+++ /project/slime/cvsroot/slime/ChangeLog	2009/11/30 14:47:18	1.1923
@@ -1,3 +1,16 @@
+2009-11-30  Helmut Eller  <heller at common-lisp.net>
+
+	Add a slime-editing-map as suggested by Attila Lendvai.  The main
+	purpose it's to create a keymap that's shared by the REPL and
+	other modes so that adding custom bindings get's a bit easier.
+
+	* slime.el (slime-editing-map, slime-mode-indirect-map): New variables.
+	(slime-init-keymaps): Clear out any existing bindings before
+	building the new keymaps.
+	(slime-init-keymap): New helper.
+	(slime-bind-keys): Renamed&extended from
+	slime-define-both-key-bindings.
+
 2009-11-26  Mark Evenson  <evenson at panix.com>>
 
 	* swank-abcl.lisp (arglist):  Fixes for functions with non-nil
--- /project/slime/cvsroot/slime/slime.el	2009/11/23 19:54:56	1.1251
+++ /project/slime/cvsroot/slime/slime.el	2009/11/30 14:47:18	1.1252
@@ -375,6 +375,11 @@
 
 ;;;;; slime-mode
 
+(defvar slime-mode-indirect-map (make-sparse-keymap)
+  "Empty keymap which has `slime-mode-map' as it's parent.
+This is a hack so that we can reinitilize the real slime-mode-map
+more easily. See `slime-init-keymaps'.")
+
 (define-minor-mode slime-mode
   "\\<slime-mode-map>\
 SLIME: The Superior Lisp Interaction Mode for Emacs (minor-mode).
@@ -408,8 +413,7 @@
 \\{slime-mode-map}"
   nil
   nil
-  ;; Fake binding to coax `define-minor-mode' to create the keymap
-  '((" " 'undefined))
+  slime-mode-indirect-map
   (slime-setup-command-hooks)
   (slime-recompute-modelines))
 
@@ -473,7 +477,7 @@
 
 ;;;;; Key bindings
 
-(defvar slime-parent-map (make-sparse-keymap)
+(defvar slime-parent-map nil
   "Parent keymap for shared between all Slime related modes.")
 
 (defvar slime-parent-bindings
@@ -488,7 +492,7 @@
     ;; Include PREFIX keys...
     ("\C-c"	 slime-prefix-map)))
 
-(defvar slime-prefix-map (make-sparse-keymap)
+(defvar slime-prefix-map nil
   "Keymap for commands prefixed with `slime-prefix-key'.")
 
 (defvar slime-prefix-bindings
@@ -511,8 +515,10 @@
     ("\C-w"  slime-who-map)
     ))
 
-;;; These keys are useful for buffers where the user can insert and
-;;; edit s-exprs, e.g. for source buffers and the REPL.
+(defvar slime-editing-map nil
+  "These keys are useful for buffers where the user can insert and
+edit s-exprs, e.g. for source buffers and the REPL.")
+
 (defvar slime-editing-keys
   `(;; Arglist display & completion
     ("\M-\t"      slime-complete-symbol)
@@ -532,23 +538,24 @@
     ;;("\M-*" pop-tag-mark) ; almost to clever
     ))
 
+(defvar slime-mode-map nil
+  "Keymap for slime-mode.")
+
 (defvar slime-keys
-  (append slime-editing-keys
-          '( ;; Compiler notes
-            ("\M-p"       slime-previous-note)
-            ("\M-n"       slime-next-note)
-            ("\C-c\M-c"   slime-remove-notes)
-            ("\C-c\C-k"   slime-compile-and-load-file)
-            ("\C-c\M-k"   slime-compile-file)
-            ("\C-c\C-c"   slime-compile-defun)
-            )))
+  '( ;; Compiler notes
+    ("\M-p"       slime-previous-note)
+    ("\M-n"       slime-next-note)
+    ("\C-c\M-c"   slime-remove-notes)
+    ("\C-c\C-k"   slime-compile-and-load-file)
+    ("\C-c\M-k"   slime-compile-file)
+    ("\C-c\C-c"   slime-compile-defun)))
 
 (defun slime-nop ()
   "The null command. Used to shadow currently-unused keybindings."
   (interactive)
   (call-interactively 'undefined))
 
-(defvar slime-doc-map (make-sparse-keymap)
+(defvar slime-doc-map nil
   "Keymap for documentation commands. Bound to a prefix key.")
 
 (defvar slime-doc-bindings
@@ -561,7 +568,7 @@
     (?~ common-lisp-hyperspec-format)
     (?# common-lisp-hyperspec-lookup-reader-macro)))
   
-(defvar slime-who-map (make-sparse-keymap)
+(defvar slime-who-map nil
   "Keymap for who-xref commands. Bound to a prefix key.")
 
 (defvar slime-who-bindings
@@ -576,31 +583,30 @@
 (defun slime-init-keymaps ()
   "(Re)initialize the keymaps for `slime-mode'."
   (interactive)
-  ;; Documentation
-  (define-prefix-command 'slime-doc-map)
-  (slime-define-both-key-bindings slime-doc-map slime-doc-bindings)
-  ;; Who-xref
-  (define-prefix-command 'slime-who-map)
-  (slime-define-both-key-bindings slime-who-map slime-who-bindings)
-  ;; Prefix map
-  (define-prefix-command 'slime-prefix-map)
-  (loop for (key binding) in slime-prefix-bindings
-        do (define-key slime-prefix-map key binding))
-  ;; Parent map
-  (setq slime-parent-map (make-sparse-keymap))
-  (loop for (key binding) in slime-parent-bindings
-        do (define-key slime-parent-map key binding))
-  ;; Slime mode map
-  (set-keymap-parent slime-mode-map slime-parent-map)
-  (loop for (key command) in slime-keys
-        do (define-key slime-mode-map key command)))
-
-(defun slime-define-both-key-bindings (keymap bindings)
-  "Add BINDINGS to KEYMAP, both unmodified and with control."
-  (loop for (char command) in bindings do
-        (define-key keymap `[,char] command)
-        (unless (equal char ?h)     ; But don't bind C-h
-          (define-key keymap `[(control ,char)] command))))
+  (slime-init-keymap 'slime-doc-map t t slime-doc-bindings)
+  (slime-init-keymap 'slime-who-map t t slime-who-bindings)
+  (slime-init-keymap 'slime-prefix-map t nil slime-prefix-bindings)
+  (slime-init-keymap 'slime-parent-map nil nil slime-parent-bindings)
+  (slime-init-keymap 'slime-editing-map nil nil slime-editing-keys)
+  (set-keymap-parent slime-editing-map slime-parent-map)
+  (slime-init-keymap 'slime-mode-map nil nil slime-keys)
+  (set-keymap-parent slime-mode-map slime-editing-map)
+  (set-keymap-parent slime-mode-indirect-map slime-mode-map))
+
+(defun slime-init-keymap (keymap-name prefixp bothp bindings)
+  (set keymap-name (make-sparse-keymap))
+  (when prefixp (define-prefix-command keymap-name))
+  (slime-bind-keys (eval keymap-name) bothp bindings))
+
+(defun slime-bind-keys (keymap bothp bindings)
+  "Add BINDINGS to KEYMAP.
+If BOTHP is true also add bindings with control modifier."
+  (loop for (key command) in bindings do
+        (cond (bothp
+               (define-key keymap `[,key] command)
+               (unless (equal key ?h)     ; But don't bind C-h
+                 (define-key keymap `[(control ,key)] command)))
+              (t (define-key keymap key command)))))
 
 (slime-init-keymaps)
 




From heller at common-lisp.net  Mon Nov 30 14:47:23 2009
From: heller at common-lisp.net (CVS User heller)
Date: Mon, 30 Nov 2009 09:47:23 -0500
Subject: [slime-cvs] CVS slime/contrib
Message-ID: <E1NF7X9-0007Ip-JG@common-lisp.net>

Update of /project/slime/cvsroot/slime/contrib
In directory cl-net:/tmp/cvs-serv28062/contrib

Modified Files:
	ChangeLog slime-presentations.el 
Log Message:
* slime-presentations.el (slime-presentation-init-keymaps):
Replace slime-define-both-key-bindings with slime-bind-keys.

--- /project/slime/cvsroot/slime/contrib/ChangeLog	2009/11/24 13:17:00	1.287
+++ /project/slime/cvsroot/slime/contrib/ChangeLog	2009/11/30 14:47:23	1.288
@@ -1,3 +1,8 @@
+2009-11-30  Helmut Eller  <heller at common-lisp.net>
+
+	* slime-presentations.el (slime-presentation-init-keymaps):
+	Replace slime-define-both-key-bindings with slime-bind-keys.
+
 2009-11-24  Tobias C. Rittweiler  <tcr at freebits.de>
 
 	Fix a few edge cases in new arglist code.
--- /project/slime/cvsroot/slime/contrib/slime-presentations.el	2009/02/27 18:07:14	1.23
+++ /project/slime/cvsroot/slime/contrib/slime-presentations.el	2009/11/30 14:47:23	1.24
@@ -694,8 +694,7 @@
 
 (defun slime-presentation-init-keymaps ()
   (setq slime-presentation-command-map (make-sparse-keymap))
-  (slime-define-both-key-bindings slime-presentation-command-map 
-				  slime-presentation-bindings)
+  (slime-bind-keys slime-presentation-command-map t slime-presentation-bindings)
   (define-key slime-presentation-command-map "\M-o" 'slime-clear-presentations)
   ;; C-c C-v is the prefix for the presentation-command map.
   (define-key slime-prefix-map "\C-v" slime-presentation-command-map))




From heller at common-lisp.net  Mon Nov 30 14:47:28 2009
From: heller at common-lisp.net (CVS User heller)
Date: Mon, 30 Nov 2009 09:47:28 -0500
Subject: [slime-cvs] CVS slime/contrib
Message-ID: <E1NF7XE-0007JV-Jj@common-lisp.net>

Update of /project/slime/cvsroot/slime/contrib
In directory cl-net:/tmp/cvs-serv28110/contrib

Modified Files:
	ChangeLog slime-presentations.el 
Log Message:
* slime-presentations.el (slime-presentation-init-keymaps): Use
  slime-init-keymap.

--- /project/slime/cvsroot/slime/contrib/ChangeLog	2009/11/30 14:47:23	1.288
+++ /project/slime/cvsroot/slime/contrib/ChangeLog	2009/11/30 14:47:28	1.289
@@ -2,6 +2,7 @@
 
 	* slime-presentations.el (slime-presentation-init-keymaps):
 	Replace slime-define-both-key-bindings with slime-bind-keys.
+	(slime-presentation-init-keymaps): Use slime-init-keymap.
 
 2009-11-24  Tobias C. Rittweiler  <tcr at freebits.de>
 
--- /project/slime/cvsroot/slime/contrib/slime-presentations.el	2009/11/30 14:47:23	1.24
+++ /project/slime/cvsroot/slime/contrib/slime-presentations.el	2009/11/30 14:47:28	1.25
@@ -680,7 +680,7 @@
 
 ;;; Presentation-related key bindings, non-context menu
 
-(defvar slime-presentation-command-map (make-sparse-keymap)
+(defvar slime-presentation-command-map nil
   "Keymap for presentation-related commands. Bound to a prefix key.")
 
 (defvar slime-presentation-bindings
@@ -693,8 +693,8 @@
     (?\  slime-mark-presentation)))
 
 (defun slime-presentation-init-keymaps ()
-  (setq slime-presentation-command-map (make-sparse-keymap))
-  (slime-bind-keys slime-presentation-command-map t slime-presentation-bindings)
+  (slime-init-keymap 'slime-presentation-command-map nil t 
+		     slime-presentation-bindings)
   (define-key slime-presentation-command-map "\M-o" 'slime-clear-presentations)
   ;; C-c C-v is the prefix for the presentation-command map.
   (define-key slime-prefix-map "\C-v" slime-presentation-command-map))




From heller at common-lisp.net  Mon Nov 30 14:47:39 2009
From: heller at common-lisp.net (CVS User heller)
Date: Mon, 30 Nov 2009 09:47:39 -0500
Subject: [slime-cvs] CVS slime
Message-ID: <E1NF7XP-0007KV-4A@common-lisp.net>

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

Modified Files:
	ChangeLog slime.el 
Log Message:
* slime.el (slime-editing-mode): New minor mode for use in the REPL.

* slime-repl.el (slime-repl-mode-map): Don't copy
slime-parent-map.  Instead ...
(slime-repl-mode): ... enable slime-editing-mode.

--- /project/slime/cvsroot/slime/ChangeLog	2009/11/30 14:47:18	1.1923
+++ /project/slime/cvsroot/slime/ChangeLog	2009/11/30 14:47:38	1.1924
@@ -11,6 +11,9 @@
 	(slime-bind-keys): Renamed&extended from
 	slime-define-both-key-bindings.
 
+	* slime.el (slime-editing-mode): New minor mode for use
+	in the REPL.
+
 2009-11-26  Mark Evenson  <evenson at panix.com>>
 
 	* swank-abcl.lisp (arglist):  Fixes for functions with non-nil
--- /project/slime/cvsroot/slime/slime.el	2009/11/30 14:47:18	1.1252
+++ /project/slime/cvsroot/slime/slime.el	2009/11/30 14:47:39	1.1253
@@ -610,6 +610,13 @@
 
 (slime-init-keymaps)
 
+(define-minor-mode slime-editing-mode
+  "Minor mode which makes slime-editing-map available.
+\\{slime-editing-map}"
+  nil
+  nil
+  slime-editing-map)
+
 
 ;;;; Setup initial `slime-mode' hooks
 




From heller at common-lisp.net  Mon Nov 30 14:47:41 2009
From: heller at common-lisp.net (CVS User heller)
Date: Mon, 30 Nov 2009 09:47:41 -0500
Subject: [slime-cvs] CVS slime/contrib
Message-ID: <E1NF7XQ-0007Ko-S0@common-lisp.net>

Update of /project/slime/cvsroot/slime/contrib
In directory cl-net:/tmp/cvs-serv28159/contrib

Modified Files:
	ChangeLog slime-repl.el 
Log Message:
* slime.el (slime-editing-mode): New minor mode for use in the REPL.

* slime-repl.el (slime-repl-mode-map): Don't copy
slime-parent-map.  Instead ...
(slime-repl-mode): ... enable slime-editing-mode.

--- /project/slime/cvsroot/slime/contrib/ChangeLog	2009/11/30 14:47:28	1.289
+++ /project/slime/cvsroot/slime/contrib/ChangeLog	2009/11/30 14:47:40	1.290
@@ -1,5 +1,9 @@
 2009-11-30  Helmut Eller  <heller at common-lisp.net>
 
+	* slime-repl.el (slime-repl-mode-map): Don't copy
+	slime-parent-map.  Instead ...
+	(slime-repl-mode): ... enable slime-editing-mode.
+
 	* slime-presentations.el (slime-presentation-init-keymaps):
 	Replace slime-define-both-key-bindings with slime-bind-keys.
 	(slime-presentation-init-keymaps): Use slime-init-keymap.
--- /project/slime/cvsroot/slime/contrib/slime-repl.el	2009/11/23 12:25:42	1.32
+++ /project/slime/cvsroot/slime/contrib/slime-repl.el	2009/11/30 14:47:40	1.33
@@ -411,14 +411,10 @@
 
 ;;;;; REPL mode setup
 
-(defvar slime-repl-mode-map)
-
-(let ((map (copy-keymap slime-parent-map)))
-  (set-keymap-parent map lisp-mode-map)
-  (setq slime-repl-mode-map (make-sparse-keymap))
-  (set-keymap-parent slime-repl-mode-map map)
-  (loop for (key command) in slime-editing-keys
-        do (define-key slime-repl-mode-map key command)))
+(defvar slime-repl-mode-map
+  (let ((map (make-sparse-keymap)))
+    (set-keymap-parent map lisp-mode-map)
+    map))
 
 (slime-define-keys slime-prefix-map
   ("\C-z" 'slime-switch-to-output-buffer)
@@ -493,6 +489,7 @@
        'slime-repl-mode-beginning-of-defun)
   (set (make-local-variable 'end-of-defun-function) 
        'slime-repl-mode-end-of-defun)
+  (slime-editing-mode 1)
   (slime-run-mode-hooks 'slime-repl-mode-hook))
 
 (defun slime-repl-buffer (&optional create connection)




From heller at common-lisp.net  Mon Nov 30 14:47:49 2009
From: heller at common-lisp.net (CVS User heller)
Date: Mon, 30 Nov 2009 09:47:49 -0500
Subject: [slime-cvs] CVS slime
Message-ID: <E1NF7XZ-0007Ll-G3@common-lisp.net>

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

Modified Files:
	ChangeLog 
Log Message:
*** empty log message ***

--- /project/slime/cvsroot/slime/ChangeLog	2009/11/30 14:47:38	1.1924
+++ /project/slime/cvsroot/slime/ChangeLog	2009/11/30 14:47:49	1.1925
@@ -1,8 +1,8 @@
 2009-11-30  Helmut Eller  <heller at common-lisp.net>
 
 	Add a slime-editing-map as suggested by Attila Lendvai.  The main
-	purpose it's to create a keymap that's shared by the REPL and
-	other modes so that adding custom bindings get's a bit easier.
+	purpose is to create a keymap that's shared by the REPL and other
+	modes so that adding custom bindings gets a bit easier.
 
 	* slime.el (slime-editing-map, slime-mode-indirect-map): New variables.
 	(slime-init-keymaps): Clear out any existing bindings before
@@ -14,7 +14,7 @@
 	* slime.el (slime-editing-mode): New minor mode for use
 	in the REPL.
 
-2009-11-26  Mark Evenson  <evenson at panix.com>>
+2009-11-26  Mark Evenson  <evenson at panix.com>
 
 	* swank-abcl.lisp (arglist):  Fixes for functions with non-nil
 	arglist and for generic functions with empty argument lists.