From trittweiler at common-lisp.net  Tue Dec  2 21:14:13 2008
From: trittweiler at common-lisp.net (CVS User trittweiler)
Date: Tue, 02 Dec 2008 21:14:13 +0000
Subject: [slime-cvs] CVS slime
Message-ID: <E1L7cZR-0001rp-HQ@common-lisp.net>

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

Modified Files:
	slime.el ChangeLog 
Log Message:

Modeline wouldn't display {debugged..} after `slime-interrupt'.

* slime.el (slime-debugged-connection-p): Can't rely on
  `sldb-debugged-continuations' to be non-null in every SLDB buffer.


--- /project/slime/cvsroot/slime/slime.el	2008/11/23 22:11:36	1.1065
+++ /project/slime/cvsroot/slime/slime.el	2008/12/02 21:14:13	1.1066
@@ -2352,7 +2352,12 @@
   (not (memq conn slime-net-processes)))
 
 (defun slime-debugged-connection-p (conn)
-  (and (sldb-debugged-continuations conn) t))
+  ;; This previously was (AND (SLDB-DEBUGGED-CONTINUATIONS CONN) T),
+  ;; but an SLDB buffer may exist without having continuations
+  ;; attached to it, e.g. the one resulting from `slime-interrupt'.
+  (loop for b in (sldb-buffers)
+        thereis (with-current-buffer b
+                  (eq slime-buffer-connection conn))))
 
 (defun slime-busy-p (&optional conn)
   "True if Lisp has outstanding requests.
--- /project/slime/cvsroot/slime/ChangeLog	2008/11/23 22:11:36	1.1587
+++ /project/slime/cvsroot/slime/ChangeLog	2008/12/02 21:14:13	1.1588
@@ -1,3 +1,10 @@
+2008-12-02  Tobias C. Rittweiler  <tcr at freebits.de>
+
+	Modeline wouldn't display {debugged..} after `slime-interrupt'.
+
+	* slime.el (slime-debugged-connection-p): Can't rely on
+	`sldb-debugged-continuations' to be non-null in every SLDB buffer.
+
 2008-11-23  Helmut Eller  <heller at common-lisp.net>
 
 	`q' in temp buffers should only delete the window if it was newly




From trittweiler at common-lisp.net  Tue Dec  2 21:41:05 2008
From: trittweiler at common-lisp.net (CVS User trittweiler)
Date: Tue, 02 Dec 2008 21:41:05 +0000
Subject: [slime-cvs] CVS slime
Message-ID: <E1L7czR-0003f7-CK@common-lisp.net>

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

Modified Files:
	slime.el ChangeLog 
Log Message:

      * slime.el (slime-compute-modeline-connection-state): Print the
      number of debugged requests if non-zero.
      (slime-connection-state-as-string): Removed unused branches.
      (slime-compute-connection-state): Removed :debugged branch making
      most likely return :connected instead.


--- /project/slime/cvsroot/slime/slime.el	2008/12/02 21:14:13	1.1066
+++ /project/slime/cvsroot/slime/slime.el	2008/12/02 21:41:05	1.1067
@@ -479,12 +479,17 @@
         (slime-connection-name conn))))
 
 (defun slime-compute-modeline-connection-state ()
-  (let ((new-state (slime-compute-connection-state (slime-current-connection))))
+  (let* ((conn (slime-current-connection))
+         (new-state (slime-compute-connection-state conn)))
     (if (eq new-state :connected)
-        (let ((n (length (slime-rex-continuations))))
-          (if (= n 0)
-              nil
-            n))
+        (let ((n (length (slime-rex-continuations)))
+              (m (length (sldb-debugged-continuations conn))))
+          (cond ((= n 0)
+                 nil)
+                ((= m 0)
+                 n)
+                (t
+                 (format "%s/%s" (- n m) m))))
       (slime-connection-state-as-string new-state))))
 
 (defun slime-compute-modeline-string (conn state pkg)
@@ -1929,21 +1934,17 @@
 (defun slime-compute-connection-state (conn)
   (cond ((null conn) :disconnected) 
         ((slime-stale-connection-p conn) :stale)
-        ((slime-debugged-connection-p conn) :debugged)
-        ((and (slime-use-sigint-for-interrupt conn) 
+        ((and (slime-use-sigint-for-interrupt conn)
               (slime-busy-p conn)) :busy)
         ((eq slime-buffer-connection conn) :local)
         (t :connected)))
 
 (defun slime-connection-state-as-string (state)
   (case state
-    (:connected       "")
     (:disconnected    "not connected")
     (:busy            "busy..")
-    (:debugged        "debugged..")
     (:stale           "stale")
-    (:local           "local")
-    ))
+    (:local           "local")))
 
 ;;; Connection-local variables:
 
--- /project/slime/cvsroot/slime/ChangeLog	2008/12/02 21:14:13	1.1588
+++ /project/slime/cvsroot/slime/ChangeLog	2008/12/02 21:41:05	1.1589
@@ -1,3 +1,11 @@
+2008-11-30  G?bor Melis  <mega at retes.hu>
+
+      * slime.el (slime-compute-modeline-connection-state): Print the
+      number of debugged requests if non-zero.
+      (slime-connection-state-as-string): Removed unused branches.
+      (slime-compute-connection-state): Removed :debugged branch making
+      most likely return :connected instead.
+
 2008-12-02  Tobias C. Rittweiler  <tcr at freebits.de>
 
 	Modeline wouldn't display {debugged..} after `slime-interrupt'.




From trittweiler at common-lisp.net  Tue Dec  2 22:00:41 2008
From: trittweiler at common-lisp.net (CVS User trittweiler)
Date: Tue, 02 Dec 2008 22:00:41 +0000
Subject: [slime-cvs] CVS slime
Message-ID: <E1L7dIP-0004da-Ik@common-lisp.net>

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

Modified Files:
	slime.el ChangeLog 
Log Message:

* slime.el (slime-compute-modeline-connection-state): Fix
  computation of debugged requests.


--- /project/slime/cvsroot/slime/slime.el	2008/12/02 21:41:05	1.1067
+++ /project/slime/cvsroot/slime/slime.el	2008/12/02 22:00:41	1.1068
@@ -482,14 +482,17 @@
   (let* ((conn (slime-current-connection))
          (new-state (slime-compute-connection-state conn)))
     (if (eq new-state :connected)
-        (let ((n (length (slime-rex-continuations)))
-              (m (length (sldb-debugged-continuations conn))))
-          (cond ((= n 0)
-                 nil)
-                ((= m 0)
-                 n)
-                (t
-                 (format "%s/%s" (- n m) m))))
+        (let ((rex-cs  (length (slime-rex-continuations)))
+              (sldb-cs (length (sldb-debugged-continuations conn)))
+              ;; There can be SLDB buffers which have no continuations
+              ;; attached to it, e.g. the one resulting from
+              ;; `slime-interrupt'.
+              (sldbs   (length (sldb-buffers conn))))
+          (if (= sldbs 0)
+              (format "%s" rex-cs)
+              (format "%s/%s"
+                      (if (= rex-cs 0) 0 (- rex-cs sldb-cs)) 
+                      sldbs)))
       (slime-connection-state-as-string new-state))))
 
 (defun slime-compute-modeline-string (conn state pkg)
@@ -2352,6 +2355,7 @@
 (defun slime-stale-connection-p (conn)
   (not (memq conn slime-net-processes)))
 
+;; UNUSED
 (defun slime-debugged-connection-p (conn)
   ;; This previously was (AND (SLDB-DEBUGGED-CONTINUATIONS CONN) T),
   ;; but an SLDB buffer may exist without having continuations
@@ -6759,9 +6763,13 @@
 
 ;;;;; SLDB buffer creation & update
 
-(defun sldb-buffers ()
-  "Return a list of all sldb buffers."
-  (slime-filter-buffers (lambda () (eq major-mode 'sldb-mode))))
+(defun sldb-buffers (&optional connection)
+  "Return a list of all sldb buffers (belonging to CONNECITON.)"
+  (if connection
+      (slime-filter-buffers (lambda ()
+                              (and (eq slime-buffer-connection connection)
+                                   (eq major-mode 'sldb-mode))))
+      (slime-filter-buffers (lambda () (eq major-mode 'sldb-mode)))))
 
 (defun sldb-find-buffer (thread &optional connection)
   (let ((connection (or connection (slime-connection))))
--- /project/slime/cvsroot/slime/ChangeLog	2008/12/02 21:41:05	1.1589
+++ /project/slime/cvsroot/slime/ChangeLog	2008/12/02 22:00:41	1.1590
@@ -1,10 +1,15 @@
+2008-12-02  Tobias C. Rittweiler  <tcr at freebits.de>
+
+	* slime.el (slime-compute-modeline-connection-state): Fix
+	computation of debugged requests.
+
 2008-11-30  G?bor Melis  <mega at retes.hu>
 
-      * slime.el (slime-compute-modeline-connection-state): Print the
-      number of debugged requests if non-zero.
-      (slime-connection-state-as-string): Removed unused branches.
-      (slime-compute-connection-state): Removed :debugged branch making
-      most likely return :connected instead.
+	* slime.el (slime-compute-modeline-connection-state): Print the
+	number of debugged requests if non-zero.
+	(slime-connection-state-as-string): Removed unused branches.
+	(slime-compute-connection-state): Removed :debugged branch making
+	most likely return :connected instead.
 
 2008-12-02  Tobias C. Rittweiler  <tcr at freebits.de>
 




From trittweiler at common-lisp.net  Fri Dec  5 18:53:14 2008
From: trittweiler at common-lisp.net (CVS User trittweiler)
Date: Fri, 05 Dec 2008 18:53:14 +0000
Subject: [slime-cvs] CVS slime
Message-ID: <E1L8fne-0003lf-7f@common-lisp.net>

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

Modified Files:
	slime.el ChangeLog 
Log Message:

* slime.el (slime-trace-query): SPEC argument can be a symbol.


--- /project/slime/cvsroot/slime/slime.el	2008/12/02 22:00:41	1.1068
+++ /project/slime/cvsroot/slime/slime.el	2008/12/05 18:53:13	1.1069
@@ -5692,6 +5692,8 @@
          (slime-read-from-minibuffer "(Un)trace: "))
         ((stringp spec)
          (slime-read-from-minibuffer "(Un)trace: " spec))
+        ((symbolp spec)    ; `slime-extract-context' can return symbols.
+         (slime-read-from-minibuffer "(Un)trace: " (prin1-to-string spec)))
         (t
          (destructure-case spec
            ((setf n)
--- /project/slime/cvsroot/slime/ChangeLog	2008/12/02 22:00:41	1.1590
+++ /project/slime/cvsroot/slime/ChangeLog	2008/12/05 18:53:14	1.1591
@@ -1,3 +1,7 @@
+2008-12-05  Tobias C. Rittweiler  <tcr at freebits.de>
+
+	* slime.el (slime-trace-query): SPEC argument can be a symbol.
+
 2008-12-02  Tobias C. Rittweiler  <tcr at freebits.de>
 
 	* slime.el (slime-compute-modeline-connection-state): Fix




From trittweiler at common-lisp.net  Fri Dec  5 20:01:54 2008
From: trittweiler at common-lisp.net (CVS User trittweiler)
Date: Fri, 05 Dec 2008 20:01:54 +0000
Subject: [slime-cvs] CVS slime
Message-ID: <E1L8gs6-0008Gf-Qb@common-lisp.net>

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

Modified Files:
	slime.el ChangeLog 
Log Message:

* slime.el (slime-macroexpansion-minor-mode-map): Bind keybindings
  of `undo' to `slime-macroexpansion-undo'.
  (slime-show-macroexpansion): Renamed to
  `slime-initialize-macroexpansion-buffer'
  (slime-initialize-macroexpansion-buffer): Make sure that the user
  can't undo past the initial insertion.
  (slime-macroexpand-undo): New function. Tries to undo-only.


--- /project/slime/cvsroot/slime/slime.el	2008/12/05 18:53:13	1.1069
+++ /project/slime/cvsroot/slime/slime.el	2008/12/05 20:01:54	1.1070
@@ -6415,13 +6415,8 @@
            (define-key slime-macroexpansion-minor-mode-map mapping to))))
   (remap 'slime-macroexpand-1 'slime-macroexpand-1-inplace)
   (remap 'slime-macroexpand-all 'slime-macroexpand-all-inplace)
-  (remap 'advertised-undo 
-         '(lambda (&optional arg)
-            (interactive)
-            (let ((inhibit-read-only t))
-              (when (fboundp 'slime-remove-edits)
-                (slime-remove-edits (point-min) (point-max)))
-              (undo arg)))))
+  (remap 'advertised-undo 'slime-macroexpand-undo)
+  (remap 'undo 'slime-macroexpand-undo))
 
 (defun slime-sexp-at-point-for-macroexpansion ()
   "Essentially like SLIME-SEXP-AT-POINT-OR-ERROR, but behaves a
@@ -6452,11 +6447,12 @@
                     (car (slime-sexp-at-point-for-macroexpansion)))))
     (setq slime-eval-macroexpand-expression `(,expander ,string))
     (slime-eval-async slime-eval-macroexpand-expression
-                      #'slime-show-macroexpansion)))
+                      #'slime-initialize-macroexpansion-buffer)))
 
-(defun slime-show-macroexpansion (expansion &optional buffer)
+(defun slime-initialize-macroexpansion-buffer (expansion &optional buffer)
   (pop-to-buffer (or buffer (slime-create-macroexpansion-buffer)))
-  (let ((inhibit-read-only t))
+  (let ((inhibit-read-only t)
+        (buffer-undo-list t)) ; Make the initial insertion not be undoable.
     (erase-buffer)
     (insert expansion)
     (goto-char (point-min))
@@ -6535,9 +6531,21 @@
   "Reperform the last macroexpansion."
   (interactive)
   (slime-eval-async slime-eval-macroexpand-expression 
-                    (slime-rcurry #'slime-show-macroexpansion
+                    (slime-rcurry #'slime-initialize-macroexpansion-buffer
                                   (current-buffer))))
 
+(defun slime-macroexpand-undo (&optional arg)
+  (interactive)
+  (flet ((undo-only (arg)
+           ;; Emacs 22.x introduced `undo-only' which works by binding
+           ;; `undo-no-redo' to t. We do it this way so we don't break
+           ;; prior Emacs versions.
+           (let ((undo-no-redo t)) (undo arg))))
+    (let ((inhibit-read-only t))
+      (when (fboundp 'slime-remove-edits)
+        (slime-remove-edits (point-min) (point-max)))
+      (undo-only arg))))
+
 
 ;;;; Subprocess control
 
--- /project/slime/cvsroot/slime/ChangeLog	2008/12/05 18:53:14	1.1591
+++ /project/slime/cvsroot/slime/ChangeLog	2008/12/05 20:01:54	1.1592
@@ -1,5 +1,15 @@
 2008-12-05  Tobias C. Rittweiler  <tcr at freebits.de>
 
+	* slime.el (slime-macroexpansion-minor-mode-map): Bind keybindings
+	of `undo' to `slime-macroexpansion-undo'.
+	(slime-show-macroexpansion): Renamed to
+	`slime-initialize-macroexpansion-buffer'
+	(slime-initialize-macroexpansion-buffer): Make sure that the user
+	can't undo past the initial insertion.
+	(slime-macroexpand-undo): New function. Tries to undo-only.
+
+2008-12-05  Tobias C. Rittweiler  <tcr at freebits.de>
+
 	* slime.el (slime-trace-query): SPEC argument can be a symbol.
 
 2008-12-02  Tobias C. Rittweiler  <tcr at freebits.de>




From nsiivola at common-lisp.net  Sun Dec  7 12:25:39 2008
From: nsiivola at common-lisp.net (CVS User nsiivola)
Date: Sun, 07 Dec 2008 12:25:39 +0000
Subject: [slime-cvs] CVS slime
Message-ID: <E1L9Ihf-0005H4-GK@common-lisp.net>

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

Modified Files:
	ChangeLog slime.el 
Log Message:
fix slime-qualify-cl-symbol-name for packages named by strings in IN-PACKAGE


--- /project/slime/cvsroot/slime/ChangeLog	2008/12/05 20:01:54	1.1592
+++ /project/slime/cvsroot/slime/ChangeLog	2008/12/07 12:25:38	1.1593
@@ -1,3 +1,9 @@
+2008-12-07  Nikodemus Siivola <nikodemus at random-state.net>
+
+	* slime.el (slime-qualify-cl-symbol-name): Clean up the package
+	name using `slime-pretty-package-name', so that packages named with
+	strings are not left with the extra doublequotes.
+	
 2008-12-05  Tobias C. Rittweiler  <tcr at freebits.de>
 
 	* slime.el (slime-macroexpansion-minor-mode-map): Bind keybindings
--- /project/slime/cvsroot/slime/slime.el	2008/12/05 20:01:54	1.1070
+++ /project/slime/cvsroot/slime/slime.el	2008/12/07 12:25:38	1.1071
@@ -9732,10 +9732,10 @@
         s
       (format "%s::%s"
               (let* ((package (or (slime-current-package) (slime-lisp-package))))
-                ;; package is a string like ":cl-user" or "CL-USER".
-                (if (and package (string-match "^:" package))
-                    (substring package 1)
-                  package))
+                ;; package is a string like ":cl-user" or "CL-USER", or "\"CL-USER\"".
+                (if package
+                    (slime-pretty-package-name package)
+                  "CL-USER"))
               (slime-cl-symbol-name s)))))
 
 ;;;;; Moving, CL idiosyncracies aware (reader conditionals &c.)




From heller at common-lisp.net  Tue Dec  9 07:47:49 2008
From: heller at common-lisp.net (CVS User heller)
Date: Tue, 09 Dec 2008 07:47:49 +0000
Subject: [slime-cvs] CVS slime
Message-ID: <E1L9xJt-0001cd-0w@common-lisp.net>

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

Modified Files:
	ChangeLog slime.el 
Log Message:
* slime.el (slime-repl-mode): Use `run-mode-hooks' rather than
just `run-hooks'.  That way, after-change-major-mode-hook is
called automatically.  Patch from David Reitter.

--- /project/slime/cvsroot/slime/ChangeLog	2008/12/07 12:25:38	1.1593
+++ /project/slime/cvsroot/slime/ChangeLog	2008/12/09 07:47:47	1.1594
@@ -1,9 +1,15 @@
+2008-12-09   David Reitter <david.reitter at gmail.com>
+
+	* slime.el (slime-repl-mode): Use `run-mode-hooks' rather than
+	just `run-hooks'.  That way, after-change-major-mode-hook is
+	called automatically.
+
 2008-12-07  Nikodemus Siivola <nikodemus at random-state.net>
 
 	* slime.el (slime-qualify-cl-symbol-name): Clean up the package
 	name using `slime-pretty-package-name', so that packages named with
 	strings are not left with the extra doublequotes.
-	
+
 2008-12-05  Tobias C. Rittweiler  <tcr at freebits.de>
 
 	* slime.el (slime-macroexpansion-minor-mode-map): Bind keybindings
--- /project/slime/cvsroot/slime/slime.el	2008/12/07 12:25:38	1.1071
+++ /project/slime/cvsroot/slime/slime.el	2008/12/09 07:47:48	1.1072
@@ -2939,7 +2939,7 @@
        'slime-repl-mode-beginning-of-defun)
   (set (make-local-variable 'end-of-defun-function) 
        'slime-repl-mode-end-of-defun)
-  (run-hooks 'slime-repl-mode-hook))
+  (run-mode-hooks 'slime-repl-mode-hook))
 
 (defun slime-repl-buffer (&optional create connection)
   "Get the REPL buffer for the current connection; optionally create."




From heller at common-lisp.net  Tue Dec  9 07:47:59 2008
From: heller at common-lisp.net (CVS User heller)
Date: Tue, 09 Dec 2008 07:47:59 +0000
Subject: [slime-cvs] CVS slime
Message-ID: <E1L9xK3-0001dS-LH@common-lisp.net>

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

Modified Files:
	ChangeLog slime.el 
Log Message:
Make the modeline a bit shorter.

* slime.el (slime-compute-modeline-string): Remove PKG: and CON:
to save space.
(slime-compute-modeline-connection-state): Don't include zeros.

--- /project/slime/cvsroot/slime/ChangeLog	2008/12/09 07:47:47	1.1594
+++ /project/slime/cvsroot/slime/ChangeLog	2008/12/09 07:47:59	1.1595
@@ -1,4 +1,12 @@
-2008-12-09   David Reitter <david.reitter at gmail.com>
+2008-12-09  Helmut Eller  <heller at common-lisp.net>
+
+	Make the modeline a bit shorter.
+
+	* slime.el (slime-compute-modeline-string): Remove PKG: and CON:
+	to save space.
+	(slime-compute-modeline-connection-state): Don't include zeros.
+
+2008-12-09  David Reitter <david.reitter at gmail.com>
 
 	* slime.el (slime-repl-mode): Use `run-mode-hooks' rather than
 	just `run-hooks'.  That way, after-change-major-mode-hook is
--- /project/slime/cvsroot/slime/slime.el	2008/12/09 07:47:48	1.1072
+++ /project/slime/cvsroot/slime/slime.el	2008/12/09 07:47:59	1.1073
@@ -488,18 +488,18 @@
               ;; attached to it, e.g. the one resulting from
               ;; `slime-interrupt'.
               (sldbs   (length (sldb-buffers conn))))
-          (if (= sldbs 0)
-              (format "%s" rex-cs)
-              (format "%s/%s"
-                      (if (= rex-cs 0) 0 (- rex-cs sldb-cs)) 
-                      sldbs)))
+          (cond ((and (= sldbs 0) (zerop rex-cs)) nil)
+                ((= sldbs 0) (format "%s" rex-cs))
+                (t (format "%s/%s"
+                           (if (= rex-cs 0) 0 (- rex-cs sldb-cs)) 
+                           sldbs))))
       (slime-connection-state-as-string new-state))))
 
 (defun slime-compute-modeline-string (conn state pkg)
   (concat (when (or conn pkg)             "[")
-          (when pkg                       (format "PKG:%s" pkg))
+          (when pkg                       (format "%s" pkg))
           (when (and (or conn state) pkg) ", ")
-          (when conn                      (format "CON:%s" conn))
+          (when conn                      (format "%s" conn))
           (when state                     (format "{%s}" state))
           (when (or conn pkg)             "]")))
 




From heller at common-lisp.net  Tue Dec  9 07:48:11 2008
From: heller at common-lisp.net (CVS User heller)
Date: Tue, 09 Dec 2008 07:48:11 +0000
Subject: [slime-cvs] CVS slime
Message-ID: <E1L9xKF-0001eC-15@common-lisp.net>

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

Modified Files:
	ChangeLog slime.el swank.lisp 
Log Message:
Be a bit more careful when computing the toplevel restart.

* swank.lisp (throw-to-toplevel): Test *sldb-quit-restart* for
nilness.
* sldb-quit (sldb-quit): Show the returned value in brackets.

--- /project/slime/cvsroot/slime/ChangeLog	2008/12/09 07:47:59	1.1595
+++ /project/slime/cvsroot/slime/ChangeLog	2008/12/09 07:48:10	1.1596
@@ -1,5 +1,13 @@
 2008-12-09  Helmut Eller  <heller at common-lisp.net>
 
+	Be a bit more careful when computing the toplevel restart.
+
+	* swank.lisp (throw-to-toplevel): Test *sldb-quit-restart* for
+	nilness.
+	* sldb-quit (sldb-quit): Show the returned value in brackets.
+
+2008-12-09  Helmut Eller  <heller at common-lisp.net>
+
 	Make the modeline a bit shorter.
 
 	* slime.el (slime-compute-modeline-string): Remove PKG: and CON:
--- /project/slime/cvsroot/slime/slime.el	2008/12/09 07:47:59	1.1073
+++ /project/slime/cvsroot/slime/slime.el	2008/12/09 07:48:10	1.1074
@@ -7399,7 +7399,7 @@
   (interactive)
   (assert sldb-restarts () "sldb-quit called outside of sldb buffer")
   (slime-rex () ('(swank:throw-to-toplevel))
-    ((:ok _) (error "sldb-quit returned"))
+    ((:ok x) (error "sldb-quit returned [%s]" x))
     ((:abort))))
 
 (defun sldb-continue ()
--- /project/slime/cvsroot/slime/swank.lisp	2008/11/22 15:14:51	1.610
+++ /project/slime/cvsroot/slime/swank.lisp	2008/12/09 07:48:10	1.611
@@ -2363,9 +2363,10 @@
 (defslimefun throw-to-toplevel ()
   "Invoke the ABORT-REQUEST restart abort an RPC from Emacs.
 If we are not evaluating an RPC then ABORT instead."
-  (let ((restart (find-restart *sldb-quit-restart*)))
+  (let ((restart (and *sldb-quit-restart*
+                      (find-restart *sldb-quit-restart*))))
     (cond (restart (invoke-restart restart))
-          (t "Toplevel restart found"))))
+          (t "No toplevel restart active"))))
 
 (defslimefun invoke-nth-restart-for-emacs (sldb-level n)
   "Invoke the Nth available restart.
@@ -2909,6 +2910,7 @@
 
 
 ;;;; Inspecting
+
 (defvar *inspector-verbose* nil)
 
 (defstruct (inspector-state (:conc-name istate.))




From heller at common-lisp.net  Tue Dec  9 07:48:20 2008
From: heller at common-lisp.net (CVS User heller)
Date: Tue, 09 Dec 2008 07:48:20 +0000
Subject: [slime-cvs] CVS slime
Message-ID: <E1L9xKO-0001ey-O5@common-lisp.net>

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

Modified Files:
	ChangeLog slime.el swank.lisp 
Log Message:
Reset the stream column to 0 after eval requests.

* swank.lisp (interactive-eval, eval-region): Use FRESH-LINE
to reset the stream column.
* slime.el (test repl-test): Adjust test accordingly.

--- /project/slime/cvsroot/slime/ChangeLog	2008/12/09 07:48:10	1.1596
+++ /project/slime/cvsroot/slime/ChangeLog	2008/12/09 07:48:20	1.1597
@@ -1,5 +1,13 @@
 2008-12-09  Helmut Eller  <heller at common-lisp.net>
 
+	Reset the stream column to 0 after eval requests.
+
+	* swank.lisp (interactive-eval, eval-region): Use FRESH-LINE
+	to reset the stream column.
+	* slime.el (test repl-test): Adjust test accordingly.
+
+2008-12-09  Helmut Eller  <heller at common-lisp.net>
+
 	Be a bit more careful when computing the toplevel restart.
 
 	* swank.lisp (throw-to-toplevel): Test *sldb-quit-restart* for
--- /project/slime/cvsroot/slime/slime.el	2008/12/09 07:48:10	1.1074
+++ /project/slime/cvsroot/slime/slime.el	2008/12/09 07:48:20	1.1075
@@ -9232,10 +9232,12 @@
 {}3
 SWANK> *[]")
       ("(princ 10)" "SWANK> (princ 10)
-{10}10
+{10
+}10
 SWANK> *[]")
       ("(princ 10)(princ 20)" "SWANK> (princ 10)(princ 20)
-{1020}20
+{1020
+}20
 SWANK> *[]")
       ("(dotimes (i 10 77) (princ i) (terpri))" 
        "SWANK> (dotimes (i 10 77) (princ i) (terpri))
@@ -9263,10 +9265,32 @@
        "SWANK> (progn (princ 10) (abort))
 {10}; Evaluation aborted.
 SWANK> *[]")
+      ("(if (fresh-line) 1 0)"
+       "SWANK> (if (fresh-line) 1 0)
+{
+}1
+SWANK> *[]")
       ("(values 1 2 3)" "SWANK> (values 1 2 3)
 {}1
 2
 3
+SWANK> *[]")
+      ("(with-standard-io-syntax
+         (write (make-list 15 :initial-element '(1 . 2)) :pretty t) 0)"
+       "SWANK> (with-standard-io-syntax
+         (write (make-list 15 :initial-element '(1 . 2)) :pretty t) 0)
+{((1 . 2) (1 . 2) (1 . 2) (1 . 2) (1 . 2) (1 . 2) (1 . 2) (1 . 2) (1 . 2)
+ (1 . 2) (1 . 2) (1 . 2) (1 . 2) (1 . 2) (1 . 2))
+}0
+SWANK> *[]")
+      ;; Two times to test the effect of FRESH-LINE.
+      ("(with-standard-io-syntax
+         (write (make-list 15 :initial-element '(1 . 2)) :pretty t) 0)"
+       "SWANK> (with-standard-io-syntax
+         (write (make-list 15 :initial-element '(1 . 2)) :pretty t) 0)
+{((1 . 2) (1 . 2) (1 . 2) (1 . 2) (1 . 2) (1 . 2) (1 . 2) (1 . 2) (1 . 2)
+ (1 . 2) (1 . 2) (1 . 2) (1 . 2) (1 . 2) (1 . 2))
+}0
 SWANK> *[]"))
   (with-current-buffer (slime-output-buffer)
     (setf (slime-lisp-package-prompt-string) "SWANK"))
--- /project/slime/cvsroot/slime/swank.lisp	2008/12/09 07:48:10	1.611
+++ /project/slime/cvsroot/slime/swank.lisp	2008/12/09 07:48:20	1.612
@@ -1891,6 +1891,7 @@
   (with-buffer-syntax ()
     (with-retry-restart (:msg "Retry SLIME interactive evaluation request.")
       (let ((values (multiple-value-list (eval (from-string string)))))
+        (fresh-line)
         (finish-output)
         (format-values-for-echo-area values)))))
 
@@ -1912,6 +1913,8 @@
       (loop
        (let ((form (read stream nil stream)))
          (when (eq form stream)
+           (fresh-line)
+           (finish-output)
            (return (values values -)))
          (setq - form)
          (setq values (multiple-value-list (eval form)))




From heller at common-lisp.net  Tue Dec  9 18:29:06 2008
From: heller at common-lisp.net (CVS User heller)
Date: Tue, 09 Dec 2008 18:29:06 +0000
Subject: [slime-cvs] CVS slime/contrib
Message-ID: <E1LA7KU-0000dx-Fs@common-lisp.net>

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

Modified Files:
	ChangeLog swank-kawa.scm 
Log Message:
* swank-kawa.scm (mif): Avoid assignments because that triggers a
bug/regression in the compiler.
(getpid): Don't use the -n option with echo.  It's not standard
and also not needed here.

--- /project/slime/cvsroot/slime/contrib/ChangeLog	2008/11/29 11:12:39	1.142
+++ /project/slime/cvsroot/slime/contrib/ChangeLog	2008/12/09 18:29:06	1.143
@@ -1,3 +1,10 @@
+2008-12-09  Helmut Eller  <heller at common-lisp.net>
+
+	* swank-kawa.scm (mif): Avoid assignments because that triggers a
+	bug/regression in the compiler.
+	(getpid): Don't use the -n with echo.  It's not standard and also
+	not needed here.
+
 2008-11-29  Tobias C. Rittweiler  <tcr at freebits.de>
 
 	* slime-package-fu.el (slime-goto-package-source-definition):
--- /project/slime/cvsroot/slime/contrib/swank-kawa.scm	2008/10/19 20:03:55	1.10
+++ /project/slime/cvsroot/slime/contrib/swank-kawa.scm	2008/12/09 18:29:06	1.11
@@ -178,13 +178,14 @@
        'ok))))
 
 (define-syntax mif
-  (syntax-rules (unquote quote _ ::)
+  (syntax-rules (quote unquote _)
     ((mif ('x value) then else)
      (if (equal? 'x value) then else))
     ((mif (,x value) then else)
      (if (eq? x value) then else))
     ((mif (() value) then else)
      (if (eq? value '()) then else))
+    #|  This variant produces no lambdas but breaks the compiler
     ((mif ((p . ps) value) then else)
      (let ((tmp value)
            (fail? :: <int> 0)
@@ -198,6 +199,18 @@
                 (set! fail? -1)))
            (set! fail? -1))
        (if (= fail? 0) result else)))
+    |#
+    ((mif ((p . ps) value) then else)
+     (let ((fail (lambda () else))
+           (tmp value))
+       (if (instance? tmp <pair>)
+           (let ((tmp :: <pair> tmp))
+             (mif (p tmp:car)
+                  (mif (ps tmp:cdr)
+                       then
+                       (fail))
+                  (fail)))
+           (fail))))
     ((mif (_ value) then else)
      then)
     ((mif (var value) then else)
@@ -336,6 +349,10 @@
 (define-variable *last-exception* #f)
 (define-variable *last-stacktrace* #f)
 
+;; FIXME: this needs factorization.  But I guess the whole idea of
+;; using bidirectional channels just sucks.  Mailboxes owned by a
+;; single thread to which everybody can send are much easier to use.
+
 (df dispatch-events ((s <socket>))
   (mlet* ((charset "iso-8859-1")
           (ins (<in> (! getInputStream s) charset))
@@ -1570,7 +1587,7 @@
     (! attach pa args)))
 
 (df getpid ()
-  (let ((p (make-process (command-parse "echo -n $PPID") #!null)))
+  (let ((p (make-process (command-parse "echo $PPID") #!null)))
     (! waitFor p)
     (! read-line (<java.io.BufferedReader> (<in> (! get-input-stream p))))))
 




From heller at common-lisp.net  Tue Dec 23 08:32:54 2008
From: heller at common-lisp.net (CVS User heller)
Date: Tue, 23 Dec 2008 08:32:54 +0000
Subject: [slime-cvs] CVS slime
Message-ID: <E1LF2hC-0002I1-SZ@common-lisp.net>

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

Modified Files:
	ChangeLog slime.el 
Log Message:
* slime.el (sldb-insert-restarts): Make the space before each
restart also propertized, consistent with how each line in the
backtrace is fully sensitive.

--- /project/slime/cvsroot/slime/ChangeLog	2008/12/09 07:48:20	1.1597
+++ /project/slime/cvsroot/slime/ChangeLog	2008/12/23 08:32:51	1.1598
@@ -1,3 +1,9 @@
+2008-12-23  Willem Broekema <metawilm at gmail.com>
+
+	* slime.el (sldb-insert-restarts): Make the space before each
+	restart also propertized, consistent with how each line in the
+	backtrace is fully sensitive.
+
 2008-12-09  Helmut Eller  <heller at common-lisp.net>
 
 	Reset the stream column to 0 after eval requests.
--- /project/slime/cvsroot/slime/slime.el	2008/12/09 07:48:20	1.1075
+++ /project/slime/cvsroot/slime/slime.el	2008/12/23 08:32:53	1.1076
@@ -6927,15 +6927,14 @@
 
 (defun sldb-insert-restarts (restarts)
   "Insert RESTARTS and add the needed text props
-RESTARTS should be alist ((NAME DESCRIPTION) ...)."
+RESTARTS should be a list ((NAME DESCRIPTION) ...)."
   (loop for (name string) in restarts
         for number from 0 do
-        (insert " ")
         (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-number (number-to-string number))
          ": ["  (in-sldb-face restart-type name) "] "
          (in-sldb-face restart string))
         (insert "\n")))




From heller at common-lisp.net  Tue Dec 23 08:33:03 2008
From: heller at common-lisp.net (CVS User heller)
Date: Tue, 23 Dec 2008 08:33:03 +0000
Subject: [slime-cvs] CVS slime
Message-ID: <E1LF2hL-0002Io-6C@common-lisp.net>

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

Modified Files:
	ChangeLog swank.lisp 
Log Message:
* swank.lisp (connection): Add a slot to store the auto-flush-thread.
(cleanup-connection-threads): Also kill the auto-flush-thread.

(stop-server): list-threads returns the thread name in second
position and not in first position.

--- /project/slime/cvsroot/slime/ChangeLog	2008/12/23 08:32:51	1.1598
+++ /project/slime/cvsroot/slime/ChangeLog	2008/12/23 08:33:02	1.1599
@@ -1,3 +1,12 @@
+2008-12-23  Sven Van Caekenberghe <sven at beta9.be>
+
+	* swank.lisp (connection): Add a slot to store the
+	auto-flush-thread.
+	(cleanup-connection-threads): Also kill the auto-flush-thread.
+
+	(stop-server): list-threads returns the thread name in second
+	position and not in first position.
+
 2008-12-23  Willem Broekema <metawilm at gmail.com>
 
 	* slime.el (sldb-insert-restarts): Make the space before each
--- /project/slime/cvsroot/slime/swank.lisp	2008/12/09 07:48:20	1.612
+++ /project/slime/cvsroot/slime/swank.lisp	2008/12/23 08:33:03	1.613
@@ -241,6 +241,7 @@
   reader-thread
   control-thread
   repl-thread
+  auto-flush-thread
   ;; Callback functions:
   ;; (SERVE-REQUESTS <this-connection>) serves all pending requests
   ;; from Emacs.
@@ -762,9 +763,8 @@
        (let ((thread-position
               (position-if 
                (lambda (x) 
-                 (string-equal (first x)
-                               (concatenate 'string "Swank "
-                                            (princ-to-string port))))
+                 (string-equal (second x)
+                               (cat "Swank " (princ-to-string port))))
                (list-threads))))
          (when thread-position
            (kill-nth-thread thread-position)
@@ -865,8 +865,9 @@
          (repl-results (make-output-stream-for-target connection
                                                       :repl-result)))
     (when (eq (connection.communication-style connection) :spawn)
-      (spawn (lambda () (auto-flush-loop out))
-             :name "auto-flush-thread"))
+      (setf (connection.auto-flush-thread connection)
+            (spawn (lambda () (auto-flush-loop out))
+                   :name "auto-flush-thread")))
     (values dedicated-output in out io repl-results)))
 
 ;; FIXME: if wait-for-event aborts the event will stay in the queue forever.
@@ -1197,7 +1198,8 @@
 (defun cleanup-connection-threads (connection)
   (let ((threads (list (connection.repl-thread connection)
                        (connection.reader-thread connection)
-                       (connection.control-thread connection))))
+                       (connection.control-thread connection)
+                       (connection.auto-flush-thread connection))))
     (dolist (thread threads)
       (when (and thread 
                  (thread-alive-p thread)




From heller at common-lisp.net  Tue Dec 23 08:33:13 2008
From: heller at common-lisp.net (CVS User heller)
Date: Tue, 23 Dec 2008 08:33:13 +0000
Subject: [slime-cvs] CVS slime
Message-ID: <E1LF2hU-0002Jl-Re@common-lisp.net>

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

Modified Files:
	ChangeLog slime.el 
Log Message:
* slime.el (slime-run-mode-hooks): Wrapper for Emacs21.
(slime-repl-mode): Use it.
Reported by Peter Denno.

--- /project/slime/cvsroot/slime/ChangeLog	2008/12/23 08:33:02	1.1599
+++ /project/slime/cvsroot/slime/ChangeLog	2008/12/23 08:33:11	1.1600
@@ -1,3 +1,9 @@
+2008-12-23  Helmut Eller  <heller at common-lisp.net>
+
+	* slime.el (slime-run-mode-hooks): Wrapper for Emacs21.
+	(slime-repl-mode): Use it.
+	Reported by Peter Denno.
+
 2008-12-23  Sven Van Caekenberghe <sven at beta9.be>
 
 	* swank.lisp (connection): Add a slot to store the
--- /project/slime/cvsroot/slime/slime.el	2008/12/23 08:32:53	1.1076
+++ /project/slime/cvsroot/slime/slime.el	2008/12/23 08:33:12	1.1077
@@ -2939,7 +2939,7 @@
        'slime-repl-mode-beginning-of-defun)
   (set (make-local-variable 'end-of-defun-function) 
        'slime-repl-mode-end-of-defun)
-  (run-mode-hooks 'slime-repl-mode-hook))
+  (slime-run-mode-hooks 'slime-repl-mode-hook))
 
 (defun slime-repl-buffer (&optional create connection)
   "Get the REPL buffer for the current connection; optionally create."
@@ -9979,6 +9979,11 @@
          (add-hook hook function append t))
         (t (add-hook hook function append t))))
 
+(defun slime-run-mode-hooks (&rest hooks)
+  (if (fboundp 'run-mode-hooks) 
+      (apply #'run-mode-hooks hooks)
+    (apply #'run-hooks hooks)))
+
 (slime-defun-if-undefined next-single-char-property-change
     (position prop &optional object limit)
   (let ((limit (typecase limit




From heller at common-lisp.net  Wed Dec 24 07:56:20 2008
From: heller at common-lisp.net (CVS User heller)
Date: Wed, 24 Dec 2008 07:56:20 +0000
Subject: [slime-cvs] CVS slime
Message-ID: <E1LFObM-0003Zj-QW@common-lisp.net>

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

Modified Files:
	ChangeLog slime.el swank-backend.lisp swank-cmucl.lisp 
	swank.lisp 
Log Message:
Create a repl also for *communication-style* = nil.
Use a custom stream which processes SLIME requests while waiting for
input.

* slime.el (slime-set-connection-info): Don't create a repl
buffer.
(slime-start-lisp): Bind process-connection-type to nil to avoid
problems witht CLISPs readline code.

* swank.lisp (read-non-blocking, make-repl-input-stream)
(simple-repl): New functions.
(simple-serve-requests): Use it.

* swank-backend.lisp (wait-for-one-stream, wait-for-streams): New
functions.
(wait-for-input): Use it to support wainting on multiple streams.

* swank-cmucl.lisp (to-fd-stream): New function.
(wait-for-input): Use it.

--- /project/slime/cvsroot/slime/ChangeLog	2008/12/23 08:33:11	1.1600
+++ /project/slime/cvsroot/slime/ChangeLog	2008/12/24 07:56:20	1.1601
@@ -1,5 +1,23 @@
 2008-12-23  Helmut Eller  <heller at common-lisp.net>
 
+	* slime.el (slime-set-connection-info): Don't create a repl
+	buffer.
+	(slime-start-lisp): Bind process-connection-type to nil to avoid
+	problems witht CLISPs readline code.
+
+	* swank.lisp (read-non-blocking, make-repl-input-stream)
+	(simple-repl): New functions.
+	(simple-serve-requests): Use it.
+
+	* swank-backend.lisp (wait-for-one-stream, wait-for-streams): New
+	functions.
+	(wait-for-input): Use it to support wainting on multiple streams.
+
+	* swank-cmucl.lisp (to-fd-stream): New function.
+	(wait-for-input): Use it.
+
+2008-12-23  Helmut Eller  <heller at common-lisp.net>
+
 	* slime.el (slime-run-mode-hooks): Wrapper for Emacs21.
 	(slime-repl-mode): Use it.
 	Reported by Peter Denno.
--- /project/slime/cvsroot/slime/slime.el	2008/12/23 08:33:12	1.1077
+++ /project/slime/cvsroot/slime/slime.el	2008/12/24 07:56:20	1.1078
@@ -1387,7 +1387,8 @@
     (when directory
       (cd (expand-file-name directory)))
     (comint-mode)
-    (let ((process-environment (append env process-environment)))
+    (let ((process-environment (append env process-environment))
+          (process-connection-type nil))
       (comint-exec (current-buffer) "inferior-lisp" program nil program-args))
     (lisp-mode-variables t)
     (let ((proc (get-buffer-process (current-buffer))))
@@ -2086,8 +2087,8 @@
         (unless (string= (slime-lisp-implementation-name) name)
           (setf (slime-connection-name)
                 (slime-generate-connection-name (symbol-name name)))))
-      (slime-hide-inferior-lisp-buffer)
-      (slime-init-output-buffer connection)
+      ;;(slime-hide-inferior-lisp-buffer)
+      ;;(slime-init-output-buffer connection)
       (slime-load-contribs)
       (run-hooks 'slime-connected-hook)
       (when-let (fun (plist-get args ':init-function))
--- /project/slime/cvsroot/slime/swank-backend.lisp	2008/11/02 12:05:13	1.163
+++ /project/slime/cvsroot/slime/swank-backend.lisp	2008/12/24 07:56:20	1.164
@@ -1065,25 +1065,37 @@
 return nil.
 
 Return :interrupt if an interrupt occurs while waiting."
-  (assert (= (length streams) 1))
-  (let ((stream (car streams)))
-    (case timeout
-      ((nil)
-       (cond ((check-slime-interrupts) :interrupt)
-             (t (peek-char nil stream nil nil) 
-                streams)))
-      ((t) 
-       (let ((c (read-char-no-hang stream nil nil)))
-         (cond (c 
-                (unread-char c stream) 
-                streams)
-               (t '()))))
-      (t 
-       (loop
-        (if (check-slime-interrupts) (return :interrupt))
-        (when (wait-for-input streams t) (return streams))
-        (sleep 0.1)
-        (when (<= (decf timeout 0.1) 0) (return nil)))))))
+  (assert (member timeout '(nil t)))
+  (cond ((null (cdr streams)) 
+         (wait-for-one-stream (car streams) timeout))
+        (t
+         (wait-for-streams streams timeout))))
+
+(defun wait-for-streams (streams timeout)
+  (flet ((readyp (s)
+           (let ((c (read-char-no-hang s nil :eof)))
+             (or (eq c :eof)
+                 (and c (progn (unread-char c s) t))
+                 c))))
+    (loop
+     (let ((ready (remove-if-not #'readyp streams)))
+       (when ready (return ready)))
+     (when timeout (return nil))
+     (when (check-slime-interrupts) (return :interrupt))
+     (sleep 0.1))))
+
+(defun wait-for-one-stream (stream timeout)
+  (ecase timeout
+    ((nil)
+     (cond ((check-slime-interrupts) :interrupt)
+           (t (peek-char nil stream nil nil) 
+              (list stream))))
+    ((t) 
+     (let ((c (read-char-no-hang stream nil nil)))
+       (cond (c 
+              (unread-char c stream) 
+              (list stream))
+             (t '()))))))
 
 (definterface toggle-trace (spec)
   "Toggle tracing of the function(s) given with SPEC.
--- /project/slime/cvsroot/slime/swank-cmucl.lisp	2008/11/02 12:05:13	1.203
+++ /project/slime/cvsroot/slime/swank-cmucl.lisp	2008/12/24 07:56:20	1.204
@@ -200,7 +200,7 @@
    (when timeout (return nil))
    (multiple-value-bind (in out) (make-pipe)
      (let* ((f (constantly t))
-            (handlers (loop for s in (cons in streams)
+            (handlers (loop for s in (cons in (mapcar #'to-fd-stream streams))
                             collect (add-one-shot-handler s f))))
        (unwind-protect
             (handler-bind ((slime-interrupt-queued 
@@ -211,6 +211,15 @@
          (close in)
          (close out))))))
 
+(defun to-fd-stream (stream)
+  (etypecase stream
+    (sys:fd-stream stream)
+    (synonym-stream 
+     (to-fd-stream 
+      (symbol-value (synonym-stream-symbol stream))))
+    (two-way-stream 
+     (to-fd-stream (two-way-stream-input-stream stream)))))
+     
 (defun add-one-shot-handler (stream function)
   (let (handler)
     (setq handler (sys:add-fd-handler (sys:fd-stream-fd stream) :input
--- /project/slime/cvsroot/slime/swank.lisp	2008/12/23 08:33:03	1.613
+++ /project/slime/cvsroot/slime/swank.lisp	2008/12/24 07:56:20	1.614
@@ -493,12 +493,24 @@
 (defvar *log-output* nil) ; should be nil for image dumpers
 
 (defun init-log-output ()
-  (labels ((deref (x)
-             (cond ((typep x 'synonym-stream)
-                    (deref (symbol-value (synonym-stream-symbol x))))
-                   (t x))))
-    (unless *log-output*
-      (setq *log-output* (deref *error-output*)))))
+  (unless *log-output*
+    (setq *log-output* (real-output-stream *error-output*))))
+
+(defun real-input-stream (stream)
+  (typecase stream
+    (synonym-stream 
+     (real-input-stream (symbol-value (synonym-stream-symbol stream))))
+    (two-way-stream
+     (real-input-stream (two-way-stream-input-stream stream)))
+    (t stream)))
+
+(defun real-output-stream (stream)
+  (typecase stream
+    (synonym-stream 
+     (real-output-stream (symbol-value (synonym-stream-symbol stream))))
+    (two-way-stream
+     (real-output-stream (two-way-stream-output-stream stream)))
+    (t stream)))
 
 (add-hook *after-init-hook* 'init-log-output)
 
@@ -1261,9 +1273,49 @@
           (invoke-or-queue-interrupt #'dispatch-interrupt-event))
         (lambda ()
           (with-simple-restart (close-connection "Close SLIME connection")
-            (handle-requests connection))))
+            ;;(handle-requests connection)
+            (let* ((stdin (real-input-stream *standard-input*))
+                   (*standard-input* (make-repl-input-stream connection 
+                                                             stdin)))
+              (simple-repl)))))
     (close-connection connection nil (safe-backtrace))))
 
+(defun simple-repl ()
+  (loop
+   (with-simple-restart (abort "Abort")
+     (format t "~&~a> " (package-string-for-prompt *package*))
+     (force-output)
+     (let ((form (read)))
+       (fresh-line)
+       (let ((- form)
+             (values (multiple-value-list (eval form))))
+         (setq *** **  ** *  * (car values)
+               /// //  // /  / values
+               +++ ++  ++ +  + form)
+         (cond ((null values) (format t "~&; No values"))
+               (t (mapc (lambda (v) (format t "~&~s" v)) values))))))))
+
+(defun make-repl-input-stream (connection stdin)
+  (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)))))))))
+
+(defun read-non-blocking (stream)
+  (with-output-to-string (str)
+    (loop (let ((c (read-char-no-hang stream)))
+            (unless c (return))
+            (write-char c str)))))
+
 (defun initialize-streams-for-connection (connection)
   (multiple-value-bind (dedicated in out io repl-results) 
       (open-streams connection)




From heller at common-lisp.net  Wed Dec 24 08:06:30 2008
From: heller at common-lisp.net (CVS User heller)
Date: Wed, 24 Dec 2008 08:06:30 +0000
Subject: [slime-cvs] CVS slime
Message-ID: <E1LFOlC-0005Pf-BQ@common-lisp.net>

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

Modified Files:
	ChangeLog slime.el 
Log Message:
Move most of the REPL mode to contrib.
Disable some commands that depend on the
existence of a REPL buffer.



--- /project/slime/cvsroot/slime/ChangeLog	2008/12/24 07:56:20	1.1601
+++ /project/slime/cvsroot/slime/ChangeLog	2008/12/24 08:06:25	1.1602
@@ -1,5 +1,11 @@
 2008-12-23  Helmut Eller  <heller at common-lisp.net>
 
+	Move most of the REPL mode to contrib.
+	Disable some commands that depend on the
+	existence of a REPL buffer.
+
+2008-12-23  Helmut Eller  <heller at common-lisp.net>
+
 	* slime.el (slime-set-connection-info): Don't create a repl
 	buffer.
 	(slime-start-lisp): Bind process-connection-type to nil to avoid
--- /project/slime/cvsroot/slime/slime.el	2008/12/24 07:56:20	1.1078
+++ /project/slime/cvsroot/slime/slime.el	2008/12/24 08:06:25	1.1079
@@ -339,63 +339,6 @@
   (local-value    "local variable values")
   (catch-tag      "catch tags"))
 
-;;;;; slime-repl
-
-(defgroup slime-repl nil
-  "The Read-Eval-Print Loop (*slime-repl* buffer)."
-  :prefix "slime-repl-"
-  :group 'slime)
-
-(defcustom slime-repl-shortcut-dispatch-char ?\,
-  "Character used to distinguish repl commands from lisp forms."
-  :type '(character)
-  :group 'slime-repl)
-
-(defcustom slime-repl-only-save-lisp-buffers t
-  "When T we only attempt to save lisp-mode file buffers. When
-  NIL slime will attempt to save all buffers (as per
-  save-some-buffers). This applies to all ASDF related repl
-  shortcuts."
-  :type '(boolean)
-  :group 'slime-repl)
-
-(defface slime-repl-prompt-face
-  (if (slime-face-inheritance-possible-p)
-      '((t (:inherit font-lock-keyword-face)))
-    '((((class color) (background light)) (:foreground "Purple"))
-      (((class color) (background dark)) (:foreground "Cyan"))
-      (t (:weight bold))))
-  "Face for the prompt in the SLIME REPL."
-  :group 'slime-repl)
-
-(defface slime-repl-output-face
-  (if (slime-face-inheritance-possible-p)
-      '((t (:inherit font-lock-string-face)))
-    '((((class color) (background light)) (:foreground "RosyBrown"))
-      (((class color) (background dark)) (:foreground "LightSalmon"))
-      (t (:slant italic))))
-  "Face for Lisp output in the SLIME REPL."
-  :group 'slime-repl)
-
-(defface slime-repl-input-face
-  '((t (:bold t)))
-  "Face for previous input in the SLIME REPL."
-  :group 'slime-repl)
-
-(defface slime-repl-result-face
-  '((t ()))
-  "Face for the result of an evaluation in the SLIME REPL."
-  :group 'slime-repl)
-
-(defcustom slime-repl-history-file "~/.slime-history.eld"
-  "File to save the persistent REPL history to."
-  :type 'string
-  :group 'slime-repl)
-
-(defcustom slime-repl-history-size 200
-  "*Maximum number of lines for persistent REPL history."
-  :type 'integer
-  :group 'slime-repl)
 
 
 ;;;; Minor modes
@@ -589,7 +532,7 @@
     ("\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-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)
     ;; Documentation
@@ -603,13 +546,12 @@
     ("\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)
+    ;;("\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-]" slime-close-all-parens-in-sexp :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)
     ;; ;; Shadow unwanted bindings from inf-lisp
@@ -919,6 +861,13 @@
   (slime-with-rigid-indentation nil
     (apply #'insert strings)))
 
+(defun slime-property-bounds (prop)
+  "Return two the positions of the previous and next changes to PROP.
+PROP is the name of a text property."
+  (assert (get-text-property (point) prop))
+  (let ((end (next-single-char-property-change (point) prop)))
+    (list (previous-single-char-property-change end prop) end)))
+
 (defun slime-curry (fun &rest args)
   `(lambda (&rest more) (apply ',fun (append ',args more))))
 
@@ -1075,7 +1024,7 @@
   nil
   (" Slime-Tmp" slime-modeline-string)
   '(("q" . slime-popup-buffer-quit-function)
-    ("\C-c\C-z" . slime-switch-to-output-buffer)
+    ;;("\C-c\C-z" . slime-switch-to-output-buffer)
     ("\M-." . slime-edit-definition)))
 
 (make-variable-buffer-local
@@ -1277,16 +1226,16 @@
            (slime-dispatching-connection process))
       (slime-setup-connection process))))
 
-(defun slime-start-and-load (filename &optional package)
-  "Start Slime, if needed, load the current file and set the package."
-  (interactive (list (expand-file-name (buffer-file-name))
-                     (slime-find-buffer-package)))
-  (cond ((slime-connected-p)
-         (slime-load-file-set-package filename package))
-        (t
-         (slime-start-and-init (slime-lisp-options)
-                               (slime-curry #'slime-start-and-load 
-                                            filename package)))))
+;;(defun slime-start-and-load (filename &optional package)
+;;  "Start Slime, if needed, load the current file and set the package."
+;;  (interactive (list (expand-file-name (buffer-file-name))
+;;                     (slime-find-buffer-package)))
+;;  (cond ((slime-connected-p)
+;;         (slime-load-file-set-package filename package))
+;;        (t
+;;         (slime-start-and-init (slime-lisp-options)
+;;                               (slime-curry #'slime-start-and-load 
+;;                                            filename package)))))
 
 (defun slime-start-and-init (options fun)
   (let* ((rest (plist-get options :init-function))
@@ -1294,12 +1243,12 @@
                      (t fun))))
     (slime-start* (plist-put (copy-list options) :init-function init))))
 
-(defun slime-load-file-set-package (filename package)
-  (let ((filename (slime-to-lisp-filename filename)))
-    (slime-eval-async `(swank:load-file ,filename)
-                      (lexical-let ((package package))
-                        (lambda (ignored)
-                          (slime-repl-set-package package))))))
+;;(defun slime-load-file-set-package (filename package)
+;;  (let ((filename (slime-to-lisp-filename filename)))
+;;    (slime-eval-async `(swank:load-file ,filename)
+;;                      (lexical-let ((package package))
+;;                        (lambda (ignored)
+;;                          (slime-repl-set-package package))))))
 
 ;;;;; Start inferior lisp
 ;;;
@@ -1380,6 +1329,9 @@
          (equal (plist-get args :env) env)
          (not (y-or-n-p "Create an additional *inferior-lisp*? ")))))
 
+(defvar slime-inferior-process-start-hook nil
+  "Hook called whenever a new process gets started.")
+
 (defun slime-start-lisp (program program-args env directory buffer)
   "Does the same as `inferior-lisp' but less ugly.
 Return the created process."
@@ -1393,6 +1345,7 @@
     (lisp-mode-variables t)
     (let ((proc (get-buffer-process (current-buffer))))
       (slime-set-query-on-exit-flag proc)
+      (run-hooks 'slime-inferior-process-start-hook)
       proc)))
 
 (defun slime-inferior-connect (process args)
@@ -1515,24 +1468,6 @@
         (assert (integerp port))
         port))))
 
-(defun slime-hide-inferior-lisp-buffer ()
-  "Display the REPL buffer instead of the *inferior-lisp* buffer."
-  (let* ((buffer (if (slime-process) 
-                     (process-buffer (slime-process))))
-         (window (if buffer (get-buffer-window buffer t)))
-         (repl-buffer (slime-output-buffer t))
-         (repl-window (get-buffer-window repl-buffer)))
-    (when buffer
-      (bury-buffer buffer))
-    (cond (repl-window
-           (when window
-             (delete-window window)))
-          (window
-           (set-window-buffer window repl-buffer))
-          (t
-           (pop-to-buffer repl-buffer)
-           (goto-char (point-max))))))
-
 ;;; Words of encouragement
 
 (defun slime-user-first-name ()
@@ -1665,13 +1600,6 @@
       (assert default-enable-multibyte-characters))
     t))
 
-(defcustom slime-repl-history-file-coding-system 
-  (cond ((slime-find-coding-system 'utf-8-unix) 'utf-8-unix)
-        (t slime-net-coding-system))
-  "*The coding system for the history file."
-  :type 'symbol
-  :group 'slime-repl)
-
 (defun slime-coding-system-mulibyte-p (coding-system)
   (second (slime-find-coding-system coding-system)))
 
@@ -1918,8 +1846,8 @@
                    slime-net-processes))
          (p (car tail)))
     (slime-select-connection p)
-    (unless (eq major-mode 'slime-repl-mode)
-      (setq slime-buffer-connection p))
+;;    (unless (eq major-mode 'slime-repl-mode)
+;;      (setq slime-buffer-connection p))
     (message "Lisp: %s %s" (slime-connection-name p) (process-contact p))))
 
 (defmacro* slime-with-connection-buffer ((&optional process) &rest body)
@@ -2087,8 +2015,6 @@
         (unless (string= (slime-lisp-implementation-name) name)
           (setf (slime-connection-name)
                 (slime-generate-connection-name (symbol-name name)))))
-      ;;(slime-hide-inferior-lisp-buffer)
-      ;;(slime-init-output-buffer connection)
       (slime-load-contribs)
       (run-hooks 'slime-connected-hook)
       (when-let (fun (plist-get args ':init-function))
@@ -2158,7 +2084,8 @@
 (defun slime-background-activities-enabled-p ()
   (and (or slime-mode 
            (eq major-mode 'sldb-mode)
-           (eq major-mode 'slime-repl-mode))
+           ;;(eq major-mode 'slime-repl-mode)
+           )
        (let ((con (slime-current-connection)))
          (and con
               (eq (process-status con) 'open)))
@@ -2264,8 +2191,8 @@
 search for and read an `in-package' form.
 
 The REPL buffer is a special case: its package is `slime-lisp-package'."
-  (cond ((eq major-mode 'slime-repl-mode)
-         (slime-lisp-package))
+  (cond ;;((eq major-mode 'slime-repl-mode)
+        ;; (slime-lisp-package))
         (slime-buffer-package)
         (t (save-restriction
              (widen)
@@ -2374,15 +2301,6 @@
                (slime-rex-continuations)
                :key #'car)))
 
-
-;; dummy defvar for compiler
-(defvar slime-repl-read-mode)
-
-(defun slime-reading-p ()
-  "True if Lisp is currently reading input from the REPL."
-  (with-current-buffer (slime-output-buffer)
-    slime-repl-read-mode))
-
 (defun slime-sync ()
   "Block until the most recent request has finished."
   (when (slime-rex-continuations)
@@ -2418,8 +2336,8 @@
   (let ((slime-dispatching-connection (or process (slime-connection))))
     (or (run-hook-with-args-until-success 'slime-event-hooks event)
         (destructure-case event
-          ((:write-string output &optional target)
-           (slime-write-string output target))
+          ;;((:write-string output &optional target)
+          ;; (slime-write-string output target))
           ((:emacs-rex form package thread continuation)
            (when (and (slime-use-sigint-for-interrupt) (slime-busy-p))
              (slime-display-oneliner "; pipelined request... %S" form))
@@ -2446,14 +2364,14 @@
            (sldb-exit thread level stepping))
           ((:emacs-interrupt thread)
            (slime-send `(:emacs-interrupt ,thread)))
-          ((:read-string thread tag)
-           (assert thread)
-           (slime-repl-read-string thread tag))
+;;          ((:read-string thread tag)
+;;           (assert thread)
+;;           (slime-repl-read-string thread tag))
           ((:y-or-n-p thread tag question)
            (slime-y-or-n-p thread tag question))
-          ((:read-aborted thread tag)
-           (assert thread)
-           (slime-repl-abort-read thread tag))
+;;          ((:read-aborted thread tag)
+;;           (assert thread)
+;;           (slime-repl-abort-read thread tag))
           ((:emacs-return-string thread tag string)
            (slime-send `(:emacs-return-string ,thread ,tag ,string)))
           ;;
@@ -2464,8 +2382,8 @@
            (setf (slime-lisp-features) features))
           ((:indentation-update info)
            (slime-handle-indentation-update info))
-          ((:open-dedicated-output-stream port)
-           (slime-open-stream-to-lisp port))
+          ;;((:open-dedicated-output-stream port)
+          ;; (slime-open-stream-to-lisp port))
           ((:eval-no-wait fun args)
            (apply (intern fun) args))
           ((:eval thread tag form-string)
@@ -2556,1288 +2474,9 @@
             (outline-minor-mode)))
         buffer)))
 
-
-;;;; Stream output
-
-(slime-def-connection-var slime-connection-output-buffer nil
-  "The buffer for the REPL.  May be nil or a dead buffer.")
-
-(make-variable-buffer-local
- (defvar slime-output-start nil
-   "Marker for the start of the output for the evaluation."))
-
-(make-variable-buffer-local
- (defvar slime-output-end nil
-   "Marker for end of output. New output is inserted at this mark."))
-
-;; dummy definitions for the compiler
-(defvar slime-repl-package-stack)
-(defvar slime-repl-directory-stack)
-(defvar slime-repl-input-start-mark)
-(defvar slime-repl-prompt-start-mark)
-
-(defun slime-output-buffer (&optional noprompt)
-  "Return the output buffer, create it if necessary."
-  (let ((buffer (slime-connection-output-buffer)))
-    (or (if (buffer-live-p buffer) buffer)
-        (setf (slime-connection-output-buffer)
-              (let ((connection (slime-connection)))
-                (with-current-buffer (slime-repl-buffer t connection)
-                  (unless (eq major-mode 'slime-repl-mode) 
-                    (slime-repl-mode))
-                  (setq slime-buffer-connection connection)
-                  (slime-reset-repl-markers)
-                  (unless noprompt 
-                    (slime-repl-insert-prompt))
-                  (current-buffer)))))))
-
-(defvar slime-repl-banner-function 'slime-repl-insert-banner)
-
-(defun slime-repl-update-banner ()
-  (funcall slime-repl-banner-function)
-  (goto-char (point-max))
-  (slime-mark-output-start)
-  (slime-mark-input-start)
-  (slime-repl-insert-prompt))
-
-(defun slime-repl-insert-banner ()
-  (when (zerop (buffer-size))
-    (let ((welcome (concat "; SLIME " (or (slime-changelog-date)
-                                          "- ChangeLog file not found"))))
-      (insert welcome))))
-
-(defun slime-init-output-buffer (connection)
-  (with-current-buffer (slime-output-buffer t)
-    (setq slime-buffer-connection connection
-          slime-repl-directory-stack '()
-          slime-repl-package-stack '())
-    (slime-repl-update-banner)))
-
-(defun slime-display-output-buffer ()
-  "Display the output buffer and scroll to bottom."
-  (with-current-buffer (slime-output-buffer)
-    (goto-char (point-max))
-    (unless (get-buffer-window (current-buffer) t)
-      (display-buffer (current-buffer) t))
-    (slime-repl-show-maximum-output)))
-
-(defmacro slime-with-output-end-mark (&rest body)
-  "Execute BODY at `slime-output-end'.  
-
-If point is initially at `slime-output-end' and the buffer is visible
-update window-point afterwards.  If point is initially not at
-`slime-output-end, execute body inside a `save-excursion' block."
-  `(let ((body.. (lambda () , at body))
-         (updatep.. (and (eobp) (pos-visible-in-window-p))))
-     (cond ((= (point) slime-output-end)
-            (let ((start.. (point)))
-              (funcall body..)
-              (set-marker slime-output-end (point))
-              (when (= start.. slime-repl-input-start-mark) 
-                (set-marker slime-repl-input-start-mark (point)))))
-           (t 

[2097 lines skipped]




From heller at common-lisp.net  Wed Dec 24 08:07:03 2008
From: heller at common-lisp.net (CVS User heller)
Date: Wed, 24 Dec 2008 08:07:03 +0000
Subject: [slime-cvs] CVS slime/contrib
Message-ID: <E1LFOlj-0005Sc-MN@common-lisp.net>

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

Added Files:
	slime-repl.el 
Log Message:
Move most of the REPL mode to contrib.
Disable some commands that depend on the
existence of a REPL buffer.




--- /project/slime/cvsroot/slime/contrib/slime-repl.el	2008/12/24 08:07:03	NONE
+++ /project/slime/cvsroot/slime/contrib/slime-repl.el	2008/12/24 08:07:03	1.1

;;;;; slime-repl

(defgroup slime-repl nil
  "The Read-Eval-Print Loop (*slime-repl* buffer)."
  :prefix "slime-repl-"
  :group 'slime)

(defcustom slime-repl-shortcut-dispatch-char ?\,
  "Character used to distinguish repl commands from lisp forms."
  :type '(character)
  :group 'slime-repl)

(defcustom slime-repl-only-save-lisp-buffers t
  "When T we only attempt to save lisp-mode file buffers. When
  NIL slime will attempt to save all buffers (as per
  save-some-buffers). This applies to all ASDF related repl
  shortcuts."
  :type '(boolean)
  :group 'slime-repl)

(defface slime-repl-prompt-face
  (if (slime-face-inheritance-possible-p)
      '((t (:inherit font-lock-keyword-face)))
    '((((class color) (background light)) (:foreground "Purple"))
      (((class color) (background dark)) (:foreground "Cyan"))
      (t (:weight bold))))
  "Face for the prompt in the SLIME REPL."
  :group 'slime-repl)

(defface slime-repl-output-face
  (if (slime-face-inheritance-possible-p)
      '((t (:inherit font-lock-string-face)))
    '((((class color) (background light)) (:foreground "RosyBrown"))
      (((class color) (background dark)) (:foreground "LightSalmon"))
      (t (:slant italic))))
  "Face for Lisp output in the SLIME REPL."
  :group 'slime-repl)

(defface slime-repl-input-face
  '((t (:bold t)))
  "Face for previous input in the SLIME REPL."
  :group 'slime-repl)

(defface slime-repl-result-face
  '((t ()))
  "Face for the result of an evaluation in the SLIME REPL."
  :group 'slime-repl)

(defcustom slime-repl-history-file "~/.slime-history.eld"
  "File to save the persistent REPL history to."
  :type 'string
  :group 'slime-repl)

(defcustom slime-repl-history-size 200
  "*Maximum number of lines for persistent REPL history."
  :type 'integer
  :group 'slime-repl)

(defcustom slime-repl-history-file-coding-system 
  (cond ((slime-find-coding-system 'utf-8-unix) 'utf-8-unix)
        (t slime-net-coding-system))
  "*The coding system for the history file."
  :type 'symbol
  :group 'slime-repl)


;; dummy defvar for compiler
(defvar slime-repl-read-mode)

(defun slime-reading-p ()
  "True if Lisp is currently reading input from the REPL."
  (with-current-buffer (slime-output-buffer)
    slime-repl-read-mode))


;;;; Stream output

(slime-def-connection-var slime-connection-output-buffer nil
  "The buffer for the REPL.  May be nil or a dead buffer.")

(make-variable-buffer-local
 (defvar slime-output-start nil
   "Marker for the start of the output for the evaluation."))

(make-variable-buffer-local
 (defvar slime-output-end nil
   "Marker for end of output. New output is inserted at this mark."))

;; dummy definitions for the compiler
(defvar slime-repl-package-stack)
(defvar slime-repl-directory-stack)
(defvar slime-repl-input-start-mark)
(defvar slime-repl-prompt-start-mark)

(defun slime-output-buffer (&optional noprompt)
  "Return the output buffer, create it if necessary."
  (let ((buffer (slime-connection-output-buffer)))
    (or (if (buffer-live-p buffer) buffer)
        (setf (slime-connection-output-buffer)
              (let ((connection (slime-connection)))
                (with-current-buffer (slime-repl-buffer t connection)
                  (unless (eq major-mode 'slime-repl-mode) 
                    (slime-repl-mode))
                  (setq slime-buffer-connection connection)
                  (slime-reset-repl-markers)
                  (unless noprompt 
                    (slime-repl-insert-prompt))
                  (current-buffer)))))))

(defvar slime-repl-banner-function 'slime-repl-insert-banner)

(defun slime-repl-update-banner ()
  (funcall slime-repl-banner-function)
  (goto-char (point-max))
  (slime-mark-output-start)
  (slime-mark-input-start)
  (slime-repl-insert-prompt))

(defun slime-repl-insert-banner ()
  (when (zerop (buffer-size))
    (let ((welcome (concat "; SLIME " (or (slime-changelog-date)
                                          "- ChangeLog file not found"))))
      (insert welcome))))

(defun slime-init-output-buffer (connection)
  (with-current-buffer (slime-output-buffer t)
    (setq slime-buffer-connection connection
          slime-repl-directory-stack '()
          slime-repl-package-stack '())
    (slime-repl-update-banner)))

(defun slime-display-output-buffer ()
  "Display the output buffer and scroll to bottom."
  (with-current-buffer (slime-output-buffer)
    (goto-char (point-max))
    (unless (get-buffer-window (current-buffer) t)
      (display-buffer (current-buffer) t))
    (slime-repl-show-maximum-output)))

(defmacro slime-with-output-end-mark (&rest body)
  "Execute BODY at `slime-output-end'.  

If point is initially at `slime-output-end' and the buffer is visible
update window-point afterwards.  If point is initially not at
`slime-output-end, execute body inside a `save-excursion' block."
  `(let ((body.. (lambda () , at body))
         (updatep.. (and (eobp) (pos-visible-in-window-p))))
     (cond ((= (point) slime-output-end)
            (let ((start.. (point)))
              (funcall body..)
              (set-marker slime-output-end (point))
              (when (= start.. slime-repl-input-start-mark) 
                (set-marker slime-repl-input-start-mark (point)))))
           (t 
            (save-excursion 
              (goto-char slime-output-end)
              (funcall body..))))
     (when updatep..
       (slime-repl-show-maximum-output))))

(defun slime-output-filter (process string)
  (with-current-buffer (process-buffer process)
    (when (and (plusp (length string))
               (eq (process-status slime-buffer-connection) 'open))
      (slime-write-string string))))

(defvar slime-open-stream-hooks)

(defun slime-open-stream-to-lisp (port)
  (let ((stream (open-network-stream "*lisp-output-stream*" 
                                     (slime-with-connection-buffer ()
                                       (current-buffer))
				     slime-lisp-host port)))
    (slime-set-query-on-exit-flag stream)
    (set-process-filter stream 'slime-output-filter)
    (let ((pcs (process-coding-system (slime-current-connection))))
      (set-process-coding-system stream (car pcs) (cdr pcs)))
    (when-let (secret (slime-secret))
      (slime-net-send secret stream))
    (run-hook-with-args 'slime-open-stream-hooks stream)
    stream))

(defun slime-io-speed-test (&optional profile)
  "A simple minded benchmark for stream performance.
If a prefix argument is given, instrument the slime package for
profiling before running the benchmark."
  (interactive "P")
  (eval-and-compile
    (require 'elp))
  (elp-reset-all)
  (elp-restore-all)
  (load "slime.el")
  ;;(byte-compile-file "slime-net.el" t)
  ;;(setq slime-log-events nil)
  (setq slime-enable-evaluate-in-emacs t)
  ;;(setq slime-repl-enable-presentations nil)
  (when profile
    (elp-instrument-package "slime-"))
  (kill-buffer (slime-output-buffer))
  (switch-to-buffer (slime-output-buffer))
  (delete-other-windows)
  (sit-for 0)
  (slime-repl-send-string "(swank:io-speed-test 4000 1)")
  (let ((proc (slime-inferior-process)))
    (when proc
      (display-buffer (process-buffer proc) t)
      (goto-char (point-max)))))

(defvar slime-write-string-function 'slime-repl-write-string)

(defun slime-write-string (string &optional target)
  "Insert STRING in the REPL buffer or some other TARGET.
If TARGET is nil, insert STRING as regular process
output.  If TARGET is :repl-result, insert STRING as the result of the
evaluation.  Other values of TARGET map to an Emacs marker via the 
hashtable `slime-output-target-to-marker'; output is inserted at this marker."
  (funcall slime-write-string-function string target))

(defun slime-repl-write-string (string &optional target)
  (case target
    ((nil) (slime-repl-emit string))
    (:repl-result (slime-repl-emit-result string))
    (t (slime-emit-string string target))))

(defvar slime-repl-popup-on-output nil
  "Display the output buffer when some output is written.
This is set to nil after displaying the buffer.")

(defmacro slime-save-marker (marker &rest body)
  (let ((pos (gensym "pos")))
  `(let ((,pos (marker-position ,marker)))
     (prog1 (progn . ,body)
       (set-marker ,marker ,pos)))))

(put 'slime-save-marker 'lisp-indent-function 1)

(defun slime-repl-emit (string)
  ;; insert the string STRING in the output buffer
  (with-current-buffer (slime-output-buffer)
    (save-excursion
      (goto-char slime-output-end)
      (slime-save-marker slime-output-start
        (slime-propertize-region '(face slime-repl-output-face 
                                        rear-nonsticky (face))
          (insert-before-markers string)
          (when (and (= (point) slime-repl-prompt-start-mark)
                     (not (bolp)))
            (insert-before-markers "\n")
            (set-marker slime-output-end (1- (point)))))))
    (when slime-repl-popup-on-output
      (setq slime-repl-popup-on-output nil)
      (display-buffer (current-buffer)))
    (slime-repl-show-maximum-output)))

(defun slime-repl-emit-result (string &optional bol)
  ;; insert STRING and mark it as evaluation result
  (with-current-buffer (slime-output-buffer)
    (save-excursion
      (slime-save-marker slime-output-start
        (slime-save-marker slime-output-end
          (goto-char slime-repl-input-start-mark)
          (when (and bol (not (bolp))) (insert-before-markers "\n"))
          (slime-propertize-region `(face slime-repl-result-face
                                          rear-nonsticky (face))
            (insert-before-markers string)))))
    (slime-repl-show-maximum-output)))

(defvar slime-last-output-target-id 0
  "The last integer we used as a TARGET id.")

(defvar slime-output-target-to-marker
  (make-hash-table)
  "Map from TARGET ids to Emacs markers.
The markers indicate where output should be inserted.")

(defun slime-output-target-marker (target)
  "Return the marker where output for TARGET should be inserted."
  (case target
    ((nil)
     (with-current-buffer (slime-output-buffer)
       slime-output-end))
    (:repl-result
     (with-current-buffer (slime-output-buffer)
       slime-repl-input-start-mark))
    (t
     (gethash target slime-output-target-to-marker))))

(defun slime-emit-string (string target)
  "Insert STRING at target TARGET.
See `slime-output-target-to-marker'."
  (let* ((marker (slime-output-target-marker target))
         (buffer (and marker (marker-buffer marker))))
    (when buffer
      (with-current-buffer buffer
        (save-excursion 
          ;; Insert STRING at MARKER, then move MARKER behind
          ;; the insertion.
          (goto-char marker)
          (insert-before-markers string)
          (set-marker marker (point)))))))

(defun slime-switch-to-output-buffer ()
  "Select the output buffer, when possible in an existing window.

Hint: You can use `display-buffer-reuse-frames' and
`special-display-buffer-names' to customize the frame in which
the buffer should appear."
  (interactive)
  (slime-pop-to-buffer (slime-output-buffer))
  (goto-char (point-max)))


;;;; REPL
;;
;; The REPL uses some markers to separate input from output.  The
;; usual configuration is as follows:
;; 
;;    ... output ...    ... result ...    prompt> ... input ...
;;    ^            ^                      ^       ^           ^
;;    output-start output-end  prompt-start       input-start point-max
;;
;; input-start is a right inserting marker, because
;; we want it to stay behind when the user inserts text.
;;
;; We maintain the following invariant:
;;
;;  output-start <= output-end <= input-start.
;;
;; This invariant is important, because we must be prepared for
;; asynchronous output and asynchronous reads.  ("Asynchronous" means,
;; triggered by Lisp and not by Emacs.)
;;
;; All output is inserted at the output-end marker.  Some care must be
;; taken when output-end and input-start are at the same position: if
;; we insert at that point, we must move the right markers.  We should
;; also not leave (window-)point in the middle of the new output.  The
;; idiom we use is a combination to slime-save-marker,
;; insert-before-markers, and manually updating window-point
;; afterwards.
;;
;; A "synchronous" evaluation request proceeds as follows: the user
;; inserts some text between input-start and point-max and then hits
;; return.  We send that region to Lisp, move the output and input
;; makers to the line after the input and wait.  When we receive the
;; result, we insert it together with a prompt between the output-end
;; and input-start mark.  See `slime-repl-insert-prompt'.
;;
;; It is possible that some output for such an evaluation request
;; arrives after the result.  This output is inserted before the
;; result (and before the prompt). 
;;
;; If we are in "reading" state, e.g., during a call to Y-OR-N-P,
;; there is no prompt between output-end and input-start.
;;

(slime-make-variables-buffer-local
 (defvar slime-repl-package-stack nil
   "The stack of packages visited in this repl.")

 (defvar slime-repl-directory-stack nil
   "The stack of default directories associated with this repl.")

 (defvar slime-repl-prompt-start-mark)
 (defvar slime-repl-input-start-mark)
 (defvar slime-repl-old-input-counter 0
   "Counter used to generate unique `slime-repl-old-input' properties.
This property value must be unique to avoid having adjacent inputs be
joined together."))

(defun slime-reset-repl-markers ()
  (dolist (markname '(slime-output-start
                      slime-output-end
                      slime-repl-prompt-start-mark
                      slime-repl-input-start-mark))
    (set markname (make-marker))
    (set-marker (symbol-value markname) (point))))

;;;;; REPL mode setup

(defvar slime-repl-mode-map)

(setq slime-repl-mode-map (make-sparse-keymap))
(set-keymap-parent slime-repl-mode-map lisp-mode-map)

(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-repl-mode-map
  ("\C-m" 'slime-repl-return)
  ([return] 'slime-repl-return)
  ("\C-j" 'slime-repl-newline-and-indent)
  ("\C-\M-m" 'slime-repl-closing-return)
  ([(control return)] 'slime-repl-closing-return)
  ("\C-a" 'slime-repl-bol)
  ([home] 'slime-repl-bol)

[1331 lines skipped]



From heller at common-lisp.net  Wed Dec 24 08:13:43 2008
From: heller at common-lisp.net (CVS User heller)
Date: Wed, 24 Dec 2008 08:13:43 +0000
Subject: [slime-cvs] CVS slime/contrib
Message-ID: <E1LFOsB-0006zT-75@common-lisp.net>

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

Modified Files:
	ChangeLog slime-fancy.el 
Log Message:
* slime-fancy.el: Add slime-repl.

--- /project/slime/cvsroot/slime/contrib/ChangeLog	2008/12/09 18:29:06	1.143
+++ /project/slime/cvsroot/slime/contrib/ChangeLog	2008/12/24 08:13:43	1.144
@@ -1,3 +1,8 @@
+2008-12-23  Helmut Eller  <heller at common-lisp.net>
+2008-12-23  Helmut Eller  <heller at common-lisp.net>
+
+	* slime-fancy.el: Add slime-repl.
+
 2008-12-09  Helmut Eller  <heller at common-lisp.net>
 
 	* swank-kawa.scm (mif): Avoid assignments because that triggers a
--- /project/slime/cvsroot/slime/contrib/slime-fancy.el	2008/08/20 21:46:09	1.7
+++ /project/slime/cvsroot/slime/contrib/slime-fancy.el	2008/12/24 08:13:43	1.8
@@ -17,6 +17,9 @@
 ;;   * Adding new commands, keybindings, menu items
 ;;   * Making things clickable that would otherwise be just plain text
 
+(require 'slime-repl)
+(slime-repl-init)
+
 ;; Better arglist display, can be turned off by customization.
 (require 'slime-autodoc)
 (slime-autodoc-init)




From heller at common-lisp.net  Wed Dec 24 08:13:47 2008
From: heller at common-lisp.net (CVS User heller)
Date: Wed, 24 Dec 2008 08:13:47 +0000
Subject: [slime-cvs] CVS slime/contrib
Message-ID: <E1LFOsF-000704-FH@common-lisp.net>

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

Modified Files:
	ChangeLog inferior-slime.el 
Log Message:
* inferior-slime.el (inferior-slime-hook-function): New function.
(inferior-slime-init): Automatically enable it in the
*inferior-lisp* buffer.

--- /project/slime/cvsroot/slime/contrib/ChangeLog	2008/12/24 08:13:43	1.144
+++ /project/slime/cvsroot/slime/contrib/ChangeLog	2008/12/24 08:13:47	1.145
@@ -1,4 +1,9 @@
 2008-12-23  Helmut Eller  <heller at common-lisp.net>
+
+	* inferior-slime.el (inferior-slime-hook-function): New function.
+	(inferior-slime-init): Automatically enable it in the
+	*inferior-lisp* buffer.
+
 2008-12-23  Helmut Eller  <heller at common-lisp.net>
 
 	* slime-fancy.el: Add slime-repl.
--- /project/slime/cvsroot/slime/contrib/inferior-slime.el	2007/09/10 21:44:48	1.2
+++ /project/slime/cvsroot/slime/contrib/inferior-slime.el	2008/12/24 08:13:47	1.3
@@ -71,11 +71,14 @@
 
 (defun inferior-slime-init-keymap ()
   (let ((map inferior-slime-mode-map))
-    (define-key map [return] 'inferior-slime-return)
-    (define-key map [(control return)] 'inferior-slime-closing-return)
-    (define-key map [(meta control ?m)] 'inferior-slime-closing-return)
-    (define-key map "\C-c\C-d" slime-doc-map)
-    (define-key map "\C-c\C-w" slime-who-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
@@ -85,4 +88,10 @@
 
 (inferior-slime-init-keymap)
 
+(defun inferior-slime-hook-function ()
+  (inferior-slime-mode))
+
+(defun inferior-slime-init ()
+  (add-hook 'slime-inferior-process-start-hook 'inferior-slime-hook-function))
+
 (provide 'inferior-slime)




From heller at common-lisp.net  Wed Dec 24 08:13:52 2008
From: heller at common-lisp.net (CVS User heller)
Date: Wed, 24 Dec 2008 08:13:52 +0000
Subject: [slime-cvs] CVS slime/contrib
Message-ID: <E1LFOsK-00070p-Gs@common-lisp.net>

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

Modified Files:
	ChangeLog slime-editing-commands.el 
Log Message:
* slime-editing-commands.el (slime-editing-commands-init): Bind
slime-close-all-parens-in-sexp.

--- /project/slime/cvsroot/slime/contrib/ChangeLog	2008/12/24 08:13:47	1.145
+++ /project/slime/cvsroot/slime/contrib/ChangeLog	2008/12/24 08:13:51	1.146
@@ -1,5 +1,10 @@
 2008-12-23  Helmut Eller  <heller at common-lisp.net>
 
+	* slime-editing-commands.el (slime-editing-commands-init): Bind
+	slime-close-all-parens-in-sexp.
+
+2008-12-23  Helmut Eller  <heller at common-lisp.net>
+
 	* inferior-slime.el (inferior-slime-hook-function): New function.
 	(inferior-slime-init): Automatically enable it in the
 	*inferior-lisp* buffer.
--- /project/slime/cvsroot/slime/contrib/slime-editing-commands.el	2008/10/21 20:37:56	1.9
+++ /project/slime/cvsroot/slime/contrib/slime-editing-commands.el	2008/12/24 08:13:51	1.10
@@ -183,6 +183,7 @@
 (defun slime-editing-commands-init ()
   (define-key slime-mode-map "\M-\C-a"  'slime-beginning-of-defun)
   (define-key slime-mode-map "\M-\C-e"  'slime-end-of-defun)
-  (define-key slime-mode-map "\C-c\M-q" 'slime-reindent-defun))
+  (define-key slime-mode-map "\C-c\M-q" 'slime-reindent-defun)
+  (define-key slime-mode-map "\C-c\C-]" 'slime-close-all-parens-in-sexp))
 
 (provide 'slime-editing-commands)




From heller at common-lisp.net  Wed Dec 24 08:13:57 2008
From: heller at common-lisp.net (CVS User heller)
Date: Wed, 24 Dec 2008 08:13:57 +0000
Subject: [slime-cvs] CVS slime/contrib
Message-ID: <E1LFOsP-00071X-4F@common-lisp.net>

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

Modified Files:
	ChangeLog slime-repl.el 
Log Message:
Move i/o related event handlers to slime-repl.el.

* slime-repl.el (slime-repl-event-hook-function): Handle some
events here.

--- /project/slime/cvsroot/slime/contrib/ChangeLog	2008/12/24 08:13:51	1.146
+++ /project/slime/cvsroot/slime/contrib/ChangeLog	2008/12/24 08:13:56	1.147
@@ -1,5 +1,12 @@
 2008-12-23  Helmut Eller  <heller at common-lisp.net>
 
+	Move i/o related event handlers to slime-repl.el.
+
+	* slime-repl.el (slime-repl-event-hook-function): Handle some
+	events here.
+
+2008-12-23  Helmut Eller  <heller at common-lisp.net>
+
 	* slime-editing-commands.el (slime-editing-commands-init): Bind
 	slime-close-all-parens-in-sexp.
 
--- /project/slime/cvsroot/slime/contrib/slime-repl.el	2008/12/24 08:07:03	1.1
+++ /project/slime/cvsroot/slime/contrib/slime-repl.el	2008/12/24 08:13:56	1.2
@@ -1451,12 +1451,28 @@
            (pop-to-buffer repl-buffer)
            (goto-char (point-max))))))
 
-(defun slime-repl-connected-hook ()
+(defun slime-repl-connected-hook-function ()
   (slime-hide-inferior-lisp-buffer)
   (slime-init-output-buffer (slime-connection)))
 
+(defun slime-repl-event-hook-function (event)
+  (destructure-case event
+    ((:write-string output &optional target)
+     (slime-write-string output target)
+     t)
+    ((:read-string thread tag)
+     (assert thread)
+     (slime-repl-read-string thread tag)
+     t)
+    ((:open-dedicated-output-stream port)
+     (slime-open-stream-to-lisp port)
+     t)
+    (t nil)))
+
 (defun slime-repl-init ()
-  (add-hook 'slime-connected-hook 'slime-repl-connected-hook))
+  (add-hook 'slime-connected-hook 'slime-repl-connected-hook-function)
+  (add-hook 'slime-event-hooks 'slime-repl-event-hook-function)
+  )
 
 (def-slime-test package-updating
     (package-name nicknames)




From heller at common-lisp.net  Wed Dec 24 08:14:06 2008
From: heller at common-lisp.net (CVS User heller)
Date: Wed, 24 Dec 2008 08:14:06 +0000
Subject: [slime-cvs] CVS slime
Message-ID: <E1LFOsY-00072h-Qw@common-lisp.net>

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

Modified Files:
	ChangeLog slime.el swank.lisp 
Log Message:
* swank.lisp (connection.env): New slot. To hold dynamic variable
bindings for this connection.
(with-io-redirection): Use it.
(create-repl): New function.  Currently only redirects IO for the
connection.  Could potentially be used to create multiple
listeners, each with a set of streams and corresponding buffers.
(*redirect-io*, maybe-call-with-io-redirection)
(call-with-redirected-io): Deleted.

* slime-repl.el (slime-repl-connected-hook-function): Create
a repl at startup.  Well, initialize stream redirection.

--- /project/slime/cvsroot/slime/ChangeLog	2008/12/24 08:06:25	1.1602
+++ /project/slime/cvsroot/slime/ChangeLog	2008/12/24 08:14:06	1.1603
@@ -1,5 +1,16 @@
 2008-12-23  Helmut Eller  <heller at common-lisp.net>
 
+	* swank.lisp (connection.env): New slot. To hold dynamic variable
+	bindings for this connection.
+	(with-io-redirection): Use it.
+	(create-repl): New function.  Currently only redirects IO for the
+	connection.  Could potentially be used to create multiple
+	listeners, each with a set of streams and corresponding buffers.
+	(*redirect-io*, maybe-call-with-io-redirection)
+	(call-with-redirected-io): Deleted.
+
+2008-12-23  Helmut Eller  <heller at common-lisp.net>
+
 	Move most of the REPL mode to contrib.
 	Disable some commands that depend on the
 	existence of a REPL buffer.
--- /project/slime/cvsroot/slime/slime.el	2008/12/24 08:06:25	1.1079
+++ /project/slime/cvsroot/slime/slime.el	2008/12/24 08:14:06	1.1080
@@ -2336,8 +2336,6 @@
   (let ((slime-dispatching-connection (or process (slime-connection))))
     (or (run-hook-with-args-until-success 'slime-event-hooks event)
         (destructure-case event
-          ;;((:write-string output &optional target)
-          ;; (slime-write-string output target))
           ((:emacs-rex form package thread continuation)
            (when (and (slime-use-sigint-for-interrupt) (slime-busy-p))
              (slime-display-oneliner "; pipelined request... %S" form))
@@ -2364,14 +2362,8 @@
            (sldb-exit thread level stepping))
           ((:emacs-interrupt thread)
            (slime-send `(:emacs-interrupt ,thread)))
-;;          ((:read-string thread tag)
-;;           (assert thread)
-;;           (slime-repl-read-string thread tag))
           ((:y-or-n-p thread tag question)
            (slime-y-or-n-p thread tag question))
-;;          ((:read-aborted thread tag)
-;;           (assert thread)
-;;           (slime-repl-abort-read thread tag))
           ((:emacs-return-string thread tag string)
            (slime-send `(:emacs-return-string ,thread ,tag ,string)))
           ;;
@@ -2382,8 +2374,6 @@
            (setf (slime-lisp-features) features))
           ((:indentation-update info)
            (slime-handle-indentation-update info))
-          ;;((:open-dedicated-output-stream port)
-          ;; (slime-open-stream-to-lisp port))
           ((:eval-no-wait fun args)
            (apply (intern fun) args))
           ((:eval thread tag form-string)
--- /project/slime/cvsroot/slime/swank.lisp	2008/12/24 07:56:20	1.614
+++ /project/slime/cvsroot/slime/swank.lisp	2008/12/24 08:14:06	1.615
@@ -90,10 +90,6 @@
 (defvar *swank-debug-p* t
   "When true, print extra debugging information.")
 
-(defvar *redirect-io* t
-  "When non-nil redirect Lisp standard I/O to Emacs.
-Redirection is done while Lisp is processing a request for Emacs.")
-
 (defvar *sldb-printer-bindings*
   `((*print-pretty*           . t)
     (*print-level*            . 4)
@@ -226,6 +222,8 @@
   (user-input       nil :type (or stream null))
   (user-output      nil :type (or stream null))
   (user-io          nil :type (or stream null))
+  ;; Bindings used for this connection (usually streams)
+  env
   ;; A stream that we use for *trace-output*; if nil, we user user-output.
   (trace-output     nil :type (or stream null))
   ;; A stream where we send REPL results.
@@ -391,14 +389,9 @@
     (symbol (apply #'make-condition datum args))))
 
 (defmacro with-io-redirection ((connection) &body body)
-  "Execute BODY I/O redirection to CONNECTION.
-If *REDIRECT-IO* is true then all standard I/O streams are redirected."
-  `(maybe-call-with-io-redirection ,connection (lambda () , at body)))
-
-(defun maybe-call-with-io-redirection (connection fun)
-  (if *redirect-io*
-      (call-with-redirected-io connection fun)
-      (funcall fun)))
+  "Execute BODY I/O redirection to CONNECTION. "
+  `(with-bindings (connection.env ,connection)
+     . ,body))
       
 (defmacro with-connection ((connection) &body body)
   "Execute BODY in the context of CONNECTION."
@@ -1202,7 +1195,6 @@
 (defun control-thread (connection)
   (with-struct* (connection. @ connection)
     (setf (@ control-thread) (current-thread))
-    (setf (@ repl-thread) (spawn-repl-thread connection "repl-thread"))
     (setf (@ reader-thread) (spawn (lambda () (read-loop connection)) 
                                    :name "reader-thread"))
     (dispatch-loop connection)))
@@ -1316,16 +1308,6 @@
             (unless c (return))
             (write-char c str)))))
 
-(defun initialize-streams-for-connection (connection)
-  (multiple-value-bind (dedicated in out io repl-results) 
-      (open-streams connection)
-    (setf (connection.dedicated-output connection) dedicated
-          (connection.user-io connection)          io
-          (connection.user-output connection)      out
-          (connection.user-input connection)       in
-          (connection.repl-results connection)     repl-results)
-    connection))
-
 (defun create-connection (socket-io style)
   (let ((success nil))
     (unwind-protect
@@ -1347,7 +1329,6 @@
                                       :serve-requests #'simple-serve-requests))
                     )))
            (setf (connection.communication-style c) style)
-           (initialize-streams-for-connection c)
            (setf success t)
            c)
       (unless success
@@ -1504,21 +1485,32 @@
 ;;; We always redirect the standard streams to Emacs while evaluating
 ;;; an RPC. This is done with simple dynamic bindings.
 
-(defun call-with-redirected-io (connection function)
-  "Call FUNCTION with I/O streams redirected via CONNECTION."
-  (declare (type function function))
-  (let* ((io  (connection.user-io connection))
-         (in  (connection.user-input connection))
-         (out (connection.user-output connection))
-         (trace (or (connection.trace-output connection) out))
-         (*standard-output* out)
-         (*error-output* out)
-         (*trace-output* trace)
-         (*debug-io* io)
-         (*query-io* io)
-         (*standard-input* in)
-         (*terminal-io* io))
-    (funcall function)))
+(defslimefun create-repl (target)
+  (assert (eq target nil))
+  (let ((conn *emacs-connection*))
+    (initialize-streams-for-connection conn)
+    (with-struct* (connection. @ conn)
+      (setf (@ env)
+            `((*standard-output* . ,(@ user-output))
+              (*standard-input* . ,(@ user-input))
+              (*trace-output* . ,(or (@ trace-output) (@ user-output)))
+              (*error-output* . ,(@ user-output))
+              (*debug-io* . ,(@ user-io))
+              (*query-io* . ,(@ user-io))
+              (*terminal-io* . ,(@ user-io))))
+      (when (eq (@ communication-style) :spawn)
+        (setf (@ repl-thread) (spawn-repl-thread conn "repl-thread")))
+      t)))
+
+(defun initialize-streams-for-connection (connection)
+  (multiple-value-bind (dedicated in out io repl-results) 
+      (open-streams connection)
+    (setf (connection.dedicated-output connection) dedicated
+          (connection.user-io connection)          io
+          (connection.user-output connection)      out
+          (connection.user-input connection)       in
+          (connection.repl-results connection)     repl-results)
+    connection))
 
 (defun call-with-thread-description (description thunk)
   ;; For `M-x slime-list-threads': Display what threads
@@ -1537,6 +1529,9 @@
       (unwind-protect (funcall thunk)
         (set-thread-description thread old-description)))))
 
+
+
+
 (defmacro with-thread-description (description &body body)
   `(call-with-thread-description ,description #'(lambda () , at body)))
 




From heller at common-lisp.net  Wed Dec 24 08:14:07 2008
From: heller at common-lisp.net (CVS User heller)
Date: Wed, 24 Dec 2008 08:14:07 +0000
Subject: [slime-cvs] CVS slime/contrib
Message-ID: <E1LFOsZ-000733-4Q@common-lisp.net>

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

Modified Files:
	ChangeLog slime-repl.el 
Log Message:
* swank.lisp (connection.env): New slot. To hold dynamic variable
bindings for this connection.
(with-io-redirection): Use it.
(create-repl): New function.  Currently only redirects IO for the
connection.  Could potentially be used to create multiple
listeners, each with a set of streams and corresponding buffers.
(*redirect-io*, maybe-call-with-io-redirection)
(call-with-redirected-io): Deleted.

* slime-repl.el (slime-repl-connected-hook-function): Create
a repl at startup.  Well, initialize stream redirection.

--- /project/slime/cvsroot/slime/contrib/ChangeLog	2008/12/24 08:13:56	1.147
+++ /project/slime/cvsroot/slime/contrib/ChangeLog	2008/12/24 08:14:07	1.148
@@ -1,5 +1,10 @@
 2008-12-23  Helmut Eller  <heller at common-lisp.net>
 
+	* slime-repl.el (slime-repl-connected-hook-function): Create
+	a repl at startup.  Well, initialize stream redirection.
+
+2008-12-23  Helmut Eller  <heller at common-lisp.net>
+
 	Move i/o related event handlers to slime-repl.el.
 
 	* slime-repl.el (slime-repl-event-hook-function): Handle some
--- /project/slime/cvsroot/slime/contrib/slime-repl.el	2008/12/24 08:13:56	1.2
+++ /project/slime/cvsroot/slime/contrib/slime-repl.el	2008/12/24 08:14:07	1.3
@@ -390,6 +390,9 @@
       (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-repl-mode-map
   ("\C-m" 'slime-repl-return)
   ([return] 'slime-repl-return)
@@ -1453,7 +1456,8 @@
 
 (defun slime-repl-connected-hook-function ()
   (slime-hide-inferior-lisp-buffer)
-  (slime-init-output-buffer (slime-connection)))
+  (slime-init-output-buffer (slime-connection))
+  (slime-eval-async '(swank:create-repl nil)))
 
 (defun slime-repl-event-hook-function (event)
   (destructure-case event
@@ -1470,9 +1474,8 @@
     (t nil)))
 
 (defun slime-repl-init ()
-  (add-hook 'slime-connected-hook 'slime-repl-connected-hook-function)
   (add-hook 'slime-event-hooks 'slime-repl-event-hook-function)
-  )
+  (add-hook 'slime-connected-hook 'slime-repl-connected-hook-function))
 
 (def-slime-test package-updating
     (package-name nicknames)




From heller at common-lisp.net  Wed Dec 24 08:14:13 2008
From: heller at common-lisp.net (CVS User heller)
Date: Wed, 24 Dec 2008 08:14:13 +0000
Subject: [slime-cvs] CVS slime
Message-ID: <E1LFOsf-00073l-BS@common-lisp.net>

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

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

--- /project/slime/cvsroot/slime/swank.lisp	2008/12/24 08:14:06	1.615
+++ /project/slime/cvsroot/slime/swank.lisp	2008/12/24 08:14:12	1.616
@@ -1492,12 +1492,12 @@
     (with-struct* (connection. @ conn)
       (setf (@ env)
             `((*standard-output* . ,(@ user-output))
-              (*standard-input* . ,(@ user-input))
-              (*trace-output* . ,(or (@ trace-output) (@ user-output)))
-              (*error-output* . ,(@ user-output))
-              (*debug-io* . ,(@ user-io))
-              (*query-io* . ,(@ user-io))
-              (*terminal-io* . ,(@ user-io))))
+              (*standard-input*  . ,(@ user-input))
+              (*trace-output*    . ,(or (@ trace-output) (@ user-output)))
+              (*error-output*    . ,(@ user-output))
+              (*debug-io*        . ,(@ user-io))
+              (*query-io*        . ,(@ user-io))
+              (*terminal-io*     . ,(@ user-io))))
       (when (eq (@ communication-style) :spawn)
         (setf (@ repl-thread) (spawn-repl-thread conn "repl-thread")))
       t)))




From slime-devel at common-lisp.net  Wed Dec 24 11:56:05 2008
From: slime-devel at common-lisp.net (slime-devel at common-lisp.net)
Date: Wed, 24 Dec 2008 11:56:05 -0000
Subject: [slime-cvs] We've lost your ICQ
Message-ID: <mailman.0.1428527568.3776.slime-cvs@common-lisp.net>

An HTML attachment was scrubbed...
URL: <https://mailman.common-lisp.net/pipermail/slime-cvs/attachments/20081224/67a8772a/attachment.html>

From heller at common-lisp.net  Fri Dec 26 07:22:40 2008
From: heller at common-lisp.net (CVS User heller)
Date: Fri, 26 Dec 2008 07:22:40 +0000
Subject: [slime-cvs] CVS slime
Message-ID: <E1LG71s-0002QO-PW@common-lisp.net>

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

Modified Files:
	ChangeLog slime.el 
Log Message:
Don't restore window configs in sldb.
That doesn't work in the native repl, because output
may have moved point.

* slime.el (sldb-setup, sldb-exit): Use temp buffer code.
(slime-display-popup-buffer): Don't overwrite existing
variables.
(slime-close-popup-window): Factored out from
slime-popup-buffer-quit.
(slime-save-local-variables): New macro.
(sldb-maybe-kill-buffer, sldb-saved-window-configuration): Deleted.

--- /project/slime/cvsroot/slime/ChangeLog	2008/12/24 08:14:06	1.1603
+++ /project/slime/cvsroot/slime/ChangeLog	2008/12/26 07:22:40	1.1604
@@ -1,3 +1,17 @@
+2008-12-25  Helmut Eller  <heller at common-lisp.net>
+
+	Don't restore window configs in sldb.
+	That doesn't work in the native repl, because output
+	may have moved point.
+
+	* slime.el (sldb-setup, sldb-exit): Use temp buffer code.
+	(slime-display-popup-buffer): Don't overwrite existing
+	variables.
+	(slime-close-popup-window): Factored out from
+	slime-popup-buffer-quit.
+	(slime-save-local-variables): New macro.
+	(sldb-maybe-kill-buffer, sldb-saved-window-configuration): Deleted.
+
 2008-12-23  Helmut Eller  <heller at common-lisp.net>
 
 	* swank.lisp (connection.env): New slot. To hold dynamic variable
--- /project/slime/cvsroot/slime/slime.el	2008/12/24 08:14:06	1.1080
+++ /project/slime/cvsroot/slime/slime.el	2008/12/26 07:22:40	1.1081
@@ -1014,10 +1014,37 @@
         (windows))
     (walk-windows (lambda (w) (push w windows)) nil t)
     (prog1 (pop-to-buffer (current-buffer))
-      (set (make-local-variable 'slime-popup-buffer-restore-info)
-           (list (unless (memq (selected-window) windows)
-                   (selected-window))
-                 selected-window)))))
+      (unless (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))
+  (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))
+
+(defmacro slime-save-local-variables (vars &rest body)
+  `(let ((vals (cons (mapcar (lambda (var)
+                               (if (local-variable-p var)
+                                   (cons var (eval var))))
+                             ',vars)
+                     (progn . ,body))))
+     (prog1 (cdr vals)
+       (mapc (lambda (var+val)
+               (when (consp var+val)
+                 (set (make-local-variable (car var+val)) (cdr var+val))))
+             (car vals)))))
+
+(put 'slime-save-local-variables 'lisp-indent-function 1)
 
 (define-minor-mode slime-popup-buffer-mode 
   "Mode for displaying read only stuff"
@@ -1046,13 +1073,7 @@
     ;;(when (slime-popup-buffer-snapshot-unchanged-p)
     ;;  (slime-popup-buffer-restore-snapshot))
     (setq slime-popup-buffer-saved-emacs-snapshot nil) ; buffer-local var!
-    (destructuring-bind (created-window selected-window) 
-        slime-popup-buffer-restore-info
-      (bury-buffer)
-      (when (eq created-window (selected-window))
-        (delete-window created-window))
-      (when (window-live-p selected-window)
-        (select-window selected-window)))
+    (slime-close-popup-window)
     (when kill-buffer-p
       (kill-buffer buffer))))
 
@@ -2082,11 +2103,7 @@
   "*If true, don't send background requests if Lisp is already busy.")
 
 (defun slime-background-activities-enabled-p ()
-  (and (or slime-mode 
-           (eq major-mode 'sldb-mode)
-           ;;(eq major-mode 'slime-repl-mode)
-           )
-       (let ((con (slime-current-connection)))
+  (and (let ((con (slime-current-connection)))
          (and con
               (eq (process-status con) 'open)))
        (or (not (slime-busy-p))
@@ -4110,10 +4127,12 @@
   ;;(with-current-buffer (slime-output-buffer)
   ;;  (save-excursion (slime-repl-insert-prompt))
   ;;  (slime-repl-show-maximum-output))
-  (with-current-buffer buffer
-    (cond (ok (funcall cont result))
-          (t (message "Evaluation aborted.")))))
-
+  (cond ((not ok)
+         (message "Evaluation aborted."))
+        (t
+         (with-current-buffer buffer
+           (funcall cont result)))))
+        
 (defun slime-eval-describe (form)
   "Evaluate FORM in Lisp and display the result in a new buffer."
   (slime-eval-async form (slime-rcurry #'slime-show-description
@@ -5183,9 +5202,6 @@
  (defvar sldb-condition nil
    "A list (DESCRIPTION TYPE) describing the condition being debugged.")
 
- (defvar sldb-saved-window-configuration nil
-   "Window configuration before the debugger was initially entered.")
-
  (defvar sldb-restarts nil
    "List of (NAME DESCRIPTION) for each available restart.")
 
@@ -5378,9 +5394,8 @@
   (with-current-buffer (sldb-get-buffer thread)
     (unless (equal sldb-level level)
       (setq buffer-read-only nil)
-      (sldb-mode)
-      (unless sldb-saved-window-configuration
-        (setq sldb-saved-window-configuration (current-window-configuration)))
+      (slime-save-local-variables (slime-popup-buffer-restore-info)
+        (sldb-mode))
       (setq slime-current-thread thread)
       (setq sldb-level level)
       (setq mode-name (format "sldb[%d]" sldb-level))
@@ -5397,7 +5412,7 @@
             (sldb-insert-frames (sldb-prune-initial-frames frames) t)
           (insert "[No backtrace]")))
       (run-hooks 'sldb-hook))
-    (pop-to-buffer (current-buffer))
+    (slime-display-popup-buffer)
     (sldb-recenter-region (point-min) (point))
     (setq buffer-read-only t)
     (when (and slime-stack-eval-tags
@@ -5428,27 +5443,10 @@
   "Exit from the debug level LEVEL."
   (when-let (sldb (sldb-find-buffer thread))
     (with-current-buffer sldb
-      (unless stepping
-        (set-window-configuration sldb-saved-window-configuration))
-      (let ((inhibit-read-only t))
-        (erase-buffer))
-      (setq sldb-level nil))
-    (cond ((and (= level 1) (not stepping))
-           (kill-buffer sldb))
-          (t (sldb-maybe-kill-buffer thread (slime-connection))))))
-
-;; If we return to a lower debug level we wait a little before closing
-;; the debugger window.  We also send a ping, just in case Lisp was
-;; interrupted in swank:wait-for-input.
-(defun sldb-maybe-kill-buffer (thread connection)
-  (run-with-idle-timer
-   0.3 nil 
-   (lambda (thead connection)
-     (when-let (sldb (sldb-find-buffer thread connection))
-       (with-current-buffer sldb
-         (when (not sldb-level)
-           (kill-buffer sldb)))))
-   thread connection))
+      (cond (stepping
+             (setq sldb-level nil))
+            (t
+             (slime-popup-buffer-quit t))))))
 
 
 ;;;;;; SLDB buffer insertion




From heller at common-lisp.net  Fri Dec 26 07:22:58 2008
From: heller at common-lisp.net (CVS User heller)
Date: Fri, 26 Dec 2008 07:22:58 +0000
Subject: [slime-cvs] CVS slime/contrib
Message-ID: <E1LG729-0002RF-Pr@common-lisp.net>

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

Modified Files:
	ChangeLog inferior-slime.el 
Log Message:
* inferior-slime.el (inferior-slime-switch-to-repl-buffer): New
function.
(inferior-slime-init): Bind it to a selector key.

--- /project/slime/cvsroot/slime/contrib/ChangeLog	2008/12/24 08:14:07	1.148
+++ /project/slime/cvsroot/slime/contrib/ChangeLog	2008/12/26 07:22:56	1.149
@@ -1,3 +1,9 @@
+2008-12-25  Helmut Eller  <heller at common-lisp.net>
+
+	* inferior-slime.el (inferior-slime-switch-to-repl-buffer): New
+	function.
+	(inferior-slime-init): Bind it to a selector key.
+
 2008-12-23  Helmut Eller  <heller at common-lisp.net>
 
 	* slime-repl.el (slime-repl-connected-hook-function): Create
--- /project/slime/cvsroot/slime/contrib/inferior-slime.el	2008/12/24 08:13:47	1.3
+++ /project/slime/cvsroot/slime/contrib/inferior-slime.el	2008/12/26 07:22:56	1.4
@@ -91,7 +91,13 @@
 (defun inferior-slime-hook-function ()
   (inferior-slime-mode))
 
+(defun inferior-slime-switch-to-repl-buffer ()
+  (switch-to-buffer (process-buffer (slime-inferior-process))))
+
 (defun inferior-slime-init ()
-  (add-hook 'slime-inferior-process-start-hook 'inferior-slime-hook-function))
+  (add-hook 'slime-inferior-process-start-hook 'inferior-slime-hook-function)
+  (def-slime-selector-method ?r
+    "SLIME Read-Eval-Print-Loop."
+    (inferior-slime-switch-to-repl-buffer)))
 
 (provide 'inferior-slime)




From heller at common-lisp.net  Fri Dec 26 07:23:06 2008
From: heller at common-lisp.net (CVS User heller)
Date: Fri, 26 Dec 2008 07:23:06 +0000
Subject: [slime-cvs] CVS slime/contrib
Message-ID: <E1LG72H-0002Ry-LO@common-lisp.net>

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

Modified Files:
	ChangeLog slime-repl.el 
Log Message:
* slime-repl.el (slime-repl-connected-hook-function): Create a
repl thread before creating a repl buffer.

--- /project/slime/cvsroot/slime/contrib/ChangeLog	2008/12/26 07:22:56	1.149
+++ /project/slime/cvsroot/slime/contrib/ChangeLog	2008/12/26 07:23:05	1.150
@@ -1,3 +1,8 @@
+2008-12-26  Helmut Eller  <heller at common-lisp.net>
+
+	* slime-repl.el (slime-repl-connected-hook-function): Create a
+	repl thread before creating a repl buffer.
+
 2008-12-25  Helmut Eller  <heller at common-lisp.net>
 
 	* inferior-slime.el (inferior-slime-switch-to-repl-buffer): New
--- /project/slime/cvsroot/slime/contrib/slime-repl.el	2008/12/24 08:14:07	1.3
+++ /project/slime/cvsroot/slime/contrib/slime-repl.el	2008/12/26 07:23:05	1.4
@@ -1,3 +1,24 @@
+;;; slime-repl.el --- Read-Eval-Print Loop written in Emacs Lisp
+;;
+;; Original Author: Helmut Eller
+;; Contributors: to many to mention
+;; License: GNU GPL (same license as Emacs)
+;;
+;;; Description:
+;;
+;; This file implements a Lisp Listener along with some niceties like
+;; a persistent history and various "shortcut" commands.  Nothing here
+;; depends on comint.el; I/O is multiplexed over SLIME's socket.
+;;
+;; This used to be the default REPL for SLIME, but it was hard to
+;; maintain.
+;;
+;;; Installation:
+;;
+;; Call slime-setup and include 'slime-repl as argument: 
+;;
+;;  (slime-setup '(slime-repl [others conribs ...]))
+;;
 
 ;;;;; slime-repl
 
@@ -1455,9 +1476,9 @@
            (goto-char (point-max))))))
 
 (defun slime-repl-connected-hook-function ()
+  (slime-eval '(swank:create-repl nil))
   (slime-hide-inferior-lisp-buffer)
-  (slime-init-output-buffer (slime-connection))
-  (slime-eval-async '(swank:create-repl nil)))
+  (slime-init-output-buffer (slime-connection)))
 
 (defun slime-repl-event-hook-function (event)
   (destructure-case event




From heller at common-lisp.net  Fri Dec 26 07:23:21 2008
From: heller at common-lisp.net (CVS User heller)
Date: Fri, 26 Dec 2008 07:23:21 +0000
Subject: [slime-cvs] CVS slime
Message-ID: <E1LG72X-0002Sn-KC@common-lisp.net>

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

Modified Files:
	slime.el 
Log Message:
* slime-repl.el (slime-repl-connected-hook-function): Create a
repl thread before creating a repl buffer.

--- /project/slime/cvsroot/slime/slime.el	2008/12/26 07:22:40	1.1081
+++ /project/slime/cvsroot/slime/slime.el	2008/12/26 07:23:20	1.1082
@@ -32,9 +32,6 @@
 ;;   mode includes many commands for interacting with the Common Lisp
 ;;   process.
 ;;
-;;   Common Lisp REPL (Read-Eval-Print Loop) written in Emacs Lisp,
-;;   similar to `ielm'.
-;;
 ;;   Common Lisp debugger written in Emacs Lisp. The debugger pops up
 ;;   an Emacs buffer similar to the Emacs/Elisp debugger.
 ;;




From heller at common-lisp.net  Sat Dec 27 13:21:43 2008
From: heller at common-lisp.net (CVS User heller)
Date: Sat, 27 Dec 2008 13:21:43 +0000
Subject: [slime-cvs] CVS slime/contrib
Message-ID: <E1LGZ6t-0003yd-Sw@common-lisp.net>

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

Modified Files:
	ChangeLog slime-asdf.el 
Log Message:
* slime-asdf.el: Require slime-repl.

--- /project/slime/cvsroot/slime/contrib/ChangeLog	2008/12/26 07:23:05	1.150
+++ /project/slime/cvsroot/slime/contrib/ChangeLog	2008/12/27 13:21:43	1.151
@@ -1,3 +1,7 @@
+2008-12-27  Helmut Eller  <heller at common-lisp.net>
+
+	* slime-asdf.el: Require slime-repl.
+
 2008-12-26  Helmut Eller  <heller at common-lisp.net>
 
 	* slime-repl.el (slime-repl-connected-hook-function): Create a
--- /project/slime/cvsroot/slime/contrib/slime-asdf.el	2008/10/04 19:13:42	1.6
+++ /project/slime/cvsroot/slime/contrib/slime-asdf.el	2008/12/27 13:21:43	1.7
@@ -17,6 +17,7 @@
 ;; NOTE: `system-name' is a predefined variable in Emacs.  Try to
 ;; avoid it as local variable name.
 
+(require 'slime-repl)
 (slime-require :swank-asdf)
 
 (defun slime-load-system (&optional system)




From heller at common-lisp.net  Sat Dec 27 13:21:48 2008
From: heller at common-lisp.net (CVS User heller)
Date: Sat, 27 Dec 2008 13:21:48 +0000
Subject: [slime-cvs] CVS slime/contrib
Message-ID: <E1LGZ6y-0003zD-0U@common-lisp.net>

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

Modified Files:
	ChangeLog slime-repl.el 
Log Message:
* slime-repl.el (slime-repl-quit): Kill the repl buffer before
quitting.  Reported by Volkan YAZICI.

--- /project/slime/cvsroot/slime/contrib/ChangeLog	2008/12/27 13:21:43	1.151
+++ /project/slime/cvsroot/slime/contrib/ChangeLog	2008/12/27 13:21:47	1.152
@@ -1,5 +1,10 @@
 2008-12-27  Helmut Eller  <heller at common-lisp.net>
 
+	* slime-repl.el (slime-repl-quit): Kill the repl buffer before
+	quitting.  Reported by Volkan YAZICI.
+
+2008-12-27  Helmut Eller  <heller at common-lisp.net>
+
 	* slime-asdf.el: Require slime-repl.
 
 2008-12-26  Helmut Eller  <heller at common-lisp.net>
--- /project/slime/cvsroot/slime/contrib/slime-repl.el	2008/12/26 07:23:05	1.4
+++ /project/slime/cvsroot/slime/contrib/slime-repl.el	2008/12/27 13:21:47	1.5
@@ -1310,7 +1310,10 @@
   (:one-liner "Quit all Lisps and close all SLIME buffers."))
 
 (defslime-repl-shortcut slime-repl-quit ("quit")
-  (:handler 'slime-quit-lisp)
+  (:handler (lambda ()
+	      (interactive)
+	      (kill-buffer (slime-output-buffer))
+	      (slime-quit-lisp)))
   (:one-liner "Quit the current Lisp."))
 
 (defslime-repl-shortcut slime-repl-defparameter ("defparameter" "!")




From heller at common-lisp.net  Sat Dec 27 18:24:29 2008
From: heller at common-lisp.net (CVS User heller)
Date: Sat, 27 Dec 2008 18:24:29 +0000
Subject: [slime-cvs] CVS slime
Message-ID: <E1LGdpt-0001c5-7S@common-lisp.net>

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

Modified Files:
	ChangeLog slime.el swank.lisp 
Log Message:
Move slime-lisp-package to slime-repl.el

* swank.lisp (create-repl): Return initial package and prompt.

* slime-repl.el (slime-repl-event-hook-function): Handle
:new-package events here.
(slime-output-buffer): Initialize slime-buffer-package.
(slime-repl-connected-hook-function): Initialize slime-lisp-package.

--- /project/slime/cvsroot/slime/ChangeLog	2008/12/26 07:22:40	1.1604
+++ /project/slime/cvsroot/slime/ChangeLog	2008/12/27 18:24:28	1.1605
@@ -1,3 +1,10 @@
+2008-12-27  Helmut Eller  <heller at common-lisp.net>
+
+	* slime.el: Move slime-lisp-package and
+	slime-lisp-package-prompt-string to slime-repl.el
+
+	* swank.lisp (create-repl): Return initial package and prompt.
+
 2008-12-25  Helmut Eller  <heller at common-lisp.net>
 
 	Don't restore window configs in sldb.
--- /project/slime/cvsroot/slime/slime.el	2008/12/26 07:23:20	1.1082
+++ /project/slime/cvsroot/slime/slime.el	2008/12/27 18:24:28	1.1083
@@ -1943,16 +1943,6 @@
 (slime-def-connection-var slime-lisp-modules '()
   "The strings of Lisp's *MODULES*.")
 
-(slime-def-connection-var slime-lisp-package
-    "COMMON-LISP-USER"
-  "The current package name of the Superior lisp.
-This is automatically synchronized from Lisp.")
-
-(slime-def-connection-var slime-lisp-package-prompt-string
-    "CL-USER"
-  "The current package name of the Superior lisp.
-This is automatically synchronized from Lisp.")
-
 (slime-def-connection-var slime-pid nil
   "The process id of the Lisp process.")
 
@@ -2017,9 +2007,6 @@
             (slime-communication-style) style
             (slime-lisp-features) features
             (slime-lisp-modules) modules)
-      (destructuring-bind (&key name prompt) package
-        (setf (slime-lisp-package) name
-              (slime-lisp-package-prompt-string) prompt))
       (destructuring-bind (&key type name version) lisp-implementation
         (setf (slime-lisp-implementation-type) type
               (slime-lisp-implementation-version) version
@@ -2202,15 +2189,11 @@
 (defun slime-current-package ()
   "Return the Common Lisp package in the current context.
 If `slime-buffer-package' has a value then return that, otherwise
-search for and read an `in-package' form.
-
-The REPL buffer is a special case: its package is `slime-lisp-package'."
-  (cond ;;((eq major-mode 'slime-repl-mode)
-        ;; (slime-lisp-package))
-        (slime-buffer-package)
-        (t (save-restriction
-             (widen)
-             (slime-find-buffer-package)))))
+search for and read an `in-package' form."
+  (or slime-buffer-package
+      (save-restriction
+        (widen)
+        (slime-find-buffer-package))))
 
 (defvar slime-find-buffer-package-function 'slime-search-buffer-package
   "*Function to use for `slime-find-buffer-package'.  
@@ -2380,10 +2363,6 @@
            (slime-y-or-n-p thread tag question))
           ((:emacs-return-string thread tag string)
            (slime-send `(:emacs-return-string ,thread ,tag ,string)))
-          ;;
-          ((:new-package package prompt-string)
-           (setf (slime-lisp-package) package)
-           (setf (slime-lisp-package-prompt-string) prompt-string))
           ((:new-features features)
            (setf (slime-lisp-features) features))
           ((:indentation-update info)
@@ -3879,8 +3858,8 @@
 (defun slime-edit-definition-cont (xrefs name where)
   (destructuring-bind (1loc file-alist) (slime-analyze-xrefs xrefs)
     (cond ((null xrefs) 
-           (error "No known definition for: %s (in %s)" 
-                  name (or (slime-current-package) (slime-lisp-package))))
+           (error "No known definition for: %s (in %s)"
+                  name (slime-current-package)))
           (1loc
            (slime-push-definition-stack)
            (slime-pop-to-location (slime-xref.location (car xrefs)) where))
@@ -6156,8 +6135,6 @@
     (set (make-local-variable 'truncate-lines) t)))
 
 (slime-define-keys slime-connection-list-mode-map
-  ;;((kbd "RET") 'slime-goto-connection)
-  ;;([return] 'slime-goto-connection)
   ("d"         'slime-connection-list-make-default)
   ("g"         'slime-update-connection-list)
   ((kbd "C-k") 'slime-quit-connection-at-point)
@@ -6167,12 +6144,6 @@
   (or (get-text-property (point) 'slime-connection)
       (error "No connection at point")))
 
-;;(defun slime-goto-connection ()
-;;  "Switch to the REPL buffer for the connection at point."
-;;  (interactive)
-;;  (let ((slime-dispatching-connection (slime-connection-at-point)))
-;;    (switch-to-buffer (slime-output-buffer))))
-
 (defun slime-quit-connection-at-point (connection)
   (interactive (list (slime-connection-at-point)))
   (let ((slime-dispatching-connection connection)
@@ -8007,7 +7978,7 @@
     (if (slime-cl-symbol-package s)
         s
       (format "%s::%s"
-              (let* ((package (or (slime-current-package) (slime-lisp-package))))
+              (let* ((package (slime-current-package)))
                 ;; package is a string like ":cl-user" or "CL-USER", or "\"CL-USER\"".
                 (if package
                     (slime-pretty-package-name package)
--- /project/slime/cvsroot/slime/swank.lisp	2008/12/24 08:14:12	1.616
+++ /project/slime/cvsroot/slime/swank.lisp	2008/12/27 18:24:29	1.617
@@ -1498,9 +1498,10 @@
               (*debug-io*        . ,(@ user-io))
               (*query-io*        . ,(@ user-io))
               (*terminal-io*     . ,(@ user-io))))
-      (when (eq (@ communication-style) :spawn)
+      (when (use-threads-p)
         (setf (@ repl-thread) (spawn-repl-thread conn "repl-thread")))
-      t)))
+      (list (package-name *package*)
+            (package-string-for-prompt *package*)))))
 
 (defun initialize-streams-for-connection (connection)
   (multiple-value-bind (dedicated in out io repl-results) 




From heller at common-lisp.net  Sat Dec 27 18:24:29 2008
From: heller at common-lisp.net (CVS User heller)
Date: Sat, 27 Dec 2008 18:24:29 +0000
Subject: [slime-cvs] CVS slime/contrib
Message-ID: <E1LGdpt-0001cO-Kk@common-lisp.net>

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

Modified Files:
	ChangeLog slime-repl.el 
Log Message:
Move slime-lisp-package to slime-repl.el

* swank.lisp (create-repl): Return initial package and prompt.

* slime-repl.el (slime-repl-event-hook-function): Handle
:new-package events here.
(slime-output-buffer): Initialize slime-buffer-package.
(slime-repl-connected-hook-function): Initialize slime-lisp-package.

--- /project/slime/cvsroot/slime/contrib/ChangeLog	2008/12/27 13:21:47	1.152
+++ /project/slime/cvsroot/slime/contrib/ChangeLog	2008/12/27 18:24:29	1.153
@@ -1,5 +1,12 @@
 2008-12-27  Helmut Eller  <heller at common-lisp.net>
 
+	* slime-repl.el (slime-repl-event-hook-function): Handle
+	:new-package events here.
+	(slime-output-buffer): Initialize slime-buffer-package.
+	(slime-repl-connected-hook-function): Initialize slime-lisp-package.
+
+2008-12-27  Helmut Eller  <heller at common-lisp.net>
+
 	* slime-repl.el (slime-repl-quit): Kill the repl buffer before
 	quitting.  Reported by Volkan YAZICI.
 
--- /project/slime/cvsroot/slime/contrib/slime-repl.el	2008/12/27 13:21:47	1.5
+++ /project/slime/cvsroot/slime/contrib/slime-repl.el	2008/12/27 18:24:29	1.6
@@ -124,6 +124,7 @@
                   (unless (eq major-mode 'slime-repl-mode) 
                     (slime-repl-mode))
                   (setq slime-buffer-connection connection)
+		  (setq slime-buffer-package (slime-lisp-package connection))
                   (slime-reset-repl-markers)
                   (unless noprompt 
                     (slime-repl-insert-prompt))
@@ -375,6 +376,17 @@
 ;; there is no prompt between output-end and input-start.
 ;;
 
+;; FIXME: slime-lisp-package should be local in a REPL buffer
+(slime-def-connection-var slime-lisp-package
+    "COMMON-LISP-USER"
+  "The current package name of the Superior lisp.
+This is automatically synchronized from Lisp.")
+
+(slime-def-connection-var slime-lisp-package-prompt-string
+    "CL-USER"
+  "The current package name of the Superior lisp.
+This is automatically synchronized from Lisp.")
+
 (slime-make-variables-buffer-local
  (defvar slime-repl-package-stack nil
    "The stack of packages visited in this repl.")
@@ -414,6 +426,10 @@
 (slime-define-keys slime-mode-map
   ("\C-c\C-z" 'slime-switch-to-output-buffer))
 
+(slime-define-keys slime-connection-list-mode-map
+  ((kbd "RET") 'slime-goto-connection)
+  ([return] 'slime-goto-connection))
+
 (slime-define-keys slime-repl-mode-map
   ("\C-m" 'slime-repl-return)
   ([return] 'slime-repl-return)
@@ -1436,6 +1452,12 @@
             (setq default-directory dir)))))
     (message "package: %s  default-directory: %s" (car package) directory)))
 
+(defun slime-goto-connection ()
+  "Switch to the REPL buffer for the connection at point."
+  (interactive)
+  (let ((slime-dispatching-connection (slime-connection-at-point)))
+    (switch-to-buffer (slime-output-buffer))))
+
 (defvar slime-repl-easy-menu
   (let ((C '(slime-connected-p)))
     `("REPL"
@@ -1479,7 +1501,9 @@
            (goto-char (point-max))))))
 
 (defun slime-repl-connected-hook-function ()
-  (slime-eval '(swank:create-repl nil))
+  (multiple-value-setq ((slime-lisp-package) 
+			(slime-lisp-package-prompt-string))
+    (slime-eval '(swank:create-repl nil)))
   (slime-hide-inferior-lisp-buffer)
   (slime-init-output-buffer (slime-connection)))
 
@@ -1495,6 +1519,14 @@
     ((:open-dedicated-output-stream port)
      (slime-open-stream-to-lisp port)
      t)
+    ((:new-package package prompt-string)
+     (setf (slime-lisp-package) package)
+     (setf (slime-lisp-package-prompt-string) prompt-string)
+     (let ((buffer (slime-connection-output-buffer)))
+       (when (buffer-live-p buffer)
+	 (with-current-buffer buffer
+	   (setq slime-buffer-package package))))
+     t)
     (t nil)))
 
 (defun slime-repl-init ()




From heller at common-lisp.net  Sat Dec 27 21:27:30 2008
From: heller at common-lisp.net (CVS User heller)
Date: Sat, 27 Dec 2008 21:27:30 +0000
Subject: [slime-cvs] CVS slime/contrib
Message-ID: <E1LGgh0-0001Nq-Lr@common-lisp.net>

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

Modified Files:
	slime-repl.el 
Log Message:
(slime-repl-connected-hook-function): Don't use multiple-value-setq.

--- /project/slime/cvsroot/slime/contrib/slime-repl.el	2008/12/27 18:24:29	1.6
+++ /project/slime/cvsroot/slime/contrib/slime-repl.el	2008/12/27 21:27:30	1.7
@@ -1501,9 +1501,10 @@
            (goto-char (point-max))))))
 
 (defun slime-repl-connected-hook-function ()
-  (multiple-value-setq ((slime-lisp-package) 
-			(slime-lisp-package-prompt-string))
-    (slime-eval '(swank:create-repl nil)))
+  (destructuring-bind (package prompt) 
+      (slime-eval '(swank:create-repl nil))
+    (setf (slime-lisp-package) package)
+    (setf (slime-lisp-package-prompt-string) prompt))
   (slime-hide-inferior-lisp-buffer)
   (slime-init-output-buffer (slime-connection)))
 




From heller at common-lisp.net  Sun Dec 28 14:32:15 2008
From: heller at common-lisp.net (CVS User heller)
Date: Sun, 28 Dec 2008 14:32:15 +0000
Subject: [slime-cvs] CVS slime
Message-ID: <E1LGwgh-0006ZT-MC@common-lisp.net>

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

Modified Files:
	ChangeLog swank-openmcl.lisp 
Log Message:
* swank-openmcl.lisp (function-source-location): Use
ccl:function-source-note.

--- /project/slime/cvsroot/slime/ChangeLog	2008/12/27 18:24:28	1.1605
+++ /project/slime/cvsroot/slime/ChangeLog	2008/12/28 14:32:14	1.1606
@@ -1,3 +1,8 @@
+2008-12-28  Helmut Eller  <heller at common-lisp.net>
+
+	* swank-openmcl.lisp (function-source-location): Use
+	ccl:function-source-note.
+
 2008-12-27  Helmut Eller  <heller at common-lisp.net>
 
 	* slime.el: Move slime-lisp-package and
--- /project/slime/cvsroot/slime/swank-openmcl.lisp	2008/10/19 20:03:34	1.144
+++ /project/slime/cvsroot/slime/swank-openmcl.lisp	2008/12/28 14:32:15	1.145
@@ -598,10 +598,69 @@
                       (list (list type symbol) 
                             (canonicalize-location file symbol))))))
 
+;; CCL commit r11373 | gz | 2008-11-16 16:35:28 +0100 (Sun, 16 Nov 2008)
+;; contains some interesting details:
+;; 
+;; Source location are recorded in CCL:SOURCE-NOTE's, which are objects
+;; with accessors CCL:SOURCE-NOTE-FILENAME, CCL:SOURCE-NOTE-START-POS,
+;; CCL:SOURCE-NOTE-END-POS and CCL:SOURCE-NOTE-TEXT.  The start and end
+;; positions are file positions (not character positions).  The text will
+;; be NIL unless text recording was on at read-time.  If the original
+;; file is still available, you can force missing source text to be read
+;; from the file at runtime via CCL:ENSURE-SOURCE-NOTE-TEXT.
+;; 
+;; Source-note's are associated with definitions (via record-source-file)
+;; and also stored in function objects (including anonymous and nested
+;; functions).  The former can be retrieved via
+;; CCL:FIND-DEFINITION-SOURCES, the latter via CCL:FUNCTION-SOURCE-NOTE.
+;; 
+;; The recording behavior is controlled by the new variable
+;; CCL:*SAVE-SOURCE-LOCATIONS*:
+;; 
+;;   If NIL, don't store source-notes in function objects, and store only
+;;   the filename for definitions (the latter only if
+;;   *record-source-file* is true).
+;; 
+;;   If T, store source-notes, including a copy of the original source
+;;   text, for function objects and definitions (the latter only if
+;;   *record-source-file* is true).
+;; 
+;;   If :NO-TEXT, store source-notes, but without saved text, for
+;;   function objects and defintions (the latter only if
+;;   *record-source-file* is true).  This is the default.
+;; 
+;; PC to source mapping is controlled by the new variable
+;; CCL:*RECORD-PC-MAPPING*.  If true (the default), functions store a
+;; compressed table mapping pc offsets to corresponding source locations.
+;; This can be retrieved by (CCL:FIND-SOURCE-NOTE-AT-PC function pc)
+;; which returns a source-note for the source at offset pc in the
+;; function.
+;; 
+;; Currently the only thing that makes use of any of this is the
+;; disassembler.  ILISP and current version of Slime still use
+;; backward-compatible functions that deal with filenames only.  The plan
+;; is to make Slime, and our IDE, use this eventually.
+
+#+#.(cl:if (cl:fboundp 'ccl::function-source-note) '(:or) '(:and))
 (defun function-source-location (function)
   (or (car (source-locations function))
       (list :error (format nil "No source info available for ~A" function))))
 
+#+#.(cl:if (cl:fboundp 'ccl::function-source-note) '(:and) '(:or))
+(progn
+  (defun function-source-location (function)
+    (let ((note (ccl:function-source-note function)))
+      (if note
+          (source-note-to-source-location note)
+          (list :error
+                (format nil "No source info available for ~A" function)))))
+
+  (defun source-note-to-source-location (note)
+    (let ((filename (namestring (truename (ccl:source-note-filename note)))))
+      (make-location
+       (list :file filename)
+       (list :position (ccl:source-note-start-pos note))))))
+
 ;; source-locations THING => LOCATIONS NAMES
 ;; LOCATIONS ... a list of source-locations.  Most "specific" first.
 ;; NAMES     ... a list of names.




From heller at common-lisp.net  Sun Dec 28 15:45:42 2008
From: heller at common-lisp.net (CVS User heller)
Date: Sun, 28 Dec 2008 15:45:42 +0000
Subject: [slime-cvs] CVS slime
Message-ID: <E1LGxpm-0002Yr-Vf@common-lisp.net>

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

Modified Files:
	ChangeLog swank-openmcl.lisp 
Log Message:
Recent CCLs support much better source location recording.
Let's use the new features in SLIME.

* swank-openmcl.lisp (pc-source-location): New function, based on
ccl:find-source-note-at-pc.
(frame-source-location-for-emacs): Use it.

--- /project/slime/cvsroot/slime/ChangeLog	2008/12/28 14:32:14	1.1606
+++ /project/slime/cvsroot/slime/ChangeLog	2008/12/28 15:45:42	1.1607
@@ -1,7 +1,13 @@
 2008-12-28  Helmut Eller  <heller at common-lisp.net>
 
+	Recent CCLs support much better source location recording.
+	Let's use the new features in SLIME.
+
 	* swank-openmcl.lisp (function-source-location): Use
 	ccl:function-source-note.
+	(pc-source-location): New function, based on
+	ccl:find-source-note-at-pc.
+	(frame-source-location-for-emacs): Use it.
 
 2008-12-27  Helmut Eller  <heller at common-lisp.net>
 
--- /project/slime/cvsroot/slime/swank-openmcl.lisp	2008/12/28 14:32:15	1.145
+++ /project/slime/cvsroot/slime/swank-openmcl.lisp	2008/12/28 15:45:42	1.146
@@ -642,10 +642,14 @@
 ;; is to make Slime, and our IDE, use this eventually.
 
 #+#.(cl:if (cl:fboundp 'ccl::function-source-note) '(:or) '(:and))
-(defun function-source-location (function)
-  (or (car (source-locations function))
-      (list :error (format nil "No source info available for ~A" function))))
-
+(progn
+  (defun function-source-location (function)
+    (or (car (source-locations function))
+        (list :error (format nil "No source info available for ~A" function))))
+  
+  (defun pc-source-location (function pc)
+    (function-source-location function)))
+  
 #+#.(cl:if (cl:fboundp 'ccl::function-source-note) '(:and) '(:or))
 (progn
   (defun function-source-location (function)
@@ -655,11 +659,18 @@
           (list :error
                 (format nil "No source info available for ~A" function)))))
 
+  (defun pc-source-location (function pc)
+    (let ((note (ccl:find-source-note-at-pc function pc)))
+      (if note
+          (source-note-to-source-location note)
+          (list :error
+                (format nil "No source note at ~A:#~x" function pc)))))
+
   (defun source-note-to-source-location (note)
     (let ((filename (namestring (truename (ccl:source-note-filename note)))))
       (make-location
        (list :file filename)
-       (list :position (ccl:source-note-start-pos note))))))
+       (list :position (1+ (ccl:source-note-start-pos note)))))))
 
 ;; source-locations THING => LOCATIONS NAMES
 ;; LOCATIONS ... a list of source-locations.  Most "specific" first.
@@ -713,10 +724,10 @@
   (block frame-source-location-for-emacs
     (map-backtrace
      (lambda (frame-number p context lfun pc)
-       (declare (ignore p context pc))
+       (declare (ignore p context))
        (when (and (= frame-number index) lfun)
          (return-from frame-source-location-for-emacs
-           (function-source-location lfun)))))))
+           (pc-source-location lfun pc)))))))
 
 (defimplementation eval-in-frame (form index)
   (block eval-in-frame




From heller at common-lisp.net  Mon Dec 29 11:51:46 2008
From: heller at common-lisp.net (CVS User heller)
Date: Mon, 29 Dec 2008 11:51:46 +0000
Subject: [slime-cvs] CVS slime
Message-ID: <E1LHGew-0002ix-5t@common-lisp.net>

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

Modified Files:
	ChangeLog swank-openmcl.lisp 
Log Message:
* swank-openmcl.lisp (find-definitions, source-locations): Use
ccl:find-definition-sources.

--- /project/slime/cvsroot/slime/ChangeLog	2008/12/28 15:45:42	1.1607
+++ /project/slime/cvsroot/slime/ChangeLog	2008/12/29 11:51:45	1.1608
@@ -1,3 +1,8 @@
+2008-12-29  Helmut Eller  <heller at common-lisp.net>
+
+	* swank-openmcl.lisp (find-definitions, source-locations): Use
+	ccl:find-definition-sources.
+
 2008-12-28  Helmut Eller  <heller at common-lisp.net>
 
 	Recent CCLs support much better source location recording.
--- /project/slime/cvsroot/slime/swank-openmcl.lisp	2008/12/28 15:45:42	1.146
+++ /project/slime/cvsroot/slime/swank-openmcl.lisp	2008/12/29 11:51:45	1.147
@@ -648,74 +648,111 @@
         (list :error (format nil "No source info available for ~A" function))))
   
   (defun pc-source-location (function pc)
-    (function-source-location function)))
-  
+    (function-source-location function))
+
+  ;; source-locations THING => LOCATIONS NAMES
+  ;; LOCATIONS ... a list of source-locations.  Most "specific" first.
+  ;; NAMES     ... a list of names.
+  (labels ((str (obj) (princ-to-string obj))
+           (str* (list) (mapcar #'princ-to-string list))
+           (unzip (list) (values (mapcar #'car list) (mapcar #'cdr list)))
+           (filename (file) (namestring (truename file)))
+           (src-loc (file pos)
+             (etypecase file
+               (null `(:error "No source-file info available"))
+               ((or string pathname)
+                (handler-case (make-location `(:file ,(filename file)) pos)
+                  (error (c) `(:error ,(princ-to-string c)))))))
+           (fallback (thing)
+             (cond ((functionp thing)
+                    (let ((name (ccl::function-name thing)))
+                      (and (consp name) (eq (car name) :internal)
+                           (ccl::edit-definition-p (second name))))))))
+
+    ;; FIXME: reorder result, e.g. if THING is a function then return
+    ;; the locations for type 'function before those with type
+    ;; 'variable.  (Otherwise the debugger jumps to compiler-macros
+    ;; instead of functions :-)
+    (defun source-locations (thing)
+      (multiple-value-bind (files name) (ccl::edit-definition-p thing)
+        (when (null files) 
+          (multiple-value-setq (files name) (fallback thing)))
+        (unzip
+         (loop for (type . file) in files collect
+               (etypecase type
+                 ((member function macro variable compiler-macro 
+                          ccl:defcallback ccl::x8664-vinsn)
+                  (cons (src-loc file (list :function-name (str name))) 
+                        (list type name)))
+                 (method
+                  (let* ((met type)
+                         (name (ccl::method-name met))
+                         (specs (ccl::method-specializers met))
+                         (specs (mapcar #'specializer-name specs))
+                         (quals (ccl::method-qualifiers met)))
+                    (cons (src-loc file (list :method (str name) 
+                                              (str* specs) (str* quals)))
+                          `(method ,name , at quals ,specs)))))))))))
+
 #+#.(cl:if (cl:fboundp 'ccl::function-source-note) '(:and) '(:or))
 (progn
   (defun function-source-location (function)
-    (let ((note (ccl:function-source-note function)))
-      (if note
-          (source-note-to-source-location note)
-          (list :error
-                (format nil "No source info available for ~A" function)))))
+    (source-note-to-source-location
+     (ccl:function-source-note function)
+     (lambda ()
+       (format nil "Function has no source note: ~A" function))))
 
   (defun pc-source-location (function pc)
-    (let ((note (ccl:find-source-note-at-pc function pc)))
-      (if note
-          (source-note-to-source-location note)
-          (list :error
-                (format nil "No source note at ~A:#~x" function pc)))))
-
-  (defun source-note-to-source-location (note)
-    (let ((filename (namestring (truename (ccl:source-note-filename note)))))
-      (make-location
-       (list :file filename)
-       (list :position (1+ (ccl:source-note-start-pos note)))))))
-
-;; source-locations THING => LOCATIONS NAMES
-;; LOCATIONS ... a list of source-locations.  Most "specific" first.
-;; NAMES     ... a list of names.
-(labels ((str (obj) (princ-to-string obj))
-         (str* (list) (mapcar #'princ-to-string list))
-         (unzip (list) (values (mapcar #'car list) (mapcar #'cdr list)))
-         (filename (file) (namestring (truename file)))
-         (src-loc (file pos)
-           (etypecase file
-             (null `(:error "No source-file info available"))
-             ((or string pathname)
-              (handler-case (make-location `(:file ,(filename file)) pos)
-                (error (c) `(:error ,(princ-to-string c)))))))
-         (fallback (thing)
-           (cond ((functionp thing)
-                  (let ((name (ccl::function-name thing)))
-                    (and (consp name) (eq (car name) :internal)
-                         (ccl::edit-definition-p (second name))))))))
-
-  ;; FIXME: reorder result, e.g. if THING is a function then return
-  ;; the locations for type 'function before those with type
-  ;; 'variable.  (Otherwise the debugger jumps to compiler-macros
-  ;; instead of functions :-)
-  (defun source-locations (thing)
-    (multiple-value-bind (files name) (ccl::edit-definition-p thing)
-      (when (null files) 
-        (multiple-value-setq (files name) (fallback thing)))
-      (unzip
-       (loop for (type . file) in files collect
-             (etypecase type
-               ((member function macro variable compiler-macro 
-                        ccl:defcallback ccl::x8664-vinsn)
-                (cons (src-loc file (list :function-name (str name))) 
-                      (list type name)))
-               (method
-                (let* ((met type)
-                       (name (ccl::method-name met))
-                       (specs (ccl::method-specializers met))
-                       (specs (mapcar #'specializer-name specs))
-                       (quals (ccl::method-qualifiers met)))
-                  (cons (src-loc file (list :method (str name) 
-                                            (str* specs) (str* quals)))
-                        `(method ,name ,quals ,specs))))))))))
-
+    (source-note-to-source-location
+     (ccl:find-source-note-at-pc function pc)
+     (lambda ()
+       (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)))))
+
+  (defimplementation find-definitions (symbol)
+    (loop for (loc . name) in (source-locations symbol)
+          collect (list name loc)))
+
+  (defgeneric source-locations (thing))
+
+  (defmethod source-locations ((f function))
+    (list (cons (function-source-location f)
+                (list 'function (ccl:function-name f)))))
+
+  (defmethod source-locations ((s symbol))
+    (append
+     #+(or)
+     (if (and (fboundp s) 
+              (not (macro-function s))
+              (not (special-operator-p s))
+              (functionp (symbol-function s)))
+         (source-locations (symbol-function s)))
+     (loop for ((type . name) source . _) in (ccl:find-definition-sources s) 
+           collect (cons (source-note-to-source-location 
+                          source (lambda () "No source info available"))
+                         (definition-name type name)))))
+
+  (defgeneric definition-name (type name)
+    (:method ((type ccl::definition-type) name)
+      (list (ccl::definition-type-name type) name)))
+
+  (defmethod definition-name ((type ccl::method-definition-type)
+                              (met method))
+    `(,(ccl::definition-type-name type)
+       ,(ccl::method-name met)
+       ,@(ccl::method-qualifiers met)
+       ,(mapcar #'specializer-name (ccl::method-specializers met)))))
+  
 (defimplementation frame-source-location-for-emacs (index)
   "Return to Emacs the location of the source code for the
 function in a debugger frame.  In OpenMCL, we are not able to




From heller at common-lisp.net  Mon Dec 29 19:03:20 2008
From: heller at common-lisp.net (CVS User heller)
Date: Mon, 29 Dec 2008 19:03:20 +0000
Subject: [slime-cvs] CVS slime
Message-ID: <E1LHNOa-0002C9-BK@common-lisp.net>

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

Modified Files:
	ChangeLog swank-openmcl.lisp 
Log Message:
* swank-openmcl.lisp (swank-compile-string, compile-temp-file): Use
new parameters to compile-file to adjust source locations.

--- /project/slime/cvsroot/slime/ChangeLog	2008/12/29 11:51:45	1.1608
+++ /project/slime/cvsroot/slime/ChangeLog	2008/12/29 19:03:20	1.1609
@@ -2,6 +2,8 @@
 
 	* swank-openmcl.lisp (find-definitions, source-locations): Use
 	ccl:find-definition-sources.
+	(swank-compile-string, compile-temp-file): Use new parameters to
+	compile-file to adjust source locations.
 
 2008-12-28  Helmut Eller  <heller at common-lisp.net>
 
--- /project/slime/cvsroot/slime/swank-openmcl.lisp	2008/12/29 11:51:45	1.147
+++ /project/slime/cvsroot/slime/swank-openmcl.lisp	2008/12/29 19:03:20	1.148
@@ -369,8 +369,8 @@
    :test 'equal))
 
 (defimplementation swank-compile-string (string &key buffer position directory
-                                                debug)
-  (declare (ignore directory debug))
+                                         debug)
+  (declare (ignore debug))
   (with-compilation-hooks ()
     (let ((*buffer-name* buffer)
           (*buffer-offset* position)
@@ -378,10 +378,22 @@
       (unwind-protect
            (with-open-file (s filename :direction :output :if-exists :error)
              (write-string string s))
-        (let ((binary-filename (compile-file filename :load t)))
+        (let ((binary-filename (compile-temp-file
+                                filename
+                                (if directory
+                                    (format nil "~a/~a" directory buffer))
+                                (1- position))))
           (delete-file binary-filename)))
       (delete-file filename))))
 
+(defun compile-temp-file (filename orig-file orig-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 filename :load t)))
+
 ;;; Profiling (alanr: lifted from swank-clisp)
 
 (defimplementation profile (fname)




From trittweiler at common-lisp.net  Tue Dec 30 17:12:11 2008
From: trittweiler at common-lisp.net (CVS User trittweiler)
Date: Tue, 30 Dec 2008 17:12:11 +0000
Subject: [slime-cvs] CVS slime/contrib
Message-ID: <E1LHi8Z-0005gE-Ny@common-lisp.net>

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

Modified Files:
	swank-arglists.lisp slime-parse.el ChangeLog 
Log Message:
	* swank-arglists.lisp (defstruct arglist-dummy): Remove
	:PRINT-OBJECT which made an arglist dummy look like a normal
	symbol. This is just confusing. If an ARGLIST-DUMMY appears in an
	arglist, the relevant code should deal with this explicitly.
	(with-availability): Renamed to WITH-AVAILABLE-ARGLIST.

	* slime-parse.el (slime-parse-extended-operator-name): Pass the
	fully qualified symbol (not just the name) to the parser function.
	(slime-make-extended-operator-parser/look-ahead): Do not take the
	operator name as first argument if point is located at the
	operator name.


--- /project/slime/cvsroot/slime/contrib/swank-arglists.lisp	2008/09/07 12:34:22	1.23
+++ /project/slime/cvsroot/slime/contrib/swank-arglists.lisp	2008/12/30 17:12:11	1.24
@@ -117,10 +117,7 @@
 ;; This is a wrapper object around anything that came from Slime and
 ;; could not reliably be read. 
 (defstruct (arglist-dummy
-	     (:conc-name #:arglist-dummy.)
-	     (:print-object (lambda (struct stream)
-			      (with-struct (arglist-dummy. string-representation) struct
-				(write-string string-representation stream)))))
+	     (:conc-name #:arglist-dummy.))
   string-representation)
 
 (defun read-conversatively-for-autodoc (string)
@@ -1095,7 +1092,7 @@
           (split-form-spec form-spec)
         (arglist-dispatch type operator arguments :remove-args remove-args))))
 
-(defmacro with-availability ((var) form &body body)
+(defmacro with-available-arglist ((var) form &body body)
   `(let ((,var ,form))
      (if (eql ,var :not-available)
          :not-available
@@ -1129,13 +1126,13 @@
                              arguments &key (remove-args t))
   (when (and (listp arguments)
 	     (not (null arguments)) ;have generic function name
-	     (notany #'listp (rest arguments))) ;don't have arglist yet 
+	     (notany #'listp (rest arguments))) ;don't have arglist yet
     (let* ((gf-name (first arguments))
 	   (gf (and (valid-function-name-p gf-name)
 		    (fboundp gf-name)
 		    (fdefinition gf-name))))
       (when (typep gf 'generic-function)
-        (with-availability (arglist) (arglist gf)
+        (with-available-arglist (arglist) (arglist gf)
           (return-from arglist-dispatch
             (values (make-arglist :provided-args (if remove-args
                                                      nil
@@ -1161,7 +1158,7 @@
 
 (defmethod arglist-dispatch ((operator-type (eql :declaration))
                              decl-identifier decl-args &key (remove-args t))
-  (with-availability (arglist)
+  (with-available-arglist (arglist)
       (declaration-arglist decl-identifier)
     (maybecall remove-args #'remove-actual-args
                (decode-arglist arglist) decl-args))
@@ -1171,7 +1168,7 @@
 
 (defmethod arglist-dispatch ((operator-type (eql :type-specifier))
                              type-specifier specifier-args &key (remove-args t))
-  (with-availability (arglist)
+  (with-available-arglist (arglist)
       (type-specifier-arglist type-specifier)
     (maybecall remove-args #'remove-actual-args
                (decode-arglist arglist) specifier-args))
--- /project/slime/cvsroot/slime/contrib/slime-parse.el	2008/09/13 10:39:02	1.12
+++ /project/slime/cvsroot/slime/contrib/slime-parse.el	2008/12/30 17:12:11	1.13
@@ -103,7 +103,9 @@
           (slime-forward-blanks))
         (when parser
           (multiple-value-setq (forms indices points)
-            (funcall parser op-name user-point forms indices points))))))
+            ;; We pass the fully qualified name (`current-op'), so it's the
+            ;; fully qualified name that will be sent to SWANK.
+            (funcall parser current-op user-point forms indices points))))))
   (values forms indices points))
 
 
@@ -127,10 +129,12 @@
 operator."
   (lexical-let ((n steps))
     #'(lambda (name user-point current-forms current-indices current-points)
-        (let ((old-forms (rest current-forms)))
-          (let* ((args (slime-ensure-list (slime-parse-sexp-at-point n)))
-                 (arg-specs (mapcar #'slime-make-form-spec-from-string args)))
-            (setq current-forms (cons `(,name , at arg-specs) old-forms))))
+        (let ((old-forms (rest current-forms))
+              (arg-idx   (first current-indices)))
+          (unless (zerop arg-idx)
+            (let* ((args (slime-ensure-list (slime-parse-sexp-at-point n)))
+                   (arg-specs (mapcar #'slime-make-form-spec-from-string args)))
+              (setq current-forms (cons `(,name , at arg-specs) old-forms)))))
         (values current-forms current-indices current-points)
         )))
 
--- /project/slime/cvsroot/slime/contrib/ChangeLog	2008/12/27 18:24:29	1.153
+++ /project/slime/cvsroot/slime/contrib/ChangeLog	2008/12/30 17:12:11	1.154
@@ -1,3 +1,17 @@
+2008-12-30  Tobias C. Rittweiler  <tcr at freebits.de>
+
+	* swank-arglists.lisp (defstruct arglist-dummy): Remove
+	:PRINT-OBJECT which made an arglist dummy look like a normal
+	symbol. This is just confusing. If an ARGLIST-DUMMY appears in an
+	arglist, the relevant code should deal with this explicitly.
+	(with-availability): Renamed to WITH-AVAILABLE-ARGLIST.
+
+	* slime-parse.el (slime-parse-extended-operator-name): Pass the
+	fully qualified symbol (not just the name) to the parser function.
+	(slime-make-extended-operator-parser/look-ahead): Do not take the
+	operator name as first argument if point is located at the
+	operator name.
+
 2008-12-27  Helmut Eller  <heller at common-lisp.net>
 
 	* slime-repl.el (slime-repl-event-hook-function): Handle




From trittweiler at common-lisp.net  Tue Dec 30 17:17:08 2008
From: trittweiler at common-lisp.net (CVS User trittweiler)
Date: Tue, 30 Dec 2008 17:17:08 +0000
Subject: [slime-cvs] CVS slime/contrib
Message-ID: <E1LHiDM-0005pc-2a@common-lisp.net>

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

Modified Files:
	ChangeLog 
Added Files:
	swank-sbcl-exts.lisp slime-sbcl-exts.el 
Log Message:
	* slime-sbcl-exts.el, swank-sbcl-exts.lisp: New contrib.

	This is the place for SBCL specific extensions and customizations
	that can't go into SBCL's swank-backend.

	At the moment, it contains code to display arglist of instructions,
	as in `(sb-assem:inst mov |'.


--- /project/slime/cvsroot/slime/contrib/ChangeLog	2008/12/30 17:12:11	1.154
+++ /project/slime/cvsroot/slime/contrib/ChangeLog	2008/12/30 17:17:08	1.155
@@ -1,5 +1,15 @@
 2008-12-30  Tobias C. Rittweiler  <tcr at freebits.de>
 
+	* slime-sbcl-exts.el, swank-sbcl-exts.lisp: New contrib.
+
+	This is the place for SBCL specific extensions and customizations
+	that can't go into SBCL's swank-backend.
+
+	At the moment, it contains code to display arglist of instructions,
+	as in `(sb-assem:inst mov |'.
+
+2008-12-30  Tobias C. Rittweiler  <tcr at freebits.de>
+
 	* swank-arglists.lisp (defstruct arglist-dummy): Remove
 	:PRINT-OBJECT which made an arglist dummy look like a normal
 	symbol. This is just confusing. If an ARGLIST-DUMMY appears in an

--- /project/slime/cvsroot/slime/contrib/swank-sbcl-exts.lisp	2008/12/30 17:17:08	NONE
+++ /project/slime/cvsroot/slime/contrib/swank-sbcl-exts.lisp	2008/12/30 17:17:08	1.1
;;; swank-sbcl-exts.lisp --- Misc extensions for SBCL
;;
;; Authors: Tobias C. Rittweiler <tcr at freebits.de>
;;
;; License: Public Domain
;;

(in-package :swank)

;;; Display arglist of instructions.
;;;
(defmethod compute-enriched-decoded-arglist ((operator-form (eql 'sb-assem:inst))
                                             argument-forms)
  (if (null argument-forms)
      (call-next-method)
      (destructuring-bind (instruction &rest args) argument-forms
        (declare (ignore args))
        (let* ((instr-name
                (if (arglist-dummy-p instruction)
                    (string-upcase (arglist-dummy.string-representation instruction))
                    (symbol-name instruction)))
               (instr-fn (gethash instr-name sb-assem:*assem-instructions*)))
          (if (not instr-fn)
              (call-next-method)
              (with-available-arglist (instr-arglist) (arglist instr-fn)
                (let ((decoded-arglist (decode-arglist instr-arglist)))
                  ;; The arglist of INST is (instruction ...INSTR-ARGLIST...).
                  (push 'sb-assem::instruction (arglist.required-args decoded-arglist))
                  (values decoded-arglist
                          (list instr-name)
                          t))))))))


(provide :swank-sbcl-exts)
--- /project/slime/cvsroot/slime/contrib/slime-sbcl-exts.el	2008/12/30 17:17:08	NONE
+++ /project/slime/cvsroot/slime/contrib/slime-sbcl-exts.el	2008/12/30 17:17:08	1.1
;;; slime-package-fu.el --- Misc extensions for SBCL
;;
;; Author:  Tobias C. Rittweiler <tcr at freebits.de>
;;
;; License: GNU GPL (same license as Emacs)
;;

(require 'slime-autodoc)
(require 'slime-references)

(push '("INST" . (slime-make-extended-operator-parser/look-ahead 1))
      slime-extended-operator-name-parser-alist)

(slime-require :swank-sbcl-exts)

(provide 'slime-sbcl-exts)



From trittweiler at common-lisp.net  Tue Dec 30 18:57:54 2008
From: trittweiler at common-lisp.net (CVS User trittweiler)
Date: Tue, 30 Dec 2008 18:57:54 +0000
Subject: [slime-cvs] CVS slime
Message-ID: <E1LHjms-0003Q2-PP@common-lisp.net>

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

Modified Files:
	swank.lisp swank-scl.lisp swank-sbcl.lisp swank-openmcl.lisp 
	swank-lispworks.lisp swank-ecl.lisp swank-corman.lisp 
	swank-cmucl.lisp swank-clisp.lisp swank-backend.lisp 
	swank-allegro.lisp swank-abcl.lisp slime.el ChangeLog 
Log Message:
	As of now, `C-u C-c C-c' compiled a function with maximum debug
	settings (SBCL only.)

	Now, `M-- C-c C-c' will compile a function with maximum _speed_
	settings (still SBCL only) --- useful to elicit compiler notes.

	* slime.el (slime-compilation-debug-level): Renamed to
	`slime-compilation-policy'.
	(slime-normalize-optimization-level): Renamed to
	`slime-compute-policy'.

	* swank.lisp (compile-string-for-emacs): Takes a policy now.
	(compile-multiple-strings-for-emacs): Ditto.

	* swank-backend.lisp (swank-compile-string): Change :DEBUG key arg
	to :POLICY.

	* swank-scl.lisp, swank-openmcl.lisp, swank-lispworks.lisp
	* swank-ecl.lisp, swank-corman.lisp, swank-cmucl.lisp,
	* swank-clisp.lisp, swank-allegro.lisp, swank-sbcl.lisp:

	Changed accordingly.


--- /project/slime/cvsroot/slime/swank.lisp	2008/12/27 18:24:29	1.617
+++ /project/slime/cvsroot/slime/swank.lisp	2008/12/30 18:57:54	1.618
@@ -2541,7 +2541,7 @@
            (declare (ignore output-pathname warnings?))
            (not failure?)))))))
 
-(defslimefun compile-string-for-emacs (string buffer position directory debug)
+(defslimefun compile-string-for-emacs (string buffer position directory policy)
   "Compile STRING (exerpted from BUFFER at POSITION).
 Record compiler notes signalled as `compiler-condition's."
   (with-buffer-syntax ()
@@ -2552,9 +2552,9 @@
                                :buffer buffer
                                :position position 
                                :directory directory
-                               :debug debug))))))
+                               :policy policy))))))
 
-(defslimefun compile-multiple-strings-for-emacs (strings debug)
+(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
@@ -2566,7 +2566,7 @@
                                      :buffer buffer
                                      :position position 
                                      :directory directory
-                                     :debug debug)))))))
+                                     :policy policy)))))))
 
 (defun file-newer-p (new-file old-file)
   "Returns true if NEW-FILE is newer than OLD-FILE."
--- /project/slime/cvsroot/slime/swank-scl.lisp	2008/10/17 21:26:53	1.29
+++ /project/slime/cvsroot/slime/swank-scl.lisp	2008/12/30 18:57:54	1.30
@@ -452,8 +452,8 @@
                       (not (load output-file)))))))))
 
 (defimplementation swank-compile-string (string &key buffer position directory
-                                                debug)
-  (declare (ignore directory debug))
+                                                policy)
+  (declare (ignore directory policy))
   (with-compilation-hooks ()
     (let ((*buffer-name* buffer)
           (*buffer-start-position* position)
--- /project/slime/cvsroot/slime/swank-sbcl.lisp	2008/10/30 09:28:51	1.227
+++ /project/slime/cvsroot/slime/swank-sbcl.lisp	2008/12/30 18:57:54	1.228
@@ -502,19 +502,27 @@
   "Return a temporary file name to compile strings into."
   (concatenate 'string (tmpnam nil) ".lisp"))
 
+(defun get-compiler-policy (default-policy)
+  (declare (ignorable default-policy))
+  #+#.(swank-backend::sbcl-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)
+   (loop for (qual . value) in policy
+         do (sb-ext:restrict-compiler-policy qual value)))
+
 (defimplementation swank-compile-string (string &key buffer position directory
-                                                debug)
-  (declare (ignorable debug))
+                                                policy)
   (let ((*buffer-name* buffer)
         (*buffer-offset* position)
         (*buffer-substring* string)
         (filename (temp-file-name))
-        #+#.(swank-backend::sbcl-with-symbol 'restrict-compiler-policy 'sb-ext)
-        (old-min-debug (assoc 'debug (sb-ext:restrict-compiler-policy)))
-        )
-    #+#.(swank-backend::sbcl-with-symbol 'restrict-compiler-policy 'sb-ext)
-    (when debug
-      (sb-ext:restrict-compiler-policy 'debug debug))
+        (saved-policy (get-compiler-policy '((debug . 0) (speed . 0)))))
+    (when policy
+      (set-compiler-policy policy))
     (flet ((load-it (filename)
              (when filename (load filename)))
            (compile-it (cont)
@@ -532,9 +540,7 @@
                (compile-it #'load-it)
                (load-it (compile-it #'identity)))
         (ignore-errors
-          #+#.(swank-backend::sbcl-with-symbol
-               'restrict-compiler-policy 'sb-ext)
-          (sb-ext:restrict-compiler-policy 'debug (or old-min-debug 0))
+          (set-compiler-policy saved-policy)
           (delete-file filename)
           (delete-file (compile-file-pathname filename)))))))
 
--- /project/slime/cvsroot/slime/swank-openmcl.lisp	2008/12/29 19:03:20	1.148
+++ /project/slime/cvsroot/slime/swank-openmcl.lisp	2008/12/30 18:57:54	1.149
@@ -369,8 +369,8 @@
    :test 'equal))
 
 (defimplementation swank-compile-string (string &key buffer position directory
-                                         debug)
-  (declare (ignore debug))
+                                         policy)
+  (declare (ignore policy))
   (with-compilation-hooks ()
     (let ((*buffer-name* buffer)
           (*buffer-offset* position)
--- /project/slime/cvsroot/slime/swank-lispworks.lisp	2008/10/31 14:13:19	1.123
+++ /project/slime/cvsroot/slime/swank-lispworks.lisp	2008/12/30 18:57:54	1.124
@@ -621,8 +621,8 @@
 	   htab))
 
 (defimplementation swank-compile-string (string &key buffer position directory
-                                                debug)
-  (declare (ignore directory debug))
+                                                policy)
+  (declare (ignore directory policy))
   (assert buffer)
   (assert position)
   (let* ((location (list :emacs-buffer buffer position string))
--- /project/slime/cvsroot/slime/swank-ecl.lisp	2008/10/17 21:26:53	1.35
+++ /project/slime/cvsroot/slime/swank-ecl.lisp	2008/12/30 18:57:54	1.36
@@ -146,8 +146,8 @@
       (compile-file *compile-filename* :load t))))
 
 (defimplementation swank-compile-string (string &key buffer position directory
-                                                debug)
-  (declare (ignore directory debug))
+                                                policy)
+  (declare (ignore directory policy))
   (with-compilation-hooks ()
     (let ((*buffer-name* buffer)
           (*buffer-start-position* position)
--- /project/slime/cvsroot/slime/swank-corman.lisp	2008/10/19 20:03:34	1.20
+++ /project/slime/cvsroot/slime/swank-corman.lisp	2008/12/30 18:57:54	1.21
@@ -372,8 +372,8 @@
 		(or failure? (and load-p (load output-file))))))))
 
 (defimplementation swank-compile-string (string &key buffer position directory
-                                                debug)
-  (declare (ignore directory debug))
+                                                policy)
+  (declare (ignore directory policy))
   (with-compilation-hooks ()
     (let ((*buffer-name* buffer)
           (*buffer-position* position)
--- /project/slime/cvsroot/slime/swank-cmucl.lisp	2008/12/24 07:56:20	1.204
+++ /project/slime/cvsroot/slime/swank-cmucl.lisp	2008/12/30 18:57:54	1.205
@@ -395,8 +395,8 @@
                       (not (load output-file)))))))))
 
 (defimplementation swank-compile-string (string &key buffer position directory
-                                                debug)
-  (declare (ignore directory debug))
+                                                policy)
+  (declare (ignore directory policy))
   (with-compilation-hooks ()
     (let ((*buffer-name* buffer)
           (*buffer-start-position* position)
--- /project/slime/cvsroot/slime/swank-clisp.lisp	2008/10/19 20:03:34	1.84
+++ /project/slime/cvsroot/slime/swank-clisp.lisp	2008/12/30 18:57:54	1.85
@@ -635,8 +635,8 @@
                          (not (load fasl-file)))))))))
 
 (defimplementation swank-compile-string (string &key buffer position directory
-                                         debug)
-  (declare (ignore directory debug))
+                                         policy)
+  (declare (ignore directory policy))
   (with-compilation-hooks ()
     (let ((*buffer-name* buffer)
           (*buffer-offset* position))
--- /project/slime/cvsroot/slime/swank-backend.lisp	2008/12/24 07:56:20	1.164
+++ /project/slime/cvsroot/slime/swank-backend.lisp	2008/12/30 18:57:54	1.165
@@ -370,8 +370,8 @@
   (declare (ignore ignore))
   `(call-with-compilation-hooks (lambda () (progn , at body))))
 
-(definterface swank-compile-string (string &key buffer position directory 
-                                           debug)
+(definterface swank-compile-string (string &key buffer position directory
+                                           policy)
   "Compile source from STRING.
 During compilation, compiler conditions must be trapped and
 resignalled as COMPILER-CONDITIONs.
--- /project/slime/cvsroot/slime/swank-allegro.lisp	2008/10/21 20:38:05	1.119
+++ /project/slime/cvsroot/slime/swank-allegro.lisp	2008/12/30 18:57:54	1.120
@@ -316,8 +316,8 @@
          (not failure?)))))
 
 (defimplementation swank-compile-string (string &key buffer position directory
-                                                debug)
-  (declare (ignore debug))
+                                                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
   ;; the fasl file is corrupted if we use some other datatype.
--- /project/slime/cvsroot/slime/swank-abcl.lisp	2008/10/19 20:03:34	1.60
+++ /project/slime/cvsroot/slime/swank-abcl.lisp	2008/12/30 18:57:54	1.61
@@ -341,8 +341,8 @@
                            (not (load fn))))))))))
 
 (defimplementation swank-compile-string (string &key buffer position directory
-                                                debug)
-  (declare (ignore directory debug))
+                                                policy)
+  (declare (ignore directory policy))
   (let ((jvm::*resignal-compiler-warnings* t)
         (*abcl-signaled-conditions* nil))
     (handler-bind ((warning #'handle-compiler-warning))                 
--- /project/slime/cvsroot/slime/slime.el	2008/12/27 18:24:28	1.1083
+++ /project/slime/cvsroot/slime/slime.el	2008/12/30 18:57:54	1.1084
@@ -2530,14 +2530,20 @@
              slime-maybe-show-xrefs-for-notes
              slime-goto-first-note))
 
-(defvar slime-compilation-debug-level nil
+(defvar slime-compilation-policy nil
   "When non-nil compile defuns with this debug optimization level.")
 
-(defun slime-normalize-optimization-level (n)
-  (cond ((not n) nil)
-        ((> n 3) 3)
-        ((< n 0) 0)
-        (t n)))
+(defun slime-compute-policy (arg)
+  (flet ((between (min n max)
+           (if (< n min)
+               min
+               (if (> n max) max n))))
+    (let ((n (prefix-numeric-value arg)))
+      (cond ((not arg)   slime-compilation-policy)
+            ((plusp n)   `((cl:debug . ,(between 0 n 3))))
+            ((eq arg '-) `((cl:speed . 3)))
+            (t           `((cl:speed . ,(between 0 (abs n) 3))))))))
+
 
 (defstruct (slime-compilation-result
              (:type list)
@@ -2592,9 +2598,7 @@
 with maximum debug setting. If invoked with a numeric prefix arg,
 compile with a debug setting of that number."
   (interactive "P")
-  (let* ((prefix-arg (and raw-prefix-arg (prefix-numeric-value raw-prefix-arg)))
-         (debug-level (slime-normalize-optimization-level prefix-arg)) 
-         (slime-compilation-debug-level debug-level))
+  (let ((slime-compilation-policy (slime-compute-policy raw-prefix-arg)))
     (apply #'slime-compile-region (slime-region-for-defun-at-point))))
 
 (defun slime-compile-region (start end)
@@ -2616,7 +2620,7 @@
      ,(buffer-name)
      ,start-offset
      ,(if (buffer-file-name) (file-name-directory (buffer-file-name)))
-     ',slime-compilation-debug-level)
+     ',slime-compilation-policy)
    #'slime-compilation-finished))
 
 (defun slime-compilation-finished (result)
@@ -2682,12 +2686,12 @@
 
 ;;;;; Recompilation.
 
-(defun slime-recompile-location (location &optional debug-level)
+(defun slime-recompile-location (location)
   (save-excursion
     (slime-goto-source-location location)
-    (slime-compile-defun debug-level)))
+    (slime-compile-defun)))
 
-(defun slime-recompile-locations (locations debug-level cont)
+(defun slime-recompile-locations (locations cont)
   (slime-eval-async 
    `(swank:compile-multiple-strings-for-emacs
      ',(loop for loc in locations collect
@@ -2702,7 +2706,7 @@
                        (if (buffer-file-name)
                            (file-name-directory (buffer-file-name))
                          nil)))))
-     ,debug-level)
+     ',slime-compilation-policy)
    cont))
 
 
@@ -4916,28 +4920,24 @@
 
 (defun slime-recompile-xref (&optional raw-prefix-arg)
   (interactive "P")
-  (let* ((prefix-arg (and raw-prefix-arg 
-                          (prefix-numeric-value raw-prefix-arg)))
-         (debug-level (slime-normalize-optimization-level prefix-arg)))
+  (let ((slime-compilation-policy (slime-compute-policy raw-prefix-arg)))
     (let ((location (slime-xref-location-at-point))
           (dspec    (slime-xref-dspec-at-point)))
       (slime-recompile-locations 
-       (list location) debug-level
+       (list location)
        (slime-rcurry #'slime-xref-recompilation-cont
                      (list dspec) (current-buffer))))))
 
 (defun slime-recompile-all-xrefs (&optional raw-prefix-arg)
   (interactive "P")
-  (let* ((prefix-arg (and raw-prefix-arg 
-                          (prefix-numeric-value raw-prefix-arg)))
-         (debug-level (slime-normalize-optimization-level prefix-arg)))
+  (let ((slime-compilation-policy (slime-compute-policy raw-prefix-arg)))
     (let ((dspecs) (locations))
       (dolist (xref (slime-all-xrefs))
         (when (slime-xref-has-location-p xref)
           (push (slime-xref.dspec xref) dspecs)
           (push (slime-xref.location xref) locations)))
       (slime-recompile-locations 
-       locations debug-level 
+       locations
        (slime-rcurry #'slime-xref-recompilation-cont
                      dspecs (current-buffer))))))
 
@@ -6034,16 +6034,14 @@
   (interactive "P")
   (slime-eval-async
    `(swank:frame-source-location-for-emacs ,(sldb-frame-number-at-point))
-   (lexical-let ((debug-level (slime-normalize-optimization-level
-                               (and raw-prefix-arg 
-                                    (prefix-numeric-value raw-prefix-arg)))))
+   (let ((slime-compilation-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 debug-level)))))))
+          (slime-recompile-location source-location)))))))
 
 
 ;;;; Thread control panel
--- /project/slime/cvsroot/slime/ChangeLog	2008/12/29 19:03:20	1.1609
+++ /project/slime/cvsroot/slime/ChangeLog	2008/12/30 18:57:54	1.1610
@@ -1,3 +1,28 @@
+2008-12-30  Tobias C. Rittweiler  <tcr at freebits.de>
+
+	As of now, `C-u C-c C-c' compiled a function with maximum debug
+	settings (SBCL only.)
+
+	Now, `M-- C-c C-c' will compile a function with maximum _speed_
+	settings (still SBCL only) --- useful to elicit compiler notes.
+
+	* slime.el (slime-compilation-debug-level): Renamed to
+	`slime-compilation-policy'.
+	(slime-normalize-optimization-level): Renamed to
+	`slime-compute-policy'.
+
+	* swank.lisp (compile-string-for-emacs): Takes a policy now.
+	(compile-multiple-strings-for-emacs): Ditto.
+
+	* swank-backend.lisp (swank-compile-string): Change :DEBUG key arg
+	to :POLICY.
+
+	* swank-scl.lisp, swank-openmcl.lisp, swank-lispworks.lisp
+	* swank-ecl.lisp, swank-corman.lisp, swank-cmucl.lisp,
+	* swank-clisp.lisp, swank-allegro.lisp, swank-sbcl.lisp:
+
+	Changed accordingly.
+
 2008-12-29  Helmut Eller  <heller at common-lisp.net>
 
 	* swank-openmcl.lisp (find-definitions, source-locations): Use




From trittweiler at common-lisp.net  Tue Dec 30 19:04:07 2008
From: trittweiler at common-lisp.net (CVS User trittweiler)
Date: Tue, 30 Dec 2008 19:04:07 +0000
Subject: [slime-cvs] CVS slime/contrib
Message-ID: <E1LHjst-0004B5-02@common-lisp.net>

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

Modified Files:
	slime-repl.el ChangeLog 
Log Message:
	* slime-repl.lisp (slime-repl-set-package): Set
	`slime-buffer-package' to the new package name. Otherwise, a ,!p
	repl command is not properly taken into account resulting in
	misbehaviour of completion and arglist display.


--- /project/slime/cvsroot/slime/contrib/slime-repl.el	2008/12/27 21:27:30	1.7
+++ /project/slime/cvsroot/slime/contrib/slime-repl.el	2008/12/30 19:04:06	1.8
@@ -853,6 +853,7 @@
           (slime-repl-shortcut-eval `(swank:set-package ,package))
         (setf (slime-lisp-package) name)
         (setf (slime-lisp-package-prompt-string) prompt-string)
+        (setf slime-buffer-package name)
         (slime-repl-insert-prompt)
         (insert unfinished-input)))))
 
--- /project/slime/cvsroot/slime/contrib/ChangeLog	2008/12/30 17:17:08	1.155
+++ /project/slime/cvsroot/slime/contrib/ChangeLog	2008/12/30 19:04:06	1.156
@@ -1,5 +1,12 @@
 2008-12-30  Tobias C. Rittweiler  <tcr at freebits.de>
 
+	* slime-repl.lisp (slime-repl-set-package): Set
+	`slime-buffer-package' to the new package name. Otherwise, a ,!p
+	repl command is not properly taken into account resulting in
+	misbehaviour of completion and arglist display.
+
+2008-12-30  Tobias C. Rittweiler  <tcr at freebits.de>
+
 	* slime-sbcl-exts.el, swank-sbcl-exts.lisp: New contrib.
 
 	This is the place for SBCL specific extensions and customizations




From heller at common-lisp.net  Wed Dec 31 11:25:03 2008
From: heller at common-lisp.net (CVS User heller)
Date: Wed, 31 Dec 2008 11:25:03 +0000
Subject: [slime-cvs] CVS slime
Message-ID: <E1LHzCB-00051X-RC@common-lisp.net>

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

Modified Files:
	ChangeLog slime.el swank-backend.lisp swank-lispworks.lisp 
	swank.lisp 
Log Message:
* slime.el ([test] find-definition.2): Also fails for Lispworks.
([test] interrupt-at-toplevel, [test] interrupt-in-debugger): Those
don't work well if there's no REPL thread.

* swank-backend.lisp (wait-for-input, wait-for-one-stream): Don't
use PEEK-CHAR because we can't interrupt that cleanly.
* swank.lisp (simple-serve-requests): Run the REPL inside
WITH-CONNECTION.
* swank-lispworks.lisp (emacs-connected): Don't install the signal
handler here ...
(install-sigint-handler): ... use this instead

--- /project/slime/cvsroot/slime/ChangeLog	2008/12/30 18:57:54	1.1610
+++ /project/slime/cvsroot/slime/ChangeLog	2008/12/31 11:25:02	1.1611
@@ -23,6 +23,20 @@
 
 	Changed accordingly.
 
+2008-12-31  Helmut Eller  <heller at common-lisp.net>
+
+	* slime.el ([test] find-definition.2): Also fails for Lispworks.
+	([test] interrupt-at-toplevel, [test] interrupt-in-debugger): Those
+	don't work well if there's no REPL thread.
+
+	* swank-backend.lisp (wait-for-input, wait-for-one-stream): Don't
+	use PEEK-CHAR because we can't interrupt that cleanly.
+	* swank.lisp (simple-serve-requests): Run the REPL inside
+	WITH-CONNECTION.
+	* swank-lispworks.lisp (emacs-connected): Don't install the signal
+	handler here ...
+	(install-sigint-handler): ... use this instead
+
 2008-12-29  Helmut Eller  <heller at common-lisp.net>
 
 	* swank-openmcl.lisp (find-definitions, source-locations): Use
--- /project/slime/cvsroot/slime/slime.el	2008/12/30 18:57:54	1.1084
+++ /project/slime/cvsroot/slime/slime.el	2008/12/31 11:25:03	1.1085
@@ -7413,7 +7413,7 @@
            (= orig-pos (point)))))
     (slime-check-top-level))
 
-(def-slime-test (find-definition.2 ("ccl" "allegro"))
+(def-slime-test (find-definition.2 ("ccl" "allegro" "lispworks"))
     (buffer-content buffer-package snippet)
     "Check that we're able to find definitions even when
 confronted with nasty #.-fu."
@@ -7842,15 +7842,18 @@
     "Let's see what happens if we send a user interrupt at toplevel."
     '(())
   (slime-check-top-level)
-  (slime-interrupt)
-  (slime-wait-condition "Debugger visible" 
-                        (lambda () 
-                          (and (slime-sldb-level= 1)
-                               (get-buffer-window (sldb-get-default-buffer))))
-                        5)
-  (with-current-buffer (sldb-get-default-buffer)
-    (sldb-quit))
-  (slime-sync-to-top-level 5))
+  (unless (and (eq (slime-communication-style) :spawn)
+               (not (featurep 'slime-repl)))
+    (slime-interrupt)
+    (slime-wait-condition 
+     "Debugger visible" 
+     (lambda () 
+       (and (slime-sldb-level= 1)
+            (get-buffer-window (sldb-get-default-buffer))))
+     5)
+    (with-current-buffer (sldb-get-default-buffer)
+      (sldb-quit))
+    (slime-sync-to-top-level 5)))
 
 (def-slime-test interrupt-in-debugger (interrupts continues)
     "Let's see what happens if we interrupt the debugger.
@@ -7858,6 +7861,11 @@
 CONTINUES  ... how often the continue restart should be invoked"
     '((1 0) (2 1) (4 2))
   (slime-check "No debugger" (not (sldb-get-default-buffer)))
+  (when (and (eq (slime-communication-style) :spawn)
+             (not (featurep 'slime-repl)))
+    (slime-eval-async '(swank::without-slime-interrupts
+                        (swank::receive)))
+    (sit-for 0.2))
   (dotimes (i interrupts)
     (slime-interrupt)
     (let ((level (1+ i)))
--- /project/slime/cvsroot/slime/swank-backend.lisp	2008/12/30 18:57:54	1.165
+++ /project/slime/cvsroot/slime/swank-backend.lisp	2008/12/31 11:25:03	1.166
@@ -1066,24 +1066,21 @@
 
 Return :interrupt if an interrupt occurs while waiting."
   (assert (member timeout '(nil t)))
-  (cond ((null (cdr streams)) 
+  (cond #+(or)
+        ((null (cdr streams)) 
          (wait-for-one-stream (car streams) timeout))
         (t
          (wait-for-streams streams timeout))))
 
 (defun wait-for-streams (streams timeout)
-  (flet ((readyp (s)
-           (let ((c (read-char-no-hang s nil :eof)))
-             (or (eq c :eof)
-                 (and c (progn (unread-char c s) t))
-                 c))))
-    (loop
-     (let ((ready (remove-if-not #'readyp streams)))
-       (when ready (return ready)))
-     (when timeout (return nil))
-     (when (check-slime-interrupts) (return :interrupt))
-     (sleep 0.1))))
+  (loop
+   (when (check-slime-interrupts) (return :interrupt))
+   (let ((ready (remove-if-not #'stream-readable-p streams)))
+     (when ready (return ready)))
+   (when timeout (return nil))
+   (sleep 0.1)))
 
+;; Note: Usually we can't interrupt PEEK-CHAR cleanly.
 (defun wait-for-one-stream (stream timeout)
   (ecase timeout
     ((nil)
@@ -1097,6 +1094,12 @@
               (list stream))
              (t '()))))))
 
+(defun stream-readable-p (stream)
+  (let ((c (read-char-no-hang stream nil :eof)))
+    (cond ((not c) nil)
+          ((eq c :eof) t)
+          (t (unread-char c stream) t))))
+
 (definterface toggle-trace (spec)
   "Toggle tracing of the function(s) given with SPEC.
 SPEC can be:
--- /project/slime/cvsroot/slime/swank-lispworks.lisp	2008/12/30 18:57:54	1.124
+++ /project/slime/cvsroot/slime/swank-lispworks.lisp	2008/12/31 11:25:03	1.125
@@ -102,12 +102,6 @@
            (apply (read-from-string "FLEXI-STREAMS:MAKE-EXTERNAL-FORMAT")
                   external-format)))
 
-(defun set-sigint-handler ()
-  ;; Set SIGINT handler on Swank request handler thread.
-  #-win32
-  (sys::set-signal-handler +sigint+ 
-                           (make-sigint-handler mp:*current-process*)))
-
 ;;; Coding Systems
 
 (defun valid-external-format-p (external-format)
@@ -141,6 +135,20 @@
     (declare (ignore args))
     (mp:process-interrupt process #'sigint-handler)))
 
+(defun set-sigint-handler ()
+  ;; Set SIGINT handler on Swank request handler thread.
+  #-win32
+  (sys::set-signal-handler +sigint+ 
+                           (make-sigint-handler mp:*current-process*)))
+
+#-win32 
+(defimplementation install-sigint-handler (handler)
+  (sys::set-signal-handler +sigint+
+                           (let ((self mp:*current-process*))
+                             (lambda (&rest args)
+                               (declare (ignore args))
+                               (mp:process-interrupt self handler)))))
+
 (defimplementation call-without-interrupts (fn)
   (lw:without-interrupts (funcall fn)))
   
@@ -819,7 +827,7 @@
            (return (car tail)))))
      (when (eq timeout t) (return (values nil t)))
      (mp:process-wait-with-timeout 
-      "receive-if" 0.2 (lambda () (some test (mailbox.queue mbox)))))))
+      "receive-if" 0.3 (lambda () (some test (mailbox.queue mbox)))))))
 
 (defimplementation send (thread message)
   (let ((mbox (mailbox thread)))
@@ -830,11 +838,6 @@
 ;;; Some intergration with the lispworks environment
 
 (defun swank-sym (name) (find-symbol (string name) :swank))
-
-(defimplementation emacs-connected ()
-  (when (eq (eval (swank-sym :*communication-style*))
-            nil)
-    (set-sigint-handler)))
       
 
 ;;;; Weak hashtables
--- /project/slime/cvsroot/slime/swank.lisp	2008/12/30 18:57:54	1.618
+++ /project/slime/cvsroot/slime/swank.lisp	2008/12/31 11:25:03	1.619
@@ -362,17 +362,19 @@
   `(with-interrupts-enabled% nil ,body))
 
 (defun invoke-or-queue-interrupt (function)
-  (log-event "invoke-or-queue-interrupt: ~a" function)
+  (log-event "invoke-or-queue-interrupt: ~a~%" function)
   (cond ((not (boundp '*slime-interrupts-enabled*))
          (without-slime-interrupts
            (funcall function)))
         (*slime-interrupts-enabled*
+         (log-event "interrupts-enabled~%")
          (funcall function))
         (t
          (setq *pending-slime-interrupts*
                (nconc *pending-slime-interrupts*
                       (list function)))
          (cond ((cdr *pending-slime-interrupts*)
+                (log-event "too many queued interrupts~%")
                 (check-slime-interrupts))
                (t
                 (log-event "queue-interrupt: ~a" function)
@@ -1036,8 +1038,8 @@
          (current-thread))
         (t
          (let ((thread (connection.repl-thread connection)))
-           (assert thread)
-           (cond ((thread-alive-p thread) thread)
+           (cond ((not thread) nil)
+                 ((thread-alive-p thread) thread)
                  (t
                   (setf (connection.repl-thread connection)
                         (spawn-repl-thread connection "new-repl-thread"))))))))
@@ -1053,9 +1055,13 @@
 
 (defun interrupt-worker-thread (id)
   (let ((thread (or (find-worker-thread id)
-                    (find-repl-thread *emacs-connection*))))
+                    (find-repl-thread *emacs-connection*)
+                    ;; FIXME: to something better here
+                    (spawn (lambda ()) :name "ephemeral"))))
+    (log-event "interrupt-worker-thread: ~a ~a~%" id thread)
+    (assert thread)
     (signal-interrupt thread
-                      (lambda () 
+                      (lambda ()
                         (invoke-or-queue-interrupt #'simple-break)))))
 
 (defun thread-for-evaluation (id)
@@ -1134,8 +1140,8 @@
          (send (connection.control-thread *emacs-connection*) event))
         (t (dispatch-event event))))
 
-(defun signal-interrupt (thread interrupt)  
-  (log-event "signal-interrupt~%")
+(defun signal-interrupt (thread interrupt)
+  (log-event "signal-interrupt [~a]: ~a ~a~%" (use-threads-p) thread interrupt)
   (cond ((use-threads-p) (interrupt-thread thread interrupt))
         (t (funcall interrupt))))
 
@@ -1269,7 +1275,8 @@
             (let* ((stdin (real-input-stream *standard-input*))
                    (*standard-input* (make-repl-input-stream connection 
                                                              stdin)))
-              (simple-repl)))))
+	      (with-connection (connection)
+		(simple-repl))))))
     (close-connection connection nil (safe-backtrace))))
 
 (defun simple-repl ()
@@ -2416,7 +2423,8 @@
 (defslimefun throw-to-toplevel ()
   "Invoke the ABORT-REQUEST restart abort an RPC from Emacs.
 If we are not evaluating an RPC then ABORT instead."
-  (let ((restart (and *sldb-quit-restart*
+  (let ((restart (and (boundp '*sldb-quit-restart*)
+                      (typep *sldb-quit-restart* 'restart)
                       (find-restart *sldb-quit-restart*))))
     (cond (restart (invoke-restart restart))
           (t "No toplevel restart active"))))




From heller at common-lisp.net  Wed Dec 31 11:25:20 2008
From: heller at common-lisp.net (CVS User heller)
Date: Wed, 31 Dec 2008 11:25:20 +0000
Subject: [slime-cvs] CVS slime
Message-ID: <E1LHzCS-00052P-EC@common-lisp.net>

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

Modified Files:
	ChangeLog slime.el 
Log Message:
* slime.el (slime-cd, slime-pwd): New commands.
(slime-change-directory): New function.
(slime-change-directory-hooks): New hook.

* inferior-slime.el (inferior-slime-change-directory): New
function.
(inferior-slime-init): Hook it in.

--- /project/slime/cvsroot/slime/ChangeLog	2008/12/31 11:25:02	1.1611
+++ /project/slime/cvsroot/slime/ChangeLog	2008/12/31 11:25:19	1.1612
@@ -25,6 +25,12 @@
 
 2008-12-31  Helmut Eller  <heller at common-lisp.net>
 
+	* slime.el (slime-cd, slime-pwd): New commands.
+	(slime-change-directory): New function.
+	(slime-change-directory-hooks): New hook.
+
+2008-12-31  Helmut Eller  <heller at common-lisp.net>
+
 	* slime.el ([test] find-definition.2): Also fails for Lispworks.
 	([test] interrupt-at-toplevel, [test] interrupt-in-debugger): Those
 	don't work well if there's no REPL thread.
--- /project/slime/cvsroot/slime/slime.el	2008/12/31 11:25:03	1.1085
+++ /project/slime/cvsroot/slime/slime.el	2008/12/31 11:25:19	1.1086
@@ -4477,6 +4477,29 @@
   (let ((lisp-filename (slime-to-lisp-filename (expand-file-name filename))))
     (slime-eval-with-transcript `(swank:load-file ,lisp-filename))))
 
+(defvar slime-change-directory-hooks nil
+  "Hook run by `slime-change-directory'.
+The functions are called with the new (absolute) directory.")
+
+(defun slime-change-directory (directory)
+  "Make DIRECTORY become Lisp's current directory.
+Return whatever swank:set-default-directory returns."
+  (let ((dir (expand-file-name directory)))
+    (prog1 (slime-eval `(swank:set-default-directory
+                         ,(slime-to-lisp-filename dir)))
+      (run-hook-with-args 'slime-change-directory-hooks dir))))
+ 
+(defun slime-cd (directory)
+  "Make DIRECTORY become Lisp's current directory.
+Return whatever swank:set-default-directory returns."
+  (interactive (list (read-directory-name "Directory: " nil nil t)))
+  (message "default-directory: %s" (slime-change-directory directory)))
+
+(defun slime-pwd ()
+  "Show Lisp's default directory."
+  (interactive)
+  (message "Directory %s" (slime-eval `(swank:default-directory))))
+
 
 ;;;; Profiling
 




From heller at common-lisp.net  Wed Dec 31 11:25:22 2008
From: heller at common-lisp.net (CVS User heller)
Date: Wed, 31 Dec 2008 11:25:22 +0000
Subject: [slime-cvs] CVS slime/contrib
Message-ID: <E1LHzCU-00052q-F0@common-lisp.net>

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

Modified Files:
	ChangeLog inferior-slime.el 
Log Message:
* slime.el (slime-cd, slime-pwd): New commands.
(slime-change-directory): New function.
(slime-change-directory-hooks): New hook.

* inferior-slime.el (inferior-slime-change-directory): New
function.
(inferior-slime-init): Hook it in.

--- /project/slime/cvsroot/slime/contrib/ChangeLog	2008/12/30 19:04:06	1.156
+++ /project/slime/cvsroot/slime/contrib/ChangeLog	2008/12/31 11:25:22	1.157
@@ -29,6 +29,12 @@
 	operator name as first argument if point is located at the
 	operator name.
 
+2008-12-31  Helmut Eller  <heller at common-lisp.net>
+
+	* inferior-slime.el (inferior-slime-change-directory): New
+	function.
+	(inferior-slime-init): Hook it in.
+
 2008-12-27  Helmut Eller  <heller at common-lisp.net>
 
 	* slime-repl.el (slime-repl-event-hook-function): Handle
--- /project/slime/cvsroot/slime/contrib/inferior-slime.el	2008/12/26 07:22:56	1.4
+++ /project/slime/cvsroot/slime/contrib/inferior-slime.el	2008/12/31 11:25:22	1.5
@@ -69,6 +69,14 @@
       (insert ")")))
   (comint-send-input))
 
+(defun inferior-slime-change-directory (directory)
+  "Set default-directory in the *inferior-lisp* buffer to DIRECTORY."
+  (let* ((proc (slime-process))
+	 (buffer (and proc (process-buffer proc))))
+    (when buffer 
+      (with-current-buffer buffer
+	(cd-absolute directory)))))
+
 (defun inferior-slime-init-keymap ()
   (let ((map inferior-slime-mode-map))
     (slime-define-keys map
@@ -89,13 +97,14 @@
 (inferior-slime-init-keymap)
 
 (defun inferior-slime-hook-function ()
-  (inferior-slime-mode))
+  (inferior-slime-mode 1))
 
 (defun inferior-slime-switch-to-repl-buffer ()
   (switch-to-buffer (process-buffer (slime-inferior-process))))
 
 (defun inferior-slime-init ()
   (add-hook 'slime-inferior-process-start-hook 'inferior-slime-hook-function)
+  (add-hook 'slime-change-directory-hooks 'inferior-slime-change-directory)
   (def-slime-selector-method ?r
     "SLIME Read-Eval-Print-Loop."
     (inferior-slime-switch-to-repl-buffer)))




From heller at common-lisp.net  Wed Dec 31 11:25:30 2008
From: heller at common-lisp.net (CVS User heller)
Date: Wed, 31 Dec 2008 11:25:30 +0000
Subject: [slime-cvs] CVS slime
Message-ID: <E1LHzCc-00053n-U0@common-lisp.net>

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

Modified Files:
	ChangeLog swank-openmcl.lisp 
Log Message:
* swank-openmcl.lisp ([method] source-locations (symbol)): Drop
the unused _; the compiler dosn't like it.

--- /project/slime/cvsroot/slime/ChangeLog	2008/12/31 11:25:19	1.1612
+++ /project/slime/cvsroot/slime/ChangeLog	2008/12/31 11:25:30	1.1613
@@ -25,6 +25,13 @@
 
 2008-12-31  Helmut Eller  <heller at common-lisp.net>
 
+	* swank-openmcl.lisp ([method] source-locations (symbol)): Drop
+	the unused _; the compiler dosn't like it.
+
+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.
--- /project/slime/cvsroot/slime/swank-openmcl.lisp	2008/12/30 18:57:54	1.149
+++ /project/slime/cvsroot/slime/swank-openmcl.lisp	2008/12/31 11:25:30	1.150
@@ -749,7 +749,7 @@
               (not (special-operator-p s))
               (functionp (symbol-function s)))
          (source-locations (symbol-function s)))
-     (loop for ((type . name) source . _) in (ccl:find-definition-sources s) 
+     (loop for ((type . name) source) in (ccl:find-definition-sources s)
            collect (cons (source-note-to-source-location 
                           source (lambda () "No source info available"))
                          (definition-name type name)))))




From heller at common-lisp.net  Wed Dec 31 11:25:39 2008
From: heller at common-lisp.net (CVS User heller)
Date: Wed, 31 Dec 2008 11:25:39 +0000
Subject: [slime-cvs] CVS slime
Message-ID: <E1LHzCl-00054d-LU@common-lisp.net>

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

Modified Files:
	ChangeLog swank.lisp 
Log Message:
* swank.lisp (maybe-redirect-global-io): Don't consider
connections without streams.
(*new-connection-hook*): Don't add MAYBE-REDIRECT-GLOBAL-IO.
(create-repl): Call MAYBE-REDIRECT-GLOBAL-IO here.

--- /project/slime/cvsroot/slime/ChangeLog	2008/12/31 11:25:30	1.1613
+++ /project/slime/cvsroot/slime/ChangeLog	2008/12/31 11:25:39	1.1614
@@ -25,6 +25,13 @@
 
 2008-12-31  Helmut Eller  <heller at common-lisp.net>
 
+	* swank.lisp (maybe-redirect-global-io): Don't consider
+	connections without streams.
+	(*new-connection-hook*): Don't add MAYBE-REDIRECT-GLOBAL-IO.
+	(create-repl): Call MAYBE-REDIRECT-GLOBAL-IO here.
+
+2008-12-31  Helmut Eller  <heller at common-lisp.net>
+
 	* swank-openmcl.lisp ([method] source-locations (symbol)): Drop
 	the unused _; the compiler dosn't like it.
 
--- /project/slime/cvsroot/slime/swank.lisp	2008/12/31 11:25:03	1.619
+++ /project/slime/cvsroot/slime/swank.lisp	2008/12/31 11:25:39	1.620
@@ -1468,8 +1468,9 @@
 NIL if streams are not globally redirected.")
 
 (defun maybe-redirect-global-io (connection)
-  "Consider globally redirecting to a newly-established CONNECTION."
-  (when (and *globally-redirect-io* (null *global-stdio-connection*))
+  "Consider globally redirecting to CONNECTION."
+  (when (and *globally-redirect-io* (null *global-stdio-connection*)
+             (connection.user-io connection))
     (setq *global-stdio-connection* connection)
     (globally-redirect-io-to-connection connection)))
 
@@ -1484,7 +1485,6 @@
         (progn (revert-global-io-redirection)
                (setq *global-stdio-connection* nil)))))
 
-(add-hook *new-connection-hook*    'maybe-redirect-global-io)
 (add-hook *connection-closed-hook* 'update-redirection-after-close)
 
 ;;;;; Redirection during requests
@@ -1505,6 +1505,7 @@
               (*debug-io*        . ,(@ user-io))
               (*query-io*        . ,(@ user-io))
               (*terminal-io*     . ,(@ user-io))))
+      (maybe-redirect-global-io conn)
       (when (use-threads-p)
         (setf (@ repl-thread) (spawn-repl-thread conn "repl-thread")))
       (list (package-name *package*)




From heller at common-lisp.net  Wed Dec 31 11:25:46 2008
From: heller at common-lisp.net (CVS User heller)
Date: Wed, 31 Dec 2008 11:25:46 +0000
Subject: [slime-cvs] CVS slime
Message-ID: <E1LHzCs-00055K-JT@common-lisp.net>

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

Modified Files:
	ChangeLog 
Log Message:
Fix automatic merge.

--- /project/slime/cvsroot/slime/ChangeLog	2008/12/31 11:25:39	1.1614
+++ /project/slime/cvsroot/slime/ChangeLog	2008/12/31 11:25:46	1.1615
@@ -1,28 +1,3 @@
-2008-12-30  Tobias C. Rittweiler  <tcr at freebits.de>
-
-	As of now, `C-u C-c C-c' compiled a function with maximum debug
-	settings (SBCL only.)
-
-	Now, `M-- C-c C-c' will compile a function with maximum _speed_
-	settings (still SBCL only) --- useful to elicit compiler notes.
-
-	* slime.el (slime-compilation-debug-level): Renamed to
-	`slime-compilation-policy'.
-	(slime-normalize-optimization-level): Renamed to
-	`slime-compute-policy'.
-
-	* swank.lisp (compile-string-for-emacs): Takes a policy now.
-	(compile-multiple-strings-for-emacs): Ditto.
-
-	* swank-backend.lisp (swank-compile-string): Change :DEBUG key arg
-	to :POLICY.
-
-	* swank-scl.lisp, swank-openmcl.lisp, swank-lispworks.lisp
-	* swank-ecl.lisp, swank-corman.lisp, swank-cmucl.lisp,
-	* swank-clisp.lisp, swank-allegro.lisp, swank-sbcl.lisp:
-
-	Changed accordingly.
-
 2008-12-31  Helmut Eller  <heller at common-lisp.net>
 
 	* swank.lisp (maybe-redirect-global-io): Don't consider
@@ -57,6 +32,31 @@
 	handler here ...
 	(install-sigint-handler): ... use this instead
 
+2008-12-30  Tobias C. Rittweiler  <tcr at freebits.de>
+
+	As of now, `C-u C-c C-c' compiled a function with maximum debug
+	settings (SBCL only.)
+
+	Now, `M-- C-c C-c' will compile a function with maximum _speed_
+	settings (still SBCL only) --- useful to elicit compiler notes.
+
+	* slime.el (slime-compilation-debug-level): Renamed to
+	`slime-compilation-policy'.
+	(slime-normalize-optimization-level): Renamed to
+	`slime-compute-policy'.
+
+	* swank.lisp (compile-string-for-emacs): Takes a policy now.
+	(compile-multiple-strings-for-emacs): Ditto.
+
+	* swank-backend.lisp (swank-compile-string): Change :DEBUG key arg
+	to :POLICY.
+
+	* swank-scl.lisp, swank-openmcl.lisp, swank-lispworks.lisp
+	* swank-ecl.lisp, swank-corman.lisp, swank-cmucl.lisp,
+	* swank-clisp.lisp, swank-allegro.lisp, swank-sbcl.lisp:
+
+	Changed accordingly.
+
 2008-12-29  Helmut Eller  <heller at common-lisp.net>
 
 	* swank-openmcl.lisp (find-definitions, source-locations): Use




From heller at common-lisp.net  Wed Dec 31 11:25:47 2008
From: heller at common-lisp.net (CVS User heller)
Date: Wed, 31 Dec 2008 11:25:47 +0000
Subject: [slime-cvs] CVS slime/contrib
Message-ID: <E1LHzCt-00055S-2i@common-lisp.net>

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

Modified Files:
	ChangeLog 
Log Message:
Fix automatic merge.

--- /project/slime/cvsroot/slime/contrib/ChangeLog	2008/12/31 11:25:22	1.157
+++ /project/slime/cvsroot/slime/contrib/ChangeLog	2008/12/31 11:25:46	1.158
@@ -1,3 +1,9 @@
+2008-12-31  Helmut Eller  <heller at common-lisp.net>
+
+	* inferior-slime.el (inferior-slime-change-directory): New
+	function.
+	(inferior-slime-init): Hook it in.
+
 2008-12-30  Tobias C. Rittweiler  <tcr at freebits.de>
 
 	* slime-repl.lisp (slime-repl-set-package): Set
@@ -29,12 +35,6 @@
 	operator name as first argument if point is located at the
 	operator name.
 
-2008-12-31  Helmut Eller  <heller at common-lisp.net>
-
-	* inferior-slime.el (inferior-slime-change-directory): New
-	function.
-	(inferior-slime-init): Hook it in.
-
 2008-12-27  Helmut Eller  <heller at common-lisp.net>
 
 	* slime-repl.el (slime-repl-event-hook-function): Handle




From trittweiler at common-lisp.net  Wed Dec 31 12:31:32 2008
From: trittweiler at common-lisp.net (CVS User trittweiler)
Date: Wed, 31 Dec 2008 12:31:32 +0000
Subject: [slime-cvs] CVS slime/contrib
Message-ID: <E1LI0EW-0001Mz-Lh@common-lisp.net>

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

Modified Files:
	swank-sbcl-exts.lisp slime-sbcl-exts.el ChangeLog 
Log Message:

	* swank-sbcl-exts.lisp: Wrap file in a big #+sbcl (PROGN ...), so
	users can use the `slime-sbcl-exts' contrib in their .emacs
	nevermind what implementation they actually use.
	(Reported by Stas Boukarev)


--- /project/slime/cvsroot/slime/contrib/swank-sbcl-exts.lisp	2008/12/30 17:17:07	1.1
+++ /project/slime/cvsroot/slime/contrib/swank-sbcl-exts.lisp	2008/12/31 12:31:31	1.2
@@ -6,7 +6,14 @@
 ;;
 
 (in-package :swank)
-
+
+(swank-require :swank-arglists)
+
+;; We need to do this so users can place `slime-sbcl-exts' into their
+;; ~/.emacs, and still use any implementation they want.
+#+sbcl
+(progn
+  
 ;;; Display arglist of instructions.
 ;;;
 (defmethod compute-enriched-decoded-arglist ((operator-form (eql 'sb-assem:inst))
@@ -31,4 +38,6 @@
                           t))))))))
 
 
+) ; PROGN
+
 (provide :swank-sbcl-exts)
--- /project/slime/cvsroot/slime/contrib/slime-sbcl-exts.el	2008/12/30 17:17:08	1.1
+++ /project/slime/cvsroot/slime/contrib/slime-sbcl-exts.el	2008/12/31 12:31:32	1.2
@@ -8,8 +8,12 @@
 (require 'slime-autodoc)
 (require 'slime-references)
 
-(push '("INST" . (slime-make-extended-operator-parser/look-ahead 1))
-      slime-extended-operator-name-parser-alist)
+(defun slime-enable-autodoc-for-sb-assem:inst ()
+  (push '("INST" . (slime-make-extended-operator-parser/look-ahead 1))
+        slime-extended-operator-name-parser-alist))
+
+(defun slime-sbcl-exts-init ()
+  (slime-enable-autodoc-for-sb-assem:inst))
 
 (slime-require :swank-sbcl-exts)
 
--- /project/slime/cvsroot/slime/contrib/ChangeLog	2008/12/31 11:25:46	1.158
+++ /project/slime/cvsroot/slime/contrib/ChangeLog	2008/12/31 12:31:32	1.159
@@ -1,3 +1,10 @@
+2008-12-31  Tobias C. Rittweiler  <tcr at freebits.de>
+
+	* swank-sbcl-exts.lisp: Wrap file in a big #+sbcl (PROGN ...), so
+	users can use the `slime-sbcl-exts' contrib in their .emacs
+	nevermind what implementation they actually use.
+	(Reported by Stas Boukarev)
+
 2008-12-31  Helmut Eller  <heller at common-lisp.net>
 
 	* inferior-slime.el (inferior-slime-change-directory): New




From trittweiler at common-lisp.net  Wed Dec 31 16:55:26 2008
From: trittweiler at common-lisp.net (CVS User trittweiler)
Date: Wed, 31 Dec 2008 16:55:26 +0000
Subject: [slime-cvs] CVS slime/contrib
Message-ID: <E1LI4Lu-0002rb-D1@common-lisp.net>

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

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

	* swank-arglists.lisp (format-arglist-for-echo-area): Catch errors
	and die gracefully.


--- /project/slime/cvsroot/slime/contrib/swank-arglists.lisp	2008/12/30 17:12:11	1.24
+++ /project/slime/cvsroot/slime/contrib/swank-arglists.lisp	2008/12/31 16:55:26	1.25
@@ -458,7 +458,12 @@
 	     print-right-margin print-lines)
   "Formats ARGLIST (given as string) for Emacs' echo area."
   (declare (ignore operator highlight package print-right-margin print-lines))
-  (apply #'decoded-arglist-to-string (decode-arglist (read-from-string arglist)) args))
+  (handler-case
+      (apply #'decoded-arglist-to-string
+             (decode-arglist (read-from-string arglist))
+             args)
+    (error (e)
+      (format nil "ARGLIST (error): ~A" e))))
 
 (defun decoded-arglist-to-string (decoded-arglist
                                   &key operator highlight (package *package*)
--- /project/slime/cvsroot/slime/contrib/ChangeLog	2008/12/31 12:31:32	1.159
+++ /project/slime/cvsroot/slime/contrib/ChangeLog	2008/12/31 16:55:26	1.160
@@ -1,5 +1,10 @@
 2008-12-31  Tobias C. Rittweiler  <tcr at freebits.de>
 
+	* swank-arglists.lisp (format-arglist-for-echo-area): Catch errors
+	and die gracefully.
+
+2008-12-31  Tobias C. Rittweiler  <tcr at freebits.de>
+
 	* swank-sbcl-exts.lisp: Wrap file in a big #+sbcl (PROGN ...), so
 	users can use the `slime-sbcl-exts' contrib in their .emacs
 	nevermind what implementation they actually use.