From heller at common-lisp.net  Thu Jan  1 14:48:05 2009
From: heller at common-lisp.net (CVS User heller)
Date: Thu, 01 Jan 2009 14:48:05 +0000
Subject: [slime-cvs] CVS slime
Message-ID: <E1LIOqD-0006Vz-KO@common-lisp.net>

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

Modified Files:
	ChangeLog slime.el swank.lisp 
Log Message:
* swank.lisp (sleep-for): New function
* slime.el ([test] break): Use SWANK::SLEEP-FOR to help CCL pass
this test.
([test] arglist): Update arglist of
swank::compile-string-for-emacs.
([rest] find-definition.2): Allow some whitespace before the actual
position.  Otherwise, CCL would fail on this test.

--- /project/slime/cvsroot/slime/ChangeLog	2008/12/31 11:25:46	1.1615
+++ /project/slime/cvsroot/slime/ChangeLog	2009/01/01 14:48:04	1.1616
@@ -1,3 +1,13 @@
+2009-01-01  Helmut Eller  <heller at common-lisp.net>
+
+	* swank.lisp (sleep-for): New function
+	* slime.el ([test] break): Use SWANK::SLEEP-FOR to help CCL pass
+	this test.
+	([test] arglist): Update arglist of
+	swank::compile-string-for-emacs.
+	([rest] find-definition.2): Allow some whitespace before the actual
+	position.  Otherwise, CCL would fail on this test.
+
 2008-12-31  Helmut Eller  <heller at common-lisp.net>
 
 	* swank.lisp (maybe-redirect-global-io): Don't consider
--- /project/slime/cvsroot/slime/slime.el	2008/12/31 11:25:19	1.1086
+++ /project/slime/cvsroot/slime/slime.el	2009/01/01 14:48:04	1.1087
@@ -7436,7 +7436,7 @@
            (= orig-pos (point)))))
     (slime-check-top-level))
 
-(def-slime-test (find-definition.2 ("ccl" "allegro" "lispworks"))
+(def-slime-test (find-definition.2 ("allegro" "lispworks"))
     (buffer-content buffer-package snippet)
     "Check that we're able to find definitions even when
 confronted with nasty #.-fu."
@@ -7448,7 +7448,7 @@
        #.(prog1 nil (makunbound '*foobar*))
        "
        "SWANK"
-       "(defun .foo. "
+       "[ \t]*(defun .foo. "
        ))
   (let ((slime-buffer-package buffer-package))
     (with-temp-buffer
@@ -7498,7 +7498,7 @@
       ("swank::create-socket" "(swank::create-socket host port)")
       ("swank::emacs-connected" "(swank::emacs-connected )")
       ("swank::compile-string-for-emacs"
-       "(swank::compile-string-for-emacs string buffer position directory debug)")
+       "(swank::compile-string-for-emacs string buffer position directory policy)")
       ("swank::connection.socket-io"
        "(swank::connection.socket-io \\(struct\\(ure\\)?\\|object\\|instance\\|x\\))")
       ("cl:lisp-implementation-type" "(cl:lisp-implementation-type )")
@@ -7809,7 +7809,9 @@
   (slime-check-top-level)
   (slime-eval-async 
    `(cl:eval (cl:read-from-string 
-              ,(prin1-to-string `(dotimes (i ,times) ,exp (sleep 0.2))))))
+              ,(prin1-to-string `(dotimes (i ,times) 
+                                   ,exp 
+                                   (swank::sleep-for 0.2))))))
   (dotimes (i times)
     (slime-wait-condition "Debugger visible" 
                           (lambda () 
--- /project/slime/cvsroot/slime/swank.lisp	2008/12/31 11:25:39	1.620
+++ /project/slime/cvsroot/slime/swank.lisp	2009/01/01 14:48:04	1.621
@@ -2204,6 +2204,20 @@
     (send-to-emacs `(:background-message 
                      ,(apply #'format nil format-string args)))))
 
+;; This is only used by the test suite.
+(defun sleep-for (seconds)
+  "Sleep at least SECONDS seconds.
+This is just like sleep but guarantees to sleep
+at least SECONDS."
+  (let* ((start (get-internal-real-time))
+         (end (+ start
+                 (* seconds internal-time-units-per-second))))
+    (loop
+     (let ((now (get-internal-real-time)))
+       (cond ((< end now) (return))
+             (t (sleep (/ (- end now)
+                          internal-time-units-per-second))))))))
+
 
 ;;;; Debugger
 




From heller at common-lisp.net  Thu Jan  1 14:48:13 2009
From: heller at common-lisp.net (CVS User heller)
Date: Thu, 01 Jan 2009 14:48:13 +0000
Subject: [slime-cvs] CVS slime
Message-ID: <E1LIOqL-0006Wn-5Q@common-lisp.net>

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

Modified Files:
	ChangeLog swank-openmcl.lisp 
Log Message:
For buffers without filename, map the name of the tempfile back to
the buffer name.

* swank-openmcl.lisp (*temp-file-map*): New variable.
(note-temp-file): New function.
(compile-temp-file, source-note-to-source-location): Use it.

--- /project/slime/cvsroot/slime/ChangeLog	2009/01/01 14:48:04	1.1616
+++ /project/slime/cvsroot/slime/ChangeLog	2009/01/01 14:48:13	1.1617
@@ -1,5 +1,14 @@
 2009-01-01  Helmut Eller  <heller at common-lisp.net>
 
+	For buffers without filename, map the name of the tempfile back to
+	the buffer name.
+
+	* swank-openmcl.lisp (*temp-file-map*): New variable.
+	(note-temp-file): New function.
+	(compile-temp-file, source-note-to-source-location): Use it.
+
+2009-01-01  Helmut Eller  <heller at common-lisp.net>
+
 	* swank.lisp (sleep-for): New function
 	* slime.el ([test] break): Use SWANK::SLEEP-FOR to help CCL pass
 	this test.
--- /project/slime/cvsroot/slime/swank-openmcl.lisp	2008/12/31 11:25:30	1.150
+++ /project/slime/cvsroot/slime/swank-openmcl.lisp	2009/01/01 14:48:13	1.151
@@ -379,19 +379,28 @@
            (with-open-file (s filename :direction :output :if-exists :error)
              (write-string string s))
         (let ((binary-filename (compile-temp-file
-                                filename
-                                (if directory
-                                    (format nil "~a/~a" directory buffer))
-                                (1- position))))
+                                filename directory buffer position)))
           (delete-file binary-filename)))
       (delete-file filename))))
 
-(defun compile-temp-file (filename orig-file orig-offset)
+(defvar *temp-file-map* (make-hash-table :test #'equal)
+  "A mapping from tempfile names to Emacs buffer names.")
+
+(defun note-temp-file (filename directory buffer)
+  (cond (directory
+         (format nil "~a/~a" directory buffer))
+        (t
+         (setf (gethash filename *temp-file-map*) buffer)
+         filename)))
+
+(defun compile-temp-file (filename dir buffer offset)
   (if (fboundp 'ccl::function-source-note)
       (compile-file filename
                     :load t
-                    :compile-file-original-truename orig-file
-                    :compile-file-original-buffer-offset orig-offset)
+                    :compile-file-original-truename (note-temp-file filename 
+                                                                    dir
+                                                                    buffer)
+                    :compile-file-original-buffer-offset (1- offset))
       (compile-file filename :load t)))
 
 ;;; Profiling (alanr: lifted from swank-clisp)
@@ -721,15 +730,19 @@
        (format nil "No source note at PC: ~A:#x~x" function pc))))
 
   (defun source-note-to-source-location (note if-nil-thunk)
-    (cond (note
-           (handler-case
-               (let* ((file (ccl:source-note-filename note))
-                      (file (namestring (truename file))))
-                 (make-location
-                  (list :file file)
-                  (list :position (1+ (ccl:source-note-start-pos note)))))
-             (error (c) `(:error ,(princ-to-string c)))))
-          (t `(:error ,(funcall if-nil-thunk)))))
+    (labels ((filename-to-buffer (filename)
+               (cond ((probe-file filename)
+                      (list :file (namestring (truename filename))))
+                     ((gethash filename *temp-file-map*)
+                      (list :buffer (gethash filename *temp-file-map*)))
+                     (t (error "File ~s doesn't exist" filename)))))
+      (cond (note
+             (handler-case
+                 (make-location 
+                  (filename-to-buffer (ccl:source-note-filename note))
+                  (list :position (1+ (ccl:source-note-start-pos note))))
+               (error (c) `(:error ,(princ-to-string c)))))
+          (t `(:error ,(funcall if-nil-thunk))))))
 
   (defimplementation find-definitions (symbol)
     (loop for (loc . name) in (source-locations symbol)




From heller at common-lisp.net  Thu Jan  1 14:48:23 2009
From: heller at common-lisp.net (CVS User heller)
Date: Thu, 01 Jan 2009 14:48:23 +0000
Subject: [slime-cvs] CVS slime
Message-ID: <E1LIOqU-0006Xc-Rl@common-lisp.net>

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

Modified Files:
	ChangeLog swank-openmcl.lisp 
Log Message:
* swank-openmcl.lisp (frame-source-location-for-emacs)
(pc-source-location): Fall back to the source-note of the function
if there is no source-note for a pc offset.

--- /project/slime/cvsroot/slime/ChangeLog	2009/01/01 14:48:13	1.1617
+++ /project/slime/cvsroot/slime/ChangeLog	2009/01/01 14:48:22	1.1618
@@ -1,5 +1,11 @@
 2009-01-01  Helmut Eller  <heller at common-lisp.net>
 
+	* swank-openmcl.lisp (frame-source-location-for-emacs)
+	(pc-source-location): Fall back to the source-note of the function
+	if there is no source-note for a pc offset.
+
+2009-01-01  Helmut Eller  <heller at common-lisp.net>
+
 	For buffers without filename, map the name of the tempfile back to
 	the buffer name.
 
--- /project/slime/cvsroot/slime/swank-openmcl.lisp	2009/01/01 14:48:13	1.151
+++ /project/slime/cvsroot/slime/swank-openmcl.lisp	2009/01/01 14:48:22	1.152
@@ -725,7 +725,8 @@
 
   (defun pc-source-location (function pc)
     (source-note-to-source-location
-     (ccl:find-source-note-at-pc function pc)
+     (or (ccl:find-source-note-at-pc function pc)
+         (ccl:function-source-note function))
      (lambda ()
        (format nil "No source note at PC: ~A:#x~x" function pc))))
 
@@ -789,7 +790,9 @@
        (declare (ignore p context))
        (when (and (= frame-number index) lfun)
          (return-from frame-source-location-for-emacs
-           (pc-source-location lfun pc)))))))
+           (if pc
+               (pc-source-location lfun pc)
+               (function-source-location lfun))))))))
 
 (defimplementation eval-in-frame (form index)
   (block eval-in-frame




From trittweiler at common-lisp.net  Thu Jan  1 15:54:30 2009
From: trittweiler at common-lisp.net (CVS User trittweiler)
Date: Thu, 01 Jan 2009 15:54:30 +0000
Subject: [slime-cvs] CVS slime/contrib
Message-ID: <E1LIPsU-0001D9-Ux@common-lisp.net>

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

Modified Files:
	slime-autodoc.el ChangeLog 
Log Message:
	* slime-autodoc.el: Autodoc is now implemented on top of ElDoc.
	(Suggested by Madhu.)


--- /project/slime/cvsroot/slime/contrib/slime-autodoc.el	2008/09/07 12:44:11	1.10
+++ /project/slime/cvsroot/slime/contrib/slime-autodoc.el	2009/01/01 15:54:30	1.11
@@ -19,26 +19,21 @@
 (require 'slime-parse)
 (require 'slime-enclosing-context)
 
-(defvar slime-use-autodoc-mode t
+(defcustom slime-use-autodoc-mode t
   "When non-nil always enable slime-autodoc-mode in slime-mode.")
 
-(defun slime-fontify-string (string)
-  "Fontify STRING as `font-lock-mode' does in Lisp mode."
-  (with-current-buffer (get-buffer-create " *slime-fontify*")
-    (erase-buffer)
-    (if (not (eq major-mode 'lisp-mode))
-        (lisp-mode))
-    (insert string)
-    (let ((font-lock-verbose nil))
-      (font-lock-fontify-buffer))
-    (goto-char (point-min))
-    (when (re-search-forward "===> \\(\\(.\\|\n\\)*\\) <===" nil t)
-      (let ((highlight (match-string 1)))
-        ;; Can't use (replace-match highlight) here -- broken in Emacs 21
-        (delete-region (match-beginning 0) (match-end 0))
-	(slime-insert-propertized '(face highlight) highlight)))
-    (buffer-substring (point-min) (point-max))))
+(defcustom slime-autodoc-use-multiline-p nil
+  "If non-nil, allow long autodoc messages to resize echo area display."
+  :type 'boolean
+  :group 'slime-ui)
+
+(defcustom slime-autodoc-delay 0.2
+  "*Delay before autodoc messages are fetched and displayed, in seconds."
+  :type 'number
+  :group 'slime-ui)
 
+
+;;; FIXME: unused?
 (defun slime-arglist (name)
   "Show the argument list for NAME."
   (interactive (list (slime-read-symbol-name "Arglist of: ")))
@@ -49,98 +44,9 @@
          (message "%s" (slime-fontify-string arglist))
        (error "Arglist not available")))))
 
-
 
 ;;;; Autodocs (automatic context-sensitive help)
 
-(defvar slime-autodoc-mode nil
-  "*When non-nil, print documentation about symbols as the point moves.")
-
-(defvar slime-autodoc-cache-type 'last
-  "*Cache policy for automatically fetched documentation.
-Possible values are:
- nil  - none.
- last - cache only the most recently-looked-at symbol's documentation.
-        The values are stored in the variable `slime-autodoc-cache'.
-
-More caching means fewer calls to the Lisp process, but at the risk of
-using outdated information.")
-
-(defvar slime-autodoc-cache nil
-  "Cache variable for when `slime-autodoc-cache-type' is 'last'.
-The value is (SYMBOL-NAME . DOCUMENTATION).")
-
-(defun slime-autodoc-mode (&optional arg)
-  "Enable `slime-autodoc'."
-  (interactive "P")
-  (cond ((< (prefix-numeric-value arg) 0) (setq slime-autodoc-mode nil))
-        (arg (setq slime-autodoc-mode t))
-        (t (setq slime-autodoc-mode (not slime-autodoc-mode))))
-  (if slime-autodoc-mode
-      (progn 
-        (slime-autodoc-start-timer)
-        (add-hook 'pre-command-hook 
-                  'slime-autodoc-pre-command-refresh-echo-area t))
-    (slime-autodoc-stop-timer)))
-
-(defvar slime-autodoc-last-message "")
-
-(defun slime-autodoc ()
-  "Print some apropos information about the code at point, if applicable."
-  (destructuring-bind (cache-key retrieve-form) (slime-autodoc-thing-at-point)
-    (let ((cached (slime-get-cached-autodoc cache-key)))
-      (if cached
-	  (slime-autodoc-message cached)
-        ;; Asynchronously fetch, cache, and display documentation
-        (slime-eval-async 
-         retrieve-form
-         (slime-rcurry 
-	  (lambda (doc cache-key)
-	    (let ((doc (if doc (slime-fontify-string doc) "")))
-	      (slime-update-autodoc-cache cache-key doc)
-	      (slime-autodoc-message doc)))
-	  cache-key))))))
-
-(defcustom slime-autodoc-use-multiline-p nil
-  "If non-nil, allow long autodoc messages to resize echo area display."
-  :type 'boolean
-  :group 'slime-ui)
-
-(defvar slime-autodoc-message-function 'slime-autodoc-show-message)
-
-(defun slime-autodoc-message (doc)
-  "Display the autodoc documentation string DOC."
-  (funcall slime-autodoc-message-function doc))
-
-(defun slime-autodoc-show-message (doc)
-  (unless slime-autodoc-use-multiline-p
-    (setq doc (slime-oneliner doc)))
-  (setq slime-autodoc-last-message doc)
-  (message "%s" doc))
-
-(defvar slime-autodoc-dimensions-function nil)
-
-(defun slime-autodoc-message-dimensions ()
-  "Return the available width and height for pretty printing autodoc
-messages."
-  (cond
-   (slime-autodoc-dimensions-function
-    (funcall slime-autodoc-dimensions-function))
-   (slime-autodoc-use-multiline-p 
-    ;; Use the full width of the minibuffer;
-    ;; minibuffer will grow vertically if necessary
-    (values (window-width (minibuffer-window))
-            nil))
-   (t
-    ;; Try to fit everything in one line; we cut off when displaying
-    (values 1000 1))))
-
-(defun slime-autodoc-pre-command-refresh-echo-area ()
-  (unless (string= slime-autodoc-last-message "")
-    (if (slime-autodoc-message-ok-p)
-        (message "%s" slime-autodoc-last-message)
-      (setq slime-autodoc-last-message ""))))
-
 (defun slime-autodoc-thing-at-point ()
   "Return a cache key and a swank form."
   (let ((global (slime-autodoc-global-at-point)))
@@ -201,6 +107,39 @@
       (when-let (pos (position cur-op-name bound-fn-names :test 'equal))
 	(nth pos arglists)))))
 
+(defvar slime-autodoc-dimensions-function nil)
+
+(defun slime-autodoc-message-dimensions ()
+  "Return the available width and height for pretty printing autodoc
+messages."
+  (cond
+   (slime-autodoc-dimensions-function
+    (funcall slime-autodoc-dimensions-function))
+   (slime-autodoc-use-multiline-p 
+    ;; Use the full width of the minibuffer;
+    ;; minibuffer will grow vertically if necessary
+    (values (window-width (minibuffer-window))
+            nil))
+   (t
+    ;; Try to fit everything in one line; we cut off when displaying
+    (values 1000 1))))
+
+
+;;;; Autodoc cache
+
+(defvar slime-autodoc-cache-type 'last
+  "*Cache policy for automatically fetched documentation.
+Possible values are:
+ nil  - none.
+ last - cache only the most recently-looked-at symbol's documentation.
+        The values are stored in the variable `slime-autodoc-cache'.
+
+More caching means fewer calls to the Lisp process, but at the risk of
+using outdated information.")
+
+(defvar slime-autodoc-cache nil
+  "Cache variable for when `slime-autodoc-cache-type' is 'last'.
+The value is (SYMBOL-NAME . DOCUMENTATION).")
 
 (defun slime-get-cached-autodoc (symbol-name)
   "Return the cached autodoc documentation for SYMBOL-NAME, or nil."
@@ -213,7 +152,7 @@
      (when-let (symbol (intern-soft symbol-name))
        (get symbol 'slime-autodoc-cache)))))
 
-(defun slime-update-autodoc-cache (symbol-name documentation)
+(defun slime-store-into-autodoc-cache (symbol-name documentation)
   "Update the autodoc cache for SYMBOL with DOCUMENTATION.
 Return DOCUMENTATION."
   (ecase slime-autodoc-cache-type
@@ -225,61 +164,83 @@
   documentation)
 
 
-;;;;; Asynchronous message idle timer
+;;;; Formatting autodoc
 
-(defvar slime-autodoc-idle-timer nil
-  "Idle timer for the next autodoc message.")
+(defun slime-format-autodoc (doc)
+  (setq doc (slime-fontify-string doc))
+  (unless slime-autodoc-use-multiline-p
+    (setq doc (slime-oneliner doc)))
+  doc)
 
-(defvar slime-autodoc-delay 0.2
-  "*Delay before autodoc messages are fetched and displayed, in seconds.")
+(defun slime-fontify-string (string)
+  "Fontify STRING as `font-lock-mode' does in Lisp mode."
+  (with-current-buffer (get-buffer-create " *slime-fontify*")
+    (erase-buffer)
+    (if (not (eq major-mode 'lisp-mode))
+        (lisp-mode))
+    (insert string)
+    (let ((font-lock-verbose nil))
+      (font-lock-fontify-buffer))
+    (goto-char (point-min))
+    (when (re-search-forward "===> \\(\\(.\\|\n\\)*\\) <===" nil t)
+      (let ((highlight (match-string 1)))
+        ;; Can't use (replace-match highlight) here -- broken in Emacs 21
+        (delete-region (match-beginning 0) (match-end 0))
+	(slime-insert-propertized '(face highlight) highlight)))
+    (buffer-substring (point-min) (point-max))))
+
+
+;;;; slime-autodoc-mode
+
+(defun slime-compute-autodoc ()
+  "Returns the cached arglist information as string, or nil.
+If it's not in the cache, the cache will be updated asynchronously."
+  (multiple-value-bind (cache-key retrieve-form) (slime-autodoc-thing-at-point)
+    (let ((cached (slime-get-cached-autodoc cache-key)))
+      (if cached
+	  cached
+          ;; If nothing is in the cache, we first decline, and fetch
+          ;; the arglist information asynchronously.
+          (prog1 nil
+            (slime-eval-async retrieve-form
+              (lexical-let ((cache-key cache-key)) 
+                (lambda (doc)
+                  (let ((doc (if doc (slime-format-autodoc doc) "")))
+                    ;; Now that we've got our information, get it to
+                    ;; the user ASAP.
+                    (eldoc-message doc)
+                    (slime-store-into-autodoc-cache cache-key doc))))))))))
+
+(make-variable-buffer-local (defvar slime-autodoc-mode nil))
+
+(defun slime-autodoc-mode (&optional arg)
+  (interactive "P")
+  (make-local-variable 'eldoc-documentation-function)
+  (make-local-variable 'eldoc-idle-delay)
+  (setq eldoc-documentation-function 'slime-compute-autodoc)
+  (setq eldoc-idle-delay slime-autodoc-delay)
+  (if (eldoc-mode arg)
+      (progn 
+        (setq slime-echo-arglist-function 
+              #'(lambda () (eldoc-message (slime-compute-autodoc))))
+        (setq slime-autodoc-mode t))
+      (progn 
+        (setq slime-echo-arglist-function 'slime-show-arglist)
+        (setq slime-autodoc-mode nil))))
 
-(defun slime-autodoc-start-timer ()
-  "(Re)start the timer that prints autodocs every `slime-autodoc-delay' seconds."
-  (interactive)
-  (when slime-autodoc-idle-timer
-    (cancel-timer slime-autodoc-idle-timer))
-  (setq slime-autodoc-idle-timer
-        (run-with-idle-timer slime-autodoc-delay slime-autodoc-delay
-                             'slime-autodoc-timer-hook)))
-
-(defun slime-autodoc-stop-timer ()
-  "Stop the timer that prints autodocs.
-See also `slime-autodoc-start-timer'."
-  (when slime-autodoc-idle-timer
-    (cancel-timer slime-autodoc-idle-timer)
-    (setq slime-autodoc-idle-timer nil)))
-
-(defun slime-autodoc-timer-hook ()
-  "Function to be called after each Emacs becomes idle.
-When `slime-autodoc-mode' is non-nil, print apropos information about
-the symbol at point if applicable."
-  (when (slime-autodoc-message-ok-p)
-    (condition-case err
-        (slime-autodoc)
-      (error
-       (setq slime-autodoc-mode nil)
-       (message "Error: %S; slime-autodoc-mode now disabled." err)))))
-
-(defun slime-autodoc-message-ok-p ()
-  "Return true if printing a message is currently okay (shouldn't
-annoy the user)."
-  (and (or slime-mode (eq major-mode 'slime-repl-mode) 
-           (eq major-mode 'sldb-mode))
-       slime-autodoc-mode
-       (or (null (current-message)) 
-           (string= (current-message) slime-autodoc-last-message))
-       (not executing-kbd-macro)
-       (not (and (boundp 'edebug-active) (symbol-value 'edebug-active)))
-       (not cursor-in-echo-area)
-       (not (active-minibuffer-window))
-       (not (eq (selected-window) (minibuffer-window)))
-       (slime-background-activities-enabled-p)))
+(defadvice eldoc-display-message-no-interference-p 
+    (after slime-autodoc-message-ok-p)
+  (when slime-autodoc-mode
+    (setq ad-return-value
+          (and ad-return-value
+               (not (active-minibuffer-window))
+               (slime-background-activities-enabled-p))))
+  ad-return-value)
 
 
-;;; Initialization
+;;;; Initialization
 
 (defun slime-autodoc-init ()
-  (setq slime-echo-arglist-function 'slime-autodoc)
   (dolist (h '(slime-mode-hook slime-repl-mode-hook sldb-mode-hook))
     (add-hook h 'slime-autodoc-maybe-enable)))
 
@@ -287,6 +248,7 @@
   (when slime-use-autodoc-mode 
     (slime-autodoc-mode 1)))
 
+;;; FIXME: This doesn't disable eldoc-mode in existing buffers.
 (defun slime-autodoc-unload ()
   (setq slime-echo-arglist-function 'slime-show-arglist)
   (dolist (h '(slime-mode-hook slime-repl-mode-hook sldb-mode-hook))
--- /project/slime/cvsroot/slime/contrib/ChangeLog	2008/12/31 16:55:26	1.160
+++ /project/slime/cvsroot/slime/contrib/ChangeLog	2009/01/01 15:54:30	1.161
@@ -1,3 +1,8 @@
+2009-01-01  Tobias C. Rittweiler  <tcr at freebits.de>
+
+	* slime-autodoc.el: Autodoc is now implemented on top of ElDoc.
+	(Suggested by Madhu.)
+
 2008-12-31  Tobias C. Rittweiler  <tcr at freebits.de>
 
 	* swank-arglists.lisp (format-arglist-for-echo-area): Catch errors




From trittweiler at common-lisp.net  Thu Jan  1 16:08:53 2009
From: trittweiler at common-lisp.net (CVS User trittweiler)
Date: Thu, 01 Jan 2009 16:08:53 +0000
Subject: [slime-cvs] CVS slime
Message-ID: <E1LIQ6P-0002Gr-NQ@common-lisp.net>

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

Modified Files:
	slime.el ChangeLog 
Log Message:
	* slime.el (slime-eval-async, slime-dispatch-event): Canoncalize
	return value. Previously they returned an arbitrary value which
	was displayed to the minibuffer due to a bug in slime-autodoc. The
	arbitrariness of the return value made debugging this a chore.


--- /project/slime/cvsroot/slime/slime.el	2009/01/01 14:48:04	1.1087
+++ /project/slime/cvsroot/slime/slime.el	2009/01/01 16:08:53	1.1088
@@ -2263,7 +2263,13 @@
        (set-buffer buffer)
        (funcall cont result)))
     ((:abort)
-     (message "Evaluation aborted."))))
+     (message "Evaluation aborted.")))
+  ;; Guard against arbitrary return values which once upon a time
+  ;; showed up in the minibuffer spuriously (due to a bug in
+  ;; slime-autodoc.)  If this ever happens again, returning the
+  ;; following will make debugging much easier:
+  :slime-eval-async)
+
 
 ;;; These functions can be handy too:
 
@@ -2390,7 +2396,9 @@
              (princ (format "Invalid protocol message:\n%s\n\n%S"
                             condition packet))
              (goto-char (point-min)))
-           (error "Invalid protocol message"))))))
+           (error "Invalid protocol message")))))
+  ;; Canonicalized return value. See comment in `slime-eval-async'.
+  :slime-dispatch-event)
 
 (defun slime-send (sexp)
   "Send SEXP directly over the wire on the current connection."
--- /project/slime/cvsroot/slime/ChangeLog	2009/01/01 14:48:22	1.1618
+++ /project/slime/cvsroot/slime/ChangeLog	2009/01/01 16:08:53	1.1619
@@ -1,3 +1,10 @@
+2009-01-01  Tobias C. Rittweiler  <tcr at freebits.de>
+
+	* slime.el (slime-eval-async, slime-dispatch-event): Canoncalize
+	return value. Previously they returned an arbitrary value which
+	was displayed to the minibuffer due to a bug in slime-autodoc. The
+	arbitrariness of the return value made debugging this a chore.
+
 2009-01-01  Helmut Eller  <heller at common-lisp.net>
 
 	* swank-openmcl.lisp (frame-source-location-for-emacs)




From trittweiler at common-lisp.net  Fri Jan  2 16:43:21 2009
From: trittweiler at common-lisp.net (CVS User trittweiler)
Date: Fri, 02 Jan 2009 16:43:21 +0000
Subject: [slime-cvs] CVS slime
Message-ID: <E1LIn7J-0001of-GI@common-lisp.net>

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

Modified Files:
	swank-loader.lisp ChangeLog 
Log Message:

	* swank-loader.lisp (*contribs*): Add `swank-sbcl-exts'.


--- /project/slime/cvsroot/slime/swank-loader.lisp	2008/08/17 08:31:17	1.88
+++ /project/slime/cvsroot/slime/swank-loader.lisp	2009/01/02 16:43:21	1.89
@@ -187,6 +187,7 @@
                      swank-presentations swank-presentation-streams
                      #+(or asdf sbcl) swank-asdf
                      swank-package-fu
+                     swank-sbcl-exts
                      )
   "List of names for contrib modules.")
 
--- /project/slime/cvsroot/slime/ChangeLog	2009/01/01 16:08:53	1.1619
+++ /project/slime/cvsroot/slime/ChangeLog	2009/01/02 16:43:21	1.1620
@@ -1,5 +1,9 @@
 2009-01-01  Tobias C. Rittweiler  <tcr at freebits.de>
 
+	* swank-loader.lisp (*contribs*): Add `swank-sbcl-exts'.
+
+2009-01-01  Tobias C. Rittweiler  <tcr at freebits.de>
+
 	* slime.el (slime-eval-async, slime-dispatch-event): Canoncalize
 	return value. Previously they returned an arbitrary value which
 	was displayed to the minibuffer due to a bug in slime-autodoc. The




From trittweiler at common-lisp.net  Fri Jan  2 17:07:00 2009
From: trittweiler at common-lisp.net (CVS User trittweiler)
Date: Fri, 02 Jan 2009 17:07:00 +0000
Subject: [slime-cvs] CVS slime
Message-ID: <E1LInUC-0002nv-V8@common-lisp.net>

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

Modified Files:
	swank-sbcl.lisp ChangeLog 
Log Message:
	Arglists of user-defined types are now displayed by slime-autodoc
	on SBCL.

	  (deftype foo (x y) `(cons ,x ,y))
	  (declare (type (foo |

	* swank-sbcl.lisp ([method] type-specifier-arglist): Make use of
	recently introduced SB-INTROSPECT:DEFTYPE-LAMBDA-LIST.


--- /project/slime/cvsroot/slime/swank-sbcl.lisp	2008/12/30 18:57:54	1.228
+++ /project/slime/cvsroot/slime/swank-sbcl.lisp	2009/01/02 17:07:00	1.229
@@ -354,6 +354,12 @@
                                   flags :key #'ensure-list))
           (call-next-method)))))
 
+#+#.(swank-backend::sbcl-with-symbol 'deftype-lambda-list 'sb-introspect)
+(defmethod type-specifier-arglist :around (typespec-operator)
+  (multiple-value-bind (arglist foundp)
+      (sb-introspect:deftype-lambda-list typespec-operator)
+    (if foundp arglist (call-next-method))))
+
 (defvar *buffer-name* nil)
 (defvar *buffer-offset*)
 (defvar *buffer-substring* nil)
--- /project/slime/cvsroot/slime/ChangeLog	2009/01/02 16:43:21	1.1620
+++ /project/slime/cvsroot/slime/ChangeLog	2009/01/02 17:07:00	1.1621
@@ -1,5 +1,16 @@
 2009-01-01  Tobias C. Rittweiler  <tcr at freebits.de>
 
+	Arglists of user-defined types are now displayed by slime-autodoc
+	on SBCL.
+
+	  (deftype foo (x y) `(cons ,x ,y))
+	  (declare (type (foo |
+
+	* swank-sbcl.lisp ([method] type-specifier-arglist): Make use of
+	recently introduced SB-INTROSPECT:DEFTYPE-LAMBDA-LIST.
+
+2009-01-01  Tobias C. Rittweiler  <tcr at freebits.de>
+
 	* swank-loader.lisp (*contribs*): Add `swank-sbcl-exts'.
 
 2009-01-01  Tobias C. Rittweiler  <tcr at freebits.de>




From heller at common-lisp.net  Fri Jan  2 21:57:13 2009
From: heller at common-lisp.net (CVS User heller)
Date: Fri, 02 Jan 2009 21:57:13 +0000
Subject: [slime-cvs] CVS slime
Message-ID: <E1LIs13-0007I2-Tw@common-lisp.net>

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

Modified Files:
	NEWS 
Log Message:
Mention the missing REPL.

--- /project/slime/cvsroot/slime/NEWS	2008/07/29 11:03:31	1.10
+++ /project/slime/cvsroot/slime/NEWS	2009/01/02 21:57:13	1.11
@@ -2,6 +2,19 @@
 
 * 3.0 (not released yet)
 
+** REPL no longer loaded by default
+SLIME has a REPL which communicates exclusively over SLIME's socket.
+This REPL is no longer loaded by default.  The default REPL is now the
+one by the Lisp implementation in the *inferior-lisp* buffer.  The
+simplest way to enable the old REPL is:
+
+  (slime-setup '(slime-repl))
+
+** Precise source tracking in Clozure CL
+Recent versions of the CCL compiler support source-location tracking.
+This makes the sldb-show-source command much more useful and M-. works
+better too.
+
 ** Environment variables for Lisp process
 slime-lisp-implementations can be used to specify a list of strings to
 augment the process environment of the Lisp process.  E.g.:




From heller at common-lisp.net  Fri Jan  2 21:57:23 2009
From: heller at common-lisp.net (CVS User heller)
Date: Fri, 02 Jan 2009 21:57:23 +0000
Subject: [slime-cvs] CVS slime
Message-ID: <E1LIs1D-0007Id-Fs@common-lisp.net>

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

Modified Files:
	ChangeLog slime.el 
Log Message:
* slime.el ([test] arglist): Guard against nil.  ECL
returns nil most of the time.

--- /project/slime/cvsroot/slime/ChangeLog	2009/01/02 17:07:00	1.1621
+++ /project/slime/cvsroot/slime/ChangeLog	2009/01/02 21:57:23	1.1622
@@ -13,6 +13,11 @@
 
 	* swank-loader.lisp (*contribs*): Add `swank-sbcl-exts'.
 
+2009-01-02  Helmut Eller  <heller at common-lisp.net>
+
+	* slime.el ([test] arglist): Guard against nil.  ECL
+	returns nil most of the time.
+
 2009-01-01  Tobias C. Rittweiler  <tcr at freebits.de>
 
 	* slime.el (slime-eval-async, slime-dispatch-event): Canoncalize
--- /project/slime/cvsroot/slime/slime.el	2009/01/01 16:08:53	1.1088
+++ /project/slime/cvsroot/slime/slime.el	2009/01/02 21:57:23	1.1089
@@ -7512,13 +7512,12 @@
       ("cl:lisp-implementation-type" "(cl:lisp-implementation-type )")
       ("cl:class-name" 
        "(cl:class-name \\(class\\|object\\|instance\\|structure\\))"))
-  (slime-check-top-level)
   (let ((arglist (slime-eval `(swank:operator-arglist ,function-name 
                                                       "swank"))))
     (slime-test-expect "Argument list is as expected"
-                       expected-arglist (downcase arglist)
-                       #'string-match))
-  (slime-check-top-level))
+                       expected-arglist (and arglist (downcase arglist))
+                       (lambda (pattern arglist)
+                         (and arglist (string-match pattern arglist))))))
 
 (def-slime-test (compile-defun ("allegro" "lispworks" "clisp" "ccl"))
     (program subform)




From heller at common-lisp.net  Fri Jan  2 21:57:31 2009
From: heller at common-lisp.net (CVS User heller)
Date: Fri, 02 Jan 2009 21:57:31 +0000
Subject: [slime-cvs] CVS slime
Message-ID: <E1LIs1L-0007JE-GJ@common-lisp.net>

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

Modified Files:
	slime.el swank.lisp 
Log Message:
Experimental channels

--- /project/slime/cvsroot/slime/slime.el	2009/01/02 21:57:23	1.1089
+++ /project/slime/cvsroot/slime/slime.el	2009/01/02 21:57:31	1.1090
@@ -2269,8 +2269,7 @@
   ;; slime-autodoc.)  If this ever happens again, returning the
   ;; following will make debugging much easier:
   :slime-eval-async)
-
-
+  
 ;;; These functions can be handy too:
 
 (defun slime-connected-p ()
@@ -2365,6 +2364,10 @@
            (sldb-exit thread level stepping))
           ((:emacs-interrupt thread)
            (slime-send `(:emacs-interrupt ,thread)))
+          ((:channel-send id msg)
+           (slime-channel-send (or (slime-find-channel id)
+                                   (error "Invalid channel id: %S %S" id msg))
+                               msg))
           ((:y-or-n-p thread tag question)
            (slime-y-or-n-p thread tag question))
           ((:emacs-return-string thread tag string)
@@ -2414,6 +2417,40 @@
   (interactive)
   (signal-process (slime-pid) 'SIGINT))
 
+
+;;;;; Channels
+
+(slime-def-connection-var slime-channels '()
+  "Alist of the form (ID . CHANNEL).")
+
+(slime-def-connection-var slime-channels-counter 0
+  "Channel serial number counter.")
+
+(defstruct (slime-channel (:conc-name slime-channel.)
+                          (:constructor 
+                           slime-make-channel% (operations name id)))
+  operations name id)
+
+(defun slime-make-channel (operations &optional name)
+  (let* ((id (incf (slime-channels-counter)))
+         (ch (slime-make-channel% operations name id)))
+    (push (cons (cons id ch) (slime-channels)))))
+
+(defun slime-close-channel (channel)
+  (setf (slime-channels.operations channel) 'closed-channel)
+  (let ((probe (assq (slime-channel.id channel) (slime-channels))))
+    (cond (probe (setf (slime-channels) (delete probe (slime-channels))))
+          (t (error "Invalid channel: %s" channel)))))
+
+(defun slime-find-channel (id)
+  (cdr (assq id (slime-channels))))
+
+(defun slime-channel-send (channel message)
+  (apply (or (cdr (assq (car message)
+                        (slime-channel.operations channel)))
+             (error "Unsupported operation: %S %S" message channel))
+         (cdr message)))
+
 ;;;;; Event logging to *slime-events*
 ;;;
 ;;; The *slime-events* buffer logs all protocol messages for debugging
--- /project/slime/cvsroot/slime/swank.lisp	2009/01/01 14:48:04	1.621
+++ /project/slime/cvsroot/slime/swank.lisp	2009/01/02 21:57:31	1.622
@@ -1105,8 +1105,8 @@
      (encode-message `(:return , at args) (current-socket-io)))
     ((:emacs-interrupt thread-id)
      (interrupt-worker-thread thread-id))
-    (((:write-string
-       :debug :debug-condition :debug-activate :debug-return
+    (((:write-string 
+       :debug :debug-condition :debug-activate :debug-return :channel-send
        :presentation-start :presentation-end
        :new-package :new-features :ed :%apply :indentation-update
        :eval :eval-no-wait :background-message :inspect :ping




From heller at common-lisp.net  Fri Jan  2 21:57:54 2009
From: heller at common-lisp.net (CVS User heller)
Date: Fri, 02 Jan 2009 21:57:54 +0000
Subject: [slime-cvs] CVS slime
Message-ID: <E1LIs1i-0007Jx-4f@common-lisp.net>

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

Modified Files:
	ChangeLog slime.el swank.lisp 
Log Message:
Experimental implementation of "channels".
The idea is to support arbitrary protocols without
changes to the low level event dispatcher.

* slime.el (slime-make-channel, slime-close-channel)
(slime-channel-send, slime-send-to-remote-channel): New functions.
(slime-define-channel-type, slime-define-channel-method): New
macros.
(slime-dispatch-event): Support channel events.
* swank.lisp (channel, listener-channel): New classes.
(channel-send, send-to-remote-channel): New functions.
(create-listener): New function.  Test case for channel code.
(process-requests): Process channel events.

--- /project/slime/cvsroot/slime/ChangeLog	2009/01/02 21:57:23	1.1622
+++ /project/slime/cvsroot/slime/ChangeLog	2009/01/02 21:57:53	1.1623
@@ -15,6 +15,22 @@
 
 2009-01-02  Helmut Eller  <heller at common-lisp.net>
 
+	Experimental implementation of "channels".
+	The idea is to support arbitrary protocols without
+	changes to the low level event dispatcher.
+
+	* slime.el (slime-make-channel, slime-close-channel)
+	(slime-channel-send, slime-send-to-remote-channel): New functions.
+	(slime-define-channel-type, slime-define-channel-method): New
+	macros.
+	(slime-dispatch-event): Support channel events.
+	* swank.lisp (channel, listener-channel): New classes.
+	(channel-send, send-to-remote-channel): New functions.
+	(create-listener): New function.  Test case for channel code.
+	(process-requests): Process channel events.
+
+(2009-01-02  Helmut Eller  <heller at common-lisp.net>
+
 	* slime.el ([test] arglist): Guard against nil.  ECL
 	returns nil most of the time.
 
--- /project/slime/cvsroot/slime/slime.el	2009/01/02 21:57:31	1.1090
+++ /project/slime/cvsroot/slime/slime.el	2009/01/02 21:57:54	1.1091
@@ -2368,6 +2368,8 @@
            (slime-channel-send (or (slime-find-channel id)
                                    (error "Invalid channel id: %S %S" id msg))
                                msg))
+          ((:emacs-channel-send id msg)
+           (slime-send `(:emacs-channel-send ,id ,msg)))
           ((:y-or-n-p thread tag question)
            (slime-y-or-n-p thread tag question))
           ((:emacs-return-string thread tag string)
@@ -2420,6 +2422,15 @@
 
 ;;;;; Channels
 
+;;; A channel implements a set of operations.  Those operations can be
+;;; invoked by sending messages to the channel.  Channels are used for
+;;; protocols which can't be expressed naturally with RPCs, e.g. if
+;;; operations don't return a meaningful result.
+;;;
+;;; A channel can be "remote" or "local".  Remote channels are
+;;; represented by integers.  Local channels are structures.  Messages
+;;; sent to a closed (remote) channel are ignored.
+
 (slime-def-connection-var slime-channels '()
   "Alist of the form (ID . CHANNEL).")
 
@@ -2428,13 +2439,14 @@
 
 (defstruct (slime-channel (:conc-name slime-channel.)
                           (:constructor 
-                           slime-make-channel% (operations name id)))
-  operations name id)
+                           slime-make-channel% (operations name id plist)))
+  operations name id plist)
 
 (defun slime-make-channel (operations &optional name)
   (let* ((id (incf (slime-channels-counter)))
-         (ch (slime-make-channel% operations name id)))
-    (push (cons (cons id ch) (slime-channels)))))
+         (ch (slime-make-channel% operations name id nil)))
+    (push (cons id ch) (slime-channels))
+    ch))
 
 (defun slime-close-channel (channel)
   (setf (slime-channels.operations channel) 'closed-channel)
@@ -2446,10 +2458,36 @@
   (cdr (assq id (slime-channels))))
 
 (defun slime-channel-send (channel message)
-  (apply (or (cdr (assq (car message)
-                        (slime-channel.operations channel)))
+  (apply (or (gethash (car message) (slime-channel.operations channel))
              (error "Unsupported operation: %S %S" message channel))
-         (cdr message)))
+         channel (cdr message)))
+
+(defun slime-channel-put (channel prop value)
+  (setf (slime-channel.plist channel) 
+        (plist-put (slime-channel.plist channel) prop value)))
+
+(defun slime-channel-get (channel prop)
+  (plist-get (slime-channel.plist channel) prop))
+
+(eval-and-compile 
+  (defun slime-channel-method-table-name (type)
+    (intern (format "slime-%s-channel-methods" type))))
+
+(defmacro slime-define-channel-type (name)
+  (let ((tab (slime-channel-method-table-name name)))
+    `(progn
+       (defvar ,tab)
+       (setq ,tab (make-hash-table :size 10)))))
+
+(defmacro slime-define-channel-method (type method args &rest body)
+  `(puthash ',method
+            (lambda (self . ,args) . ,body)
+            ,(slime-channel-method-table-name type)))
+
+(put 'slime-define-channel-method 'lisp-indent-function 3)
+
+(defun slime-send-to-remote-channel (channel-id msg)
+  (slime-dispatch-event `(:emacs-channel-send ,channel-id ,msg)))
 
 ;;;;; Event logging to *slime-events*
 ;;;
--- /project/slime/cvsroot/slime/swank.lisp	2009/01/02 21:57:31	1.622
+++ /project/slime/cvsroot/slime/swank.lisp	2009/01/02 21:57:54	1.623
@@ -970,9 +970,14 @@
   "Read and process requests from Emacs."
   (loop
    (multiple-value-bind (event timeout?)
-       (wait-for-event `(:emacs-rex . _) timeout)
+       (wait-for-event `(or (:emacs-rex . _)
+                            (:emacs-channel-send . _))
+                       timeout)
     (when timeout? (return))
-    (apply #'eval-for-emacs (cdr event)))))
+    (destructure-case event
+      ((:emacs-rex &rest args) (apply #'eval-for-emacs args))
+      ((:emacs-channel-send channel (selector &rest args))
+       (channel-send channel selector args))))))
 
 (defun current-socket-io ()
   (connection.socket-io *emacs-connection*))
@@ -1116,6 +1121,9 @@
      (encode-message event (current-socket-io)))
     (((:emacs-pong :emacs-return :emacs-return-string) thread-id &rest args)
      (send-event (find-thread thread-id) (cons (car event) args)))
+    ((:emacs-channel-send channel-id msg)
+     (let ((ch (find-channel channel-id)))
+       (send-event (channel-thread ch) `(:emacs-channel-send ,ch ,msg))))
     (((:end-of-stream))
      (close-connection *emacs-connection* nil (safe-backtrace)))
     ((:reader-error packet condition)
@@ -1521,6 +1529,123 @@
           (connection.repl-results connection)     repl-results)
     connection))
 
+
+;;; Channels
+
+(progn
+
+(defvar *channels* '())
+(defvar *channel-counter* 0)
+
+(defclass channel ()
+  ((id :reader channel-id)
+   (thread :initarg :thread :initform (current-thread) :reader channel-thread)
+   (name :initarg :name :initform nil)))
+
+(defmethod initialize-instance ((ch channel) &rest initargs)
+  (declare (ignore initargs))
+  (call-next-method)
+  (with-slots (id) ch
+    (setf id (incf *channel-counter*))
+    (push (cons id ch) *channels*)))
+
+(defmethod print-object ((c channel) stream)
+  (print-unreadable-object (c stream :type t)
+    (with-slots (id name) c
+      (format stream "~d ~a" id name))))
+
+(defun find-channel (id)
+  (cdr (assoc id *channels*)))
+
+(defgeneric channel-send (channel selector args))
+
+(defmacro define-channel-method (selector (channel &rest args) &body body)
+  `(defmethod channel-send (,channel (selector (eql ',selector)) args)
+     (destructuring-bind ,args args
+       . ,body)))
+
+(defun send-to-remote-channel (channel-id msg)
+  (send-to-emacs `(:channel-send ,channel-id ,msg)))
+
+(defclass listener-channel (channel)
+  ((remote :initarg :remote)
+   (env :initarg :env)))
+
+(defslimefun create-listener (remote)
+  (let* ((pkg *package*)
+         (conn *emacs-connection*)
+         (ch (make-instance 'listener-channel
+                            :remote remote
+                            :env (initial-listener-bindings remote))))
+
+    (with-slots (thread id) ch
+      (when (use-threads-p)
+        (setf thread (spawn-listener-thread ch conn)))
+      (list id
+            (thread-id thread)
+            (package-name pkg)
+            (package-string-for-prompt pkg)))))
+
+(defun initial-listener-bindings (remote)
+  `((*package* . ,*package*)
+    (*standard-output* 
+     . ,(make-listener-output-stream remote))
+    (*standard-input*
+     . ,(make-listener-input-stream remote))))
+
+(defun spawn-listener-thread (channel connection)
+  (spawn (lambda ()
+           (with-connection (connection)
+             (loop 
+              (destructure-case (wait-for-event `(:emacs-channel-send . _))
+                ((:emacs-channel-send c (selector &rest args))
+                 (assert (eq c channel))
+                 (channel-send channel selector args))))))
+         :name "swank-listener-thread"))
+
+(define-channel-method :eval ((c listener-channel) string)
+  (with-slots (remote env) c
+    (let ((aborted t))
+      (with-bindings env
+        (unwind-protect 
+             (let* ((form (read-from-string string))
+                    (value (eval form)))
+               (send-to-remote-channel remote 
+                                       `(:write-result
+                                         ,(prin1-to-string value)))
+               (setq aborted nil))
+          (force-output)
+          (setf env (loop for (sym) in env 
+                          collect (cons sym (symbol-value sym))))
+          (let ((pkg (package-name *package*))
+                (prompt (package-string-for-prompt *package*)))
+            (send-to-remote-channel remote 
+                                    (if aborted 
+                                        `(:evaluation-aborted ,pkg ,prompt)
+                                        `(:prompt ,pkg ,prompt)))))))))
+
+(defun make-listener-output-stream (remote)
+  (make-output-stream (lambda (string)
+                        (send-to-remote-channel remote
+                                                `(:write-string ,string)))))
+
+(defun make-listener-input-stream (remote)
+  (make-input-stream 
+   (lambda ()
+     (force-output)
+     (let ((tag (make-tag)))
+       (send-to-remote-channel remote 
+                               `(:read-string ,(current-thread-id) ,tag))
+       (let ((ok nil))
+         (unwind-protect
+              (prog1 (caddr (wait-for-event
+                             `(:emacs-return-string ,tag value)))
+                (setq ok t))
+           (unless ok
+             (send-to-remote-channel remote `(:read-aborted ,tag)))))))))
+
+)
+
 (defun call-with-thread-description (description thunk)
   ;; For `M-x slime-list-threads': Display what threads
   ;; created by swank are currently doing.
@@ -2206,8 +2331,8 @@
 
 ;; This is only used by the test suite.
 (defun sleep-for (seconds)
-  "Sleep at least SECONDS seconds.
-This is just like sleep but guarantees to sleep
+  "Sleep for at least SECONDS seconds.
+This is just like cl:sleep but guarantees to sleep
 at least SECONDS."
   (let* ((start (get-internal-real-time))
          (end (+ start




From heller at common-lisp.net  Fri Jan  2 21:58:05 2009
From: heller at common-lisp.net (CVS User heller)
Date: Fri, 02 Jan 2009 21:58:05 +0000
Subject: [slime-cvs] CVS slime
Message-ID: <E1LIs1t-0007Kk-VQ@common-lisp.net>

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

Modified Files:
	ChangeLog 
Log Message:
Delete junk.

--- /project/slime/cvsroot/slime/ChangeLog	2009/01/02 21:57:53	1.1623
+++ /project/slime/cvsroot/slime/ChangeLog	2009/01/02 21:58:05	1.1624
@@ -29,7 +29,7 @@
 	(create-listener): New function.  Test case for channel code.
 	(process-requests): Process channel events.
 
-(2009-01-02  Helmut Eller  <heller at common-lisp.net>
+2009-01-02  Helmut Eller  <heller at common-lisp.net>
 
 	* slime.el ([test] arglist): Guard against nil.  ECL
 	returns nil most of the time.
@@ -80,8 +80,6 @@
 
 2008-12-31  Helmut Eller  <heller at common-lisp.net>
 
-	* swank-openmcl.lisp ([method] source-locations (symbol)): 
-
 	* slime.el (slime-cd, slime-pwd): New commands.
 	(slime-change-directory): New function.
 	(slime-change-directory-hooks): New hook.




From heller at common-lisp.net  Fri Jan  2 22:02:24 2009
From: heller at common-lisp.net (CVS User heller)
Date: Fri, 02 Jan 2009 22:02:24 +0000
Subject: [slime-cvs] CVS slime/contrib
Message-ID: <E1LIs64-0007yK-Ud@common-lisp.net>

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

Modified Files:
	ChangeLog 
Added Files:
	slime-mrepl.el 
Log Message:
slime-mrepl.el: new file

--- /project/slime/cvsroot/slime/contrib/ChangeLog	2009/01/01 15:54:30	1.161
+++ /project/slime/cvsroot/slime/contrib/ChangeLog	2009/01/02 22:02:24	1.162
@@ -1,3 +1,7 @@
+2009-01-02  Helmut Eller  <heller at common-lisp.net>
+
+	* slime-mrepl.el: New file.
+
 2009-01-01  Tobias C. Rittweiler  <tcr at freebits.de>
 
 	* slime-autodoc.el: Autodoc is now implemented on top of ElDoc.

--- /project/slime/cvsroot/slime/contrib/slime-mrepl.el	2009/01/02 22:02:24	NONE
+++ /project/slime/cvsroot/slime/contrib/slime-mrepl.el	2009/01/02 22:02:24	1.1
;;; slime-mrepl.el --- Multiple REPLs
;;
;; An experimental implementation of multiple REPLs multiplexed over a
;; single Slime socket.  M-x slime-open-listener creates a new REPL
;; buffer.
;;
;; Some copy&pasting from slime-repl.el

(require 'slime-repl)

(slime-define-channel-type listener)

(slime-define-channel-method listener :prompt (package prompt)
  (with-current-buffer (slime-channel-get self 'buffer)
    (setf slime-buffer-package package)
    (letf (((slime-lisp-package-prompt-string) prompt))
      (slime-repl-insert-prompt))))

(slime-define-channel-method listener :write-result (result)
  (letf (((slime-connection-output-buffer) (slime-channel-get self 'buffer)))
    (slime-repl-emit-result result t)))

(slime-define-channel-method listener :evaluation-aborted (package prompt)
  (with-current-buffer (slime-channel-get self 'buffer)
    (setq slime-buffer-package package)
    (letf (((slime-connection-output-buffer) (current-buffer))
	   ((slime-lisp-package-prompt-string) prompt))
      (slime-repl-show-abort))))

(slime-define-channel-method listener :write-string (string)
  (letf (((slime-connection-output-buffer) (slime-channel-get self 'buffer)))
    (slime-repl-emit string)))

(slime-define-channel-method listener :read-string (thread tag)
  (letf (((slime-connection-output-buffer) (slime-channel-get self 'buffer)))
    (slime-repl-read-string thread tag)))

(define-derived-mode slime-mrepl-mode slime-repl-mode "mrepl")

(slime-define-keys slime-mrepl-mode-map
  ((kbd "RET") 'slime-mrepl-return)
  ([return] 'slime-mrepl-return))

(defun slime-mrepl-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,
i.e. the parenthesis are matched. 

With prefix argument send the input even if the parenthesis are not
balanced."
  (interactive "P")
  (slime-check-connected)
  (cond (end-of-input
         (slime-mrepl-send-input))
        (slime-repl-read-mode ; bad style?
         (slime-mrepl-send-input t))
        ((and (get-text-property (point) 'slime-repl-old-input)
              (< (point) slime-repl-input-start-mark))
         (slime-repl-grab-old-input end-of-input)
         (slime-repl-recenter-if-needed))
        ((slime-input-complete-p slime-repl-input-start-mark (point-max))
         (slime-mrepl-send-input t))
        (t 
         (slime-repl-newline-and-indent)
         (message "[input not complete]"))))

(defun slime-mrepl-send-input (&optional newline)
  "Goto to the end of the input and send the current input.
If NEWLINE is true then add a newline at the end of the input."
  (unless (slime-repl-in-input-area-p)
    (error "No input at point."))
  (goto-char (point-max))
  (let ((end (point))) ; end of input, without the newline
    (slime-repl-add-to-input-history 
     (buffer-substring slime-repl-input-start-mark end))
    (when newline 
      (insert "\n")
      (slime-repl-show-maximum-output))
    (let ((inhibit-modification-hooks t))
      (add-text-properties slime-repl-input-start-mark 
                           (point)
                           `(slime-repl-old-input
                             ,(incf slime-repl-old-input-counter))))
    (let ((overlay (make-overlay slime-repl-input-start-mark end)))
      ;; These properties are on an overlay so that they won't be taken
      ;; by kill/yank.
      (overlay-put overlay 'read-only t)
      (overlay-put overlay 'face 'slime-repl-input-face)))
  (let ((input (slime-repl-current-input)))
    (goto-char (point-max))
    (slime-mark-input-start)
    (slime-mark-output-start)
    (slime-mrepl-send-string input)))

(defun slime-mrepl-send-string (string &optional command-string)
  (cond (slime-repl-read-mode
         (slime-repl-return-string string))
        (t (slime-mrepl-send `(:eval ,string)))))

(defun slime-mrepl-send (msg)
  "Send MSG to the remote channel."
  (slime-send-to-remote-channel slime-mrepl-remote-channel msg))

(defun slime-open-listener ()
  "Create a new listener window."
  (interactive)
  (let ((channel (slime-make-channel slime-listener-channel-methods)))
    (slime-eval-async
     `(swank:create-listener ,(slime-channel.id channel))
     (slime-rcurry 
      (lambda (result channel)
	(destructuring-bind (remote thread-id package prompt) result
	  (pop-to-buffer (generate-new-buffer "*slime-listener*"))
	  (slime-mrepl-mode)
	  (setq slime-current-thread thread-id)
	  (setq slime-buffer-connection (slime-connection))
	  (set (make-local-variable 'slime-mrepl-remote-channel) remote)
	  (slime-channel-put channel 'buffer (current-buffer))
	  (slime-reset-repl-markers)
	  (slime-channel-send channel `(:prompt ,package ,prompt))
	  (slime-repl-show-maximum-output)))
      channel))))

(provide 'slime-mrepl)



From heller at common-lisp.net  Fri Jan  2 22:03:27 2009
From: heller at common-lisp.net (CVS User heller)
Date: Fri, 02 Jan 2009 22:03:27 +0000
Subject: [slime-cvs] CVS slime
Message-ID: <E1LIs75-0007zZ-Lo@common-lisp.net>

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

Modified Files:
	ChangeLog 
Log Message:
Fix merge.


--- /project/slime/cvsroot/slime/ChangeLog	2009/01/02 21:58:05	1.1624
+++ /project/slime/cvsroot/slime/ChangeLog	2009/01/02 22:03:27	1.1625
@@ -1,18 +1,3 @@
-2009-01-01  Tobias C. Rittweiler  <tcr at freebits.de>
-
-	Arglists of user-defined types are now displayed by slime-autodoc
-	on SBCL.
-
-	  (deftype foo (x y) `(cons ,x ,y))
-	  (declare (type (foo |
-
-	* swank-sbcl.lisp ([method] type-specifier-arglist): Make use of
-	recently introduced SB-INTROSPECT:DEFTYPE-LAMBDA-LIST.
-
-2009-01-01  Tobias C. Rittweiler  <tcr at freebits.de>
-
-	* swank-loader.lisp (*contribs*): Add `swank-sbcl-exts'.
-
 2009-01-02  Helmut Eller  <heller at common-lisp.net>
 
 	Experimental implementation of "channels".
@@ -36,6 +21,21 @@
 
 2009-01-01  Tobias C. Rittweiler  <tcr at freebits.de>
 
+	Arglists of user-defined types are now displayed by slime-autodoc
+	on SBCL.
+
+	  (deftype foo (x y) `(cons ,x ,y))
+	  (declare (type (foo |
+
+	* swank-sbcl.lisp ([method] type-specifier-arglist): Make use of
+	recently introduced SB-INTROSPECT:DEFTYPE-LAMBDA-LIST.
+
+2009-01-01  Tobias C. Rittweiler  <tcr at freebits.de>
+
+	* swank-loader.lisp (*contribs*): Add `swank-sbcl-exts'.
+
+2009-01-01  Tobias C. Rittweiler  <tcr at freebits.de>
+
 	* slime.el (slime-eval-async, slime-dispatch-event): Canoncalize
 	return value. Previously they returned an arbitrary value which
 	was displayed to the minibuffer due to a bug in slime-autodoc. The




From heller at common-lisp.net  Sat Jan  3 21:13:00 2009
From: heller at common-lisp.net (CVS User heller)
Date: Sat, 03 Jan 2009 21:13:00 +0000
Subject: [slime-cvs] CVS slime
Message-ID: <E1LJDno-00021B-In@common-lisp.net>

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

Modified Files:
	ChangeLog swank-clisp.lisp 
Log Message:
* swank-clisp.lisp (wait-for-input): Disable it for win32.

--- /project/slime/cvsroot/slime/ChangeLog	2009/01/02 22:03:27	1.1625
+++ /project/slime/cvsroot/slime/ChangeLog	2009/01/03 21:13:00	1.1626
@@ -1,3 +1,7 @@
+2009-01-03  Helmut Eller  <heller at common-lisp.net>
+
+	* swank-clisp.lisp (wait-for-input): Disable it for win32.
+
 2009-01-02  Helmut Eller  <heller at common-lisp.net>
 
 	Experimental implementation of "channels".
--- /project/slime/cvsroot/slime/swank-clisp.lisp	2008/12/30 18:57:54	1.85
+++ /project/slime/cvsroot/slime/swank-clisp.lisp	2009/01/03 21:13:00	1.86
@@ -177,6 +177,7 @@
                         :element-type 'character
                         :external-format external-format))
 
+#-win32
 (defimplementation wait-for-input (streams &optional timeout)
   (assert (member timeout '(nil t)))
   (let ((streams (mapcar (lambda (s) (list* s :input nil)) streams)))




From heller at common-lisp.net  Sat Jan  3 21:13:10 2009
From: heller at common-lisp.net (CVS User heller)
Date: Sat, 03 Jan 2009 21:13:10 +0000
Subject: [slime-cvs] CVS slime
Message-ID: <E1LJDny-00021u-1I@common-lisp.net>

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

Modified Files:
	ChangeLog swank.lisp 
Log Message:
* swank.lisp (simple-serve-requests, make-repl-input-stream):
Move the call to WITH-CONNECTION to the input stream to pick up
stream redirections.

--- /project/slime/cvsroot/slime/ChangeLog	2009/01/03 21:13:00	1.1626
+++ /project/slime/cvsroot/slime/ChangeLog	2009/01/03 21:13:09	1.1627
@@ -1,5 +1,11 @@
 2009-01-03  Helmut Eller  <heller at common-lisp.net>
 
+	* swank.lisp (simple-serve-requests, make-repl-input-stream):
+	Move the call to WITH-CONNECTION to the input stream to pick up
+	stream redirections.
+
+2009-01-03  Helmut Eller  <heller at common-lisp.net>
+
 	* swank-clisp.lisp (wait-for-input): Disable it for win32.
 
 2009-01-02  Helmut Eller  <heller at common-lisp.net>
--- /project/slime/cvsroot/slime/swank.lisp	2009/01/02 21:57:54	1.623
+++ /project/slime/cvsroot/slime/swank.lisp	2009/01/03 21:13:09	1.624
@@ -1283,8 +1283,7 @@
             (let* ((stdin (real-input-stream *standard-input*))
                    (*standard-input* (make-repl-input-stream connection 
                                                              stdin)))
-	      (with-connection (connection)
-		(simple-repl))))))
+              (simple-repl)))))
     (close-connection connection nil (safe-backtrace))))
 
 (defun simple-repl ()
@@ -1306,16 +1305,17 @@
   (make-input-stream
    (lambda ()
      (loop
-      (let* ((socket (connection.socket-io connection))
-             (inputs (list socket stdin))
-             (ready (wait-for-input inputs)))
-        (cond ((eq ready :interrupt)
-               (check-slime-interrupts))
-              ((member socket ready)
-               (handle-requests connection t))
-              ((member stdin ready)
-               (return (read-non-blocking stdin)))
-              (t (assert (null ready)))))))))
+      (with-connection (connection)
+        (let* ((socket (connection.socket-io connection))
+               (inputs (list socket stdin))
+               (ready (wait-for-input inputs)))
+          (cond ((eq ready :interrupt)
+                 (check-slime-interrupts))
+                ((member socket ready)
+                 (handle-requests connection t))
+                ((member stdin ready)
+                 (return (read-non-blocking stdin)))
+                (t (assert (null ready))))))))))
 
 (defun read-non-blocking (stream)
   (with-output-to-string (str)




From heller at common-lisp.net  Sat Jan  3 21:13:21 2009
From: heller at common-lisp.net (CVS User heller)
Date: Sat, 03 Jan 2009 21:13:21 +0000
Subject: [slime-cvs] CVS slime
Message-ID: <E1LJDo9-00022c-3k@common-lisp.net>

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

Modified Files:
	ChangeLog slime.el 
Log Message:
By default, show compiler notes in a buffer with compilation-mode.

* slime.el (slime-show-compilation-log)
(slime-maybe-show-compilation-log): New functions,
(slime-compilation-finished-hook): Change the default value
to 'slime-maybe-show-compilation-log.

--- /project/slime/cvsroot/slime/ChangeLog	2009/01/03 21:13:09	1.1627
+++ /project/slime/cvsroot/slime/ChangeLog	2009/01/03 21:13:20	1.1628
@@ -1,5 +1,14 @@
 2009-01-03  Helmut Eller  <heller at common-lisp.net>
 
+	By default, show compiler notes in a buffer with compilation-mode.
+
+	* slime.el (slime-show-compilation-log)
+	(slime-maybe-show-compilation-log): New functions,
+	(slime-compilation-finished-hook): Change the default value
+	to 'slime-maybe-show-compilation-log.
+
+2009-01-03  Helmut Eller  <heller at common-lisp.net>
+
 	* swank.lisp (simple-serve-requests, make-repl-input-stream):
 	Move the call to WITH-CONNECTION to the input stream to pick up
 	stream redirections.
--- /project/slime/cvsroot/slime/slime.el	2009/01/02 21:57:54	1.1091
+++ /project/slime/cvsroot/slime/slime.el	2009/01/03 21:13:20	1.1092
@@ -2419,13 +2419,12 @@
   (interactive)
   (signal-process (slime-pid) 'SIGINT))
 
-
 ;;;;; Channels
 
 ;;; A channel implements a set of operations.  Those operations can be
 ;;; invoked by sending messages to the channel.  Channels are used for
-;;; protocols which can't be expressed naturally with RPCs, e.g. if
-;;; operations don't return a meaningful result.
+;;; protocols which can't be expressed naturally with RPCs, e.g. for
+;;; streaming data over the wire.
 ;;;
 ;;; A channel can be "remote" or "local".  Remote channels are
 ;;; represented by integers.  Local channels are structures.  Messages
@@ -2604,11 +2603,12 @@
 The function receive two arguments: the beginning and the end of the 
 region that will be compiled.")
 
-(defcustom slime-compilation-finished-hook 'slime-maybe-list-compiler-notes
+(defcustom slime-compilation-finished-hook 'slime-maybe-show-compilation-log
   "Hook called with a list of compiler notes after a compilation."
   :group 'slime-mode
   :type 'hook
-  :options '(slime-maybe-list-compiler-notes
+  :options '(slime-maybe-show-compilation-log
+             slime-maybe-list-compiler-notes
              slime-list-compiler-notes
              slime-maybe-show-xrefs-for-notes
              slime-goto-first-note))
@@ -2875,6 +2875,38 @@
 (defun slime-note-has-location-p (note)
   (not (eq ':error (car (slime-note.location note)))))
 
+(defun slime-maybe-show-compilation-log (notes)
+  "Show NOTES in a `compilation-mode' buffer, if NOTES isn't nil"
+  (unless (null notes)
+    (slime-show-compilation-log notes)))
+
+(defun slime-show-compilation-log (notes)
+  (interactive (list (slime-compiler-notes)))
+  (with-temp-message "Preparing compiler note tree..."
+    (slime-with-popup-buffer ("*SLIME Compilation*")
+      (compilation-mode)
+      (let ((inhibit-read-only t))
+        (insert (format "%d compiler notes:\n" (length notes)))
+        (dolist (note notes)
+          (insert (format "%s%s:\n%s\n"
+                          (slime-compilation-loc (slime-note.location note))
+                          (substring (symbol-name (slime-note.severity note))
+                                     1)
+                          (slime-note.message note)))))
+      (unless compilation-scroll-output 
+        (goto-char (point-min))))))
+
+(defun slime-compilation-loc (location)
+  (cond ((slime-location-p location)
+         (destructuring-bind (filename line col)
+             (save-excursion
+               (slime-goto-source-location location)
+               (list (or (buffer-file-name) (buffer-name))
+                     (line-number-at-pos)
+                     (1+ (current-column))))
+           (format "%s:%d:%d:" (or filename "") line col)))
+        (t "")))
+
 (defun slime-maybe-list-compiler-notes (notes)
   "Show the compiler notes if appropriate."
   ;; don't pop up a buffer if all notes are already annotated in the




From heller at common-lisp.net  Sat Jan  3 21:13:31 2009
From: heller at common-lisp.net (CVS User heller)
Date: Sat, 03 Jan 2009 21:13:31 +0000
Subject: [slime-cvs] CVS slime
Message-ID: <E1LJDoJ-00023N-8x@common-lisp.net>

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

Modified Files:
	ChangeLog slime.el 
Log Message:
* slime.el (slime-goto-location-buffer): Don't goto point-min.
(slime-check-location-buffer-name-sanity)
(slime-check-location-filename-sanity): Separated from
slime-goto-location-buffer.

--- /project/slime/cvsroot/slime/ChangeLog	2009/01/03 21:13:20	1.1628
+++ /project/slime/cvsroot/slime/ChangeLog	2009/01/03 21:13:31	1.1629
@@ -1,5 +1,12 @@
 2009-01-03  Helmut Eller  <heller at common-lisp.net>
 
+	* slime.el (slime-goto-location-buffer): Don't goto point-min.
+	(slime-check-location-buffer-name-sanity)
+	(slime-check-location-filename-sanity): Separated from
+	slime-goto-location-buffer.
+
+2009-01-03  Helmut Eller  <heller at common-lisp.net>
+
 	By default, show compiler notes in a buffer with compilation-mode.
 
 	* slime.el (slime-show-compilation-log)
--- /project/slime/cvsroot/slime/slime.el	2009/01/03 21:13:20	1.1092
+++ /project/slime/cvsroot/slime/slime.el	2009/01/03 21:13:31	1.1093
@@ -2900,10 +2900,12 @@
   (cond ((slime-location-p location)
          (destructuring-bind (filename line col)
              (save-excursion
-               (slime-goto-source-location location)
-               (list (or (buffer-file-name) (buffer-name))
-                     (line-number-at-pos)
-                     (1+ (current-column))))
+               (slime-goto-location-buffer (slime-location.buffer location))
+               (save-excursion
+                 (slime-goto-source-location location)
+                 (list (or (buffer-file-name) (buffer-name))
+                       (line-number-at-pos)
+                       (1+ (current-column)))))
            (format "%s:%d:%d:" (or filename "") line col)))
         (t "")))
 
@@ -3348,42 +3350,47 @@
                                  (file-name-directory guessed-target))
                                (file-name-nondirectory target-filename)))))))
 
-(defun slime-goto-location-buffer (buffer)
+(defun slime-check-location-filename-sanity (filename)
   (flet ((file-truename-safe (filename) (and filename (file-truename filename))))
-    (destructure-case buffer
-      ((:file filename)
-       (let ((target-filename (file-truename-safe (slime-from-lisp-filename filename)))
-             (buffer-filename (file-truename-safe (buffer-file-name))))
-         (when buffer-filename
-           (slime-maybe-warn-for-different-source-root target-filename buffer-filename))
-         (unless (and buffer-filename (string= buffer-filename target-filename))
-           (set-buffer (find-file-noselect target-filename t))))
-       (goto-char (point-min)))
-      ((:buffer buffer-name)
-       (let ((old-buffer-filename (file-truename-safe (buffer-file-name)))
-             (target-buffer-filename (file-truename-safe
-                                      (buffer-file-name (get-buffer buffer-name)))))
-         (when (and target-buffer-filename old-buffer-filename)
-           (slime-maybe-warn-for-different-source-root target-buffer-filename
-                                                       old-buffer-filename)))
-       (set-buffer buffer-name)
-       (goto-char (point-min)))
-      ((:source-form string)
-       (set-buffer (get-buffer-create "*SLIME Source Form*"))
-       (erase-buffer)
-       (lisp-mode)
-       (insert string)
-       (goto-char (point-min)))
-      ((:zip file entry)
-       (require 'arc-mode)
-       (set-buffer (find-file-noselect file t))
-       (goto-char (point-min))
-       (re-search-forward (concat "  " entry "$"))
-       (let ((buffer (save-window-excursion
-                       (archive-extract)
-                       (current-buffer))))
-         (set-buffer buffer)
-         (goto-char (point-min)))))))
+    (let ((target-filename (file-truename-safe filename))
+          (buffer-filename (file-truename-safe (buffer-file-name))))
+      (when buffer-filename
+        (slime-maybe-warn-for-different-source-root target-filename buffer-filename)))))
+
+(defun slime-check-location-buffer-name-sanity (buffer-name)
+  (flet ((file-truename-safe (filename) (and filename (file-truename filename))))
+    (let ((old-buffer-filename (file-truename-safe (buffer-file-name)))
+          (target-buffer-filename (file-truename-safe
+                                   (buffer-file-name (get-buffer buffer-name)))))
+      (when (and target-buffer-filename old-buffer-filename)
+        (slime-maybe-warn-for-different-source-root target-buffer-filename
+                                                    old-buffer-filename)))))
+
+(defun slime-goto-location-buffer (buffer)
+  (destructure-case buffer
+    ((:file filename)
+     (let ((filename (slime-from-lisp-filename filename)))
+       (slime-check-location-filename-sanity filename)
+       (set-buffer (find-file-noselect filename))))
+    ((:buffer buffer-name)
+     (slime-check-location-buffer-name-sanity buffer-name)
+     (set-buffer buffer-name))
+    ((:source-form string)
+     (set-buffer (get-buffer-create "*SLIME Source Form*"))
+     (erase-buffer)
+     (lisp-mode)
+     (insert string)
+     (goto-char (point-min)))
+    ((:zip file entry)
+     (require 'arc-mode)
+     (set-buffer (find-file-noselect file t))
+     (goto-char (point-min))
+     (re-search-forward (concat "  " entry "$"))
+     (let ((buffer (save-window-excursion
+                     (archive-extract)
+                     (current-buffer))))
+       (set-buffer buffer)
+       (goto-char (point-min))))))
 
 (defun slime-goto-location-position (position)
   (destructure-case position




From heller at common-lisp.net  Sat Jan  3 21:13:37 2009
From: heller at common-lisp.net (CVS User heller)
Date: Sat, 03 Jan 2009 21:13:37 +0000
Subject: [slime-cvs] CVS slime
Message-ID: <E1LJDoP-000240-Qz@common-lisp.net>

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

Modified Files:
	slime.el 
Log Message:
(slime-show-compilation-log): Set next-error-last-buffer.

--- /project/slime/cvsroot/slime/slime.el	2009/01/03 21:13:31	1.1093
+++ /project/slime/cvsroot/slime/slime.el	2009/01/03 21:13:37	1.1094
@@ -2894,7 +2894,8 @@
                                      1)
                           (slime-note.message note)))))
       (unless compilation-scroll-output 
-        (goto-char (point-min))))))
+        (goto-char (point-min)))
+      (setq next-error-last-buffer (current-buffer)))))
 
 (defun slime-compilation-loc (location)
   (cond ((slime-location-p location)




From heller at common-lisp.net  Sat Jan  3 21:33:51 2009
From: heller at common-lisp.net (CVS User heller)
Date: Sat, 03 Jan 2009 21:33:51 +0000
Subject: [slime-cvs] CVS slime
Message-ID: <E1LJE7z-00030U-IX@common-lisp.net>

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

Modified Files:
	ChangeLog slime.el 
Log Message:
slime.el (slime-line-number-at-pos): New compatibility function.

--- /project/slime/cvsroot/slime/ChangeLog	2009/01/03 21:13:31	1.1629
+++ /project/slime/cvsroot/slime/ChangeLog	2009/01/03 21:33:51	1.1630
@@ -4,6 +4,7 @@
 	(slime-check-location-buffer-name-sanity)
 	(slime-check-location-filename-sanity): Separated from
 	slime-goto-location-buffer.
+	(slime-line-number-at-pos): New compatibility function.
 
 2009-01-03  Helmut Eller  <heller at common-lisp.net>
 
--- /project/slime/cvsroot/slime/slime.el	2009/01/03 21:13:37	1.1094
+++ /project/slime/cvsroot/slime/slime.el	2009/01/03 21:33:51	1.1095
@@ -2905,7 +2905,7 @@
                (save-excursion
                  (slime-goto-source-location location)
                  (list (or (buffer-file-name) (buffer-name))
-                       (line-number-at-pos)
+                       (slime-line-number-at-pos)
                        (1+ (current-column)))))
            (format "%s:%d:%d:" (or filename "") line col)))
         (t "")))
@@ -6487,11 +6487,7 @@
   ;; narrowed the buffer.
   (save-restriction
     (widen)
-    (cons (cond ((fboundp 'line-number)
-                 (line-number))         ; XEmacs
-                ((fboundp 'line-number-at-pos)
-                 (line-number-at-pos))  ; Recent GNU Emacs
-                (t (1+ (count-lines 1 (point-at-bol)))))
+    (cons (slime-line-number-at-pos)
           (current-column))))
 
 (defun slime-inspector-operate-on-point ()
@@ -8378,6 +8374,13 @@
       (apply #'run-mode-hooks hooks)
     (apply #'run-hooks hooks)))
 
+(defun slime-line-number-at-pos ()
+  (cond ((fboundp 'line-number)
+         (line-number))         ; XEmacs
+        ((fboundp 'line-number-at-pos)
+         (line-number-at-pos))  ; Recent GNU Emacs
+        (t (1+ (count-lines 1 (point-at-bol))))))
+
 (slime-defun-if-undefined next-single-char-property-change
     (position prop &optional object limit)
   (let ((limit (typecase limit




From heller at common-lisp.net  Sun Jan  4 20:53:06 2009
From: heller at common-lisp.net (CVS User heller)
Date: Sun, 04 Jan 2009 20:53:06 +0000
Subject: [slime-cvs] CVS slime/contrib
Message-ID: <E1LJZy6-0004h2-Fc@common-lisp.net>

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

Modified Files:
	ChangeLog slime-mrepl.el slime-repl.el 
Log Message:
* slime-repl.el, slime-mrepl.el: Byte-compile the output
functions.

--- /project/slime/cvsroot/slime/contrib/ChangeLog	2009/01/02 22:02:24	1.162
+++ /project/slime/cvsroot/slime/contrib/ChangeLog	2009/01/04 20:53:06	1.163
@@ -1,3 +1,8 @@
+2009-01-04  Helmut Eller  <heller at common-lisp.net>
+
+	* slime-repl.el, slime-mrepl.el: Byte-compile the output
+	functions.
+
 2009-01-02  Helmut Eller  <heller at common-lisp.net>
 
 	* slime-mrepl.el: New file.
--- /project/slime/cvsroot/slime/contrib/slime-mrepl.el	2009/01/02 22:02:24	1.1
+++ /project/slime/cvsroot/slime/contrib/slime-mrepl.el	2009/01/04 20:53:06	1.2
@@ -28,9 +28,14 @@
       (slime-repl-show-abort))))
 
 (slime-define-channel-method listener :write-string (string)
+  (slime-mrepl-write-string self string))
+
+(defun slime-mrepl-write-string (self string)
   (letf (((slime-connection-output-buffer) (slime-channel-get self 'buffer)))
     (slime-repl-emit string)))
 
+(byte-compile 'slime-mrepl-write-string)
+
 (slime-define-channel-method listener :read-string (thread tag)
   (letf (((slime-connection-output-buffer) (slime-channel-get self 'buffer)))
     (slime-repl-read-string thread tag)))
--- /project/slime/cvsroot/slime/contrib/slime-repl.el	2008/12/30 19:04:06	1.8
+++ /project/slime/cvsroot/slime/contrib/slime-repl.el	2009/01/04 20:53:06	1.9
@@ -1805,4 +1805,12 @@
 #\\X
 SWANK> " (buffer-string))))
 
+(let ((byte-compile-warnings '()))
+  (mapc #'byte-compile
+	'(slime-repl-event-hook-function
+	  slime-write-string
+	  slime-repl-write-string
+	  slime-repl-emit
+	  slime-repl-show-maximum-output)))
+
 (provide 'slime-repl)




From heller at common-lisp.net  Sun Jan  4 20:53:30 2009
From: heller at common-lisp.net (CVS User heller)
Date: Sun, 04 Jan 2009 20:53:30 +0000
Subject: [slime-cvs] CVS slime
Message-ID: <E1LJZyU-0004iS-UC@common-lisp.net>

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

Modified Files:
	ChangeLog slime.el swank-cmucl.lisp 
Log Message:
* swank-cmucl.lisp (note-error-location): If possible, include the
filename.
* slime.el (slime-goto-location-position): Add :eof as position
kind.

--- /project/slime/cvsroot/slime/ChangeLog	2009/01/03 21:33:51	1.1630
+++ /project/slime/cvsroot/slime/ChangeLog	2009/01/04 20:53:30	1.1631
@@ -1,3 +1,10 @@
+2009-01-04  Helmut Eller  <heller at common-lisp.net>
+
+	* swank-cmucl.lisp (note-error-location): If possible, include the
+	filename.
+	* slime.el (slime-goto-location-position): Add a :eof as position
+	kind.
+
 2009-01-03  Helmut Eller  <heller at common-lisp.net>
 
 	* slime.el (slime-goto-location-buffer): Don't goto point-min.
--- /project/slime/cvsroot/slime/slime.el	2009/01/03 21:33:51	1.1095
+++ /project/slime/cvsroot/slime/slime.el	2009/01/04 20:53:30	1.1096
@@ -3423,7 +3423,9 @@
             (goto-char start-position)
             (slime-forward-positioned-source-path source-path))
            (t
-            (slime-forward-source-path source-path))))))
+            (slime-forward-source-path source-path))))
+    ((:eof)
+     (goto-char (point-max)))))
 
 (defun slime-eol-conversion-fixup (n)
   ;; Return the number of \r\n eol markers that we need to cross when
--- /project/slime/cvsroot/slime/swank-cmucl.lisp	2008/12/30 18:57:54	1.205
+++ /project/slime/cvsroot/slime/swank-cmucl.lisp	2009/01/04 20:53:30	1.206
@@ -479,16 +479,22 @@
 Return a `location' record, or (:error REASON) on failure."
   (if (null context)
       (note-error-location)
-      (let ((file (c::compiler-error-context-file-name context))
-            (source (c::compiler-error-context-original-source context))
-            (path
-             (reverse (c::compiler-error-context-original-source-path context))))
-        (or (locate-compiler-note file source path)
+      (with-struct (c::compiler-error-context- file-name 
+                                               original-source
+                                               original-source-path) context
+        (or (locate-compiler-note file-name original-source 
+                                  (reverse original-source-path))
             (note-error-location)))))
 
 (defun note-error-location ()
   "Pseudo-location for notes that can't be located."
-  (list :error "No error location available."))
+  (cond (*compile-file-truename*
+         (make-location (list :file (unix-truename *compile-file-truename*))
+                        (list :eof)))
+        (*buffer-name*
+         (make-location (list :buffer *buffer-name*)
+                        (list :position *buffer-start-position*)))
+        (t (list :error "No error location available."))))
 
 (defun locate-compiler-note (file source source-path)
   (cond ((and (eq file :stream) *buffer-name*)




From heller at common-lisp.net  Sun Jan  4 20:53:48 2009
From: heller at common-lisp.net (CVS User heller)
Date: Sun, 04 Jan 2009 20:53:48 +0000
Subject: [slime-cvs] CVS slime
Message-ID: <E1LJZym-0004jp-PY@common-lisp.net>

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

Modified Files:
	ChangeLog slime.el 
Log Message:
* slime.el (slime-local-variable-p): New function. XEmacs requires
two arguments.

--- /project/slime/cvsroot/slime/ChangeLog	2009/01/04 20:53:30	1.1631
+++ /project/slime/cvsroot/slime/ChangeLog	2009/01/04 20:53:48	1.1632
@@ -1,8 +1,13 @@
 2009-01-04  Helmut Eller  <heller at common-lisp.net>
 
+	* slime.el (slime-local-variable-p): New function. XEmacs requires
+	two arguments.
+
+2009-01-04  Helmut Eller  <heller at common-lisp.net>
+
 	* swank-cmucl.lisp (note-error-location): If possible, include the
 	filename.
-	* slime.el (slime-goto-location-position): Add a :eof as position
+	* slime.el (slime-goto-location-position): Add :eof as position
 	kind.
 
 2009-01-03  Helmut Eller  <heller at common-lisp.net>
--- /project/slime/cvsroot/slime/slime.el	2009/01/04 20:53:30	1.1096
+++ /project/slime/cvsroot/slime/slime.el	2009/01/04 20:53:48	1.1097
@@ -1011,14 +1011,14 @@
         (windows))
     (walk-windows (lambda (w) (push w windows)) nil t)
     (prog1 (pop-to-buffer (current-buffer))
-      (unless (local-variable-p 'slime-popup-buffer-restore-info)
+      (unless (slime-local-variable-p 'slime-popup-buffer-restore-info)
         (set (make-local-variable 'slime-popup-buffer-restore-info)
              (list (unless (memq (selected-window) windows)
                      (selected-window))
                    selected-window))))))
 
 (defun slime-close-popup-window ()
-  (assert (local-variable-p 'slime-popup-buffer-restore-info))
+  (assert (slime-local-variable-p 'slime-popup-buffer-restore-info))
   (destructuring-bind (created-window selected-window)
       slime-popup-buffer-restore-info
     (bury-buffer)
@@ -1031,7 +1031,7 @@
 
 (defmacro slime-save-local-variables (vars &rest body)
   `(let ((vals (cons (mapcar (lambda (var)
-                               (if (local-variable-p var)
+                               (if (slime-local-variable-p var)
                                    (cons var (eval var))))
                              ',vars)
                      (progn . ,body))))
@@ -8377,12 +8377,15 @@
     (apply #'run-hooks hooks)))
 
 (defun slime-line-number-at-pos ()
-  (cond ((fboundp 'line-number)
+  (cond ((fboundp 'line-number-at-pos)
+         (line-number-at-pos))  ; Emacs 22
+        ((fboundp 'line-number)
          (line-number))         ; XEmacs
-        ((fboundp 'line-number-at-pos)
-         (line-number-at-pos))  ; Recent GNU Emacs
         (t (1+ (count-lines 1 (point-at-bol))))))
 
+(defun slime-local-variable-p (var &optional buffer)
+  (local-variable-p var (or buffer (current-buffer)))) ; XEmacs
+
 (slime-defun-if-undefined next-single-char-property-change
     (position prop &optional object limit)
   (let ((limit (typecase limit




From heller at common-lisp.net  Sun Jan  4 20:54:00 2009
From: heller at common-lisp.net (CVS User heller)
Date: Sun, 04 Jan 2009 20:54:00 +0000
Subject: [slime-cvs] CVS slime
Message-ID: <E1LJZyy-0004kt-Sz@common-lisp.net>

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

Modified Files:
	ChangeLog slime.el 
Log Message:
Make it possible to limit the number of displayed restarts.

* slime.el (sldb-initial-restart-limit)
(sldb-insert-more-restarts): New.
(sldb-setup, sldb-insert-restarts): Use it.

--- /project/slime/cvsroot/slime/ChangeLog	2009/01/04 20:53:48	1.1632
+++ /project/slime/cvsroot/slime/ChangeLog	2009/01/04 20:54:00	1.1633
@@ -1,5 +1,13 @@
 2009-01-04  Helmut Eller  <heller at common-lisp.net>
 
+	Make it possible to limit the number of displayed restarts.
+
+	* slime.el (sldb-initial-restart-limit)
+	(sldb-insert-more-restarts): New.
+	(sldb-setup, sldb-insert-restarts): Use it.
+
+2009-01-04  Helmut Eller  <heller at common-lisp.net>
+
 	* slime.el (slime-local-variable-p): New function. XEmacs requires
 	two arguments.
 
--- /project/slime/cvsroot/slime/slime.el	2009/01/04 20:53:48	1.1097
+++ /project/slime/cvsroot/slime/slime.el	2009/01/04 20:54:00	1.1098
@@ -5315,6 +5315,11 @@
 (defvar sldb-hook nil
   "Hook run on entry to the debugger.")
 
+(defcustom sldb-initial-restart-limit 6
+  "Maximum number of restarts to display initially."
+  :group 'slime-debugger
+  :type 'integer)
+
 
 ;;;;; Local variables in the debugger buffer
 
@@ -5527,8 +5532,8 @@
       (setq sldb-restarts restarts)
       (setq sldb-continuations conts)
       (sldb-insert-condition condition)
-      (insert "\n\n" (in-sldb-face section "Restarts:") "\n")
-      (sldb-insert-restarts restarts)
+      (insert "\n\n" (in-sldb-face section "Restarts:"))
+      (sldb-insert-restarts restarts 0 sldb-initial-restart-limit)
       (insert "\n" (in-sldb-face section "Backtrace:") "\n")
       (setq sldb-backtrace-start-marker (point-marker))
       (save-excursion
@@ -5602,19 +5607,34 @@
            ;;(error "Unhandled extra element:" extra)
            )))))
 
-(defun sldb-insert-restarts (restarts)
+(defun sldb-insert-restarts (restarts start count)
   "Insert RESTARTS and add the needed text props
 RESTARTS should be a list ((NAME DESCRIPTION) ...)."
-  (loop for (name string) in restarts
-        for number from 0 do
+  (let* ((len (length restarts))
+         (end (if count (min (+ start count) len) len)))
+    (loop for (name string) in (subseq restarts start end)
+          for number from start do
+          (unless (bolp) (insert "\n"))
+          (slime-insert-propertized
+           `(, at nil restart-number ,number
+                   sldb-default-action sldb-invoke-restart
+                   mouse-face highlight)
+           " " (in-sldb-face restart-number (number-to-string number))
+           ": ["  (in-sldb-face restart-type name) "] "
+           (in-sldb-face restart string))
+          (insert "\n"))
+    (when (< end len)
+      (let ((pos (point)))
         (slime-insert-propertized
-         `(, at nil restart-number ,number
-                 sldb-default-action sldb-invoke-restart
-                 mouse-face highlight)
-         " " (in-sldb-face restart-number (number-to-string number))
-         ": ["  (in-sldb-face restart-type name) "] "
-         (in-sldb-face restart string))
-        (insert "\n")))
+         (list 'sldb-default-action 
+               (slime-rcurry #'sldb-insert-more-restarts restarts pos end))
+         " --more--\n")))))
+
+(defun sldb-insert-more-restarts (restarts position start)
+  (goto-char position)
+  (let ((inhibit-read-only t))
+    (delete-region position (1+ (line-end-position)))
+    (sldb-insert-restarts restarts start nil)))
 
 (defun sldb-frame.string (frame)
   (destructuring-bind (_ str &optional _) frame str))




From trittweiler at common-lisp.net  Mon Jan  5 11:14:13 2009
From: trittweiler at common-lisp.net (CVS User trittweiler)
Date: Mon, 05 Jan 2009 11:14:13 +0000
Subject: [slime-cvs] CVS slime
Message-ID: <E1LJnPR-0006Hu-Sv@common-lisp.net>

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

Modified Files:
	swank.lisp ChangeLog 
Log Message:
	Do not truncate error messages in SLDB.

	* swank.lisp (*sldb-bitvector-length*): Like *PRINT-LENGTH* for
	bit-vectors.
	(*sldb-string-length*): Likewise for strings.
	(*sldb-pprint-dispatch-table*): Truncate bit-vectors / strings
	according to the above variables.
	(*sldb-printer-bindings*): Use the new variables. Bind
	*PRINT-LINES* to NIL so error messages are not truncated.


--- /project/slime/cvsroot/slime/swank.lisp	2009/01/03 21:13:09	1.624
+++ /project/slime/cvsroot/slime/swank.lisp	2009/01/05 11:14:13	1.625
@@ -90,20 +90,62 @@
 (defvar *swank-debug-p* t
   "When true, print extra debugging information.")
 
+;;;;; SLDB customized pprint dispatch table
+;;;
+;;; CLHS 22.1.3.4, and CLHS 22.1.3.6 do not specify *PRINT-LENGTH* to
+;;; affect the printing of strings and bit-vectors.
+;;;
+;;; We use a customized pprint dispatch table to do it for us.
+
+(declaim (special *sldb-string-length*))
+(declaim (special *sldb-bitvector-length*))
+
+(defvar *sldb-pprint-dispatch-table*
+  (let ((initial-table (copy-pprint-dispatch nil))
+        (result-table  (copy-pprint-dispatch nil)))
+    (flet ((sldb-bitvector-pprint (stream bitvector)
+             ;;; Truncate bit-vectors according to *SLDB-BITVECTOR-LENGTH*.
+             (if (or (not *print-array*) (not *print-length*))
+                 (let ((*print-pprint-dispatch* initial-table))
+                   (write bitvector :stream stream))
+                 (loop initially (write-string "#*" stream)
+                       for i from 0 and bit across bitvector do
+                       (when (= i *sldb-bitvector-length*)
+                         (write-string "..." stream)
+                         (loop-finish))
+                       (write bit :stream stream))))
+           (sldb-string-pprint (stream string)
+             ;;; Truncate strings according to *SLDB-STRING-LENGTH*.
+             (if (or (not *print-array*) (not *print-length*))
+                 (let ((*print-pprint-dispatch* initial-table))
+                   (write string :stream stream))
+                 (loop initially (write-char #\" stream)
+                       for i from 0 and char across string do
+                       (when (= i *sldb-string-length*)
+                         (write-string "..." stream)
+                         (loop-finish))
+                       (write-char char stream)
+                       finally (write-char #\" stream)))))
+      (set-pprint-dispatch 'bit-vector #'sldb-bitvector-pprint 0 result-table)
+      (set-pprint-dispatch 'string #'sldb-string-pprint 0 result-table)
+      result-table)))
+
 (defvar *sldb-printer-bindings*
   `((*print-pretty*           . t)
     (*print-level*            . 4)
     (*print-length*           . 10)
     (*print-circle*           . t)
     (*print-readably*         . nil)
-    (*print-pprint-dispatch*  . ,(copy-pprint-dispatch nil))
+    (*print-pprint-dispatch*  . ,*sldb-pprint-dispatch-table*)
     (*print-gensym*           . t)
     (*print-base*             . 10)
     (*print-radix*            . nil)
     (*print-array*            . t)
-    (*print-lines*            . 10)
+    (*print-lines*            . nil)
     (*print-escape*           . t)
-    (*print-right-margin*     . 65))
+    (*print-right-margin*     . 65)
+    (*sldb-bitvector-length*  . 25)
+    (*sldb-string-length*     . 50))
   "A set of printer variables used in the debugger.")
 
 (defvar *backtrace-pprint-dispatch-table*
--- /project/slime/cvsroot/slime/ChangeLog	2009/01/04 20:54:00	1.1633
+++ /project/slime/cvsroot/slime/ChangeLog	2009/01/05 11:14:13	1.1634
@@ -1,3 +1,15 @@
+2009-01-05  Tobias C. Rittweiler  <tcr at freebits.de>
+
+	Do not truncate error messages in SLDB.
+
+	* swank.lisp (*sldb-bitvector-length*): Like *PRINT-LENGTH* for
+	bit-vectors.
+	(*sldb-string-length*): Likewise for strings.
+	(*sldb-pprint-dispatch-table*): Truncate bit-vectors / strings
+	according to the above variables.
+	(*sldb-printer-bindings*): Use the new variables. Bind
+	*PRINT-LINES* to NIL so error messages are not truncated.
+
 2009-01-04  Helmut Eller  <heller at common-lisp.net>
 
 	Make it possible to limit the number of displayed restarts.




From trittweiler at common-lisp.net  Mon Jan  5 11:19:09 2009
From: trittweiler at common-lisp.net (CVS User trittweiler)
Date: Mon, 05 Jan 2009 11:19:09 +0000
Subject: [slime-cvs] CVS slime
Message-ID: <E1LJnUD-0006PV-Kc@common-lisp.net>

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

Modified Files:
	swank-sbcl.lisp ChangeLog 
Log Message:
	* swank-sbcl.lisp (function-arglist):
	SB-INTROSPECT:FUNCTION-ARGLIST is deprecated in bleeding edge sbcl.


--- /project/slime/cvsroot/slime/swank-sbcl.lisp	2009/01/02 17:07:00	1.229
+++ /project/slime/cvsroot/slime/swank-sbcl.lisp	2009/01/05 11:19:09	1.230
@@ -335,6 +335,11 @@
 
 ;;; Utilities
 
+#+#.(swank-backend::sbcl-with-symbol 'function-lambda-list 'sb-introspect)
+(defimplementation arglist (fname)
+  (sb-introspect:function-lambda-list fname))
+
+#-#.(swank-backend::sbcl-with-symbol 'function-lambda-list 'sb-introspect)
 (defimplementation arglist (fname)
   (sb-introspect:function-arglist fname))
 
--- /project/slime/cvsroot/slime/ChangeLog	2009/01/05 11:14:13	1.1634
+++ /project/slime/cvsroot/slime/ChangeLog	2009/01/05 11:19:09	1.1635
@@ -1,5 +1,10 @@
 2009-01-05  Tobias C. Rittweiler  <tcr at freebits.de>
 
+	* swank-sbcl.lisp (function-arglist):
+	SB-INTROSPECT:FUNCTION-ARGLIST is deprecated in bleeding edge sbcl.
+
+2009-01-05  Tobias C. Rittweiler  <tcr at freebits.de>
+
 	Do not truncate error messages in SLDB.
 
 	* swank.lisp (*sldb-bitvector-length*): Like *PRINT-LENGTH* for




From heller at common-lisp.net  Mon Jan  5 15:54:11 2009
From: heller at common-lisp.net (CVS User heller)
Date: Mon, 05 Jan 2009 15:54:11 +0000
Subject: [slime-cvs] CVS slime
Message-ID: <E1LJrmN-00069p-FM@common-lisp.net>

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

Modified Files:
	ChangeLog slime.el 
Log Message:
* slime.el (slime-show-compilation-log): Insert two lines at
the beginning.  Emacs 21 seems to skip over those two.

--- /project/slime/cvsroot/slime/ChangeLog	2009/01/05 11:19:09	1.1635
+++ /project/slime/cvsroot/slime/ChangeLog	2009/01/05 15:54:10	1.1636
@@ -1,3 +1,8 @@
+2009-01-05  Helmut Eller  <heller at common-lisp.net>
+
+	* slime.el (slime-show-compilation-log): Insert two lines at
+	the beginning.  Emacs 21 seems to skip over those two.
+
 2009-01-05  Tobias C. Rittweiler  <tcr at freebits.de>
 
 	* swank-sbcl.lisp (function-arglist):
--- /project/slime/cvsroot/slime/slime.el	2009/01/04 20:54:00	1.1098
+++ /project/slime/cvsroot/slime/slime.el	2009/01/05 15:54:11	1.1099
@@ -2886,16 +2886,15 @@
     (slime-with-popup-buffer ("*SLIME Compilation*")
       (compilation-mode)
       (let ((inhibit-read-only t))
-        (insert (format "%d compiler notes:\n" (length notes)))
+        (insert (format "cd %s\n%d compiler notes:\n" 
+                        default-directory (length notes)))
         (dolist (note notes)
           (insert (format "%s%s:\n%s\n"
                           (slime-compilation-loc (slime-note.location note))
                           (substring (symbol-name (slime-note.severity note))
                                      1)
                           (slime-note.message note)))))
-      (unless compilation-scroll-output 
-        (goto-char (point-min)))
-      (setq next-error-last-buffer (current-buffer)))))
+      (goto-char (point-min)))))
 
 (defun slime-compilation-loc (location)
   (cond ((slime-location-p location)
@@ -2907,7 +2906,7 @@
                  (list (or (buffer-file-name) (buffer-name))
                        (slime-line-number-at-pos)
                        (1+ (current-column)))))
-           (format "%s:%d:%d:" (or filename "") line col)))
+           (format "%s:%d:%d: " (or filename "") line col)))
         (t "")))
 
 (defun slime-maybe-list-compiler-notes (notes)




From heller at common-lisp.net  Mon Jan  5 21:57:35 2009
From: heller at common-lisp.net (CVS User heller)
Date: Mon, 05 Jan 2009 21:57:35 +0000
Subject: [slime-cvs] CVS slime
Message-ID: <E1LJxS3-0003Hv-80@common-lisp.net>

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

Modified Files:
	ChangeLog slime.el 
Log Message:
* slime.el (slime-with-popup-buffer): New argment: select.
If nil (default) buffer will only be displayed but not selected.

--- /project/slime/cvsroot/slime/ChangeLog	2009/01/05 15:54:10	1.1636
+++ /project/slime/cvsroot/slime/ChangeLog	2009/01/05 21:57:34	1.1637
@@ -1,5 +1,10 @@
 2009-01-05  Helmut Eller  <heller at common-lisp.net>
 
+	* slime.el (slime-with-popup-buffer): New argment: select.
+	If nil (default) buffer will only be displayed but not selected.
+
+2009-01-05  Helmut Eller  <heller at common-lisp.net>
+
 	* slime.el (slime-show-compilation-log): Insert two lines at
 	the beginning.  Emacs 21 seems to skip over those two.
 
--- /project/slime/cvsroot/slime/slime.el	2009/01/05 15:54:11	1.1099
+++ /project/slime/cvsroot/slime/slime.el	2009/01/05 21:57:35	1.1100
@@ -955,8 +955,8 @@
    "The emacs snapshot \"fingerprint\" after displaying the buffer."))
 
 ;; Interface
-(defmacro* slime-with-popup-buffer ((name &optional package
-                                          connection emacs-snapshot)
+(defmacro* slime-with-popup-buffer ((name &optional package connection select
+                                          emacs-snapshot)
                                     &body body)
   "Similar to `with-output-to-temp-buffer'.
 Bind standard-output and initialize some buffer-local variables.
@@ -981,15 +981,17 @@
          (assert (eq (current-buffer) standard-output))
          (setq buffer-read-only t)
          (slime-init-popup-buffer vars%)
-         (slime-display-popup-buffer)))))
+         (slime-display-popup-buffer ,(or select 'nil))))))
 
 (put 'slime-with-popup-buffer 'lisp-indent-function 1)
 
 (defun slime-make-popup-buffer (name buffer-vars)
   "Return a temporary buffer called NAME.
 The buffer also uses the minor-mode `slime-popup-buffer-mode'."
-  (when (and (get-buffer name) (kill-buffer (get-buffer name))))
-  (with-current-buffer (get-buffer-create name)
+  (with-current-buffer (or (get-buffer name) (get-buffer-create name))
+    (kill-all-local-variables)
+    (setq buffer-read-only nil)
+    (erase-buffer)
     (set-syntax-table lisp-mode-syntax-table)
     (slime-init-popup-buffer buffer-vars)
     (current-buffer)))
@@ -1003,31 +1005,35 @@
                         slime-popup-buffer-saved-emacs-snapshot)
     buffer-vars))
 
-(defun slime-display-popup-buffer ()
+(defun slime-display-popup-buffer (select)
   "Display the current buffer.
 Save the selected-window in a buffer-local variable, so that we
 can restore it later."
   (let ((selected-window (selected-window))
         (windows))
     (walk-windows (lambda (w) (push w windows)) nil t)
-    (prog1 (pop-to-buffer (current-buffer))
+    (let ((new-window (display-buffer (current-buffer))))
       (unless (slime-local-variable-p 'slime-popup-buffer-restore-info)
         (set (make-local-variable 'slime-popup-buffer-restore-info)
-             (list (unless (memq (selected-window) windows)
-                     (selected-window))
-                   selected-window))))))
+             (list (unless (memq new-window windows)
+                     new-window)
+                   selected-window)))
+      (when select
+        (select-window new-window))
+      (current-buffer))))
 
 (defun slime-close-popup-window ()
-  (assert (slime-local-variable-p 'slime-popup-buffer-restore-info))
-  (destructuring-bind (created-window selected-window)
-      slime-popup-buffer-restore-info
-    (bury-buffer)
-    (when (and (eq created-window (selected-window))
-               (not (eq (next-window created-window) created-window)))
-      (delete-window created-window))
-    (when (window-live-p selected-window)
-      (select-window selected-window)))
-  (kill-local-variable 'slime-popup-buffer-restore-info))
+  (cond ((slime-local-variable-p 'slime-popup-buffer-restore-info)
+         (destructuring-bind (created-window selected-window)
+             slime-popup-buffer-restore-info
+           (bury-buffer)
+           (when (and (eq created-window (selected-window))
+                      (not (eq (next-window created-window) created-window)))
+             (delete-window created-window))
+           (when (window-live-p selected-window)
+             (select-window selected-window)))
+         (kill-local-variable 'slime-popup-buffer-restore-info))
+        (t (bury-buffer))))
 
 (defmacro slime-save-local-variables (vars &rest body)
   `(let ((vals (cons (mapcar (lambda (var)
@@ -4350,7 +4356,7 @@
 
 (defun slime-edit-value-callback (form-string current-value package)
   (let* ((name (generate-new-buffer-name (format "*Edit %s*" form-string)))
-         (buffer (slime-with-popup-buffer (name package t)
+         (buffer (slime-with-popup-buffer (name package t t)
                   (lisp-mode)
                   (slime-mode 1)
                   (slime-popup-buffer-mode -1) ; don't want binding of 'q'
@@ -4869,7 +4875,7 @@
                                    &body body)
   "Execute BODY in a xref buffer, then show that buffer."
   `(let ((xref-buffer-name% (format "*XREF[%s: %s]*" ,xref-type ,symbol)))
-     (slime-with-popup-buffer (xref-buffer-name% ,package t ,emacs-snapshot)
+     (slime-with-popup-buffer (xref-buffer-name% ,package t t ,emacs-snapshot)
        (slime-xref-mode)
        (slime-set-truncate-lines)
        (setq slime-popup-buffer-quit-function 'slime-xref-quit)
@@ -5540,7 +5546,7 @@
             (sldb-insert-frames (sldb-prune-initial-frames frames) t)
           (insert "[No backtrace]")))
       (run-hooks 'sldb-hook))
-    (slime-display-popup-buffer)
+    (slime-display-popup-buffer t)
     (sldb-recenter-region (point-min) (point))
     (setq buffer-read-only t)
     (when (and slime-stack-eval-tags
@@ -6782,17 +6788,19 @@
 BODY is a series of forms which are evaluated when the selector
 is chosen. The returned buffer is selected with
 switch-to-buffer."
-  `(setq slime-selector-methods
-         (sort* (cons (list ,key ,description
-                            (lambda () 
-                              (let ((buffer (progn , at body)))
-                                (cond ((get-buffer buffer)
-                                       (switch-to-buffer buffer))
-                                      (t
-                                       (message "No such buffer: %S" buffer)
-                                       (ding))))))
-                      (remove* ,key slime-selector-methods :key #'car))
-                #'< :key #'car)))
+  (let ((method `(lambda () 
+                   (let ((buffer (progn , at body)))
+                     (cond ((not (get-buffer buffer))
+                            (message "No such buffer: %S" buffer)
+                            (ding))
+                           ((get-buffer-window buffer)
+                            (select-window (get-buffer-window buffer)))
+                           (t
+                            (switch-to-buffer buffer)))))))
+    `(setq slime-selector-methods
+           (sort* (cons (list ,key ,description ,method)
+                        (remove* ,key slime-selector-methods :key #'car))
+                  #'< :key #'car))))
 
 (def-slime-selector-method ?? "Selector help buffer."
   (ignore-errors (kill-buffer "*Select Help*"))




From heller at common-lisp.net  Mon Jan  5 21:57:54 2009
From: heller at common-lisp.net (CVS User heller)
Date: Mon, 05 Jan 2009 21:57:54 +0000
Subject: [slime-cvs] CVS slime
Message-ID: <E1LJxSM-0003Iq-Ea@common-lisp.net>

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

Modified Files:
	ChangeLog slime.el 
Log Message:
Use keymap inheritance to share bindings in various modes.

* slime.el (slime-parent-map): New keymap.
(slime-mode-map, slime-popup-buffer-mode-map, sldb-mode-map)
(slime-inspector-mode-map): Use it.
(slime-parent-bindings, slime-prefix-bindings): New variables.
(slime-prefix-key, slime-define-key): Deleted.

Update contribs accordinly.

--- /project/slime/cvsroot/slime/ChangeLog	2009/01/05 21:57:34	1.1637
+++ /project/slime/cvsroot/slime/ChangeLog	2009/01/05 21:57:54	1.1638
@@ -1,8 +1,21 @@
 2009-01-05  Helmut Eller  <heller at common-lisp.net>
 
+	Use keymap inheritance to share bindings in various modes.
+
+	* slime.el (slime-parent-map): New keymap.
+	(slime-mode-map, slime-popup-buffer-mode-map, sldb-mode-map)
+	(slime-inspector-mode-map): Use it.
+	(slime-parent-bindings, slime-prefix-bindings): New variables.
+	(slime-prefix-key, slime-define-key): Deleted.
+
+	Update contribs accordinly.
+
+2009-01-05  Helmut Eller  <heller at common-lisp.net>
+
 	* slime.el (slime-with-popup-buffer): New argment: select.
 	If nil (default) buffer will only be displayed but not selected.
 
+
 2009-01-05  Helmut Eller  <heller at common-lisp.net>
 
 	* slime.el (slime-show-compilation-log): Insert two lines at
--- /project/slime/cvsroot/slime/slime.el	2009/01/05 21:57:35	1.1100
+++ /project/slime/cvsroot/slime/slime.el	2009/01/05 21:57:54	1.1101
@@ -502,58 +502,67 @@
 
 ;;;;; Key bindings
 
-;; See `slime-define-key' below for keyword meanings.
+(defvar slime-parent-map (make-sparse-keymap)
+  "Parent keymap parent for various Slime related modes.")
+
+(defvar slime-parent-bindings
+  '(("\M-."      slime-edit-definition)
+    ("\M-,"      slime-pop-find-definition-stack)
+    ("\C-x4." 	 slime-edit-definition-other-window)
+    ("\C-x5." 	 slime-edit-definition-other-frame)
+    ("\C-x\C-e"  slime-eval-last-expression)
+    ("\C-\M-x"   slime-eval-defun)
+    ("\C-c"	 slime-prefix-map)))
+
+(defvar slime-prefix-map (make-sparse-keymap)
+  "Keymap for commands prefixed with `slime-prefix-key'.")
+
+(defvar slime-prefix-bindings
+  '(("\C-r"  slime-eval-region)
+    (":"     slime-interactive-eval)
+    ("\C-e"  slime-interactive-eval)
+    ("E"     slime-edit-value)
+    ("\C-l"  slime-load-file)
+    ("\C-b"  slime-interrupt)
+    ("\M-d"  slime-disassemble-symbol)
+    ("\C-t"  slime-toggle-trace-fdefinition)
+    ("I"     slime-inspect)
+    ("\C-xt" slime-list-threads)
+    ("\C-xc" slime-list-connections)
+    ("<"     slime-list-callers)
+    (">"     slime-list-callees)
+    ("\C-d"  slime-doc-map)
+    ("\C-w"  slime-who-map)
+    ;;("\C-z" slime-switch-to-output-buffer :prefixed t :sldb t)
+    ))
+
 (defvar slime-keys
   '(;; Compiler notes
-    ("\M-p" slime-previous-note)
-    ("\M-n" slime-next-note)
-    ("\M-c" slime-remove-notes :prefixed t)
-    ("\C-k" slime-compile-and-load-file :prefixed t)
-    ("\M-k" slime-compile-file :prefixed t)
-    ("\C-c" slime-compile-defun :prefixed t)
-    ("\C-l" slime-load-file :prefixed t)
+    ("\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)
     ;; Editing/navigating
-    ("\M-\C-i" slime-complete-symbol :inferior t)
-    ("\C-i" slime-complete-symbol :prefixed t :inferior t)
-    ("\M-." slime-edit-definition :inferior t :sldb t)
-    ("\C-x4." slime-edit-definition-other-window :inferior t :sldb t)
-    ("\C-x5." slime-edit-definition-other-frame :inferior t :sldb t)
-    ("\M-," slime-pop-find-definition-stack :inferior t :sldb t)
+    ("\M-\C-i"    slime-complete-symbol)
+    ("\C-c\C-i"   slime-complete-symbol)
     ;; Evaluating
-    ("\C-x\C-e" slime-eval-last-expression :inferior t)
-    ("\C-x\M-e" slime-eval-last-expression-display-output :inferior t)
-    ("\C-p" slime-pprint-eval-last-expression :prefixed t :inferior t)
-    ("\C-r" slime-eval-region :prefixed t :inferior t)
-    ("\C-\M-x" slime-eval-defun)
-    (":"    slime-interactive-eval :prefixed t :sldb t)
-    ("\C-e" slime-interactive-eval :prefixed t :sldb t :inferior t)
-    ("\C-y" slime-call-defun :prefixed t)
-    ("E"    slime-edit-value :prefixed t :sldb t :inferior t)
-    ;;("\C-z" slime-switch-to-output-buffer :prefixed t :sldb t)
-    ("\C-b" slime-interrupt :prefixed t :inferior t :sldb t)
-    ("\M-g" slime-quit :prefixed t :inferior t :sldb t)
+    ;;("\C-x\M-e" slime-eval-last-expression-display-output :inferior t)
+    ("\C-c\C-p"   slime-pprint-eval-last-expression)
+    ("\C-c\C-y"   slime-call-defun)
+    ;;("\M-g"     slime-quit :prefixed t :inferior t :sldb t)
     ;; Documentation
-    (" " slime-space :inferior t)
-    ("\C-f" slime-describe-function :prefixed t :inferior t :sldb t)
-    ("\M-d" slime-disassemble-symbol :prefixed t :inferior t :sldb t)
-    ("\C-t" slime-toggle-trace-fdefinition :prefixed t :sldb t)
-    ("\C-u" slime-undefine-function :prefixed t)
-    ("\C-m" slime-macroexpand-1 :prefixed t :inferior t)
-    ("\M-m" slime-macroexpand-all :prefixed t :inferior t)
-    ("\M-0" slime-restore-window-configuration :prefixed t :inferior t)
-    ([(control meta ?\.)] slime-next-location :inferior t)
-    ("~" slime-sync-package-and-default-directory :prefixed t :inferior t)
-    ;;("\M-p" slime-repl-set-package :prefixed t :inferior t)
-    ;; Cross reference
-    ("<" slime-list-callers :prefixed t :inferior t :sldb t)
-    (">" slime-list-callees :prefixed t :inferior t :sldb t)
-    ;; "Other"
-    ("\I"  slime-inspect :prefixed t :inferior t :sldb t)
-    ("\C-xt" slime-list-threads :prefixed t :inferior t :sldb t)
-    ("\C-xc" slime-list-connections :prefixed t :inferior t :sldb t)
+    (" "          slime-space)
+    ("\C-c\C-f"   slime-describe-function)
+    ("\C-c\C-u"   slime-undefine-function)
+    ("\C-c\C-m"   slime-macroexpand-1)
+    ("\C-c\M-m"   slime-macroexpand-all)
+    ("\C-c\M-0"   slime-restore-window-configuration)
+    ([?\C-\M-.]   slime-next-location)
     ;; ;; Shadow unwanted bindings from inf-lisp
-    ;; ("\C-a" slime-nop :prefixed t :inferior t :sldb t)
-    ;; ("\C-v" slime-nop :prefixed t :inferior t :sldb t)
+    ;; ("\C-a"    slime-nop :prefixed t :inferior t :sldb t)
+    ;; ("\C-v"    slime-nop :prefixed t :inferior t :sldb t)
     ))
 
 (defun slime-nop ()
@@ -585,36 +594,27 @@
     (?m slime-who-macroexpands)
     (?a slime-who-specializes)))
 
-;; Maybe a good idea, maybe not..
-(defvar slime-prefix-key "\C-c"
-  "The prefix key to use in SLIME keybinding sequences.")
-
-(defvar slime-prefix-map (make-sparse-keymap)
-  "Keymap for commands prefixed with `slime-prefix-key'.")
-
-(defun* slime-define-key (key command &key prefixed)
-  "Define a keybinding of KEY for COMMAND.
-If PREFIXED is non-nil, `slime-prefix-key' is prepended to KEY."
-  (cond (prefixed (define-key slime-prefix-map key command))
-        (t (define-key slime-mode-map key command))))
-
 (defun slime-init-keymaps ()
   "(Re)initialize the keymaps for `slime-mode'."
   (interactive)
-  (setq slime-prefix-map (make-sparse-keymap))
-  (define-key slime-mode-map slime-prefix-key slime-prefix-map)
-  (loop for (key command . keys) in slime-keys
-        do (apply #'slime-define-key key command :allow-other-keys t keys))
   ;; Documentation
-  (setq slime-doc-map (make-sparse-keymap))
+  (define-prefix-command 'slime-doc-map)
   (slime-define-both-key-bindings slime-doc-map slime-doc-bindings)
-  ;; C-c C-d is the prefix for the doc map.
-  (slime-define-key "\C-d" slime-doc-map :prefixed t)
   ;; Who-xref
-  (setq slime-who-map (make-sparse-keymap))
+  (define-prefix-command 'slime-who-map)
   (slime-define-both-key-bindings slime-who-map slime-who-bindings)
-  ;; C-c C-w is the prefix for the who-xref map.
-  (slime-define-key "\C-w" slime-who-map :prefixed t))
+  ;; 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)
   (loop for (char command) in bindings do
@@ -1057,6 +1057,8 @@
     ;;("\C-c\C-z" . slime-switch-to-output-buffer)
     ("\M-." . slime-edit-definition)))
 
+(set-keymap-parent slime-popup-buffer-mode-map slime-parent-map)
+
 (make-variable-buffer-local
  (defvar slime-popup-buffer-quit-function 'slime-popup-buffer-quit
    "The function that is used to quit a temporary popup buffer."))
@@ -5422,6 +5424,8 @@
   ;; Make original slime-connection "sticky" for SLDB commands in this buffer
   (setq slime-buffer-connection (slime-connection)))
 
+(set-keymap-parent sldb-mode-map slime-parent-map)
+
 (slime-define-keys sldb-mode-map
   ("h"    'describe-mode)
   ("v"    'sldb-show-source)
@@ -5458,13 +5462,6 @@
   ("\C-c\C-c" 'sldb-recompile-frame-source)
   ("\C-c\C-d" slime-doc-map))
 
-;; Inherit bindings from slime-mode
-(dolist (spec slime-keys)
-  (destructuring-bind (key command &key sldb prefixed &allow-other-keys) spec
-    (when sldb
-      (let ((key (if prefixed (concat slime-prefix-key key) key)))
-        (define-key sldb-mode-map key command)))))
-
 ;; Keys 0-9 are shortcuts to invoke particular restarts.
 (dotimes (number 10)
   (let ((fname (intern (format "sldb-invoke-restart-%S" number)))
@@ -6726,6 +6723,8 @@
              (list (append i2 i1) l2 s2 e1))
             (t (error "Invalid chunks"))))))
 
+(set-keymap-parent slime-inspector-mode-map slime-parent-map)
+
 (slime-define-keys slime-inspector-mode-map
   ([return] 'slime-inspector-operate-on-point)
   ((kbd "M-RET") 'slime-inspector-copy-down)
@@ -6742,9 +6741,7 @@
   ("\C-i" 'slime-inspector-next-inspectable-object)
   ([(shift tab)] 'slime-inspector-previous-inspectable-object) ; Emacs translates S-TAB
   ([backtab]     'slime-inspector-previous-inspectable-object) ; to BACKTAB on X.
-  ("\M-." 'slime-edit-definition)
-  ("." 'slime-inspector-show-source)
-  (slime-prefix-key slime-prefix-map))
+  ("." 'slime-inspector-show-source))
 
 
 ;;;; Buffer selector




From heller at common-lisp.net  Mon Jan  5 21:57:54 2009
From: heller at common-lisp.net (CVS User heller)
Date: Mon, 05 Jan 2009 21:57:54 +0000
Subject: [slime-cvs] CVS slime/contrib
Message-ID: <E1LJxSM-0003J7-Ok@common-lisp.net>

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

Modified Files:
	inferior-slime.el slime-presentations.el slime-repl.el 
Log Message:
Use keymap inheritance to share bindings in various modes.

* slime.el (slime-parent-map): New keymap.
(slime-mode-map, slime-popup-buffer-mode-map, sldb-mode-map)
(slime-inspector-mode-map): Use it.
(slime-parent-bindings, slime-prefix-bindings): New variables.
(slime-prefix-key, slime-define-key): Deleted.

Update contribs accordinly.

--- /project/slime/cvsroot/slime/contrib/inferior-slime.el	2008/12/31 11:25:22	1.5
+++ /project/slime/cvsroot/slime/contrib/inferior-slime.el	2009/01/05 21:57:54	1.6
@@ -79,20 +79,13 @@
 
 (defun inferior-slime-init-keymap ()
   (let ((map inferior-slime-mode-map))
+    (set-keymap-parent map slime-parent-map)
     (slime-define-keys map
       ([return]			'inferior-slime-return)
       ([(control return)]	'inferior-slime-closing-return)
       ([(meta control ?m)]	'inferior-slime-closing-return)
       ("\t"			'slime-indent-and-complete-symbol)
-      (" "			'slime-space)
-      ("\C-c\C-d" slime-doc-map)
-      ("\C-c\C-w" slime-who-map))
-    (loop for (key command . keys) in slime-keys do
-	  (destructuring-bind (&key prefixed inferior &allow-other-keys) keys
-	    (when prefixed
-	      (setq key (concat slime-prefix-key key)))
-	    (when inferior
-	      (define-key map key command))))))
+      (" "			'slime-space))))
 
 (inferior-slime-init-keymap)
 
--- /project/slime/cvsroot/slime/contrib/slime-presentations.el	2008/09/24 09:14:02	1.20
+++ /project/slime/cvsroot/slime/contrib/slime-presentations.el	2009/01/05 21:57:54	1.21
@@ -698,10 +698,7 @@
 				  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.
-  (slime-define-key "\C-v" slime-presentation-command-map :prefixed t)
-  (define-key slime-repl-mode-map "\C-c\C-v" slime-presentation-command-map)
-  (define-key sldb-mode-map "\C-c\C-v" slime-presentation-command-map)
-  (define-key slime-inspector-mode-map "\C-c\C-v" slime-presentation-command-map))
+  (define-key slime-prefix-map "\C-v" slime-presentation-command-map))
 
 (defun slime-presentation-around-or-before-point-p ()
   (multiple-value-bind (presentation beg end) 
--- /project/slime/cvsroot/slime/contrib/slime-repl.el	2009/01/04 20:53:06	1.9
+++ /project/slime/cvsroot/slime/contrib/slime-repl.el	2009/01/05 21:57:54	1.10
@@ -413,18 +413,17 @@
 
 (defvar slime-repl-mode-map)
 
-(setq slime-repl-mode-map (make-sparse-keymap))
-(set-keymap-parent slime-repl-mode-map lisp-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))
+
+(slime-define-keys slime-prefix-map
+  ("\C-z" 'slime-switch-to-output-buffer)
+  ("\M-p" 'slime-repl-set-package))
 
-(dolist (spec slime-keys)
-  (destructuring-bind (key command &key inferior prefixed 
-                           &allow-other-keys) spec
-    (when inferior
-      (let ((key (if prefixed (concat slime-prefix-key key) key)))
-        (define-key slime-repl-mode-map key command)))))
-
-(slime-define-keys slime-mode-map
-  ("\C-c\C-z" 'slime-switch-to-output-buffer))
+(slime-define-keys slime-mode-map 
+  ("~" 'slime-sync-package-and-default-directory))
 
 (slime-define-keys slime-connection-list-mode-map
   ((kbd "RET") 'slime-goto-connection)
@@ -444,8 +443,8 @@
   ((kbd "C-<down>") 'slime-repl-forward-input)
   ("\M-r" 'slime-repl-previous-matching-input)
   ("\M-s" 'slime-repl-next-matching-input)
-  ("\C-c\C-c" 'slime-interrupt)
   ("\C-c\C-b" 'slime-interrupt)
+  ("\C-c\C-c" 'slime-interrupt)
   ("\C-c:"    'slime-interactive-eval)
   ("\C-c\C-e" 'slime-interactive-eval)
   ("\C-cE"     'slime-edit-value)




From heller at common-lisp.net  Mon Jan  5 21:58:05 2009
From: heller at common-lisp.net (CVS User heller)
Date: Mon, 05 Jan 2009 21:58:05 +0000
Subject: [slime-cvs] CVS slime
Message-ID: <E1LJxSX-0003KB-Va@common-lisp.net>

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

Modified Files:
	ChangeLog slime.el 
Log Message:
Create a compilation-log buffer so that next-error works but
don't display the buffer.

* slime.el (slime-create-compilation-log): New function.
(slime-compilation-finished-hook): Use it.

--- /project/slime/cvsroot/slime/ChangeLog	2009/01/05 21:57:54	1.1638
+++ /project/slime/cvsroot/slime/ChangeLog	2009/01/05 21:58:05	1.1639
@@ -1,5 +1,13 @@
 2009-01-05  Helmut Eller  <heller at common-lisp.net>
 
+	Create a compilation-log buffer so that next-error works but
+	don't display the buffer.
+
+	* slime.el (slime-create-compilation-log): New function.
+	(slime-compilation-finished-hook): Use it.
+
+2009-01-05  Helmut Eller  <heller at common-lisp.net>
+
 	Use keymap inheritance to share bindings in various modes.
 
 	* slime.el (slime-parent-map): New keymap.
--- /project/slime/cvsroot/slime/slime.el	2009/01/05 21:57:54	1.1101
+++ /project/slime/cvsroot/slime/slime.el	2009/01/05 21:58:05	1.1102
@@ -2611,11 +2611,12 @@
 The function receive two arguments: the beginning and the end of the 
 region that will be compiled.")
 
-(defcustom slime-compilation-finished-hook 'slime-maybe-show-compilation-log
+(defcustom slime-compilation-finished-hook 'slime-create-compilation-log
   "Hook called with a list of compiler notes after a compilation."
   :group 'slime-mode
   :type 'hook
-  :options '(slime-maybe-show-compilation-log
+  :options '(slime-create-compilation-log
+             slime-show-compilation-log
              slime-maybe-list-compiler-notes
              slime-list-compiler-notes
              slime-maybe-show-xrefs-for-notes
@@ -2883,26 +2884,33 @@
 (defun slime-note-has-location-p (note)
   (not (eq ':error (car (slime-note.location note)))))
 
-(defun slime-maybe-show-compilation-log (notes)
-  "Show NOTES in a `compilation-mode' buffer, if NOTES isn't nil"
-  (unless (null notes)
-    (slime-show-compilation-log notes)))
+(defun slime-create-compilation-log (notes)
+  "Create a buffer for `next-error' to use."
+  (with-current-buffer (get-buffer-create "*SLIME Compilation*")
+    (let ((inhibit-read-only t))
+      (erase-buffer))
+    (slime-insert-compilation-log notes)))
 
 (defun slime-show-compilation-log (notes)
   (interactive (list (slime-compiler-notes)))
-  (with-temp-message "Preparing compiler note tree..."
-    (slime-with-popup-buffer ("*SLIME Compilation*")
-      (compilation-mode)
-      (let ((inhibit-read-only t))
-        (insert (format "cd %s\n%d compiler notes:\n" 
-                        default-directory (length notes)))
-        (dolist (note notes)
-          (insert (format "%s%s:\n%s\n"
-                          (slime-compilation-loc (slime-note.location note))
-                          (substring (symbol-name (slime-note.severity note))
-                                     1)
-                          (slime-note.message note)))))
-      (goto-char (point-min)))))
+  (slime-with-popup-buffer ("*SLIME Compilation*")
+    (slime-insert-compilation-log notes)))
+
+(defun slime-insert-compilation-log (notes)
+  "Insert NOTES in format suitable for `compilation-mode'."
+  (with-temp-message "Preparing compilation log..."
+    (compilation-mode)
+    (let ((inhibit-read-only t))
+      (insert (format "cd %s\n%d compiler notes:\n" 
+                      default-directory (length notes)))
+      (dolist (note notes)
+        (insert (format "%s%s:\n%s\n"
+                        (slime-compilation-loc (slime-note.location note))
+                        (substring (symbol-name (slime-note.severity note))
+                                   1)
+                        (slime-note.message note)))))
+    (goto-char (point-min))
+    (setq next-error-last-buffer (current-buffer))))
 
 (defun slime-compilation-loc (location)
   (cond ((slime-location-p location)




From heller at common-lisp.net  Mon Jan  5 21:58:14 2009
From: heller at common-lisp.net (CVS User heller)
Date: Mon, 05 Jan 2009 21:58:14 +0000
Subject: [slime-cvs] CVS slime
Message-ID: <E1LJxSg-0003Kr-N7@common-lisp.net>

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

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

--- /project/slime/cvsroot/slime/ChangeLog	2009/01/05 21:58:05	1.1639
+++ /project/slime/cvsroot/slime/ChangeLog	2009/01/05 21:58:14	1.1640
@@ -23,7 +23,6 @@
 	* slime.el (slime-with-popup-buffer): New argment: select.
 	If nil (default) buffer will only be displayed but not selected.
 
-
 2009-01-05  Helmut Eller  <heller at common-lisp.net>
 
 	* slime.el (slime-show-compilation-log): Insert two lines at




From heller at common-lisp.net  Mon Jan  5 21:58:22 2009
From: heller at common-lisp.net (CVS User heller)
Date: Mon, 05 Jan 2009 21:58:22 +0000
Subject: [slime-cvs] CVS slime
Message-ID: <E1LJxSo-0003LQ-2W@common-lisp.net>

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

Modified Files:
	slime.el 
Log Message:
*** empty log message ***

--- /project/slime/cvsroot/slime/slime.el	2009/01/05 21:58:05	1.1102
+++ /project/slime/cvsroot/slime/slime.el	2009/01/05 21:58:21	1.1103
@@ -503,7 +503,7 @@
 ;;;;; Key bindings
 
 (defvar slime-parent-map (make-sparse-keymap)
-  "Parent keymap parent for various Slime related modes.")
+  "Parent keymap for various Slime related modes.")
 
 (defvar slime-parent-bindings
   '(("\M-."      slime-edit-definition)




From heller at common-lisp.net  Wed Jan  7 09:21:44 2009
From: heller at common-lisp.net (CVS User heller)
Date: Wed, 07 Jan 2009 09:21:44 +0000
Subject: [slime-cvs] CVS slime
Message-ID: <E1LKUbg-0005PR-IK@common-lisp.net>

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

Modified Files:
	ChangeLog slime.el 
Log Message:
* slime.el (slime-keys): Remove the binding for C-c C-i. M-TAB
can also be pressed with M-C-i which is probably not taken
by the window manager.  ESC TAB would also work.  Maybe we
should reuse C-c C-i for slime-inspect.
Move C-c C-y to slime-repl.e.
Remove C-c C-f: it's already on C-c C-d f.
Remove C-c M-0: slime-restore-window-configuration doesn't exist.
Remove M-g: slime-quit doesn't work since ages.

* slime-repl.el (slime-mode-map): Bind C-c~ not ~.
Reported by James Wright.
(slime-repl-mode-map): Bind M-TAB.
Remove C-c C-k: compiling the REPL buffer doesn't work anyway.
Remove C-cC-b, C-c:, C-cE, C-cC-d, C-cC-w, C-M-x, C-cC-t, C-cC-l:
those are already bound in slime-parent-map.

--- /project/slime/cvsroot/slime/ChangeLog	2009/01/05 21:58:14	1.1640
+++ /project/slime/cvsroot/slime/ChangeLog	2009/01/07 09:21:44	1.1641
@@ -1,3 +1,14 @@
+2009-01-07  Helmut Eller  <heller at common-lisp.net>
+
+	* slime.el (slime-keys): Remove the binding for C-c C-i. M-TAB
+	can also be pressed with M-C-i which is probably not taken
+	by the window manager.  ESC TAB would also work.  Maybe we
+	should reuse C-c C-i for slime-inspect.
+	Move C-c C-y to slime-repl.e.
+	Remove C-c C-f: it's already on C-c C-d f.
+	Remove C-c M-0: slime-restore-window-configuration doesn't exist.
+	Remove M-g: slime-quit doesn't work since ages.
+
 2009-01-05  Helmut Eller  <heller at common-lisp.net>
 
 	Create a compilation-log buffer so that next-error works but
--- /project/slime/cvsroot/slime/slime.el	2009/01/05 21:58:21	1.1103
+++ /project/slime/cvsroot/slime/slime.el	2009/01/07 09:21:44	1.1104
@@ -544,21 +544,16 @@
     ("\C-c\C-k"   slime-compile-and-load-file)
     ("\C-c\M-k"   slime-compile-file)
     ("\C-c\C-c"   slime-compile-defun)
-    ;; Editing/navigating
-    ("\M-\C-i"    slime-complete-symbol)
-    ("\C-c\C-i"   slime-complete-symbol)
+    ;; Editing
+    ("\M-\t"      slime-complete-symbol)
+    (" "          slime-space)
     ;; Evaluating
     ;;("\C-x\M-e" slime-eval-last-expression-display-output :inferior t)
     ("\C-c\C-p"   slime-pprint-eval-last-expression)
-    ("\C-c\C-y"   slime-call-defun)
-    ;;("\M-g"     slime-quit :prefixed t :inferior t :sldb t)
-    ;; Documentation
-    (" "          slime-space)
-    ("\C-c\C-f"   slime-describe-function)
+    ;; Misc
     ("\C-c\C-u"   slime-undefine-function)
     ("\C-c\C-m"   slime-macroexpand-1)
     ("\C-c\M-m"   slime-macroexpand-all)
-    ("\C-c\M-0"   slime-restore-window-configuration)
     ([?\C-\M-.]   slime-next-location)
     ;; ;; Shadow unwanted bindings from inf-lisp
     ;; ("\C-a"    slime-nop :prefixed t :inferior t :sldb t)
@@ -3387,7 +3382,8 @@
     ((:file filename)
      (let ((filename (slime-from-lisp-filename filename)))
        (slime-check-location-filename-sanity filename)
-       (set-buffer (find-file-noselect filename))))
+       (set-buffer (or (get-file-buffer filename)
+                       (find-file-noselect filename)))))
     ((:buffer buffer-name)
      (slime-check-location-buffer-name-sanity buffer-name)
      (set-buffer buffer-name))




From heller at common-lisp.net  Wed Jan  7 09:21:45 2009
From: heller at common-lisp.net (CVS User heller)
Date: Wed, 07 Jan 2009 09:21:45 +0000
Subject: [slime-cvs] CVS slime/contrib
Message-ID: <E1LKUbh-0005Pe-4E@common-lisp.net>

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

Modified Files:
	ChangeLog slime-repl.el 
Log Message:
* slime.el (slime-keys): Remove the binding for C-c C-i. M-TAB
can also be pressed with M-C-i which is probably not taken
by the window manager.  ESC TAB would also work.  Maybe we
should reuse C-c C-i for slime-inspect.
Move C-c C-y to slime-repl.e.
Remove C-c C-f: it's already on C-c C-d f.
Remove C-c M-0: slime-restore-window-configuration doesn't exist.
Remove M-g: slime-quit doesn't work since ages.

* slime-repl.el (slime-mode-map): Bind C-c~ not ~.
Reported by James Wright.
(slime-repl-mode-map): Bind M-TAB.
Remove C-c C-k: compiling the REPL buffer doesn't work anyway.
Remove C-cC-b, C-c:, C-cE, C-cC-d, C-cC-w, C-M-x, C-cC-t, C-cC-l:
those are already bound in slime-parent-map.

--- /project/slime/cvsroot/slime/contrib/ChangeLog	2009/01/04 20:53:06	1.163
+++ /project/slime/cvsroot/slime/contrib/ChangeLog	2009/01/07 09:21:44	1.164
@@ -1,3 +1,12 @@
+2009-01-07  Helmut Eller  <heller at common-lisp.net>
+
+	* slime-repl.el (slime-mode-map): Bind C-c~ not ~.
+	Reported by James Wright.
+	(slime-repl-mode-map): Bind M-TAB.
+	Remove C-c C-k: compiling the REPL buffer doesn't work anyway.
+	Remove C-cC-b, C-c:, C-cE, C-cC-d, C-cC-w, C-M-x, C-cC-t, C-cC-l:
+	those are already bound in slime-parent-map.
+
 2009-01-04  Helmut Eller  <heller at common-lisp.net>
 
 	* slime-repl.el, slime-mrepl.el: Byte-compile the output
--- /project/slime/cvsroot/slime/contrib/slime-repl.el	2009/01/05 21:57:54	1.10
+++ /project/slime/cvsroot/slime/contrib/slime-repl.el	2009/01/07 09:21:44	1.11
@@ -423,7 +423,8 @@
   ("\M-p" 'slime-repl-set-package))
 
 (slime-define-keys slime-mode-map 
-  ("~" 'slime-sync-package-and-default-directory))
+  ("\C-c~" 'slime-sync-package-and-default-directory)
+  ("\C-c\C-y" 'slime-call-defun))
 
 (slime-define-keys slime-connection-list-mode-map
   ((kbd "RET") 'slime-goto-connection)
@@ -443,25 +444,16 @@
   ((kbd "C-<down>") 'slime-repl-forward-input)
   ("\M-r" 'slime-repl-previous-matching-input)
   ("\M-s" 'slime-repl-next-matching-input)
-  ("\C-c\C-b" 'slime-interrupt)
   ("\C-c\C-c" 'slime-interrupt)
-  ("\C-c:"    'slime-interactive-eval)
-  ("\C-c\C-e" 'slime-interactive-eval)
-  ("\C-cE"     'slime-edit-value)
   ;("\t"   'slime-complete-symbol)
   ("\t"   'slime-indent-and-complete-symbol)
+  ("\M-\t" 'slime-complete-symbol)
   (" "    'slime-space)
-  ("\C-c\C-d" slime-doc-map)
-  ("\C-c\C-w" slime-who-map)
-  ("\C-\M-x" 'slime-eval-defun)
   ("\C-c\C-o" 'slime-repl-clear-output)
   ("\C-c\M-o" 'slime-repl-clear-buffer)
-  ("\C-c\C-t" 'slime-toggle-trace-fdefinition)
   ("\C-c\C-u" 'slime-repl-kill-input)
   ("\C-c\C-n" 'slime-repl-next-prompt)
   ("\C-c\C-p" 'slime-repl-previous-prompt)
-  ("\C-c\C-l" 'slime-load-file)
-  ("\C-c\C-k" 'slime-compile-and-load-file)
   ("\C-c\C-z" 'slime-nop))
 
 (def-slime-selector-method ?r




From heller at common-lisp.net  Wed Jan  7 09:21:54 2009
From: heller at common-lisp.net (CVS User heller)
Date: Wed, 07 Jan 2009 09:21:54 +0000
Subject: [slime-cvs] CVS slime
Message-ID: <E1LKUbq-0005Qc-Bu@common-lisp.net>

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

Modified Files:
	ChangeLog slime.el 
Log Message:
* slime.el (slime-show-buffer-position): Use reposition-window.

--- /project/slime/cvsroot/slime/ChangeLog	2009/01/07 09:21:44	1.1641
+++ /project/slime/cvsroot/slime/ChangeLog	2009/01/07 09:21:54	1.1642
@@ -1,5 +1,9 @@
 2009-01-07  Helmut Eller  <heller at common-lisp.net>
 
+	* slime.el (slime-show-buffer-position): Use reposition-window.
+
+2009-01-07  Helmut Eller  <heller at common-lisp.net>
+
 	* slime.el (slime-keys): Remove the binding for C-c C-i. M-TAB
 	can also be pressed with M-C-i which is probably not taken
 	by the window manager.  ESC TAB would also work.  Maybe we
--- /project/slime/cvsroot/slime/slime.el	2009/01/07 09:21:44	1.1104
+++ /project/slime/cvsroot/slime/slime.el	2009/01/07 09:21:54	1.1105
@@ -5778,7 +5778,9 @@
       (goto-char position)
       ;;(push-mark)
       (unless (pos-visible-in-window-p)
-        (slime-recenter-window window sldb-show-location-recenter-arg)))))
+        (reposition-window)
+        ;;(slime-recenter-window window sldb-show-location-recenter-arg))
+      ))))
 
 (defun slime-recenter-window (window line)
   "Set window-start in WINDOW LINE lines before point."




From heller at common-lisp.net  Thu Jan  8 06:45:10 2009
From: heller at common-lisp.net (CVS User heller)
Date: Thu, 08 Jan 2009 06:45:10 +0000
Subject: [slime-cvs] CVS slime
Message-ID: <E1LKodi-0006w8-38@common-lisp.net>

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

Modified Files:
	ChangeLog slime.el 
Log Message:
* slime.el (slime-with-xref-buffer): Don't set
slime-popup-buffer-quit-function. Use the default.  Don't shrink
the window because it may have existed before creating the buffer
and we need to restore it.
(slime-goto-xref): Just use slime-popup-buffer-quit.
(slime-edit-definition-cont): Push definition stack here so that
we don't need to do anything special in slime-goto-xref.
(slime-display-popup-buffer): Also save the buffer that the popup
window was displaying before (if the window is not new).
(slime-close-popup-window): Restore the old buffer (if any) of the
popup window.

--- /project/slime/cvsroot/slime/ChangeLog	2009/01/07 09:21:54	1.1642
+++ /project/slime/cvsroot/slime/ChangeLog	2009/01/08 06:45:09	1.1643
@@ -1,5 +1,19 @@
 2009-01-07  Helmut Eller  <heller at common-lisp.net>
 
+	* slime.el (slime-with-xref-buffer): Don't set
+	slime-popup-buffer-quit-function. Use the default.  Don't shrink
+	the window because it may have existed before creating the buffer
+	and we need to restore it.
+	(slime-goto-xref): Just use slime-popup-buffer-quit.
+	(slime-edit-definition-cont): Push definition stack here so that
+	we don't need to do anything special in slime-goto-xref.
+	(slime-display-popup-buffer): Also save the buffer that the popup
+	window was displaying before (if the window is not new).
+	(slime-close-popup-window): Restore the old buffer (if any) of the
+	popup window.
+
+2009-01-07  Helmut Eller  <heller at common-lisp.net>
+
 	* slime.el (slime-show-buffer-position): Use reposition-window.
 
 2009-01-07  Helmut Eller  <heller at common-lisp.net>
--- /project/slime/cvsroot/slime/slime.el	2009/01/07 09:21:54	1.1105
+++ /project/slime/cvsroot/slime/slime.el	2009/01/08 06:45:09	1.1106
@@ -1005,26 +1005,29 @@
 Save the selected-window in a buffer-local variable, so that we
 can restore it later."
   (let ((selected-window (selected-window))
-        (windows))
-    (walk-windows (lambda (w) (push w windows)) nil t)
+        (old-windows))
+    (walk-windows (lambda (w) (push (cons w (window-buffer w)) old-windows))
+                  nil t)
     (let ((new-window (display-buffer (current-buffer))))
       (unless (slime-local-variable-p 'slime-popup-buffer-restore-info)
         (set (make-local-variable 'slime-popup-buffer-restore-info)
-             (list (unless (memq new-window windows)
-                     new-window)
-                   selected-window)))
+             (list new-window
+                   selected-window
+                   (cdr (find new-window old-windows :key #'car)))))
       (when select
         (select-window new-window))
       (current-buffer))))
 
 (defun slime-close-popup-window ()
   (cond ((slime-local-variable-p 'slime-popup-buffer-restore-info)
-         (destructuring-bind (created-window selected-window)
+         (destructuring-bind (popup-window selected-window old-buffer)
              slime-popup-buffer-restore-info
            (bury-buffer)
-           (when (and (eq created-window (selected-window))
-                      (not (eq (next-window created-window) created-window)))
-             (delete-window created-window))
+           (when (eq popup-window (selected-window))
+             (cond ((and (not old-buffer) (not (one-window-p)))
+                    (delete-window popup-window))
+                   ((and old-buffer (buffer-live-p old-buffer))
+                    (set-window-buffer popup-window old-buffer))))
            (when (window-live-p selected-window)
              (select-window selected-window)))
          (kill-local-variable 'slime-popup-buffer-restore-info))
@@ -4006,7 +4009,7 @@
           ((slime-length= xrefs 1)      ; ((:error "..."))
            (error "%s" (cadr (slime-xref.location (car xrefs)))))
           (t
-           ;; Xref buffers will themselves push onto the find-definition stack.
+           (slime-push-definition-stack)
            (slime-show-xrefs file-alist 'definition name
                              (slime-current-package))))))
 
@@ -4884,11 +4887,8 @@
      (slime-with-popup-buffer (xref-buffer-name% ,package t t ,emacs-snapshot)
        (slime-xref-mode)
        (slime-set-truncate-lines)
-       (setq slime-popup-buffer-quit-function 'slime-xref-quit)
        (erase-buffer)
-       (prog1 (progn , at body)
-         (assert (equal (buffer-name) xref-buffer-name%))
-         (shrink-window-if-larger-than-buffer)))))
+       , at body)))
 
 (put 'slime-with-xref-buffer 'lisp-indent-function 1)
 
@@ -5042,11 +5042,8 @@
 (defun slime-goto-xref ()
   "Goto the cross-referenced location at point."
   (interactive)
-  ;; Notice: We implement it this way so `slime-show-xref' changes the
-  ;; the window snapshot such that `slime-xref-quit' will push onto
-  ;; the find-definition-stack.
   (slime-show-xref)
-  (slime-xref-quit))
+  (slime-popup-buffer-quit))
 
 (defun slime-show-xref ()
   "Display the xref at point in the other window."




From heller at common-lisp.net  Thu Jan  8 06:45:19 2009
From: heller at common-lisp.net (CVS User heller)
Date: Thu, 08 Jan 2009 06:45:19 +0000
Subject: [slime-cvs] CVS slime
Message-ID: <E1LKodr-0006wp-UF@common-lisp.net>

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

Modified Files:
	ChangeLog swank-source-path-parser.lisp 
Log Message:
* swank-source-path-parser.lisp (make-source-recorder)
(source-path-source-position): Adjust the file-position before
entering it the table.

--- /project/slime/cvsroot/slime/ChangeLog	2009/01/08 06:45:09	1.1643
+++ /project/slime/cvsroot/slime/ChangeLog	2009/01/08 06:45:19	1.1644
@@ -1,5 +1,11 @@
 2009-01-07  Helmut Eller  <heller at common-lisp.net>
 
+	* swank-source-path-parser.lisp (make-source-recorder)
+	(source-path-source-position): Adjust the file-position before
+	entering it the table.
+
+2009-01-07  Helmut Eller  <heller at common-lisp.net>
+
 	* slime.el (slime-with-xref-buffer): Don't set
 	slime-popup-buffer-quit-function. Use the default.  Don't shrink
 	the window because it may have existed before creating the buffer
--- /project/slime/cvsroot/slime/swank-source-path-parser.lisp	2008/03/23 23:34:41	1.20
+++ /project/slime/cvsroot/slime/swank-source-path-parser.lisp	2009/01/08 06:45:19	1.21
@@ -45,7 +45,7 @@
 before and after of calling FN in the hashtable SOURCE-MAP."
   (declare (type function fn))
   (lambda (stream char)
-    (let ((start (file-position stream))
+    (let ((start (1- (file-position stream)))
 	  (values (multiple-value-list (funcall fn stream char)))
 	  (end (file-position stream)))
       ;(format t "[~D \"~{~A~^, ~}\" ~D ~D ~S]~%" start values end (char-code char) char)
@@ -144,5 +144,5 @@
 	  for positions = (gethash form source-map)
 	  until (and positions (null (cdr positions)))
 	  finally (destructuring-bind ((start . end)) positions
-		    (return (values (1- start) end))))))
+		    (return (values start end))))))
 




From heller at common-lisp.net  Thu Jan  8 06:45:29 2009
From: heller at common-lisp.net (CVS User heller)
Date: Thu, 08 Jan 2009 06:45:29 +0000
Subject: [slime-cvs] CVS slime
Message-ID: <E1LKoe1-0006xW-3M@common-lisp.net>

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

Modified Files:
	ChangeLog swank-cmucl.lisp 
Log Message:
* swank-cmucl.lisp (frame-locals): Remove non-valid variables.

--- /project/slime/cvsroot/slime/ChangeLog	2009/01/08 06:45:19	1.1644
+++ /project/slime/cvsroot/slime/ChangeLog	2009/01/08 06:45:28	1.1645
@@ -1,8 +1,12 @@
 2009-01-07  Helmut Eller  <heller at common-lisp.net>
 
+	* swank-cmucl.lisp (frame-locals): Remove non-valid variables.
+
+2009-01-07  Helmut Eller  <heller at common-lisp.net>
+
 	* swank-source-path-parser.lisp (make-source-recorder)
 	(source-path-source-position): Adjust the file-position before
-	entering it the table.
+	entering it in the table.
 
 2009-01-07  Helmut Eller  <heller at common-lisp.net>
 
--- /project/slime/cvsroot/slime/swank-cmucl.lisp	2009/01/04 20:53:30	1.206
+++ /project/slime/cvsroot/slime/swank-cmucl.lisp	2009/01/08 06:45:29	1.207
@@ -1553,10 +1553,11 @@
   (let* ((frame (nth-frame index))
 	 (loc (di:frame-code-location frame))
 	 (vars (frame-debug-vars frame)))
-    (loop for v across vars collect
-          (list :name (di:debug-variable-symbol v)
-                :id (di:debug-variable-id v)
-                :value (debug-var-value v frame loc)))))
+    (loop for v across vars 
+          when (eq (di:debug-variable-validity v loc) :valid)
+          collect (list :name (di:debug-variable-symbol v)
+                        :id (di:debug-variable-id v)
+                        :value (di:debug-variable-valid-value v frame)))))
 
 (defimplementation frame-var-value (frame var)
   (let* ((frame (nth-frame frame))




From heller at common-lisp.net  Thu Jan  8 06:45:37 2009
From: heller at common-lisp.net (CVS User heller)
Date: Thu, 08 Jan 2009 06:45:37 +0000
Subject: [slime-cvs] CVS slime
Message-ID: <E1LKoe9-0006yB-BH@common-lisp.net>

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

Modified Files:
	ChangeLog swank-cmucl.lisp 
Log Message:
* swank-cmucl.lisp (frame-locals, frame-debug-vars): Remove
non-valid variables.
(debug-var-value): Compute the location from the frame arg.

--- /project/slime/cvsroot/slime/ChangeLog	2009/01/08 06:45:28	1.1645
+++ /project/slime/cvsroot/slime/ChangeLog	2009/01/08 06:45:37	1.1646
@@ -1,6 +1,8 @@
 2009-01-07  Helmut Eller  <heller at common-lisp.net>
 
-	* swank-cmucl.lisp (frame-locals): Remove non-valid variables.
+	* swank-cmucl.lisp (frame-locals, frame-debug-vars): Remove
+	non-valid variables.
+	(debug-var-value): Compute the location from the frame arg.
 
 2009-01-07  Helmut Eller  <heller at common-lisp.net>
 
--- /project/slime/cvsroot/slime/swank-cmucl.lisp	2009/01/08 06:45:29	1.207
+++ /project/slime/cvsroot/slime/swank-cmucl.lisp	2009/01/08 06:45:37	1.208
@@ -1541,28 +1541,30 @@
 
 (defun frame-debug-vars (frame)
   "Return a vector of debug-variables in frame."
-  (di::debug-function-debug-variables (di:frame-debug-function frame)))
-
-(defun debug-var-value (var frame location)
-  (let ((validity (di:debug-variable-validity var location)))
+  (let ((loc (di:frame-code-location frame)))
+    (remove-if
+     (lambda (v)
+       (not (eq (di:debug-variable-validity v loc) :valid)))
+     (di::debug-function-debug-variables (di:frame-debug-function frame)))))
+
+(defun debug-var-value (var frame)
+  (let* ((loc (di:frame-code-location frame))
+         (validity (di:debug-variable-validity var loc)))
     (ecase validity
       (:valid (di:debug-variable-value var frame))
       ((:invalid :unknown) (make-symbol (string validity))))))
 
 (defimplementation frame-locals (index)
-  (let* ((frame (nth-frame index))
-	 (loc (di:frame-code-location frame))
-	 (vars (frame-debug-vars frame)))
-    (loop for v across vars 
-          when (eq (di:debug-variable-validity v loc) :valid)
+  (let ((frame (nth-frame index)))
+    (loop for v across (frame-debug-vars frame)
           collect (list :name (di:debug-variable-symbol v)
                         :id (di:debug-variable-id v)
-                        :value (di:debug-variable-valid-value v frame)))))
+                        :value (debug-var-value v frame)))))
 
 (defimplementation frame-var-value (frame var)
   (let* ((frame (nth-frame frame))
          (dvar (aref (frame-debug-vars frame) var)))
-    (debug-var-value dvar frame (di:frame-code-location frame))))
+    (debug-var-value dvar frame)))
 
 (defimplementation frame-catch-tags (index)
   (mapcar #'car (di:frame-catches (nth-frame index))))




From heller at common-lisp.net  Thu Jan  8 06:45:46 2009
From: heller at common-lisp.net (CVS User heller)
Date: Thu, 08 Jan 2009 06:45:46 +0000
Subject: [slime-cvs] CVS slime
Message-ID: <E1LKoeI-0006yr-1k@common-lisp.net>

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

Modified Files:
	ChangeLog swank.lisp 
Log Message:
* swank.lisp (*sldb-pprint-dispatch-table*): Honor *print-escape*

--- /project/slime/cvsroot/slime/ChangeLog	2009/01/08 06:45:37	1.1646
+++ /project/slime/cvsroot/slime/ChangeLog	2009/01/08 06:45:45	1.1647
@@ -1,5 +1,9 @@
 2009-01-07  Helmut Eller  <heller at common-lisp.net>
 
+	* swank.lisp (*sldb-pprint-dispatch-table*): Honor *print-escape*
+
+2009-01-07  Helmut Eller  <heller at common-lisp.net>
+
 	* swank-cmucl.lisp (frame-locals, frame-debug-vars): Remove
 	non-valid variables.
 	(debug-var-value): Compute the location from the frame arg.
--- /project/slime/cvsroot/slime/swank.lisp	2009/01/05 11:14:13	1.625
+++ /project/slime/cvsroot/slime/swank.lisp	2009/01/08 06:45:45	1.626
@@ -116,16 +116,21 @@
                        (write bit :stream stream))))
            (sldb-string-pprint (stream string)
              ;;; Truncate strings according to *SLDB-STRING-LENGTH*.
-             (if (or (not *print-array*) (not *print-length*))
-                 (let ((*print-pprint-dispatch* initial-table))
-                   (write string :stream stream))
-                 (loop initially (write-char #\" stream)
-                       for i from 0 and char across string do
-                       (when (= i *sldb-string-length*)
-                         (write-string "..." stream)
-                         (loop-finish))
-                       (write-char char stream)
-                       finally (write-char #\" stream)))))
+             (cond ((or (not *print-array*) (not *print-length*))
+                    (let ((*print-pprint-dispatch* initial-table))
+                      (write string :stream stream)))
+                   ((not *print-escape*)
+                    (write-string string stream))
+                   (t
+                    (loop initially (write-char #\" stream)
+                          for i from 0 and char across string do
+                          (cond ((= i *sldb-string-length*)
+                                 (write-string "..." stream)
+                                 (loop-finish))
+                                ((char= char #\")
+                                 (write-string "\\\"" stream))
+                                (t (write-char char stream)))
+                          finally (write-char #\" stream))))))
       (set-pprint-dispatch 'bit-vector #'sldb-bitvector-pprint 0 result-table)
       (set-pprint-dispatch 'string #'sldb-string-pprint 0 result-table)
       result-table)))




From heller at common-lisp.net  Thu Jan  8 06:45:57 2009
From: heller at common-lisp.net (CVS User heller)
Date: Thu, 08 Jan 2009 06:45:57 +0000
Subject: [slime-cvs] CVS slime
Message-ID: <E1LKoeT-0006zW-FK@common-lisp.net>

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

Modified Files:
	ChangeLog slime.el 
Log Message:
Fix the slime-next-location command.

* slime.el (slime-xref-last-buffer): New variable.
(slime-show-xrefs): Initialize it.
(slime-goto-next-xref): Use it.
(slime-search-property): New function.
(slime-xref-buffer): Delted

--- /project/slime/cvsroot/slime/ChangeLog	2009/01/08 06:45:45	1.1647
+++ /project/slime/cvsroot/slime/ChangeLog	2009/01/08 06:45:56	1.1648
@@ -1,5 +1,15 @@
 2009-01-07  Helmut Eller  <heller at common-lisp.net>
 
+	Fix the slime-next-location command.
+
+	* slime.el (slime-xref-last-buffer): New variable.
+	(slime-show-xrefs): Initialize it.
+	(slime-goto-next-xref): Use it.
+	(slime-search-property): New function.
+	(slime-xref-buffer): Delted
+
+2009-01-07  Helmut Eller  <heller at common-lisp.net>
+
 	* swank.lisp (*sldb-pprint-dispatch-table*): Honor *print-escape*
 
 2009-01-07  Helmut Eller  <heller at common-lisp.net>
--- /project/slime/cvsroot/slime/slime.el	2009/01/08 06:45:09	1.1106
+++ /project/slime/cvsroot/slime/slime.el	2009/01/08 06:45:57	1.1107
@@ -376,8 +376,8 @@
   nil
   nil
   ;; Fake binding to coax `define-minor-mode' to create the keymap
-  '((" " 'undefined)))
-
+  '((" " 'undefined))
+  (slime-setup-command-hooks))
 
 (make-variable-buffer-local
  (defvar slime-modeline-string nil
@@ -4892,13 +4892,6 @@
 
 (put 'slime-with-xref-buffer 'lisp-indent-function 1)
 
-(defun slime-xref-buffer ()
-  "Return the XREF results buffer.
-If CREATE is non-nil, create it if necessary."
-  (or (find-if (lambda (b) (string-match "*XREF\\[" (buffer-name b)))
-               (buffer-list))
-      (error "No XREF buffer")))
-
 (defun slime-xref-quit (&optional _)
   "Kill the current xref buffer, restore the window configuration
 if appropriate."
@@ -4938,16 +4931,21 @@
 (defvar slime-next-location-function nil
   "Function to call for going to the next location.")
 
+(defvar slime-xref-last-buffer nil
+  "The most recent XREF results buffer.
+This is used by `slime-goto-next-xref'")
+
 (defun slime-show-xrefs (xrefs type symbol package &optional emacs-snapshot)
   "Show the results of an XREF query."
   (if (null xrefs)
       (message "No references found for %s." symbol)
-    (setq slime-next-location-function 'slime-goto-next-xref)
     (slime-with-xref-buffer (type symbol package emacs-snapshot)
       (slime-insert-xrefs xrefs)
       (goto-char (point-min))
       (forward-line)
-      (skip-chars-forward " \t"))))
+      (skip-chars-forward " \t")
+      (setq slime-next-location-function 'slime-goto-next-xref)
+      (setq slime-xref-last-buffer (current-buffer )))))
 
 
 ;;;;; XREF commands
@@ -5051,20 +5049,34 @@
   (let ((location (slime-xref-location-at-point)))
     (slime-show-source-location location)))
       
-(defun slime-goto-next-xref ()
+(defun slime-goto-next-xref (&optional backward)
   "Goto the next cross-reference location."
-  (let ((location (with-current-buffer (slime-xref-buffer)
-                    (let ((w (display-buffer (current-buffer) t)))
-                      (goto-char (1+ (next-single-char-property-change 
-                                      (point) 'slime-location)))
-                      (set-window-point w (point)))
-                    (cond ((eobp)
-                           (message "No more xrefs.")
-                           nil)
-                          (t 
-                           (slime-xref-location-at-point))))))
-    (when location
-      (slime-pop-to-location location))))
+  (let ((location 
+         (and (buffer-live-p slime-xref-last-buffer)
+              (with-current-buffer slime-xref-last-buffer
+                (slime-search-property 'slime-location backward)))))
+    (cond ((slime-location-p location)
+           (slime-pop-to-location location))
+          ((null location)
+           (message "No more xrefs."))
+          (t ; error
+           (slime-goto-next-xref backward)))))
+
+(defun slime-search-property (prop &optional backward)
+  "Search the next text range where PROP is non-nil.
+If found, return the value of the property; otherwise return nil.
+If BACKWARD is non-nil, search backward."
+  (let ((fun (cond (backward #'previous-single-char-property-change)
+                   (t #'next-single-char-property-change)))
+        (test (lambda () (get-text-property (point) prop)))
+        (start (point)))
+    (while (progn 
+             (goto-char (funcall fun (point) prop))
+             (not (or (funcall test) 
+                      (eobp) 
+                      (bobp)))))
+    (or (funcall test)
+        (progn (goto-char start) nil))))
 
 (defun slime-next-location ()
   "Go to the next location, depending on context.




From heller at common-lisp.net  Thu Jan  8 06:46:05 2009
From: heller at common-lisp.net (CVS User heller)
Date: Thu, 08 Jan 2009 06:46:05 +0000
Subject: [slime-cvs] CVS slime
Message-ID: <E1LKoeb-00070B-Nx@common-lisp.net>

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

Modified Files:
	ChangeLog slime.el 
Log Message:
Just use find-tag-marker-ring as stack for M-.

* slime.el (slime-push-definition-stack)
(slime-pop-find-definition-stack): Do whatever Emacs's standard
find-tag commands do.

--- /project/slime/cvsroot/slime/ChangeLog	2009/01/08 06:45:56	1.1648
+++ /project/slime/cvsroot/slime/ChangeLog	2009/01/08 06:46:05	1.1649
@@ -1,5 +1,13 @@
 2009-01-07  Helmut Eller  <heller at common-lisp.net>
 
+	Just use find-tag-marker-ring as stack for M-.
+
+	* slime.el (slime-push-definition-stack)
+	(slime-pop-find-definition-stack): Do whatever Emacs's standard
+	find-tag commands do.
+
+2009-01-07  Helmut Eller  <heller at common-lisp.net>
+
 	Fix the slime-next-location command.
 
 	* slime.el (slime-xref-last-buffer): New variable.
--- /project/slime/cvsroot/slime/slime.el	2009/01/08 06:45:57	1.1107
+++ /project/slime/cvsroot/slime/slime.el	2009/01/08 06:46:05	1.1108
@@ -2454,7 +2454,7 @@
     ch))
 
 (defun slime-close-channel (channel)
-  (setf (slime-channels.operations channel) 'closed-channel)
+  (setf (slime-channel.operations channel) 'closed-channel)
   (let ((probe (assq (slime-channel.id channel) (slime-channels))))
     (cond (probe (setf (slime-channels) (delete probe (slime-channels))))
           (t (error "Invalid channel: %s" channel)))))
@@ -3927,40 +3927,18 @@
 
 ;;;; Edit definition
 
-(defvar slime-find-definition-history-ring (make-ring 20)
-  "History ring recording the definition-finding \"stack\".")
-
-(defun slime-push-definition-stack-from-snapshot (emacs-snapshot)
-  (with-struct (slime-emacs-snapshot. narrowing-configuration point-marker)
-      emacs-snapshot
-    (slime-push-definition-stack point-marker narrowing-configuration)))
-
-(defun slime-push-definition-stack (&optional marker narrowing-configuration)
-  "Add MARKER and NARROWING-CONFIGURATION to the edit-definition history stack.
-If MARKER is nil, use the current point. If NARROWING-CONFIGURATION is nil, 
-look if the current buffer is narrowed, and if so use the relevant values."
-  (ring-insert-at-beginning slime-find-definition-history-ring 
-    (list (or marker (point-marker))
-          (or narrowing-configuration
-              (slime-current-narrowing-configuration)))))
+(defun slime-push-definition-stack ()
+  "Add point to find-tag-marker-ring."
+  (cond ((featurep 'xemacs)
+         (require 'etags)
+         (push-tag-mark))
+        (t (ring-insert find-tag-marker-ring (point-marker)))))
 
 (defun slime-pop-find-definition-stack ()
   "Pop the edit-definition stack and goto the location."
   (interactive)
-  (unless (ring-empty-p slime-find-definition-history-ring)
-    (destructuring-bind (marker narrowing-cfg)
-        (ring-remove slime-find-definition-history-ring)
-      (let ((buffer (marker-buffer marker))
-            (narrowedp  (slime-narrowing-configuration.narrowedp narrowing-cfg))
-            (narrow-beg (slime-narrowing-configuration.beg narrowing-cfg))
-            (narrow-end (slime-narrowing-configuration.end narrowing-cfg)))
-        (if (buffer-live-p buffer)
-            (progn (switch-to-buffer buffer)
-                   (goto-char (marker-position marker))
-                   (when narrowedp
-                     (narrow-to-region narrow-beg narrow-end)))
-            ;; If this buffer was deleted, recurse to try the next one
-            (slime-pop-find-definition-stack))))))
+  (cond ((featurep 'xemacs) (pop-tag-mark nil))
+        (t (pop-tag-mark))))
 
 (defstruct (slime-xref (:conc-name slime-xref.) (:type list))
   dspec location)




From heller at common-lisp.net  Thu Jan  8 10:33:11 2009
From: heller at common-lisp.net (CVS User heller)
Date: Thu, 08 Jan 2009 10:33:11 +0000
Subject: [slime-cvs] CVS slime
Message-ID: <E1LKsCN-0004XZ-UZ@common-lisp.net>

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

Modified Files:
	ChangeLog slime.el 
Log Message:
Remove some customization variables of questionale use.

* slime.el (slime-when-complete-filename-expand)
(slime-space-information-p, slime-display-compilation-output)
(sldb-show-location-recenter-arg, slime-recenter-window)
(slime-display-buffer-region): Deleted.

--- /project/slime/cvsroot/slime/ChangeLog	2009/01/08 06:46:05	1.1649
+++ /project/slime/cvsroot/slime/ChangeLog	2009/01/08 10:33:11	1.1650
@@ -1,3 +1,12 @@
+2009-01-08  Helmut Eller  <heller at common-lisp.net>
+
+	Remove some customization variables of questionale use.
+
+	* slime.el (slime-when-complete-filename-expand)
+	(slime-space-information-p, slime-display-compilation-output)
+	(sldb-show-location-recenter-arg, slime-recenter-window)
+	(slime-display-buffer-region): Deleted.
+
 2009-01-07  Helmut Eller  <heller at common-lisp.net>
 
 	Just use find-tag-marker-ring as stack for M-.
--- /project/slime/cvsroot/slime/slime.el	2009/01/08 06:46:05	1.1108
+++ /project/slime/cvsroot/slime/slime.el	2009/01/08 10:33:11	1.1109
@@ -38,7 +38,7 @@
 ;;   Trapping compiler messages and creating annotations in the source
 ;;   file on the appropriate forms.
 ;;
-;; SLIME is compatible with GNU Emacs 20 and 21 and XEmacs 21. In
+;; SLIME is compatible with GNU Emacs 21, 22, 23 and XEmacs 21. In
 ;; order to run SLIME requires a supporting Lisp server called
 ;; Swank. Swank is distributed with slime.el and will automatically be
 ;; started in a normal installation.
@@ -214,17 +214,6 @@
                  (const :tag "Compound" slime-complete-symbol*)
                  (const :tag "Fuzzy" slime-fuzzy-complete-symbol)))
 
-(defcustom slime-when-complete-filename-expand nil
-  "Use comint-replace-by-expanded-filename instead of
-comint-dynamic-complete-as-filename to complete file names"
-  :group 'slime-mode
-  :type 'boolean)
-
-(defcustom slime-space-information-p t
-  "Have the SPC key offer arglist information."
-  :type 'boolean
-  :group 'slime-mode)
-
 ;;;;; slime-mode-faces
 
 (defgroup slime-mode-faces nil
@@ -336,7 +325,6 @@
   (local-value    "local variable values")
   (catch-tag      "catch tags"))
 
-
 
 ;;;; Minor modes
 
@@ -491,7 +479,7 @@
          ;; SLIME-MODELINE-UPDATE-TIMER is not going to
          ;; trigger by itself.
          (slime-update-all-modelines))))
-  
+
 ;; Setup the mode-line to say when we're in slime-mode, which
 ;; connection is active, and which CL package we think the current
 ;; buffer belongs to.
@@ -631,7 +619,7 @@
 (defun slime-pre-command-hook ()
   "Execute all functions in `slime-pre-command-actions', then NIL it."
   (dolist (undo-fn slime-pre-command-actions)
-    (ignore-errors (funcall undo-fn)))
+    (funcall undo-fn))
   (setq slime-pre-command-actions nil))
 
 (defun slime-post-command-hook ()
@@ -2599,11 +2587,6 @@
 (defvar slime-highlight-compiler-notes t
   "*When non-nil annotate buffers with compilation notes etc.")
 
-(defcustom slime-display-compilation-output t
-  "Display the REPL buffer before compiling files."
-  :type '(choice (const :tag "Enable" t) (const :tag "Disable" nil))
-  :group 'slime-mode)
-
 (defvar slime-before-compile-functions nil
   "A list of function called before compiling a buffer or region.
 The function receive two arguments: the beginning and the end of the 
@@ -2674,10 +2657,8 @@
     (save-buffer))
   (run-hook-with-args 'slime-before-compile-functions (point-min) (point-max))
   (let ((file (slime-to-lisp-filename (buffer-file-name))))
-    (slime-eval-with-transcript
+    (slime-eval-async
      `(swank:compile-file-for-emacs ,file ,(if load t nil))
-     (format "Compile file %s" file)
-     (not slime-display-compilation-output)
      #'slime-compilation-finished)
     (message "Compiling %s..." file)))
 
@@ -3688,8 +3669,7 @@
 more than one space."
   (interactive "p")
   (self-insert-command n)
-  (when (and slime-space-information-p
-             (slime-background-activities-enabled-p))
+  (when (slime-background-activities-enabled-p)
     (slime-echo-arglist)))
 
 (defvar slime-echo-arglist-function 'slime-show-arglist)
@@ -3853,12 +3833,10 @@
 
 (defun slime-maybe-complete-as-filename ()
   "If point is at a string starting with \", complete it as filename.
-Return nil iff if point is not at filename."
+Return nil if point is not at filename."
   (if (save-excursion (re-search-backward "\"[^ \t\n]+\\=" nil t))
       (let ((comint-completion-addsuffix '("/" . "\"")))
-        (if slime-when-complete-filename-expand
-            (comint-replace-by-expanded-filename)
-          (comint-dynamic-complete-as-filename))
+        (comint-replace-by-expanded-filename)
         t)
     nil))
 
@@ -3929,8 +3907,8 @@
 
 (defun slime-push-definition-stack ()
   "Add point to find-tag-marker-ring."
+  (require 'etags)
   (cond ((featurep 'xemacs)
-         (require 'etags)
          (push-tag-mark))
         (t (ring-insert find-tag-marker-ring (point-marker)))))
 
@@ -3972,7 +3950,8 @@
 If there's no name at point, or a prefix argument is given, then the
 function name is prompted."
   (interactive (list (slime-read-symbol-name "Name: ")))
-  (or (run-hook-with-args-until-success 'slime-edit-definition-hooks name where)
+  (or (run-hook-with-args-until-success 'slime-edit-definition-hooks 
+                                        name where)
       (slime-edit-definition-cont (slime-find-definitions name)
                                   name where)))
 
@@ -4187,11 +4166,9 @@
 (defun slime-eval-print (string)
   "Eval STRING in Lisp; insert any output and the result at point."
   (slime-eval-async `(swank:eval-and-grab-output ,string)
-                    (lexical-let ((buffer (current-buffer)))
-                      (lambda (result)
-                        (with-current-buffer buffer
-                          (destructuring-bind (output value) result
-                            (insert output value)))))))
+                    (lambda (result)
+                      (destructuring-bind (output value) result
+                        (insert output value)))))
 
 (defun slime-eval-with-transcript (form &optional msg no-popups cont)
   "Eval FROM in Lisp.  Display output, if any, caused by the evaluation."
@@ -4240,23 +4217,6 @@
     (princ string)
     (goto-char (point-min))))
 
-(defun slime-display-buffer-region (buffer start end &optional other-window)
-  "Like `display-buffer', but only display the specified region."
-  (let ((window-min-height 1))
-    (with-current-buffer buffer
-      (save-excursion
-        (save-restriction
-          (goto-char start)
-          (beginning-of-line)
-          (narrow-to-region (point) end)
-          (let ((window (display-buffer buffer other-window t)))
-            (set-window-start window (point))
-            (unless (or (one-window-p t)
-                        (/= (frame-width) (window-width)))
-              (set-window-text-height window (/ (1- (frame-height)) 2)))
-            (shrink-window-if-larger-than-buffer window)
-            window))))))
-  
 (defun slime-last-expression ()
   (buffer-substring-no-properties
    (save-excursion (backward-sexp) (point))
@@ -4977,13 +4937,11 @@
   "Make an XREF request to Lisp."
   (slime-eval-async
    `(swank:xref ',type ',symbol)
-   (lexical-let ((type type)
-                 (symbol symbol)
-                 (package (slime-current-package))
-                 (snapshot (slime-current-emacs-snapshot)))
-     (lambda (result)
-       (let ((file-alist (cadr (slime-analyze-xrefs result))))
-         (slime-show-xrefs file-alist type symbol package snapshot))))))
+   (slime-rcurry
+    (lambda (result type symbol package snapshot)
+      (let ((file-alist (cadr (slime-analyze-xrefs result))))
+         (slime-show-xrefs file-alist type symbol package snapshot)))
+    type symbol (slime-current-package) (slime-current-emacs-snapshot))))
 
 
 ;;;;; XREF navigation
@@ -5450,8 +5408,7 @@
   ("P"    'sldb-print-condition)
   ("C"    'sldb-inspect-condition)
   (":"    'slime-interactive-eval)
-  ("\C-c\C-c" 'sldb-recompile-frame-source)
-  ("\C-c\C-d" slime-doc-map))
+  ("\C-c\C-c" 'sldb-recompile-frame-source))
 
 ;; Keys 0-9 are shortcuts to invoke particular restarts.
 (dotimes (number 10)
@@ -5754,30 +5711,14 @@
 
 ;; FIXME: these functions need factorization
 
-(defvar sldb-show-location-recenter-arg nil
-  "Argument to pass to `recenter' when displaying a source location.")
-
 (defun slime-show-buffer-position (position)
   "Ensure sure that the POSITION in the current buffer is visible."
   (let ((window (display-buffer (current-buffer) t)))
     (save-selected-window
       (select-window window)
       (goto-char position)
-      ;;(push-mark)
       (unless (pos-visible-in-window-p)
-        (reposition-window)
-        ;;(slime-recenter-window window sldb-show-location-recenter-arg))
-      ))))
-
-(defun slime-recenter-window (window line)
-  "Set window-start in WINDOW LINE lines before point."
-  (let* ((line (if (not line)
-                   (/ (window-height window) 2)
-                 line))
-         (start (save-excursion
-                  (loop repeat line do (forward-line -1))
-                  (point))))
-    (set-window-start window start)))
+        (reposition-window)))))
 
 (defun sldb-recenter-region (start end &optional center)
   "Make the region from START to END visible.
@@ -5915,7 +5856,6 @@
 	(end (or end (save-excursion (ignore-errors (forward-sexp)) (point)))))
     (slime-flash-region start end)))
 
-
 
 ;;;;;; SLDB toggle details
 
@@ -6027,8 +5967,6 @@
 		      (lambda (result)
 			(slime-show-description result nil)))))
 
-
-
 (defun sldb-inspect-in-frame (string)
   "Prompt for an expression and inspect it in the selected frame."
   (interactive (list (slime-read-from-minibuffer 
@@ -6259,11 +6197,10 @@
     (set (make-local-variable 'truncate-lines) t)))
 
 (slime-define-keys slime-thread-control-mode-map
-  ("a"         'slime-thread-attach)
-  ("d"         'slime-thread-debug)
-  ("g"         'slime-update-threads-buffer)
-  ("k"         'slime-thread-kill))
-
+  ("a" 'slime-thread-attach)
+  ("d" 'slime-thread-debug)
+  ("g" 'slime-update-threads-buffer)
+  ("k" 'slime-thread-kill))
 
 (defun slime-thread-kill ()
   (interactive)
@@ -6850,10 +6787,6 @@
         finally (error "Can't find unshown buffer in %S" mode)))
 
 
-;;;; Editing commands
-
-
-
 ;;;; Font Lock
 
 (defcustom slime-highlight-suppressed-forms t




From heller at common-lisp.net  Thu Jan  8 10:33:12 2009
From: heller at common-lisp.net (CVS User heller)
Date: Thu, 08 Jan 2009 10:33:12 +0000
Subject: [slime-cvs] CVS slime/contrib
Message-ID: <E1LKsCO-0004Xq-6Y@common-lisp.net>

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

Modified Files:
	slime-fuzzy.el 
Log Message:
Remove some customization variables of questionale use.

* slime.el (slime-when-complete-filename-expand)
(slime-space-information-p, slime-display-compilation-output)
(sldb-show-location-recenter-arg, slime-recenter-window)
(slime-display-buffer-region): Deleted.

--- /project/slime/cvsroot/slime/contrib/slime-fuzzy.el	2008/08/18 09:20:20	1.8
+++ /project/slime/cvsroot/slime/contrib/slime-fuzzy.el	2009/01/08 10:33:12	1.9
@@ -35,6 +35,12 @@
   :group 'slime-mode
   :type 'integer)
 
+(defcustom slime-when-complete-filename-expand nil
+  "Use comint-replace-by-expanded-filename instead of
+comint-dynamic-complete-as-filename to complete file names"
+  :group 'slime-mode
+  :type 'boolean)
+
 (defvar slime-fuzzy-target-buffer nil
   "The buffer that is the target of the completion activities.")
 (defvar slime-fuzzy-saved-window-configuration nil




From heller at common-lisp.net  Thu Jan  8 10:33:21 2009
From: heller at common-lisp.net (CVS User heller)
Date: Thu, 08 Jan 2009 10:33:21 +0000
Subject: [slime-cvs] CVS slime
Message-ID: <E1LKsCX-0004Ym-NQ@common-lisp.net>

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

Modified Files:
	ChangeLog slime.el 
Log Message:
* slime.el (slime-popup-restore-data): Renamed from
slime-popup-buffer-restore-info.
(slime-popup-buffer-saved-fingerprint)
(slime-popup-buffer-saved-emacs-snapshot): Deleted.

--- /project/slime/cvsroot/slime/ChangeLog	2009/01/08 10:33:11	1.1650
+++ /project/slime/cvsroot/slime/ChangeLog	2009/01/08 10:33:21	1.1651
@@ -1,5 +1,12 @@
 2009-01-08  Helmut Eller  <heller at common-lisp.net>
 
+	* slime.el (slime-popup-restore-data): Renamed from
+	slime-popup-buffer-restore-info.
+	(slime-popup-buffer-saved-fingerprint)
+	(slime-popup-buffer-saved-emacs-snapshot): Deleted.
+
+2009-01-08  Helmut Eller  <heller at common-lisp.net>
+
 	Remove some customization variables of questionale use.
 
 	* slime.el (slime-when-complete-filename-expand)
--- /project/slime/cvsroot/slime/slime.el	2009/01/08 10:33:11	1.1109
+++ /project/slime/cvsroot/slime/slime.el	2009/01/08 10:33:21	1.1110
@@ -927,15 +927,18 @@
 
 ;;;;; Temporary popup buffers
 
-(make-variable-buffer-local
- (defvar slime-popup-buffer-saved-emacs-snapshot nil
-   "The snapshot of the current state in Emacs before the popup-buffer
-was displayed, so that this state can be restored later on.
-Buffer local in popup-buffers."))
+(defvar slime-popup-restore-data nil
+  "Data needed when closing popup windows.
+This is buffer local variable.
+The format is (POPUP-WINDOW SELECTED-WINDOW OLD-BUFFER).
+POPUP-WINDOW is the window used to display the temp buffer.
+That window may have been reused or freshly created.
+SELECTED-WINDOW is the window that was selected before displaying
+the popup buffer.
+OLD-BUFFER is the buffer that was previously displayed in POPUP-WINDOW.
+OLD-BUFFER if nil if POPUP-WINDOW was newly created.
 
-(make-variable-buffer-local
- (defvar slime-popup-buffer-saved-fingerprint nil
-   "The emacs snapshot \"fingerprint\" after displaying the buffer."))
+See `view-return-to-alist' for a similar idea.")
 
 ;; Interface
 (defmacro* slime-with-popup-buffer ((name &optional package connection select
@@ -981,8 +984,8 @@
 
 (defun slime-init-popup-buffer (buffer-vars)
   (slime-popup-buffer-mode 1)
-  (setq slime-popup-buffer-saved-fingerprint
-        (slime-current-emacs-snapshot-fingerprint))
+  ;;(setq slime-popup-buffer-saved-fingerprint
+  ;;      (slime-current-emacs-snapshot-fingerprint))
   (multiple-value-setq (slime-buffer-package 
                         slime-buffer-connection
                         slime-popup-buffer-saved-emacs-snapshot)
@@ -997,8 +1000,8 @@
     (walk-windows (lambda (w) (push (cons w (window-buffer w)) old-windows))
                   nil t)
     (let ((new-window (display-buffer (current-buffer))))
-      (unless (slime-local-variable-p 'slime-popup-buffer-restore-info)
-        (set (make-local-variable 'slime-popup-buffer-restore-info)
+      (unless slime-popup-restore-data
+        (set (make-local-variable 'slime-popup-restore-data)
              (list new-window
                    selected-window
                    (cdr (find new-window old-windows :key #'car)))))
@@ -1007,19 +1010,18 @@
       (current-buffer))))
 
 (defun slime-close-popup-window ()
-  (cond ((slime-local-variable-p 'slime-popup-buffer-restore-info)
-         (destructuring-bind (popup-window selected-window old-buffer)
-             slime-popup-buffer-restore-info
-           (bury-buffer)
-           (when (eq popup-window (selected-window))
-             (cond ((and (not old-buffer) (not (one-window-p)))
-                    (delete-window popup-window))
-                   ((and old-buffer (buffer-live-p old-buffer))
-                    (set-window-buffer popup-window old-buffer))))
-           (when (window-live-p selected-window)
-             (select-window selected-window)))
-         (kill-local-variable 'slime-popup-buffer-restore-info))
-        (t (bury-buffer))))
+  (when slime-popup-restore-data
+    (destructuring-bind (popup-window selected-window old-buffer)
+        slime-popup-restore-data
+      (bury-buffer)
+      (when (eq popup-window (selected-window))
+        (cond ((and (not old-buffer) (not (one-window-p)))
+               (delete-window popup-window))
+              ((and old-buffer (buffer-live-p old-buffer))
+               (set-window-buffer popup-window old-buffer))))
+      (when (window-live-p selected-window)
+        (select-window selected-window)))
+    (kill-local-variable 'slime-popup-restore-data)))
 
 (defmacro slime-save-local-variables (vars &rest body)
   `(let ((vals (cons (mapcar (lambda (var)
@@ -5473,7 +5475,7 @@
   (with-current-buffer (sldb-get-buffer thread)
     (unless (equal sldb-level level)
       (setq buffer-read-only nil)
-      (slime-save-local-variables (slime-popup-buffer-restore-info)
+      (slime-save-local-variables (slime-popup-restore-data)
         (sldb-mode))
       (setq slime-current-thread thread)
       (setq sldb-level level)




From heller at common-lisp.net  Thu Jan  8 10:33:30 2009
From: heller at common-lisp.net (CVS User heller)
Date: Thu, 08 Jan 2009 10:33:30 +0000
Subject: [slime-cvs] CVS slime
Message-ID: <E1LKsCg-0004Zf-Be@common-lisp.net>

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

Modified Files:
	ChangeLog slime.el 
Log Message:
* slime.el (slime-popup-restore-data): Renamed from
slime-popup-buffer-restore-info.
(slime-popup-buffer-saved-fingerprint)
(slime-popup-buffer-saved-emacs-snapshot)
(slime-popup-buffer-snapshot-unchanged-p)
(slime-popup-buffer-restore-snapshot)
(slime-xref-quit, slime-xref-retract): Deleted.

--- /project/slime/cvsroot/slime/ChangeLog	2009/01/08 10:33:21	1.1651
+++ /project/slime/cvsroot/slime/ChangeLog	2009/01/08 10:33:30	1.1652
@@ -3,7 +3,10 @@
 	* slime.el (slime-popup-restore-data): Renamed from
 	slime-popup-buffer-restore-info.
 	(slime-popup-buffer-saved-fingerprint)
-	(slime-popup-buffer-saved-emacs-snapshot): Deleted.
+	(slime-popup-buffer-saved-emacs-snapshot)
+	(slime-popup-buffer-snapshot-unchanged-p)
+	(slime-popup-buffer-restore-snapshot)
+	(slime-xref-quit, slime-xref-retract): Deleted.
 
 2009-01-08  Helmut Eller  <heller at common-lisp.net>
 
--- /project/slime/cvsroot/slime/slime.el	2009/01/08 10:33:21	1.1110
+++ /project/slime/cvsroot/slime/slime.el	2009/01/08 10:33:30	1.1111
@@ -929,17 +929,21 @@
 
 (defvar slime-popup-restore-data nil
   "Data needed when closing popup windows.
-This is buffer local variable.
+This is used as buffer local variable.
 The format is (POPUP-WINDOW SELECTED-WINDOW OLD-BUFFER).
 POPUP-WINDOW is the window used to display the temp buffer.
 That window may have been reused or freshly created.
 SELECTED-WINDOW is the window that was selected before displaying
 the popup buffer.
 OLD-BUFFER is the buffer that was previously displayed in POPUP-WINDOW.
-OLD-BUFFER if nil if POPUP-WINDOW was newly created.
+OLD-BUFFER is nil if POPUP-WINDOW was newly created.
 
 See `view-return-to-alist' for a similar idea.")
 
+;; keep compiler quiet
+(defvar slime-buffer-package)
+(defvar slime-buffer-connection)
+
 ;; Interface
 (defmacro* slime-with-popup-buffer ((name &optional package connection select
                                           emacs-snapshot)
@@ -984,11 +988,7 @@
 
 (defun slime-init-popup-buffer (buffer-vars)
   (slime-popup-buffer-mode 1)
-  ;;(setq slime-popup-buffer-saved-fingerprint
-  ;;      (slime-current-emacs-snapshot-fingerprint))
-  (multiple-value-setq (slime-buffer-package 
-                        slime-buffer-connection
-                        slime-popup-buffer-saved-emacs-snapshot)
+  (multiple-value-setq (slime-buffer-package slime-buffer-connection)
     buffer-vars))
 
 (defun slime-display-popup-buffer (select)
@@ -1024,16 +1024,16 @@
     (kill-local-variable 'slime-popup-restore-data)))
 
 (defmacro slime-save-local-variables (vars &rest body)
-  `(let ((vals (cons (mapcar (lambda (var)
-                               (if (slime-local-variable-p var)
-                                   (cons var (eval var))))
-                             ',vars)
-                     (progn . ,body))))
-     (prog1 (cdr vals)
+  (let ((vals (make-symbol "vals")))
+  `(let ((,vals (mapcar (lambda (var)
+                          (if (slime-local-variable-p var)
+                              (cons var (eval var))))
+                        ',vars)))
+     (prog1 (progn . ,body)
        (mapc (lambda (var+val)
                (when (consp var+val)
                  (set (make-local-variable (car var+val)) (cdr var+val))))
-             (car vals)))))
+             ,vals)))))
 
 (put 'slime-save-local-variables 'lisp-indent-function 1)
 
@@ -1063,22 +1063,10 @@
 last activated the buffer."
   (interactive)
   (let ((buffer (current-buffer)))
-    ;;(when (slime-popup-buffer-snapshot-unchanged-p)
-    ;;  (slime-popup-buffer-restore-snapshot))
-    (setq slime-popup-buffer-saved-emacs-snapshot nil) ; buffer-local var!
     (slime-close-popup-window)
     (when kill-buffer-p
       (kill-buffer buffer))))
 
-(defun slime-popup-buffer-snapshot-unchanged-p ()
-  (equalp (slime-current-emacs-snapshot-fingerprint)
-          slime-popup-buffer-saved-fingerprint))
-
-(defun slime-popup-buffer-restore-snapshot ()
-  (let ((snapshot slime-popup-buffer-saved-emacs-snapshot))
-    (assert snapshot) 
-    (slime-set-emacs-snapshot snapshot)))
-
 ;;;;; Filename translation
 ;;;
 ;;; Filenames passed between Emacs and Lisp should be translated using
@@ -4832,28 +4820,6 @@
 
 (put 'slime-with-xref-buffer 'lisp-indent-function 1)
 
-(defun slime-xref-quit (&optional _)
-  "Kill the current xref buffer, restore the window configuration
-if appropriate."
-  (interactive)
-  ;; We can't simply use `slime-popup-buffer-quit' because we also
-  ;; want the Xref window be deleted.
-  (if (slime-popup-buffer-snapshot-unchanged-p)
-      (slime-xref-retract)
-    (let ((snapshot slime-popup-buffer-saved-emacs-snapshot)
-          (buffer   (current-buffer)))
-      ;; Make M-, work after Xref'ing.
-      (slime-push-definition-stack-from-snapshot snapshot)
-      (delete-windows-on buffer)
-      (kill-buffer buffer))))
-
-(defun slime-xref-retract ()
-  "Leave the Xref buffer, and make everything as of before."
-  (interactive)
-  (let ((buffer (current-buffer)))
-    (slime-popup-buffer-restore-snapshot)
-    (kill-buffer buffer)))
-
 (defun slime-insert-xrefs (xref-alist)
   "Insert XREF-ALIST in the current-buffer.
 XREF-ALIST is of the form ((GROUP . ((LABEL LOCATION) ...)) ...).




From heller at common-lisp.net  Thu Jan  8 10:33:44 2009
From: heller at common-lisp.net (CVS User heller)
Date: Thu, 08 Jan 2009 10:33:44 +0000
Subject: [slime-cvs] CVS slime
Message-ID: <E1LKsCu-0004au-CT@common-lisp.net>

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

Modified Files:
	ChangeLog slime.el swank-abcl.lisp swank-allegro.lisp 
	swank-backend.lisp swank-clisp.lisp swank-cmucl.lisp 
	swank-corman.lisp swank-ecl.lisp swank-lispworks.lisp 
	swank-openmcl.lisp swank-sbcl.lisp swank-scl.lisp swank.lisp 
Log Message:
* swank-backend.lisp (swank-compile-string): Pass the
buffer-file-name to Lisp, not only the directory.
Update callers accordingly

--- /project/slime/cvsroot/slime/ChangeLog	2009/01/08 10:33:30	1.1652
+++ /project/slime/cvsroot/slime/ChangeLog	2009/01/08 10:33:43	1.1653
@@ -1,5 +1,11 @@
 2009-01-08  Helmut Eller  <heller at common-lisp.net>
 
+	* swank-backend.lisp (swank-compile-string): Pass the
+	buffer-file-name to Lisp, not only the directory.
+	Update callers accordingly.
+
+2009-01-08  Helmut Eller  <heller at common-lisp.net>
+
 	* slime.el (slime-popup-restore-data): Renamed from
 	slime-popup-buffer-restore-info.
 	(slime-popup-buffer-saved-fingerprint)
--- /project/slime/cvsroot/slime/slime.el	2009/01/08 10:33:30	1.1111
+++ /project/slime/cvsroot/slime/slime.el	2009/01/08 10:33:43	1.1112
@@ -2680,7 +2680,7 @@
      ,string
      ,(buffer-name)
      ,start-offset
-     ,(if (buffer-file-name) (file-name-directory (buffer-file-name)))
+     ,(if (buffer-file-name) (slime-to-lisp-filename (buffer-file-name)))
      ',slime-compilation-policy)
    #'slime-compilation-finished))
 
--- /project/slime/cvsroot/slime/swank-abcl.lisp	2008/12/30 18:57:54	1.61
+++ /project/slime/cvsroot/slime/swank-abcl.lisp	2009/01/08 10:33:43	1.62
@@ -340,9 +340,9 @@
                       (and load-p 
                            (not (load fn))))))))))
 
-(defimplementation swank-compile-string (string &key buffer position directory
-                                                policy)
-  (declare (ignore directory policy))
+(defimplementation swank-compile-string (string &key buffer position filename
+                                         policy)
+  (declare (ignore filename policy))
   (let ((jvm::*resignal-compiler-warnings* t)
         (*abcl-signaled-conditions* nil))
     (handler-bind ((warning #'handle-compiler-warning))                 
--- /project/slime/cvsroot/slime/swank-allegro.lisp	2008/12/30 18:57:54	1.120
+++ /project/slime/cvsroot/slime/swank-allegro.lisp	2009/01/08 10:33:43	1.121
@@ -315,8 +315,8 @@
            (delete-file binary-filename))
          (not failure?)))))
 
-(defimplementation swank-compile-string (string &key buffer position directory
-                                                policy)
+(defimplementation swank-compile-string (string &key buffer position filename
+                                         policy)
   (declare (ignore policy))
   ;; We store the source buffer in excl::*source-pathname* as a string
   ;; of the form <buffername>;<start-offset>.  Quite ugly encoding, but
@@ -326,14 +326,14 @@
           (*buffer-start-position* position)
           (*buffer-string* string)
           (*default-pathname-defaults*
-           (if directory (merge-pathnames (pathname directory))
+           (if directory (merge-pathnames (pathname filename))
                *default-pathname-defaults*)))
       (compile-from-temp-file
        (format nil "~S ~S~%~A" 
                `(in-package ,(package-name *package*))
                `(eval-when (:compile-toplevel :load-toplevel)
-                 (setq excl::*source-pathname*
-                  ',(format nil "~A;~D" buffer position)))
+                  (setq excl::*source-pathname*
+                        ',(or filename (format nil "~A;~D" buffer position))))
                string)))))
 
 ;;;; Definition Finding
--- /project/slime/cvsroot/slime/swank-backend.lisp	2008/12/31 11:25:03	1.166
+++ /project/slime/cvsroot/slime/swank-backend.lisp	2009/01/08 10:33:43	1.167
@@ -370,7 +370,7 @@
   (declare (ignore ignore))
   `(call-with-compilation-hooks (lambda () (progn , at body))))
 
-(definterface swank-compile-string (string &key buffer position directory
+(definterface swank-compile-string (string &key buffer position filename
                                            policy)
   "Compile source from STRING.
 During compilation, compiler conditions must be trapped and
@@ -381,11 +381,11 @@
 Additionally, if POSITION is supplied, it must be added to source
 positions reported in compiler conditions.
 
-If DIRECTORY is specified it may be used by certain implementations to
+If FILENAME is specified it may be used by certain implementations to
 rebind *DEFAULT-PATHNAME-DEFAULTS* which may improve the recording of
 source information.
 
-If DEBUG is supplied, and non-NIL, it may be used by certain
+If POLICY is supplied, and non-NIL, it may be used by certain
 implementations to compile with a debug optimization quality of its
 value.
 
--- /project/slime/cvsroot/slime/swank-clisp.lisp	2009/01/03 21:13:00	1.86
+++ /project/slime/cvsroot/slime/swank-clisp.lisp	2009/01/08 10:33:43	1.87
@@ -635,9 +635,9 @@
                     (and load-p 
                          (not (load fasl-file)))))))))
 
-(defimplementation swank-compile-string (string &key buffer position directory
+(defimplementation swank-compile-string (string &key buffer position filename
                                          policy)
-  (declare (ignore directory policy))
+  (declare (ignore filename policy))
   (with-compilation-hooks ()
     (let ((*buffer-name* buffer)
           (*buffer-offset* position))
--- /project/slime/cvsroot/slime/swank-cmucl.lisp	2009/01/08 06:45:37	1.208
+++ /project/slime/cvsroot/slime/swank-cmucl.lisp	2009/01/08 10:33:44	1.209
@@ -394,9 +394,9 @@
                       (source-cache-get filename (file-write-date filename))
                       (not (load output-file)))))))))
 
-(defimplementation swank-compile-string (string &key buffer position directory
-                                                policy)
-  (declare (ignore directory policy))
+(defimplementation swank-compile-string (string &key buffer position filename
+                                         policy)
+  (declare (ignore filename policy))
   (with-compilation-hooks ()
     (let ((*buffer-name* buffer)
           (*buffer-start-position* position)
--- /project/slime/cvsroot/slime/swank-corman.lisp	2008/12/30 18:57:54	1.21
+++ /project/slime/cvsroot/slime/swank-corman.lisp	2009/01/08 10:33:44	1.22
@@ -371,9 +371,9 @@
 	(values output-file warnings?
 		(or failure? (and load-p (load output-file))))))))
 
-(defimplementation swank-compile-string (string &key buffer position directory
-                                                policy)
-  (declare (ignore directory policy))
+(defimplementation swank-compile-string (string &key buffer position filename
+					 policy)
+  (declare (ignore filename policy))
   (with-compilation-hooks ()
     (let ((*buffer-name* buffer)
           (*buffer-position* position)
--- /project/slime/cvsroot/slime/swank-ecl.lisp	2008/12/30 18:57:54	1.36
+++ /project/slime/cvsroot/slime/swank-ecl.lisp	2009/01/08 10:33:44	1.37
@@ -145,9 +145,9 @@
     (let ((*buffer-name* nil))
       (compile-file *compile-filename* :load t))))
 
-(defimplementation swank-compile-string (string &key buffer position directory
-                                                policy)
-  (declare (ignore directory policy))
+(defimplementation swank-compile-string (string &key buffer position filename
+                                         policy)
+  (declare (ignore filename policy))
   (with-compilation-hooks ()
     (let ((*buffer-name* buffer)
           (*buffer-start-position* position)
--- /project/slime/cvsroot/slime/swank-lispworks.lisp	2008/12/31 11:25:03	1.125
+++ /project/slime/cvsroot/slime/swank-lispworks.lisp	2009/01/08 10:33:44	1.126
@@ -628,9 +628,9 @@
 		nil)))
 	   htab))
 
-(defimplementation swank-compile-string (string &key buffer position directory
-                                                policy)
-  (declare (ignore directory policy))
+(defimplementation swank-compile-string (string &key buffer position filename
+                                         policy)
+  (declare (ignore filename policy))
   (assert buffer)
   (assert position)
   (let* ((location (list :emacs-buffer buffer position string))
--- /project/slime/cvsroot/slime/swank-openmcl.lisp	2009/01/01 14:48:22	1.152
+++ /project/slime/cvsroot/slime/swank-openmcl.lisp	2009/01/08 10:33:44	1.153
@@ -368,40 +368,38 @@
            (mapcan 'who-specializes (ccl::%class-direct-subclasses class)))
    :test 'equal))
 
-(defimplementation swank-compile-string (string &key buffer position directory
+(defimplementation swank-compile-string (string &key buffer position filename
                                          policy)
   (declare (ignore policy))
   (with-compilation-hooks ()
     (let ((*buffer-name* buffer)
           (*buffer-offset* position)
-          (filename (temp-file-name)))
+          (temp-file-name (temp-file-name)))
       (unwind-protect
-           (with-open-file (s filename :direction :output :if-exists :error)
-             (write-string string s))
-        (let ((binary-filename (compile-temp-file
-                                filename directory buffer position)))
-          (delete-file binary-filename)))
-      (delete-file filename))))
+           (progn
+             (with-open-file (s temp-file-name :direction :output 
+                                :if-exists :error)
+               (write-string string s))
+             (let ((binary-filename (compile-temp-file
+                                     temp-file-name filename buffer position)))
+               (delete-file binary-filename)))
+        (delete-file temp-file-name)))))
 
 (defvar *temp-file-map* (make-hash-table :test #'equal)
   "A mapping from tempfile names to Emacs buffer names.")
 
-(defun note-temp-file (filename directory buffer)
-  (cond (directory
-         (format nil "~a/~a" directory buffer))
-        (t
-         (setf (gethash filename *temp-file-map*) buffer)
-         filename)))
-
-(defun compile-temp-file (filename dir buffer offset)
+(defun compile-temp-file (temp-file-name buffer-file-name buffer-name offset)
   (if (fboundp 'ccl::function-source-note)
-      (compile-file filename
+      (compile-file temp-file-name
                     :load t
-                    :compile-file-original-truename (note-temp-file filename 
-                                                                    dir
-                                                                    buffer)
+                    :compile-file-original-truename 
+                    (or buffer-file-name
+                        (progn 
+                          (setf (gethash temp-file-name *temp-file-map*)
+                                buffer-name)
+                          temp-file-name))
                     :compile-file-original-buffer-offset (1- offset))
-      (compile-file filename :load t)))
+      (compile-file temp-file-name :load t)))
 
 ;;; Profiling (alanr: lifted from swank-clisp)
 
--- /project/slime/cvsroot/slime/swank-sbcl.lisp	2009/01/05 11:19:09	1.230
+++ /project/slime/cvsroot/slime/swank-sbcl.lisp	2009/01/08 10:33:44	1.231
@@ -525,12 +525,12 @@
    (loop for (qual . value) in policy
          do (sb-ext:restrict-compiler-policy qual value)))
 
-(defimplementation swank-compile-string (string &key buffer position directory
-                                                policy)
+(defimplementation swank-compile-string (string &key buffer position filename
+                                         policy)
   (let ((*buffer-name* buffer)
         (*buffer-offset* position)
         (*buffer-substring* string)
-        (filename (temp-file-name))
+        (temp-file-name (temp-file-name))
         (saved-policy (get-compiler-policy '((debug . 0) (speed . 0)))))
     (when policy
       (set-compiler-policy policy))
@@ -540,11 +540,11 @@
              (with-compilation-hooks ()
                (with-compilation-unit
                    (:source-plist (list :emacs-buffer buffer
-                                        :emacs-directory directory
+                                        :emacs-filename filename
                                         :emacs-string string
                                         :emacs-position position))
-                 (funcall cont (compile-file filename))))))
-      (with-open-file (s filename :direction :output :if-exists :error)
+                 (funcall cont (compile-file temp-file-name))))))
+      (with-open-file (s temp-file-name :direction :output :if-exists :error)
         (write-string string s))
       (unwind-protect
            (if *trap-load-time-warnings*
@@ -552,8 +552,8 @@
                (load-it (compile-it #'identity)))
         (ignore-errors
           (set-compiler-policy saved-policy)
-          (delete-file filename)
-          (delete-file (compile-file-pathname filename)))))))
+          (delete-file temp-file-name)
+          (delete-file (compile-file-pathname temp-file-name)))))))
 
 ;;;; Definitions
 
--- /project/slime/cvsroot/slime/swank-scl.lisp	2008/12/30 18:57:54	1.30
+++ /project/slime/cvsroot/slime/swank-scl.lisp	2009/01/08 10:33:44	1.31
@@ -451,9 +451,9 @@
                       (source-cache-get filename (file-write-date filename))
                       (not (load output-file)))))))))
 
-(defimplementation swank-compile-string (string &key buffer position directory
+(defimplementation swank-compile-string (string &key buffer position filename
                                                 policy)
-  (declare (ignore directory policy))
+  (declare (ignore filename policy))
   (with-compilation-hooks ()
     (let ((*buffer-name* buffer)
           (*buffer-start-position* position)
--- /project/slime/cvsroot/slime/swank.lisp	2009/01/08 06:45:45	1.626
+++ /project/slime/cvsroot/slime/swank.lisp	2009/01/08 10:33:44	1.627
@@ -2736,7 +2736,7 @@
            (declare (ignore output-pathname warnings?))
            (not failure?)))))))
 
-(defslimefun compile-string-for-emacs (string buffer position directory policy)
+(defslimefun compile-string-for-emacs (string buffer position filename policy)
   "Compile STRING (exerpted from BUFFER at POSITION).
 Record compiler notes signalled as `compiler-condition's."
   (with-buffer-syntax ()
@@ -2746,13 +2746,13 @@
          (swank-compile-string string
                                :buffer buffer
                                :position position 
-                               :directory directory
+                               :filename filename
                                :policy policy))))))
 
 (defslimefun compile-multiple-strings-for-emacs (strings policy)
   "Compile STRINGS (exerpted from BUFFER at POSITION).
 Record compiler notes signalled as `compiler-condition's."
-  (loop for (string buffer package position directory) in strings collect
+  (loop for (string buffer package position filename) in strings collect
         (collect-notes
          (lambda ()
            (with-buffer-syntax (package)
@@ -2760,7 +2760,7 @@
                (swank-compile-string string
                                      :buffer buffer
                                      :position position 
-                                     :directory directory
+                                     :filename filename
                                      :policy policy)))))))
 
 (defun file-newer-p (new-file old-file)




From heller at common-lisp.net  Thu Jan  8 10:37:51 2009
From: heller at common-lisp.net (CVS User heller)
Date: Thu, 08 Jan 2009 10:37:51 +0000
Subject: [slime-cvs] CVS slime
Message-ID: <E1LKsGt-0004iy-Fo@common-lisp.net>

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

Modified Files:
	ChangeLog slime.el swank.lisp 
Log Message:
Move the tree widget for compiler notes to contrib/.

--- /project/slime/cvsroot/slime/ChangeLog	2009/01/08 10:33:43	1.1653
+++ /project/slime/cvsroot/slime/ChangeLog	2009/01/08 10:37:51	1.1654
@@ -1,5 +1,9 @@
 2009-01-08  Helmut Eller  <heller at common-lisp.net>
 
+	* slime.el: Move the tree widget for compiler notes to contrib/.
+
+2009-01-08  Helmut Eller  <heller at common-lisp.net>
+
 	* swank-backend.lisp (swank-compile-string): Pass the
 	buffer-file-name to Lisp, not only the directory.
 	Update callers accordingly.
--- /project/slime/cvsroot/slime/slime.el	2009/01/08 10:33:43	1.1112
+++ /project/slime/cvsroot/slime/slime.el	2009/01/08 10:37:51	1.1113
@@ -2597,6 +2597,7 @@
   "When non-nil compile defuns with this debug optimization level.")
 
 (defun slime-compute-policy (arg)
+  "Return the policy for the prefix argument ARG."
   (flet ((between (min n max)
            (if (< n min)
                min
@@ -2607,7 +2608,6 @@
             ((eq arg '-) `((cl:speed . 3)))
             (t           `((cl:speed . ,(between 0 (abs n) 3))))))))
 
-
 (defstruct (slime-compilation-result
              (:type list)
              (:conc-name slime-compilation-result.)
@@ -2894,29 +2894,6 @@
            (format "%s:%d:%d: " (or filename "") line col)))
         (t "")))
 
-(defun slime-maybe-list-compiler-notes (notes)
-  "Show the compiler notes if appropriate."
-  ;; don't pop up a buffer if all notes are already annotated in the
-  ;; buffer itself
-  (unless (every #'slime-note-has-location-p notes)
-    (slime-list-compiler-notes notes)))
-
-(defun slime-list-compiler-notes (notes)
-  "Show the compiler notes NOTES in tree view."
-  (interactive (list (slime-compiler-notes)))
-  (with-temp-message "Preparing compiler note tree..."
-    (slime-with-popup-buffer ("*SLIME Compiler-Notes*")
-      (erase-buffer)
-      (slime-compiler-notes-mode)
-      (when (null notes)
-        (insert "[no notes]"))
-      (let ((collapsed-p))
-        (dolist (tree (slime-compiler-notes-to-tree notes))
-          (when (slime-tree.collapsed-p tree) (setf collapsed-p t))
-          (slime-tree-insert tree "")
-          (insert "\n"))
-        (goto-char (point-min))))))
-
 (defun slime-alistify (list key test)
   "Partition the elements of LIST into an alist.
 KEY extracts the key from an element and TEST is used to compare
@@ -2954,152 +2931,6 @@
     (:read-error "Read Errors")
     (:style-warning "Style Warnings")))
 
-(defvar slime-tree-printer 'slime-tree-default-printer)
-
-(defun slime-tree-for-note (note)
-  (make-slime-tree :item (slime-note.message note)
-                   :plist (list 'note note)
-                   :print-fn slime-tree-printer))
-
-(defun slime-tree-for-severity (severity notes collapsed-p)
-  (make-slime-tree :item (format "%s (%d)" 
-                                 (slime-severity-label severity)
-                                 (length notes))
-                   :kids (mapcar #'slime-tree-for-note notes)
-                   :collapsed-p collapsed-p))
-
-(defun slime-compiler-notes-to-tree (notes)
-  (let* ((alist (slime-alistify notes #'slime-note.severity #'eq))
-         (collapsed-p (slime-length> alist 1)))
-    (loop for (severity . notes) in alist
-          collect (slime-tree-for-severity severity notes 
-                                           collapsed-p))))
-
-(defvar slime-compiler-notes-mode-map)
-
-(define-derived-mode slime-compiler-notes-mode fundamental-mode 
-  "Compiler-Notes"
-  "\\<slime-compiler-notes-mode-map>\
-\\{slime-compiler-notes-mode-map}
-\\{slime-popup-buffer-mode-map}
-"
-  (slime-set-truncate-lines))
-
-(slime-define-keys slime-compiler-notes-mode-map
-  ((kbd "RET") 'slime-compiler-notes-default-action-or-show-details)
-  ([return] 'slime-compiler-notes-default-action-or-show-details)
-  ([mouse-2] 'slime-compiler-notes-default-action-or-show-details/mouse))
-
-(defun slime-compiler-notes-default-action-or-show-details/mouse (event)
-  "Invoke the action pointed at by the mouse, or show details."
-  (interactive "e")
-  (destructuring-bind (mouse-2 (w pos &rest _) &rest __) event
-    (save-excursion
-      (goto-char pos)
-      (let ((fn (get-text-property (point) 
-                                   'slime-compiler-notes-default-action)))
-	(if fn (funcall fn) (slime-compiler-notes-show-details))))))
-
-(defun slime-compiler-notes-default-action-or-show-details ()
-  "Invoke the action at point, or show details."
-  (interactive)
-  (let ((fn (get-text-property (point) 'slime-compiler-notes-default-action)))
-    (if fn (funcall fn) (slime-compiler-notes-show-details))))
-
-(defun slime-compiler-notes-show-details ()
-  (interactive)
-  (let* ((tree (slime-tree-at-point))
-         (note (plist-get (slime-tree.plist tree) 'note))
-         (inhibit-read-only t))
-    (cond ((not (slime-tree-leaf-p tree))
-           (slime-tree-toggle tree))
-          (t
-           (slime-show-source-location (slime-note.location note) t)))))
-
-
-;;;;;; Tree Widget
-
-(defstruct (slime-tree (:conc-name slime-tree.))
-  item
-  (print-fn #'slime-tree-default-printer :type function)
-  (kids '() :type list)
-  (collapsed-p t :type boolean)
-  (prefix "" :type string)
-  (start-mark nil)
-  (end-mark nil)
-  (plist '() :type list))
-
-(defun slime-tree-leaf-p (tree)
-  (not (slime-tree.kids tree)))
-
-(defun slime-tree-default-printer (tree)
-  (princ (slime-tree.item tree) (current-buffer)))
-
-(defun slime-tree-decoration (tree)
-  (cond ((slime-tree-leaf-p tree) "-- ")
-	((slime-tree.collapsed-p tree) "[+] ")
-	(t "-+  ")))
-
-(defun slime-tree-insert-list (list prefix)
-  "Insert a list of trees."
-  (loop for (elt . rest) on list 
-	do (cond (rest
-		  (insert prefix " |")
-		  (slime-tree-insert elt (concat prefix " |"))
-                  (insert "\n"))
-		 (t
-		  (insert prefix " `")
-		  (slime-tree-insert elt (concat prefix "  "))))))
-
-(defun slime-tree-insert-decoration (tree)
-  (insert (slime-tree-decoration tree)))
-
-(defun slime-tree-indent-item (start end prefix)
-  "Insert PREFIX at the beginning of each but the first line.
-This is used for labels spanning multiple lines."
-  (save-excursion
-    (goto-char end)
-    (beginning-of-line)
-    (while (< start (point))
-      (insert-before-markers prefix)
-      (forward-line -1))))
-
-(defun slime-tree-insert (tree prefix)
-  "Insert TREE prefixed with PREFIX at point."
-  (with-struct (slime-tree. print-fn kids collapsed-p start-mark end-mark) tree
-    (let ((line-start (line-beginning-position)))
-      (setf start-mark (point-marker))
-      (slime-tree-insert-decoration tree)
-      (funcall print-fn tree)
-      (slime-tree-indent-item start-mark (point) (concat prefix "   "))
-      (add-text-properties line-start (point) (list 'slime-tree tree))
-      (set-marker-insertion-type start-mark t)
-      (when (and kids (not collapsed-p))
-        (terpri (current-buffer))
-        (slime-tree-insert-list kids prefix))
-      (setf (slime-tree.prefix tree) prefix)
-      (setf end-mark (point-marker)))))
-
-(defun slime-tree-at-point ()
-  (cond ((get-text-property (point) 'slime-tree))
-        (t (error "No tree at point"))))
-
-(defun slime-tree-delete (tree)
-  "Delete the region for TREE."
-  (delete-region (slime-tree.start-mark tree)
-                 (slime-tree.end-mark tree)))
-
-(defun slime-tree-toggle (tree)
-  "Toggle the visibility of TREE's children."
-  (with-struct (slime-tree. collapsed-p start-mark end-mark prefix) tree
-    (setf collapsed-p (not collapsed-p))
-    (slime-tree-delete tree)
-    (insert-before-markers " ") ; move parent's end-mark
-    (backward-char 1)
-    (slime-tree-insert tree prefix)
-    (delete-char 1)
-    (goto-char start-mark)))
-
 
 ;;;;; Adding a single compiler note
 
--- /project/slime/cvsroot/slime/swank.lisp	2009/01/08 10:33:44	1.627
+++ /project/slime/cvsroot/slime/swank.lisp	2009/01/08 10:37:51	1.628
@@ -253,8 +253,9 @@
 ;;; Connection structures represent the network connections between
 ;;; Emacs and Lisp. Each has a socket stream, a set of user I/O
 ;;; streams that redirect to Emacs, and optionally a second socket
-;;; used solely to pipe user-output to Emacs (an optimization).
-;;;
+;;; used solely to pipe user-output to Emacs (an optimization).  This
+;;; is also the place where we keep everything that needs to be
+;;; freed/closed/killed when we disconnect.
 
 (defstruct (connection
              (:conc-name connection.)




From heller at common-lisp.net  Thu Jan  8 10:37:51 2009
From: heller at common-lisp.net (CVS User heller)
Date: Thu, 08 Jan 2009 10:37:51 +0000
Subject: [slime-cvs] CVS slime/contrib
Message-ID: <E1LKsGt-0004jK-Sg@common-lisp.net>

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

Added Files:
	slime-compiler-notes-tree.el 
Log Message:
Move the tree widget for compiler notes to contrib/.


--- /project/slime/cvsroot/slime/contrib/slime-compiler-notes-tree.el	2009/01/08 10:37:51	NONE
+++ /project/slime/cvsroot/slime/contrib/slime-compiler-notes-tree.el	2009/01/08 10:37:51	1.1
;; slime-complete-notes-tree.el --- Display compiler messages in tree layout.
;;
;; Author: Helmut Eller
;; License: GNU GPL (same license as Emacs)
;;
;;; Commentary:
;;
;; M-x slime-list-compiler-notes display the compiler notes in a tree
;; grouped by severity.
;;
;; `slime-maybe-list-compiler-notes' can be used as
;; `slime-compilation-finished-hook'.

(defun slime-maybe-list-compiler-notes (notes)
  "Show the compiler notes if appropriate."
  ;; don't pop up a buffer if all notes are already annotated in the
  ;; buffer itself
  (unless (every #'slime-note-has-location-p notes)
    (slime-list-compiler-notes notes)))

(defun slime-list-compiler-notes (notes)
  "Show the compiler notes NOTES in tree view."
  (interactive (list (slime-compiler-notes)))
  (with-temp-message "Preparing compiler note tree..."
    (slime-with-popup-buffer ("*SLIME Compiler-Notes*")
      (erase-buffer)
      (slime-compiler-notes-mode)
      (when (null notes)
        (insert "[no notes]"))
      (let ((collapsed-p))
        (dolist (tree (slime-compiler-notes-to-tree notes))
          (when (slime-tree.collapsed-p tree) (setf collapsed-p t))
          (slime-tree-insert tree "")
          (insert "\n"))
        (goto-char (point-min))))))

(defvar slime-tree-printer 'slime-tree-default-printer)

(defun slime-tree-for-note (note)
  (make-slime-tree :item (slime-note.message note)
                   :plist (list 'note note)
                   :print-fn slime-tree-printer))

(defun slime-tree-for-severity (severity notes collapsed-p)
  (make-slime-tree :item (format "%s (%d)" 
                                 (slime-severity-label severity)
                                 (length notes))
                   :kids (mapcar #'slime-tree-for-note notes)
                   :collapsed-p collapsed-p))

(defun slime-compiler-notes-to-tree (notes)
  (let* ((alist (slime-alistify notes #'slime-note.severity #'eq))
         (collapsed-p (slime-length> alist 1)))
    (loop for (severity . notes) in alist
          collect (slime-tree-for-severity severity notes 
                                           collapsed-p))))

(defvar slime-compiler-notes-mode-map)

(define-derived-mode slime-compiler-notes-mode fundamental-mode 
  "Compiler-Notes"
  "\\<slime-compiler-notes-mode-map>\
\\{slime-compiler-notes-mode-map}
\\{slime-popup-buffer-mode-map}
"
  (slime-set-truncate-lines))

(slime-define-keys slime-compiler-notes-mode-map
  ((kbd "RET") 'slime-compiler-notes-default-action-or-show-details)
  ([return] 'slime-compiler-notes-default-action-or-show-details)
  ([mouse-2] 'slime-compiler-notes-default-action-or-show-details/mouse))

(defun slime-compiler-notes-default-action-or-show-details/mouse (event)
  "Invoke the action pointed at by the mouse, or show details."
  (interactive "e")
  (destructuring-bind (mouse-2 (w pos &rest _) &rest __) event
    (save-excursion
      (goto-char pos)
      (let ((fn (get-text-property (point) 
                                   'slime-compiler-notes-default-action)))
	(if fn (funcall fn) (slime-compiler-notes-show-details))))))

(defun slime-compiler-notes-default-action-or-show-details ()
  "Invoke the action at point, or show details."
  (interactive)
  (let ((fn (get-text-property (point) 'slime-compiler-notes-default-action)))
    (if fn (funcall fn) (slime-compiler-notes-show-details))))

(defun slime-compiler-notes-show-details ()
  (interactive)
  (let* ((tree (slime-tree-at-point))
         (note (plist-get (slime-tree.plist tree) 'note))
         (inhibit-read-only t))
    (cond ((not (slime-tree-leaf-p tree))
           (slime-tree-toggle tree))
          (t
           (slime-show-source-location (slime-note.location note) t)))))


;;;;;; Tree Widget

(defstruct (slime-tree (:conc-name slime-tree.))
  item
  (print-fn #'slime-tree-default-printer :type function)
  (kids '() :type list)
  (collapsed-p t :type boolean)
  (prefix "" :type string)
  (start-mark nil)
  (end-mark nil)
  (plist '() :type list))

(defun slime-tree-leaf-p (tree)
  (not (slime-tree.kids tree)))

(defun slime-tree-default-printer (tree)
  (princ (slime-tree.item tree) (current-buffer)))

(defun slime-tree-decoration (tree)
  (cond ((slime-tree-leaf-p tree) "-- ")
	((slime-tree.collapsed-p tree) "[+] ")
	(t "-+  ")))

(defun slime-tree-insert-list (list prefix)
  "Insert a list of trees."
  (loop for (elt . rest) on list 
	do (cond (rest
		  (insert prefix " |")
		  (slime-tree-insert elt (concat prefix " |"))
                  (insert "\n"))
		 (t
		  (insert prefix " `")
		  (slime-tree-insert elt (concat prefix "  "))))))

(defun slime-tree-insert-decoration (tree)
  (insert (slime-tree-decoration tree)))

(defun slime-tree-indent-item (start end prefix)
  "Insert PREFIX at the beginning of each but the first line.
This is used for labels spanning multiple lines."
  (save-excursion
    (goto-char end)
    (beginning-of-line)
    (while (< start (point))
      (insert-before-markers prefix)
      (forward-line -1))))

(defun slime-tree-insert (tree prefix)
  "Insert TREE prefixed with PREFIX at point."
  (with-struct (slime-tree. print-fn kids collapsed-p start-mark end-mark) tree
    (let ((line-start (line-beginning-position)))
      (setf start-mark (point-marker))
      (slime-tree-insert-decoration tree)
      (funcall print-fn tree)
      (slime-tree-indent-item start-mark (point) (concat prefix "   "))
      (add-text-properties line-start (point) (list 'slime-tree tree))
      (set-marker-insertion-type start-mark t)
      (when (and kids (not collapsed-p))
        (terpri (current-buffer))
        (slime-tree-insert-list kids prefix))
      (setf (slime-tree.prefix tree) prefix)
      (setf end-mark (point-marker)))))

(defun slime-tree-at-point ()
  (cond ((get-text-property (point) 'slime-tree))
        (t (error "No tree at point"))))

(defun slime-tree-delete (tree)
  "Delete the region for TREE."
  (delete-region (slime-tree.start-mark tree)
                 (slime-tree.end-mark tree)))

(defun slime-tree-toggle (tree)
  "Toggle the visibility of TREE's children."
  (with-struct (slime-tree. collapsed-p start-mark end-mark prefix) tree
    (setf collapsed-p (not collapsed-p))
    (slime-tree-delete tree)
    (insert-before-markers " ") ; move parent's end-mark
    (backward-char 1)
    (slime-tree-insert tree prefix)
    (delete-char 1)
    (goto-char start-mark)))

(provide 'slime-complete-notes-tree)



From heller at common-lisp.net  Thu Jan  8 16:13:33 2009
From: heller at common-lisp.net (CVS User heller)
Date: Thu, 08 Jan 2009 16:13:33 +0000
Subject: [slime-cvs] CVS slime
Message-ID: <E1LKxVl-000679-K8@common-lisp.net>

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

Modified Files:
	ChangeLog slime.el 
Log Message:
* slime.el ([test] arglist): Update arglist.

--- /project/slime/cvsroot/slime/ChangeLog	2009/01/08 10:37:51	1.1654
+++ /project/slime/cvsroot/slime/ChangeLog	2009/01/08 16:13:33	1.1655
@@ -7,6 +7,7 @@
 	* swank-backend.lisp (swank-compile-string): Pass the
 	buffer-file-name to Lisp, not only the directory.
 	Update callers accordingly.
+	([test] arglist): Update arglist.
 
 2009-01-08  Helmut Eller  <heller at common-lisp.net>
 
--- /project/slime/cvsroot/slime/slime.el	2009/01/08 10:37:51	1.1113
+++ /project/slime/cvsroot/slime/slime.el	2009/01/08 16:13:33	1.1114
@@ -7368,7 +7368,7 @@
       ("swank::create-socket" "(swank::create-socket host port)")
       ("swank::emacs-connected" "(swank::emacs-connected )")
       ("swank::compile-string-for-emacs"
-       "(swank::compile-string-for-emacs string buffer position directory policy)")
+       "(swank::compile-string-for-emacs string buffer position filename policy)")
       ("swank::connection.socket-io"
        "(swank::connection.socket-io \\(struct\\(ure\\)?\\|object\\|instance\\|x\\))")
       ("cl:lisp-implementation-type" "(cl:lisp-implementation-type )")




From heller at common-lisp.net  Thu Jan  8 16:20:14 2009
From: heller at common-lisp.net (CVS User heller)
Date: Thu, 08 Jan 2009 16:20:14 +0000
Subject: [slime-cvs] CVS slime
Message-ID: <E1LKxcE-0006TE-Ix@common-lisp.net>

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

Modified Files:
	ChangeLog swank-loader.lisp 
Log Message:
Some updates for the manual

--- /project/slime/cvsroot/slime/ChangeLog	2009/01/08 16:13:33	1.1655
+++ /project/slime/cvsroot/slime/ChangeLog	2009/01/08 16:20:14	1.1656
@@ -7,7 +7,7 @@
 	* swank-backend.lisp (swank-compile-string): Pass the
 	buffer-file-name to Lisp, not only the directory.
 	Update callers accordingly.
-	([test] arglist): Update arglist.
+	* slime.el ([test] arglist): Update arglist.
 
 2009-01-08  Helmut Eller  <heller at common-lisp.net>
 
--- /project/slime/cvsroot/slime/swank-loader.lisp	2009/01/02 16:43:21	1.89
+++ /project/slime/cvsroot/slime/swank-loader.lisp	2009/01/08 16:20:14	1.90
@@ -228,6 +228,12 @@
   (funcall (q "swank::init")))
 
 (defun init (&key delete reload load-contribs (setup t))
+  "Load SWANK and initialize some global variables.
+If DELETE is true, delete any existing SWANK packages.
+If RELOAD is true, reload SWANK, even if the SWANK package already exists.
+If LOAD-CONTRIBS is true, load all contribs
+If SETUP is true, load user init files and initialize some
+global variabes in SWANK."
   (when (and delete (find-package :swank))
     (mapc #'delete-package '(:swank :swank-io-package :swank-backend)))
   (cond ((or (not (find-package :swank)) reload)




From heller at common-lisp.net  Thu Jan  8 16:20:14 2009
From: heller at common-lisp.net (CVS User heller)
Date: Thu, 08 Jan 2009 16:20:14 +0000
Subject: [slime-cvs] CVS slime/doc
Message-ID: <E1LKxcE-0006Tb-Ql@common-lisp.net>

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

Modified Files:
	Makefile slime.texi 
Log Message:
Some updates for the manual

--- /project/slime/cvsroot/slime/doc/Makefile	2007/09/17 14:04:27	1.12
+++ /project/slime/cvsroot/slime/doc/Makefile	2009/01/08 16:20:14	1.13
@@ -33,6 +33,9 @@
 html/index.html: $(TEXI)
 	makeinfo -o html --html $<
 
+html.tgz: html/index.html
+	tar -czf $@ html
+
 slime.pdf: $(TEXI)
 	texi2pdf $<
 
@@ -94,4 +97,4 @@
 	rm -f contributors.texi
 	rm -f slime.{aux,cp,cps,fn,fns,ky,kys,log,pg,tmp,toc,tp,vr,vrs}
 	rm -f slime.{info,pdf,dvi,ps,html}
-	rm -rf html
+	rm -rf html{,.tgz}
--- /project/slime/cvsroot/slime/doc/slime.texi	2008/10/11 17:13:18	1.66
+++ /project/slime/cvsroot/slime/doc/slime.texi	2009/01/08 16:20:14	1.67
@@ -12,7 +12,7 @@
 @set EDITION 3.0-alpha
 @set SLIMEVER 3.0-alpha
 @c @set UPDATED @today{}
- at set UPDATED @code{$Date: 2008/10/11 17:13:18 $}
+ at set UPDATED @code{$Date: 2009/01/08 16:20:14 $}
 @set TITLE SLIME User Manual
 @settitle @value{TITLE}, version @value{EDITION}
 
@@ -112,8 +112,7 @@
 @menu
 * Introduction::                
 * Getting started::             
-* slime-mode::                  
-* REPL::                        
+* SLIME mode::                  
 * Debugger::                    
 * Misc::                        
 * Customization::               
@@ -150,10 +149,21 @@
 * Multiple Lisps::              
 * Loading Swank faster::        
 
-Using slime-mode
+Using Slime mode
 
 * User-interface conventions::  
-* Commands::                    
+* Evaluation::                  
+* Compilation::                 
+* Completion::                  
+* Finding definitions::         
+* Documentation::               
+* Cross-reference::             
+* Macro-expansion::             
+* Disassembly::                 
+* Recovery::                    
+* Inspector::                   
+* Profiling::                   
+* Other::                       
 * Semantic indentation::        
 * Reader conditionals::         
 
@@ -164,32 +174,6 @@
 * Multithreading::              
 * Key bindings::                
 
-Commands
-
-* Programming::                 
-* Compilation::                 
-* Evaluation::                  
-* Recovery::                    
-* Inspector::                   
-* Profiling::                   
-* Other::                       
-
-Programming commands
-
-* Completion::                  
-* Indentation::                 
-* Documentation::               
-* Cross-reference::             
-* Finding definitions::         
-* Macro-expansion::             
-* Disassembly::                 
-
-REPL: the ``top level''
-
-* REPL commands::               
-* Input Navigation::            
-* Shortcuts::                   
-
 SLDB: the SLIME debugger
 
 * Examining frames::            
@@ -233,6 +217,9 @@
 Contributed Packages
 
 * Loading Contribs::            
+* REPL::                        
+* slime-mrepl::                 
+* inferior-slime-mode::         
 * Compound Completion::         
 * Fuzzy Completion::            
 * slime-autodoc-mode::          
@@ -246,10 +233,15 @@
 * Documentation Links::         
 * Xref and Class Browser::      
 * Highlight Edits::             
-* inferior-slime-mode::         
 * Scratch Buffer::              
 * slime-fancy::                 
 
+REPL: the ``top level''
+
+* REPL commands::               
+* Input Navigation::            
+* Shortcuts::                   
+
 @end detailmenu
 @end menu
 
@@ -301,7 +293,7 @@
 
 @SLIME{} supports a wide range of operating systems and Lisp
 implementations. @SLIME{} runs on Unix systems, Mac OSX, and Microsoft
-Windows. GNU Emacs versions 20, 21 and 22 and XEmacs version 21 are
+Windows. GNU Emacs versions 21, 22, and 22 and XEmacs version 21 are
 supported.
 
 The supported Lisp implementations, roughly ordered from the
@@ -313,7 +305,7 @@
 @item
 Steel Bank Common Lisp (@acronym{SBCL}), 1.0 or newer
 @item
-OpenMCL, version 0.14.3 or newer
+Clozure Common Lisp (@acronym{CCL}), version 1.3 or newer
 @item
 LispWorks, version 4.3 or newer
 @item
@@ -323,10 +315,12 @@
 @item
 Armed Bear Common Lisp (@acronym{ABCL})
 @item
-Corman Common Lisp (@acronym{CCL}), version 2.51 or newer with the
+Corman Common Lisp, version 2.51 or newer with the
 patches from @url{http://www.grumblesmurf.org/lisp/corman-patches})
 @item
 Scieneer Common Lisp (@acronym{SCL}), version 1.2.7 or newer
+ at item
+Embedded Common Lisp (@acronym{ECL})
 @end itemize
 
 Most features work uniformly across implementations, but some are
@@ -418,24 +412,30 @@
 
 @vindex inferior-lisp-program
 @vindex load-path
+ at vindex slime-setup
 @example 
-(setq inferior-lisp-program "@emph{the path to your Lisp system}")
-(add-to-list 'load-path "@emph{the path of your @file{slime} directory}")
+(setq inferior-lisp-program "/opt/sbcl/bin/sbcl") ; @emph{your Lisp system}
+(add-to-list 'load-path "~/hacking/lisp/slime/")  ; @emph{your SLIME directory}
 (require 'slime)
 (slime-setup)
 @end example
 
- at iftex
+ at c @iftex
 The snippet above also appears in the @file{README} file. You can
 copy&paste it from there, but remember to fill in the appropriate
 paths.
- at end iftex
+ at c @end iftex
+
+This is the minimal configuration with the fewest frills.  If the
+basic setup is working, you can try additional modules (@ref{Loading
+Contribs}).
 
 We recommend not loading the @acronym{ILISP} package into Emacs if you
 intend to use @SLIME{}. Doing so will add a lot of extra bindings to
 the keymap for Lisp source files that may be confusing and may not
 work correctly for a Lisp process started by @SLIME{}.
 
+
 @c ----------------------- 
 @node Running
 @section Running SLIME
@@ -448,11 +448,6 @@
 
 At this point @SLIME{} is up and running and you can start exploring.
 
-You can restart the @code{inferior-lisp} process using the function:
- at table @kbd
- at cmditem{slime-restart-inferior-lisp}
- at end table
-
 @node Setup Tuning
 @section Setup Tuning
 
@@ -462,6 +457,8 @@
 Please proceed with this section only if your basic setup works.  If
 you are happy with the basic setup, skip this section.
 
+For contrib modules @pxref{Loading Contribs}.
+
 @menu
 * Autoloading::                 
 * Multiple Lisps::              
@@ -511,7 +508,7 @@
 program from that list.  The elements of the list should look like
 
 @lisp
-(NAME (PROGRAM PROGRAM-ARGS...) &key CODING-SYSTEM INIT INIT-FUNCTION)
+(NAME (PROGRAM PROGRAM-ARGS...) &key CODING-SYSTEM INIT INIT-FUNCTION ENV)
 @end lisp
 
 @table @code
@@ -535,6 +532,14 @@
 @itemx INIT-FUNCTION
 should be a function which takes no arguments.  It is called after 
 the connection is established. (See also @ref{slime-connected-hook}.)
+ at item ENV
+specifies a list of environment variables for the subprocess. E.g.
+ at lisp
+(sbcl-cvs ("/home/me/sbcl-cvs/src/runtime/sbcl" 
+           "--core" "/home/me/sbcl-cvs/output/sbcl.core")
+          :env ("SBCL_HOME=/home/me/sbcl-cvs/contrib/"))
+ at end lisp
+initializes @code{SBCL_HOME} in the subprocess.
 @end table
 
 @node Loading Swank faster
@@ -566,7 +571,7 @@
 @example
 shell$ sbcl
 * (load ".../slime/swank-loader.lisp")
-* (save-lisp-and-die "sbcl.core-with-swank")
+* (swank-loader:dump-image "sbcl.core-with-swank")
 @end example
 
 @noindent
@@ -583,8 +588,8 @@
 @noindent
 Similar setups should also work for other Lisp implementations.
 
- at node slime-mode
- at chapter Using slime-mode
+ at node SLIME mode
+ at chapter Using Slime mode
 
 @SLIME{}'s commands are provided via @code{slime-mode}, a minor-mode
 used in conjunction with Emacs's @code{lisp-mode}. This chapter
@@ -592,7 +597,18 @@
 
 @menu
 * User-interface conventions::  
-* Commands::                    
+* Evaluation::                  
+* Compilation::                 
+* Completion::                  
+* Finding definitions::         
+* Documentation::               
+* Cross-reference::             
+* Macro-expansion::             
+* Disassembly::                 
+* Recovery::                    
+* Inspector::                   
+* Profiling::                   
+* Other::                       
 * Semantic indentation::        
 * Reader conditionals::         
 @end menu
@@ -765,47 +781,128 @@
 @code{slime-insert-balanced-comments} in the REPL buffer.
 
 @c ----------------------- 
- at node Commands
- at section Commands
+ at node Evaluation
+ at section Evaluation commands
 
- at acronym{SLIME} commands are divided into the following general
-categories: @strong{Programming, Compilation, Evaluation, Recovery,
-Inspector, and Profiling}, discussed in separate sections below. There
-are also comprehensive indices to commands by function 
-(@pxref{Command Index}).
+These commands each evaluate a Common Lisp expression in a different
+way.  Usually they mimic commands for evaluating Emacs Lisp code.  By
+default they show their results in the echo area, but a prefix
+argument causes the results to be inserted in the current buffer.
 
- at menu
-* Programming::                 
-* Compilation::                 
-* Evaluation::                  
-* Recovery::                    
-* Inspector::                   
-* Profiling::                   
-* Other::                       
- at end menu
+ at table @kbd
 
- at c ----------------------- 
- at node Programming
- at subsection Programming commands
+ at kbditem{C-x C-e, slime-eval-last-expression}
 
-Programming commands are divided into the following categories:
- at strong{Completion, Documentation, Cross-reference, Finding
-definitions, Macro-expansion, and Disassembly}, discussed in
-separate sections below.
+Evaluate the expression before point and show the result in the echo
+area.
 
- at menu
-* Completion::                  
-* Indentation::                 
-* Documentation::               
-* Cross-reference::             
-* Finding definitions::         
-* Macro-expansion::             
-* Disassembly::                 
- at end menu
+ at kbditem{C-M-x, slime-eval-defun}
+Evaluate the current toplevel form and show the result in the echo
+area.  `C-M-x' treats `defvar' expressions specially.  Normally,
+evaluating a `defvar' expression does nothing if the variable it
+defines already has a value.  But `C-M-x' unconditionally resets the
+variable to the initial value specified in the `defvar' expression.
+This special feature is convenient for debugging Lisp programs.
+
+ at end table
+
+If @kbd{C-M-x} or @kbd{C-x C-e} is given a numeric argument, it
+inserts the value into the current buffer, rather than displaying it
+in the echo area.
+
+ at table @kbd
+ at kbditem{C-c :, slime-interactive-eval}
+Evaluate an expression read from the minibuffer.
+
+ at kbditem{C-c C-r, slime-eval-region}
+Evaluate the region.
+
+ at kbditem{C-c C-p, slime-pprint-eval-last-expression}
+Evaluate the expression before point and pretty-print the result in a
+fresh buffer.
+
+ at kbditem{C-c E, slime-edit-value}
+Edit the value of a setf-able form in a new buffer @file{*Edit <form>*}.
+The value is inserted into a temporary buffer for editing and then set
+in Lisp when committed with @kbd{C-c C-c}.
+
+ at kbditem{C-x M-e, slime-eval-last-expression-display-output}
+Display the output buffer and evaluate the expression preceding point.
+This is useful if the expression writes something to the output stream.
+
+ at kbditem{C-c C-u, slime-undefine-function}
+Undefine the function, with @code{fmakunbound}, for the symbol at
+point.
+
+ at end table
 
 @c ----------------------- 
+ at node Compilation
+ at section Compilation commands
+
+ at cindex Compilation
+
+ at SLIME{} has fancy commands for compiling functions, files, and
+packages. The fancy part is that notes and warnings offered by the
+Lisp compiler are intercepted and annotated directly onto the
+corresponding expressions in the Lisp source buffer. (Give it a try to
+see what this means.)
+
+ at table @kbd
+ at cindex Compiling Functions
+ at kbditem{C-c C-c, slime-compile-defun}
+Compile the top-level form at point.  The region blinks shortly to
+give some feedback which part was choosen.
+
+With (positive) prefix argument the form is compiled with maximal
+debug settings.  With negative prefix argument it is compiled for
+speed.
+
+The code for the region is executed after compilation.  In principle,
+the command writes the region to a file, compiles that file, and loads
+the resulting code.
+
+ at kbditem{C-c C-k, slime-compile-and-load-file}
+Compile and load the current buffer's source file.  If the compilation
+step failes, the file is not loaded.  It's not always easy to tell
+whether the compilation failed: occasionaly you may end up in the
+debugger during the load step.
+
+ at kbditem{C-c M-k, slime-compile-file}
+Compile (but don't load) the current buffer's source file.
+
+ at kbditem{C-c C-l, slime-load-file}
+Load a Lisp file.  This command uses the Common Lisp LOAD function.
+
+ at cmditem{slime-compile-region}
+Compile the selected region.
+
+ at end table
+
+The annotations are indicated as underlining on source forms. The
+compiler message associated with an annotation can be read either by
+placing the mouse over the text or with the selection commands below.
+
+ at table @kbd
+ at kbditem{M-n, slime-next-note}
+Move the point to the next compiler note and displays the note.
+
+ at kbditem{M-p, slime-previous-note}

[856 lines skipped]




From heller at common-lisp.net  Fri Jan  9 07:12:56 2009
From: heller at common-lisp.net (CVS User heller)
Date: Fri, 09 Jan 2009 07:12:56 +0000
Subject: [slime-cvs] CVS slime
Message-ID: <E1LLBY8-0002Py-8M@common-lisp.net>

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

Modified Files:
	ChangeLog swank-allegro.lisp 
Log Message:
* swank-allegro.lisp (swank-compile-string): Don't use the
no-longer-existing directory argument.

--- /project/slime/cvsroot/slime/ChangeLog	2009/01/08 16:20:14	1.1656
+++ /project/slime/cvsroot/slime/ChangeLog	2009/01/09 07:12:55	1.1657
@@ -1,3 +1,8 @@
+2009-01-09  Helmut Eller  <heller at common-lisp.net>
+
+	* swank-allegro.lisp (swank-compile-string): Don't use the
+	no-longer-existing directory argument.
+
 2009-01-08  Helmut Eller  <heller at common-lisp.net>
 
 	* slime.el: Move the tree widget for compiler notes to contrib/.
--- /project/slime/cvsroot/slime/swank-allegro.lisp	2009/01/08 10:33:43	1.121
+++ /project/slime/cvsroot/slime/swank-allegro.lisp	2009/01/09 07:12:56	1.122
@@ -326,14 +326,15 @@
           (*buffer-start-position* position)
           (*buffer-string* string)
           (*default-pathname-defaults*
-           (if directory (merge-pathnames (pathname filename))
+           (if filename 
+               (merge-pathnames (pathname filename))
                *default-pathname-defaults*)))
       (compile-from-temp-file
        (format nil "~S ~S~%~A" 
                `(in-package ,(package-name *package*))
                `(eval-when (:compile-toplevel :load-toplevel)
                   (setq excl::*source-pathname*
-                        ',(or filename (format nil "~A;~D" buffer position))))
+                        ',(format nil "~A;~D" buffer position)))
                string)))))
 
 ;;;; Definition Finding




From trittweiler at common-lisp.net  Sat Jan 10 10:06:59 2009
From: trittweiler at common-lisp.net (CVS User trittweiler)
Date: Sat, 10 Jan 2009 10:06:59 +0000
Subject: [slime-cvs] CVS slime
Message-ID: <E1LLak7-0004Hr-RF@common-lisp.net>

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

Modified Files:
	swank.lisp ChangeLog 
Log Message:

	* swank.lisp (do-symbols*): Wrap body in TAGBODY.


--- /project/slime/cvsroot/slime/swank.lisp	2009/01/08 10:37:51	1.628
+++ /project/slime/cvsroot/slime/swank.lisp	2009/01/10 10:06:59	1.629
@@ -520,7 +520,7 @@
       (do-symbols (,var ,package ,result-form)
         (unless (gethash ,var ,seen-ht)
           (setf (gethash ,var ,seen-ht) t)
-          , at body)))))
+          (tagbody , at body))))))
 
 (defun use-threads-p ()
   (eq (connection.communication-style *emacs-connection*) :spawn))
--- /project/slime/cvsroot/slime/ChangeLog	2009/01/09 07:12:55	1.1657
+++ /project/slime/cvsroot/slime/ChangeLog	2009/01/10 10:06:59	1.1658
@@ -1,3 +1,7 @@
+2009-01-05  Tobias C. Rittweiler  <tcr at freebits.de>
+
+	* swank.lisp (do-symbols*): Wrap body in TAGBODY.
+
 2009-01-09  Helmut Eller  <heller at common-lisp.net>
 
 	* swank-allegro.lisp (swank-compile-string): Don't use the




From trittweiler at common-lisp.net  Sat Jan 10 10:08:17 2009
From: trittweiler at common-lisp.net (CVS User trittweiler)
Date: Sat, 10 Jan 2009 10:08:17 +0000
Subject: [slime-cvs] CVS slime
Message-ID: <E1LLalN-0004Jo-7S@common-lisp.net>

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

Modified Files:
	ChangeLog 
Log Message:

	Fix Changelog's date.


--- /project/slime/cvsroot/slime/ChangeLog	2009/01/10 10:06:59	1.1658
+++ /project/slime/cvsroot/slime/ChangeLog	2009/01/10 10:08:17	1.1659
@@ -1,4 +1,4 @@
-2009-01-05  Tobias C. Rittweiler  <tcr at freebits.de>
+2009-01-10  Tobias C. Rittweiler  <tcr at freebits.de>
 
 	* swank.lisp (do-symbols*): Wrap body in TAGBODY.
 




From trittweiler at common-lisp.net  Sat Jan 10 10:09:47 2009
From: trittweiler at common-lisp.net (CVS User trittweiler)
Date: Sat, 10 Jan 2009 10:09:47 +0000
Subject: [slime-cvs] CVS slime/contrib
Message-ID: <E1LLamp-0004LV-TA@common-lisp.net>

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

Modified Files:
	swank-fancy-inspector.lisp ChangeLog 
Log Message:
	* swank-fancy-inspector.lisp (emacs-inspect [package]): Also
	display link to show all inherited symbols of a package.


--- /project/slime/cvsroot/slime/contrib/swank-fancy-inspector.lisp	2008/04/17 15:21:51	1.15
+++ /project/slime/cvsroot/slime/contrib/swank-fancy-inspector.lisp	2009/01/10 10:09:47	1.16
@@ -438,7 +438,7 @@
 
 (defmethod emacs-inspect ((%container %package-symbols-container))
   (with-struct (%container. title description symbols grouping-kind) %container
-            `(,title (:newline) 
+            `(,title (:newline) (:newline)
 	      , at description
               (:newline)
               "  " ,(ecase grouping-kind
@@ -459,18 +459,23 @@
         (package-use-list     (package-use-list package))
         (package-used-by-list (package-used-by-list package))
         (shadowed-symbols     (package-shadowing-symbols package))
-        (present-symbols      '()) (present-symbols-length  0)
-        (internal-symbols     '()) (internal-symbols-length 0)
-        (external-symbols     '()) (external-symbols-length 0))
+        (present-symbols      '()) (present-symbols-length   0)
+        (internal-symbols     '()) (internal-symbols-length  0)
+        (inherited-symbols    '()) (inherited-symbols-length 0)
+        (external-symbols     '()) (external-symbols-length  0))
 
     (do-symbols* (sym package)
       (let ((status (symbol-status sym package)))
-        (when (not (eq status :inherited))
-          (push sym present-symbols) (incf present-symbols-length)
-          (if (eq status :internal)
-              (progn (push sym internal-symbols) (incf internal-symbols-length))                
-              (progn (push sym external-symbols) (incf external-symbols-length))))))
-    
+        (when (eq status :inherited)
+          (push sym inherited-symbols) (incf inherited-symbols-length)
+          (go :continue))
+        (push sym present-symbols) (incf present-symbols-length)
+        (cond ((eq status :internal)
+               (push sym internal-symbols) (incf internal-symbols-length))
+              (t
+               (push sym external-symbols) (incf external-symbols-length))))
+      :continue)
+
     (setf package-nicknames    (sort (copy-list package-nicknames)    #'string<)
           package-use-list     (sort (copy-list package-use-list)     #'string< :key #'package-name)
           package-used-by-list (sort (copy-list package-used-by-list) #'string< :key #'package-name)
@@ -478,7 +483,8 @@
     
     (setf present-symbols      (sort present-symbols  #'string<)  ; SORT + STRING-LESSP
           internal-symbols     (sort internal-symbols #'string<)  ; conses on at least
-          external-symbols     (sort external-symbols #'string<)) ; SBCL 0.9.18.
+          external-symbols     (sort external-symbols #'string<)  ; SBCL 0.9.18.
+          inherited-symbols    (sort inherited-symbols #'string<))
 
     
      `(""                               ; dummy to preserve indentation.
@@ -540,6 +546,12 @@
                              "entry of `internal' because it's assumed to be more"    (:newline)
                              "useful this way."                                       (:newline)))
             (:newline)
+            ,(display-link "inherited" inherited-symbols  inherited-symbols-length
+                          :title (format nil "All inherited symbols of package \"~A\"" package-name)
+                          :description
+                          '("A symbol is considered inherited in a package if it" (:newline)
+                            "was made accessible via USE-PACKAGE."                (:newline)))
+            (:newline)
             ,(display-link "shadowed" shadowed-symbols (length shadowed-symbols)
                            :title (format nil "All shadowed symbols of package \"~A\"" package-name)
                            :description nil))))))
--- /project/slime/cvsroot/slime/contrib/ChangeLog	2009/01/07 09:21:44	1.164
+++ /project/slime/cvsroot/slime/contrib/ChangeLog	2009/01/10 10:09:47	1.165
@@ -1,3 +1,8 @@
+2009-01-10  Tobias C. Rittweiler  <tcr at freebits.de>
+
+	* swank-fancy-inspector.lisp (emacs-inspect [package]): Also
+	display link to show all inherited symbols of a package.
+
 2009-01-07  Helmut Eller  <heller at common-lisp.net>
 
 	* slime-repl.el (slime-mode-map): Bind C-c~ not ~.




From heller at common-lisp.net  Sat Jan 10 12:17:41 2009
From: heller at common-lisp.net (CVS User heller)
Date: Sat, 10 Jan 2009 12:17:41 +0000
Subject: [slime-cvs] CVS slime
Message-ID: <E1LLcmb-0000i5-Iz@common-lisp.net>

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

Modified Files:
	ChangeLog swank-allegro.lisp swank-backend.lisp 
	swank-lispworks.lisp swank-openmcl.lisp swank.lisp 
Log Message:
* swank-backend.lisp (set-default-initial-binding): New function.
* swank.lisp (setup-stream-indirection):  Use it

--- /project/slime/cvsroot/slime/ChangeLog	2009/01/10 10:08:17	1.1659
+++ /project/slime/cvsroot/slime/ChangeLog	2009/01/10 12:17:41	1.1660
@@ -2,6 +2,11 @@
 
 	* swank.lisp (do-symbols*): Wrap body in TAGBODY.
 
+2009-01-10  Helmut Eller  <heller at common-lisp.net>
+
+	* swank-backend.lisp (set-default-initial-binding): New function.
+	* swank.lisp (setup-stream-indirection):  Use it
+
 2009-01-09  Helmut Eller  <heller at common-lisp.net>
 
 	* swank-allegro.lisp (swank-compile-string): Don't use the
--- /project/slime/cvsroot/slime/swank-allegro.lisp	2009/01/09 07:12:56	1.122
+++ /project/slime/cvsroot/slime/swank-allegro.lisp	2009/01/10 12:17:41	1.123
@@ -693,6 +693,10 @@
      (mp:process-wait-with-timeout "receive-if" 0.5
                                    #'mp:gate-open-p (mailbox.gate mbox)))))
 
+(defimplementation set-default-initial-binding (var form)
+  (setq excl:*cl-default-special-bindings*
+        (acons var form excl:*cl-default-special-bindings*)))
+
 (defimplementation quit-lisp ()
   (excl:exit 0 :quiet t))
 
--- /project/slime/cvsroot/slime/swank-backend.lisp	2009/01/08 10:33:43	1.167
+++ /project/slime/cvsroot/slime/swank-backend.lisp	2009/01/10 12:17:41	1.168
@@ -1036,6 +1036,14 @@
 (definterface receive-if (predicate &optional timeout)
   "Return the first message satisfiying PREDICATE.")
 
+(definterface set-default-initial-binding (var form)
+  "Initialize special variable VAR by default with FORM.
+
+Some implementations initialize certain variables in each newly
+created thread.  This function sets the form which is used to produce
+the initial value."
+  (set var (eval form)))
+
 ;; List of delayed interrupts.  
 ;; This should only have thread-local bindings, so no init form.
 (defvar *pending-slime-interrupts*)
--- /project/slime/cvsroot/slime/swank-lispworks.lisp	2009/01/08 10:33:44	1.126
+++ /project/slime/cvsroot/slime/swank-lispworks.lisp	2009/01/10 12:17:41	1.127
@@ -753,11 +753,7 @@
         (t (funcall continuation))))
 
 (defimplementation spawn (fn &key name)
-  (let ((mp:*process-initial-bindings* 
-         (remove (find-package :cl) 
-                 mp:*process-initial-bindings*
-                 :key (lambda (x) (symbol-package (car x))))))
-    (mp:process-run-function name () fn)))
+  (mp:process-run-function name () fn))
 
 (defvar *id-lock* (mp:make-lock))
 (defvar *thread-id-counter* 0)
@@ -835,6 +831,11 @@
       (setf (mailbox.queue mbox)
             (nconc (mailbox.queue mbox) (list message))))))
 
+(defimplementation set-default-initial-binding (var form)
+  (setq mp:*process-initial-bindings* 
+        (acons var `(eval (quote ,form))
+               mp:*process-initial-bindings* )))
+
 ;;; Some intergration with the lispworks environment
 
 (defun swank-sym (name) (find-symbol (string name) :swank))
--- /project/slime/cvsroot/slime/swank-openmcl.lisp	2009/01/08 10:33:44	1.153
+++ /project/slime/cvsroot/slime/swank-openmcl.lisp	2009/01/10 12:17:41	1.154
@@ -1094,6 +1094,9 @@
      (when (eq timeout t) (return (values nil t)))
      (ccl:timed-wait-on-semaphore (mailbox.semaphore mbox) 1))))
 
+(defimplementation set-default-initial-binding (var form)
+  (eval `(ccl::def-standard-initial-binding ,var ,form)))
+
 (defimplementation quit-lisp ()
   (ccl::quit))
 
--- /project/slime/cvsroot/slime/swank.lisp	2009/01/10 10:06:59	1.629
+++ /project/slime/cvsroot/slime/swank.lisp	2009/01/10 12:17:41	1.630
@@ -1457,7 +1457,9 @@
     (proclaim `(special ,current-stream-var))
     (set current-stream-var stream)
     ;; Assign the real binding as a synonym for the current one.
-    (set stream-var (make-synonym-stream current-stream-var))))
+    (let ((stream (make-synonym-stream current-stream-var)))
+      (set stream-var stream)
+      (set-default-initial-binding stream-var `(quote ,stream)))))
 
 (defun prefixed-var (prefix variable-symbol)
   "(PREFIXED-VAR \"FOO\" '*BAR*) => SWANK::*FOO-BAR*"




From heller at common-lisp.net  Sat Jan 10 12:21:09 2009
From: heller at common-lisp.net (CVS User heller)
Date: Sat, 10 Jan 2009 12:21:09 +0000
Subject: [slime-cvs] CVS slime/doc
Message-ID: <E1LLcpx-0001Iu-VB@common-lisp.net>

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

Modified Files:
	slime.texi 
Log Message:
*** empty log message ***

--- /project/slime/cvsroot/slime/doc/slime.texi	2009/01/08 16:20:14	1.67
+++ /project/slime/cvsroot/slime/doc/slime.texi	2009/01/10 12:21:09	1.68
@@ -12,7 +12,7 @@
 @set EDITION 3.0-alpha
 @set SLIMEVER 3.0-alpha
 @c @set UPDATED @today{}
- at set UPDATED @code{$Date: 2009/01/08 16:20:14 $}
+ at set UPDATED @code{$Date: 2009/01/10 12:21:09 $}
 @set TITLE SLIME User Manual
 @settitle @value{TITLE}, version @value{EDITION}
 
@@ -104,7 +104,7 @@
 @top SLIME
 
 @SLIME{} is the ``Superior Lisp Interaction Mode for Emacs''. This is
-the manual for version @value{SLIMEVER}.
+the manual for version @value{SLIMEVER}. (Last updated @value{UPDATED})
 
 @insertcopying
 @end ifnottex
@@ -667,7 +667,7 @@
 top-level. This direct access to Lisp is useful for troubleshooting,
 and some degree of @SLIME{} integration is available using the
 @code{inferior-slime-mode}. However, in normal use we recommend using
-the fully-integrated @SLIME{} @REPL{} and ignoring the
+the fully-integrated @SLIME{} @REPL{} (@pxref{REPL}) and ignoring the
 @code{*inferior-lisp*} buffer.
 
 @c ----------------------- 




From heller at common-lisp.net  Sat Jan 10 12:25:16 2009
From: heller at common-lisp.net (CVS User heller)
Date: Sat, 10 Jan 2009 12:25:16 +0000
Subject: [slime-cvs] CVS slime
Message-ID: <E1LLctw-0001RO-Ap@common-lisp.net>

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

Modified Files:
	ChangeLog swank-abcl.lisp swank-allegro.lisp 
	swank-backend.lisp swank-clisp.lisp swank-cmucl.lisp 
	swank-corman.lisp swank-ecl.lisp swank-lispworks.lisp 
	swank-openmcl.lisp swank-sbcl.lisp swank-scl.lisp swank.lisp 
Log Message:
* swank-backend.lisp (swank-compile-file): Take output-file as
additional argument.  Update backends accordingly.

* swank.lisp (*fasl-directory*): New variable.
(fasl-pathname): New function.
(compile-file-for-emacs): Use it.

--- /project/slime/cvsroot/slime/ChangeLog	2009/01/10 12:17:41	1.1660
+++ /project/slime/cvsroot/slime/ChangeLog	2009/01/10 12:25:15	1.1661
@@ -4,7 +4,17 @@
 
 2009-01-10  Helmut Eller  <heller at common-lisp.net>
 
+	* swank-backend.lisp (swank-compile-file): Take output-file as
+	additional argument.  Update backends accordingly.
+
+	* swank.lisp (*fasl-directory*): New variable.
+	(fasl-pathname): New function.
+	(compile-file-for-emacs): Use it.
+
+2009-01-10  Helmut Eller  <heller at common-lisp.net>
+
 	* swank-backend.lisp (set-default-initial-binding): New function.
+
 	* swank.lisp (setup-stream-indirection):  Use it
 
 2009-01-09  Helmut Eller  <heller at common-lisp.net>
--- /project/slime/cvsroot/slime/swank-abcl.lisp	2009/01/08 10:33:43	1.62
+++ /project/slime/cvsroot/slime/swank-abcl.lisp	2009/01/10 12:25:16	1.63
@@ -327,14 +327,16 @@
 
 (defvar *abcl-signaled-conditions*)
 
-(defimplementation swank-compile-file (filename load-p external-format)
+(defimplementation swank-compile-file (input-file output-file
+                                       load-p external-format)
   (declare (ignore external-format))
   (let ((jvm::*resignal-compiler-warnings* t)
         (*abcl-signaled-conditions* nil))
     (handler-bind ((warning #'handle-compiler-warning))
       (let ((*buffer-name* nil)
-            (*compile-filename* filename))
-        (multiple-value-bind (fn warn fail) (compile-file filename)
+            (*compile-filename* input-file))
+        (multiple-value-bind (fn warn fail) 
+            (compile-file input-file :output-file output-file)
           (values fn warn
                   (or fail 
                       (and load-p 
--- /project/slime/cvsroot/slime/swank-allegro.lisp	2009/01/10 12:17:41	1.123
+++ /project/slime/cvsroot/slime/swank-allegro.lisp	2009/01/10 12:25:16	1.124
@@ -285,11 +285,14 @@
                  )
     (funcall function)))
 
-(defimplementation swank-compile-file (filename load-p external-format)
+(defimplementation swank-compile-file (input-file output-file 
+                                       load-p external-format)
   (with-compilation-hooks ()
     (let ((*buffer-name* nil)
-          (*compile-filename* filename))
-      (compile-file *compile-filename* :load-after-compile load-p
+          (*compile-filename* input-file))
+      (compile-file *compile-filename* 
+                    :output-file output-file
+                    :load-after-compile load-p
                     :external-format external-format))))
 
 (defun call-with-temp-file (fn)
--- /project/slime/cvsroot/slime/swank-backend.lisp	2009/01/10 12:17:41	1.168
+++ /project/slime/cvsroot/slime/swank-backend.lisp	2009/01/10 12:25:16	1.169
@@ -392,8 +392,9 @@
 Should return T on successfull compilation, NIL otherwise.
 ")
 
-(definterface swank-compile-file (pathname load-p external-format)
-   "Compile PATHNAME signalling COMPILE-CONDITIONs.
+(definterface swank-compile-file (input-file output-file load-p 
+                                             external-format)
+   "Compile INPUT-FILE signalling COMPILE-CONDITIONs.
 If LOAD-P is true, load the file after compilation.
 EXTERNAL-FORMAT is a value returned by find-external-format or
 :default.
--- /project/slime/cvsroot/slime/swank-clisp.lisp	2009/01/08 10:33:43	1.87
+++ /project/slime/cvsroot/slime/swank-clisp.lisp	2009/01/10 12:25:16	1.88
@@ -625,11 +625,14 @@
                           :message (princ-to-string condition)
                           :location (compiler-note-location))))
 
-(defimplementation swank-compile-file (filename load-p external-format)
+(defimplementation swank-compile-file (input-file output-file
+                                       load-p external-format)
   (with-compilation-hooks ()
     (with-compilation-unit ()
       (multiple-value-bind (fasl-file warningsp failurep)
-          (compile-file filename :external-format external-format)
+          (compile-file input-file 
+                        :output-file output-file
+                        :external-format external-format)
         (values fasl-file warningsp
                 (or failurep 
                     (and load-p 
--- /project/slime/cvsroot/slime/swank-cmucl.lisp	2009/01/08 10:33:44	1.209
+++ /project/slime/cvsroot/slime/swank-cmucl.lisp	2009/01/10 12:25:16	1.210
@@ -379,19 +379,21 @@
                    (c::warning        #'handle-notification-condition))
       (funcall function))))
 
-(defimplementation swank-compile-file (filename load-p external-format)
+(defimplementation swank-compile-file (input-file output-file
+                                       load-p external-format)
   (declare (ignore external-format))
-  (clear-xref-info filename)
+  (clear-xref-info input-file)
   (with-compilation-hooks ()
     (let ((*buffer-name* nil)
           (ext:*ignore-extra-close-parentheses* nil))
       (multiple-value-bind (output-file warnings-p failure-p)
-          (compile-file filename)
+          (compile-file input-file :output-file output-file)
         (values output-file warnings-p
                 (or failure-p
                     (when load-p
                       ;; Cache the latest source file for definition-finding.
-                      (source-cache-get filename (file-write-date filename))
+                      (source-cache-get input-file 
+                                        (file-write-date input-file))
                       (not (load output-file)))))))))
 
 (defimplementation swank-compile-string (string &key buffer position filename
--- /project/slime/cvsroot/slime/swank-corman.lisp	2009/01/08 10:33:44	1.22
+++ /project/slime/cvsroot/slime/swank-corman.lisp	2009/01/10 12:25:16	1.23
@@ -361,13 +361,14 @@
                                           (list :error "No location"))))))))
     (funcall fn)))
 
-(defimplementation swank-compile-file (*compile-filename* load-p
-				       external-format)
+(defimplementation swank-compile-file (input-file output-file 
+				       load-p external-format)
   (declare (ignore external-format))
   (with-compilation-hooks ()
-    (let ((*buffer-name* nil))
+    (let ((*buffer-name* nil)
+	  (*compile-filename* input-file))
       (multiple-value-bind (output-file warnings? failure?)
-	  (compile-file *compile-filename*)
+	  (compile-file input-file :output-file output-file)
 	(values output-file warnings?
 		(or failure? (and load-p (load output-file))))))))
 
--- /project/slime/cvsroot/slime/swank-ecl.lisp	2009/01/08 10:33:44	1.37
+++ /project/slime/cvsroot/slime/swank-ecl.lisp	2009/01/10 12:25:16	1.38
@@ -138,12 +138,13 @@
   (handler-bind ((warning #'handle-compiler-warning))
     (funcall function)))
 
-(defimplementation swank-compile-file (*compile-filename* load-p
-                                       external-format)
+(defimplementation swank-compile-file (input-file output-file
+                                       load-p external-format)
   (declare (ignore external-format))
   (with-compilation-hooks ()
-    (let ((*buffer-name* nil))
-      (compile-file *compile-filename* :load t))))
+    (let ((*buffer-name* nil)
+          (*compile-filename* input-file))
+      (compile-file input-file :output-file output-file :load t))))
 
 (defimplementation swank-compile-string (string &key buffer position filename
                                          policy)
--- /project/slime/cvsroot/slime/swank-lispworks.lisp	2009/01/10 12:17:41	1.127
+++ /project/slime/cvsroot/slime/swank-lispworks.lisp	2009/01/10 12:25:16	1.128
@@ -426,9 +426,12 @@
            (signal-undefined-functions compiler::*unknown-functions* 
                                        ,location))))))
 
-(defimplementation swank-compile-file (filename load-p external-format)
-  (with-swank-compilation-unit (filename)
-    (compile-file filename :load load-p 
+(defimplementation swank-compile-file (input-file output-file
+                                       load-p external-format)
+  (with-swank-compilation-unit (input-file)
+    (compile-file input-file 
+                  :output-file output-file
+                  :load load-p 
                   :external-format external-format)))
 
 (defvar *within-call-with-compilation-hooks* nil
--- /project/slime/cvsroot/slime/swank-openmcl.lisp	2009/01/10 12:17:41	1.154
+++ /project/slime/cvsroot/slime/swank-openmcl.lisp	2009/01/10 12:25:16	1.155
@@ -261,12 +261,15 @@
   (handler-bind ((ccl::compiler-warning 'handle-compiler-warning))
     (funcall function)))
 
-(defimplementation swank-compile-file (filename load-p external-format)
+(defimplementation swank-compile-file (input-file output-file
+                                       load-p external-format)
   (declare (ignore external-format))
   (with-compilation-hooks ()
     (let ((*buffer-name* nil)
           (*buffer-offset* nil))
-      (compile-file filename :load load-p))))
+      (compile-file input-file 
+                    :output-file output-file
+                    :load load-p))))
 
 (defimplementation frame-var-value (frame var)
   (block frame-var-value
--- /project/slime/cvsroot/slime/swank-sbcl.lisp	2009/01/08 10:33:44	1.231
+++ /project/slime/cvsroot/slime/swank-sbcl.lisp	2009/01/10 12:25:16	1.232
@@ -485,16 +485,19 @@
 
 (defvar *trap-load-time-warnings* nil)
 
-(defimplementation swank-compile-file (pathname load-p external-format)
+(defimplementation swank-compile-file (input-file output-file 
+                                       load-p external-format)
   (handler-case
       (multiple-value-bind (output-file warnings-p failure-p)
           (with-compilation-hooks ()
-            (compile-file pathname :external-format external-format))
+            (compile-file input-file :output-file output-file
+                          :external-format external-format))
         (values output-file warnings-p
                 (or failure-p
                     (when load-p
                       ;; Cache the latest source file for definition-finding.
-                      (source-cache-get pathname (file-write-date pathname))
+                      (source-cache-get input-file 
+                                        (file-write-date input-file))
                       (not (load output-file))))))
     (sb-c:fatal-compiler-error () nil)))
 
--- /project/slime/cvsroot/slime/swank-scl.lisp	2009/01/08 10:33:44	1.31
+++ /project/slime/cvsroot/slime/swank-scl.lisp	2009/01/10 12:25:16	1.32
@@ -438,17 +438,21 @@
                    (c::warning        #'handle-notification-condition))
       (funcall function))))
 
-(defimplementation swank-compile-file (filename load-p external-format)
+(defimplementation swank-compile-file (input-file output-file 
+                                       load-p external-format)
   (with-compilation-hooks ()
     (let ((*buffer-name* nil)
           (ext:*ignore-extra-close-parentheses* nil))
       (multiple-value-bind (output-file warnings-p failure-p)
-          (compile-file filename :external-format external-format)
+          (compile-file input-file 
+                        :output-file output-file
+                        :external-format external-format)
         (values output-file warnings-p
                 (or failure-p
                     (when load-p
                       ;; Cache the latest source file for definition-finding.
-                      (source-cache-get filename (file-write-date filename))
+                      (source-cache-get input-file 
+                                        (file-write-date input-file))
                       (not (load output-file)))))))))
 
 (defimplementation swank-compile-string (string &key buffer position filename
--- /project/slime/cvsroot/slime/swank.lisp	2009/01/10 12:17:41	1.630
+++ /project/slime/cvsroot/slime/swank.lisp	2009/01/10 12:25:16	1.631
@@ -29,6 +29,7 @@
            ;; These are user-configurable variables:
            #:*communication-style*
            #:*dont-close*
+           #:*fasl-directory*
            #:*log-events*
            #:*log-output*
            #:*use-dedicated-output-stream*
@@ -2724,7 +2725,7 @@
       (check-type successp boolean)
       (make-compilation-result (reverse notes) successp seconds))))
 
-(defslimefun compile-file-for-emacs (filename load-p)
+(defslimefun compile-file-for-emacs (filename load-p &optional options)
   "Compile FILENAME and, when LOAD-P, load the result.
 Record compiler notes signalled as `compiler-condition's."
   (with-buffer-syntax ()
@@ -2733,12 +2734,32 @@
        (let ((pathname (filename-to-pathname filename))
              (*compile-print* nil) (*compile-verbose* t))
          (multiple-value-bind (output-pathname warnings? failure?)
-             (swank-compile-file pathname load-p
+             (swank-compile-file pathname
+                                 (fasl-pathname pathname options)
+                                 load-p
                                  (or (guess-external-format pathname)
                                      :default))
            (declare (ignore output-pathname warnings?))
            (not failure?)))))))
 
+(defvar *fasl-directory* nil
+  "Directory where swank should place fasl files.")
+
+(defun fasl-pathname (input-file options)
+  (cond ((getf options :fasl-directory)
+         (let* ((str (getf options :fasl-directory))
+                (dir (filename-to-pathname str)))
+           (assert (char= (aref str (1- (length str))) #\/))
+           (compile-file-pathname input-file :output-file dir)))
+        (*fasl-directory*
+         (compile-file-pathname input-file :output-file *fasl-directory*))
+        (t
+         (compile-file-pathname input-file))))
+
+(pathname-to-filename
+ (compile-file-pathname "y.lisp" 
+                        :output-file (filename-to-pathname "/tmp/x/")))
+
 (defslimefun compile-string-for-emacs (string buffer position filename policy)
   "Compile STRING (exerpted from BUFFER at POSITION).
 Record compiler notes signalled as `compiler-condition's."




From heller at common-lisp.net  Sat Jan 10 12:25:30 2009
From: heller at common-lisp.net (CVS User heller)
Date: Sat, 10 Jan 2009 12:25:30 +0000
Subject: [slime-cvs] CVS slime
Message-ID: <E1LLcuA-0001T8-JE@common-lisp.net>

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

Modified Files:
	ChangeLog slime.el 
Log Message:
* slime.el (slime-space): Declare `slime-space' to
`delete-selection-mode' and friends (CUA) so that their behavior
is the same as with normal insertion of a space.

--- /project/slime/cvsroot/slime/ChangeLog	2009/01/10 12:25:15	1.1661
+++ /project/slime/cvsroot/slime/ChangeLog	2009/01/10 12:25:30	1.1662
@@ -2,6 +2,12 @@
 
 	* swank.lisp (do-symbols*): Wrap body in TAGBODY.
 
+2009-01-10  David Reitter <david.reitter at gmail.com>
+
+	* slime.el (slime-space): Declare `slime-space' to
+	`delete-selection-mode' and friends (CUA) so that their behavior
+	is the same as with normal insertion of a space.
+
 2009-01-10  Helmut Eller  <heller at common-lisp.net>
 
 	* swank-backend.lisp (swank-compile-file): Take output-file as
--- /project/slime/cvsroot/slime/slime.el	2009/01/08 16:13:33	1.1114
+++ /project/slime/cvsroot/slime/slime.el	2009/01/10 12:25:30	1.1115
@@ -3493,6 +3493,8 @@
   (when (slime-background-activities-enabled-p)
     (slime-echo-arglist)))
 
+(put 'slime-space 'delete-selection t) ; for delete-section-mode & CUA
+
 (defvar slime-echo-arglist-function 'slime-show-arglist)
 
 (defun slime-echo-arglist ()




From heller at common-lisp.net  Sat Jan 10 12:25:41 2009
From: heller at common-lisp.net (CVS User heller)
Date: Sat, 10 Jan 2009 12:25:41 +0000
Subject: [slime-cvs] CVS slime
Message-ID: <E1LLcuL-0001Tx-N5@common-lisp.net>

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

Modified Files:
	ChangeLog slime.el 
Log Message:
* slime.el (slime-compile-file-options): New variable.
(slime-compile-file): Use it.

--- /project/slime/cvsroot/slime/ChangeLog	2009/01/10 12:25:30	1.1662
+++ /project/slime/cvsroot/slime/ChangeLog	2009/01/10 12:25:41	1.1663
@@ -2,6 +2,11 @@
 
 	* swank.lisp (do-symbols*): Wrap body in TAGBODY.
 
+2009-01-10  Helmut Eller  <heller at common-lisp.net>
+
+	* slime.el (slime-compile-file-options): New variable.
+	(slime-compile-file): Use it.
+
 2009-01-10  David Reitter <david.reitter at gmail.com>
 
 	* slime.el (slime-space): Declare `slime-space' to
--- /project/slime/cvsroot/slime/slime.el	2009/01/10 12:25:30	1.1115
+++ /project/slime/cvsroot/slime/slime.el	2009/01/10 12:25:41	1.1116
@@ -2632,6 +2632,10 @@
   (interactive)
   (slime-compile-file t))
 
+(defvar slime-compile-file-options '()
+  "Plist of additional options that C-c C-k should pass to Lisp.
+Currently only :fasl-directory is supported.")
+
 (defun slime-compile-file (&optional load)
   "Compile current buffer's file and highlight resulting compiler notes.
 
@@ -2648,7 +2652,8 @@
   (run-hook-with-args 'slime-before-compile-functions (point-min) (point-max))
   (let ((file (slime-to-lisp-filename (buffer-file-name))))
     (slime-eval-async
-     `(swank:compile-file-for-emacs ,file ,(if load t nil))
+     `(swank:compile-file-for-emacs ,file ,(if load t nil) 
+                                    ',slime-compile-file-options)
      #'slime-compilation-finished)
     (message "Compiling %s..." file)))
 




From heller at common-lisp.net  Sat Jan 10 12:25:46 2009
From: heller at common-lisp.net (CVS User heller)
Date: Sat, 10 Jan 2009 12:25:46 +0000
Subject: [slime-cvs] CVS slime
Message-ID: <E1LLcuQ-0001Uh-Il@common-lisp.net>

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

Modified Files:
	swank.lisp 
Log Message:
*** empty log message ***

--- /project/slime/cvsroot/slime/swank.lisp	2009/01/10 12:25:16	1.631
+++ /project/slime/cvsroot/slime/swank.lisp	2009/01/10 12:25:46	1.632
@@ -2756,10 +2756,6 @@
         (t
          (compile-file-pathname input-file))))
 
-(pathname-to-filename
- (compile-file-pathname "y.lisp" 
-                        :output-file (filename-to-pathname "/tmp/x/")))
-
 (defslimefun compile-string-for-emacs (string buffer position filename policy)
   "Compile STRING (exerpted from BUFFER at POSITION).
 Record compiler notes signalled as `compiler-condition's."




From heller at common-lisp.net  Sat Jan 10 12:40:13 2009
From: heller at common-lisp.net (CVS User heller)
Date: Sat, 10 Jan 2009 12:40:13 +0000
Subject: [slime-cvs] CVS slime
Message-ID: <E1LLd8P-0001vq-Vt@common-lisp.net>

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

Modified Files:
	ChangeLog swank-openmcl.lisp 
Log Message:
* swank-openmcl.lisp (install-debugger-globally): Set *break-in-sldb*.

--- /project/slime/cvsroot/slime/ChangeLog	2009/01/10 12:25:41	1.1663
+++ /project/slime/cvsroot/slime/ChangeLog	2009/01/10 12:40:13	1.1664
@@ -1,3 +1,7 @@
+2009-01-10  Helmut Eller  <heller at common-lisp.net>
+
+	* swank-openmcl.lisp (install-debugger-globally): Set *break-in-sldb*.
+
 2009-01-10  Tobias C. Rittweiler  <tcr at freebits.de>
 
 	* swank.lisp (do-symbols*): Wrap body in TAGBODY.
--- /project/slime/cvsroot/slime/swank-openmcl.lisp	2009/01/10 12:25:16	1.155
+++ /project/slime/cvsroot/slime/swank-openmcl.lisp	2009/01/10 12:40:13	1.156
@@ -460,6 +460,10 @@
         (*break-in-sldb* t))
     (funcall fun)))
 
+(defimplementation install-debugger-globally (function)
+  (setq *debugger-hook* function)
+  (setq *break-in-sldb* t))
+
 (defun backtrace-context ()
   nil)
 




From msimmons at common-lisp.net  Thu Jan 15 17:07:22 2009
From: msimmons at common-lisp.net (CVS User msimmons)
Date: Thu, 15 Jan 2009 17:07:22 +0000
Subject: [slime-cvs] CVS slime
Message-ID: <E1LNVgg-000720-2j@common-lisp.net>

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

Modified Files:
	ChangeLog swank-lispworks.lisp 
Log Message:
swank-lispworks.lisp: wrapper functions for swank-mop
slot-boundp-using-class, slot-value-using-class and
slot-makunbound-using-class to account for MOP differences.



--- /project/slime/cvsroot/slime/ChangeLog	2009/01/10 12:40:13	1.1664
+++ /project/slime/cvsroot/slime/ChangeLog	2009/01/15 17:07:21	1.1665
@@ -1,3 +1,9 @@
+2009-01-15  Martin Simmons  <martin at lispworks.com>
+
+	* swank-lispworks.lisp: wrapper functions for swank-mop
+ 	slot-boundp-using-class, slot-value-using-class and
+ 	slot-makunbound-using-class to account for MOP differences.
+	
 2009-01-10  Helmut Eller  <heller at common-lisp.net>
 
 	* swank-openmcl.lisp (install-debugger-globally): Set *break-in-sldb*.
--- /project/slime/cvsroot/slime/swank-lispworks.lisp	2009/01/10 12:25:16	1.128
+++ /project/slime/cvsroot/slime/swank-lispworks.lisp	2009/01/15 17:07:21	1.129
@@ -15,6 +15,9 @@
   (import-from :stream *gray-stream-symbols* :swank-backend))
 
 (import-swank-mop-symbols :clos '(:slot-definition-documentation
+                                  :slot-boundp-using-class
+                                  :slot-value-using-class
+                                  :slot-makunbound-using-class
                                   :eql-specializer
                                   :eql-specializer-object
                                   :compute-applicable-methods-using-classes))
@@ -22,6 +25,23 @@
 (defun swank-mop:slot-definition-documentation (slot)
   (documentation slot t))
 
+(defun swank-mop:slot-boundp-using-class (class object slotd)
+  (clos:slot-boundp-using-class class object
+                                (clos:slot-definition-name slotd)))
+
+(defun swank-mop:slot-value-using-class (class object slotd)
+  (clos:slot-value-using-class class object
+                               (clos:slot-definition-name slotd)))
+
+(defun (setf swank-mop:slot-value-using-class) (value class object slotd)
+  (setf (clos:slot-value-using-class class object
+                                     (clos:slot-definition-name slotd))
+        value))
+
+(defun swank-mop:slot-makunbound-using-class (class object slotd)
+  (clos:slot-makunbound-using-class class object
+                                    (clos:slot-definition-name slotd)))
+
 (defun swank-mop:compute-applicable-methods-using-classes (gf classes)
   (clos::compute-applicable-methods-from-classes gf classes))
 




From heller at common-lisp.net  Fri Jan 16 15:48:54 2009
From: heller at common-lisp.net (CVS User heller)
Date: Fri, 16 Jan 2009 15:48:54 +0000
Subject: [slime-cvs] CVS slime/contrib
Message-ID: <E1LNqwI-0000Zo-Ud@common-lisp.net>

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

Modified Files:
	ChangeLog slime-repl.el 
Log Message:
* slime-repl.el (slime-repl-clear-buffer): Call recenter with t as
argument (to avoid erasing the entire frame).

--- /project/slime/cvsroot/slime/contrib/ChangeLog	2009/01/10 10:09:47	1.165
+++ /project/slime/cvsroot/slime/contrib/ChangeLog	2009/01/16 15:48:53	1.166
@@ -1,3 +1,8 @@
+2009-01-16   David Reitter <david.reitter at gmail.com>
+
+	* slime-repl.el (slime-repl-clear-buffer): Call recenter with t as
+	argument (to avoid erasing the entire frame).
+
 2009-01-10  Tobias C. Rittweiler  <tcr at freebits.de>
 
 	* swank-fancy-inspector.lisp (emacs-inspect [package]): Also
--- /project/slime/cvsroot/slime/contrib/slime-repl.el	2009/01/07 09:21:44	1.11
+++ /project/slime/cvsroot/slime/contrib/slime-repl.el	2009/01/16 15:48:53	1.12
@@ -813,7 +813,7 @@
     (delete-region (point-min) slime-repl-prompt-start-mark)
     (delete-region slime-output-start slime-output-end)
     (goto-char slime-repl-input-start-mark)
-    (recenter))
+    (recenter t))
   (run-hooks 'slime-repl-clear-buffer-hook))
 
 (defun slime-repl-clear-output ()




From heller at common-lisp.net  Fri Jan 16 15:49:25 2009
From: heller at common-lisp.net (CVS User heller)
Date: Fri, 16 Jan 2009 15:49:25 +0000
Subject: [slime-cvs] CVS slime
Message-ID: <E1LNqwn-0000ag-PS@common-lisp.net>

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

Modified Files:
	ChangeLog swank-backend.lisp 
Log Message:
* swank-backend.lisp (warn-unimplemented-interfaces): Print the
names with pprint-fill.

--- /project/slime/cvsroot/slime/ChangeLog	2009/01/15 17:07:21	1.1665
+++ /project/slime/cvsroot/slime/ChangeLog	2009/01/16 15:49:25	1.1666
@@ -4,6 +4,11 @@
  	slot-boundp-using-class, slot-value-using-class and
  	slot-makunbound-using-class to account for MOP differences.
 	
+2009-01-16  Helmut Eller  <heller at common-lisp.net>
+
+	* swank-backend.lisp (warn-unimplemented-interfaces): Print the
+	names with pprint-fill.
+
 2009-01-10  Helmut Eller  <heller at common-lisp.net>
 
 	* swank-openmcl.lisp (install-debugger-globally): Set *break-in-sldb*.
--- /project/slime/cvsroot/slime/swank-backend.lisp	2009/01/10 12:25:16	1.169
+++ /project/slime/cvsroot/slime/swank-backend.lisp	2009/01/16 15:49:25	1.170
@@ -173,8 +173,8 @@
 (defun warn-unimplemented-interfaces ()
   "Warn the user about unimplemented backend features.
 The portable code calls this function at startup."
-  (warn "These Swank interfaces are unimplemented:~% ~A"
-        (sort (copy-list *unimplemented-interfaces*) #'string<)))
+  (warn "These Swank interfaces are unimplemented:~% ~:<~{~A~^ ~:_~}~:>"
+        (list (sort (copy-list *unimplemented-interfaces*) #'string<))))
 
 (defun import-to-swank-mop (symbol-list)
   (dolist (sym symbol-list)




From heller at common-lisp.net  Fri Jan 16 15:49:40 2009
From: heller at common-lisp.net (CVS User heller)
Date: Fri, 16 Jan 2009 15:49:40 +0000
Subject: [slime-cvs] CVS slime
Message-ID: <E1LNqx2-0000bM-34@common-lisp.net>

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

Modified Files:
	ChangeLog swank-openmcl.lisp 
Log Message:
* swank-openmcl.lisp (break-in-sldb): Display the argument.

--- /project/slime/cvsroot/slime/ChangeLog	2009/01/16 15:49:25	1.1666
+++ /project/slime/cvsroot/slime/ChangeLog	2009/01/16 15:49:39	1.1667
@@ -6,6 +6,10 @@
 	
 2009-01-16  Helmut Eller  <heller at common-lisp.net>
 
+	* swank-openmcl.lisp (break-in-sldb): Display the argument.
+
+2009-01-16  Helmut Eller  <heller at common-lisp.net>
+
 	* swank-backend.lisp (warn-unimplemented-interfaces): Print the
 	names with pprint-fill.
 
--- /project/slime/cvsroot/slime/swank-openmcl.lisp	2009/01/10 12:40:13	1.156
+++ /project/slime/cvsroot/slime/swank-openmcl.lisp	2009/01/16 15:49:40	1.157
@@ -846,10 +846,10 @@
    :when :around
    :name sldb-break))
 
-(defun break-in-sldb (&optional string &rest args)
+(defun break-in-sldb (x y &rest args)
   (let ((*sldb-stack-top-hint* (or *sldb-stack-top-hint*
                                    (ccl::%get-frame-ptr))))
-    (apply #'cerror "Continue from break" (or string "Break") args)))
+    (apply #'cerror y (if args "Break: ~a" x) args)))
 
 ;;; Utilities
 




From heller at common-lisp.net  Fri Jan 16 15:49:48 2009
From: heller at common-lisp.net (CVS User heller)
Date: Fri, 16 Jan 2009 15:49:48 +0000
Subject: [slime-cvs] CVS slime
Message-ID: <E1LNqxA-0000bw-Pg@common-lisp.net>

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

Modified Files:
	ChangeLog swank.lisp 
Log Message:
* swank.lisp (pprint-eval): Also return the output produced during
evaluation.

--- /project/slime/cvsroot/slime/ChangeLog	2009/01/16 15:49:39	1.1667
+++ /project/slime/cvsroot/slime/ChangeLog	2009/01/16 15:49:48	1.1668
@@ -6,6 +6,11 @@
 	
 2009-01-16  Helmut Eller  <heller at common-lisp.net>
 
+	* swank.lisp (pprint-eval): Also return the output produced during
+	evaluation.
+
+2009-01-16  Helmut Eller  <heller at common-lisp.net>
+
 	* swank-openmcl.lisp (break-in-sldb): Display the argument.
 
 2009-01-16  Helmut Eller  <heller at common-lisp.net>
--- /project/slime/cvsroot/slime/swank.lisp	2009/01/10 12:25:46	1.632
+++ /project/slime/cvsroot/slime/swank.lisp	2009/01/16 15:49:48	1.633
@@ -2191,8 +2191,13 @@
   
 (defslimefun pprint-eval (string)
   (with-buffer-syntax ()
-    (with-retry-restart (:msg "Retry SLIME evaluation request.")
-      (swank-pprint (multiple-value-list (eval (read-from-string string)))))))
+    (let* ((s (make-string-output-stream))
+           (values 
+            (let ((*standard-output* s)
+                  (*trace-output* s))
+              (multiple-value-list (eval (read-from-string string))))))
+      (cat (get-output-stream-string s)
+           (swank-pprint values)))))
 
 (defslimefun set-package (name)
   "Set *package* to the package named NAME.




From heller at common-lisp.net  Fri Jan 16 15:50:03 2009
From: heller at common-lisp.net (CVS User heller)
Date: Fri, 16 Jan 2009 15:50:03 +0000
Subject: [slime-cvs] CVS slime
Message-ID: <E1LNqxP-0000ca-A6@common-lisp.net>

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

Modified Files:
	ChangeLog slime.el 
Log Message:
* slime.el (slime-keys): Put C-c C-i and M-* back.

--- /project/slime/cvsroot/slime/ChangeLog	2009/01/16 15:49:48	1.1668
+++ /project/slime/cvsroot/slime/ChangeLog	2009/01/16 15:50:03	1.1669
@@ -6,6 +6,10 @@
 	
 2009-01-16  Helmut Eller  <heller at common-lisp.net>
 
+	* slime.el (slime-keys): Put C-c C-i and M-* back.
+
+2009-01-16  Helmut Eller  <heller at common-lisp.net>
+
 	* swank.lisp (pprint-eval): Also return the output produced during
 	evaluation.
 
--- /project/slime/cvsroot/slime/slime.el	2009/01/10 12:25:41	1.1116
+++ /project/slime/cvsroot/slime/slime.el	2009/01/16 15:50:03	1.1117
@@ -546,7 +546,9 @@
     ;; ;; Shadow unwanted bindings from inf-lisp
     ;; ("\C-a"    slime-nop :prefixed t :inferior t :sldb t)
     ;; ("\C-v"    slime-nop :prefixed t :inferior t :sldb t)
-    ))
+    ;; Obsolete, redundant bindings
+    ("\C-c\C-i" slime-complete-symbol)
+    ("\M-*" slime-edit-definition)))
 
 (defun slime-nop ()
   "The null command. Used to shadow currently-unused keybindings."




From trittweiler at common-lisp.net  Sat Jan 17 20:27:28 2009
From: trittweiler at common-lisp.net (CVS User trittweiler)
Date: Sat, 17 Jan 2009 20:27:28 +0000
Subject: [slime-cvs] CVS slime
Message-ID: <E1LOHlQ-0007EZ-FT@common-lisp.net>

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

Modified Files:
	slime.el ChangeLog 
Log Message:
	Fix C-u C-c C-c in SLDB.

	* slime.el (sldb-recompile-frame-source): Bind
	`slime-compilation-policy' at the right place.


--- /project/slime/cvsroot/slime/slime.el	2009/01/16 15:50:03	1.1117
+++ /project/slime/cvsroot/slime/slime.el	2009/01/17 20:27:28	1.1118
@@ -5943,14 +5943,15 @@
   (interactive "P")
   (slime-eval-async
    `(swank:frame-source-location-for-emacs ,(sldb-frame-number-at-point))
-   (let ((slime-compilation-policy (slime-compute-policy raw-prefix-arg)))
+   (lexical-let ((policy (slime-compute-policy raw-prefix-arg)))
      (lambda (source-location)
        (destructure-case source-location
          ((:error message)
           (message "%s" message)
           (ding))
          (t
-          (slime-recompile-location source-location)))))))
+          (let ((slime-compilation-policy policy))
+            (slime-recompile-location source-location))))))))
 
 
 ;;;; Thread control panel
--- /project/slime/cvsroot/slime/ChangeLog	2009/01/16 15:50:03	1.1669
+++ /project/slime/cvsroot/slime/ChangeLog	2009/01/17 20:27:28	1.1670
@@ -1,9 +1,16 @@
+2009-01-17  Tobias C. Rittweiler  <tcr at freebits.de>
+
+	Fix C-u C-c C-c in SLDB.
+
+	* slime.el (sldb-recompile-frame-source): Bind
+	`slime-compilation-policy' at the right place.
+
 2009-01-15  Martin Simmons  <martin at lispworks.com>
 
 	* swank-lispworks.lisp: wrapper functions for swank-mop
  	slot-boundp-using-class, slot-value-using-class and
  	slot-makunbound-using-class to account for MOP differences.
-	
+
 2009-01-16  Helmut Eller  <heller at common-lisp.net>
 
 	* slime.el (slime-keys): Put C-c C-i and M-* back.




From trittweiler at common-lisp.net  Sun Jan 18 14:18:53 2009
From: trittweiler at common-lisp.net (CVS User trittweiler)
Date: Sun, 18 Jan 2009 14:18:53 +0000
Subject: [slime-cvs] CVS slime/contrib
Message-ID: <E1LOYUH-0008SH-GI@common-lisp.net>

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

Modified Files:
	slime-enclosing-context.el ChangeLog 
Log Message:
	Local M-. and local arglist display didn't work for

	   (flet ((foo () ...))
	     (some-form)
	     |)

	* slime-enclosing-context.el (slime-enclosing-bound-names),
	(slime-enclosing-bound-functions): Correctly test for when point
	is in scope of an FLET/LET/etc.
	([test] enclosing-context.1): Test for this.


--- /project/slime/cvsroot/slime/contrib/slime-enclosing-context.el	2008/09/13 10:39:02	1.2
+++ /project/slime/cvsroot/slime/contrib/slime-enclosing-context.el	2009/01/18 14:18:53	1.3
@@ -47,7 +47,7 @@
 	    for point in points
 	    do (when (and (slime-binding-op-p op) 
 			  ;; Are the bindings of OP in scope?
-			  (= index (slime-binding-op-body-pos op)))
+			  (>= index (slime-binding-op-body-pos op)))
 		 (goto-char point) 
 		 (forward-sexp (slime-binding-op-bindings-pos op))
 		 (down-list)
@@ -72,12 +72,14 @@
 	    for point in points
 	    do (when (and (slime-binding-op-p op :function) 
 			  ;; Are the bindings of OP in scope?
-			  (= index (slime-binding-op-body-pos op)))
+			  (>= index (slime-binding-op-body-pos op)))
 		 (goto-char point)
 		 (forward-sexp (slime-binding-op-bindings-pos op))
 		 (down-list)
-		 (ignore-errors
-		   (loop 
+                 ;; If we're at the end of the bindings, an error will
+                 ;; be signalled by the `down-list' below.
+		 (ignore-errors 
+		   (loop
 		    (down-list) 
 		    (destructuring-bind (name arglist)
 			(slime-ensure-list (slime-parse-sexp-at-point 2))
@@ -100,7 +102,12 @@
 	       (,foo 42))
 	   *HERE*))" 
        (",nil" "bar" ",foo")
-       ((",nil" "()"))))
+       ((",nil" "()")))
+      ("(flet ((foo ()))
+         (quux)
+         (bar *HERE*))"
+       ("foo")
+       (("foo" "()"))))
   (slime-check-top-level)
   (with-temp-buffer
     (let ((tmpbuf (current-buffer)))
--- /project/slime/cvsroot/slime/contrib/ChangeLog	2009/01/16 15:48:53	1.166
+++ /project/slime/cvsroot/slime/contrib/ChangeLog	2009/01/18 14:18:53	1.167
@@ -1,3 +1,16 @@
+2009-01-18  Tobias C. Rittweiler  <tcr at freebits.de>
+
+	Local M-. and local arglist display didn't work for
+
+	   (flet ((foo () ...))
+	     (some-form)
+	     |)
+
+	* slime-enclosing-context.el (slime-enclosing-bound-names),
+	(slime-enclosing-bound-functions): Correctly test for when point
+	is in scope of an FLET/LET/etc.
+	([test] enclosing-context.1): Test for this.
+
 2009-01-16   David Reitter <david.reitter at gmail.com>
 
 	* slime-repl.el (slime-repl-clear-buffer): Call recenter with t as




From trittweiler at common-lisp.net  Fri Jan 23 10:05:03 2009
From: trittweiler at common-lisp.net (CVS User trittweiler)
Date: Fri, 23 Jan 2009 10:05:03 +0000
Subject: [slime-cvs] CVS slime
Message-ID: <E1LQIuN-0001fj-BW@common-lisp.net>

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

Modified Files:
	slime.el ChangeLog 
Log Message:

	* slime.el (slime-editing-keys): New variable; splitted from
	`slime-keys'. Contains key bindings that are useful for buffers
	where users can edit s-exprs, such as source buffers and the REPL.
	(slime-keys): Use it.


--- /project/slime/cvsroot/slime/slime.el	2009/01/17 20:27:28	1.1118
+++ /project/slime/cvsroot/slime/slime.el	2009/01/23 10:05:03	1.1119
@@ -491,7 +491,7 @@
 ;;;;; Key bindings
 
 (defvar slime-parent-map (make-sparse-keymap)
-  "Parent keymap for various Slime related modes.")
+  "Parent keymap for shared between all Slime related modes.")
 
 (defvar slime-parent-bindings
   '(("\M-."      slime-edit-definition)
@@ -500,6 +500,7 @@
     ("\C-x5." 	 slime-edit-definition-other-frame)
     ("\C-x\C-e"  slime-eval-last-expression)
     ("\C-\M-x"   slime-eval-defun)
+    ;; Include PREFIX keys...
     ("\C-c"	 slime-prefix-map)))
 
 (defvar slime-prefix-map (make-sparse-keymap)
@@ -519,36 +520,42 @@
     ("\C-xc" slime-list-connections)
     ("<"     slime-list-callers)
     (">"     slime-list-callees)
+    ;; Include DOC keys...
     ("\C-d"  slime-doc-map)
+    ;; Include XREF WHO-FOO keys...
     ("\C-w"  slime-who-map)
-    ;;("\C-z" slime-switch-to-output-buffer :prefixed t :sldb t)
     ))
 
-(defvar slime-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)
-    ;; Editing
+;;; 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)
     (" "          slime-space)
     ;; Evaluating
     ;;("\C-x\M-e" slime-eval-last-expression-display-output :inferior t)
     ("\C-c\C-p"   slime-pprint-eval-last-expression)
-    ;; Misc
-    ("\C-c\C-u"   slime-undefine-function)
+    ;; Macroexpand
     ("\C-c\C-m"   slime-macroexpand-1)
     ("\C-c\M-m"   slime-macroexpand-all)
+    ;; Misc
+    ("\C-c\C-u"   slime-undefine-function)
     ([?\C-\M-.]   slime-next-location)
-    ;; ;; Shadow unwanted bindings from inf-lisp
-    ;; ("\C-a"    slime-nop :prefixed t :inferior t :sldb t)
-    ;; ("\C-v"    slime-nop :prefixed t :inferior t :sldb t)
     ;; Obsolete, redundant bindings
     ("\C-c\C-i" slime-complete-symbol)
-    ("\M-*" slime-edit-definition)))
+    ("\M-*" slime-edit-definition)
+    ))
+
+(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)
+            )))
 
 (defun slime-nop ()
   "The null command. Used to shadow currently-unused keybindings."
--- /project/slime/cvsroot/slime/ChangeLog	2009/01/17 20:27:28	1.1670
+++ /project/slime/cvsroot/slime/ChangeLog	2009/01/23 10:05:03	1.1671
@@ -1,3 +1,10 @@
+2009-01-23  Tobias C. Rittweiler  <tcr at freebits.de>
+
+	* slime.el (slime-editing-keys): New variable; splitted from
+	`slime-keys'. Contains key bindings that are useful for buffers
+	where users can edit s-exprs, such as source buffers and the REPL.
+	(slime-keys): Use it.
+
 2009-01-17  Tobias C. Rittweiler  <tcr at freebits.de>
 
 	Fix C-u C-c C-c in SLDB.




From trittweiler at common-lisp.net  Fri Jan 23 10:07:14 2009
From: trittweiler at common-lisp.net (CVS User trittweiler)
Date: Fri, 23 Jan 2009 10:07:14 +0000
Subject: [slime-cvs] CVS slime/contrib
Message-ID: <E1LQIwU-0001hA-PK@common-lisp.net>

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

Modified Files:
	slime-repl.el ChangeLog 
Log Message:
	* slime-repl.el (slime-repl-mode-map): Use the key bindings from
	`slime-editing-keys'.


--- /project/slime/cvsroot/slime/contrib/slime-repl.el	2009/01/16 15:48:53	1.12
+++ /project/slime/cvsroot/slime/contrib/slime-repl.el	2009/01/23 10:07:14	1.13
@@ -416,7 +416,9 @@
 (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))
+  (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)))
 
 (slime-define-keys slime-prefix-map
   ("\C-z" 'slime-switch-to-output-buffer)
--- /project/slime/cvsroot/slime/contrib/ChangeLog	2009/01/18 14:18:53	1.167
+++ /project/slime/cvsroot/slime/contrib/ChangeLog	2009/01/23 10:07:14	1.168
@@ -1,3 +1,8 @@
+2009-01-23  Tobias C. Rittweiler  <tcr at freebits.de>
+
+	* slime-repl.el (slime-repl-mode-map): Use the key bindings from
+	`slime-editing-keys'.
+
 2009-01-18  Tobias C. Rittweiler  <tcr at freebits.de>
 
 	Local M-. and local arglist display didn't work for




From trittweiler at common-lisp.net  Tue Jan 27 14:56:14 2009
From: trittweiler at common-lisp.net (CVS User trittweiler)
Date: Tue, 27 Jan 2009 14:56:14 +0000
Subject: [slime-cvs] CVS slime
Message-ID: <E1LRpMM-0005wJ-Iq@common-lisp.net>

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

Modified Files:
	swank-sbcl.lisp swank-openmcl.lisp swank-backend.lisp 
	ChangeLog 
Log Message:
	* swank-backend.lisp (with-symbol): New function, to be used with #+.

	* swank-sbcl.lisp: Use WITH-SYMBOL and get rid of SBCL-WITH-SYMBOL.

	* swank-openmcl.lisp (macroexpand-all): Implement it.

	Patch by Stas Boukarev.


--- /project/slime/cvsroot/slime/swank-sbcl.lisp	2009/01/10 12:25:16	1.232
+++ /project/slime/cvsroot/slime/swank-sbcl.lisp	2009/01/27 14:56:14	1.233
@@ -32,29 +32,16 @@
   ;; Generate a form suitable for testing for stepper support (0.9.17)
   ;; with #+.
   (defun sbcl-with-new-stepper-p ()
-    (if (find-symbol "ENABLE-STEPPING" "SB-IMPL")
-        '(:and)
-        '(:or)))
+    (with-symbol 'enable-stepping 'sb-impl))
   ;; Ditto for weak hash-tables
   (defun sbcl-with-weak-hash-tables ()
-    (if (find-symbol "HASH-TABLE-WEAKNESS" "SB-EXT")
-        '(:and)
-        '(:or)))
+    (with-symbol 'hash-table-weakness 'sb-ext))
   ;; And for xref support (1.0.1)
   (defun sbcl-with-xref-p ()
-    (if (find-symbol "WHO-CALLS" "SB-INTROSPECT")
-        '(:and)
-        '(:or)))
+    (with-symbol 'who-calls 'sb-introspect))
   ;; ... for restart-frame support (1.0.2)
   (defun sbcl-with-restart-frame ()
-    (if (find-symbol "FRAME-HAS-DEBUG-TAG-P" "SB-DEBUG")
-        '(:and)
-        '(:or)))
-  (defun sbcl-with-symbol (name package)
-    (if (find-symbol (string name) (string package))
-        '(:and)
-        '(:or)))
-  )
+    (with-symbol 'frame-has-debug-tag-p 'sb-debug)))
 
 ;;; swank-mop
 
@@ -335,11 +322,11 @@
 
 ;;; Utilities
 
-#+#.(swank-backend::sbcl-with-symbol 'function-lambda-list 'sb-introspect)
+#+#.(swank-backend::with-symbol 'function-lambda-list 'sb-introspect)
 (defimplementation arglist (fname)
   (sb-introspect:function-lambda-list fname))
 
-#-#.(swank-backend::sbcl-with-symbol 'function-lambda-list 'sb-introspect)
+#-#.(swank-backend::with-symbol 'function-lambda-list 'sb-introspect)
 (defimplementation arglist (fname)
   (sb-introspect:function-arglist fname))
 
@@ -359,7 +346,7 @@
                                   flags :key #'ensure-list))
           (call-next-method)))))
 
-#+#.(swank-backend::sbcl-with-symbol 'deftype-lambda-list 'sb-introspect)
+#+#.(swank-backend::with-symbol 'deftype-lambda-list 'sb-introspect)
 (defmethod type-specifier-arglist :around (typespec-operator)
   (multiple-value-bind (arglist foundp)
       (sb-introspect:deftype-lambda-list typespec-operator)
@@ -518,13 +505,13 @@
 
 (defun get-compiler-policy (default-policy)
   (declare (ignorable default-policy))
-  #+#.(swank-backend::sbcl-with-symbol 'restrict-compiler-policy 'sb-ext)
+  #+#.(swank-backend::with-symbol 'restrict-compiler-policy 'sb-ext)
   (remove-duplicates (append default-policy (sb-ext:restrict-compiler-policy))
                      :key #'car))
 
 (defun set-compiler-policy (policy)
   (declare (ignorable policy))
-  #+#.(swank-backend::sbcl-with-symbol 'restrict-compiler-policy 'sb-ext)
+  #+#.(swank-backend::with-symbol 'restrict-compiler-policy 'sb-ext)
    (loop for (qual . value) in policy
          do (sb-ext:restrict-compiler-policy qual value)))
 
@@ -762,7 +749,7 @@
   (defxref who-sets)
   (defxref who-references)
   (defxref who-macroexpands)
-  #+#.(swank-backend::sbcl-with-symbol 'who-specializes 'sb-introspect)
+  #+#.(swank-backend::with-symbol 'who-specializes 'sb-introspect)
   (defxref who-specializes))
 
 (defun source-location-for-xref-data (xref-data)
@@ -933,11 +920,11 @@
          (plist (sb-c::debug-source-plist dsource)))
     (if (getf plist :emacs-buffer)
         (emacs-buffer-source-location code-location plist)
-        #+#.(swank-backend::sbcl-with-symbol 'debug-source-from 'sb-di)
+        #+#.(swank-backend::with-symbol 'debug-source-from 'sb-di)
         (ecase (sb-di:debug-source-from dsource)
           (:file (file-source-location code-location))
           (:lisp (lisp-source-location code-location)))
-        #-#.(swank-backend::sbcl-with-symbol 'debug-source-from 'sb-di)
+        #-#.(swank-backend::with-symbol 'debug-source-from 'sb-di)
         (if (sb-di:debug-source-namestring dsource)
             (file-source-location code-location)
             (lisp-source-location code-location)))))
@@ -994,10 +981,10 @@
                          `(:snippet ,snippet)))))))
 
 (defun code-location-debug-source-name (code-location)
-  (namestring (truename (#+#.(swank-backend::sbcl-with-symbol
+  (namestring (truename (#+#.(swank-backend::with-symbol
                               'debug-source-name 'sb-di)
                              sb-c::debug-source-name
-                             #-#.(swank-backend::sbcl-with-symbol
+                             #-#.(swank-backend::with-symbol
                                   'debug-source-name 'sb-di)
                              sb-c::debug-source-namestring
                          (sb-di::code-location-debug-source code-location)))))
--- /project/slime/cvsroot/slime/swank-openmcl.lisp	2009/01/16 15:49:40	1.157
+++ /project/slime/cvsroot/slime/swank-openmcl.lisp	2009/01/27 14:56:14	1.158
@@ -925,6 +925,10 @@
 	   (< (symbol-value s) 255))
       (setf (gethash (symbol-value s) *value2tag*) s)))
 
+#+#.(swank-backend::with-symbol 'macroexpand-all 'ccl)
+(defimplementation macroexpand-all (form)
+  (ccl:macroexpand-all form))
+
 ;;;; Inspection
 
 (defimplementation describe-primitive-type (thing)
--- /project/slime/cvsroot/slime/swank-backend.lisp	2009/01/16 15:49:25	1.170
+++ /project/slime/cvsroot/slime/swank-backend.lisp	2009/01/27 14:56:14	1.171
@@ -245,6 +245,12 @@
                      (t (error "Malformed syntax in WITH-STRUCT: ~A" name))))
           , at body)))))
 
+(defun with-symbol (name package)
+  "Generate a form suitable for testing with #+."
+  (if (find-symbol (string name) (string package))
+      '(:and)
+      '(:or)))
+
 
 ;;;; TCP server
 
--- /project/slime/cvsroot/slime/ChangeLog	2009/01/23 10:05:03	1.1671
+++ /project/slime/cvsroot/slime/ChangeLog	2009/01/27 14:56:14	1.1672
@@ -1,3 +1,13 @@
+2009-01-27  Tobias C. Rittweiler  <tcr at freebits.de>
+
+	* swank-backend.lisp (with-symbol): New function, to be used with #+.
+
+	* swank-sbcl.lisp: Use WITH-SYMBOL and get rid of SBCL-WITH-SYMBOL.
+
+	* swank-openmcl.lisp (macroexpand-all): Implement it.
+
+	Patch by Stas Boukarev.
+
 2009-01-23  Tobias C. Rittweiler  <tcr at freebits.de>
 
 	* slime.el (slime-editing-keys): New variable; splitted from
@@ -9,7 +19,7 @@
 
 	Fix C-u C-c C-c in SLDB.
 
-	* slime.el (sldb-recompile-frame-source): Bind
+	* slime.el (sldb-recompile-frame-source): sind
 	`slime-compilation-policy' at the right place.
 
 2009-01-15  Martin Simmons  <martin at lispworks.com>




From trittweiler at common-lisp.net  Tue Jan 27 15:13:52 2009
From: trittweiler at common-lisp.net (CVS User trittweiler)
Date: Tue, 27 Jan 2009 15:13:52 +0000
Subject: [slime-cvs] CVS slime/contrib
Message-ID: <E1LRpdQ-0006ur-Qz@common-lisp.net>

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

Modified Files:
	slime-repl.el ChangeLog 
Log Message:
	* slime-repl.el ([shortcut] quit): Quit the connection before
	killing the REPL buffer; otherwise the default connection is
	selected rather than the connection of the REPL buffer.
	Reported by Stas Boukarev.


--- /project/slime/cvsroot/slime/contrib/slime-repl.el	2009/01/23 10:07:14	1.13
+++ /project/slime/cvsroot/slime/contrib/slime-repl.el	2009/01/27 15:13:52	1.14
@@ -1322,8 +1322,11 @@
 (defslime-repl-shortcut slime-repl-quit ("quit")
   (:handler (lambda ()
 	      (interactive)
-	      (kill-buffer (slime-output-buffer))
-	      (slime-quit-lisp)))
+              ;; `slime-quit-lisp' determines the connection to quit
+              ;; on behalf of the REPL's `slime-buffer-connection'.
+              (let ((repl-buffer (slime-output-buffer)))
+                (slime-quit-lisp)
+                (kill-buffer repl-buffer))))
   (:one-liner "Quit the current Lisp."))
 
 (defslime-repl-shortcut slime-repl-defparameter ("defparameter" "!")
--- /project/slime/cvsroot/slime/contrib/ChangeLog	2009/01/23 10:07:14	1.168
+++ /project/slime/cvsroot/slime/contrib/ChangeLog	2009/01/27 15:13:52	1.169
@@ -1,3 +1,10 @@
+2009-01-27  Tobias C. Rittweiler  <tcr at freebits.de>
+
+	* slime-repl.el ([shortcut] quit): Quit the connection before
+	killing the REPL buffer; otherwise the default connection is
+	selected rather than the connection of the REPL buffer.
+	Reported by Stas Boukarev.
+
 2009-01-23  Tobias C. Rittweiler  <tcr at freebits.de>
 
 	* slime-repl.el (slime-repl-mode-map): Use the key bindings from




From gcarncross at common-lisp.net  Fri Jan 30 06:07:31 2009
From: gcarncross at common-lisp.net (CVS User gcarncross)
Date: Fri, 30 Jan 2009 06:07:31 +0000
Subject: [slime-cvs] CVS slime
Message-ID: <E1LSmXL-0000QQ-Bk@common-lisp.net>

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

Modified Files:
	swank-ecl.lisp 
Log Message:
2009-01-30  Geo Carncross  <geocar at gmail.com>

	* swank-ecl.lisp (grovel-docstring-for-arglist): Fix for arglist
	that reads, but isn't a list


--- /project/slime/cvsroot/slime/swank-ecl.lisp	2009/01/10 12:25:16	1.38
+++ /project/slime/cvsroot/slime/swank-ecl.lisp	2009/01/30 06:07:31	1.39
@@ -184,7 +184,9 @@
           (multiple-value-bind (arglist errorp)
               (ignore-errors
                 (values (read-from-string docstring t nil :start pos)))
-            (if errorp :not-available (cdr arglist)))
+            (if (or errorp (not (listp arglist)))
+                :not-available
+                (cdr arglist)))
           :not-available ))))
 
 (defimplementation arglist (name)




From gcarncross at common-lisp.net  Fri Jan 30 06:08:07 2009
From: gcarncross at common-lisp.net (CVS User gcarncross)
Date: Fri, 30 Jan 2009 06:08:07 +0000
Subject: [slime-cvs] CVS slime
Message-ID: <E1LSmXv-0000RB-Jt@common-lisp.net>

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

Modified Files:
	ChangeLog 
Log Message:
2009-01-30  Geo Carncross  <geocar at gmail.com>

	* swank-ecl.lisp (grovel-docstring-for-arglist): Fix for arglist
	that reads, but isn't a list


--- /project/slime/cvsroot/slime/ChangeLog	2009/01/27 14:56:14	1.1672
+++ /project/slime/cvsroot/slime/ChangeLog	2009/01/30 06:08:07	1.1673
@@ -1,3 +1,8 @@
+2009-01-30  Geo Carncross  <geocar at gmail.com>
+
+	* swank-ecl.lisp (grovel-docstring-for-arglist): Fix for arglist
+	that reads, but isn't a list
+
 2009-01-27  Tobias C. Rittweiler  <tcr at freebits.de>
 
 	* swank-backend.lisp (with-symbol): New function, to be used with #+.




From trittweiler at common-lisp.net  Fri Jan 30 09:58:48 2009
From: trittweiler at common-lisp.net (CVS User trittweiler)
Date: Fri, 30 Jan 2009 09:58:48 +0000
Subject: [slime-cvs] CVS slime
Message-ID: <E1LSq9A-0003OA-Hj@common-lisp.net>

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

Modified Files:
	swank-clisp.lisp ChangeLog 
Log Message:

	* swank-clisp.lisp (fspec-location): Fix creation of source-location.


--- /project/slime/cvsroot/slime/swank-clisp.lisp	2009/01/10 12:25:16	1.88
+++ /project/slime/cvsroot/slime/swank-clisp.lisp	2009/01/30 09:58:48	1.89
@@ -307,8 +307,9 @@
 			  (make-location (list :file (namestring truename))
 					 (if (consp lines)
 					     (list* :line lines)
-					     (list :function-name (string fspec)))
-					 (list :snippet (format nil "~A" type))))
+					     (list :function-name (string name)))
+                                         (when (consp type)
+                                           (list :snippet (format nil "~A" type)))))
 			 (t (list :error (princ-to-string c))))))
 		(t (list :error (format nil "No source information available for: ~S"
 					fspec)))))))
--- /project/slime/cvsroot/slime/ChangeLog	2009/01/30 06:08:07	1.1673
+++ /project/slime/cvsroot/slime/ChangeLog	2009/01/30 09:58:48	1.1674
@@ -1,3 +1,9 @@
+2009-01-30  Tobias C. Rittweiler  <tcr at freebits.de>
+
+	* swank-clisp.lisp (fspec-location): Fix creation of source-location.
+
+	Patch by Carsten Blaauw.
+
 2009-01-30  Geo Carncross  <geocar at gmail.com>
 
 	* swank-ecl.lisp (grovel-docstring-for-arglist): Fix for arglist