From heller at common-lisp.net  Mon Feb  2 07:25:40 2004
From: heller at common-lisp.net (Helmut Eller)
Date: Mon, 02 Feb 2004 02:25:40 -0500
Subject: [slime-cvs] CVS update: slime/swank.lisp 
Message-ID: <E1AnYSi-00054L-00@common-lisp.net>

Update of /project/slime/cvsroot/slime
In directory common-lisp.net:/tmp/cvs-serv19445

Modified Files:
	swank.lisp 
Log Message:
(simple-break): Bind *debugger-hook* before invoking the debugger.
Fixes bug reported by Michael Livshin.
Date: Mon Feb  2 02:25:40 2004
Author: heller

Index: slime/swank.lisp
diff -u slime/swank.lisp:1.113 slime/swank.lisp:1.114
--- slime/swank.lisp:1.113	Sat Jan 31 15:17:19 2004
+++ slime/swank.lisp	Mon Feb  2 02:25:40 2004
@@ -351,11 +351,12 @@
   (loop (with-simple-restart (abort "Retstart dispatch loop.")
 	  (loop (dispatch-event (receive) socket-io)))))
 
-
 (defun simple-break ()
   (with-simple-restart  (continue "Continue from interrupt.")
-    (invoke-debugger (make-condition 'simple-error 
-                                     :format-control "Interrupt from Emacs"))))
+    (let ((*debugger-hook* #'swank-debugger-hook))
+      (invoke-debugger 
+       (make-condition 'simple-error 
+                       :format-control "Interrupt from Emacs")))))
 
 (defun interrupt-worker-thread (thread)
   (let ((thread (etypecase thread




From heller at common-lisp.net  Mon Feb  2 07:31:06 2004
From: heller at common-lisp.net (Helmut Eller)
Date: Mon, 02 Feb 2004 02:31:06 -0500
Subject: [slime-cvs] CVS update: slime/slime.el 
Message-ID: <E1AnYXy-0001uz-00@common-lisp.net>

Update of /project/slime/cvsroot/slime
In directory common-lisp.net:/tmp/cvs-serv7040

Modified Files:
	slime.el 
Log Message:
(slime-debugger): The customization group is called 'slime-debugger',
fix referrers.  Reported by Jouni K Seppanen.

Date: Mon Feb  2 02:31:06 2004
Author: heller

Index: slime/slime.el
diff -u slime/slime.el:1.201 slime/slime.el:1.202
--- slime/slime.el:1.201	Sat Jan 31 14:25:50 2004
+++ slime/slime.el	Mon Feb  2 02:31:06 2004
@@ -224,19 +224,19 @@
     `(defface ,facename
       '((t ,default))
       ,(format "Face for %s." description)
-      :group 'sldb)))
+      :group 'slime-debugger)))
 
 (defcustom sldb-enable-styled-backtrace t "Enable faces in slime backtrace" 
   :type '(choice 
 	  (const :tag "Enable" t)
 	  (const :tag "Disable" nil))
-  :group 'sldb)
+  :group 'slime-debugger)
 
 (defcustom sldb-show-catch-tags t "Show catch tags in frames" 
   :type '(choice 
 	  (const :tag "Show" t)
 	  (const :tag "Don't show" nil))
-  :group 'sldb)
+  :group 'slime-debugger)
 
 (def-sldb-face topline "top line describing error"
   (:bold t))




From heller at common-lisp.net  Mon Feb  2 07:31:29 2004
From: heller at common-lisp.net (Helmut Eller)
Date: Mon, 02 Feb 2004 02:31:29 -0500
Subject: [slime-cvs] CVS update: slime/ChangeLog 
Message-ID: <E1AnYYL-000222-00@common-lisp.net>

Update of /project/slime/cvsroot/slime
In directory common-lisp.net:/tmp/cvs-serv7680

Modified Files:
	ChangeLog 
Log Message:
*** empty log message ***
Date: Mon Feb  2 02:31:29 2004
Author: heller

Index: slime/ChangeLog
diff -u slime/ChangeLog:1.242 slime/ChangeLog:1.243
--- slime/ChangeLog:1.242	Sat Jan 31 15:23:57 2004
+++ slime/ChangeLog	Mon Feb  2 02:31:29 2004
@@ -1,3 +1,11 @@
+2004-02-02  Helmut Eller  <e9626484 at stud3.tuwien.ac.at>
+
+	* slime.el (slime-debugger): The customization group is called
+	'slime-debugger', fix referrers.  Reported by Jouni K Seppanen.
+
+	* swank.lisp (simple-break): Bind *debugger-hook* before invoking
+	the debugger.  Reported by Michael Livshin.
+
 2004-01-31  Robert E. Brown <bbrown at speakeasy.net>
 
 	* swank-sbcl.lisp, swank.lisp: Add more type declarations and
@@ -7,7 +15,6 @@
 
 	* slime.el (slime-path): Placed inside an eval-and-compile.  Works
 	around some problems when byte-compiling slime-changelog-date.
-	(slime-swank-connection-retries): 
 
 2004-01-31  Marco Baringer  <mb at bese.it>
 
@@ -26,7 +33,7 @@
 	
 2004-01-31 Helmut Eller  <e9626484 at stud3.tuwien.ac.at>
 
-	* Merge stateless-emacs branch into main trunk.  We use now signal
+	Merge stateless-emacs branch into main trunk.  We use now signal
 	driven IO for CMUCL and one thread per request for multithreaded
 	Lisps.
 




From ukintruded at uk.tk  Tue Feb  3 02:20:35 2004
From: ukintruded at uk.tk (Wfeek)
Date: Tue, 03 Feb 2004 02:20:35 -0000
Subject: [slime-cvs] sukper viagrma
Message-ID: <jpagh.036549yylvurab@Wfeekokmqezifbs>

It`s fabuklous!

I took the only one pijll of Cialjs and that was such a GREAT weekend!
All the girls at the party were just punch-drunk with my potential

I have fhcked all of them THREE times but my dhck WAS able to do some more!

Cbalis- it`s COOL!!! The best weekend stuff I've ever trhied!
Haven`t you tried yet?

DO IT NkOW at 
http://www.vow-meds.com/sv/index.php?pid=genviag

cowardice emitted passive expert maintains loved descend seems trailer.
 





From heller at common-lisp.net  Wed Feb  4 22:08:08 2004
From: heller at common-lisp.net (Helmut Eller)
Date: Wed, 04 Feb 2004 17:08:08 -0500
Subject: [slime-cvs] CVS update: slime/swank-openmcl.lisp 
Message-ID: <E1AoVBo-0000FE-00@common-lisp.net>

Update of /project/slime/cvsroot/slime
In directory common-lisp.net:/tmp/cvs-serv31712

Modified Files:
	swank-openmcl.lisp 
Log Message:
(mailbox): Use a semaphore instead of process-wait.  Works better with
native threads.  Patch by Bryan O'Conner.

Date: Wed Feb  4 17:08:08 2004
Author: heller

Index: slime/swank-openmcl.lisp
diff -u slime/swank-openmcl.lisp:1.58 slime/swank-openmcl.lisp:1.59
--- slime/swank-openmcl.lisp:1.58	Sat Jan 31 10:07:35 2004
+++ slime/swank-openmcl.lisp	Wed Feb  4 17:08:07 2004
@@ -590,6 +590,7 @@
 
 (defstruct (mailbox (:conc-name mailbox.)) 
   (mutex (ccl:make-lock "thread mailbox"))
+  (semaphore (ccl:make-semaphore))
   (queue '() :type list))
 
 (defimplementation spawn (fn &key name)
@@ -640,11 +641,12 @@
          (mutex (mailbox.mutex mbox)))
     (ccl:with-lock-grabbed (mutex)
       (setf (mailbox.queue mbox)
-            (nconc (mailbox.queue mbox) (list message))))))
+            (nconc (mailbox.queue mbox) (list message)))
+      (ccl:signal-semaphore (mailbox.semaphore mbox)))))
 
 (defimplementation receive ()
   (let* ((mbox (mailbox ccl:*current-process*))
          (mutex (mailbox.mutex mbox)))
-    (ccl:process-wait "receive" #'mailbox.queue mbox)
+    (ccl:wait-on-semaphore (mailbox.semaphore mbox))
     (ccl:with-lock-grabbed (mutex)
       (pop (mailbox.queue mbox)))))




From heller at common-lisp.net  Wed Feb  4 22:14:02 2004
From: heller at common-lisp.net (Helmut Eller)
Date: Wed, 04 Feb 2004 17:14:02 -0500
Subject: [slime-cvs] CVS update: slime/slime.el 
Message-ID: <E1AoVHW-0005or-00@common-lisp.net>

Update of /project/slime/cvsroot/slime
In directory common-lisp.net:/tmp/cvs-serv5750

Modified Files:
	slime.el 
Log Message:
(slime-path): Use load-file-name as fallback.  Suggested by Lawrence
Mitchell.

(slime-dispatch-event): Add support for :debug-activate event.
(sldb-activate): New function.

(sldb-mode): make-local-hook doesn't seem to work in Emacs 20.  Use a
buffer local variable instead.

(slime-list-connections): Don't print Lisp's state.
(slime-short-state-name): Deleted.

Date: Wed Feb  4 17:14:01 2004
Author: heller

Index: slime/slime.el
diff -u slime/slime.el:1.202 slime/slime.el:1.203
--- slime/slime.el:1.202	Mon Feb  2 02:31:06 2004
+++ slime/slime.el	Wed Feb  4 17:14:01 2004
@@ -68,7 +68,7 @@
 
 (eval-and-compile 
   (defvar slime-path
-    (let ((path (locate-library "slime")))
+    (let ((path (or (locate-library "slime") load-file-name)))
       (and path (file-name-directory path)))
     "Directory containing the Slime package.
 This is used to load the supporting Common Lisp library, Swank.
@@ -1339,6 +1339,12 @@
                     (funcall (cdr rec) value))
                (t
                 (error "Unexpected reply: %S %S" id value)))))
+      ((:debug-activate thread level)
+       (sldb-activate thread level))
+      ((:debug thread level condition restarts frames)
+       (sldb-setup thread level condition restarts frames))
+      ((:debug-return thread level)
+       (sldb-exit thread level))
       ((:emacs-interrupt thread)
        (cond ((slime-use-sigint-for-interrupt) (slime-send-sigint))
              (t (slime-send `(:emacs-interrupt ,thread)))))
@@ -1348,10 +1354,6 @@
        (slime-repl-abort-read thread tag))
       ((:emacs-return-string thread tag string)
        (slime-send `(:emacs-return-string ,thread ,tag ,string)))
-      ((:debug thread level condition restarts frames)
-       (sldb-setup thread level condition restarts frames))
-      ((:debug-return thread level)
-       (sldb-exit thread level))
       ;;
       ((:new-package package)
        (setf (slime-lisp-package) package))
@@ -1370,17 +1372,6 @@
       ((:debug-condition thread message)
        (message "%s" message)))))
 
-;;; XXX thread is ignored
-(defun sldb-exit (thread level)
-  (when-let (sldb (get-sldb-buffer))
-    (with-current-buffer sldb
-      (set-window-configuration sldb-saved-window-configuration)
-      (let ((inhibit-read-only t))
-        (erase-buffer))
-      (setq sldb-level nil))
-    (when (= level 1)
-      (kill-buffer sldb))))
-
 (defun slime-reset ()
   "Clear all pending continuations."
   (interactive)
@@ -3896,7 +3887,7 @@
   (slime-set-truncate-lines)
   ;; Make original slime-connection "sticky" for SLDB commands in this buffer
   (setq slime-buffer-connection (slime-connection))
-  (make-local-hook 'kill-buffer-hook)
+  (make-local-variable 'kill-buffer-hook)
   (add-hook 'kill-buffer-hook 'sldb-delete-overlays))
 
 (slime-define-keys sldb-mode-map 
@@ -3989,9 +3980,28 @@
       (insert "\n" (in-sldb-face section "Backtrace:") "\n")
       (setq sldb-backtrace-start-marker (point-marker))
       (sldb-insert-frames (sldb-prune-initial-frames frames) nil)
-      (setq buffer-read-only t)
       (pop-to-buffer (current-buffer))
-      (run-hooks 'sldb-hook))))
+      (run-hooks 'sldb-hook)
+      (setq buffer-read-only t))))
+
+(defun sldb-activate (thread level)
+  (with-current-buffer (get-sldb-buffer t)
+    (unless (equal sldb-level level)
+      (with-lexical-bindings (thread level)
+        (slime-eval-async `(swank:debugger-info-for-emacs 0 1) nil
+                          (lambda (result)
+                            (apply #'sldb-setup thread level result)))))))
+
+;;; XXX thread is ignored
+(defun sldb-exit (thread level)
+  (when-let (sldb (get-sldb-buffer))
+    (with-current-buffer sldb
+      (set-window-configuration sldb-saved-window-configuration)
+      (let ((inhibit-read-only t))
+        (erase-buffer))
+      (setq sldb-level nil))
+    (when (= level 1)
+      (kill-buffer sldb))))
 
 (defun sldb-insert-restarts (restarts)
   (loop for (name string) in restarts
@@ -4084,7 +4094,7 @@
   "Highlight the first sexp after point."
   (sldb-delete-overlays)
   (let ((start (or start (point)))
-	(end (or end (save-excursion (forward-sexp) (point)))))
+	(end (or end (save-excursion (forward-sexp)  (point)))))
     (push (make-overlay start (1+ start)) sldb-overlays)
     (push (make-overlay (1- end) end) sldb-overlays)
     (dolist (overlay sldb-overlays)
@@ -4431,14 +4441,6 @@
 
 ;;;;; Connection listing
 
-(defun slime-short-state-name (&optional state)
-  "Return a short symbol for STATEs name."
-  (ecase (slime-state-name (or state (slime-current-state)))
-    (slime-idle-state 'idle)
-    (slime-evaluating-state 'eval)
-    (slime-debugging-state 'debug)
-    (slime-read-string-state 'read)))
-                               
 (defun slime-list-connections ()
   "Display a list of all connections."
   (interactive)
@@ -4446,16 +4448,15 @@
     (kill-buffer  "*SLIME connections*"))
   (slime-with-output-to-temp-buffer "*SLIME connections*"
     (let ((default (slime-connection)))
-      (insert " Nr  State  Type                  Port                Pid\n"
-              " --  -----  ----                  ----                ---\n")
+      (insert " Nr  Type                  Port                Pid\n"
+              " --  ----                  ----                ---\n")
       (dolist (p slime-net-processes)
         (let ((slime-dispatching-connection p))
           (insert
            (slime-with-connection-buffer (p)
-             (format "%s%2d  %-5s  %-20s  %-17s  %-5s\n"
+             (format "%s%2d  %-20s  %-17s  %-5s\n"
                      (if (eq default p) "*" " ")
                      (slime-connection-number)
-                     (slime-short-state-name)
                      (slime-lisp-implementation-type)
                      (or (process-id p) (process-contact p))
                      (slime-pid)))))))))
@@ -5060,6 +5061,11 @@
                       debug-hook-max-depth depth)
           (= debug-hook-max-depth depth))))))
 
+(defun slime-sldb-level= (level)
+  (when-let (sldb (get-sldb-buffer))
+    (with-current-buffer sldb
+      (equal sldb-level level))))
+
 (def-slime-test loop-interrupt-quit
     ()
     "Test interrupting a loop."
@@ -5077,13 +5083,12 @@
     (slime-check "In eval state."
       (not (null slime-rex-continuations)))
     (slime-interrupt)
+    (slime-wait-condition "First interrupt" (lambda () (slime-sldb-level= 1))
+                          5)
+    (with-current-buffer (get-sldb-buffer)
+      (sldb-quit))
     (slime-sync-to-top-level 5)
     (slime-check-top-level)))
-
-(defun slime-sldb-level= (level)
-  (when-let (sldb (get-sldb-buffer))
-    (with-current-buffer sldb
-      (equal sldb-level level))))
 
 (def-slime-test loop-interrupt-continue-interrupt-quit
     ()




From heller at common-lisp.net  Wed Feb  4 22:16:55 2004
From: heller at common-lisp.net (Helmut Eller)
Date: Wed, 04 Feb 2004 17:16:55 -0500
Subject: [slime-cvs] CVS update: slime/swank.lisp 
Message-ID: <E1AoVKJ-0003PX-00@common-lisp.net>

Update of /project/slime/cvsroot/slime
In directory common-lisp.net:/tmp/cvs-serv8947

Modified Files:
	swank.lisp 
Log Message:
(sldb-loop, dispatch-event, send-to-socket-io): Send a :debug-activate
event instead of a :debug event (to avoid sending a backtrace each time).

(handle-sldb-condition): Include the thread-id in the message.
Date: Wed Feb  4 17:16:54 2004
Author: heller

Index: slime/swank.lisp
diff -u slime/swank.lisp:1.114 slime/swank.lisp:1.115
--- slime/swank.lisp:1.114	Mon Feb  2 02:25:40 2004
+++ slime/swank.lisp	Wed Feb  4 17:16:54 2004
@@ -59,36 +59,6 @@
 ;;; streams that redirect to Emacs, and optionally a second socket
 ;;; used solely to pipe user-output to Emacs (an optimization).
 ;;;
-;;; Initially Emacs connects to Lisp and the "main" connection is
-;;; created. The thread that accepts this connection then reads and
-;;; serves requests from Emacs as they arrive. Later, new connections
-;;; can be created for other threads that need to talke to Emacs,
-;;; e.g. to enter the debugger.
-;;;
-;;; Each connection is owned by the thread that accepts it. Only the
-;;; owner can use a connection to communicate with Emacs, with one
-;;; exception: Any thread may send out-of-band messages to Emacs using
-;;; the main connection. A message is "out of band" if it is
-;;; independent of the protocol state (or more specifically, if the
-;;; `slime-handle-oob' elisp function can handle it).
-;;;
-;;; When a new thread needs to talk to Emacs it must first create a
-;;; connection of its own. This is done by binding a listen-socket and
-;;; asking Emacs to connect, using an out-of-band message on the main
-;;; connection to tell Emacs what port to connect to. This logic is
-;;; encapsulated by the WITH-A-CONNECTION macro, which will execute
-;;; its body forms with a connection available, creating a temporary
-;;; one if necessary.
-;;;
-;;; Multiple threads can write to the main connection, so these writes
-;;; must by synchronized. This is coarsely achieved by using the
-;;; WITH-I/O-LOCK macro to globally serialize all writes to any
-;;; connection. Reads do not have to be synchronized because each
-;;; connection can only be read by one thread.
-;;;
-;;; Non-multiprocessing systems can ignore all of this. There is only
-;;; one connection and only one thread, so the invariants come for
-;;; free.
 
 (defstruct (connection
              (:conc-name connection.)
@@ -113,21 +83,24 @@
   (cleanup          nil :type (or null function))
   )
 
+#+(or)
+(defun %print-connection (connection stream depth)
+  (declare (ignore depth))
+  (print-unreadable-object (connection stream :type t :identity t)))
+
+
 (defvar *emacs-connection* nil
   "The connection to Emacs.
-Any thread may send out-of-band messages to Emacs using this
-connection.")
+All threads communicate through this interface with Emacs.")
 
-(defvar *swank-state-stack* '())
+(defvar *swank-state-stack* '()
+  "A list of symbols describing the current state.  Used for debugging
+and to detect situations where interrupts can be ignored.")
 
 (defslimefun state-stack ()
+  "Return the value of *SWANK-STATE-STACK*."
   *swank-state-stack*)
 
-#+(or)
-(defun %print-connection (connection stream depth)
-  (declare (ignore depth))
-  (print-unreadable-object (connection stream :type t :identity t)))
-
 ;; Condition for SLIME protocol errors.
 (define-condition slime-read-error (error) 
   ((condition :initarg :condition :reader slime-read-error.condition))
@@ -211,6 +184,7 @@
       (serve-requests connection))))
 
 (defun serve-requests (connection)
+  "Read and process all requests on connections."
   (funcall (connection.serve-requests connection) connection))
 
 (defun init-emacs-connection (connection)
@@ -225,7 +199,13 @@
     (format s "~S~%" port))
   (simple-announce-function port))
 
+(defun simple-announce-function (port)
+  (when *swank-debug-p*
+    (format *debug-io* "~&;; Swank started at port: ~D.~%" port)))
+
 (defun open-streams (socket-io)
+  "Return the 4 streams for IO redirection:
+ DEDICATED-OUTPUT INPUT OUTPUT IO"
   (encode-message `(:check-protocol-version ,(changelog-date)) socket-io)
   (multiple-value-bind (output-fn dedicated-output) 
       (make-output-function socket-io)
@@ -260,16 +240,15 @@
     (accept-connection socket)))
 
 (defun handle-request ()
+  "Read and process one request.  The processing is done in the extend
+of the toplevel restart."
   (assert (null *swank-state-stack*))
   (let ((*swank-state-stack* '(:handle-request)))
     (catch 'slime-toplevel
       (with-simple-restart (abort "Return to SLIME toplevel.")
         (with-io-redirection ()
-          (read-from-emacs))))))
-
-(defun simple-announce-function (port)
-  (when *swank-debug-p*
-    (format *debug-io* "~&;; Swank started at port: ~D.~%" port)))
+          (let ((*debugger-hook* #'swank-debugger-hook))
+            (read-from-emacs)))))))
 
 (defun changelog-date ()
   "Return the datestring of the latest ChangeLog entry.  The date is
@@ -378,7 +357,7 @@
        (add-thread thread)))
     ((:emacs-interrupt thread)
      (interrupt-worker-thread thread))
-    ((:debug thread &rest args)
+    (((:debug :debug-condition :debug-activate) thread &rest args)
      (encode-message `(:debug ,(add-thread thread) . ,args) socket-io))
     ((:debug-return thread level)
      (encode-message `(:debug-return ,(drop-thread thread) ,level) socket-io))
@@ -391,7 +370,7 @@
      (encode-message `(:read-aborted ,(drop-thread thread) , at args) socket-io))
     ((:emacs-return-string thread tag string)
      (send (lookup-thread-id thread) `(take-input ,tag ,string)))
-    (((:read-output :new-package :new-features :ed :debug-condition)
+    (((:read-output :new-package :new-features :ed)
       &rest _)
      (declare (ignore _))
      (encode-message event socket-io))))
@@ -467,7 +446,8 @@
   (log-event "DISPATCHING: ~S~%" event)
   (flet ((send (o) (encode-message o (current-socket-io))))
     (destructure-case event
-      (((:debug :debug-return :read-string :read-aborted) thread &rest args)
+      (((:debug-activate :debug :debug-return :read-string :read-aborted) 
+        thread &rest args)
        (declare (ignore thread))
        (send `(,(car event) 0 , at args)))
       ((:return thread &rest args)
@@ -705,14 +685,13 @@
        (lambda () (sldb-loop *sldb-level*)))))
 
 (defun sldb-loop (level)
+  (send-to-emacs (list* :debug (current-thread) *sldb-level*
+                        (debugger-info-for-emacs 0 *sldb-initial-frames*)))
   (unwind-protect
        (loop (catch 'sldb-loop-catcher
                (with-simple-restart (abort "Return to sldb level ~D." level)
-                 (send-to-emacs 
-                  (list* :debug 
-                         (current-thread)
-                         *sldb-level*
-                         (debugger-info-for-emacs 0 *sldb-initial-frames*)))
+                 (send-to-emacs (list :debug-activate (current-thread)
+                                      *sldb-level*))
                  (handler-bind ((sldb-condition #'handle-sldb-condition))
                    (read-from-emacs)))))
     (send-to-emacs `(:debug-return ,(current-thread) ,level))))
@@ -722,7 +701,8 @@
 Rather than recursively debug the debugger (a dangerous idea!), these
 conditions are simply reported."
   (let ((real-condition (original-condition condition)))
-    (send-to-emacs `(:debug-condition ,(princ-to-string real-condition))))
+    (send-to-emacs `(:debug-condition ,(current-thread)
+                     ,(princ-to-string real-condition))))
   (throw 'sldb-loop-catcher nil))
 
 (defun safe-condition-message (condition)




From heller at common-lisp.net  Wed Feb  4 22:18:46 2004
From: heller at common-lisp.net (Helmut Eller)
Date: Wed, 04 Feb 2004 17:18:46 -0500
Subject: [slime-cvs] CVS update: slime/swank-backend.lisp 
Message-ID: <E1AoVM6-0007iT-00@common-lisp.net>

Update of /project/slime/cvsroot/slime
In directory common-lisp.net:/tmp/cvs-serv27233

Modified Files:
	swank-backend.lisp 
Log Message:
(debugger-info-for-emacs): Export it.
Date: Wed Feb  4 17:18:46 2004
Author: heller

Index: slime/swank-backend.lisp
diff -u slime/swank-backend.lisp:1.26 slime/swank-backend.lisp:1.27
--- slime/swank-backend.lisp:1.26	Sat Jan 31 10:07:35 2004
+++ slime/swank-backend.lisp	Wed Feb  4 17:18:46 2004
@@ -63,6 +63,7 @@
            #:sldb-break-with-default-debugger
            #:sldb-continue
            #:slime-debugger-function
+           #:debugger-info-for-emacs
            #:start-server
            #:startup-multiprocessing
            #:startup-multiprocessing-for-emacs




From heller at common-lisp.net  Wed Feb  4 22:20:54 2004
From: heller at common-lisp.net (Helmut Eller)
Date: Wed, 04 Feb 2004 17:20:54 -0500
Subject: [slime-cvs] CVS update: slime/swank-sbcl.lisp 
Message-ID: <E1AoVOA-00079M-00@common-lisp.net>

Update of /project/slime/cvsroot/slime
In directory common-lisp.net:/tmp/cvs-serv25140

Modified Files:
	swank-sbcl.lisp 
Log Message:
(add-input-handler): Use fcntl from the sb-posix package.
Date: Wed Feb  4 17:20:54 2004
Author: heller

Index: slime/swank-sbcl.lisp
diff -u slime/swank-sbcl.lisp:1.60 slime/swank-sbcl.lisp:1.61
--- slime/swank-sbcl.lisp:1.60	Sat Jan 31 15:17:19 2004
+++ slime/swank-sbcl.lisp	Wed Feb  4 17:20:54 2004
@@ -89,36 +89,17 @@
           (funcall (the function (cdr handler))))
         *sigio-handlers*))
 
-
 (defun set-sigio-handler ()
   (sb-sys:enable-interrupt sb-unix:SIGIO (lambda (signal code scp)
                                            (sigio-handler signal code scp))))
 
-(set-sigio-handler)
-
-#+linux
-(progn
-  (defconstant +o_async+ 8192)
-  (defconstant +f_setown+ 8)
-  (defconstant +f_setfl+ 4))
-
 (defimplementation add-input-handler (socket fn)
+  (set-sigio-handler)
   (let ((fd (socket-fd socket)))
     (format *debug-io* "Adding sigio handler: ~S ~%" fd)
-    (let ((fcntl (sb-alien:extern-alien "fcntl" 
-                                        (function sb-alien:int sb-alien:int 
-                                                  sb-alien:int sb-alien:int))))
-      ;; XXX error checking
-      (sb-alien:alien-funcall fcntl fd +f_setfl+ +o_async+)
-      (sb-alien:alien-funcall fcntl fd +f_setown+ (sb-unix:unix-getpid))
-      (push (cons fd fn) *sigio-handlers*))))
-
-;;(defimplementation add-input-handler (socket fn)
-;;  (let ((fd (socket-fd socket)))
-;;    (format *debug-io* "Adding sigio handler: ~S ~%" fd)
-;;    (sb-posix:fcntl fd sb-posix::f-setfl sb-posix::o-async)
-;;    (sb-posix:fcntl fd sb-posix::f-setown (sb-unix:unix-getpid))
-;;    (push (cons fd fn) *sigio-handlers*)))
+    (sb-posix:fcntl fd sb-posix::f-setfl sb-posix::o-async)
+    (sb-posix:fcntl fd sb-posix::f-setown (sb-unix:unix-getpid))
+    (push (cons fd fn) *sigio-handlers*)))
 
 (defimplementation remove-input-handlers (socket)
   (let ((fd (socket-fd socket)))




From heller at common-lisp.net  Wed Feb  4 22:22:12 2004
From: heller at common-lisp.net (Helmut Eller)
Date: Wed, 04 Feb 2004 17:22:12 -0500
Subject: [slime-cvs] CVS update: slime/ChangeLog 
Message-ID: <E1AoVPQ-0006W9-00@common-lisp.net>

Update of /project/slime/cvsroot/slime
In directory common-lisp.net:/tmp/cvs-serv18785

Modified Files:
	ChangeLog 
Log Message:
*** empty log message ***
Date: Wed Feb  4 17:22:11 2004
Author: heller

Index: slime/ChangeLog
diff -u slime/ChangeLog:1.243 slime/ChangeLog:1.244
--- slime/ChangeLog:1.243	Mon Feb  2 02:31:29 2004
+++ slime/ChangeLog	Wed Feb  4 17:22:11 2004
@@ -1,3 +1,29 @@
+2004-02-04  Bryan O'Connor <bryan-slime at lunch.org>
+
+	* swank-openmcl.lisp (mailbox): Use a semaphore instead of
+	process-wait.  Works better with native threads.
+
+2004-02-04  Helmut Eller  <e9626484 at stud3.tuwien.ac.at>
+
+	* swank-backend.lisp (debugger-info-for-emacs): Export it.
+
+	* swank-sbcl.lisp (add-input-handler): Use fcntl from the sb-posix
+	package.
+	
+	* swank.lisp (sldb-loop, dispatch-event, send-to-socket-io): Send
+	a :debug-activate event instead of a :debug event (to avoid
+	sending a potentially long backtrace each time).
+	(handle-sldb-condition): Include the thread-id in the message.
+
+	* slime.el (slime-path): Use load-file-name as fallback.
+	Suggested by Lawrence Mitchell.
+	(slime-dispatch-event): Add support for :debug-activate event.
+	(sldb-activate): New function.
+	(sldb-mode): make-local-hook doesn't seem to work in Emacs 20.
+	Use a buffer local variable instead.
+	(slime-list-connections): Don't print Lisp's state.
+	(slime-short-state-name): Deleted.
+	
 2004-02-02  Helmut Eller  <e9626484 at stud3.tuwien.ac.at>
 
 	* slime.el (slime-debugger): The customization group is called




From wjenkner at common-lisp.net  Thu Feb  5 05:57:05 2004
From: wjenkner at common-lisp.net (Wolfgang Jenkner)
Date: Thu, 05 Feb 2004 00:57:05 -0500
Subject: [slime-cvs] CVS update: slime/swank-loader.lisp
	slime/swank-clisp.lisp 
Message-ID: <E1AocVd-0005xJ-00@common-lisp.net>

Update of /project/slime/cvsroot/slime
In directory common-lisp.net:/tmp/cvs-serv16065

Modified Files:
	swank-loader.lisp swank-clisp.lisp 
Log Message:
Add profiling support via Kantrowitz's metering package.  Reporting
needs to be refined (profile-package currently ignores callers-p and
methods).

Date: Thu Feb  5 00:57:04 2004
Author: wjenkner

Index: slime/swank-loader.lisp
diff -u slime/swank-loader.lisp:1.15 slime/swank-loader.lisp:1.16
--- slime/swank-loader.lisp:1.15	Wed Jan 21 19:09:15 2004
+++ slime/swank-loader.lisp	Thu Feb  5 00:57:04 2004
@@ -7,7 +7,7 @@
 ;;; This code has been placed in the Public Domain.  All warranties
 ;;; are disclaimed.
 ;;;
-;;;   $Id: swank-loader.lisp,v 1.15 2004/01/22 00:09:15 heller Exp $
+;;;   $Id: swank-loader.lisp,v 1.16 2004/02/05 05:57:04 wjenkner Exp $
 ;;;
 
 (cl:defpackage :swank-loader
@@ -32,7 +32,7 @@
           #+openmcl '("swank-openmcl" "swank-gray")
           #+lispworks '("swank-lispworks" "swank-gray")
           #+allegro '("swank-allegro" "swank-gray")
-          #+clisp '("xref" "swank-clisp" "swank-gray")
+          #+clisp '("xref" "metering" "swank-clisp" "swank-gray")
           ))
 
 (defparameter *swank-pathname* (make-swank-pathname "swank"))


Index: slime/swank-clisp.lisp
diff -u slime/swank-clisp.lisp:1.15 slime/swank-clisp.lisp:1.16
--- slime/swank-clisp.lisp:1.15	Sat Jan 31 06:50:25 2004
+++ slime/swank-clisp.lisp	Thu Feb  5 00:57:04 2004
@@ -15,8 +15,16 @@
 ;;; This code is developed using the current CVS version of CLISP and
 ;;; CLISP 2.32 on Linux. Older versions may not work (2.29 and below
 ;;; are confirmed non-working; please upgrade).  You need an image
-;;; containing the "SOCKET", "REGEXP", and (optionally) "LINUX"
-;;; packages.
+;;; containing the "SOCKET", "REGEXP", and "LINUX" packages.  The
+;;; portable xref from the CMU AI repository and metering.lisp from
+;;; CLOCC are also required (alternatively, you have to manually
+;;; comment out some code below).  Note that currently SLIME comes
+;;; with xref but not with metering.  Please fetch it from
+
+;;; http://cvs.sourceforge.net/viewcvs.py/clocc/clocc/src/tools/metering/
+
+;;; and put it (or a link to it) in the directory containing the other
+;;; SLIME source files.
 
 (in-package "SWANK")
 
@@ -328,6 +336,30 @@
 
 (defslimefun sldb-abort ()
   (invoke-restart (find 'abort *sldb-restarts* :key #'restart-name)))
+
+;;; Profiling
+
+(defimplementation profile (fname)
+  (eval `(mon:monitor ,fname)))		;monitor is a macro
+
+(defimplementation profiled-functions ()
+  mon:*monitored-functions*)
+
+(defimplementation unprofile (fname)
+  (eval `(mon:unmonitor ,fname)))	;unmonitor is a macro
+
+(defimplementation unprofile-all ()
+  (mon:unmonitor))
+
+(defimplementation profile-report ()
+  (mon:report-monitoring))
+
+(defimplementation profile-reset ()
+  (mon:reset-all-monitoring))
+
+(defimplementation profile-package (package callers-p methods)
+  (declare (ignore callers-p methods))
+  (mon:monitor-all package))
 
 ;;; Handle compiler conditions (find out location of error etc.)
 




From wjenkner at common-lisp.net  Thu Feb  5 06:03:40 2004
From: wjenkner at common-lisp.net (Wolfgang Jenkner)
Date: Thu, 05 Feb 2004 01:03:40 -0500
Subject: [slime-cvs] CVS update: slime/ChangeLog 
Message-ID: <E1Aocc0-0005uS-00@common-lisp.net>

Update of /project/slime/cvsroot/slime
In directory common-lisp.net:/tmp/cvs-serv3329

Modified Files:
	ChangeLog 
Log Message:

Date: Thu Feb  5 01:03:40 2004
Author: wjenkner

Index: slime/ChangeLog
diff -u slime/ChangeLog:1.244 slime/ChangeLog:1.245
--- slime/ChangeLog:1.244	Wed Feb  4 17:22:11 2004
+++ slime/ChangeLog	Thu Feb  5 01:03:40 2004
@@ -1,3 +1,9 @@
+2004-02-05  Wolfgang Jenkner  <wjenkner at inode.at>
+
+	* swank-clisp.lisp, swank-loader.lisp: Add profiling support via
+	Kantrowitz's metering package.  Reporting needs to be
+	refined (profile-package currently ignores callers-p and methods).
+
 2004-02-04  Bryan O'Connor <bryan-slime at lunch.org>
 
 	* swank-openmcl.lisp (mailbox): Use a semaphore instead of




From heller at common-lisp.net  Thu Feb  5 07:01:51 2004
From: heller at common-lisp.net (Helmut Eller)
Date: Thu, 05 Feb 2004 02:01:51 -0500
Subject: [slime-cvs] CVS update: slime/swank-openmcl.lisp 
Message-ID: <E1AodWJ-0003rh-00@common-lisp.net>

Update of /project/slime/cvsroot/slime
In directory common-lisp.net:/tmp/cvs-serv13115

Modified Files:
	swank-openmcl.lisp 
Log Message:
(compile-system-for-emacs): Remove compile time dependency on ASDF.
Date: Thu Feb  5 02:01:51 2004
Author: heller

Index: slime/swank-openmcl.lisp
diff -u slime/swank-openmcl.lisp:1.59 slime/swank-openmcl.lisp:1.60
--- slime/swank-openmcl.lisp:1.59	Wed Feb  4 17:08:07 2004
+++ slime/swank-openmcl.lisp	Thu Feb  5 02:01:50 2004
@@ -200,7 +200,11 @@
   (with-compilation-hooks ()
     (let ((*buffer-name* nil)
           (*buffer-offset* nil))
-      (asdf:oos 'asdf:load-op system-name))))
+      (let ((oos (find-symbol (string :oos) :asdf))
+            (load-op (find-symbol (string :load-op) :asdf)))
+        (cond ((and oos load-op)
+               (funcall oos load-op system-name))
+              (t (error "ASDF not loaded")))))))
 
 (defimplementation compile-string-for-emacs (string &key buffer position)
   (with-compilation-hooks ()




From heller at common-lisp.net  Thu Feb  5 07:03:30 2004
From: heller at common-lisp.net (Helmut Eller)
Date: Thu, 05 Feb 2004 02:03:30 -0500
Subject: [slime-cvs] CVS update: slime/ChangeLog 
Message-ID: <E1AodXu-0001Vc-00@common-lisp.net>

Update of /project/slime/cvsroot/slime
In directory common-lisp.net:/tmp/cvs-serv1184

Modified Files:
	ChangeLog 
Log Message:
*** empty log message ***
Date: Thu Feb  5 02:03:30 2004
Author: heller

Index: slime/ChangeLog
diff -u slime/ChangeLog:1.245 slime/ChangeLog:1.246
--- slime/ChangeLog:1.245	Thu Feb  5 01:03:40 2004
+++ slime/ChangeLog	Thu Feb  5 02:03:29 2004
@@ -1,3 +1,8 @@
+2004-02-05  Helmut Eller  <e9626484 at stud3.tuwien.ac.at>
+
+	* swank-openmcl.lisp (compile-system-for-emacs): Remove compile
+	time dependency on ASDF.
+
 2004-02-05  Wolfgang Jenkner  <wjenkner at inode.at>
 
 	* swank-clisp.lisp, swank-loader.lisp: Add profiling support via




From heller at common-lisp.net  Thu Feb  5 23:20:15 2004
From: heller at common-lisp.net (Helmut Eller)
Date: Thu, 05 Feb 2004 18:20:15 -0500
Subject: [slime-cvs] CVS update: slime/slime.el 
Message-ID: <E1Aosn9-0007pg-00@common-lisp.net>

Update of /project/slime/cvsroot/slime
In directory common-lisp.net:/tmp/cvs-serv19041

Modified Files:
	slime.el 
Log Message:
(sldb-setup): Offer to enter a recursive edit if there are pending
continuations.  

(slime-eval): Unwind the stack, thereby exititing recursive edits,
before signaling the error.

Date: Thu Feb  5 18:20:14 2004
Author: heller

Index: slime/slime.el
diff -u slime/slime.el:1.203 slime/slime.el:1.204
--- slime/slime.el:1.203	Wed Feb  4 17:14:01 2004
+++ slime/slime.el	Thu Feb  5 18:20:14 2004
@@ -1512,26 +1512,21 @@
   "Evaluate EXPR on the superior Lisp and return the result."
   (let* ((tag (gensym "slime-result-"))
 	 (slime-stack-eval-tags (cons tag slime-stack-eval-tags)))
-    (unwind-protect
-      (catch tag
-      (slime-rex (tag sexp)
-          (sexp package)
-        ((:ok value)
-         (unless (member tag slime-stack-eval-tags)
-           (error "tag = %S eval-tags = %S sexp = %S" tag slime-stack-eval-tags sexp))
-         (throw tag value))
-        ((:abort)
-         (error "Lisp Evaluation aborted.")))
-      (let ((debug-on-quit t)
-            (inhibit-quit nil))
-        (while t
-          (accept-process-output nil 0 10000)
-          ;;(debug)
-          (when nil ;; (and (slime-debugging-p) nil) ;; FIXME
-            (recursive-edit)
-            ;; If we get here, the user completed the recursive edit without
-            ;; coaxing the debugger into returning. We abort.
-            (error "Evaluation aborted."))))))))
+    (apply
+     #'funcall 
+     (catch tag
+       (slime-rex (tag sexp)
+           (sexp package)
+         ((:ok value)
+          (unless (member tag slime-stack-eval-tags)
+            (error "tag = %S eval-tags = %S sexp = %S"
+                   tag slime-stack-eval-tags sexp))
+          (throw tag (list #'identity value)))
+         ((:abort)
+          (throw tag (list #'error "Synchronous Lisp Evaluation aborted."))))
+       (let ((debug-on-quit t)
+             (inhibit-quit nil))
+         (while t (accept-process-output nil 0 10000)))))))
 
 (defun slime-eval-async (sexp package cont)
   "Evaluate EXPR on the superior Lisp and call CONT with the result."
@@ -3982,7 +3977,10 @@
       (sldb-insert-frames (sldb-prune-initial-frames frames) nil)
       (pop-to-buffer (current-buffer))
       (run-hooks 'sldb-hook)
-      (setq buffer-read-only t))))
+      (setq buffer-read-only t)
+      (when (and slime-stack-eval-tags
+                 (y-or-n-p "Enter recursive edit? "))
+        (recursive-edit)))))
 
 (defun sldb-activate (thread level)
   (with-current-buffer (get-sldb-buffer t)




From heller at common-lisp.net  Thu Feb  5 23:21:12 2004
From: heller at common-lisp.net (Helmut Eller)
Date: Thu, 05 Feb 2004 18:21:12 -0500
Subject: [slime-cvs] CVS update: slime/ChangeLog 
Message-ID: <E1Aoso4-0002wi-00@common-lisp.net>

Update of /project/slime/cvsroot/slime
In directory common-lisp.net:/tmp/cvs-serv5184

Modified Files:
	ChangeLog 
Log Message:
*** empty log message ***
Date: Thu Feb  5 18:21:12 2004
Author: heller

Index: slime/ChangeLog
diff -u slime/ChangeLog:1.246 slime/ChangeLog:1.247
--- slime/ChangeLog:1.246	Thu Feb  5 02:03:29 2004
+++ slime/ChangeLog	Thu Feb  5 18:21:12 2004
@@ -1,3 +1,10 @@
+2004-02-06  Helmut Eller  <e9626484 at stud3.tuwien.ac.at>
+
+	* slime.el (sldb-setup): Offer to enter a recursive edit if there
+	are pending continuations.  
+	(slime-eval): Unwind the stack, thereby exititing recursive edits,
+	before signaling the error.
+
 2004-02-05  Helmut Eller  <e9626484 at stud3.tuwien.ac.at>
 
 	* swank-openmcl.lisp (compile-system-for-emacs): Remove compile




From heller at common-lisp.net  Sat Feb  7 11:36:01 2004
From: heller at common-lisp.net (Helmut Eller)
Date: Sat, 07 Feb 2004 06:36:01 -0500
Subject: [slime-cvs] CVS update: slime/slime.el 
Message-ID: <E1ApQkj-0005vU-00@common-lisp.net>

Update of /project/slime/cvsroot/slime
In directory common-lisp.net:/tmp/cvs-serv14360

Modified Files:
	slime.el 
Log Message:
(slime-undefine-function): New command.  Bound to C-c C-u.

Date: Sat Feb  7 06:36:00 2004
Author: heller

Index: slime/slime.el
diff -u slime/slime.el:1.204 slime/slime.el:1.205
--- slime/slime.el:1.204	Thu Feb  5 18:20:14 2004
+++ slime/slime.el	Sat Feb  7 06:35:59 2004
@@ -429,6 +429,7 @@
     ("\C-f" slime-describe-function :prefixed t :inferior t :sldb t)
     ("\M-d" slime-disassemble-symbol :prefixed t :inferior t :sldb t)
     ("\C-t" slime-toggle-trace-fdefinition :prefixed t :sldb t)
+    ("\C-u" slime-undefine-function :prefixed t)
     ("\C-a" slime-apropos :prefixed t :inferior t :sldb t)
     ("\M-a" slime-apropos-all :prefixed t :inferior t :sldb t)
     ;; Kinda crappy binding. Maybe we should introduce some extra
@@ -3324,6 +3325,13 @@
   (interactive (list (slime-read-symbol-name "Disassemble: ")))
   (slime-eval-describe `(swank:disassemble-symbol ,symbol-name)))
 
+(defun slime-undefine-function (symbol-name)
+  "Unbind the function slot of SYMBOL-NAME."
+  (interactive (list (slime-read-symbol-name "fmakunbound: ")))
+  (slime-eval-async `(swank:undefine-function ,symbol-name)
+                    (slime-buffer-package t)
+                    (lambda (result) (message "%s" result))))
+
 (defun slime-load-file (filename)
   "Load the Lisp file FILENAME."
   (interactive (list 
@@ -5070,23 +5078,14 @@
     '(())
   (slime-check-top-level)
   (slime-eval-async '(cl:loop) "CL-USER" (lambda (_) ))
-  (let ((sldb-hook
-         (lambda ()
-           (slime-check "First interrupt."
-             (when-let (sldb (get-sldb-buffer))
-               (with-current-buffer sldb
-                 (equal sldb-level 1))))
-           (sldb-quit))))
-    (accept-process-output nil 1)
-    (slime-check "In eval state."
-      (not (null slime-rex-continuations)))
-    (slime-interrupt)
-    (slime-wait-condition "First interrupt" (lambda () (slime-sldb-level= 1))
-                          5)
-    (with-current-buffer (get-sldb-buffer)
-      (sldb-quit))
-    (slime-sync-to-top-level 5)
-    (slime-check-top-level)))
+  (accept-process-output nil 1)
+  (slime-check "In eval state." (not (null slime-rex-continuations)))
+  (slime-interrupt)
+  (slime-wait-condition "First interrupt" (lambda () (slime-sldb-level= 1)) 5)
+  (with-current-buffer (get-sldb-buffer) 
+    (sldb-quit))
+  (slime-sync-to-top-level 5)
+  (slime-check-top-level))
 
 (def-slime-test loop-interrupt-continue-interrupt-quit
     ()
@@ -5096,16 +5095,14 @@
   (slime-eval-async '(cl:loop) "CL-USER" (lambda (_) ))
   (slime-wait-condition "running" #'slime-busy-p 5)
   (slime-interrupt)
-  (slime-wait-condition "First interrupt" (lambda () (slime-sldb-level= 1))
-                        5)
+  (slime-wait-condition "First interrupt" (lambda () (slime-sldb-level= 1)) 5)
   (with-current-buffer (get-sldb-buffer)
     (sldb-continue))
   (slime-wait-condition "running" (lambda () (and (slime-busy-p)
                                                    (not (get-sldb-buffer))))
                         5)
   (slime-interrupt)
-  (slime-wait-condition "Second interrupt" (lambda () (slime-sldb-level= 1))
-                        5)
+  (slime-wait-condition "Second interrupt" (lambda () (slime-sldb-level= 1)) 5)
   (with-current-buffer (get-sldb-buffer)
     (sldb-quit))
   (slime-sync-to-top-level 5)




From heller at common-lisp.net  Sat Feb  7 11:38:04 2004
From: heller at common-lisp.net (Helmut Eller)
Date: Sat, 07 Feb 2004 06:38:04 -0500
Subject: [slime-cvs] CVS update: slime/swank.lisp 
Message-ID: <E1ApQmi-00069x-00@common-lisp.net>

Update of /project/slime/cvsroot/slime
In directory common-lisp.net:/tmp/cvs-serv16090

Modified Files:
	swank.lisp 
Log Message:
(undefine-function): New function.

(print-with-frame-label, print-part-to-string): Bind *print-circle* to
t, to avoid unbound recursion when printing cyclic data structures.
Date: Sat Feb  7 06:38:03 2004
Author: heller

Index: slime/swank.lisp
diff -u slime/swank.lisp:1.115 slime/swank.lisp:1.116
--- slime/swank.lisp:1.115	Wed Feb  4 17:16:54 2004
+++ slime/swank.lisp	Sat Feb  7 06:38:03 2004
@@ -728,7 +728,8 @@
   (declare (type function fn))
   (let* ((label (format nil "  ~D: " n))
          (string (with-output-to-string (stream) 
-                   (let ((*print-pretty* *sldb-pprint-frames*))
+                   (let ((*print-pretty* *sldb-pprint-frames*)
+                         (*print-circle* t))
                      (princ label stream) (funcall fn stream)))))
     (subseq string (length label))))
 
@@ -1236,6 +1237,10 @@
 (defslimefun untrace-all ()
   (untrace))
 
+(defslimefun undefine-function (fname-string)
+  (let ((fname (from-string fname-string)))
+    (format nil "~S" (fmakunbound fname))))
+
 (defslimefun load-file (filename)
   (to-string (load filename)))
 
@@ -1330,7 +1335,8 @@
   (inspect-object (eval (from-string string))))
 
 (defun print-part-to-string (value)
-  (let ((*print-pretty* nil))
+  (let ((*print-pretty* nil)
+        (*print-circle* t))
     (let ((string (to-string value))
 	  (pos (position value *inspector-history*)))
       (if pos




From heller at common-lisp.net  Sat Feb  7 11:40:09 2004
From: heller at common-lisp.net (Helmut Eller)
Date: Sat, 07 Feb 2004 06:40:09 -0500
Subject: [slime-cvs] CVS update: slime/swank-cmucl.lisp 
Message-ID: <E1ApQoj-0004q0-00@common-lisp.net>

Update of /project/slime/cvsroot/slime
In directory common-lisp.net:/tmp/cvs-serv16288

Modified Files:
	swank-cmucl.lisp 
Log Message:
(gf-definition-location): Return an error when pathname for the GF is
nil (this happens if the GF is not-compiled from a file).

Date: Sat Feb  7 06:40:09 2004
Author: heller

Index: slime/swank-cmucl.lisp
diff -u slime/swank-cmucl.lisp:1.59 slime/swank-cmucl.lisp:1.60
--- slime/swank-cmucl.lisp:1.59	Sat Jan 31 06:50:25 2004
+++ slime/swank-cmucl.lisp	Sat Feb  7 06:40:09 2004
@@ -638,7 +638,9 @@
            (etypecase pathname
              (pathname 
               (make-location `(:file ,(guess-source-file pathname)) 
-                             `(:function-name ,(string name)))))))))))
+                             `(:function-name ,(string name))))
+             (null `(:error ,(format nil "Cannot resolve: ~S" def-source)))
+             )))))))
 
 (defun method-source-location (method)
   (function-source-location (or (pcl::method-fast-function method)
@@ -1129,19 +1131,17 @@
           (di::bogus-debug-function
            (format t "~%[Disassembling bogus frames not implemented]"))))))
 
-
 #+(or)
 (defun print-binding-stack ()
-  (do ((bsp (kernel:binding-stack-pointer-sap)
-            (sys:sap+ bsp (- (* vm:binding-size vm:word-bytes))))
-       (start (sys:int-sap (lisp::binding-stack-start))))
-      ((sys:sap<= bsp start))
-    (format t "~X:  ~S = ~S~%" 
-            (sys:sap-int bsp)
-            (kernel:make-lisp-obj 
-             (sys:sap-ref-32 bsp (* vm:binding-symbol-slot vm:word-bytes)))
-            (kernel:make-lisp-obj
-             (sys:sap-ref-32 bsp (* vm:binding-value-slot vm:word-bytes))))))
+  (flet ((bsp- (p) (sys:sap+ p (- (* vm:binding-size vm:word-bytes))))
+         (frob (p offset) (kernel:make-lisp-obj (sys:sap-ref-32 p offset))))
+    (do ((bsp (bsp- (kernel:binding-stack-pointer-sap)) (bsp- bsp))
+         (start (sys:int-sap (lisp::binding-stack-start))))
+        ((sys:sap= bsp start))
+      (format t "~X:  ~S = ~S~%" 
+              (sys:sap-int bsp)
+              (frob bsp (* vm:binding-symbol-slot vm:word-bytes))
+              (frob bsp (* vm:binding-value-slot vm:word-bytes))))))
 
 ;; (print-binding-stack)
 
@@ -1161,7 +1161,7 @@
       (format t "~X:  uwp = ~8X  cfp = ~8X  tag = ~X~%" 
               int uwp cfp (kernel:make-lisp-obj tag)))))))
 
-;; (print-catch-blocks)
+;; (print-catch-blocks) 
 
 #+(or)
 (defun print-unwind-blocks ()




From heller at common-lisp.net  Sat Feb  7 11:41:48 2004
From: heller at common-lisp.net (Helmut Eller)
Date: Sat, 07 Feb 2004 06:41:48 -0500
Subject: [slime-cvs] CVS update: slime/ChangeLog 
Message-ID: <E1ApQqK-0003wD-00@common-lisp.net>

Update of /project/slime/cvsroot/slime
In directory common-lisp.net:/tmp/cvs-serv9920

Modified Files:
	ChangeLog 
Log Message:
*** empty log message ***
Date: Sat Feb  7 06:41:48 2004
Author: heller

Index: slime/ChangeLog
diff -u slime/ChangeLog:1.247 slime/ChangeLog:1.248
--- slime/ChangeLog:1.247	Thu Feb  5 18:21:12 2004
+++ slime/ChangeLog	Sat Feb  7 06:41:48 2004
@@ -1,3 +1,17 @@
+2004-02-07  Helmut Eller  <e9626484 at stud3.tuwien.ac.at>
+
+	* swank-cmucl.lisp (gf-definition-location): Return an error when
+	pathname for the GF is nil (this happens if the GF is not compiled
+	from a file).
+
+	* swank.lisp (undefine-function): New function.
+	(print-with-frame-label, print-part-to-string): Bind
+	*print-circle* to t, to avoid unbound recursion when printing
+	cyclic data structures.
+
+	* slime.el (slime-undefine-function): New command.  Bound to C-c
+	C-u.
+
 2004-02-06  Helmut Eller  <e9626484 at stud3.tuwien.ac.at>
 
 	* slime.el (sldb-setup): Offer to enter a recursive edit if there




From heller at common-lisp.net  Sat Feb  7 13:19:18 2004
From: heller at common-lisp.net (Helmut Eller)
Date: Sat, 07 Feb 2004 08:19:18 -0500
Subject: [slime-cvs] CVS update: slime/swank-sbcl.lisp 
Message-ID: <E1ApSMg-0006bo-00@common-lisp.net>

Update of /project/slime/cvsroot/slime
In directory common-lisp.net:/tmp/cvs-serv25068

Modified Files:
	swank-sbcl.lisp 
Log Message:
(enable-sigio-on-fd): New function.  Use fallback if sb-posix:fcntl
isn't fbound.
Date: Sat Feb  7 08:19:18 2004
Author: heller

Index: slime/swank-sbcl.lisp
diff -u slime/swank-sbcl.lisp:1.61 slime/swank-sbcl.lisp:1.62
--- slime/swank-sbcl.lisp:1.61	Wed Feb  4 17:20:54 2004
+++ slime/swank-sbcl.lisp	Sat Feb  7 08:19:17 2004
@@ -93,6 +93,48 @@
   (sb-sys:enable-interrupt sb-unix:SIGIO (lambda (signal code scp)
                                            (sigio-handler signal code scp))))
 
+
+
+;;;; XXX remove fcntl kludge when SBCL with sb-posix:fcntl is more
+;;;; widely available.
+(defconstant +o_async+ 8192)
+(defconstant +f_setown+ 8)
+(defconstant +f_setfl+ 4)
+
+(unless (find-symbol (string :fcntl) :sb-posix)
+  (warn "No binding for fctnl(2) in sb-posix.
+Please upgrade to SBCL 0.8.7.36 or later."))
+
+(defun enable-sigio-on-fd (fd)
+  (cond ((fboundp (find-symbol (string :fcntl) :sb-posix))
+         (funcall 
+          (eval
+           (read-from-string 
+            "(lambda (fd)
+             (sb-posix:fcntl fd sb-posix::f-setfl sb-posix::o-async)
+             (sb-posix:fcntl fd sb-posix::f-setown (sb-unix:unix-getpid)))"))
+          fd))
+        (t
+         (unless (sb-int:featurep :linux)
+           (warn "~
+You aren't runinng Linux. The values of +o_async+ etc are probably bogus."))
+         (let ((fcntl (sb-alien:extern-alien 
+                       "fcntl" 
+                       (function sb-alien:int sb-alien:int 
+                                 sb-alien:int sb-alien:int))))
+           ;; XXX error checking
+           (sb-alien:alien-funcall fcntl fd +f_setfl+ +o_async+)
+           (sb-alien:alien-funcall fcntl fd +f_setown+
+                                   (sb-unix:unix-getpid))))))
+
+(defimplementation add-input-handler (socket fn)
+  (set-sigio-handler)
+  (let ((fd (socket-fd socket)))
+    (format *debug-io* "Adding sigio handler: ~S ~%" fd)
+    (enable-sigio-on-fd fd)
+    (push (cons fd fn) *sigio-handlers*)))
+
+#+(or)
 (defimplementation add-input-handler (socket fn)
   (set-sigio-handler)
   (let ((fd (socket-fd socket)))




From heller at common-lisp.net  Sat Feb  7 13:20:10 2004
From: heller at common-lisp.net (Helmut Eller)
Date: Sat, 07 Feb 2004 08:20:10 -0500
Subject: [slime-cvs] CVS update: slime/ChangeLog 
Message-ID: <E1ApSNW-0002WP-00@common-lisp.net>

Update of /project/slime/cvsroot/slime
In directory common-lisp.net:/tmp/cvs-serv5396

Modified Files:
	ChangeLog 
Log Message:
*** empty log message ***
Date: Sat Feb  7 08:20:10 2004
Author: heller

Index: slime/ChangeLog
diff -u slime/ChangeLog:1.248 slime/ChangeLog:1.249
--- slime/ChangeLog:1.248	Sat Feb  7 06:41:48 2004
+++ slime/ChangeLog	Sat Feb  7 08:20:10 2004
@@ -1,5 +1,8 @@
 2004-02-07  Helmut Eller  <e9626484 at stud3.tuwien.ac.at>
 
+	* swank-sbcl.lisp (enable-sigio-on-fd): New function.  Use
+	fallback if sb-posix:fcntl isn't fbound.
+
 	* swank-cmucl.lisp (gf-definition-location): Return an error when
 	pathname for the GF is nil (this happens if the GF is not compiled
 	from a file).




From heller at common-lisp.net  Sat Feb  7 19:20:47 2004
From: heller at common-lisp.net (Helmut Eller)
Date: Sat, 07 Feb 2004 14:20:47 -0500
Subject: [slime-cvs] CVS update: slime/slime.el 
Message-ID: <E1ApY0V-00058z-00@common-lisp.net>

Update of /project/slime/cvsroot/slime
In directory common-lisp.net:/tmp/cvs-serv19169

Modified Files:
	slime.el 
Log Message:
(slime-rex): Mention thread argument in docstring.

(sldb-break-with-default-debugger): Use slime-rex and don't switch to
the output buffer (happens automatically).

(slime-list-threads): Renamed from slime-thread-control-panel.
(slime-thread-insert): Use slightly different layout.

(slime-give-goahead, slime-waiting-threads)
(slime-popup-thread-control-panel, slime-register-waiting-thread)
(slime-thread-goahead): Deleted.
Date: Sat Feb  7 14:20:46 2004
Author: heller

Index: slime/slime.el
diff -u slime/slime.el:1.205 slime/slime.el:1.206
--- slime/slime.el:1.205	Sat Feb  7 06:35:59 2004
+++ slime/slime.el	Sat Feb  7 14:20:46 2004
@@ -1474,7 +1474,7 @@
                             (package 'slime-buffer-package)
                             (thread 'slime-current-thread))
                       &rest continuations)
-  "(slime-rex (VAR ...) (SEXP [PACKAGE]) CLAUSES ...)
+  "(slime-rex (VAR ...) (SEXP &optional PACKAGE THREAD) CLAUSES ...)
 
 Remote EXecute SEXP.
 
@@ -3801,20 +3801,6 @@
       (slime-dispatch-event '(:emacs-quit))
     (error "Not evaluating - nothing to quit.")))
 
-(defun slime-give-goahead (thread-id)
-  "Allow a suspended thread to continue."
-  (interactive "xThread-ID: ")
-  (case (slime-state-name (slime-current-state))
-    (slime-idle-state
-     (slime-eval-async `(swank:give-goahead ,thread-id)
-                       (slime-buffer-package)
-                       (lambda (v) nil)))
-    (slime-debugging-state
-     (error "Already debugging - must finish first."))
-    (t
-     (error "Busy - can't attach in current state (%S)"
-            (slime-current-state)))))
-
 (defun slime-set-package (package)
   (interactive (list (slime-read-package-name "Package: " 
 					      (slime-find-buffer-package))))
@@ -4335,10 +4321,9 @@
 
 (defun sldb-break-with-default-debugger ()
   (interactive)
-  (slime-switch-to-output-buffer)
-  (slime-eval-async 
-   '(swank:sldb-break-with-default-debugger) nil 
-   (lambda (_))))
+  (slime-rex ()
+      ('(swank:sldb-break-with-default-debugger) nil slime-current-thread)
+    ((:abort))))
 
 (defun sldb-step ()
   (interactive)
@@ -4376,54 +4361,32 @@
 
 ;;; Thread control panel
 
-;; The "thread control panel" is a buffer showing all interesting Lisp
-;; threads -- for now, this means threads that are waiting to be
-;; debugged. Threads can be selected with RET to have Emacs debug
-;; them.
-
-(defvar slime-waiting-threads '()
-  "List of threads waiting for attention from Emacs.
-Each entry is (ID NAME SUMMARY-STRING).")
-
-(defvar slime-popup-thread-control-panel t
-  "*When non-nil, automatically display the thread control panel.
-The buffer will be popped up any time it is modified.")
-
-(defun slime-register-waiting-thread (id name summary)
-  (unless (member* id slime-waiting-threads :test #'equal :key #'first)
-    (setq slime-waiting-threads
-          (append slime-waiting-threads (list (list id name summary)))))
-  (slime-thread-control-panel (not slime-popup-thread-control-panel))
-  (message "Thread awaiting goahead: %s" name))
-
-(defun slime-thread-control-panel (&optional dont-show)
+(defun slime-list-threads ()
+  "Display a list of threads."
   (interactive)
-  (with-current-buffer (get-buffer-create "*slime-threads*")
-    (slime-thread-control-mode)
-    (let ((inhibit-read-only t))
-      (erase-buffer)
-      (loop for (id name summary) in slime-waiting-threads
-            do (slime-thread-insert id name summary))
-      (goto-char (point-min))
-      (unless dont-show (pop-to-buffer (current-buffer)))
-      (setq buffer-read-only t))))
+  (slime-eval-async 
+   '(swank:list-threads)
+   nil
+   (lambda (threads)
+     (with-current-buffer (get-buffer-create "*slime-threads*")
+       (slime-thread-control-mode)
+       (let ((inhibit-read-only t))
+         (erase-buffer)
+         (loop for id from 0 
+               for (name status) in threads
+               do (slime-thread-insert id name status))
+         (goto-char (point-min))
+         (setq buffer-read-only t)
+         (pop-to-buffer (current-buffer)))))))
 
 (defun slime-thread-insert (id name summary)
   (slime-propertize-region `(thread-id ,id)
-    (slime-insert-propertized '(face bold) name "\n")
+    (slime-insert-propertized '(face bold) name)
+    (insert-char ?\  (- 30 (current-column)))
     (let ((summary-start (point)))
-      (insert summary)
+      (insert " " summary)
       (unless (bolp) (insert "\n"))
       (indent-rigidly summary-start (point) 2))))
-
-(defun slime-thread-goahead ()
-  (interactive)
-  (let ((id (get-text-property (point) 'thread-id)))
-    (unless id (error "No thread at point."))
-    (slime-give-goahead id)
-    (setq slime-waiting-threads
-          (remove* id slime-waiting-threads :key #'car :test #'equal))
-    (slime-thread-control-panel t)))
 
 
 ;;;;; Major mode




From heller at common-lisp.net  Sat Feb  7 19:27:10 2004
From: heller at common-lisp.net (Helmut Eller)
Date: Sat, 07 Feb 2004 14:27:10 -0500
Subject: [slime-cvs] CVS update: slime/swank.lisp 
Message-ID: <E1ApY6g-0005BY-00@common-lisp.net>

Update of /project/slime/cvsroot/slime
In directory common-lisp.net:/tmp/cvs-serv19863

Modified Files:
	swank.lisp 
Log Message:
(dispatch-event): :debug, :debug-condition, :debug-activate events
where all encoded as :debug events, which means the debugger never
worked!  Fix it.  I guess no one uses SLIME with a multithreaded Lisp

(read-user-input-from-emacs): Flush the output for reading.

(sldb-loop): Add a sldb-enter-default-debugger tag, so we can enter
the default debugger by throwing to this it.
(sldb-break-with-default-debugger): Throw to
sldb-enter-default-debugger.

(*thread-list*): New variable.
(list-threads): New function.


Date: Sat Feb  7 14:27:10 2004
Author: heller

Index: slime/swank.lisp
diff -u slime/swank.lisp:1.116 slime/swank.lisp:1.117
--- slime/swank.lisp:1.116	Sat Feb  7 06:38:03 2004
+++ slime/swank.lisp	Sat Feb  7 14:27:09 2004
@@ -358,7 +358,7 @@
     ((:emacs-interrupt thread)
      (interrupt-worker-thread thread))
     (((:debug :debug-condition :debug-activate) thread &rest args)
-     (encode-message `(:debug ,(add-thread thread) . ,args) socket-io))
+     (encode-message `(,(car event) ,(add-thread thread) . ,args) socket-io))
     ((:debug-return thread level)
      (encode-message `(:debug-return ,(drop-thread thread) ,level) socket-io))
     ((:return thread &rest args)
@@ -571,6 +571,7 @@
 
 (defun read-user-input-from-emacs ()
   (let ((*read-input-catch-tag* (1+ *read-input-catch-tag*)))
+    (force-output)
     (send-to-emacs `(:read-string ,(current-thread)
                      ,*read-input-catch-tag*))
     (let ((ok nil))
@@ -687,14 +688,18 @@
 (defun sldb-loop (level)
   (send-to-emacs (list* :debug (current-thread) *sldb-level*
                         (debugger-info-for-emacs 0 *sldb-initial-frames*)))
-  (unwind-protect
-       (loop (catch 'sldb-loop-catcher
-               (with-simple-restart (abort "Return to sldb level ~D." level)
-                 (send-to-emacs (list :debug-activate (current-thread)
-                                      *sldb-level*))
-                 (handler-bind ((sldb-condition #'handle-sldb-condition))
-                   (read-from-emacs)))))
-    (send-to-emacs `(:debug-return ,(current-thread) ,level))))
+  (catch 'sldb-enter-default-debugger
+    (unwind-protect
+         (loop (catch 'sldb-loop-catcher
+                 (with-simple-restart (abort "Return to sldb level ~D." level)
+                   (send-to-emacs (list :debug-activate (current-thread)
+                                        *sldb-level*))
+                   (handler-bind ((sldb-condition #'handle-sldb-condition))
+                     (read-from-emacs)))))
+      (send-to-emacs `(:debug-return ,(current-thread) ,level)))))
+
+(defun sldb-break-with-default-debugger ()
+  (throw 'sldb-enter-default-debugger nil))
 
 (defun handle-sldb-condition (condition)
   "Handle an internal debugger condition.
@@ -747,12 +752,6 @@
   (when (= sldb-level *sldb-level*)
     (invoke-nth-restart n)))
 
-(defun sldb-break-with-default-debugger ()
-  (let ((*debugger-hook* nil))
-    ;; FIXME: This will break when the SBCL backend starts using the
-    ;; extra sbcl debugger hook.
-    (break)))
-
 (defslimefun eval-string-in-frame (string index)
   (to-string (eval-in-frame (from-string string) index)))
 
@@ -1416,6 +1415,25 @@
 	     (t
 	      (push (cons (string 'rest) in-list) reversed-elements)
 	      (done "The object is an improper list of length ~S.~%")))))))
+
+
+;;;; Thread listing
+
+(defvar *thread-list* ()
+  "List of threads displayed in Emacs.  We don't care a about
+synchronization issues (yet).  There can only be one thread listing at
+a time.")
+
+(defslimefun list-threads ()
+  "Return a list ((NAME DESCRIPTION) ...) of all threads."
+  (setq *thread-list* (all-threads))
+  (loop for thread in  *thread-list* 
+        collect (list (thread-name thread)
+                      (thread-status thread))))
+
+(defslimefun quit-thread-browser ()
+  (setq *thread-list* nil))
+
 
 ;;; Local Variables:
 ;;; eval: (font-lock-add-keywords 'lisp-mode '(("(\\(defslimefun\\)\\s +\\(\\(\\w\\|\\s_\\)+\\)"  (1 font-lock-keyword-face) (2 font-lock-function-name-face))))




From heller at common-lisp.net  Sat Feb  7 19:28:41 2004
From: heller at common-lisp.net (Helmut Eller)
Date: Sat, 07 Feb 2004 14:28:41 -0500
Subject: [slime-cvs] CVS update: slime/swank-backend.lisp 
Message-ID: <E1ApY89-0006Sn-00@common-lisp.net>

Update of /project/slime/cvsroot/slime
In directory common-lisp.net:/tmp/cvs-serv24841

Modified Files:
	swank-backend.lisp 
Log Message:
(thread-name): Take a thread object as argument.
(thread-status, all-threads, thread-alive-p): New function.

(thread-id): Deleted.
Date: Sat Feb  7 14:28:41 2004
Author: heller

Index: slime/swank-backend.lisp
diff -u slime/swank-backend.lisp:1.27 slime/swank-backend.lisp:1.28
--- slime/swank-backend.lisp:1.27	Wed Feb  4 17:18:46 2004
+++ slime/swank-backend.lisp	Sat Feb  7 14:28:41 2004
@@ -516,28 +516,19 @@
 (definterface spawn (fn &key name)
   "Create a new thread to call FN.")
 
-(definterface thread-id ()
-   "Return a value that uniquely identifies the current thread.
-Thread-IDs allow Emacs to refer to individual threads.
-
-When called several times by the same thread, all return values are
-EQUAL. The value has a READable printed representation that preserves
-equality. The printed representation must be identical in Emacs Lisp
-and Common Lisp, and short enough to include in the REPL prompt.
-
-For example, a THREAD-ID could be an integer or a short ASCII string.
-
-Systems that do not support multiprocessing return NIL."
-   nil)
-
-(definterface thread-name (thread-id)
-   "Return the name of the thread identified by THREAD-ID.
+(definterface thread-name (thread)
+   "Return the name of THREAD.
 
 Thread names are be single-line strings and are meaningful to the
 user. They do not have to be unique."
-   (declare (ignore thread-id))
+   (declare (ignore thread))
    "The One True Thread")
 
+(definterface thread-status (thread)
+   "Return a string describing THREAD's state."
+   (declare (ignore thread))
+   "")
+
 (definterface make-lock (&key name)
    "Make a lock for thread synchronization.
 Only one thread may hold the lock (via CALL-WITH-LOCK-HELD) at a time."
@@ -553,6 +544,12 @@
 (definterface current-thread ()
   "Return the currently executing thread."
   0)
+
+(definterface all-threads ()
+  "Return a list of all threads.")
+
+(definterface thread-alive-p (thread)
+  "Test if THREAD is termintated.")
 
 (definterface interrupt-thread (thread fn)
   "Cause THREAD to execute FN.")




From heller at common-lisp.net  Sat Feb  7 19:30:07 2004
From: heller at common-lisp.net (Helmut Eller)
Date: Sat, 07 Feb 2004 14:30:07 -0500
Subject: [slime-cvs] CVS update: slime/swank-cmucl.lisp
	slime/swank-lispworks.lisp slime/swank-allegro.lisp
	slime/swank-openmcl.lisp slime/swank-sbcl.lisp 
Message-ID: <E1ApY9X-00030q-00@common-lisp.net>

Update of /project/slime/cvsroot/slime
In directory common-lisp.net:/tmp/cvs-serv5569

Modified Files:
	swank-cmucl.lisp swank-lispworks.lisp swank-allegro.lisp 
	swank-openmcl.lisp swank-sbcl.lisp 
Log Message:
Update for modified thread interface.

Date: Sat Feb  7 14:30:06 2004
Author: heller

Index: slime/swank-cmucl.lisp
diff -u slime/swank-cmucl.lisp:1.60 slime/swank-cmucl.lisp:1.61
--- slime/swank-cmucl.lisp:1.60	Sat Feb  7 06:40:09 2004
+++ slime/swank-cmucl.lisp	Sat Feb  7 14:30:05 2004
@@ -1306,10 +1306,6 @@
 
 #+MP
 (progn
-  (defvar *known-processes* '()         ; FIXME: leakage. -luke
-    "List of processes that have been assigned IDs.
-     The ID is the position in the list.")
-
   (defimplementation startup-multiprocessing ()
     (setq *swank-in-background* :spawn)
     ;; Threads magic: this never returns! But top-level becomes
@@ -1319,29 +1315,17 @@
   (defimplementation spawn (fn &key (name "Anonymous"))
     (mp:make-process fn :name name))
 
-  (defimplementation thread-id ()
-    (mp:without-scheduling
-     (or (find-thread-id)
-         (prog1 (length *known-processes*)
-           (setq *known-processes*
-                 (append *known-processes* (list (mp:current-process))))))))
-
-  (defun find-thread-id (&optional (process (mp:current-process)))
-    (position process *known-processes*))
-
-  (defun lookup-thread (thread-id)
-    (or (nth thread-id *known-processes*)
-        (error "Unknown Thread-ID: ~S" thread-id)))
+  (defimplementation thread-name (thread)
+    (mp:process-name thread))
 
-  (defimplementation thread-name (thread-id)
-    (mp:process-name (lookup-thread thread-id)))
+  (defimplementation thread-status (thread)
+    (mp:process-whostate thread))
 
-  (defimplementation make-lock (&key name)
-    (mp:make-lock name))
+  (defimplementation current-thread ()
+    mp:*current-process*)
 
-  (defimplementation call-with-lock-held (lock function)
-    (mp:with-lock-held (lock)
-      (funcall function)))
+  (defimplementation all-threads ()
+    (copy-list mp:*all-processes*))
 
   )
 


Index: slime/swank-lispworks.lisp
diff -u slime/swank-lispworks.lisp:1.20 slime/swank-lispworks.lisp:1.21
--- slime/swank-lispworks.lisp:1.20	Sat Jan 31 06:50:25 2004
+++ slime/swank-lispworks.lisp	Sat Feb  7 14:30:05 2004
@@ -7,8 +7,6 @@
 ;;; This code has been placed in the Public Domain.  All warranties
 ;;; are disclaimed.
 ;;;
-;;;   $Id: swank-lispworks.lisp,v 1.20 2004/01/31 11:50:25 heller Exp $
-;;;
 
 (in-package :swank)
 
@@ -210,15 +208,21 @@
   (invoke-restart-interactively (nth-restart index)))
 
 (defimplementation frame-locals (n)
-  (let ((frame (nth-frame n)))
+  (let ((frame (nth-frame n))
+        (*print-readably* nil)
+        (*print-pretty* t)
+        (*print-circle* t))
     (if (dbg::call-frame-p frame)
 	(destructuring-bind (vars with)
 	    (dbg::frame-locals-format-list frame #'list 75 0)
 	  (declare (ignore with))
-	  (loop for (name value symbol location) in vars
-		collect (list :name (to-string symbol) :id 0
-			      :value-string 
-                              (to-string value)))))))
+          (mapcar (lambda (var)
+                    (destructuring-bind (name value symbol location) var
+                      (declare (ignore name location))
+                      (list :name (to-string symbol) :id 0
+                            :value-string 
+                            (to-string value))))
+                  vars)))))
 
 (defimplementation frame-catch-tags (index)
   (declare (ignore index))
@@ -402,12 +406,13 @@
 (defimplementation spawn (fn &key name)
   (mp:process-run-function name () fn))
 
-;; XXX: shortcut
-(defimplementation thread-id ()
-  (mp:process-name mp:*current-process*))
+(defimplementation thread-name (thread)
+  (mp:process-name thread))
 
-(defimplementation thread-name (thread-id)
-  thread-id)
+(defimplementation thread-status (thread)
+  (format nil "~A ~D" 
+          (mp:process-whostate thread)
+          (mp:process-priority thread)))
 
 (defimplementation make-lock (&key name)
   (mp:make-lock :name name))
@@ -417,6 +422,9 @@
 
 (defimplementation current-thread ()
   mp:*current-process*)
+
+(defimplementation all-threads ()
+  (mp:list-all-processes))
 
 (defimplementation interrupt-thread (thread fn)
   (mp:process-interrupt thread fn))


Index: slime/swank-allegro.lisp
diff -u slime/swank-allegro.lisp:1.12 slime/swank-allegro.lisp:1.13
--- slime/swank-allegro.lisp:1.12	Sat Jan 31 06:50:25 2004
+++ slime/swank-allegro.lisp	Sat Feb  7 14:30:05 2004
@@ -7,7 +7,7 @@
 ;;; This code has been placed in the Public Domain.  All warranties
 ;;; are disclaimed.
 ;;;
-;;;   $Id: swank-allegro.lisp,v 1.12 2004/01/31 11:50:25 heller Exp $
+;;;   $Id: swank-allegro.lisp,v 1.13 2004/02/07 19:30:05 heller Exp $
 ;;;
 ;;; This code was written for 
 ;;;   Allegro CL Trial Edition "5.0 [Linux/X86] (8/29/98 10:57)"
@@ -323,12 +323,12 @@
 (defimplementation spawn (fn &key name)
   (mp:process-run-function name fn))
 
-;; XXX: shurtcut
-(defimplementation thread-id ()
-  (mp:process-name mp:*current-process*))
+(defimplementation thread-name (thread)
+  (mp:process-name thread))
 
-(defimplementation thread-name (thread-id)
-  thread-id)
+(defimplementation thread-status (thread)
+  (format nil "~A ~D" (mp:process-whostate thread)
+          (mp:process-priority thread)))
 
 (defimplementation make-lock (&key name)
   (mp:make-process-lock :name name))
@@ -340,7 +340,7 @@
   mp:*current-process*)
 
 (defimplementation all-threads ()
-  mp:*all-processes*)
+  (copy-list mp:*all-processes*))
 
 (defimplementation interrupt-thread (thread fn)
   (mp:process-interrupt thread fn))


Index: slime/swank-openmcl.lisp
diff -u slime/swank-openmcl.lisp:1.60 slime/swank-openmcl.lisp:1.61
--- slime/swank-openmcl.lisp:1.60	Thu Feb  5 02:01:50 2004
+++ slime/swank-openmcl.lisp	Sat Feb  7 14:30:05 2004
@@ -603,18 +603,11 @@
 (defimplementation startup-multiprocessing ()
   (setq *swank-in-background* :spawn))
 
-(defimplementation thread-id ()
-  (let* ((thread ccl:*current-process*)
-         (id (ccl::process-serial-number thread)))
-    (ccl:with-lock-grabbed (*known-processes-lock*)
-      (unless (rassoc thread *known-processes* :key #'car)
-        (setq *known-processes*
-              (acons id (list thread (make-mailbox)) *known-processes*))))
-    id))
+(defimplementation thread-name (thread)
+  (ccl::process-name thread))
 
-(defimplementation thread-name (thread-id)
-  (ccl:with-lock-grabbed (*known-processes-lock*)
-    (ccl::process-name (cdr (assoc thread-id *known-processes*)))))
+(defimplementation thread-status (thread)
+  (format nil "~A" (ccl:process-whostate thread)))
 
 (defimplementation make-lock (&key name)
   (ccl:make-lock name))
@@ -625,6 +618,9 @@
 
 (defimplementation current-thread ()
   ccl:*current-process*)
+
+(defimplementation all-threads ()
+  (ccl:all-processes))
 
 (defimplementation interrupt-thread (thread fn)
   (ccl:process-interrupt thread fn))


Index: slime/swank-sbcl.lisp
diff -u slime/swank-sbcl.lisp:1.62 slime/swank-sbcl.lisp:1.63
--- slime/swank-sbcl.lisp:1.62	Sat Feb  7 08:19:17 2004
+++ slime/swank-sbcl.lisp	Sat Feb  7 14:30:05 2004
@@ -628,6 +628,11 @@
   (sb-profile:profile))
 
 
+;;;;
+
+
+
+
 ;;;; Multiprocessing
 
 #+SB-THREAD
@@ -639,11 +644,12 @@
   (defimplementation startup-multiprocessing ()
     (setq *swank-in-background* :spawn))
 
-  (defimplementation thread-id ()
-    (sb-thread:current-thread-id))
+  (defimplementation thread-name (thread)
+    (format nil "Thread ~D" thread))
 
-  (defimplementation thread-name (thread-id)
-    (format nil "Thread ~S" thread-id))
+  (defimplementation thread-status (thread)
+    (declare (ignore thread))
+    "???")
 
   (defimplementation make-lock (&key name)
     (sb-thread:make-mutex :name name))
@@ -655,7 +661,7 @@
   (defimplementation current-thread ()
     (sb-thread:current-thread-id))
 
-  (defun all-threads ()
+  (defimplementation all-threads ()
     (sb-thread::mapcar-threads
      (lambda (sap)
        (sb-sys:sap-ref-32 sap (* sb-vm:n-word-bytes




From heller at common-lisp.net  Sat Feb  7 19:34:08 2004
From: heller at common-lisp.net (Helmut Eller)
Date: Sat, 07 Feb 2004 14:34:08 -0500
Subject: [slime-cvs] CVS update: slime/ChangeLog 
Message-ID: <E1ApYDQ-0001Ds-00@common-lisp.net>

Update of /project/slime/cvsroot/slime
In directory common-lisp.net:/tmp/cvs-serv4416

Modified Files:
	ChangeLog 
Log Message:
*** empty log message ***
Date: Sat Feb  7 14:34:08 2004
Author: heller

Index: slime/ChangeLog
diff -u slime/ChangeLog:1.249 slime/ChangeLog:1.250
--- slime/ChangeLog:1.249	Sat Feb  7 08:20:10 2004
+++ slime/ChangeLog	Sat Feb  7 14:34:08 2004
@@ -1,5 +1,35 @@
 2004-02-07  Helmut Eller  <e9626484 at stud3.tuwien.ac.at>
 
+	* slime.el (slime-rex): Mention thread argument in docstring.
+	(sldb-break-with-default-debugger): Use slime-rex and don't switch
+	to the output buffer (happens automatically).
+	(slime-list-threads): Renamed from slime-thread-control-panel.
+	(slime-thread-insert): Use slightly different layout.
+	(slime-give-goahead, slime-waiting-threads)
+	(slime-popup-thread-control-panel, slime-register-waiting-thread)
+	(slime-thread-goahead): Deleted.
+
+	* swank.lisp (dispatch-event): :debug, :debug-condition,
+	:debug-activate events were all encoded as :debug events, which
+	means the debugger never worked!  Fix it.  I guess no one uses
+	SLIME with a multithreaded Lisp.
+	(read-user-input-from-emacs): Flush the output before reading.
+	(sldb-loop): Add a sldb-enter-default-debugger tag, so we can
+	enter the default debugger by throwing to this it.
+	(sldb-break-with-default-debugger): Throw to
+	sldb-enter-default-debugger.
+	(*thread-list*): New variable.
+	(list-threads): New function.
+
+	* swank-backend.lisp (thread-name): Take a thread object as
+	argument.
+	(thread-status, all-threads, thread-alive-p): New function.
+	(thread-id): Deleted.
+
+	* swank-allegro.lisp, swank-cmucl.lisp, swank-lispworks.lisp,
+	swank-openmcl.lisp, swank-sbcl.lisp: Update for modified thread
+	interface.
+
 	* swank-sbcl.lisp (enable-sigio-on-fd): New function.  Use
 	fallback if sb-posix:fcntl isn't fbound.
 




From heller at common-lisp.net  Sat Feb  7 20:59:45 2004
From: heller at common-lisp.net (Helmut Eller)
Date: Sat, 07 Feb 2004 15:59:45 -0500
Subject: [slime-cvs] CVS update: slime/slime.el 
Message-ID: <E1ApZYH-0006Sz-00@common-lisp.net>

Update of /project/slime/cvsroot/slime
In directory common-lisp.net:/tmp/cvs-serv24848

Modified Files:
	slime.el 
Log Message:
(slime-maybe-start-multiprocessing): Call
swank:startup-multiprocessing not
swank:startup-multiprocessing-for-emacs.  Reported by Paolo Amoroso.

Date: Sat Feb  7 15:59:45 2004
Author: heller

Index: slime/slime.el
diff -u slime/slime.el:1.206 slime/slime.el:1.207
--- slime/slime.el:1.206	Sat Feb  7 14:20:46 2004
+++ slime/slime.el	Sat Feb  7 15:59:44 2004
@@ -921,11 +921,10 @@
 
 (defun slime-maybe-close-old-connections ()
   "Offer to keep old connections alive, otherwise disconnect."
-  (unless (or (null slime-net-processes)
+  (unless (or (not (slime-connected-p))
               (y-or-n-p "Keep old connections? "))
     (slime-disconnect)))
 
-
 (defun slime-maybe-start-lisp ()
   "Start an inferior lisp unless one is already running."
   (unless (get-buffer-process (get-buffer "*inferior-lisp*"))
@@ -938,7 +937,7 @@
 (defun slime-maybe-start-multiprocessing ()
   (when slime-multiprocessing
     (comint-send-string (inferior-lisp-proc)
-                        "(swank:startup-multiprocessing-for-emacs)")))
+                        "(swank:startup-multiprocessing)")))
 
 (defun slime-start-swank-server ()
   "Start a Swank server on the inferior lisp."




From heller at common-lisp.net  Sat Feb  7 21:10:33 2004
From: heller at common-lisp.net (Helmut Eller)
Date: Sat, 07 Feb 2004 16:10:33 -0500
Subject: [slime-cvs] CVS update: slime/ChangeLog 
Message-ID: <E1ApZij-0004BQ-00@common-lisp.net>

Update of /project/slime/cvsroot/slime
In directory common-lisp.net:/tmp/cvs-serv16064

Modified Files:
	ChangeLog 
Log Message:
*** empty log message ***
Date: Sat Feb  7 16:10:33 2004
Author: heller

Index: slime/ChangeLog
diff -u slime/ChangeLog:1.250 slime/ChangeLog:1.251
--- slime/ChangeLog:1.250	Sat Feb  7 14:34:08 2004
+++ slime/ChangeLog	Sat Feb  7 16:10:33 2004
@@ -8,6 +8,8 @@
 	(slime-give-goahead, slime-waiting-threads)
 	(slime-popup-thread-control-panel, slime-register-waiting-thread)
 	(slime-thread-goahead): Deleted.
+	(slime-maybe-start-multiprocessing): Call
+	swank:startup-multiprocessing.  Reported by Paolo Amoroso.
 
 	* swank.lisp (dispatch-event): :debug, :debug-condition,
 	:debug-activate events were all encoded as :debug events, which
@@ -15,7 +17,7 @@
 	SLIME with a multithreaded Lisp.
 	(read-user-input-from-emacs): Flush the output before reading.
 	(sldb-loop): Add a sldb-enter-default-debugger tag, so we can
-	enter the default debugger by throwing to this it.
+	enter the default debugger by throwing to it.
 	(sldb-break-with-default-debugger): Throw to
 	sldb-enter-default-debugger.
 	(*thread-list*): New variable.




From heller at common-lisp.net  Sat Feb  7 22:29:55 2004
From: heller at common-lisp.net (Helmut Eller)
Date: Sat, 07 Feb 2004 17:29:55 -0500
Subject: [slime-cvs] CVS update: slime/swank-sbcl.lisp 
Message-ID: <E1ApaxX-0003eT-00@common-lisp.net>

Update of /project/slime/cvsroot/slime
In directory common-lisp.net:/tmp/cvs-serv12293

Modified Files:
	swank-sbcl.lisp 
Log Message:
(inspected-parts): Implemented.
Date: Sat Feb  7 17:29:54 2004
Author: heller

Index: slime/swank-sbcl.lisp
diff -u slime/swank-sbcl.lisp:1.63 slime/swank-sbcl.lisp:1.64
--- slime/swank-sbcl.lisp:1.63	Sat Feb  7 14:30:05 2004
+++ slime/swank-sbcl.lisp	Sat Feb  7 17:29:54 2004
@@ -628,9 +628,84 @@
   (sb-profile:profile))
 
 
-;;;;
+;;;; Inspector
 
+(defimplementation describe-primitive-type (object)
+  (declare (ignore object))
+  "NYI")
 
+(defmethod inspected-parts (o)
+  (cond ((sb-di::indirect-value-cell-p o)
+	 (inspected-parts-of-value-cell o))
+	(t
+	 (multiple-value-bind (text labeledp parts)
+             (sb-impl::inspected-parts o)
+	   (let ((parts (if labeledp 
+			    (loop for (label . value) in parts
+				  collect (cons (string label) value))
+			    (loop for value in parts
+				  for i from 0
+				  collect (cons (format nil "~D" i) value)))))
+	     (values text parts))))))
+
+(defun inspected-parts-of-value-cell (o)
+  (values (format nil "~A~% is a value cell." o)
+	  (list (cons "Value" (sb-kernel:value-cell-ref o)))))
+
+(defmethod inspected-parts ((o function))
+  (let ((header (sb-kernel:widetag-of o)))
+    (cond ((= header sb-vm:simple-fun-header-widetag)
+	   (values 
+	    (format nil "~A~% is a simple-fun." o)
+	    (list (cons "Self" (sb-kernel:%simple-fun-self o))
+		  (cons "Next" (sb-kernel:%simple-fun-next o))
+		  (cons "Name" (sb-kernel:%simple-fun-name o))
+		  (cons "Arglist" (sb-kernel:%simple-fun-arglist o))
+		  (cons "Type" (sb-kernel:%simple-fun-type o))
+		  (cons "Code Object" (sb-kernel:fun-code-header o)))))
+	  ((= header sb-vm:closure-header-widetag)
+	   (values (format nil "~A~% is a closure." o)
+		   (list* 
+		    (cons "Function" (sb-kernel:%closure-fun o))
+		    (loop for i from 0 
+                          below (- (sb-kernel:get-closure-length o) 
+                                   (1- sb-vm:closure-info-offset))
+			  collect (cons (format nil "~D" i)
+					(sb-kernel:%closure-index-ref o i))))))
+	  (t (call-next-method o)))))
+
+(defmethod inspected-parts ((o sb-kernel:code-component))
+  (values (format nil "~A~% is a code data-block." o)
+	  `(("First entry point" . ,(sb-kernel:%code-entry-points o))
+	    ,@(loop for i from sb-vm:code-constants-offset 
+		    below (sb-kernel:get-header-data o)
+		    collect (cons (format nil "Constant#~D" i)
+				  (sb-kernel:code-header-ref o i)))
+	    ("Debug info" . ,(sb-kernel:%code-debug-info o))
+	    ("Instructions"  . ,(sb-kernel:code-instructions o)))))
+
+(defmethod inspected-parts ((o sb-kernel:fdefn))
+  (values (format nil "~A~% is a fdefn object." o)
+	  `(("Name" . ,(sb-kernel:fdefn-name o))
+	    ("Function" . ,(sb-kernel:fdefn-fun o)))))
+
+
+(defmethod inspected-parts ((o generic-function))
+  (values (format nil "~A~% is a generic function." o)
+          (list
+           (cons "Method-Class" (sb-pcl:generic-function-method-class o))
+           (cons "Methods" (sb-pcl:generic-function-methods o))
+           (cons "Name" (sb-pcl:generic-function-name o))
+           (cons "Declarations" (sb-pcl:generic-function-declarations o))
+           (cons "Method-Combination" 
+                 (sb-pcl:generic-function-method-combination o))
+           (cons "Lambda-List" (sb-pcl:generic-function-lambda-list o))
+           (cons "Precedence-Order" 
+                 (sb-pcl:generic-function-argument-precedence-order o))
+           (cons "Pretty-Arglist"
+                 (sb-pcl::generic-function-pretty-arglist o))
+           (cons "Initial-Methods" 
+                 (sb-pcl::generic-function-initial-methods  o)))))
 
 
 ;;;; Multiprocessing




From heller at common-lisp.net  Sat Feb  7 22:31:11 2004
From: heller at common-lisp.net (Helmut Eller)
Date: Sat, 07 Feb 2004 17:31:11 -0500
Subject: [slime-cvs] CVS update: slime/swank-cmucl.lisp 
Message-ID: <E1Apayl-0005Q6-00@common-lisp.net>

Update of /project/slime/cvsroot/slime
In directory common-lisp.net:/tmp/cvs-serv15904

Modified Files:
	swank-cmucl.lisp 
Log Message:
Implement more threading functions.
Date: Sat Feb  7 17:31:11 2004
Author: heller

Index: slime/swank-cmucl.lisp
diff -u slime/swank-cmucl.lisp:1.61 slime/swank-cmucl.lisp:1.62
--- slime/swank-cmucl.lisp:1.61	Sat Feb  7 14:30:05 2004
+++ slime/swank-cmucl.lisp	Sat Feb  7 17:31:11 2004
@@ -1204,7 +1204,8 @@
      (append (apropos-list "-TYPE" "VM" t)
 	     (apropos-list "-TYPE" "BIGNUM" t)))))
 
-(defmethod describe-primitive-type (object)
+
+(defimplementation describe-primitive-type (object)
   (with-output-to-string (*standard-output*)
     (let* ((lowtag (kernel:get-lowtag object))
 	   (lowtag-symbol (find lowtag +lowtag-symbols+ :key #'symbol-value)))
@@ -1220,7 +1221,7 @@
 	       (format t ", type: ~A]" type-symbol)))
 	    (t (format t "]"))))))
 
-(defmethod inspected-parts (o)
+(defimplementation inspected-parts (o)
   (cond ((di::indirect-value-cell-p o)
 	 (inspected-parts-of-value-cell o))
 	(t
@@ -1326,6 +1327,36 @@
 
   (defimplementation all-threads ()
     (copy-list mp:*all-processes*))
+
+  (defimplementation interrupt-thread (thread fn)
+    (mp:process-interrupt thread fn))
+
+  (defvar *mailbox-lock* (mp:make-lock "mailbox lock"))
+  
+  (defstruct (mailbox (:conc-name mailbox.)) 
+    (mutex (mp:make-lock "process mailbox"))
+    (queue '() :type list))
+
+  (defun mailbox (thread)
+    "Return THREAD's mailbox."
+    (mp:with-lock-held (*mailbox-lock*)
+      (or (getf (mp:process-property-list thread) 'mailbox)
+          (setf (getf (mp:process-property-list thread) 'mailbox)
+                (make-mailbox)))))
+  
+  (defimplementation send (thread message)
+    (let* ((mbox (mailbox thread))
+           (mutex (mailbox.mutex mbox)))
+      (mp:with-lock-held (mutex)
+        (setf (mailbox.queue mbox)
+              (nconc (mailbox.queue mbox) (list message))))))
+  
+  (defimplementation receive ()
+    (let* ((mbox (mailbox mp:*current-process*))
+           (mutex (mailbox.mutex mbox)))
+      (mp:process-wait "receive" #'mailbox.queue mbox)
+      (mp:with-lock-held (mutex)
+        (pop (mailbox.queue mbox)))))
 
   )
 




From heller at common-lisp.net  Sat Feb  7 22:33:03 2004
From: heller at common-lisp.net (Helmut Eller)
Date: Sat, 07 Feb 2004 17:33:03 -0500
Subject: [slime-cvs] CVS update: slime/ChangeLog 
Message-ID: <E1Apb0Z-0006k6-00@common-lisp.net>

Update of /project/slime/cvsroot/slime
In directory common-lisp.net:/tmp/cvs-serv18976

Modified Files:
	ChangeLog 
Log Message:
*** empty log message ***
Date: Sat Feb  7 17:33:03 2004
Author: heller

Index: slime/ChangeLog
diff -u slime/ChangeLog:1.251 slime/ChangeLog:1.252
--- slime/ChangeLog:1.251	Sat Feb  7 16:10:33 2004
+++ slime/ChangeLog	Sat Feb  7 17:33:02 2004
@@ -1,5 +1,10 @@
 2004-02-07  Helmut Eller  <e9626484 at stud3.tuwien.ac.at>
 
+	* swank-cmucl.lisp (send, receive, interrupt-thread): Implement
+	more threading functions.
+
+	* swank-sbcl.lisp (inspected-parts): Implemented.
+
 	* slime.el (slime-rex): Mention thread argument in docstring.
 	(sldb-break-with-default-debugger): Use slime-rex and don't switch
 	to the output buffer (happens automatically).




From mbaringer at common-lisp.net  Sun Feb  8 15:35:24 2004
From: mbaringer at common-lisp.net (Marco Baringer)
Date: Sun, 08 Feb 2004 10:35:24 -0500
Subject: [slime-cvs] CVS update: slime/ChangeLog 
Message-ID: <E1Apqxw-0004fY-00@common-lisp.net>

Update of /project/slime/cvsroot/slime
In directory common-lisp.net:/tmp/cvs-serv10288

Modified Files:
	ChangeLog 
Log Message:
See ChangeLog.

Date: Sun Feb  8 10:35:23 2004
Author: mbaringer

Index: slime/ChangeLog
diff -u slime/ChangeLog:1.252 slime/ChangeLog:1.253
--- slime/ChangeLog:1.252	Sat Feb  7 17:33:02 2004
+++ slime/ChangeLog	Sun Feb  8 10:35:23 2004
@@ -1,3 +1,16 @@
+2004-02-08  Marco Baringer  <mb at bese.it>
+
+	* swank-openmcl.lisp (find-source-locations): Eliminate unused
+	variable warning.
+
+	* swank.lisp (swank-pprint): Bind pretty print vars to
+	*swank-pprint-X* counter parts.
+	(*swank-pprint-circle*, *swank-pprint-escape*,
+	*swank-pprint-level*, *swank-pprint-length*): Swank counterparts
+	to *print-X* variables used when swank needs to pretty print a
+	form.
+	(apply-macro-expander): Use swank-pprint.
+
 2004-02-07  Helmut Eller  <e9626484 at stud3.tuwien.ac.at>
 
 	* swank-cmucl.lisp (send, receive, interrupt-thread): Implement




From mbaringer at common-lisp.net  Sun Feb  8 15:37:34 2004
From: mbaringer at common-lisp.net (Marco Baringer)
Date: Sun, 08 Feb 2004 10:37:34 -0500
Subject: [slime-cvs] CVS update: slime/swank-openmcl.lisp slime/swank.lisp 
Message-ID: <E1Apr02-0002Xd-00@common-lisp.net>

Update of /project/slime/cvsroot/slime
In directory common-lisp.net:/tmp/cvs-serv5569

Modified Files:
	swank-openmcl.lisp swank.lisp 
Log Message:
Previous commit left out the files and only changed the ChangeLog, my bad.

Date: Sun Feb  8 10:37:33 2004
Author: mbaringer

Index: slime/swank-openmcl.lisp
diff -u slime/swank-openmcl.lisp:1.61 slime/swank-openmcl.lisp:1.62
--- slime/swank-openmcl.lisp:1.61	Sat Feb  7 14:30:05 2004
+++ slime/swank-openmcl.lisp	Sun Feb  8 10:37:33 2004
@@ -407,7 +407,7 @@
          (dolist (i info)
            (typecase (car i)
              ((member method)
-              (loop for (m . files) in (cdr i) 
+              (loop for (nil . files) in (cdr i) 
                     do (frob* files (list :function-name name))))
              ((member function variable method-combination)
               (frob* (cdr i) (list :function-name name)))


Index: slime/swank.lisp
diff -u slime/swank.lisp:1.117 slime/swank.lisp:1.118
--- slime/swank.lisp:1.117	Sat Feb  7 14:27:09 2004
+++ slime/swank.lisp	Sun Feb  8 10:37:33 2004
@@ -838,13 +838,25 @@
 	(makunbound name)
 	(prin1-to-string (eval form))))))
 
+(defvar *swank-pprint-circle* *print-circle*
+  "*PRINT-CIRCLE* is bound to this volue when pretty printing slime output.")
+
+(defvar *swank-pprint-escape* *print-escape*
+  "*PRINT-ESCAPE* is bound to this volue when pretty printing slime output.")
+
+(defvar *swank-pprint-level* *print-level*
+  "*PRINT-LEVEL* is bound to this volue when pretty printing slime output.")
+
+(defvar *swank-pprint-length* *print-length*
+  "*PRINT-LENGTH* is bound to this volue when pretty printing slime output.")
+
 (defun swank-pprint (list)
   "Bind some printer variables and pretty print each object in LIST."
   (let ((*print-pretty* t)
-        (*print-circle* t)
-        (*print-escape* t)
-        (*print-level* nil)
-        (*print-length* nil))
+        (*print-circle* *swank-pprint-circle*)
+        (*print-escape* *swank-pprint-escape*)
+        (*print-level* *swank-pprint-level*)
+        (*print-length* *swank-pprint-length*))
     (cond ((null list) "; No value")
           (t (with-output-to-string (*standard-output*)
                (dolist (o list)
@@ -945,10 +957,7 @@
 
 (defun apply-macro-expander (expander string)
   (declare (type function expander))
-  (let ((*print-pretty* t)
-	(*print-length* 20)
-	(*print-level* 20))
-    (to-string (funcall expander (from-string string)))))
+  (swank-pprint (list (funcall expander (from-string string)))))
 
 (defslimefun swank-macroexpand-1 (string)
   (apply-macro-expander #'macroexpand-1 string))




From heller at common-lisp.net  Sun Feb  8 19:12:39 2004
From: heller at common-lisp.net (Helmut Eller)
Date: Sun, 08 Feb 2004 14:12:39 -0500
Subject: [slime-cvs] CVS update: slime/swank.lisp 
Message-ID: <E1ApuMB-0007xx-00@common-lisp.net>

Update of /project/slime/cvsroot/slime
In directory common-lisp.net:/tmp/cvs-serv26438

Modified Files:
	swank.lisp 
Log Message:
(setup-server): Pass loopback-interface to create-socket.
(*loopback-interface*): New parameter.

(sldb-loop): Move send :debug event inside unwind-protect, to avoid
losing :debug-return events.  
Date: Sun Feb  8 14:12:38 2004
Author: heller

Index: slime/swank.lisp
diff -u slime/swank.lisp:1.118 slime/swank.lisp:1.119
--- slime/swank.lisp:1.118	Sun Feb  8 10:37:33 2004
+++ slime/swank.lisp	Sun Feb  8 14:12:38 2004
@@ -166,9 +166,11 @@
                             (announce-fn #'simple-announce-function))
   (setup-server port announce-fn background))
 
+(defparameter *loopback-interface* "127.0.0.1")
+
 (defun setup-server (port announce-fn style)
   (declare (type function announce-fn))
-  (let* ((socket (create-socket port))
+  (let* ((socket (create-socket *loopback-interface* port))
          (port (local-port socket)))
     (funcall announce-fn port)
     (cond ((eq style :spawn)
@@ -234,7 +236,7 @@
 Return an output stream suitable for writing program output.
 
 This is an optimized way for Lisp to deliver output to Emacs."
-  (let* ((socket (create-socket 0))
+  (let* ((socket (create-socket *loopback-interface* 0))
          (port (local-port socket)))
     (encode-message `(:open-dedicated-output-stream ,port) socket-io)
     (accept-connection socket)))
@@ -686,17 +688,18 @@
        (lambda () (sldb-loop *sldb-level*)))))
 
 (defun sldb-loop (level)
-  (send-to-emacs (list* :debug (current-thread) *sldb-level*
-                        (debugger-info-for-emacs 0 *sldb-initial-frames*)))
-  (catch 'sldb-enter-default-debugger
-    (unwind-protect
+  (unwind-protect
+       (catch 'sldb-enter-default-debugger
+         (send-to-emacs 
+          (list* :debug (current-thread) *sldb-level* 
+                 (debugger-info-for-emacs 0 *sldb-initial-frames*)))
          (loop (catch 'sldb-loop-catcher
                  (with-simple-restart (abort "Return to sldb level ~D." level)
                    (send-to-emacs (list :debug-activate (current-thread)
                                         *sldb-level*))
                    (handler-bind ((sldb-condition #'handle-sldb-condition))
-                     (read-from-emacs)))))
-      (send-to-emacs `(:debug-return ,(current-thread) ,level)))))
+                     (read-from-emacs))))))
+    (send-to-emacs `(:debug-return ,(current-thread) ,level))))
 
 (defun sldb-break-with-default-debugger ()
   (throw 'sldb-enter-default-debugger nil))




From heller at common-lisp.net  Sun Feb  8 19:17:26 2004
From: heller at common-lisp.net (Helmut Eller)
Date: Sun, 08 Feb 2004 14:17:26 -0500
Subject: [slime-cvs] CVS update: slime/slime.el 
Message-ID: <E1ApuQo-00062D-00@common-lisp.net>

Update of /project/slime/cvsroot/slime
In directory common-lisp.net:/tmp/cvs-serv14241

Modified Files:
	slime.el 
Log Message:
(sldb-show-frame-details): Fix typos.

(slime-print-apropos): Don't bind action.

(slime-reset): Kill sldb-buffers.

(slime-test-find-definition, slime-test-complete-symbol)
(slime-test-arglist): Add more slime-check-top-level calls.
Date: Sun Feb  8 14:17:25 2004
Author: heller

Index: slime/slime.el
diff -u slime/slime.el:1.207 slime/slime.el:1.208
--- slime/slime.el:1.207	Sat Feb  7 15:59:44 2004
+++ slime/slime.el	Sun Feb  8 14:17:25 2004
@@ -89,22 +89,22 @@
 the same name instead."))
 
 (defvar slime-dont-prompt nil
-  "When true, don't prompt the user for input during startup.
+  "* When true, don't prompt the user for input during startup.
 This is used for batch-mode testing.")
 
 (defvar slime-truncate-lines t
-  "When true, set `truncate-lines' in certain popup buffers.
+  "* When true, set `truncate-lines' in certain popup buffers.
 This applies to buffers that present lines as rows of data, such as
 debugger backtraces and apropos listings.")
 
 (defvar slime-global-debugger-hook nil
-  "When true, install the SLIME debugger hook globally in Lisp.
+  "* When true, install the SLIME debugger hook globally in Lisp.
 
 This means the SLIME debugger will be used for all errors occuring in
 Lisp, not just those occuring during RPCs.")
 
 (defvar slime-multiprocessing nil
-  "When true, enable multiprocessing in Lisp.")
+  "* When true, enable multiprocessing in Lisp.")
 
 (defvar slime-translate-to-lisp-filename-function 'identity
   "Function to use for translating Emacs filenames to Lisp filenames.
@@ -1375,8 +1375,10 @@
 (defun slime-reset ()
   "Clear all pending continuations."
   (interactive)
-  (setq slime-rex-continuations '()))
-
+  (setq slime-rex-continuations '())
+  (when-let (sldb (get-sldb-buffer))
+    (kill-buffer sldb)))
+                        
 (defun slime-nyi ()
   (error "Not yet implemented!"))
 
@@ -3498,7 +3500,7 @@
                                 designator))
     (terpri)
     (let ((apropos-label-properties slime-apropos-label-properties))
-      (loop for (prop namespace action) 
+      (loop for (prop namespace) 
 	    in '((:variable "Variable")
 		 (:function "Function")
 		 (:generic-function "Generic Function")
@@ -3968,8 +3970,8 @@
       (insert "\n" (in-sldb-face section "Backtrace:") "\n")
       (setq sldb-backtrace-start-marker (point-marker))
       (sldb-insert-frames (sldb-prune-initial-frames frames) nil)
-      (pop-to-buffer (current-buffer))
       (run-hooks 'sldb-hook)
+      (pop-to-buffer (current-buffer))
       (setq buffer-read-only t)
       (when (and slime-stack-eval-tags
                  (y-or-n-p "Enter recursive edit? "))
@@ -4157,13 +4159,13 @@
 	    (let ((catchers (sldb-catch-tags frame-number)))
 	      (cond ((null catchers)
 		     (insert indent1
-                             (in-sldb-face catch-tags "[No catch-tags]\n")))
+                             (in-sldb-face catch-tag "[No catch-tags]\n")))
 		    (t
 		     (insert indent1 "Catch-tags:\n")
 		     (loop for (tag . location) in catchers
 			   do (slime-insert-propertized  
 			       '(catch-tag ,tag)
-			       indent2 (in-sldb-face catch-tags 
+			       indent2 (in-sldb-face catch-tag
                                                      (format "%S\n" tag))))))))
 
 	  (unless sldb-enable-styled-backtrace (terpri))
@@ -4918,6 +4920,7 @@
       (swank::read-from-emacs "CL-USER")
       (swank:start-server "CL-USER"))
   (switch-to-buffer "*scratch*")        ; not buffer of definition
+  (slime-check-top-level)
   (let ((orig-buffer (current-buffer))
         (orig-pos (point))
         (enable-local-variables nil)    ; don't get stuck on -*- eval: -*-
@@ -4933,7 +4936,8 @@
     (slime-pop-find-definition-stack)
     (slime-check "Returning from definition restores original buffer/position."
       (and (eq orig-buffer (current-buffer))
-           (= orig-pos (point))))))
+           (= orig-pos (point)))))
+    (slime-check-top-level))
 
 (def-slime-test complete-symbol
     (prefix expected-completions)
@@ -4947,9 +4951,11 @@
                            "cl::compile-file"))
       ("cl:m-v-l" (("cl:multiple-value-list" "cl:multiple-values-limit")
                    "cl:multiple-value-li")))
+  (slime-check-top-level)
   (let ((completions (slime-completions prefix)))
     (slime-check "Completion set is as expected."
-      (equal expected-completions completions))))
+      (equal expected-completions completions)))
+  (slime-check-top-level))
 
 (def-slime-test arglist
     (function-name expected-arglist)
@@ -4960,7 +4966,7 @@
       ("swank::compound-prefix-match"
        "(swank::compound-prefix-match prefix target)")
       ("swank::create-socket"
-       "(swank::create-socket port)")
+       "(swank::create-socket host port)")
       ("swank::emacs-connected"
        "(swank::emacs-connected)")
       ("swank::compile-string-for-emacs"
@@ -4971,9 +4977,11 @@
 ;;    Different arglists found in the wild.
 ;;      ("cl:class-name"
 ;;       "(cl:class-name structure)"))
+  (slime-check-top-level)
   (let ((arglist (slime-get-arglist function-name))) ;
     (slime-test-expect "Argument list is as expected"
-                       expected-arglist arglist)))
+                       expected-arglist arglist))
+  (slime-check-top-level))
 
 (def-slime-test compile-defun 
     (program subform)
@@ -4995,6 +5003,7 @@
            (list `(1 ,(random 10) 2 ,@(random 10) 3 ,(cl-user::bar))))"
        (cl-user::bar))
       )
+  (slime-check-top-level)
   (with-temp-buffer 
     (lisp-mode)
     (insert program)
@@ -5004,26 +5013,30 @@
     (slime-previous-note)
     (slime-check error-location-correct
       (equal (read (current-buffer))
-             subform))))
+             subform)))
+  (slime-check-top-level))
 
 (def-slime-test async-eval-debugging (depth)
   "Test recursive debugging of asynchronous evaluation requests."
   '((1) (2) (3))
+  (slime-check-top-level)
   (lexical-let ((depth depth)
                 (debug-hook-max-depth 0))
     (let ((debug-hook
            (lambda ()
-             (when (> sldb-level debug-hook-max-depth)
-               (setq debug-hook-max-depth sldb-level)
-               (if (= sldb-level depth)
-                   ;; We're at maximum recursion - time to unwind
-                   (sldb-quit)
-                 ;; Going down - enter another recursive debug
-                 ;; Recursively debug.
-                 (slime-eval-async 'no-such-variable nil (lambda (_) nil)))))))
+             (with-current-buffer (get-sldb-buffer)
+               (when (> sldb-level debug-hook-max-depth)
+                 (setq debug-hook-max-depth sldb-level)
+                 (if (= sldb-level depth)
+                     ;; We're at maximum recursion - time to unwind
+                     (sldb-quit)
+                   ;; Going down - enter another recursive debug
+                   ;; Recursively debug.
+                   (slime-eval-async 'no-such-variable 
+                                     nil (lambda (_) nil))))))))
       (let ((sldb-hook (cons debug-hook sldb-hook)))
         (slime-eval-async 'no-such-variable nil (lambda (_) nil))
-        (slime-sync-to-top-level 5)
+        (slime-sync-to-top-level 15)
         (slime-check-top-level)
         (slime-check ("Maximum depth reached (%S) is %S."
                       debug-hook-max-depth depth)
@@ -5061,8 +5074,7 @@
   (with-current-buffer (get-sldb-buffer)
     (sldb-continue))
   (slime-wait-condition "running" (lambda () (and (slime-busy-p)
-                                                   (not (get-sldb-buffer))))
-                        5)
+                                                  (not (get-sldb-buffer)))) 5)
   (slime-interrupt)
   (slime-wait-condition "Second interrupt" (lambda () (slime-sldb-level= 1)) 5)
   (with-current-buffer (get-sldb-buffer)




From heller at common-lisp.net  Sun Feb  8 19:19:43 2004
From: heller at common-lisp.net (Helmut Eller)
Date: Sun, 08 Feb 2004 14:19:43 -0500
Subject: [slime-cvs] CVS update: slime/swank-backend.lisp
	slime/swank-cmucl.lisp slime/swank-sbcl.lisp
	slime/swank-allegro.lisp slime/swank-lispworks.lisp
	slime/swank-openmcl.lisp slime/swank-clisp.lisp 
Message-ID: <E1ApuT1-00029P-00@common-lisp.net>

Update of /project/slime/cvsroot/slime
In directory common-lisp.net:/tmp/cvs-serv5504

Modified Files:
	swank-backend.lisp swank-cmucl.lisp swank-sbcl.lisp 
	swank-allegro.lisp swank-lispworks.lisp swank-openmcl.lisp 
	swank-clisp.lisp 
Log Message:
(create-socket): Take interface as argument.

Date: Sun Feb  8 14:19:42 2004
Author: heller

Index: slime/swank-backend.lisp
diff -u slime/swank-backend.lisp:1.28 slime/swank-backend.lisp:1.29
--- slime/swank-backend.lisp:1.28	Sat Feb  7 14:28:41 2004
+++ slime/swank-backend.lisp	Sun Feb  8 14:19:42 2004
@@ -66,7 +66,6 @@
            #:debugger-info-for-emacs
            #:start-server
            #:startup-multiprocessing
-           #:startup-multiprocessing-for-emacs
            #:swank-compile-file
            #:swank-compile-string
            #:swank-macroexpand
@@ -147,8 +146,8 @@
 
 ;;;; TCP server
 
-(definterface create-socket (port)
-  "Create a listening TCP socket on port PORT.")
+(definterface create-socket (host port)
+  "Create a listening TCP socket on interface HOST and port PORT .")
 
 (definterface local-port (socket)
   "Return the local port number of SOCKET.")
@@ -494,9 +493,8 @@
   (:documentation
    "Return a short description and a list of (LABEL . VALUE) pairs."))
 
-(defgeneric describe-primitive-type (object)
-  (:documentation
-   "Return a string describing the primitive type of object."))
+(definterface describe-primitive-type (object)
+  "Return a string describing the primitive type of object.")
 
 
 ;;;; Multiprocessing


Index: slime/swank-cmucl.lisp
diff -u slime/swank-cmucl.lisp:1.62 slime/swank-cmucl.lisp:1.63
--- slime/swank-cmucl.lisp:1.62	Sat Feb  7 17:31:11 2004
+++ slime/swank-cmucl.lisp	Sun Feb  8 14:19:42 2004
@@ -9,13 +9,10 @@
 
 (setq *swank-in-background* :sigio)
 
-(defimplementation create-socket (port)
-  (let ((fd (ext:create-inet-listener port :stream
-                                      :reuse-address t
-                                      :host (resolve-hostname "localhost"))))
-    #+MP
-    ;;  (when *multiprocessing-enabled* (set-fd-non-blocking fd))
-    fd))
+(defimplementation create-socket (host port)
+  (ext:create-inet-listener 0 :stream
+                            :reuse-address t
+                            :host (resolve-hostname host)))
 
 (defimplementation local-port (socket)
   (nth-value 1 (ext::get-socket-host-and-port (socket-fd socket))))


Index: slime/swank-sbcl.lisp
diff -u slime/swank-sbcl.lisp:1.64 slime/swank-sbcl.lisp:1.65
--- slime/swank-sbcl.lisp:1.64	Sat Feb  7 17:29:54 2004
+++ slime/swank-sbcl.lisp	Sun Feb  8 14:19:42 2004
@@ -62,12 +62,16 @@
 
 (setq *swank-in-background* :sigio)
 
-(defimplementation create-socket (port)
+(defun resolve-hostname (name)
+  (car (sb-bsd-sockets:host-ent-addresses
+        (sb-bsd-sockets:get-host-by-name name))))
+
+(defimplementation create-socket (host port)
   (let ((socket (make-instance 'sb-bsd-sockets:inet-socket
 			       :type :stream
 			       :protocol :tcp)))
     (setf (sb-bsd-sockets:sockopt-reuse-address socket) t)
-    (sb-bsd-sockets:socket-bind socket #(127 0 0 1) port)
+    (sb-bsd-sockets:socket-bind socket (resolve-hostname host) port)
     (sb-bsd-sockets:socket-listen socket 5)
     socket))
 


Index: slime/swank-allegro.lisp
diff -u slime/swank-allegro.lisp:1.13 slime/swank-allegro.lisp:1.14
--- slime/swank-allegro.lisp:1.13	Sat Feb  7 14:30:05 2004
+++ slime/swank-allegro.lisp	Sun Feb  8 14:19:42 2004
@@ -5,12 +5,8 @@
 ;;; Created 2003, Helmut Eller
 ;;;
 ;;; This code has been placed in the Public Domain.  All warranties
-;;; are disclaimed.
-;;;
-;;;   $Id: swank-allegro.lisp,v 1.13 2004/02/07 19:30:05 heller Exp $
-;;;
-;;; This code was written for 
-;;;   Allegro CL Trial Edition "5.0 [Linux/X86] (8/29/98 10:57)"
+;;; are disclaimed. This code was written for "Allegro CL Trial
+;;; Edition "5.0 [Linux/X86] (8/29/98 10:57)".
 ;;;  
 
 (eval-when (:compile-toplevel :load-toplevel :execute)
@@ -36,8 +32,9 @@
 
 (setq *swank-in-background* :spawn)
 
-(defimplementation create-socket (port)
-  (socket:make-socket :connect :passive :local-port port :reuse-address t))
+(defimplementation create-socket (host port)
+  (socket:make-socket :connect :passive :local-port port 
+                      :local-host host :reuse-address t))
 
 (defimplementation local-port (socket)
   (socket:local-port socket))


Index: slime/swank-lispworks.lisp
diff -u slime/swank-lispworks.lisp:1.21 slime/swank-lispworks.lisp:1.22
--- slime/swank-lispworks.lisp:1.21	Sat Feb  7 14:30:05 2004
+++ slime/swank-lispworks.lisp	Sun Feb  8 14:19:42 2004
@@ -34,9 +34,9 @@
     (fixnum socket)
     (comm:socket-stream (comm:socket-stream-socket socket))))
 
-(defimplementation create-socket (port)
+(defimplementation create-socket (host port)
   (multiple-value-bind (socket where errno)
-      (comm::create-tcp-socket-for-service port :address "localhost")
+      (comm::create-tcp-socket-for-service port :address host)
     (cond (socket socket)
           (t (error 'network-error 
               :format-control "~A failed: ~A (~D)"


Index: slime/swank-openmcl.lisp
diff -u slime/swank-openmcl.lisp:1.62 slime/swank-openmcl.lisp:1.63
--- slime/swank-openmcl.lisp:1.62	Sun Feb  8 10:37:33 2004
+++ slime/swank-openmcl.lisp	Sun Feb  8 14:19:42 2004
@@ -71,8 +71,9 @@
 
 (setq *swank-in-background* :spawn)
 
-(defimplementation create-socket (port)
-  (ccl:make-socket :connect :passive :local-port port :reuse-address t))
+(defimplementation create-socket (host port)
+  (ccl:make-socket :connect :passive :local-port port 
+                   :local-host host :reuse-address t))
 
 (defimplementation local-port (socket)
   (ccl:local-port socket))


Index: slime/swank-clisp.lisp
diff -u slime/swank-clisp.lisp:1.16 slime/swank-clisp.lisp:1.17
--- slime/swank-clisp.lisp:1.16	Thu Feb  5 00:57:04 2004
+++ slime/swank-clisp.lisp	Sun Feb  8 14:19:42 2004
@@ -67,7 +67,8 @@
 
 (setq *swank-in-background* nil)
 
-(defimplementation create-socket (port)
+(defimplementation create-socket (host port)
+  (declare (ignore host))
   (socket:socket-server port))
 
 (defimplementation local-port (socket)




From heller at common-lisp.net  Sun Feb  8 19:39:16 2004
From: heller at common-lisp.net (Helmut Eller)
Date: Sun, 08 Feb 2004 14:39:16 -0500
Subject: [slime-cvs] CVS update: slime/ChangeLog 
Message-ID: <E1Apulw-0004GG-00@common-lisp.net>

Update of /project/slime/cvsroot/slime
In directory common-lisp.net:/tmp/cvs-serv10186

Modified Files:
	ChangeLog 
Log Message:
*** empty log message ***
Date: Sun Feb  8 14:39:15 2004
Author: heller

Index: slime/ChangeLog
diff -u slime/ChangeLog:1.253 slime/ChangeLog:1.254
--- slime/ChangeLog:1.253	Sun Feb  8 10:35:23 2004
+++ slime/ChangeLog	Sun Feb  8 14:39:15 2004
@@ -1,3 +1,21 @@
+2004-02-08  Helmut Eller  <e9626484 at stud3.tuwien.ac.at>
+
+	* swank-allegro.lisp, swank-backend.lisp, swank-clisp.lisp,
+	swank-cmucl.lisp, swank-lispworks.lisp, swank-openmcl.lisp,
+	swank-sbcl.lisp (create-socket): Take interface as argument.
+
+	* slime.el (sldb-show-frame-details): Fix typos.
+	(slime-print-apropos): Don't bind action.
+	(slime-reset): Kill sldb-buffers.
+	(slime-test-find-definition, slime-test-complete-symbol)
+	(slime-test-arglist): Add more slime-check-top-level calls.
+
+	* swank.lisp (setup-server): Pass loopback-interface to
+	create-socket.
+	(*loopback-interface*): New parameter.
+	(sldb-loop): Move send :debug event inside unwind-protect, to
+	avoid losing :debug-return events.
+
 2004-02-08  Marco Baringer  <mb at bese.it>
 
 	* swank-openmcl.lisp (find-source-locations): Eliminate unused




From heller at common-lisp.net  Sun Feb  8 20:11:20 2004
From: heller at common-lisp.net (Helmut Eller)
Date: Sun, 08 Feb 2004 15:11:20 -0500
Subject: [slime-cvs] CVS update: slime/swank-cmucl.lisp 
Message-ID: <E1ApvGy-0001mT-00@common-lisp.net>

Update of /project/slime/cvsroot/slime
In directory common-lisp.net:/tmp/cvs-serv3753

Modified Files:
	swank-cmucl.lisp 
Log Message:
(create-socket): Fix last change.  Use the proper port argument down.

Date: Sun Feb  8 15:11:20 2004
Author: heller

Index: slime/swank-cmucl.lisp
diff -u slime/swank-cmucl.lisp:1.63 slime/swank-cmucl.lisp:1.64
--- slime/swank-cmucl.lisp:1.63	Sun Feb  8 14:19:42 2004
+++ slime/swank-cmucl.lisp	Sun Feb  8 15:11:20 2004
@@ -10,7 +10,7 @@
 (setq *swank-in-background* :sigio)
 
 (defimplementation create-socket (host port)
-  (ext:create-inet-listener 0 :stream
+  (ext:create-inet-listener port :stream
                             :reuse-address t
                             :host (resolve-hostname host)))
 




From heller at common-lisp.net  Sun Feb  8 20:13:37 2004
From: heller at common-lisp.net (Helmut Eller)
Date: Sun, 08 Feb 2004 15:13:37 -0500
Subject: [slime-cvs] CVS update: slime/ChangeLog 
Message-ID: <E1ApvJB-0001eC-00@common-lisp.net>

Update of /project/slime/cvsroot/slime
In directory common-lisp.net:/tmp/cvs-serv31311

Modified Files:
	ChangeLog 
Log Message:
*** empty log message ***
Date: Sun Feb  8 15:13:36 2004
Author: heller

Index: slime/ChangeLog
diff -u slime/ChangeLog:1.254 slime/ChangeLog:1.255
--- slime/ChangeLog:1.254	Sun Feb  8 14:39:15 2004
+++ slime/ChangeLog	Sun Feb  8 15:13:36 2004
@@ -1,9 +1,12 @@
 2004-02-08  Helmut Eller  <e9626484 at stud3.tuwien.ac.at>
 
+	* swank-cmucl.lisp (create-socket): Fix last fix.  Use the proper
+	port argument.
+
 	* swank-allegro.lisp, swank-backend.lisp, swank-clisp.lisp,
 	swank-cmucl.lisp, swank-lispworks.lisp, swank-openmcl.lisp,
 	swank-sbcl.lisp (create-socket): Take interface as argument.
-
+	
 	* slime.el (sldb-show-frame-details): Fix typos.
 	(slime-print-apropos): Don't bind action.
 	(slime-reset): Kill sldb-buffers.
@@ -11,10 +14,10 @@
 	(slime-test-arglist): Add more slime-check-top-level calls.
 
 	* swank.lisp (setup-server): Pass loopback-interface to
-	create-socket.
+	create-socket.  Reported by Dirk Gerrits.
 	(*loopback-interface*): New parameter.
-	(sldb-loop): Move send :debug event inside unwind-protect, to
-	avoid losing :debug-return events.
+	(sldb-loop): Send :debug event inside unwind-protect, so we never
+	lose the corresponding :debug-return event.
 
 2004-02-08  Marco Baringer  <mb at bese.it>
 




From dj3ujtnk at escelsa.com.br  Sun Feb  8 20:32:31 2004
From: dj3ujtnk at escelsa.com.br (Sonny Mejia)
Date: Sun, 08 Feb 04 20:32:31 GMT
Subject: [slime-cvs] Have your cake and eat it too
Message-ID: <rz4j-e-9080io40x803d128tr-82@shyp6.kr>

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

From zxfgso3 at nittsu.co.jp  Thu Feb 12 23:17:20 2004
From: zxfgso3 at nittsu.co.jp (Marion Leach)
Date: Thu, 12 Feb 04 23:17:20 GMT
Subject: [slime-cvs] Cash in on other people's success
Message-ID: <4ps8-r09-6tpv5-$-i-$5$y--qh@1xm.civjjssz>

An HTML attachment was scrubbed...
URL: <https://mailman.common-lisp.net/pipermail/slime-cvs/attachments/20040212/9437c881/attachment.html>

From ey288ked at mni.fh-giessen.de  Fri Feb 13 04:21:50 2004
From: ey288ked at mni.fh-giessen.de (Sergio Mcintyre)
Date: Fri, 13 Feb 04 04:21:50 GMT
Subject: [slime-cvs] Different ways to find and choose profitable affiliate
	programs
Message-ID: <z7i7$7-4z278q4p2$6sy8p4-1-p667@afk.h4ah>

An HTML attachment was scrubbed...
URL: <https://mailman.common-lisp.net/pipermail/slime-cvs/attachments/20040213/240a6946/attachment.html>

From 840addyvh at aol.com  Sat Feb 14 23:49:52 2004
From: 840addyvh at aol.com (Darrin Calloway)
Date: Sat, 14 Feb 04 23:49:52 GMT
Subject: [slime-cvs] Re: Application Declined
Message-ID: <b3y59$e-1-001j9zfp0-3wpcqw-b2@21i.g6>

An HTML attachment was scrubbed...
URL: <https://mailman.common-lisp.net/pipermail/slime-cvs/attachments/20040214/9d9bb855/attachment.html>

From heller at common-lisp.net  Mon Feb 16 21:38:27 2004
From: heller at common-lisp.net (Helmut Eller)
Date: Mon, 16 Feb 2004 16:38:27 -0500
Subject: [slime-cvs] CVS update: slime/slime.el 
Message-ID: <E1AsqRf-00012X-00@common-lisp.net>

Update of /project/slime/cvsroot/slime
In directory common-lisp.net:/tmp/cvs-serv3520

Modified Files:
	slime.el 
Log Message:
(slime-compilation-finished): Display compiler notes grouped by
severity in a separate buffer.
(slime-compilation-finished-continuation, slime-compile-file)
(slime-load-system, slime-compile-string): Update callers.
(slime-list-compiler-notes, slime-alistify, slime-tree-for-note)
(slime-tree-for-severity, slime-compiler-notes-to-tree)
(slime-compiler-notes-mode, slime-compiler-notes-quit): New functions.
(with-struct, slime-tree): New code for pseudo tree widget.

(slime-init-connection-state): Set slime-state-name to "".


Date: Mon Feb 16 16:38:27 2004
Author: heller

Index: slime/slime.el
diff -u slime/slime.el:1.208 slime/slime.el:1.209
--- slime/slime.el:1.208	Sun Feb  8 14:17:25 2004
+++ slime/slime.el	Mon Feb 16 16:38:26 2004
@@ -1402,6 +1402,7 @@
   (setf (slime-pid) (slime-eval '(swank:getpid)))
   (setf (slime-lisp-implementation-type) 
         (slime-eval '(cl:lisp-implementation-type)))
+  (setq slime-state-name "")
   (when-let (repl-buffer (slime-repl-buffer))
     ;; REPL buffer already exists - update its local
     ;; `slime-connection' binding.
@@ -2237,7 +2238,7 @@
     (slime-eval-async
      `(swank:swank-compile-file ,lisp-filename ,(if load t nil))
      nil
-     (slime-compilation-finished-continuation))
+     (slime-compilation-finished-continuation t))
     (message "Compiling %s.." lisp-filename)))
 
 (defun slime-find-asd ()
@@ -2262,7 +2263,7 @@
   (slime-eval-async
    `(swank:swank-load-system ,system-name)
    nil
-   (slime-compilation-finished-continuation))
+   (slime-compilation-finished-continuation t))
   (message "Compiling system %s.." system-name))
 
 (defun slime-compile-defun ()
@@ -2283,7 +2284,7 @@
   (slime-eval-async 
    `(swank:swank-compile-string ,string ,(buffer-name) ,start-offset)
    (slime-buffer-package)
-   (slime-compilation-finished-continuation)))
+   (slime-compilation-finished-continuation nil)))
 
 (defvar slime-hide-style-warning-count-if-zero t)
 
@@ -2336,21 +2337,25 @@
       (replace-match " "))
     (buffer-string)))
 
-(defun slime-compilation-finished (result buffer)
+(defun slime-compilation-finished (result buffer show-notes-buffer)
   (let ((notes (slime-compiler-notes)))
     (with-current-buffer buffer
       (multiple-value-bind (result secs) result
         (slime-show-note-counts notes secs)
         (slime-highlight-notes notes)))
-    (let ((xrefs (slime-xrefs-for-notes notes)))
-      (when (> (length xrefs) 1) ; >1 file
-        (slime-show-xrefs
-         xrefs 'definition "Compiler notes" (slime-buffer-package))))))
-
-(defun slime-compilation-finished-continuation ()
-  (lexical-let ((buffer (current-buffer)))
+    (when (and show-notes-buffer (< 1 (length notes)))
+      (slime-list-compiler-notes notes))
+    ;;(let ((xrefs (slime-xrefs-for-notes notes)))
+    ;;  (when (> (length xrefs) 1) ; >1 file
+    ;;    (slime-show-xrefs
+    ;;     xrefs 'definition "Compiler notes" (slime-buffer-package))))
+    ))
+
+(defun slime-compilation-finished-continuation (show-notes-buffer)
+  (lexical-let ((buffer (current-buffer))
+                (show-notes-buffer show-notes-buffer))
     (lambda (result) 
-      (slime-compilation-finished result buffer))))
+      (slime-compilation-finished result buffer show-notes-buffer))))
 
 (defun slime-highlight-notes (notes)
   "Highlight compiler notes, warnings, and errors in the buffer."
@@ -2374,6 +2379,200 @@
       (goto-char (next-overlay-change (point))))))
 
 
+;;;;; Compiler notes list
+
+(defun slime-list-compiler-notes (&optional notes)
+  (interactive)
+  (let ((notes (or notes (slime-compiler-notes))))
+    (with-current-buffer (get-buffer-create "*compiler notes*")
+      (let ((inhibit-read-only t))
+        (erase-buffer)
+        (slime-tree-insert (slime-compiler-notes-to-tree notes) ""))
+      (slime-compiler-notes-mode)
+      (setq buffer-read-only t)
+      (make-local-variable 'slime-compiler-notes-saved-window-configuration)
+      (setq slime-compiler-notes-saved-window-configuration
+            (current-window-configuration))
+      (display-buffer (current-buffer)))))
+
+(defun slime-alistify (list key test)
+  "Partition the elements of LIST into an alist.  KEY extracts the key
+from an element and TEST is used to compare keys."
+  (declare (type function key))
+  (let ((alist '()))
+    (dolist (e list)
+      (let* ((k (funcall key e))
+	     (probe (assoc* k alist :test test)))
+	(if probe
+	    (push e (cdr probe))
+            (push (cons k (list e)) alist))))
+    alist))
+
+(defun slime-note.severity (note)
+  (plist-get note :severity))
+
+(defun slime-note.message (note)
+  (plist-get note :message))
+
+(defun slime-note.short-message (note)
+  (plist-get note :short-message))
+
+(defun slime-note.location (note)
+  (plist-get note :location))
+
+(defun slime-severity-label (severity)
+  (ecase severity
+    (:note "Notes")
+    (:warning "Warnings")
+    (:error "Errors")
+    (:style-warning "Style Warnings")))
+
+(defun slime-tree-for-note (note)
+  (make-slime-tree :item (slime-note.short-message note)
+                   :plist (list 'note note)))
+
+(defun slime-tree-for-severity (severity notes)
+  (make-slime-tree :item (format "%s (%d)" 
+                                 (slime-severity-label severity)
+                                 (length notes))
+                   :kids (mapcar #'slime-tree-for-note notes)))
+
+(defun slime-compiler-notes-to-tree (notes)
+  (let ((kids (let ((alist (slime-alistify notes #'slime-note.severity #'eq)))
+                (loop for (severity . notes) in alist
+                      collect (slime-tree-for-severity severity notes)))))
+    (make-slime-tree :item (format "All (%d)"  (length notes))
+                     :kids kids :collapsed-p nil)))
+
+(defvar slime-compiler-notes-mode-map)
+
+(define-derived-mode slime-compiler-notes-mode fundamental-mode 
+  "Compiler Notes"
+  "\\<slime-compiler-notes-mode-map>
+\\{slime-compiler-notes-mode-map}"
+  (slime-set-truncate-lines))
+
+(slime-define-keys slime-compiler-notes-mode-map
+  ((kbd "RET") 'slime-compiler-notes-show-details)
+  ("q" 'slime-compiler-notes-quit))
+
+(defun slime-compiler-notes-quit ()
+  (interactive)
+  (let ((config slime-compiler-notes-saved-window-configuration))
+    (kill-buffer (current-buffer))
+    (set-window-configuration config)))
+
+(defun slime-compiler-notes-show-details ()
+  (interactive)
+  (let* ((tree (slime-tree-at-point))
+         (note (plist-get (slime-tree.plist tree) 'note))
+         (inhibit-read-only t))
+    (cond ((not (slime-tree-leaf-p tree))
+           (slime-tree-toggle tree))
+          (t
+           (slime-show-source-location (slime-note.location note))))))
+          
+
+;;;;;;; Tree Widget
+
+(defmacro* with-struct ((conc-name &rest slots) struct &body body)
+  "Like with-slots but works only for structs."
+  (flet ((reader (slot) (intern (concat (symbol-name conc-name)
+					(symbol-name slot)))))
+    (let ((struct-var (gensym "struct")))
+      `(let ((,struct-var ,struct))
+	 (symbol-macrolet
+	     ,(mapcar (lambda (slot)
+			(etypecase slot
+			  (symbol `(,slot (,(reader slot) ,struct-var)))
+			  (cons `(,(first slot) (,(reader (second slot)) 
+						 ,struct-var)))))
+		      slots)
+	   . ,body)))))
+
+(put 'with-struct 'lisp-indent-function 2)
+
+(defstruct (slime-tree (:conc-name slime-tree.))
+  item
+  (print-fn #'slime-tree-default-printer :type function)
+  (kids '() :type list)
+  (collapsed-p t :type boolean)
+  (prefix "" :type string)
+  (start-mark nil)
+  (end-mark nil)
+  (plist '() :type list))
+
+(defun slime-tree-leaf-p (tree)
+  (not (slime-tree.kids tree)))
+
+(defun slime-tree-default-printer (tree)
+  (princ (slime-tree.item tree) (current-buffer)))
+
+(defun slime-tree-decoration (tree)
+  (cond ((slime-tree-leaf-p tree) "-- ")
+	((slime-tree.collapsed-p tree) "[+] ")
+	(t "-+  ")))
+
+(defun slime-tree-insert-list (list prefix)
+  "Insert a list of trees."
+  (loop for (elt . rest) on list 
+	do (cond (rest
+		  (insert prefix " |")
+		  (slime-tree-insert elt (concat prefix " |")))
+		 (t
+		  (insert prefix " `")
+		  (slime-tree-insert elt (concat prefix "  "))))))
+
+(defun slime-tree-insert-decoration (tree)
+  (insert (slime-tree-decoration tree)))
+
+(defun slime-tree-indent-item (start end prefix)
+  "Insert PREFIX at the beginning of each but the first line.
+This is used for labels spanning multiple lines."
+  (save-excursion 
+    (goto-char end)
+    (beginning-of-line)
+    (while (< start (point))
+      (insert prefix)
+      (forward-line -1))))
+
+(defun slime-tree-insert (tree prefix)
+  "Insert TREE prefixed with PREFIX at point."
+  (with-struct (slime-tree. print-fn kids collapsed-p start-mark end-mark) tree
+    (setf start-mark (point-marker))
+    (slime-tree-insert-decoration tree)
+    (funcall print-fn tree)
+    (slime-tree-indent-item start-mark (point) (concat prefix "   "))
+    (let ((end (point)))
+      (terpri (current-buffer))
+      (add-text-properties start-mark end (list 'slime-tree tree)))
+    (when (and kids (not collapsed-p))
+      (slime-tree-insert-list kids prefix))
+    (setf (slime-tree.prefix tree) prefix)
+    (setf end-mark (point-marker))))
+
+(defun slime-tree-at-point ()
+  (cond ((get-text-property (point) 'slime-tree))
+        (t (error "No tree at point"))))
+
+(defun slime-tree-delete (tree)
+  "Delete the region for TREE."
+  (delete-region (slime-tree.start-mark tree)
+                 (slime-tree.end-mark tree)))
+
+(defun slime-tree-toggle (tree)
+  "Toggle the visibility of TREE's children."
+  (with-struct (slime-tree. collapsed-p start-mark end-mark prefix) tree
+    (setf collapsed-p (not collapsed-p))
+    (slime-tree-delete tree)
+    (goto-char end-mark)
+    (insert-before-markers " ") ; keep markers separated
+    (backward-char)
+    (slime-tree-insert tree prefix)
+    (delete-char 1)
+    (goto-char start-mark)))
+
+
 ;;;;; Adding a single compiler note
 
 (defun slime-overlay-note (note)
@@ -5436,6 +5635,7 @@
         slime-net-read3
         slime-net-read
         slime-print-apropos
+        slime-show-note-counts
         slime-insert-propertized))
 
 (run-hooks 'slime-load-hook)




From heller at common-lisp.net  Mon Feb 16 21:39:39 2004
From: heller at common-lisp.net (Helmut Eller)
Date: Mon, 16 Feb 2004 16:39:39 -0500
Subject: [slime-cvs] CVS update: slime/swank-backend.lisp 
Message-ID: <E1AsqSp-0005fk-00@common-lisp.net>

Update of /project/slime/cvsroot/slime
In directory common-lisp.net:/tmp/cvs-serv21800

Modified Files:
	swank-backend.lisp 
Log Message:
(compile-system-for-emacs): Add default implementation.

(compiler-condition): New slot short-message.

Date: Mon Feb 16 16:39:39 2004
Author: heller

Index: slime/swank-backend.lisp
diff -u slime/swank-backend.lisp:1.29 slime/swank-backend.lisp:1.30
--- slime/swank-backend.lisp:1.29	Sun Feb  8 14:19:42 2004
+++ slime/swank-backend.lisp	Mon Feb 16 16:39:39 2004
@@ -24,6 +24,7 @@
            #:describe-definition
            #:describe-symbol
            #:describe-symbol-for-emacs
+           #:describe-function
            #:disassemble-symbol
            #:documentation-symbol
            #:eval-in-frame
@@ -31,6 +32,7 @@
            #:restart-frame
            #:eval-string
            #:eval-string-in-frame
+           #:oneway-eval-string
            #:find-function-locations
            #:frame-catch-tags
            #:frame-locals
@@ -44,6 +46,7 @@
            #:inspect-nth-part
            #:inspector-next
            #:inspector-pop
+           #:describe-inspectee
            #:interactive-eval
            #:interactive-eval-region
            #:invoke-nth-restart
@@ -62,12 +65,15 @@
            #:sldb-abort
            #:sldb-break-with-default-debugger
            #:sldb-continue
+           #:sldb-disassemble
+           #:sldb-step
            #:slime-debugger-function
            #:debugger-info-for-emacs
            #:start-server
            #:startup-multiprocessing
            #:swank-compile-file
            #:swank-compile-string
+           #:swank-load-system
            #:swank-macroexpand
            #:swank-macroexpand-1
            #:swank-macroexpand-all
@@ -84,6 +90,7 @@
            #:profile-report
            #:profile-reset
            #:profile-package
+           #:toggle-profile-fdefinition
            #:wait-goahead
            #:warn-unimplemented-interfaces
            #:who-binds
@@ -91,6 +98,10 @@
            #:who-macroexpands
            #:who-references
            #:who-sets
+           #:who-specializes
+           #:list-threads
+           #:quit-thread-browser
+           #:ed-in-emacs
            ))
 
 (in-package :swank)
@@ -210,7 +221,13 @@
 (definterface compile-system-for-emacs (system-name)
   "Compile and load SYSTEM-NAME, During compilation compiler
   conditions must be trapped and resignalled as
-  COMPILER-CONDITION ala compile-string-for-emacs.")
+  COMPILER-CONDITION ala compile-string-for-emacs."
+  (with-compilation-hooks ()
+    (cond ((member :asdf *features*)
+           (let ((operate (find-symbol (string :operate) :asdf))
+                 (load-op (find-symbol (string :load-op) :asdf)))
+             (funcall operate load-op system-name)))
+          (t (error "ASDF not loaded")))))
 
 (definterface compile-file-for-emacs (filename load-p)
    "Compile FILENAME signalling COMPILE-CONDITIONs.
@@ -234,8 +251,14 @@
    (message :initarg :message
             :accessor message)
 
+   (short-message :initarg :short-message
+                  :initform nil
+                  :accessor short-message)
+
    (location :initarg :location
              :accessor location)))
+
+
 
 
 ;;;; Streams




From heller at common-lisp.net  Mon Feb 16 21:40:56 2004
From: heller at common-lisp.net (Helmut Eller)
Date: Mon, 16 Feb 2004 16:40:56 -0500
Subject: [slime-cvs] CVS update: slime/swank-clisp.lisp 
Message-ID: <E1AsqU4-0001BI-00@common-lisp.net>

Update of /project/slime/cvsroot/slime
In directory common-lisp.net:/tmp/cvs-serv4064

Modified Files:
	swank-clisp.lisp 
Log Message:
(set-sigio-handler, add-input-handler): Conditionalize for linux.
Date: Mon Feb 16 16:40:55 2004
Author: heller

Index: slime/swank-clisp.lisp
diff -u slime/swank-clisp.lisp:1.17 slime/swank-clisp.lisp:1.18
--- slime/swank-clisp.lisp:1.17	Sun Feb  8 14:19:42 2004
+++ slime/swank-clisp.lisp	Mon Feb 16 16:40:55 2004
@@ -95,23 +95,27 @@
 
 (defvar *saved-sigio-handler*)
 
-(defun set-sigio-handler ()
-  (setf *saved-sigio-handler*
-	(linux:set-signal-handler linux:SIGIO 
-				  (lambda (signal) (sigio-handler signal))))
-  (let* ((action (linux:signal-action-retrieve linux:SIGIO))
-	 (flags (linux:sa-flags action)))
-    (setf (linux:sa-flags action) (logior flags linux:SA_NODEFER))
-    (linux:signal-action-install linux:SIGIO action)))
+#+linux
+(progn
+  (defun set-sigio-handler ()
+    (setf *saved-sigio-handler*
+	  (linux:set-signal-handler linux:SIGIO 
+				    (lambda (signal) (sigio-handler signal))))
+    (let* ((action (linux:signal-action-retrieve linux:SIGIO))
+	   (flags (linux:sa-flags action)))
+      (setf (linux:sa-flags action) (logior flags linux:SA_NODEFER))
+      (linux:signal-action-install linux:SIGIO action)))
 
-(defimplementation add-input-handler (socket fn)
-  (set-sigio-handler)
-  (let ((fd (socket:socket-stream-handle socket)))
-    (format *debug-io* "Adding input handler: ~S ~%" fd)
-    ;; XXX error checking
-    (linux:fcntl3l fd linux:F_SETOWN (getpid))
-    (linux:fcntl3l fd linux:F_SETFL linux:O_ASYNC)
-    (push (cons fd fn) *sigio-handlers*)))
+
+  (defimplementation add-input-handler (socket fn)
+    (set-sigio-handler)
+    (let ((fd (socket:socket-stream-handle socket)))
+      (format *debug-io* "Adding input handler: ~S ~%" fd)
+      ;; XXX error checking
+      (linux:fcntl3l fd linux:F_SETOWN (getpid))
+      (linux:fcntl3l fd linux:F_SETFL linux:O_ASYNC)
+      (push (cons fd fn) *sigio-handlers*)))
+  )
 
 (defimplementation remove-input-handlers (socket)
   (let ((fd (socket:socket-stream-handle socket)))




From heller at common-lisp.net  Mon Feb 16 21:44:18 2004
From: heller at common-lisp.net (Helmut Eller)
Date: Mon, 16 Feb 2004 16:44:18 -0500
Subject: [slime-cvs] CVS update: slime/swank-cmucl.lisp 
Message-ID: <E1AsqXK-0001u5-00@common-lisp.net>

Update of /project/slime/cvsroot/slime
In directory common-lisp.net:/tmp/cvs-serv7305

Modified Files:
	swank-cmucl.lisp 
Log Message:
(handle-notification-condition): Don't use the context of the previous
message.
(signal-compiler-condition): Set short message slot.
(long-compiler-message-for-emacs): New function.

(sigio-handler): Ignore arguments.
Date: Mon Feb 16 16:44:18 2004
Author: heller

Index: slime/swank-cmucl.lisp
diff -u slime/swank-cmucl.lisp:1.64 slime/swank-cmucl.lisp:1.65
--- slime/swank-cmucl.lisp:1.64	Sun Feb  8 15:11:20 2004
+++ slime/swank-cmucl.lisp	Mon Feb 16 16:44:18 2004
@@ -34,6 +34,7 @@
   (setf *sigio-handlers* (delete key *sigio-handlers* :key #'car)))
 
 (defun sigio-handler (signal code scp)
+  (declare (ignore signal code scp))
   (mapc (lambda (handler) (funcall (cdr handler))) *sigio-handlers*)
   )
 
@@ -224,7 +225,7 @@
 craft our own error messages, which can omit a lot of redundant
 information."
   (unless (eq condition *previous-compiler-condition*)
-    (let ((context (or (c::find-error-context nil) *previous-context*)))
+    (let ((context (c::find-error-context nil)))
       (setq *previous-compiler-condition* condition)
       (setq *previous-context* context)
       (signal-compiler-condition condition context))))
@@ -234,7 +235,8 @@
            'compiler-condition
            :original-condition condition
            :severity (severity-for-emacs condition)
-           :message (brief-compiler-message-for-emacs condition context)
+           :short-message (brief-compiler-message-for-emacs condition)
+           :message (long-compiler-message-for-emacs condition context)
            :location (compiler-note-location context))))
 
 (defun severity-for-emacs (condition)
@@ -244,11 +246,15 @@
     (c::style-warning :note)
     (c::warning :warning)))
 
-(defun brief-compiler-message-for-emacs (condition error-context)
+(defun brief-compiler-message-for-emacs (condition)
   "Briefly describe a compiler error for Emacs.
 When Emacs presents the message it already has the source popped up
 and the source form highlighted. This makes much of the information in
 the error-context redundant."
+  (princ-to-string condition))
+
+(defun long-compiler-message-for-emacs (condition error-context)
+  "Describe a compiler error for Emacs including context information."
   (declare (type (or c::compiler-error-context null) error-context))
   (multiple-value-bind (enclosing source)
       (if error-context
@@ -257,7 +263,6 @@
     (format nil "~@[--> ~{~<~%--> ~1:;~A~> ~}~%~]~@[~{==>~%~A~^~%~}~]~A"
             enclosing source condition)))
 
-
 (defun compiler-note-location (context)
   (cond (context
          (resolve-note-location
@@ -299,10 +304,6 @@
         (*compile-file-truename*
          (make-location (list :file (namestring *compile-file-truename*))
                         (list :position 0)))
-        (*compile-filename*
-         ;; XXX is this _ever_ used?  By what?  *compile-file-truename*
-         ;; should be set by the implementation inside any call to compile-file
-         (make-location (list :file *compile-filename*) (list :position 0)))
         (t 
          (list :error "No error location available"))))
 
@@ -340,14 +341,6 @@
                         :emacs-buffer-offset ,position
                         :emacs-buffer-string ,string))))))
 
-(defimplementation compile-system-for-emacs (system-name)
-  (with-compilation-hooks ()
-    (cond ((ext:featurep :asdf)
-           (let ((operate (find-symbol (string :operate) :asdf))
-                 (load-op (find-symbol (string :load-op) :asdf)))
-             (funcall operate load-op system-name)))
-          (t (error "ASDF not loaded")))))
-
 
 ;;;; XREF
 
@@ -412,8 +405,8 @@
 (defun clear-xref-info (namestring)
   "Clear XREF notes pertaining to FILENAME.
 This is a workaround for a CMUCL bug: XREF records are cumulative."
-  (let ((filename (parse-namestring namestring)))
-    (when c:*record-xref-info*
+  (when c:*record-xref-info*
+    (let ((filename (parse-namestring namestring)))
       (dolist (db (list xref::*who-calls*
                         #+cmu19 xref::*who-is-called*
                         #+cmu19 xref::*who-macroexpands*




From heller at common-lisp.net  Mon Feb 16 21:45:22 2004
From: heller at common-lisp.net (Helmut Eller)
Date: Mon, 16 Feb 2004 16:45:22 -0500
Subject: [slime-cvs] CVS update: slime/swank-sbcl.lisp 
Message-ID: <E1AsqYM-00051E-00@common-lisp.net>

Update of /project/slime/cvsroot/slime
In directory common-lisp.net:/tmp/cvs-serv19008

Modified Files:
	swank-sbcl.lisp 
Log Message:
(signal-compiler-condition): Initialize short-message slot.
(long-compiler-message-for-emacs): New function.
Date: Mon Feb 16 16:45:22 2004
Author: heller

Index: slime/swank-sbcl.lisp
diff -u slime/swank-sbcl.lisp:1.65 slime/swank-sbcl.lisp:1.66
--- slime/swank-sbcl.lisp:1.65	Sun Feb  8 14:19:42 2004
+++ slime/swank-sbcl.lisp	Mon Feb 16 16:45:22 2004
@@ -121,7 +121,7 @@
         (t
          (unless (sb-int:featurep :linux)
            (warn "~
-You aren't runinng Linux. The values of +o_async+ etc are probably bogus."))
+You aren't running Linux. The values of +o_async+ etc are probably bogus."))
          (let ((fcntl (sb-alien:extern-alien 
                        "fcntl" 
                        (function sb-alien:int sb-alien:int 
@@ -216,7 +216,8 @@
                        (sb-ext:compiler-note :note)
                        (style-warning        :style-warning)
                        (warning              :warning))
-           :message (brief-compiler-message-for-emacs condition context)
+           :short-message (brief-compiler-message-for-emacs condition)
+           :message (long-compiler-message-for-emacs condition context)
            :location (compiler-note-location context))))
 
 
@@ -265,19 +266,22 @@
         (t 
          (list :error "No error location available"))))
 
-
-(defun brief-compiler-message-for-emacs (condition error-context)
+(defun brief-compiler-message-for-emacs (condition)
   "Briefly describe a compiler error for Emacs.
 When Emacs presents the message it already has the source popped up
 and the source form highlighted. This makes much of the information in
 the error-context redundant."
+  (princ-to-string condition))
+
+(defun long-compiler-message-for-emacs (condition error-context)
+  "Describe a compiler error for Emacs including context information."
   (declare (type (or sb-c::compiler-error-context null) error-context))
-  (let ((enclosing 
-         (and error-context
-              (sb-c::compiler-error-context-enclosing-source error-context))))
-    (if enclosing
-        (format nil "--> ~{~<~%--> ~1:;~A~> ~}~%~A" enclosing condition)
-        (format nil "~A" condition))))
+  (multiple-value-bind (enclosing source)
+      (if error-context
+          (values (sb-c::compiler-error-context-enclosing-source error-context)
+                  (sb-c::compiler-error-context-source error-context)))
+    (format nil "~@[--> ~{~<~%--> ~1:;~A~> ~}~%~]~@[~{==>~%~A~^~%~}~]~A"
+            enclosing source condition)))
 
 (defun current-compiler-error-source-path (context)
   "Return the source-path for the current compiler error.




From heller at common-lisp.net  Mon Feb 16 21:46:13 2004
From: heller at common-lisp.net (Helmut Eller)
Date: Mon, 16 Feb 2004 16:46:13 -0500
Subject: [slime-cvs] CVS update: slime/swank.lisp 
Message-ID: <E1AsqZB-0006E8-00@common-lisp.net>

Update of /project/slime/cvsroot/slime
In directory common-lisp.net:/tmp/cvs-serv23709

Modified Files:
	swank.lisp 
Log Message:
(make-compiler-note): Include short-message.
Date: Mon Feb 16 16:46:13 2004
Author: heller

Index: slime/swank.lisp
diff -u slime/swank.lisp:1.119 slime/swank.lisp:1.120
--- slime/swank.lisp:1.119	Sun Feb  8 14:12:38 2004
+++ slime/swank.lisp	Mon Feb 16 16:46:13 2004
@@ -741,10 +741,6 @@
                      (princ label stream) (funcall fn stream)))))
     (subseq string (length label))))
 
-(defslimefun sldb-can-continue-p ()
-  "Return T if there is a continue restart; otherwise NIL."
-  (if (find-restart 'continue) t nil))
-  
 (defslimefun sldb-continue ()
   (continue))
 
@@ -927,6 +923,8 @@
   "Make a compiler note data structure from a compiler-condition."
   (declare (type compiler-condition condition))
   (list :message (message condition)
+        :short-message (or (short-message condition)
+                           (message condition))
         :severity (severity condition)
         :location (location condition)))
 




From heller at common-lisp.net  Mon Feb 16 22:07:40 2004
From: heller at common-lisp.net (Helmut Eller)
Date: Mon, 16 Feb 2004 17:07:40 -0500
Subject: [slime-cvs] CVS update: slime/ChangeLog 
Message-ID: <E1Asqtw-0007yN-00@common-lisp.net>

Update of /project/slime/cvsroot/slime
In directory common-lisp.net:/tmp/cvs-serv30635

Modified Files:
	ChangeLog 
Log Message:
*** empty log message ***
Date: Mon Feb 16 17:07:40 2004
Author: heller

Index: slime/ChangeLog
diff -u slime/ChangeLog:1.255 slime/ChangeLog:1.256
--- slime/ChangeLog:1.255	Sun Feb  8 15:13:36 2004
+++ slime/ChangeLog	Mon Feb 16 17:07:39 2004
@@ -1,3 +1,35 @@
+2004-02-16  Helmut Eller  <e9626484 at stud3.tuwien.ac.at>
+
+	* swank.lisp (make-compiler-note): Include short-message.
+
+	* swank-sbcl.lisp (signal-compiler-condition): Initialize
+	short-message slot.
+	(long-compiler-message-for-emacs): New function.
+
+	* swank-cmucl.lisp (handle-notification-condition): Don't use the
+	context of the previous message.
+	(signal-compiler-condition): Set short message slot.
+	(long-compiler-message-for-emacs): New function.
+	(sigio-handler): Ignore arguments.
+
+	* swank-clisp.lisp (set-sigio-handler, add-input-handler):
+	Conditionalize for linux.
+
+	* swank-backend.lisp (compile-system-for-emacs): Add default
+	implementation.
+	(compiler-condition): New slot short-message.
+
+	* slime.el (slime-compilation-finished): Display compiler notes
+	grouped by severity in a separate buffer.
+	(slime-compilation-finished-continuation, slime-compile-file)
+	(slime-load-system, slime-compile-string): Update callers.
+	(slime-list-compiler-notes, slime-alistify, slime-tree-for-note)
+	(slime-tree-for-severity, slime-compiler-notes-to-tree)
+	(slime-compiler-notes-mode, slime-compiler-notes-quit): New
+	functions.
+	(with-struct, slime-tree): New code for pseudo tree widget.
+	(slime-init-connection-state): Set slime-state-name to "".
+
 2004-02-08  Helmut Eller  <e9626484 at stud3.tuwien.ac.at>
 
 	* swank-cmucl.lisp (create-socket): Fix last fix.  Use the proper




From 6ewbnl at zg.hinet.hr  Tue Feb 17 16:13:47 2004
From: 6ewbnl at zg.hinet.hr (Nadine Crowe)
Date: Tue, 17 Feb 04 16:13:47 GMT
Subject: [slime-cvs] A fully automated business
Message-ID: <a29--a8o71-9514@ct4.l2sw.f4nl>

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

From heller at common-lisp.net  Tue Feb 17 21:47:04 2004
From: heller at common-lisp.net (Helmut Eller)
Date: Tue, 17 Feb 2004 16:47:04 -0500
Subject: [slime-cvs] CVS update: slime/slime.el 
Message-ID: <E1AtD3Y-0008T5-00@common-lisp.net>

Update of /project/slime/cvsroot/slime
In directory common-lisp.net:/tmp/cvs-serv31552

Modified Files:
	slime.el 
Log Message:
(slime-length>): New function.
(slime-compiler-notes-to-tree): Don't collapse if there is only one
kind of notes.
Date: Tue Feb 17 16:47:03 2004
Author: heller

Index: slime/slime.el
diff -u slime/slime.el:1.209 slime/slime.el:1.210
--- slime/slime.el:1.209	Mon Feb 16 16:38:26 2004
+++ slime/slime.el	Tue Feb 17 16:47:03 2004
@@ -2337,13 +2337,20 @@
       (replace-match " "))
     (buffer-string)))
 
+(defun slime-length> (list n)
+  "Test if (length LIST) is greater than N."
+  (while (and (> n 0) list)
+    (setq list (cdr list))
+    (decf n))
+  list)
+
 (defun slime-compilation-finished (result buffer show-notes-buffer)
   (let ((notes (slime-compiler-notes)))
     (with-current-buffer buffer
       (multiple-value-bind (result secs) result
         (slime-show-note-counts notes secs)
         (slime-highlight-notes notes)))
-    (when (and show-notes-buffer (< 1 (length notes)))
+    (when (and show-notes-buffer (slime-length> notes 1))
       (slime-list-compiler-notes notes))
     ;;(let ((xrefs (slime-xrefs-for-notes notes)))
     ;;  (when (> (length xrefs) 1) ; >1 file
@@ -2431,16 +2438,19 @@
   (make-slime-tree :item (slime-note.short-message note)
                    :plist (list 'note note)))
 
-(defun slime-tree-for-severity (severity notes)
+(defun slime-tree-for-severity (severity notes collapsed-p)
   (make-slime-tree :item (format "%s (%d)" 
                                  (slime-severity-label severity)
                                  (length notes))
-                   :kids (mapcar #'slime-tree-for-note notes)))
+                   :kids (mapcar #'slime-tree-for-note notes)
+                   :collapsed-p collapsed-p))
 
 (defun slime-compiler-notes-to-tree (notes)
-  (let ((kids (let ((alist (slime-alistify notes #'slime-note.severity #'eq)))
+  (let ((kids (let* ((alist (slime-alistify notes #'slime-note.severity #'eq))
+                     (collapsed-p (slime-length> alist 1)))
                 (loop for (severity . notes) in alist
-                      collect (slime-tree-for-severity severity notes)))))
+                      collect (slime-tree-for-severity severity notes 
+                                                       collapsed-p)))))
     (make-slime-tree :item (format "All (%d)"  (length notes))
                      :kids kids :collapsed-p nil)))
 




From heller at common-lisp.net  Tue Feb 17 21:48:25 2004
From: heller at common-lisp.net (Helmut Eller)
Date: Tue, 17 Feb 2004 16:48:25 -0500
Subject: [slime-cvs] CVS update: slime/swank-clisp.lisp 
Message-ID: <E1AtD4r-0001SK-00@common-lisp.net>

Update of /project/slime/cvsroot/slime
In directory common-lisp.net:/tmp/cvs-serv5344

Modified Files:
	swank-clisp.lisp 
Log Message:
(remove-input-handlers): socket:socket-stream-handle is not available
on Windows.  Reported by Alan Shutko.
Date: Tue Feb 17 16:48:25 2004
Author: heller

Index: slime/swank-clisp.lisp
diff -u slime/swank-clisp.lisp:1.18 slime/swank-clisp.lisp:1.19
--- slime/swank-clisp.lisp:1.18	Mon Feb 16 16:40:55 2004
+++ slime/swank-clisp.lisp	Tue Feb 17 16:48:25 2004
@@ -95,7 +95,7 @@
 
 (defvar *saved-sigio-handler*)
 
-#+linux
+#+(or)
 (progn
   (defun set-sigio-handler ()
     (setf *saved-sigio-handler*
@@ -115,13 +115,14 @@
       (linux:fcntl3l fd linux:F_SETOWN (getpid))
       (linux:fcntl3l fd linux:F_SETFL linux:O_ASYNC)
       (push (cons fd fn) *sigio-handlers*)))
-  )
 
-(defimplementation remove-input-handlers (socket)
-  (let ((fd (socket:socket-stream-handle socket)))
-    (remove-sigio-handler fd)
-    (setf *sigio-handlers* (delete fd *sigio-handlers* :key #'car)))
-  (close socket))
+
+  (defimplementation remove-input-handlers (socket)
+    (let ((fd (socket:socket-stream-handle socket)))
+      (remove-sigio-handler fd)
+      (setf *sigio-handlers* (delete fd *sigio-handlers* :key #'car)))
+    (close socket))
+  )
 
 ;;; Swank functions
 




From heller at common-lisp.net  Tue Feb 17 21:51:24 2004
From: heller at common-lisp.net (Helmut Eller)
Date: Tue, 17 Feb 2004 16:51:24 -0500
Subject: [slime-cvs] CVS update: slime/swank-cmucl.lisp 
Message-ID: <E1AtD7k-0001WT-00@common-lisp.net>

Update of /project/slime/cvsroot/slime
In directory common-lisp.net:/tmp/cvs-serv5152

Modified Files:
	swank-cmucl.lisp 
Log Message:
(clear-xref-info): Compare the truenames with equalp instead of the
unix-truenames.  The old version was very inefficient (clearing the
tables with about 1000 entries required serveral seconds).

(xref-context-derived-from-p, pathname=): Delete unused functions.

Date: Tue Feb 17 16:51:24 2004
Author: heller

Index: slime/swank-cmucl.lisp
diff -u slime/swank-cmucl.lisp:1.65 slime/swank-cmucl.lisp:1.66
--- slime/swank-cmucl.lisp:1.65	Mon Feb 16 16:44:18 2004
+++ slime/swank-cmucl.lisp	Tue Feb 17 16:51:24 2004
@@ -403,10 +403,10 @@
     (group-xrefs xrefs)))
 
 (defun clear-xref-info (namestring)
-  "Clear XREF notes pertaining to FILENAME.
+  "Clear XREF notes pertaining to NAMESTRING.
 This is a workaround for a CMUCL bug: XREF records are cumulative."
   (when c:*record-xref-info*
-    (let ((filename (parse-namestring namestring)))
+    (let ((filename (truename namestring)))
       (dolist (db (list xref::*who-calls*
                         #+cmu19 xref::*who-is-called*
                         #+cmu19 xref::*who-macroexpands*
@@ -414,20 +414,12 @@
                         xref::*who-binds*
                         xref::*who-sets*))
         (maphash (lambda (target contexts)
+                   ;; XXX update during traversal?  
                    (setf (gethash target db)
-                         (delete-if 
-			  (lambda (ctx)
-			    (xref-context-derived-from-p ctx filename))
-			  contexts)))
+                         (delete filename contexts 
+                                 :key #'xref:xref-context-file
+                                 :test #'equalp)))
                  db)))))
-
-(defun xref-context-derived-from-p (context filename)
-  (let ((xref-file (xref:xref-context-file context)))
-    (and xref-file (pathname= filename xref-file))))
-  
-(defun pathname= (&rest pathnames)
-  "True if PATHNAMES refer to the same file."
-  (apply #'string= (mapcar #'unix-truename pathnames)))
 
 (defun unix-truename (pathname)
   (ext:unix-namestring (truename pathname)))




From heller at common-lisp.net  Tue Feb 17 21:54:25 2004
From: heller at common-lisp.net (Helmut Eller)
Date: Tue, 17 Feb 2004 16:54:25 -0500
Subject: [slime-cvs] CVS update: slime/slime.el 
Message-ID: <E1AtDAf-0006AS-00@common-lisp.net>

Update of /project/slime/cvsroot/slime
In directory common-lisp.net:/tmp/cvs-serv23296

Modified Files:
	slime.el 
Log Message:
(make-compiler-note): Don't send the short-message across the wire if
the slot is nil.
Date: Tue Feb 17 16:54:25 2004
Author: heller

Index: slime/slime.el
diff -u slime/slime.el:1.210 slime/slime.el:1.211
--- slime/slime.el:1.210	Tue Feb 17 16:47:03 2004
+++ slime/slime.el	Tue Feb 17 16:54:25 2004
@@ -2422,7 +2422,8 @@
   (plist-get note :message))
 
 (defun slime-note.short-message (note)
-  (plist-get note :short-message))
+  (or (plist-get note :short-message)
+      (plist-get note :message)))
 
 (defun slime-note.location (note)
   (plist-get note :location))




From heller at common-lisp.net  Tue Feb 17 21:54:36 2004
From: heller at common-lisp.net (Helmut Eller)
Date: Tue, 17 Feb 2004 16:54:36 -0500
Subject: [slime-cvs] CVS update: slime/swank.lisp 
Message-ID: <E1AtDAq-0006y5-00@common-lisp.net>

Update of /project/slime/cvsroot/slime
In directory common-lisp.net:/tmp/cvs-serv26208

Modified Files:
	swank.lisp 
Log Message:
(make-compiler-note): Don't send the short-message across the wire if
the slot is nil.
Date: Tue Feb 17 16:54:36 2004
Author: heller

Index: slime/swank.lisp
diff -u slime/swank.lisp:1.120 slime/swank.lisp:1.121
--- slime/swank.lisp:1.120	Mon Feb 16 16:46:13 2004
+++ slime/swank.lisp	Tue Feb 17 16:54:36 2004
@@ -922,11 +922,11 @@
 (defun make-compiler-note (condition)
   "Make a compiler note data structure from a compiler-condition."
   (declare (type compiler-condition condition))
-  (list :message (message condition)
-        :short-message (or (short-message condition)
-                           (message condition))
-        :severity (severity condition)
-        :location (location condition)))
+  (list* :message (message condition)
+         :severity (severity condition)
+         :location (location condition)
+         (let ((s (short-message condition)))
+           (if s (list :short-message s)))))
 
 (defun swank-compiler (function)
   (clear-compiler-notes)




From heller at common-lisp.net  Tue Feb 17 21:57:06 2004
From: heller at common-lisp.net (Helmut Eller)
Date: Tue, 17 Feb 2004 16:57:06 -0500
Subject: [slime-cvs] CVS update: slime/ChangeLog 
Message-ID: <E1AtDDG-0007xQ-00@common-lisp.net>

Update of /project/slime/cvsroot/slime
In directory common-lisp.net:/tmp/cvs-serv30241

Modified Files:
	ChangeLog 
Log Message:
*** empty log message ***
Date: Tue Feb 17 16:57:06 2004
Author: heller

Index: slime/ChangeLog
diff -u slime/ChangeLog:1.256 slime/ChangeLog:1.257
--- slime/ChangeLog:1.256	Mon Feb 16 17:07:39 2004
+++ slime/ChangeLog	Tue Feb 17 16:57:06 2004
@@ -1,3 +1,22 @@
+2004-02-17  Helmut Eller  <e9626484 at stud3.tuwien.ac.at>
+
+	* swank.lisp, slime.el (make-compiler-note): Don't send the
+	short-message across the wire if the slot is nil.
+
+	* swank-cmucl.lisp (clear-xref-info): Compare the truenames with
+	equalp instead of the unix-truenames.  The old version was very
+	inefficient (clearing the tables with about 1000 entries required
+	serveral seconds).
+	(xref-context-derived-from-p, pathname=): Delete unused functions.
+
+	* swank-clisp.lisp (remove-input-handlers):
+	socket:socket-stream-handle is not available on Windows.
+	Reported by Alan Shutko.
+
+	* slime.el (slime-length>): New function.
+	(slime-compiler-notes-to-tree): Don't collapse if there is only
+	one kind of notes.
+
 2004-02-16  Helmut Eller  <e9626484 at stud3.tuwien.ac.at>
 
 	* swank.lisp (make-compiler-note): Include short-message.




From heller at common-lisp.net  Wed Feb 18 07:25:39 2004
From: heller at common-lisp.net (Helmut Eller)
Date: Wed, 18 Feb 2004 02:25:39 -0500
Subject: [slime-cvs] CVS update: slime/metering.lisp 
Message-ID: <E1AtM5T-0001Hr-00@common-lisp.net>

Update of /project/slime/cvsroot/slime
In directory common-lisp.net:/tmp/cvs-serv819

Added Files:
	metering.lisp 
Log Message:
Imported from CLOCC.

Date: Wed Feb 18 02:25:39 2004
Author: heller





From heller at common-lisp.net  Wed Feb 18 07:31:59 2004
From: heller at common-lisp.net (Helmut Eller)
Date: Wed, 18 Feb 2004 02:31:59 -0500
Subject: [slime-cvs] CVS update: slime/swank-loader.lisp 
Message-ID: <E1AtMBb-0003CG-00@common-lisp.net>

Update of /project/slime/cvsroot/slime
In directory common-lisp.net:/tmp/cvs-serv12128

Modified Files:
	swank-loader.lisp 
Log Message:
Place the fasl files of different implementations in different
directories.  Patch by Peter Seibel.

Date: Wed Feb 18 02:31:59 2004
Author: heller

Index: slime/swank-loader.lisp
diff -u slime/swank-loader.lisp:1.16 slime/swank-loader.lisp:1.17
--- slime/swank-loader.lisp:1.16	Thu Feb  5 00:57:04 2004
+++ slime/swank-loader.lisp	Wed Feb 18 02:31:59 2004
@@ -7,7 +7,7 @@
 ;;; This code has been placed in the Public Domain.  All warranties
 ;;; are disclaimed.
 ;;;
-;;;   $Id: swank-loader.lisp,v 1.16 2004/02/05 05:57:04 wjenkner Exp $
+;;;   $Id: swank-loader.lisp,v 1.17 2004/02/18 07:31:59 heller Exp $
 ;;;
 
 (cl:defpackage :swank-loader
@@ -35,12 +35,25 @@
           #+clisp '("xref" "metering" "swank-clisp" "swank-gray")
           ))
 
+(defparameter *lisp-name*
+  #+cmu "cmu"
+  #+sbcl "sbcl"
+  #+openmcl "openmcl"
+  #+lispworks "lispworks"
+  #+allegro "allegro"
+  #+clisp "clisp")
+
 (defparameter *swank-pathname* (make-swank-pathname "swank"))
 
 (defun file-newer-p (new-file old-file)
   "Returns true if NEW-FILE is newer than OLD-FILE."
   (> (file-write-date new-file) (file-write-date old-file)))
 
+(defun binary-pathname (source-pathname)
+  (merge-pathnames
+   (make-pathname :directory `(:relative "fasl" ,*lisp-name*))
+   (merge-pathnames (compile-file-pathname source-pathname))))
+
 (defun compile-files-if-needed-serially (files)
   "Compile each file in FILES if the source is newer than
 its corresponding binary, or the file preceding it was 
@@ -48,14 +61,15 @@
   (with-compilation-unit ()
     (let ((needs-recompile nil))
       (dolist (source-pathname files)
-        (let ((binary-pathname (compile-file-pathname source-pathname)))
+        (let ((binary-pathname (binary-pathname source-pathname)))
           (handler-case
               (progn
                 (when (or needs-recompile
                           (not (probe-file binary-pathname))
                           (file-newer-p source-pathname binary-pathname))
                   (format t "~&;; Compiling ~A...~%" source-pathname)
-                  (compile-file source-pathname)
+                  (ensure-directories-exist binary-pathname)
+                  (compile-file source-pathname :output-file binary-pathname)
                   (setq needs-recompile t))
                 (load binary-pathname))
             #+(or)




From heller at common-lisp.net  Wed Feb 18 07:32:45 2004
From: heller at common-lisp.net (Helmut Eller)
Date: Wed, 18 Feb 2004 02:32:45 -0500
Subject: [slime-cvs] CVS update: slime/swank-clisp.lisp 
Message-ID: <E1AtMCL-00047o-00@common-lisp.net>

Update of /project/slime/cvsroot/slime
In directory common-lisp.net:/tmp/cvs-serv15847

Modified Files:
	swank-clisp.lisp 
Log Message:
Update comments about metering package.
Date: Wed Feb 18 02:32:45 2004
Author: heller

Index: slime/swank-clisp.lisp
diff -u slime/swank-clisp.lisp:1.19 slime/swank-clisp.lisp:1.20
--- slime/swank-clisp.lisp:1.19	Tue Feb 17 16:48:25 2004
+++ slime/swank-clisp.lisp	Wed Feb 18 02:32:44 2004
@@ -17,14 +17,10 @@
 ;;; are confirmed non-working; please upgrade).  You need an image
 ;;; containing the "SOCKET", "REGEXP", and "LINUX" packages.  The
 ;;; portable xref from the CMU AI repository and metering.lisp from
-;;; CLOCC are also required (alternatively, you have to manually
-;;; comment out some code below).  Note that currently SLIME comes
-;;; with xref but not with metering.  Please fetch it from
-
-;;; http://cvs.sourceforge.net/viewcvs.py/clocc/clocc/src/tools/metering/
-
-;;; and put it (or a link to it) in the directory containing the other
-;;; SLIME source files.
+;;; CLOCC [1] are also required (alternatively, you have to manually
+;;; comment out some code below). 
+;;;
+;;; [1] http://cvs.sourceforge.net/viewcvs.py/clocc/clocc/src/tools/metering/
 
 (in-package "SWANK")
 
@@ -106,7 +102,6 @@
       (setf (linux:sa-flags action) (logior flags linux:SA_NODEFER))
       (linux:signal-action-install linux:SIGIO action)))
 
-
   (defimplementation add-input-handler (socket fn)
     (set-sigio-handler)
     (let ((fd (socket:socket-stream-handle socket)))
@@ -115,7 +110,6 @@
       (linux:fcntl3l fd linux:F_SETOWN (getpid))
       (linux:fcntl3l fd linux:F_SETFL linux:O_ASYNC)
       (push (cons fd fn) *sigio-handlers*)))
-
 
   (defimplementation remove-input-handlers (socket)
     (let ((fd (socket:socket-stream-handle socket)))




From heller at common-lisp.net  Wed Feb 18 07:35:17 2004
From: heller at common-lisp.net (Helmut Eller)
Date: Wed, 18 Feb 2004 02:35:17 -0500
Subject: [slime-cvs] CVS update: slime/ChangeLog 
Message-ID: <E1AtMEn-00017g-00@common-lisp.net>

Update of /project/slime/cvsroot/slime
In directory common-lisp.net:/tmp/cvs-serv3644

Modified Files:
	ChangeLog 
Log Message:
*** empty log message ***
Date: Wed Feb 18 02:35:17 2004
Author: heller

Index: slime/ChangeLog
diff -u slime/ChangeLog:1.257 slime/ChangeLog:1.258
--- slime/ChangeLog:1.257	Tue Feb 17 16:57:06 2004
+++ slime/ChangeLog	Wed Feb 18 02:35:17 2004
@@ -1,3 +1,14 @@
+2004-02-18  Peter Seibel <peter at javamonkey.com>
+
+	* swank-loader.lisp: Place the fasl files of different
+	implementations in different directories.
+
+2004-02-18  Helmut Eller  <e9626484 at stud3.tuwien.ac.at>
+
+	* swank-clisp.lisp: Update comments about metering package.
+
+	* metering.lisp: Imported from CLOCC.  Suggested by Peter Seibel.
+
 2004-02-17  Helmut Eller  <e9626484 at stud3.tuwien.ac.at>
 
 	* swank.lisp, slime.el (make-compiler-note): Don't send the




From yeiwbw74ph at lycos.com  Thu Feb 19 03:43:48 2004
From: yeiwbw74ph at lycos.com (Ted Thorne)
Date: Thu, 19 Feb 04 03:43:48 GMT
Subject: [slime-cvs] fast weight |oss
Message-ID: <22k27$4$x0iltkq$578@hvei8>

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

From hw5ysdpwsq at aol.com  Wed Feb 18 07:45:35 2004
From: hw5ysdpwsq at aol.com (Aisha Quinn)
Date: Wed, 18 Feb 04 07:45:35 GMT
Subject: [slime-cvs] Fwd: Did you seen this ?
Message-ID: <f57nv50ss3ecbb@nk02wg>

An HTML attachment was scrubbed...
URL: <https://mailman.common-lisp.net/pipermail/slime-cvs/attachments/20040218/4c85ec7b/attachment.html>

From heller at common-lisp.net  Wed Feb 18 19:31:49 2004
From: heller at common-lisp.net (Helmut Eller)
Date: Wed, 18 Feb 2004 14:31:49 -0500
Subject: [slime-cvs] CVS update: slime/swank-cmucl.lisp 
Message-ID: <E1AtXQD-0003yD-00@common-lisp.net>

Update of /project/slime/cvsroot/slime
In directory common-lisp.net:/tmp/cvs-serv14690

Modified Files:
	swank-cmucl.lisp 
Log Message:
(read-into-simple-string): Workaround for bug in read-sequence.
Date: Wed Feb 18 14:31:49 2004
Author: heller

Index: slime/swank-cmucl.lisp
diff -u slime/swank-cmucl.lisp:1.66 slime/swank-cmucl.lisp:1.67
--- slime/swank-cmucl.lisp:1.66	Tue Feb 17 16:51:24 2004
+++ slime/swank-cmucl.lisp	Wed Feb 18 14:31:49 2004
@@ -4,6 +4,39 @@
 
 (in-package :swank)
 
+(in-package :lisp)
+
+;; Fix for read-sequence in 18e
+#+cmu18e
+(progn
+  (let ((s (find-symbol (string :*enable-package-locked-errors*) :lisp)))
+    (when s
+      (setf (symbol-value s) nil)))
+
+  (defun read-into-simple-string (s stream start end)
+    (declare (type simple-string s))
+    (declare (type stream stream))
+    (declare (type index start end))
+    (unless (subtypep (stream-element-type stream) 'character)
+      (error 'type-error
+             :datum (read-char stream nil #\Null)
+             :expected-type (stream-element-type stream)
+             :format-control "Trying to read characters from a binary stream."))
+    ;; Let's go as low level as it seems reasonable.
+    (let* ((numbytes (- end start))
+           (bytes-read (system:read-n-bytes stream s start numbytes t)))
+      (if (< bytes-read numbytes)
+          (+ start bytes-read)
+          end)))
+
+  (let ((s (find-symbol (string :*enable-package-locked-errors*) :lisp)))
+    (when s
+      (setf (symbol-value s) t)))
+
+  )
+
+(in-package :swank)
+
 
 ;;;; TCP server.
 




From heller at common-lisp.net  Wed Feb 18 19:43:27 2004
From: heller at common-lisp.net (Helmut Eller)
Date: Wed, 18 Feb 2004 14:43:27 -0500
Subject: [slime-cvs] CVS update: slime/slime.el 
Message-ID: <E1AtXbT-0001oh-00@common-lisp.net>

Update of /project/slime/cvsroot/slime
In directory common-lisp.net:/tmp/cvs-serv6960

Modified Files:
	slime.el 
Log Message:
(slime): Just close the connection when called without
prefix-argument.  Keeping the connection open doesn't make sense.  We
could ask if the Lisp process should be killed, tough.

(slime-maybe-close-old-connections): Delete unused function.

(slime-start-swank-server): Use comint-send-string instead of
comint-proc-query, 'cause I don't like Olin "100%" Shivers' code.

(slime-init-output-buffer): Show some animations.

(slime-repl-clear-output): Fixed.

(slime-compilation-finished): It's not necessary to switch to the
original buffer, because the buffer is encoded in the
source-locations.

(sldb-show-source): Don't raise an error if the source cannot be
located.  Print a message instead, because errors in process-filters
cause a 1 second delay.






Date: Wed Feb 18 14:43:26 2004
Author: heller

Index: slime/slime.el
diff -u slime/slime.el:1.211 slime/slime.el:1.212
--- slime/slime.el:1.211	Tue Feb 17 16:54:25 2004
+++ slime/slime.el	Wed Feb 18 14:43:26 2004
@@ -908,7 +908,7 @@
            (slime-connected-p)
            (get-buffer "*inferior-lisp*"))
       (slime-maybe-rearrange-inferior-lisp)
-    (slime-maybe-close-old-connections))
+    (slime-disconnect))
   (slime-maybe-start-lisp)
   (slime-read-port-and-connect))
 
@@ -919,31 +919,25 @@
             (with-current-buffer "*inferior-lisp*"
               (rename-buffer bufname)))))
 
-(defun slime-maybe-close-old-connections ()
-  "Offer to keep old connections alive, otherwise disconnect."
-  (unless (or (not (slime-connected-p))
-              (y-or-n-p "Keep old connections? "))
-    (slime-disconnect)))
-
 (defun slime-maybe-start-lisp ()
   "Start an inferior lisp unless one is already running."
   (unless (get-buffer-process (get-buffer "*inferior-lisp*"))
     (call-interactively 'inferior-lisp)
-    (comint-proc-query (inferior-lisp-proc)
-                       (format "(load %S)\n"
-                               (concat slime-path slime-backend)))
+    (comint-send-string (inferior-lisp-proc)
+                        (format "(load %S)\n"
+                                (concat slime-path slime-backend)))
     (slime-maybe-start-multiprocessing)))
 
 (defun slime-maybe-start-multiprocessing ()
   (when slime-multiprocessing
     (comint-send-string (inferior-lisp-proc)
-                        "(swank:startup-multiprocessing)")))
+                        "(swank:startup-multiprocessing)\n")))
 
 (defun slime-start-swank-server ()
   "Start a Swank server on the inferior lisp."
-  (comint-proc-query (inferior-lisp-proc)
-                     (format "(swank:start-server %S)\n"
-                             (slime-swank-port-file))))
+  (comint-send-string (inferior-lisp-proc) 
+                      (format "(swank:start-server %S)\n"
+                              (slime-swank-port-file))))
 
 (defun slime-swank-port-file ()
   "Filename where the SWANK server writes its TCP port number."
@@ -1602,11 +1596,18 @@
                             (process-contact (slime-connection)))
                           (slime-pid))))
       ;; Emacs21 has the fancy persistent header-line.
-      (if (boundp 'header-line-format)
-          (progn (setq header-line-format banner)
-                 (slime-repl-insert-prompt ""))
-        (slime-repl-insert-prompt (concat "; " banner))))
-    (pop-to-buffer (current-buffer))))
+      (cond ((boundp 'header-line-format)
+             (setq header-line-format banner)
+             (pop-to-buffer (current-buffer))
+             (when (fboundp 'animate-string)
+               ;; and dancing text
+               (when (zerop (buffer-size))
+                 (animate-string (format "; SLIME %s" (slime-changelog-date))
+                                 0 0)))
+             (slime-repl-insert-prompt ""))
+            (t
+             (slime-repl-insert-prompt (concat "; " banner))
+             (pop-to-buffer (current-buffer)))))))
 
 (defvar slime-show-last-output-function 
   'slime-maybe-display-output-buffer
@@ -2019,13 +2020,15 @@
 
 (defun slime-repl-clear-output ()
   (interactive)
-  (when (marker-position slime-repl-last-input-start-mark)
-    (delete-region slime-repl-last-input-start-mark
-                   (1- (slime-repl-input-line-beginning-position)))
-    (save-excursion
-      (goto-char slime-repl-last-input-start-mark)
-      (insert ";;; output flushed"))
-    (set-marker slime-repl-last-input-start-mark nil)))
+  (let ((start (save-excursion 
+                 (slime-repl-previous-prompt)
+                 (point)))
+        (end (1- (slime-repl-input-line-beginning-position))))
+    (when (< start end)
+      (delete-region start end)
+      (save-excursion
+        (goto-char start)
+        (insert ";;; output flushed")))))
 
 (defun slime-repl-set-package (package)
   "Set the package of the REPL buffer to PACKAGE."
@@ -2346,10 +2349,9 @@
 
 (defun slime-compilation-finished (result buffer show-notes-buffer)
   (let ((notes (slime-compiler-notes)))
-    (with-current-buffer buffer
-      (multiple-value-bind (result secs) result
-        (slime-show-note-counts notes secs)
-        (slime-highlight-notes notes)))
+    (multiple-value-bind (result secs) result
+      (slime-show-note-counts notes secs)
+      (slime-highlight-notes notes))
     (when (and show-notes-buffer (slime-length> notes 1))
       (slime-list-compiler-notes notes))
     ;;(let ((xrefs (slime-xrefs-for-notes notes)))
@@ -4322,7 +4324,12 @@
      `(swank:frame-source-location-for-emacs ,number)
      nil
      (lambda (source-location)
-       (slime-show-source-location source-location)))))
+       (destructure-case source-location
+         ((:error message)
+          (message "%s" message)
+          (ding))
+         (t
+          (slime-show-source-location source-location)))))))
 
 (defun slime-show-source-location (source-location)
   (save-selected-window




From heller at common-lisp.net  Wed Feb 18 19:46:02 2004
From: heller at common-lisp.net (Helmut Eller)
Date: Wed, 18 Feb 2004 14:46:02 -0500
Subject: [slime-cvs] CVS update: slime/ChangeLog 
Message-ID: <E1AtXdy-0002KW-00@common-lisp.net>

Update of /project/slime/cvsroot/slime
In directory common-lisp.net:/tmp/cvs-serv7968

Modified Files:
	ChangeLog 
Log Message:
*** empty log message ***
Date: Wed Feb 18 14:46:02 2004
Author: heller

Index: slime/ChangeLog
diff -u slime/ChangeLog:1.258 slime/ChangeLog:1.259
--- slime/ChangeLog:1.258	Wed Feb 18 02:35:17 2004
+++ slime/ChangeLog	Wed Feb 18 14:46:01 2004
@@ -1,3 +1,23 @@
+2004-02-18  Helmut Eller  <e9626484 at stud3.tuwien.ac.at>
+
+	* slime.el (slime): Just close the connection when called without
+	prefix-argument.  Keeping the connection open doesn't make sense.
+	We could ask if the Lisp process should be killed, though.
+	(slime-maybe-close-old-connections): Delete unused function.
+	(slime-start-swank-server): Use comint-send-string instead of
+	comint-proc-query, 'cause I don't like Olin "100%" Shivers' code.
+	(slime-init-output-buffer): Show some animations.
+	(slime-repl-clear-output): Fixed.
+	(slime-compilation-finished): It's not necessary to switch to the
+	original buffer, because the buffer is encoded in the
+	source-locations.
+	(sldb-show-source): Don't raise an error if the source cannot be
+	located.  Print a message instead, because errors in
+	process-filters cause a 1 second delay.
+
+	* swank-cmucl.lisp (read-into-simple-string): Workaround for
+	read-sequence bug in 18e.
+
 2004-02-18  Peter Seibel <peter at javamonkey.com>
 
 	* swank-loader.lisp: Place the fasl files of different




From WyattHellberg at arp.sprnet.org  Wed Feb 18 20:05:50 2004
From: WyattHellberg at arp.sprnet.org (Kilah Hopp)
Date: Thu, 19 Feb 2004 02:05:50 +0600
Subject: [slime-cvs] =?iso-8859-1?q?Fw=3A_Account_Over_Due=3F____________?=
	=?iso-8859-1?q?___________________________________________________?=
	=?iso-8859-1?q?____________________________________________=A0____?=
	=?iso-8859-1?q?____________=A0____________________________________?=
	=?iso-8859-1?q?___________________________________________________?=
	=?iso-8859-1?q?___________________________________________________?=
	=?iso-8859-1?q?___________________________________________________?=
	=?iso-8859-1?q?___________________________________________________?=
	=?iso-8859-1?q?___________________________________________________?=
	=?iso-8859-1?q?___________________________________________________?=
	=?iso-8859-1?q?___________________________________________________?=
	=?iso-8859-1?q?___________________________________________________?=
	=?iso-8859-1?q?___________________________________________________?=
	=?iso-8859-1?q?__________________________________________=A0______?=
	=?iso-8859-1?q?___________________________________________________?=
	=?iso-8859-1?q?___________________________________________________?=
	=?iso-8859-1?q?___________________________________________________?=
	=?iso-8859-1?q?___________________________________________________?=
	=?iso-8859-1?q?___________________________________________________?=
	=?iso-8859-1?q?___________________________________________________?=
	=?iso-8859-1?q?___________________________________________________?=
	=?iso-8859-1?q?___________________________________________________?=
	=?iso-8859-1?q?___________________________________________________?=
	=?iso-8859-1?q?___________________________________________________?=
	=?iso-8859-1?q?________________=A0________________________________?=
	=?iso-8859-1?q?___________________________________________________?=
	=?iso-8859-1?q?________________________=A0__diebold_stanza_homeomo?=
	=?iso-8859-1?q?rph_demonstrate_shari_souvenir_pumpkin_gumption_bee?=
	=?iso-8859-1?q?keeper_promethium_regional_tumble_harden_grammarian?=
	=?iso-8859-1?q?_speck_arching_alternation_?=
Message-ID: <DBNMBBZGVWWVMAUPDOKIZBBJZ@gte.net>

An HTML attachment was scrubbed...
URL: <https://mailman.common-lisp.net/pipermail/slime-cvs/attachments/20040219/0a08e1db/attachment.html>

From kokimpostor at byke.com  Fri Feb 20 13:52:40 2004
From: kokimpostor at byke.com (Clhp-announce)
Date: Fri, 20 Feb 2004 14:52:40 +0100
Subject: [slime-cvs] diatribes CheapPharmacy racketeers
Message-ID: <epuhxqjdqp.9383365noyuz@Clhp-announcepeamoo>

An HTML attachment was scrubbed...
URL: <https://mailman.common-lisp.net/pipermail/slime-cvs/attachments/20040220/5c9a3ce6/attachment.html>

From heller at common-lisp.net  Sat Feb 21 07:32:52 2004
From: heller at common-lisp.net (Helmut Eller)
Date: Sat, 21 Feb 2004 02:32:52 -0500
Subject: [slime-cvs] CVS update: slime/slime.el 
Message-ID: <E1AuRd6-0005Qe-00@common-lisp.net>

Update of /project/slime/cvsroot/slime
In directory common-lisp.net:/tmp/cvs-serv20672

Modified Files:
	slime.el 
Log Message:
(slime-keys): Bind it to C-c C-x t to slime-list-threads and C-c C-x c
to slime-list-connections.

(slime): Disconnect before reconnecting if the inferior-lisp buffer
wasn't renamed.

(slime-connect): Use the host argument and the "localhost".

(slime-compilation-finished): Undo last change.  We need to switch to
the buffer to remove old annotations.

(slime-choose-overlay-region): Ignore errors in slime-forward-sexp.

Date: Sat Feb 21 02:32:52 2004
Author: heller

Index: slime/slime.el
diff -u slime/slime.el:1.212 slime/slime.el:1.213
--- slime/slime.el:1.212	Wed Feb 18 14:43:26 2004
+++ slime/slime.el	Sat Feb 21 02:32:52 2004
@@ -457,7 +457,8 @@
     ;; "Other"
     ("\I"  slime-inspect :prefixed t :inferior t :sldb t)
     ("\C-]" slime-close-all-sexp :prefixed t :inferior t :sldb t)
-    ("\C-xt" slime-thread-control-panel :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)))
 
 ;; Maybe a good idea, maybe not..
 (defvar slime-prefix-key "\C-c"
@@ -904,11 +905,12 @@
 (defun slime ()
   "Start an inferior^_superior Lisp and connect to its Swank server."
   (interactive)
-  (if (and current-prefix-arg
-           (slime-connected-p)
-           (get-buffer "*inferior-lisp*"))
-      (slime-maybe-rearrange-inferior-lisp)
-    (slime-disconnect))
+  (cond ((and current-prefix-arg
+              (slime-connected-p)
+              (get-buffer "*inferior-lisp*"))
+         (unless (slime-maybe-rearrange-inferior-lisp)
+           (slime-disconnect)))
+        (t (slime-disconnect)))
   (slime-maybe-start-lisp)
   (slime-read-port-and-connect))
 
@@ -997,7 +999,7 @@
                        (y-or-n-p "Close old connections first? "))))
   (when kill-old-p (slime-disconnect))
   (message "Connecting to Swank on port %S.." port)
-  (slime-init-connection (slime-net-connect "localhost" port))
+  (slime-init-connection (slime-net-connect host port))
   (when-let (buffer (get-buffer "*inferior-lisp*"))
     (delete-windows-on buffer)
     (bury-buffer buffer))
@@ -1417,6 +1419,7 @@
   "*Log protocol events to the *slime-events* buffer.")
 
 ;;;;;;; Event logging to *slime-events*
+
 (defun slime-log-event (event)
   (when slime-log-events
     (with-current-buffer (slime-events-buffer)
@@ -2349,10 +2352,11 @@
 
 (defun slime-compilation-finished (result buffer show-notes-buffer)
   (let ((notes (slime-compiler-notes)))
-    (multiple-value-bind (result secs) result
-      (slime-show-note-counts notes secs)
-      (slime-highlight-notes notes))
-    (when (and show-notes-buffer (slime-length> notes 1))
+    (with-current-buffer buffer
+      (multiple-value-bind (result secs) result
+        (slime-show-note-counts notes secs)
+        (slime-highlight-notes notes)))
+    (when (and show-notes-buffer (slime-length> notes 0))
       (slime-list-compiler-notes notes))
     ;;(let ((xrefs (slime-xrefs-for-notes notes)))
     ;;  (when (> (length xrefs) 1) ; >1 file
@@ -2640,7 +2644,7 @@
     (unless (eql (car location) :error) 
       (slime-goto-source-location location)
       (let ((start (point)))
-        (slime-forward-sexp)
+        (ignore-errors (slime-forward-sexp))
         (if (slime-same-line-p start (point))
             (values start (point))
             (values (1+ start)




From heller at common-lisp.net  Sat Feb 21 07:35:12 2004
From: heller at common-lisp.net (Helmut Eller)
Date: Sat, 21 Feb 2004 02:35:12 -0500
Subject: [slime-cvs] CVS update: slime/swank.lisp 
Message-ID: <E1AuRfM-0002d0-00@common-lisp.net>

Update of /project/slime/cvsroot/slime
In directory common-lisp.net:/tmp/cvs-serv10096

Modified Files:
	swank.lisp 
Log Message:
(process-available-input): Move auxiliary function to toplevel.  Test
if the stream is open.
(install-sigio-handler): Handle the first request after installing the
signal handler.

Date: Sat Feb 21 02:35:12 2004
Author: heller

Index: slime/swank.lisp
diff -u slime/swank.lisp:1.121 slime/swank.lisp:1.122
--- slime/swank.lisp:1.121	Tue Feb 17 16:54:36 2004
+++ slime/swank.lisp	Sat Feb 21 02:35:12 2004
@@ -88,7 +88,6 @@
   (declare (ignore depth))
   (print-unreadable-object (connection stream :type t :identity t)))
 
-
 (defvar *emacs-connection* nil
   "The connection to Emacs.
 All threads communicate through this interface with Emacs.")
@@ -407,19 +406,21 @@
                         :send #'send-to-socket-io
                         :serve-requests #'simple-serve-requests)))))
 
+(defun process-available-input (stream fn)
+  (loop while (and (open-stream-p stream) 
+                   (listen stream))
+        do (funcall fn)))
+
 (defun install-sigio-handler (connection)
   (let ((client (connection.socket-io connection)))
-    (labels ((process-available-input (fn)
-               (loop do (funcall fn)
-                     while (listen client)))
-             (handler ()   
-               (cond ((null *swank-state-stack*)
-                      (with-reader-error-handler (connection)
-                        (process-available-input #'handle-request)))
-                     ((eq (car *swank-state-stack*) :read-next-form))
-                     (t (process-available-input #'read-from-emacs)))))
-      (handler)
-      (add-input-handler client #'handler))))
+    (flet ((handler ()   
+             (cond ((null *swank-state-stack*)
+                    (with-reader-error-handler (connection)
+                      (process-available-input client #'handle-request)))
+                   ((eq (car *swank-state-stack*) :read-next-form))
+                   (t (process-available-input client #'read-from-emacs)))))
+      (add-input-handler client #'handler)
+      (handler))))
 
 (defun remove-sigio-handler (connection)
   (remove-input-handlers (connection.socket-io connection)))




From heller at common-lisp.net  Sat Feb 21 07:37:36 2004
From: heller at common-lisp.net (Helmut Eller)
Date: Sat, 21 Feb 2004 02:37:36 -0500
Subject: [slime-cvs] CVS update: slime/ChangeLog 
Message-ID: <E1AuRhg-0004qu-00@common-lisp.net>

Update of /project/slime/cvsroot/slime
In directory common-lisp.net:/tmp/cvs-serv18331

Modified Files:
	ChangeLog 
Log Message:
*** empty log message ***
Date: Sat Feb 21 02:37:36 2004
Author: heller

Index: slime/ChangeLog
diff -u slime/ChangeLog:1.259 slime/ChangeLog:1.260
--- slime/ChangeLog:1.259	Wed Feb 18 14:46:01 2004
+++ slime/ChangeLog	Sat Feb 21 02:37:36 2004
@@ -1,3 +1,20 @@
+2004-02-21  Helmut Eller  <e9626484 at stud3.tuwien.ac.at>
+
+	* swank.lisp (process-available-input): Move auxiliary function to
+	toplevel.  Test if the stream is open.
+	(install-sigio-handler): Handle the first request after installing
+	the signal handler.
+
+	* slime.el (slime-keys): Bind C-c C-x t to slime-list-threads and
+	C-c C-x c to slime-list-connections.
+	(slime): Disconnect before reconnecting if the inferior-lisp
+	buffer wasn't renamed.
+	(slime-connect): Use the host argument and not "localhost".
+	(slime-compilation-finished): Undo last change.  Switch to the
+	buffer to remove old annotations.
+	(slime-choose-overlay-region): Ignore errors in
+	slime-forward-sexp.
+
 2004-02-18  Helmut Eller  <e9626484 at stud3.tuwien.ac.at>
 
 	* slime.el (slime): Just close the connection when called without




From heller at common-lisp.net  Sat Feb 21 16:34:05 2004
From: heller at common-lisp.net (Helmut Eller)
Date: Sat, 21 Feb 2004 11:34:05 -0500
Subject: [slime-cvs] CVS update: slime/slime.el 
Message-ID: <E1Aua4r-0000ch-00@common-lisp.net>

Update of /project/slime/cvsroot/slime
In directory common-lisp.net:/tmp/cvs-serv25438

Modified Files:
	slime.el 
Log Message:
(slime-batch-test): Use sit-for instead of accept-process-output, so
that we see something when swank gets compiled.  May be problematic in
real batch mode.

(loop-interrupt-continue-interrupt-quit): Wait a second before
interrupting.  The signal seems to arrive before the evaluation
request if don't wait => the endless loop is executed inside the
debugger and sldb-quit will not be processed with fd-handlers.

Date: Sat Feb 21 11:34:05 2004
Author: heller

Index: slime/slime.el
diff -u slime/slime.el:1.213 slime/slime.el:1.214
--- slime/slime.el:1.213	Sat Feb 21 02:32:52 2004
+++ slime/slime.el	Sat Feb 21 11:34:05 2004
@@ -1550,8 +1550,8 @@
   "Block until the most recent request has finished."
   (when slime-rex-continuations
     (let ((tag (caar slime-rex-continuations)))
-      (loop while (find tag slime-rex-continuations :key #'car)
-            do (accept-process-output nil 0 100000)))))
+      (while (find tag slime-rex-continuations :key #'car)
+        (accept-process-output nil 0 100000)))))
 
 (defun slime-ping ()
   "Check that communication works."
@@ -4983,7 +4983,7 @@
     (slime)
     ;; Block until we are up and running.
     (while (not (slime-connected-p))
-      (accept-process-output nil 2))
+      (sit-for 1))
     (slime-sync-to-top-level 5)
     (switch-to-buffer "*scratch*")
     (let ((failed-tests (slime-run-tests)))
@@ -5289,6 +5289,7 @@
     '(())
   (slime-check-top-level)
   (slime-eval-async '(cl:loop) "CL-USER" (lambda (_) ))
+  (sleep-for 1)
   (slime-wait-condition "running" #'slime-busy-p 5)
   (slime-interrupt)
   (slime-wait-condition "First interrupt" (lambda () (slime-sldb-level= 1)) 5)




From heller at common-lisp.net  Sat Feb 21 16:35:55 2004
From: heller at common-lisp.net (Helmut Eller)
Date: Sat, 21 Feb 2004 11:35:55 -0500
Subject: [slime-cvs] CVS update: slime/swank-backend.lisp 
Message-ID: <E1Aua6d-00025U-00@common-lisp.net>

Update of /project/slime/cvsroot/slime
In directory common-lisp.net:/tmp/cvs-serv8016

Modified Files:
	swank-backend.lisp 
Log Message:
(add-sigio-handler): Renamed from add-input-handler.
(remove-sigio-handlers): Renamed from remove-input-handlers.
(add-fd-handler, remove-fd-handlers): New interface functions.
Date: Sat Feb 21 11:35:55 2004
Author: heller

Index: slime/swank-backend.lisp
diff -u slime/swank-backend.lisp:1.30 slime/swank-backend.lisp:1.31
--- slime/swank-backend.lisp:1.30	Mon Feb 16 16:39:39 2004
+++ slime/swank-backend.lisp	Sat Feb 21 11:35:55 2004
@@ -170,11 +170,17 @@
    "Accept a client connection on the listening socket SOCKET.  Return
 a stream for the new connection.")
 
-(definterface add-input-handler (socket fn)
+(definterface add-sigio-handler (socket fn)
   "Call FN whenever SOCKET is readable.")
 
-(definterface remove-input-handlers (socket)
-  "Remove all input handlers for SOCKET.")
+(definterface remove-sigio-handlers (socket)
+  "Remove all sigio handlers for SOCKET.")
+
+(definterface add-fd-handler (socket fn)
+  "Call FN when Lisp is waiting for input and SOCKET is readable.")
+
+(definterface remove-fd-handlers (socket)
+  "Remove all fd-handlers for SOCKET.")
 
 ;;; Base condition for networking errors.
 (define-condition network-error (error) ())




From heller at common-lisp.net  Sat Feb 21 16:37:27 2004
From: heller at common-lisp.net (Helmut Eller)
Date: Sat, 21 Feb 2004 11:37:27 -0500
Subject: [slime-cvs] CVS update: slime/swank.lisp 
Message-ID: <E1Aua87-00031s-00@common-lisp.net>

Update of /project/slime/cvsroot/slime
In directory common-lisp.net:/tmp/cvs-serv11637

Modified Files:
	swank.lisp 
Log Message:
(create-connection): Add support for fd-handlers.
(install-fd-handler,  deinstall-fd-handler): New functions.
Date: Sat Feb 21 11:37:27 2004
Author: heller

Index: slime/swank.lisp
diff -u slime/swank.lisp:1.122 slime/swank.lisp:1.123
--- slime/swank.lisp:1.122	Sat Feb 21 02:35:12 2004
+++ slime/swank.lisp	Sat Feb 21 11:37:27 2004
@@ -398,7 +398,14 @@
                         :read #'read-from-socket-io
                         :send #'send-to-socket-io
                         :serve-requests #'install-sigio-handler
-                        :cleanup #'remove-sigio-handler))
+                        :cleanup #'deinstall-fd-handler))
+      (:fd-handler
+       (make-connection :socket-io socket-io :dedicated-output dedicated
+                        :user-input in :user-output out :user-io io
+                        :read #'read-from-socket-io
+                        :send #'send-to-socket-io
+                        :serve-requests #'install-fd-handler
+                        :cleanup #'deinstall-fd-handler))
       ((nil)
        (make-connection :socket-io socket-io :dedicated-output dedicated
                         :user-input in :user-output out :user-io io
@@ -411,6 +418,8 @@
                    (listen stream))
         do (funcall fn)))
 
+;;;;;; Signal driven IO
+
 (defun install-sigio-handler (connection)
   (let ((client (connection.socket-io connection)))
     (flet ((handler ()   
@@ -419,11 +428,38 @@
                       (process-available-input client #'handle-request)))
                    ((eq (car *swank-state-stack*) :read-next-form))
                    (t (process-available-input client #'read-from-emacs)))))
-      (add-input-handler client #'handler)
+      (add-sigio-handler client #'handler)
       (handler))))
 
-(defun remove-sigio-handler (connection)
-  (remove-input-handlers (connection.socket-io connection)))
+(defun deinstall-sigio-handler (connection)
+  (remove-sigio-handlers (connection.socket-io connection)))
+
+;;;;;; SERVE-EVENT based IO
+
+(defun install-fd-handler (connection)
+  (let ((client (connection.socket-io connection)))
+    (flet ((handler ()   
+             (cond ((null *swank-state-stack*)
+                    (with-reader-error-handler (connection)
+                      (process-available-input client #'handle-request)))
+                   ((eq (car *swank-state-stack*) :read-next-form))
+                   (t (process-available-input client #'read-from-emacs)))))
+      (encode-message '(:use-sigint-for-interrupt) client)
+      (setq *debugger-hook* 
+            (lambda (c h)
+              (with-reader-error-handler (connection)
+		(block debugger
+		  (catch 'slime-toplevel
+		    (swank-debugger-hook c h)
+		    (return-from debugger))
+		  (abort)))))
+      (add-fd-handler client #'handler)
+      (handler))))
+
+(defun deinstall-fd-handler (connection)
+  (remove-fd-handlers (connection.socket-io connection)))
+
+;;;;;; Simple sequential IO
 
 (defun simple-serve-requests (connection)
   (let ((socket-io (connection.socket-io connection)))




From heller at common-lisp.net  Sat Feb 21 16:42:19 2004
From: heller at common-lisp.net (Helmut Eller)
Date: Sat, 21 Feb 2004 11:42:19 -0500
Subject: [slime-cvs] CVS update: slime/swank-cmucl.lisp 
Message-ID: <E1AuaCp-0002Gb-00@common-lisp.net>

Update of /project/slime/cvsroot/slime
In directory common-lisp.net:/tmp/cvs-serv8705

Modified Files:
	swank-cmucl.lisp 
Log Message:
(fcntl): New function.
(add-sigio-handler, remove-sigio-handlers): Renamed.
(add-fd-handler,  remove-fd-handlers): Implement interface.
Date: Sat Feb 21 11:42:19 2004
Author: heller

Index: slime/swank-cmucl.lisp
diff -u slime/swank-cmucl.lisp:1.67 slime/swank-cmucl.lisp:1.68
--- slime/swank-cmucl.lisp:1.67	Wed Feb 18 14:31:49 2004
+++ slime/swank-cmucl.lisp	Sat Feb 21 11:42:19 2004
@@ -60,36 +60,43 @@
 (defvar *sigio-handlers* '()
   "List of (key . (fn . args)) pairs to be called on SIGIO.")
 
-(defun add-sigio-handler (key fn)
-  (push (cons key fn) *sigio-handlers*))
-
-(defun remove-sigio-handler (key)
-  (setf *sigio-handlers* (delete key *sigio-handlers* :key #'car)))
-
 (defun sigio-handler (signal code scp)
   (declare (ignore signal code scp))
-  (mapc (lambda (handler) (funcall (cdr handler))) *sigio-handlers*)
-  )
+  (mapc (lambda (handler) (funcall (cdr handler))) *sigio-handlers*))
 
 (defun set-sigio-handler ()
   (sys:enable-interrupt unix:SIGIO (lambda (signal code scp)
 				     (sigio-handler signal code scp))))
-(set-sigio-handler)
 
-(defimplementation add-input-handler (socket fn)
+(defun fcntl (fd command arg)
+  (multiple-value-bind (ok error) (unix:unix-fcntl fd command arg)
+    (cond (ok)
+          (t (error "fcntl: ~A" (unix:get-unix-error-msg error))))))
+
+(defimplementation add-sigio-handler (socket fn)
+  (set-sigio-handler)
   (let ((fd (socket-fd socket)))
-    (format *debug-io* "Adding input handler: ~S ~%" fd)
-    ;; XXX error checking
-    (unix:unix-fcntl fd unix:f-setown (unix:unix-getpid))
-    (unix:unix-fcntl fd unix:f-setfl unix:FASYNC)
-    (add-sigio-handler fd fn)))
+    (format *debug-io* "; Adding input handler: ~S ~%" fd)
+    (fcntl fd unix:f-setown (unix:unix-getpid))
+    (fcntl fd unix:f-setfl unix:FASYNC)
+    (push (cons fd fn) *sigio-handlers*)))
 
-(defimplementation remove-input-handlers (socket)
+(defimplementation remove-sigio-handlers (socket)
   (let ((fd (socket-fd socket)))
-    (remove-sigio-handler fd)
-    (sys:invalidate-descriptor fd)) 
+    (setf *sigio-handlers* (delete fd *sigio-handlers* :key #'car))
+    (sys:invalidate-descriptor fd))
   (close socket))
 
+(defimplementation add-fd-handler (socket fn)
+  (let ((fd (socket-fd socket)))
+    (format *debug-io* "; Adding fd handler: ~S ~%" fd)
+    (sys:add-fd-handler fd :input (lambda (_) 
+                                    _
+                                    (funcall fn)))))
+
+(defimplementation remove-fd-handlers (socket)
+  (sys:invalidate-descriptor (socket-fd socket)))
+
 (defimplementation make-fn-streams (input-fn output-fn)
   (let* ((output (make-slime-output-stream output-fn))
          (input  (make-slime-input-stream input-fn output)))
@@ -336,6 +343,9 @@
                         (list :position *buffer-start-position*)))
         (*compile-file-truename*
          (make-location (list :file (namestring *compile-file-truename*))
+                        (list :position 0)))
+        (*compile-filename*
+         (make-location (list :file *compile-filename*)
                         (list :position 0)))
         (t 
          (list :error "No error location available"))))




From heller at common-lisp.net  Sat Feb 21 16:42:52 2004
From: heller at common-lisp.net (Helmut Eller)
Date: Sat, 21 Feb 2004 11:42:52 -0500
Subject: [slime-cvs] CVS update: slime/swank-sbcl.lisp 
Message-ID: <E1AuaDM-0002an-00@common-lisp.net>

Update of /project/slime/cvsroot/slime
In directory common-lisp.net:/tmp/cvs-serv9961

Modified Files:
	swank-sbcl.lisp 
Log Message:
(add-sigio-handler, remove-sigio-handlers): Renamed.
(add-fd-handler,  remove-fd-handlers): Implement interface.
Date: Sat Feb 21 11:42:52 2004
Author: heller

Index: slime/swank-sbcl.lisp
diff -u slime/swank-sbcl.lisp:1.66 slime/swank-sbcl.lisp:1.67
--- slime/swank-sbcl.lisp:1.66	Mon Feb 16 16:45:22 2004
+++ slime/swank-sbcl.lisp	Sat Feb 21 11:42:52 2004
@@ -131,7 +131,7 @@
            (sb-alien:alien-funcall fcntl fd +f_setown+
                                    (sb-unix:unix-getpid))))))
 
-(defimplementation add-input-handler (socket fn)
+(defimplementation add-sigio-handler (socket fn)
   (set-sigio-handler)
   (let ((fd (socket-fd socket)))
     (format *debug-io* "Adding sigio handler: ~S ~%" fd)
@@ -139,7 +139,7 @@
     (push (cons fd fn) *sigio-handlers*)))
 
 #+(or)
-(defimplementation add-input-handler (socket fn)
+(defimplementation add-sigio-handler (socket fn)
   (set-sigio-handler)
   (let ((fd (socket-fd socket)))
     (format *debug-io* "Adding sigio handler: ~S ~%" fd)
@@ -147,11 +147,22 @@
     (sb-posix:fcntl fd sb-posix::f-setown (sb-unix:unix-getpid))
     (push (cons fd fn) *sigio-handlers*)))
 
-(defimplementation remove-input-handlers (socket)
+(defimplementation remove-sigio-handlers (socket)
   (let ((fd (socket-fd socket)))
     (setf *sigio-handlers* (delete fd *sigio-handlers* :key #'car))
     (sb-sys:invalidate-descriptor fd)) 
   (close socket))
+
+(defimplementation add-fd-handler (socket fn)
+  (declare (type function fn))
+  (let ((fd (socket-fd socket)))
+    (format *debug-io* "; Adding fd handler: ~S ~%" fd)
+    (sb-sys:add-fd-handler fd :input (lambda (_) 
+                                       _
+                                       (funcall fn)))))
+
+(defimplementation remove-fd-handlers (socket)
+  (sb-sys:invalidate-descriptor (socket-fd socket)))
 
 (defun socket-fd (socket)
   (etypecase socket




From heller at common-lisp.net  Sat Feb 21 16:45:25 2004
From: heller at common-lisp.net (Helmut Eller)
Date: Sat, 21 Feb 2004 11:45:25 -0500
Subject: [slime-cvs] CVS update: slime/ChangeLog 
Message-ID: <E1AuaFp-000111-00@common-lisp.net>

Update of /project/slime/cvsroot/slime
In directory common-lisp.net:/tmp/cvs-serv3224

Modified Files:
	ChangeLog 
Log Message:
*** empty log message ***
Date: Sat Feb 21 11:45:25 2004
Author: heller

Index: slime/ChangeLog
diff -u slime/ChangeLog:1.260 slime/ChangeLog:1.261
--- slime/ChangeLog:1.260	Sat Feb 21 02:37:36 2004
+++ slime/ChangeLog	Sat Feb 21 11:45:25 2004
@@ -1,5 +1,31 @@
 2004-02-21  Helmut Eller  <e9626484 at stud3.tuwien.ac.at>
 
+	Add support for SERVE-EVENT based communication.
+	
+	* swank-sbcl.lisp (add-sigio-handler, remove-sigio-handlers):
+	Renamed.
+	(add-fd-handler, remove-fd-handlers): Implement interface.
+
+	* swank-cmucl.lisp (fcntl): New function.
+	(add-sigio-handler, remove-sigio-handlers): Renamed.
+	(add-fd-handler, remove-fd-handlers): Implement interface.
+
+	* swank.lisp (create-connection): Add support for fd-handlers.
+	(install-fd-handler, deinstall-fd-handler): New functions.
+
+	* swank-backend.lisp (add-sigio-handler): Renamed from
+	add-input-handler.
+	(remove-sigio-handlers): Renamed from remove-input-handlers.
+	(add-fd-handler, remove-fd-handlers): New interface functions.
+
+	* slime.el (slime-batch-test): Use sit-for instead of
+	accept-process-output, so that we see something when swank gets
+	compiled.  May be problematic in real batch mode.
+	(loop-interrupt-continue-interrupt-quit): Wait a second before
+	interrupting.  The signal seems to arrive before the evaluation
+	request if don't wait => the endless loop is executed inside the
+	debugger and sldb-quit will not be processed with fd-handlers.
+
 	* swank.lisp (process-available-input): Move auxiliary function to
 	toplevel.  Test if the stream is open.
 	(install-sigio-handler): Handle the first request after installing




From Tippy_Ebert074 at yahoo.com  Sun Feb 22 01:04:54 2004
From: Tippy_Ebert074 at yahoo.com (Jamie Madison)
Date: Sun, 22 Feb 04 01:04:54 GMT
Subject: [slime-cvs] Fake Watches reason
Message-ID: <e-$6ks-j5nn$54ni4rcg--46@0u6hvbw9fu>

An HTML attachment was scrubbed...
URL: <https://mailman.common-lisp.net/pipermail/slime-cvs/attachments/20040222/7813cfa4/attachment.html>

From Millard_Murphy033 at yahoo.com  Sun Feb 22 22:21:38 2004
From: Millard_Murphy033 at yahoo.com (Pansy Leary)
Date: Mon, 23 Feb 2004 01:21:38 +0300
Subject: [slime-cvs] Fake rolex watches fell
Message-ID: <XGJAKFFXOEYTYKIHUKLBGDNC@yahoo.com>

An HTML attachment was scrubbed...
URL: <https://mailman.common-lisp.net/pipermail/slime-cvs/attachments/20040223/2f012d75/attachment.html>

From heller at common-lisp.net  Mon Feb 23 07:21:08 2004
From: heller at common-lisp.net (Helmut Eller)
Date: Mon, 23 Feb 2004 02:21:08 -0500
Subject: [slime-cvs] CVS update: slime/swank.lisp slime/swank-cmucl.lisp 
Message-ID: <E1AvAOq-0004Ap-00@common-lisp.net>

Update of /project/slime/cvsroot/slime
In directory common-lisp.net:/tmp/cvs-serv15520

Modified Files:
	swank.lisp swank-cmucl.lisp 
Log Message:
* swank.lisp (format-arglist): Bind *PRINT-PRETTY* to NIL.
(eval-in-emacs): Fix typo in docstring.

* swank-cmucl.lisp (arglist-string): Bind *PRINT-PRETTY* to NIL.

Date: Mon Feb 23 02:21:07 2004
Author: heller

Index: slime/swank.lisp
diff -u slime/swank.lisp:1.123 slime/swank.lisp:1.124
--- slime/swank.lisp:1.123	Sat Feb 21 11:37:27 2004
+++ slime/swank.lisp	Mon Feb 23 02:21:07 2004
@@ -691,7 +691,8 @@
         (let ((symbol (find-symbol-or-lose function-name)))
           (values (funcall lambda-list-fn symbol))))
     (cond (condition  (format nil "(-- ~A)" condition))
-          (t (let ((*print-case* :downcase))
+          (t (let ((*print-case* :downcase)
+                   (*print-pretty* nil))
                (format nil "(~{~A~^ ~})" arglist))))))
 
 
@@ -795,7 +796,7 @@
 ;;;; Evaluation
 
 (defun eval-in-emacs (form)
-  "Execute FROM in Emacs."
+  "Execute FORM in Emacs."
   (destructuring-bind (fn &rest args) form
     (send-to-emacs `(:%apply ,(string-downcase (string fn)) ,args))))
 


Index: slime/swank-cmucl.lisp
diff -u slime/swank-cmucl.lisp:1.68 slime/swank-cmucl.lisp:1.69
--- slime/swank-cmucl.lisp:1.68	Sat Feb 21 11:42:19 2004
+++ slime/swank-cmucl.lisp	Mon Feb 23 02:21:07 2004
@@ -836,7 +836,9 @@
 		       (t "(<arglist-unavailable>)"))))))
       (etypecase arglist
         (string arglist)
-        (cons (let ((*print-case* :downcase)) (princ-to-string arglist)))
+        (cons (let ((*print-case* :downcase)
+                    (*print-pretty* nil))
+                (princ-to-string arglist)))
         (null "()")))))
 
 




From heller at common-lisp.net  Mon Feb 23 07:21:31 2004
From: heller at common-lisp.net (Helmut Eller)
Date: Mon, 23 Feb 2004 02:21:31 -0500
Subject: [slime-cvs] CVS update: slime/ChangeLog 
Message-ID: <E1AvAPD-0004Vl-00@common-lisp.net>

Update of /project/slime/cvsroot/slime
In directory common-lisp.net:/tmp/cvs-serv16832

Modified Files:
	ChangeLog 
Log Message:
*** empty log message ***
Date: Mon Feb 23 02:21:31 2004
Author: heller

Index: slime/ChangeLog
diff -u slime/ChangeLog:1.261 slime/ChangeLog:1.262
--- slime/ChangeLog:1.261	Sat Feb 21 11:45:25 2004
+++ slime/ChangeLog	Mon Feb 23 02:21:31 2004
@@ -1,3 +1,10 @@
+2004-02-22  Lawrence Mitchell  <wence at gmx.li>
+
+	* swank.lisp (format-arglist): Bind *PRINT-PRETTY* to NIL.
+	(eval-in-emacs): Fix typo in docstring.
+
+	* swank-cmucl.lisp (arglist-string): Bind *PRINT-PRETTY* to NIL.
+	
 2004-02-21  Helmut Eller  <e9626484 at stud3.tuwien.ac.at>
 
 	Add support for SERVE-EVENT based communication.




From heller at common-lisp.net  Mon Feb 23 21:13:21 2004
From: heller at common-lisp.net (Helmut Eller)
Date: Mon, 23 Feb 2004 16:13:21 -0500
Subject: [slime-cvs] CVS update: slime/slime.el 
Message-ID: <E1AvNOD-0007t6-00@common-lisp.net>

Update of /project/slime/cvsroot/slime
In directory common-lisp.net:/tmp/cvs-serv27554

Modified Files:
	slime.el 
Log Message:
(slime-find-unbalanced-parenthesis): New command. Bound to C-c C-).
Date: Mon Feb 23 16:13:21 2004
Author: heller

Index: slime/slime.el
diff -u slime/slime.el:1.214 slime/slime.el:1.215
--- slime/slime.el:1.214	Sat Feb 21 11:34:05 2004
+++ slime/slime.el	Mon Feb 23 16:13:21 2004
@@ -457,6 +457,7 @@
     ;; "Other"
     ("\I"  slime-inspect :prefixed t :inferior t :sldb t)
     ("\C-]" slime-close-all-sexp :prefixed t :inferior t :sldb t)
+    ([(control c) (control \))] slime-find-unbalanced-parenthesis)
     ("\C-xt" slime-list-threads :prefixed t :inferior t :sldb t)
     ("\C-xc" slime-list-connections :prefixed t :inferior t :sldb t)))
 
@@ -4901,6 +4902,39 @@
       (skip-chars-forward " \t\n)")
       (skip-chars-backward " \t\n")
       (delete-region point (point)))))
+
+(defun slime-find-unbalanced-parenthesis ()
+  "Verify that parentheses in the current buffer are balanced.
+If they are not, position point at the first syntax error found."
+  (interactive)
+  (let ((saved-point (point))
+        (state (parse-partial-sexp (point-min) (point-max) -1)))
+    (destructuring-bind (depth innermost-start last-terminated-start
+                               in-string in-comment after-quote 
+                               minimum-depth comment-style 
+                               comment-or-string-start &rest _) state
+      (cond ((and (zerop depth) 
+                  (not in-string) 
+                  (or (not in-comment) 
+                      (and (eq comment-style nil) 
+                           (eobp)))
+                  (not after-quote))
+             (goto-char saved-point)
+             (message "All parentheses appear to be balanced."))
+            ((plusp depth)
+             (goto-char innermost-start)
+             (error "Missing )"))
+            ((minusp depth)
+             (error "Extra )"))
+            (in-string
+             (goto-char comment-or-string-start)
+             (error "String not terminated"))
+            (in-comment
+             (goto-char comment-or-string-start)
+             (error "Comment not terminated"))
+            (after-quote
+             (error "After quote"))
+            (t (error "Shouldn't happen: parsing state: %S" state))))))
 
 ;;; Test suite
 




From heller at common-lisp.net  Mon Feb 23 22:14:56 2004
From: heller at common-lisp.net (Helmut Eller)
Date: Mon, 23 Feb 2004 17:14:56 -0500
Subject: [slime-cvs] CVS update: slime/slime.el 
Message-ID: <E1AvOLo-00007E-00@common-lisp.net>

Update of /project/slime/cvsroot/slime
In directory common-lisp.net:/tmp/cvs-serv11850

Modified Files:
	slime.el 
Log Message:
(slime-find-unbalanced-parenthesis): Delete it.  Emacs 21 has already
check-parens.

Date: Mon Feb 23 17:14:56 2004
Author: heller

Index: slime/slime.el
diff -u slime/slime.el:1.215 slime/slime.el:1.216
--- slime/slime.el:1.215	Mon Feb 23 16:13:21 2004
+++ slime/slime.el	Mon Feb 23 17:14:56 2004
@@ -457,7 +457,6 @@
     ;; "Other"
     ("\I"  slime-inspect :prefixed t :inferior t :sldb t)
     ("\C-]" slime-close-all-sexp :prefixed t :inferior t :sldb t)
-    ([(control c) (control \))] slime-find-unbalanced-parenthesis)
     ("\C-xt" slime-list-threads :prefixed t :inferior t :sldb t)
     ("\C-xc" slime-list-connections :prefixed t :inferior t :sldb t)))
 
@@ -4902,39 +4901,6 @@
       (skip-chars-forward " \t\n)")
       (skip-chars-backward " \t\n")
       (delete-region point (point)))))
-
-(defun slime-find-unbalanced-parenthesis ()
-  "Verify that parentheses in the current buffer are balanced.
-If they are not, position point at the first syntax error found."
-  (interactive)
-  (let ((saved-point (point))
-        (state (parse-partial-sexp (point-min) (point-max) -1)))
-    (destructuring-bind (depth innermost-start last-terminated-start
-                               in-string in-comment after-quote 
-                               minimum-depth comment-style 
-                               comment-or-string-start &rest _) state
-      (cond ((and (zerop depth) 
-                  (not in-string) 
-                  (or (not in-comment) 
-                      (and (eq comment-style nil) 
-                           (eobp)))
-                  (not after-quote))
-             (goto-char saved-point)
-             (message "All parentheses appear to be balanced."))
-            ((plusp depth)
-             (goto-char innermost-start)
-             (error "Missing )"))
-            ((minusp depth)
-             (error "Extra )"))
-            (in-string
-             (goto-char comment-or-string-start)
-             (error "String not terminated"))
-            (in-comment
-             (goto-char comment-or-string-start)
-             (error "Comment not terminated"))
-            (after-quote
-             (error "After quote"))
-            (t (error "Shouldn't happen: parsing state: %S" state))))))
 
 ;;; Test suite
 




From pbmriogqoj at bellsouth.net  Tue Feb 24 05:10:41 2004
From: pbmriogqoj at bellsouth.net (Liza Person)
Date: Tue, 24 Feb 2004 08:10:41 +0300
Subject: [slime-cvs] Your Prescription is Ready
Message-ID: <STNWDRSTGKMUJPGYKPQKRE@globalctigroup.com>

An HTML attachment was scrubbed...
URL: <https://mailman.common-lisp.net/pipermail/slime-cvs/attachments/20040224/6ed015de/attachment.html>

From heller at common-lisp.net  Tue Feb 24 23:27:43 2004
From: heller at common-lisp.net (Helmut Eller)
Date: Tue, 24 Feb 2004 18:27:43 -0500
Subject: [slime-cvs] CVS update: slime/swank.lisp 
Message-ID: <E1Avlxn-0002zT-00@common-lisp.net>

Update of /project/slime/cvsroot/slime
In directory common-lisp.net:/tmp/cvs-serv11489

Modified Files:
	swank.lisp 
Log Message:
(format-arglist): Use an special pprint-dispatch table.
Date: Tue Feb 24 18:27:43 2004
Author: heller

Index: slime/swank.lisp
diff -u slime/swank.lisp:1.124 slime/swank.lisp:1.125
--- slime/swank.lisp:1.124	Mon Feb 23 02:21:07 2004
+++ slime/swank.lisp	Tue Feb 24 18:27:43 2004
@@ -682,6 +682,31 @@
     (cond (package (values symbol package))
           (t (error "Unknown symbol: ~S [in ~A]" string default-package)))))
 
+;;; We use a special pprint-dispatch table for printing the arglist.
+;;; An argument is either a symbol or a list.  The name of the
+;;; argument is PRINCed but the other components of an argument
+;;; --default value or type-- are PPRINTed.  We do this to nicely
+;;; cover cases like (&key (function #'cons) (quote 'quote)).  Too
+;;; much code for such a minor feature?
+
+(defvar *initial-pprint-dispatch-table* (copy-pprint-dispatch nil))
+
+(defun print-cons-argument (stream object)
+  (pprint-logical-block (stream object :prefix "(" :suffix ")")
+    (princ (car object) stream)
+    (let ((*print-pprint-dispatch* *initial-pprint-dispatch-table*))
+      (pprint-fill stream (cdr object) nil))))
+
+(defun print-symbol-argument (stream object)
+  (let ((*print-pprint-dispatch* *initial-pprint-dispatch-table*))
+    (princ object stream)))
+
+(defvar *arglist-pprint-dispatch-table* 
+  (let ((table (copy-pprint-dispatch nil)))
+    (set-pprint-dispatch 'cons #'print-cons-argument 0 table)
+    (set-pprint-dispatch 'symbol #'print-symbol-argument 0 table)
+    table))
+
 (defun format-arglist (function-name lambda-list-fn)
   "Use LAMBDA-LIST-FN to format the arglist for FUNCTION-NAME.
 Call LAMBDA-LIST-FN with the symbol corresponding to FUNCTION-NAME."
@@ -690,10 +715,13 @@
       (ignore-errors 
         (let ((symbol (find-symbol-or-lose function-name)))
           (values (funcall lambda-list-fn symbol))))
-    (cond (condition  (format nil "(-- ~A)" condition))
+    (cond (condition (format nil "(-- ~A)" condition))
           (t (let ((*print-case* :downcase)
-                   (*print-pretty* nil))
-               (format nil "(~{~A~^ ~})" arglist))))))
+                   (*print-pprint-dispatch* *arglist-pprint-dispatch-table*)
+                   (*print-level* nil)
+                   (*print-length* nil))
+               (with-output-to-string (stream)
+                 (pprint-fill stream arglist)))))))
 
 
 ;;;; Debugger
@@ -1481,7 +1509,6 @@
 
 (defslimefun quit-thread-browser ()
   (setq *thread-list* nil))
-
 
 ;;; Local Variables:
 ;;; eval: (font-lock-add-keywords 'lisp-mode '(("(\\(defslimefun\\)\\s +\\(\\(\\w\\|\\s_\\)+\\)"  (1 font-lock-keyword-face) (2 font-lock-function-name-face))))




From heller at common-lisp.net  Tue Feb 24 23:31:35 2004
From: heller at common-lisp.net (Helmut Eller)
Date: Tue, 24 Feb 2004 18:31:35 -0500
Subject: [slime-cvs] CVS update: slime/slime.el slime/swank-backend.lisp
	slime/swank-cmucl.lisp slime/swank-sbcl.lisp
	slime/swank-openmcl.lisp slime/swank-lispworks.lisp
	slime/swank-clisp.lisp 
Message-ID: <E1Avm1X-0000m0-00@common-lisp.net>

Update of /project/slime/cvsroot/slime
In directory common-lisp.net:/tmp/cvs-serv15681

Modified Files:
	slime.el swank-backend.lisp swank-cmucl.lisp swank-sbcl.lisp 
	swank-openmcl.lisp swank-lispworks.lisp swank-clisp.lisp 
Log Message:
* slime.el: Various bits of support for maintaining multiple SLIME
connections to different Lisp implementations simultaneously.

* swank-{backend,cmucl,sbcl,clisp,lispworks,openmcl}.lisp 
(lisp-implementation-type-name): Add function to
return simple name of lisp implementation; used by new
multi-connection functionality in slime.el.

Date: Tue Feb 24 18:31:34 2004
Author: heller

Index: slime/slime.el
diff -u slime/slime.el:1.216 slime/slime.el:1.217
--- slime/slime.el:1.216	Mon Feb 23 17:14:56 2004
+++ slime/slime.el	Tue Feb 24 18:31:34 2004
@@ -633,6 +633,27 @@
 
 (put 'destructure-case 'lisp-indent-function 1)
 
+(defmacro* slime-with-chosen-connection ((&optional 
+                                          (prefix-arg 'current-prefix-arg))
+                                         &body body)
+  "Make the connection choosen by PREFIX-ARG current.
+
+(slime-with-chosen-connection (&optional (PREFIX-ARG 'current-prefix-arg))
+  &body BODY)"
+  `(let ((slime-buffer-connection (slime-get-named-connection ,prefix-arg)))
+     , at body))
+
+(put 'slime-with-chosen-connection 'lisp-indent-function 1)
+
+(defun slime-get-named-connection (prefix-arg)
+  "Get a connection based on PREIFX-ARG."
+  (cond ((not prefix-arg) 
+         (slime-connection))
+        ((equal prefix-arg '(4))
+         (slime-find-connection-by-type-name 
+          (slime-read-lisp-implementation-type-name)))
+        (t (error "Invalid prefix argument: %S" prefix-arg))))
+
 (defmacro slime-define-keys (keymap &rest key-command)
   `(progn . ,(mapcar (lambda (k-c) `(define-key ,keymap . ,k-c))
 		     key-command)))
@@ -1229,8 +1250,9 @@
   (when (eq process slime-default-connection)
     (when slime-net-processes
       (slime-select-connection (car slime-net-processes))
-      (message (format "Default connection closed; switched to #%S"
-                       (slime-connection-number))))))
+      (message (format "Default connection closed; switched to #%S (%S)"
+                       (slime-connection-number)
+                       (slime-lisp-implementation-type-name))))))
 
 (defun slime-connection-number (&optional connection)
   (slime-with-connection-buffer (connection)
@@ -1249,7 +1271,18 @@
                         (length slime-net-processes))
                    slime-net-processes)))
     (slime-select-connection conn)
-    (message (format "Selected connection #%S" (slime-connection-number)))))
+    (message (format "Selected connection #%S (%s)"
+                     (slime-connection-number)
+                     (slime-lisp-implementation-type-name)))))
+
+(defun slime-make-default-connection ()
+  "Make the current buffer connection the default connection."
+  (interactive)
+  (slime-select-connection slime-buffer-connection)
+  (message (format "Connection #%S (%s) now default SLIME connection."
+                   (slime-connection-number)
+                   (slime-lisp-implementation-type-name))))
+
 
 (put 'slime-with-connection-buffer 'lisp-indent-function 1)
 
@@ -1275,8 +1308,8 @@
        (make-variable-buffer-local
         (defvar ,real-var , at initial-value-and-doc))
        ;; Accessor
-       (defun ,varname ()
-         (slime-with-connection-buffer () ,real-var))
+       (defun ,varname (&optional process)
+         (slime-with-connection-buffer (process) ,real-var))
        ;; Setf
        (defsetf ,varname () (store)
          `(slime-with-connection-buffer ()
@@ -1299,6 +1332,9 @@
 (slime-def-connection-var slime-lisp-implementation-type nil
   "The implementation type of the Lisp process.")
 
+(slime-def-connection-var slime-lisp-implementation-type-name nil
+  "The short name for the implementation type of the Lisp process.")
+
 (slime-def-connection-var slime-use-sigint-for-interrupt nil
   "If non-nil use a SIGINT for interrupting.")
 
@@ -1394,18 +1430,20 @@
   (when (equal slime-net-processes (list proc))
     (setq slime-connection-counter 0))
   (slime-with-connection-buffer ()
-    (setq slime-connection-number (incf slime-connection-counter)))
-  (setf (slime-pid) (slime-eval '(swank:getpid)))
-  (setf (slime-lisp-implementation-type) 
-        (slime-eval '(cl:lisp-implementation-type)))
-  (setq slime-state-name "")
-  (when-let (repl-buffer (slime-repl-buffer))
-    ;; REPL buffer already exists - update its local
-    ;; `slime-connection' binding.
-    (with-current-buffer repl-buffer
-      (setq slime-buffer-connection proc)))
-  (when slime-global-debugger-hook
-    (slime-eval '(swank:install-global-debugger-hook) "COMMON-LISP-USER")))
+    (setq slime-connection-number (incf slime-connection-counter))
+    (setf (slime-pid) (slime-eval '(swank:getpid)))
+    (setf (slime-lisp-implementation-type) 
+          (slime-eval '(cl:lisp-implementation-type)))
+    (setf (slime-lisp-implementation-type-name) 
+          (slime-eval '(swank:lisp-implementation-type-name)))
+    (setq slime-state-name "")
+    (when-let (repl-buffer (slime-repl-buffer))
+      ;; REPL buffer already exists - update its local
+      ;; `slime-connection' binding.
+      (with-current-buffer repl-buffer
+        (setq slime-buffer-connection proc)))
+    (when slime-global-debugger-hook
+      (slime-eval '(swank:install-global-debugger-hook) "COMMON-LISP-USER"))))
 
 (defun slime-busy-p ()
   slime-rex-continuations)
@@ -1692,10 +1730,11 @@
 (defun slime-switch-to-output-buffer ()
   "Select the output buffer, preferably in a different window."
   (interactive)
-  (set-buffer (slime-output-buffer))
-  (unless (eq (current-buffer) (window-buffer))
-    (pop-to-buffer (current-buffer) t))
-  (goto-char (point-max)))
+  (slime-with-chosen-connection ()
+    (set-buffer (slime-output-buffer))
+    (unless (eq (current-buffer) (window-buffer))
+      (pop-to-buffer (current-buffer) t))
+    (goto-char (point-max))))
 
 
 ;;; REPL
@@ -2227,7 +2266,8 @@
 `slime-next-note' and `slime-previous-note' can be used to navigate
 between compiler notes and to display their full details."
   (interactive)
-  (slime-compile-file t))
+  (slime-with-chosen-connection ()
+    (slime-compile-file t)))
 
 (defun slime-compile-file (&optional load)
   "Compile current buffer's file and highlight resulting compiler notes.
@@ -2275,16 +2315,19 @@
 (defun slime-compile-defun ()
   "Compile the current toplevel form."
   (interactive)
-  (slime-compile-string (slime-defun-at-point)
-                        (save-excursion 
-                          (end-of-defun)
-                          (beginning-of-defun)
-                          (point))))
+  (slime-with-chosen-connection ()
+    (slime-compile-string
+     (slime-defun-at-point)
+     (save-excursion 
+       (end-of-defun)
+       (beginning-of-defun)
+       (point)))))
 
 (defun slime-compile-region (start end)
   "Compile the region."
   (interactive "r")
-  (slime-compile-string (buffer-substring-no-properties start end) start))
+  (slime-with-chosen-connection ()
+    (slime-compile-string (buffer-substring-no-properties start end) start)))
 
 (defun slime-compile-string (string start-offset)
   (slime-eval-async 
@@ -4639,18 +4682,21 @@
     (kill-buffer  "*SLIME connections*"))
   (slime-with-output-to-temp-buffer "*SLIME connections*"
     (let ((default (slime-connection)))
-      (insert " Nr  Type                  Port                Pid\n"
-              " --  ----                  ----                ---\n")
+      (insert
+       (format "%s%2s  %-7s  %-17s  %-7s %-s\n" " " "Nr" "Name" "Port" "Pid" "Type"))
+      (insert
+       (format "%s%2s  %-7s  %-17s  %-7s %-s\n" " " "--" "----" "----" "---" "----"))
       (dolist (p slime-net-processes)
         (let ((slime-dispatching-connection p))
           (insert
            (slime-with-connection-buffer (p)
-             (format "%s%2d  %-20s  %-17s  %-5s\n"
+             (format "%s%2d  %-7s  %-17s  %-7s %-s\n"
                      (if (eq default p) "*" " ")
                      (slime-connection-number)
-                     (slime-lisp-implementation-type)
+                     (slime-lisp-implementation-type-name)
                      (or (process-id p) (process-contact p))
-                     (slime-pid)))))))))
+                     (slime-pid)
+                     (slime-lisp-implementation-type)))))))))
 
 
 ;;; Inspector


Index: slime/swank-backend.lisp
diff -u slime/swank-backend.lisp:1.31 slime/swank-backend.lisp:1.32
--- slime/swank-backend.lisp:1.31	Sat Feb 21 11:35:55 2004
+++ slime/swank-backend.lisp	Tue Feb 24 18:31:34 2004
@@ -38,6 +38,7 @@
            #:frame-locals
            #:frame-source-location-for-emacs
            #:frame-source-position
+           #:lisp-implementation-type-name
            #:getpid
            #:give-goahead
            #:give-gohead
@@ -202,8 +203,12 @@
 (defgeneric call-without-interrupts (fn)
   (:documentation "Call FN in a context where interrupts are disabled."))
 
-(defgeneric getpid ()
-  (:documentation "Return the (Unix) process ID of this superior Lisp."))
+(definterface getpid ()
+  "Return the (Unix) process ID of this superior Lisp.")
+
+(definterface lisp-implementation-type-name ()
+  "Return a short name for the Lisp implementation."
+  (lisp-implementation-type))
 
 
 ;;;; Compilation


Index: slime/swank-cmucl.lisp
diff -u slime/swank-cmucl.lisp:1.69 slime/swank-cmucl.lisp:1.70
--- slime/swank-cmucl.lisp:1.69	Mon Feb 23 02:21:07 2004
+++ slime/swank-cmucl.lisp	Tue Feb 24 18:31:34 2004
@@ -132,12 +132,13 @@
 ;;;; Unix signals
 
 (defmethod call-without-interrupts (fn)
-  (sys:without-interrupts (funcall fn))
-  ;;(funcall fn)
-  )
+  (sys:without-interrupts (funcall fn)))
 
-(defmethod getpid ()
+(defimplementation getpid ()
   (unix:unix-getpid))
+
+(defimplementation lisp-implementation-type-name ()
+  "cmucl")
 
 
 ;;;; Stream handling


Index: slime/swank-sbcl.lisp
diff -u slime/swank-sbcl.lisp:1.67 slime/swank-sbcl.lisp:1.68
--- slime/swank-sbcl.lisp:1.67	Sat Feb 21 11:42:52 2004
+++ slime/swank-sbcl.lisp	Tue Feb 24 18:31:34 2004
@@ -189,6 +189,9 @@
 (defmethod getpid ()
   (sb-unix:unix-getpid))
 
+(defimplementation lisp-implementation-type-name ()
+  "sbcl")
+
 ;;; Utilities
 
 (defvar *swank-debugger-stack-frame*)


Index: slime/swank-openmcl.lisp
diff -u slime/swank-openmcl.lisp:1.63 slime/swank-openmcl.lisp:1.64
--- slime/swank-openmcl.lisp:1.63	Sun Feb  8 14:19:42 2004
+++ slime/swank-openmcl.lisp	Tue Feb 24 18:31:34 2004
@@ -95,6 +95,9 @@
 (defmethod getpid ()
   (ccl::getpid))
 
+(defimplementation lisp-implementation-type-name ()
+  "openmcl")
+
 (let ((ccl::*warn-if-redefine-kernel* nil))
   (defun ccl::force-break-in-listener (p)
     (ccl::process-interrupt


Index: slime/swank-lispworks.lisp
diff -u slime/swank-lispworks.lisp:1.22 slime/swank-lispworks.lisp:1.23
--- slime/swank-lispworks.lisp:1.22	Sun Feb  8 14:19:42 2004
+++ slime/swank-lispworks.lisp	Tue Feb 24 18:31:34 2004
@@ -77,6 +77,9 @@
 (defmethod getpid ()
   (system::getpid))
 
+(defimplementation lisp-implementation-type-name ()
+  "lispworks")
+
 (defimplementation arglist-string (fname)
   (format-arglist fname #'lw:function-lambda-list))
 


Index: slime/swank-clisp.lisp
diff -u slime/swank-clisp.lisp:1.20 slime/swank-clisp.lisp:1.21
--- slime/swank-clisp.lisp:1.20	Wed Feb 18 02:32:44 2004
+++ slime/swank-clisp.lisp	Tue Feb 24 18:31:34 2004
@@ -58,6 +58,9 @@
 #+win32 (defmethod getpid () (or (system::getenv "PID") -1))
 ;; the above is likely broken; we need windows NT users!
 
+(defimplementation lisp-implementation-type-name ()
+  "clisp")
+
 
 ;;; TCP Server
 




From heller at common-lisp.net  Tue Feb 24 23:32:52 2004
From: heller at common-lisp.net (Helmut Eller)
Date: Tue, 24 Feb 2004 18:32:52 -0500
Subject: [slime-cvs] CVS update: slime/ChangeLog 
Message-ID: <E1Avm2m-0001hh-00@common-lisp.net>

Update of /project/slime/cvsroot/slime
In directory common-lisp.net:/tmp/cvs-serv6432

Modified Files:
	ChangeLog 
Log Message:
*** empty log message ***
Date: Tue Feb 24 18:32:52 2004
Author: heller

Index: slime/ChangeLog
diff -u slime/ChangeLog:1.262 slime/ChangeLog:1.263
--- slime/ChangeLog:1.262	Mon Feb 23 02:21:31 2004
+++ slime/ChangeLog	Tue Feb 24 18:32:52 2004
@@ -1,3 +1,16 @@
+2004-02-25  Peter Seibel  <peter at javamonkey.com>
+
+	* slime.el: Various bits of support for maintaining multiple SLIME
+	connections to different Lisp implementations simultaneously.
+
+	* swank-backend.lisp (lisp-implementation-type-name): Add function to
+	return simple name of lisp implementation; used by new
+	multi-connection functionality in slime.el.
+
+2004-02-25  Helmut Eller  <e9626484 at stud3.tuwien.ac.at>
+
+	* swank.lisp (format-arglist): Use a special pprint-dispatch table.
+
 2004-02-22  Lawrence Mitchell  <wence at gmx.li>
 
 	* swank.lisp (format-arglist): Bind *PRINT-PRETTY* to NIL.




From heller at common-lisp.net  Wed Feb 25 07:27:02 2004
From: heller at common-lisp.net (Helmut Eller)
Date: Wed, 25 Feb 2004 02:27:02 -0500
Subject: [slime-cvs] CVS update: slime/slime.el 
Message-ID: <E1AvtRe-00089E-00@common-lisp.net>

Update of /project/slime/cvsroot/slime
In directory common-lisp.net:/tmp/cvs-serv30813

Modified Files:
	slime.el 
Log Message:
(slime-with-chosen-connection): Bind slime-dispatching-connection and
not slime-buffer-connection.  slime-buffer-connection is a buffer
local variable not a dynamic variable.

(slime-find-connection-by-type-name)
(slime-read-lisp-implementation-type-name): Where lost during the merge.
Date: Wed Feb 25 02:27:02 2004
Author: heller

Index: slime/slime.el
diff -u slime/slime.el:1.217 slime/slime.el:1.218
--- slime/slime.el:1.217	Tue Feb 24 18:31:34 2004
+++ slime/slime.el	Wed Feb 25 02:27:01 2004
@@ -638,9 +638,10 @@
                                          &body body)
   "Make the connection choosen by PREFIX-ARG current.
 
-(slime-with-chosen-connection (&optional (PREFIX-ARG 'current-prefix-arg))
+\(slime-with-chosen-connection (&optional (PREFIX-ARG 'current-prefix-arg))
   &body BODY)"
-  `(let ((slime-buffer-connection (slime-get-named-connection ,prefix-arg)))
+  `(let ((slime-dispatching-connection 
+          (slime-get-named-connection ,prefix-arg)))
      , at body))
 
 (put 'slime-with-chosen-connection 'lisp-indent-function 1)
@@ -1020,13 +1021,14 @@
                        (y-or-n-p "Close old connections first? "))))
   (when kill-old-p (slime-disconnect))
   (message "Connecting to Swank on port %S.." port)
-  (slime-init-connection (slime-net-connect host port))
-  (when-let (buffer (get-buffer "*inferior-lisp*"))
-    (delete-windows-on buffer)
-    (bury-buffer buffer))
-  (slime-init-output-buffer)
-  (message "Connected to Swank server on port %S. %s"
-           port (slime-random-words-of-encouragement)))
+  (let ((process (slime-net-connect host port)))
+    (slime-init-connection process)
+    (when-let (buffer (get-buffer "*inferior-lisp*"))
+      (delete-windows-on buffer)
+      (bury-buffer buffer))
+    (slime-init-output-buffer process)
+    (message "Connected to Swank server on port %S. %s"
+             port (slime-random-words-of-encouragement))))
 
 (defun slime-changelog-date ()
   "Return the datestring of the latest entry in the ChangeLog file.
@@ -1243,6 +1245,8 @@
                            (error "No connection")))
      , at body))
 
+(put 'slime-with-connection-buffer 'lisp-indent-function 1)
+
 (defun slime-select-connection (process)
   (setq slime-default-connection process))
 
@@ -1283,8 +1287,22 @@
                    (slime-connection-number)
                    (slime-lisp-implementation-type-name))))
 
-
-(put 'slime-with-connection-buffer 'lisp-indent-function 1)
+(defun slime-find-connection-by-type-name (name)
+  (find name slime-net-processes
+        :test #'string=
+        :key #'slime-lisp-implementation-type-name))
+
+(defun slime-read-lisp-implementation-type-name ()
+  (let ((default (slime-lisp-implementation-type-name)))
+    (completing-read
+     (format "Name (default %s): " default)
+     (slime-bogus-completion-alist
+      (mapcar #'slime-lisp-implementation-type-name slime-net-processes))
+     nil
+     t
+     nil
+     nil
+     default)))
 
 
 ;;;;; Connection-local variables
@@ -1430,20 +1448,15 @@
   (when (equal slime-net-processes (list proc))
     (setq slime-connection-counter 0))
   (slime-with-connection-buffer ()
-    (setq slime-connection-number (incf slime-connection-counter))
-    (setf (slime-pid) (slime-eval '(swank:getpid)))
-    (setf (slime-lisp-implementation-type) 
-          (slime-eval '(cl:lisp-implementation-type)))
-    (setf (slime-lisp-implementation-type-name) 
-          (slime-eval '(swank:lisp-implementation-type-name)))
-    (setq slime-state-name "")
-    (when-let (repl-buffer (slime-repl-buffer))
-      ;; REPL buffer already exists - update its local
-      ;; `slime-connection' binding.
-      (with-current-buffer repl-buffer
-        (setq slime-buffer-connection proc)))
-    (when slime-global-debugger-hook
-      (slime-eval '(swank:install-global-debugger-hook) "COMMON-LISP-USER"))))
+    (setq slime-connection-number (incf slime-connection-counter)))
+  (setf (slime-pid) (slime-eval '(swank:getpid)))
+  (setf (slime-lisp-implementation-type) 
+        (slime-eval '(cl:lisp-implementation-type)))
+  (setf (slime-lisp-implementation-type-name) 
+        (slime-eval '(swank:lisp-implementation-type-name)))
+  (setq slime-state-name "")
+  (when slime-global-debugger-hook
+    (slime-eval '(swank:install-global-debugger-hook) "COMMON-LISP-USER")))
 
 (defun slime-busy-p ()
   slime-rex-continuations)
@@ -1628,8 +1641,9 @@
           (unless noprompt (slime-repl-insert-prompt "" 0))
           (current-buffer)))))
 
-(defun slime-init-output-buffer ()
+(defun slime-init-output-buffer (connection)
   (with-current-buffer (slime-output-buffer t)
+    (set (make-local-variable 'slime-buffer-connection) connection)
     (let ((banner (format "%s  Port: %s  Pid: %s"
                           (slime-lisp-implementation-type)
                           (if (featurep 'xemacs)




From heller at common-lisp.net  Wed Feb 25 07:30:00 2004
From: heller at common-lisp.net (Helmut Eller)
Date: Wed, 25 Feb 2004 02:30:00 -0500
Subject: [slime-cvs] CVS update: slime/ChangeLog 
Message-ID: <E1AvtUW-0003UW-00@common-lisp.net>

Update of /project/slime/cvsroot/slime
In directory common-lisp.net:/tmp/cvs-serv12431

Modified Files:
	ChangeLog 
Log Message:
*** empty log message ***
Date: Wed Feb 25 02:30:00 2004
Author: heller

Index: slime/ChangeLog
diff -u slime/ChangeLog:1.263 slime/ChangeLog:1.264
--- slime/ChangeLog:1.263	Tue Feb 24 18:32:52 2004
+++ slime/ChangeLog	Wed Feb 25 02:29:59 2004
@@ -1,3 +1,13 @@
+2004-02-25  Helmut Eller  <e9626484 at stud3.tuwien.ac.at>
+
+	* slime.el (slime-with-chosen-connection): Bind
+	slime-dispatching-connection and not slime-buffer-connection.
+	slime-buffer-connection is a buffer local variable not a dynamic
+	variable.
+	(slime-find-connection-by-type-name)
+	(slime-read-lisp-implementation-type-name): Where lost during the
+	merge.
+
 2004-02-25  Peter Seibel  <peter at javamonkey.com>
 
 	* slime.el: Various bits of support for maintaining multiple SLIME




From heller at common-lisp.net  Wed Feb 25 08:05:12 2004
From: heller at common-lisp.net (Helmut Eller)
Date: Wed, 25 Feb 2004 03:05:12 -0500
Subject: [slime-cvs] CVS update: slime/slime.el 
Message-ID: <E1Avu2a-0001qG-00@common-lisp.net>

Update of /project/slime/cvsroot/slime
In directory common-lisp.net:/tmp/cvs-serv17500

Modified Files:
	slime.el 
Log Message:
(sldb-fetch-more-frames): Use (goto-char (point-max)) instead of
end-of-buffer. 
Date: Wed Feb 25 03:05:12 2004
Author: heller

Index: slime/slime.el
diff -u slime/slime.el:1.218 slime/slime.el:1.219
--- slime/slime.el:1.218	Wed Feb 25 02:27:01 2004
+++ slime/slime.el	Wed Feb 25 03:05:12 2004
@@ -4326,10 +4326,11 @@
 Called on the `point-entered' text-property hook."
   (let ((inhibit-point-motion-hooks t))
     (let ((inhibit-read-only t))
-      (when-let (previous (get-text-property (point) 'sldb-previous-frame-number))
+      (when-let (previous (get-text-property (point) 
+                                             'sldb-previous-frame-number))
         (beginning-of-line)
         (let ((start (point)))
-          (end-of-buffer)
+          (goto-char (point-max))
           (delete-region start (point)))
         (let ((start (1+ previous))
               (end (+ previous 40)))
@@ -5699,6 +5700,7 @@
 (defun sldb-xemacs-post-command-hook ()
   (when (get-text-property (point) 'point-entered)
     (funcall (get-text-property (point) 'point-entered))))
+
 
 
 ;;; Finishing up




From heller at common-lisp.net  Wed Feb 25 08:06:41 2004
From: heller at common-lisp.net (Helmut Eller)
Date: Wed, 25 Feb 2004 03:06:41 -0500
Subject: [slime-cvs] CVS update: slime/ChangeLog 
Message-ID: <E1Avu41-00034D-00@common-lisp.net>

Update of /project/slime/cvsroot/slime
In directory common-lisp.net:/tmp/cvs-serv8943

Modified Files:
	ChangeLog 
Log Message:
*** empty log message ***
Date: Wed Feb 25 03:06:41 2004
Author: heller

Index: slime/ChangeLog
diff -u slime/ChangeLog:1.264 slime/ChangeLog:1.265
--- slime/ChangeLog:1.264	Wed Feb 25 02:29:59 2004
+++ slime/ChangeLog	Wed Feb 25 03:06:41 2004
@@ -7,6 +7,8 @@
 	(slime-find-connection-by-type-name)
 	(slime-read-lisp-implementation-type-name): Where lost during the
 	merge.
+	(sldb-fetch-more-frames): Use (goto-char (point-max)) instead of
+	end-of-buffer. 
 
 2004-02-25  Peter Seibel  <peter at javamonkey.com>
 




From heller at common-lisp.net  Wed Feb 25 20:47:32 2004
From: heller at common-lisp.net (Helmut Eller)
Date: Wed, 25 Feb 2004 15:47:32 -0500
Subject: [slime-cvs] CVS update: slime/slime.el 
Message-ID: <E1Aw5wK-0006s4-00@common-lisp.net>

Update of /project/slime/cvsroot/slime
In directory common-lisp.net:/tmp/cvs-serv22528

Modified Files:
	slime.el 
Log Message:
(slime-symbol-at-point): Don't skip backwards across whitespace when
we are at the first character of a symbol.  To handle this case: skip
symbol constituents forward before skipping whitespace backwards.
Reported by Jan Richter.

(slime-connection-close-hook, slime-next-connection)
(slime-make-default-connection): Remove extra call to format.

(slime-init-connection-state): Use only a single RPC instead of 4 to
initialize the connection.

Date: Wed Feb 25 15:47:28 2004
Author: heller

Index: slime/slime.el
diff -u slime/slime.el:1.219 slime/slime.el:1.220
--- slime/slime.el:1.219	Wed Feb 25 03:05:12 2004
+++ slime/slime.el	Wed Feb 25 15:47:27 2004
@@ -769,7 +769,8 @@
 (defun slime-symbol-at-point ()
   "Return the symbol at point, otherwise nil."
   (save-excursion
-    (skip-syntax-backward "-")
+    (skip-syntax-forward "w_")
+    (skip-syntax-backward "-") 
     (let ((string (thing-at-point 'symbol)))
       (if string (intern (substring-no-properties string)) nil))))
 
@@ -1254,9 +1255,9 @@
   (when (eq process slime-default-connection)
     (when slime-net-processes
       (slime-select-connection (car slime-net-processes))
-      (message (format "Default connection closed; switched to #%S (%S)"
-                       (slime-connection-number)
-                       (slime-lisp-implementation-type-name))))))
+      (message "Default connection closed; switched to #%S (%S)"
+               (slime-connection-number)
+               (slime-lisp-implementation-type-name)))))
 
 (defun slime-connection-number (&optional connection)
   (slime-with-connection-buffer (connection)
@@ -1275,17 +1276,17 @@
                         (length slime-net-processes))
                    slime-net-processes)))
     (slime-select-connection conn)
-    (message (format "Selected connection #%S (%s)"
-                     (slime-connection-number)
-                     (slime-lisp-implementation-type-name)))))
+    (message "Selected connection #%S (%s)"
+             (slime-connection-number)
+             (slime-lisp-implementation-type-name))))
 
 (defun slime-make-default-connection ()
   "Make the current buffer connection the default connection."
   (interactive)
   (slime-select-connection slime-buffer-connection)
-  (message (format "Connection #%S (%s) now default SLIME connection."
-                   (slime-connection-number)
-                   (slime-lisp-implementation-type-name))))
+  (message "Connection #%S (%s) now default SLIME connection."
+           (slime-connection-number)
+           (slime-lisp-implementation-type-name)))
 
 (defun slime-find-connection-by-type-name (name)
   (find name slime-net-processes
@@ -1449,11 +1450,13 @@
     (setq slime-connection-counter 0))
   (slime-with-connection-buffer ()
     (setq slime-connection-number (incf slime-connection-counter)))
-  (setf (slime-pid) (slime-eval '(swank:getpid)))
-  (setf (slime-lisp-implementation-type) 
-        (slime-eval '(cl:lisp-implementation-type)))
-  (setf (slime-lisp-implementation-type-name) 
-        (slime-eval '(swank:lisp-implementation-type-name)))
+  (destructuring-bind (version pid type name features)
+      (slime-eval '(swank:connection-info))
+    (slime-check-protocol-version version)
+    (setf (slime-pid) pid
+          (slime-lisp-implementation-type) type
+          (slime-lisp-implementation-type-name) name
+          (slime-lisp-features) features))
   (setq slime-state-name "")
   (when slime-global-debugger-hook
     (slime-eval '(swank:install-global-debugger-hook) "COMMON-LISP-USER")))




From heller at common-lisp.net  Wed Feb 25 20:49:37 2004
From: heller at common-lisp.net (Helmut Eller)
Date: Wed, 25 Feb 2004 15:49:37 -0500
Subject: [slime-cvs] CVS update: slime/swank.lisp 
Message-ID: <E1Aw5yL-00054o-00@common-lisp.net>

Update of /project/slime/cvsroot/slime
In directory common-lisp.net:/tmp/cvs-serv19508

Modified Files:
	swank.lisp 
Log Message:
(connection-info): New function.

(open-streams): Don't send the :check-protocol-version message.  Now
handled with CONNECTION-INFO.
Date: Wed Feb 25 15:49:37 2004
Author: heller

Index: slime/swank.lisp
diff -u slime/swank.lisp:1.125 slime/swank.lisp:1.126
--- slime/swank.lisp:1.125	Tue Feb 24 18:27:43 2004
+++ slime/swank.lisp	Wed Feb 25 15:49:37 2004
@@ -207,7 +207,6 @@
 (defun open-streams (socket-io)
   "Return the 4 streams for IO redirection:
  DEDICATED-OUTPUT INPUT OUTPUT IO"
-  (encode-message `(:check-protocol-version ,(changelog-date)) socket-io)
   (multiple-value-bind (output-fn dedicated-output) 
       (make-output-function socket-io)
     (let ((input-fn  (lambda () (read-user-input-from-emacs))))
@@ -624,6 +623,15 @@
 
 (defslimefun take-input (tag input)
   (throw tag input))
+
+(defslimefun connection-info ()
+  "Return a list of the form: 
+\(VERSION PID IMPLEMENTATION-TYPE IMPLEMENTATION-NAME FEATURES)."
+  (list (changelog-date)
+        (getpid)
+        (lisp-implementation-type)
+        (lisp-implementation-type-name)
+        (setq *slime-features* *features*)))
 
 
 ;;;; Reading and printing




From heller at common-lisp.net  Wed Feb 25 20:51:51 2004
From: heller at common-lisp.net (Helmut Eller)
Date: Wed, 25 Feb 2004 15:51:51 -0500
Subject: [slime-cvs] CVS update: slime/swank-cmucl.lisp 
Message-ID: <E1Aw60V-0000YN-00@common-lisp.net>

Update of /project/slime/cvsroot/slime
In directory common-lisp.net:/tmp/cvs-serv2118

Modified Files:
	swank-cmucl.lisp 
Log Message:
(arglist-string): Delay the call to di::function-debug-function until
it is actually needed.
Date: Wed Feb 25 15:51:50 2004
Author: heller

Index: slime/swank-cmucl.lisp
diff -u slime/swank-cmucl.lisp:1.70 slime/swank-cmucl.lisp:1.71
--- slime/swank-cmucl.lisp:1.70	Tue Feb 24 18:31:34 2004
+++ slime/swank-cmucl.lisp	Wed Feb 25 15:51:50 2004
@@ -822,7 +822,6 @@
 	       "(-- <Unknown-Function>)"
 	       (let* ((fun (or (macro-function function)
                                (symbol-function function)))
-		      (df (di::function-debug-function fun))
 		      (arglist (kernel:%function-arglist 
                                 (kernel:%function-self fun))))
 		 (cond ((eval:interpreted-function-p fun)
@@ -833,8 +832,10 @@
 		       ;; this should work both for
 		       ;; compiled-debug-function and for
 		       ;; interpreted-debug-function
-		       (df (di::debug-function-lambda-list df))
-		       (t "(<arglist-unavailable>)"))))))
+		       (t (let ((df (di::function-debug-function fun)))
+                            (if df 
+                                (di::debug-function-lambda-list df)
+                                "(<arglist-unavailable>)"))))))))
       (etypecase arglist
         (string arglist)
         (cons (let ((*print-case* :downcase)




From heller at common-lisp.net  Wed Feb 25 21:01:10 2004
From: heller at common-lisp.net (Helmut Eller)
Date: Wed, 25 Feb 2004 16:01:10 -0500
Subject: [slime-cvs] CVS update: slime/ChangeLog 
Message-ID: <E1Aw69W-0000Rt-00@common-lisp.net>

Update of /project/slime/cvsroot/slime
In directory common-lisp.net:/tmp/cvs-serv32640

Modified Files:
	ChangeLog 
Log Message:
*** empty log message ***
Date: Wed Feb 25 16:01:09 2004
Author: heller

Index: slime/ChangeLog
diff -u slime/ChangeLog:1.265 slime/ChangeLog:1.266
--- slime/ChangeLog:1.265	Wed Feb 25 03:06:41 2004
+++ slime/ChangeLog	Wed Feb 25 16:01:08 2004
@@ -1,11 +1,28 @@
 2004-02-25  Helmut Eller  <e9626484 at stud3.tuwien.ac.at>
 
+	* swank-cmucl.lisp (arglist-string): Delay the call to
+	di::function-debug-function until it is actually needed.
+
+	* swank.lisp (connection-info): New function.
+	(open-streams): Don't send the :check-protocol-version message.  Now
+	handled with CONNECTION-INFO.
+
+	* slime.el (slime-symbol-at-point): Don't skip backwards across
+	whitespace when we are at the first character of a symbol.  To
+	handle this case: skip symbol constituents forward before skipping
+	whitespace backwards.  Reported by Jan Richter.
+	(slime-connection-close-hook, slime-next-connection)
+	(slime-make-default-connection): Remove extra call to format.
+	(slime-init-connection-state): Use only a single RPC instead of 4.
+
+2004-02-25  Helmut Eller  <e9626484 at stud3.tuwien.ac.at>
+
 	* slime.el (slime-with-chosen-connection): Bind
 	slime-dispatching-connection and not slime-buffer-connection.
 	slime-buffer-connection is a buffer local variable not a dynamic
 	variable.
 	(slime-find-connection-by-type-name)
-	(slime-read-lisp-implementation-type-name): Where lost during the
+	(slime-read-lisp-implementation-type-name): Were lost during the
 	merge.
 	(sldb-fetch-more-frames): Use (goto-char (point-max)) instead of
 	end-of-buffer. 




From heller at common-lisp.net  Wed Feb 25 22:03:40 2004
From: heller at common-lisp.net (Helmut Eller)
Date: Wed, 25 Feb 2004 17:03:40 -0500
Subject: [slime-cvs] CVS update: slime/swank-cmucl.lisp 
Message-ID: <E1Aw780-0004Yr-00@common-lisp.net>

Update of /project/slime/cvsroot/slime
In directory common-lisp.net:/tmp/cvs-serv17250

Modified Files:
	swank-cmucl.lisp 
Log Message:
(compile-file-for-emacs): Load the fasl file even irrespective of
COMILE-FILE's third return value.
Date: Wed Feb 25 17:03:40 2004
Author: heller

Index: slime/swank-cmucl.lisp
diff -u slime/swank-cmucl.lisp:1.71 slime/swank-cmucl.lisp:1.72
--- slime/swank-cmucl.lisp:1.71	Wed Feb 25 15:51:50 2004
+++ slime/swank-cmucl.lisp	Wed Feb 25 17:03:39 2004
@@ -365,10 +365,8 @@
   (with-compilation-hooks ()
     (let ((*buffer-name* nil)
           (*compile-filename* filename))
-      (multiple-value-bind (fasl-file warnings-p failure-p)
-          (compile-file filename)
-        (declare (ignore warnings-p))
-        (when (and load-p (not failure-p))
+      (let ((fasl-file (compile-file filename)))
+        (when (and load-p fasl-file)
           (load fasl-file))))))
 
 (defimplementation compile-string-for-emacs (string &key buffer position)




From heller at common-lisp.net  Wed Feb 25 22:12:10 2004
From: heller at common-lisp.net (Helmut Eller)
Date: Wed, 25 Feb 2004 17:12:10 -0500
Subject: [slime-cvs] CVS update: slime/ChangeLog 
Message-ID: <E1Aw7GE-0000Cv-00@common-lisp.net>

Update of /project/slime/cvsroot/slime
In directory common-lisp.net:/tmp/cvs-serv32608

Modified Files:
	ChangeLog 
Log Message:
*** empty log message ***
Date: Wed Feb 25 17:12:10 2004
Author: heller

Index: slime/ChangeLog
diff -u slime/ChangeLog:1.266 slime/ChangeLog:1.267
--- slime/ChangeLog:1.266	Wed Feb 25 16:01:08 2004
+++ slime/ChangeLog	Wed Feb 25 17:12:10 2004
@@ -2,6 +2,8 @@
 
 	* swank-cmucl.lisp (arglist-string): Delay the call to
 	di::function-debug-function until it is actually needed.
+	(compile-file-for-emacs): Load the fasl file even irrespective of
+	COMILE-FILE's third return value.
 
 	* swank.lisp (connection-info): New function.
 	(open-streams): Don't send the :check-protocol-version message.  Now




From heller at common-lisp.net  Thu Feb 26 07:12:02 2004
From: heller at common-lisp.net (Helmut Eller)
Date: Thu, 26 Feb 2004 02:12:02 -0500
Subject: [slime-cvs] CVS update: slime/swank-lispworks.lisp 
Message-ID: <E1AwFgg-0001xr-00@common-lisp.net>

Update of /project/slime/cvsroot/slime
In directory common-lisp.net:/tmp/cvs-serv7201

Modified Files:
	swank-lispworks.lisp 
Log Message:
(dspec-buffer-position): Renamed from dspec-buffer-buffer-position.
Handle dspecs of the form (defmacro foo).

(arglist-string): Handle unknown arglists properly.
Date: Thu Feb 26 02:12:02 2004
Author: heller

Index: slime/swank-lispworks.lisp
diff -u slime/swank-lispworks.lisp:1.23 slime/swank-lispworks.lisp:1.24
--- slime/swank-lispworks.lisp:1.23	Tue Feb 24 18:31:34 2004
+++ slime/swank-lispworks.lisp	Thu Feb 26 02:12:02 2004
@@ -81,7 +81,13 @@
   "lispworks")
 
 (defimplementation arglist-string (fname)
-  (format-arglist fname #'lw:function-lambda-list))
+  (format-arglist fname 
+                  (lambda (symbol)
+                    (let ((arglist (lw:function-lambda-list symbol)))
+                      (etypecase arglist
+                        ((member :dont-know)
+                         (error "<arglist-unavailable>"))
+                        (cons arglist))))))
 
 (defimplementation macroexpand-all (form)
   (walker:walk-form form))
@@ -296,14 +302,11 @@
              (delete-file binary-filename))))
     (delete-file filename)))
 
-
-;; (dspec:dspec-primary-name '(:top-level-form 19))
-
-(defun dspec-buffer-buffer-position (dspec)
+(defun dspec-buffer-position (dspec)
   (etypecase dspec
     (cons (ecase (car dspec)
-            (defun `(:function-name ,(symbol-name (cadr dspec))))
-            (method `(:function-name ,(symbol-name (cadr dspec))))
+            ((defun method defmacro)
+             `(:function-name ,(symbol-name (cadr dspec))))
             ;; XXX this isn't quite right
             (lw:top-level-form `(:source-path ,(cdr dspec) nil))))
     (symbol `(:function-name ,(symbol-name dspec)))))
@@ -329,7 +332,7 @@
            (etypecase location
              ((or pathname string) 
               (make-location `(:file ,(filename location))
-                             (dspec-buffer-buffer-position dspec)))
+                             (dspec-buffer-position dspec)))
              ((member :listener)
               `(:error ,(format nil "Function defined in listener: ~S" dspec)))
              ((member :unknown)




From heller at common-lisp.net  Thu Feb 26 07:13:01 2004
From: heller at common-lisp.net (Helmut Eller)
Date: Thu, 26 Feb 2004 02:13:01 -0500
Subject: [slime-cvs] CVS update: slime/swank.lisp 
Message-ID: <E1AwFhd-0002zo-00@common-lisp.net>

Update of /project/slime/cvsroot/slime
In directory common-lisp.net:/tmp/cvs-serv10626

Modified Files:
	swank.lisp 
Log Message:
(swank-pprint): Bind *package* to *buffer-package*.
Date: Thu Feb 26 02:13:01 2004
Author: heller

Index: slime/swank.lisp
diff -u slime/swank.lisp:1.126 slime/swank.lisp:1.127
--- slime/swank.lisp:1.126	Wed Feb 25 15:49:37 2004
+++ slime/swank.lisp	Thu Feb 26 02:13:01 2004
@@ -929,7 +929,8 @@
         (*print-circle* *swank-pprint-circle*)
         (*print-escape* *swank-pprint-escape*)
         (*print-level* *swank-pprint-level*)
-        (*print-length* *swank-pprint-length*))
+        (*print-length* *swank-pprint-length*)
+        (*package* *buffer-package*))
     (cond ((null list) "; No value")
           (t (with-output-to-string (*standard-output*)
                (dolist (o list)




From heller at common-lisp.net  Thu Feb 26 07:15:51 2004
From: heller at common-lisp.net (Helmut Eller)
Date: Thu, 26 Feb 2004 02:15:51 -0500
Subject: [slime-cvs] CVS update: slime/swank-sbcl.lisp 
Message-ID: <E1AwFkN-0000p6-00@common-lisp.net>

Update of /project/slime/cvsroot/slime
In directory common-lisp.net:/tmp/cvs-serv2817

Modified Files:
	swank-sbcl.lisp 
Log Message:
(compile-file-for-emacs): Load the fasl file regardless of f-p. 
Date: Thu Feb 26 02:15:51 2004
Author: heller

Index: slime/swank-sbcl.lisp
diff -u slime/swank-sbcl.lisp:1.68 slime/swank-sbcl.lisp:1.69
--- slime/swank-sbcl.lisp:1.68	Tue Feb 24 18:31:34 2004
+++ slime/swank-sbcl.lisp	Thu Feb 26 02:15:51 2004
@@ -321,7 +321,7 @@
   (with-compilation-hooks ()
     (multiple-value-bind (fasl-file w-p f-p) (compile-file filename)
       (declare (ignore w-p))
-      (cond ((and fasl-file (not f-p) load-p)
+      (cond ((and load-p fasl-file)
              (load fasl-file))
             (t fasl-file)))))
 




From heller at common-lisp.net  Thu Feb 26 07:16:17 2004
From: heller at common-lisp.net (Helmut Eller)
Date: Thu, 26 Feb 2004 02:16:17 -0500
Subject: [slime-cvs] CVS update: slime/swank-allegro.lisp 
Message-ID: <E1AwFkn-0002Co-00@common-lisp.net>

Update of /project/slime/cvsroot/slime
In directory common-lisp.net:/tmp/cvs-serv8224

Modified Files:
	swank-allegro.lisp 
Log Message:
(lisp-implementation-type-name): Implement it.
Date: Thu Feb 26 02:16:17 2004
Author: heller

Index: slime/swank-allegro.lisp
diff -u slime/swank-allegro.lisp:1.14 slime/swank-allegro.lisp:1.15
--- slime/swank-allegro.lisp:1.14	Sun Feb  8 14:19:42 2004
+++ slime/swank-allegro.lisp	Thu Feb 26 02:16:16 2004
@@ -55,6 +55,9 @@
 (defimplementation getpid ()
   (excl::getpid))
 
+(defimplementation lisp-implementation-type-name ()
+  "allegro")
+
 ;;;; Misc
 
 (defimplementation arglist-string (fname)




From heller at common-lisp.net  Thu Feb 26 07:17:11 2004
From: heller at common-lisp.net (Helmut Eller)
Date: Thu, 26 Feb 2004 02:17:11 -0500
Subject: [slime-cvs] CVS update: slime/swank-backend.lisp 
Message-ID: <E1AwFlf-0003M0-00@common-lisp.net>

Update of /project/slime/cvsroot/slime
In directory common-lisp.net:/tmp/cvs-serv12575

Modified Files:
	swank-backend.lisp 
Log Message:
(:swank): export connection-info.
Date: Thu Feb 26 02:17:10 2004
Author: heller

Index: slime/swank-backend.lisp
diff -u slime/swank-backend.lisp:1.32 slime/swank-backend.lisp:1.33
--- slime/swank-backend.lisp:1.32	Tue Feb 24 18:31:34 2004
+++ slime/swank-backend.lisp	Thu Feb 26 02:17:10 2004
@@ -40,6 +40,7 @@
            #:frame-source-position
            #:lisp-implementation-type-name
            #:getpid
+           #:connection-info
            #:give-goahead
            #:give-gohead
            #:init-inspector




From heller at common-lisp.net  Thu Feb 26 07:19:07 2004
From: heller at common-lisp.net (Helmut Eller)
Date: Thu, 26 Feb 2004 02:19:07 -0500
Subject: [slime-cvs] CVS update: slime/ChangeLog 
Message-ID: <E1AwFnX-00085u-00@common-lisp.net>

Update of /project/slime/cvsroot/slime
In directory common-lisp.net:/tmp/cvs-serv31034

Modified Files:
	ChangeLog 
Log Message:
*** empty log message ***
Date: Thu Feb 26 02:19:07 2004
Author: heller

Index: slime/ChangeLog
diff -u slime/ChangeLog:1.267 slime/ChangeLog:1.268
--- slime/ChangeLog:1.267	Wed Feb 25 17:12:10 2004
+++ slime/ChangeLog	Thu Feb 26 02:19:07 2004
@@ -1,8 +1,26 @@
+2004-02-26  Helmut Eller  <e9626484 at stud3.tuwien.ac.at>
+
+	* swank-backend.lisp (:swank): export connection-info.
+
+	* swank-allegro.lisp (lisp-implementation-type-name): Implement
+	it.
+
+	* swank-sbcl.lisp (compile-file-for-emacs): Load the fasl file
+	regardless of f-p.
+
+	* swank.lisp (swank-pprint): Bind *package* to *buffer-package*.
+	Reported by Alan Picard.
+
+	* swank-lispworks.lisp (dspec-buffer-position): Renamed from
+	dspec-buffer-buffer-position.  Handle dspecs of the form (defmacro
+	foo).  Reported by Alan Picard.
+	(arglist-string): Handle unknown arglists properly.
+
 2004-02-25  Helmut Eller  <e9626484 at stud3.tuwien.ac.at>
 
 	* swank-cmucl.lisp (arglist-string): Delay the call to
 	di::function-debug-function until it is actually needed.
-	(compile-file-for-emacs): Load the fasl file even irrespective of
+	(compile-file-for-emacs): Load the fasl file irrespective of
 	COMILE-FILE's third return value.
 
 	* swank.lisp (connection-info): New function.




From mbaringer at common-lisp.net  Thu Feb 26 18:38:01 2004
From: mbaringer at common-lisp.net (Marco Baringer)
Date: Thu, 26 Feb 2004 13:38:01 -0500
Subject: [slime-cvs] CVS update: slime/ChangeLog slime/swank-openmcl.lisp 
Message-ID: <E1AwQOX-00012W-00@common-lisp.net>

Update of /project/slime/cvsroot/slime
In directory common-lisp.net:/tmp/cvs-serv1411

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

Date: Thu Feb 26 13:38:01 2004
Author: mbaringer

Index: slime/ChangeLog
diff -u slime/ChangeLog:1.268 slime/ChangeLog:1.269
--- slime/ChangeLog:1.268	Thu Feb 26 02:19:07 2004
+++ slime/ChangeLog	Thu Feb 26 13:38:00 2004
@@ -1,3 +1,9 @@
+2004-02-26  Marco Baringer  <mb at bese.it>
+
+	* swank-openmcl.lisp (ccl::force-break-in-listener): Pass a
+	condition object to invoke-debugger.
+	Patch by Bryan O'Connor <bryan-slime at lunch.org>
+
 2004-02-26  Helmut Eller  <e9626484 at stud3.tuwien.ac.at>
 
 	* swank-backend.lisp (:swank): export connection-info.


Index: slime/swank-openmcl.lisp
diff -u slime/swank-openmcl.lisp:1.64 slime/swank-openmcl.lisp:1.65
--- slime/swank-openmcl.lisp:1.64	Tue Feb 24 18:31:34 2004
+++ slime/swank-openmcl.lisp	Thu Feb 26 13:38:00 2004
@@ -114,7 +114,8 @@
                      (setq *swank-debugger-stack-frame* p)
                      (return-from find-frame))
                    (setq previous-f (ccl::lfun-name lfun)))))
-      (restart-case (invoke-debugger)
+      (restart-case (invoke-debugger
+                     (make-condition 'simple-condition :format-control ""))
         (continue () :report (lambda (stream) (write-string "Resume interrupted evaluation" stream)) t))
       ))))))
 




From pseibel at common-lisp.net  Thu Feb 26 19:20:06 2004
From: pseibel at common-lisp.net (Peter Seibel)
Date: Thu, 26 Feb 2004 14:20:06 -0500
Subject: [slime-cvs] CVS update: slime/ChangeLog slime/slime.el 
Message-ID: <E1AwR3G-0004HI-00@common-lisp.net>

Update of /project/slime/cvsroot/slime
In directory common-lisp.net:/tmp/cvs-serv8064

Modified Files:
	ChangeLog slime.el 
Log Message:
Change slime-list-connections to be a bit more useful.

Date: Thu Feb 26 14:20:05 2004
Author: pseibel

Index: slime/ChangeLog
diff -u slime/ChangeLog:1.269 slime/ChangeLog:1.270
--- slime/ChangeLog:1.269	Thu Feb 26 13:38:00 2004
+++ slime/ChangeLog	Thu Feb 26 14:20:04 2004
@@ -1,3 +1,9 @@
+2004-02-26  Peter Seibel  <peter at javamonkey.com>
+
+	* slime.el (slime-list-connections): Make the buffer created by
+	this function do a bit more: Can use it to switch to different
+	connections and change the default.
+
 2004-02-26  Marco Baringer  <mb at bese.it>
 
 	* swank-openmcl.lisp (ccl::force-break-in-listener): Pass a


Index: slime/slime.el
diff -u slime/slime.el:1.220 slime/slime.el:1.221
--- slime/slime.el:1.220	Wed Feb 25 15:47:27 2004
+++ slime/slime.el	Thu Feb 26 14:20:04 2004
@@ -4693,28 +4693,71 @@
 
 ;;;;; Connection listing
 
+(define-derived-mode slime-connection-list-mode fundamental-mode
+  "connection-list"
+  "SLIME Connection List Mode.
+
+\\{slime-connection-list-mode-map}"
+  (when slime-truncate-lines
+    (set (make-local-variable 'truncate-lines) t)))
+
+(slime-define-keys slime-connection-list-mode-map
+  ((kbd "RET") 'slime-goto-connection)
+  ("d"         'slime-connection-list-make-default)
+  ("q"         'slime-temp-buffer-quit))
+
+(defun slime-goto-connection ()
+  (interactive)
+  (let ((slime-dispatching-connection 
+         (slime-find-connection-by-type-name
+          (slime-extract-type-name-from-line))))
+    (slime-switch-to-output-buffer)))
+
+(defun slime-connection-list-make-default ()
+  (interactive)
+  (let ((slime-dispatching-connection 
+         (slime-find-connection-by-type-name
+          (slime-extract-type-name-from-line))))
+    (slime-make-default-connection)
+    (slime-draw-connection-list)))
+
+(defun slime-extract-type-name-from-line ()
+  (save-excursion
+    (beginning-of-line)
+    (search-forward-regexp "[0-9]\\s *\\([0-9a-zA-Z]+\\)")
+    (match-string 1)))
+
 (defun slime-list-connections ()
   "Display a list of all connections."
   (interactive)
   (when (get-buffer "*SLIME connections*")
     (kill-buffer  "*SLIME connections*"))
-  (slime-with-output-to-temp-buffer "*SLIME connections*"
-    (let ((default (slime-connection)))
-      (insert
-       (format "%s%2s  %-7s  %-17s  %-7s %-s\n" " " "Nr" "Name" "Port" "Pid" "Type"))
-      (insert
-       (format "%s%2s  %-7s  %-17s  %-7s %-s\n" " " "--" "----" "----" "---" "----"))
-      (dolist (p slime-net-processes)
-        (let ((slime-dispatching-connection p))
-          (insert
-           (slime-with-connection-buffer (p)
-             (format "%s%2d  %-7s  %-17s  %-7s %-s\n"
-                     (if (eq default p) "*" " ")
-                     (slime-connection-number)
-                     (slime-lisp-implementation-type-name)
-                     (or (process-id p) (process-contact p))
-                     (slime-pid)
-                     (slime-lisp-implementation-type)))))))))
+  (slime-draw-connection-list))
+
+(defun slime-draw-connection-list ()
+  (let ((default-pos nil))
+    (slime-with-output-to-temp-buffer "*SLIME connections*"
+      (slime-connection-list-mode)
+      (let ((default (slime-connection)))
+        (insert
+         (format "%s%2s  %-7s  %-17s  %-7s %-s\n" " " "Nr" "Name" "Port" "Pid" "Type"))
+        (insert
+         (format "%s%2s  %-7s  %-17s  %-7s %-s\n" " " "--" "----" "----" "---" "----"))
+        (dolist (p (reverse slime-net-processes))
+          (let ((slime-dispatching-connection p))
+            (if (eq default p) (setf default-pos (point)))
+            (insert
+             (slime-with-connection-buffer (p)
+               (format "%s%2d  %-7s  %-17s  %-7s %-s\n"
+                       (if (eq default p) "*" " ")
+                       (slime-connection-number)
+                       (slime-lisp-implementation-type-name)
+                       (or (process-id p) (process-contact p))
+                       (slime-pid)
+                       (slime-lisp-implementation-type))))))))
+    (with-current-buffer (get-buffer "*SLIME connections*")
+      (goto-char default-pos))))
+
 
 
 ;;; Inspector




From pseibel at common-lisp.net  Thu Feb 26 22:31:13 2004
From: pseibel at common-lisp.net (Peter Seibel)
Date: Thu, 26 Feb 2004 17:31:13 -0500
Subject: [slime-cvs] CVS update: slime/ChangeLog slime/slime.el 
Message-ID: <E1AwU2D-00011U-00@common-lisp.net>

Update of /project/slime/cvsroot/slime
In directory common-lisp.net:/tmp/cvs-serv866

Modified Files:
	ChangeLog slime.el 
Log Message:
Changing connection list to use text-properties instead of regexp to find connection.

Date: Thu Feb 26 17:31:13 2004
Author: pseibel

Index: slime/ChangeLog
diff -u slime/ChangeLog:1.270 slime/ChangeLog:1.271
--- slime/ChangeLog:1.270	Thu Feb 26 14:20:04 2004
+++ slime/ChangeLog	Thu Feb 26 17:31:13 2004
@@ -1,5 +1,11 @@
 2004-02-26  Peter Seibel  <peter at javamonkey.com>
 
+	* slime.el (slime-draw-connection-list): Use text-properties to
+	associate the connections each line of the connections list
+	buffer.
+
+2004-02-26  Peter Seibel  <peter at javamonkey.com>
+
 	* slime.el (slime-list-connections): Make the buffer created by
 	this function do a bit more: Can use it to switch to different
 	connections and change the default.


Index: slime/slime.el
diff -u slime/slime.el:1.221 slime/slime.el:1.222
--- slime/slime.el:1.221	Thu Feb 26 14:20:04 2004
+++ slime/slime.el	Thu Feb 26 17:31:13 2004
@@ -4709,24 +4709,16 @@
 (defun slime-goto-connection ()
   (interactive)
   (let ((slime-dispatching-connection 
-         (slime-find-connection-by-type-name
-          (slime-extract-type-name-from-line))))
+         (get-text-property (point) 'slime-connection)))
     (slime-switch-to-output-buffer)))
 
 (defun slime-connection-list-make-default ()
   (interactive)
   (let ((slime-dispatching-connection 
-         (slime-find-connection-by-type-name
-          (slime-extract-type-name-from-line))))
+         (get-text-property (point) 'slime-connection)))
     (slime-make-default-connection)
     (slime-draw-connection-list)))
 
-(defun slime-extract-type-name-from-line ()
-  (save-excursion
-    (beginning-of-line)
-    (search-forward-regexp "[0-9]\\s *\\([0-9a-zA-Z]+\\)")
-    (match-string 1)))
-
 (defun slime-list-connections ()
   "Display a list of all connections."
   (interactive)
@@ -4744,8 +4736,9 @@
         (insert
          (format "%s%2s  %-7s  %-17s  %-7s %-s\n" " " "--" "----" "----" "---" "----"))
         (dolist (p (reverse slime-net-processes))
-          (let ((slime-dispatching-connection p))
-            (if (eq default p) (setf default-pos (point)))
+          (let ((slime-dispatching-connection p)
+                (line-start (point)))
+            (if (eq default p) (setf default-pos line-start))
             (insert
              (slime-with-connection-buffer (p)
                (format "%s%2d  %-7s  %-17s  %-7s %-s\n"
@@ -4754,7 +4747,8 @@
                        (slime-lisp-implementation-type-name)
                        (or (process-id p) (process-contact p))
                        (slime-pid)
-                       (slime-lisp-implementation-type))))))))
+                       (slime-lisp-implementation-type))))
+            (add-text-properties line-start (point) (list 'slime-connection p))))))
     (with-current-buffer (get-buffer "*SLIME connections*")
       (goto-char default-pos))))
 




From mdzaao at austin.rr.com  Fri Feb 27 07:47:29 2004
From: mdzaao at austin.rr.com (Anna Echols)
Date: Fri, 27 Feb 2004 01:47:29 -0600
Subject: [slime-cvs] Save on 100 of the top brands of cigarettes
Message-ID: <AYRYUVEYXYNKIJNZMHSVSZNCC@calway.com>

An HTML attachment was scrubbed...
URL: <https://mailman.common-lisp.net/pipermail/slime-cvs/attachments/20040227/4b19975c/attachment.html>

From mbaringer at common-lisp.net  Fri Feb 27 12:32:07 2004
From: mbaringer at common-lisp.net (Marco Baringer)
Date: Fri, 27 Feb 2004 07:32:07 -0500
Subject: [slime-cvs] CVS update: slime/ChangeLog slime/slime.el
	slime/swank-backend.lisp slime/swank-openmcl.lisp slime/swank.lisp 
Message-ID: <E1Awh9z-0006JU-00@common-lisp.net>

Update of /project/slime/cvsroot/slime
In directory common-lisp.net:/tmp/cvs-serv22592

Modified Files:
	ChangeLog slime.el swank-backend.lisp swank-openmcl.lisp 
	swank.lisp 
Log Message:
See ChangeLog entry "2004-02-27 Macro Baringer"

Date: Fri Feb 27 07:32:06 2004
Author: mbaringer

Index: slime/ChangeLog
diff -u slime/ChangeLog:1.271 slime/ChangeLog:1.272
--- slime/ChangeLog:1.271	Thu Feb 26 17:31:13 2004
+++ slime/ChangeLog	Fri Feb 27 07:32:06 2004
@@ -1,3 +1,25 @@
+2004-02-27  Marco Baringer  <mb at bese.it>
+
+	* slime.el (slime-read-port-and-connect,
+	slime-read-port-and-connect-to-running-swank): Refactor
+	slime-read-port-and-connect into two functions so that
+	slime-thread-attach can use the logic in
+	slime-read-port-and-connect.
+	(slime-thread-control-mode-map): Added key bindings for
+	slime-thread-kill, slime-thread-attach, slime-thread-debug and
+	slime-list-threads.
+	(slime-thread-kill, slime-thread-attach, slime-thread-debug): New
+	functions.
+
+	* swank-backend.lisp (kill-thread): Added to swank interface.
+
+	* swank-openmcl.lisp (kill-thread): Implement.
+
+	* swank.lisp (start-server): Add optional background argument,
+	defaults to *swank-background*.
+	(lookup-thread-by-id): New function.
+	(debug-thread): New function.
+	
 2004-02-26  Peter Seibel  <peter at javamonkey.com>
 
 	* slime.el (slime-draw-connection-list): Use text-properties to


Index: slime/slime.el
diff -u slime/slime.el:1.222 slime/slime.el:1.223
--- slime/slime.el:1.222	Thu Feb 26 17:31:13 2004
+++ slime/slime.el	Fri Feb 27 07:32:06 2004
@@ -985,6 +985,9 @@
 (defun slime-read-port-and-connect (&optional retries)
   "Connect to a running Swank server."
   (slime-start-swank-server)
+  (slime-read-port-and-connect-to-running-swank retries))
+
+(defun slime-read-port-and-connect-to-running-swank (retries)
   (lexical-let ((retries (or retries slime-swank-connection-retries))
                 (attempt 0))
     (labels
@@ -4683,12 +4686,38 @@
     (set (make-local-variable 'truncate-lines) t)))
 
 (slime-define-keys slime-thread-control-mode-map
+  ("a"         'slime-thread-attach)
+  ("d"         'slime-thread-debug)
+  ("g"         'slime-list-threads)
+  ("k"         'slime-thread-kill)
   ((kbd "RET") 'slime-thread-goahead)
   ("q"         'slime-thread-quit))
 
 (defun slime-thread-quit ()
   (interactive)
   (kill-buffer (current-buffer)))
+
+(defun slime-thread-kill ()
+  (interactive)
+  (slime-eval `(swank::kill-thread (swank::lookup-thread-by-id ,(get-text-property (point) 'thread-id))))
+  (call-interactively 'slime-list-threads))
+
+(defun slime-thread-attach ()
+  (interactive)
+  (slime-eval-async `(swank::interrupt-thread
+                      (swank::lookup-thread-by-id ,(get-text-property (point) 'thread-id))
+                      (cl:lambda ()
+                        (swank::start-server ,(slime-swank-port-file) nil)))
+                    (slime-buffer-package)
+                    (lambda (v)
+                      nil))
+  (slime-read-port-and-connect-to-running-swank nil))
+
+(defun slime-thread-debug ()
+  (interactive)
+  (slime-eval-async `(swank::debug-thread ,(get-text-property (point) 'thread-id))
+                    (slime-buffer-package)
+                    (lambda (v) nil)))
 
 
 ;;;;; Connection listing


Index: slime/swank-backend.lisp
diff -u slime/swank-backend.lisp:1.33 slime/swank-backend.lisp:1.34
--- slime/swank-backend.lisp:1.33	Thu Feb 26 02:17:10 2004
+++ slime/swank-backend.lisp	Fri Feb 27 07:32:06 2004
@@ -587,6 +587,11 @@
 (definterface interrupt-thread (thread fn)
   "Cause THREAD to execute FN.")
 
+(definterface kill-thread (thread)
+  "Kill THREAD."
+  (declare (ignore thread))
+  nil)
+
 (definterface send (thread object)
   "Send OBJECT to thread THREAD.")
 


Index: slime/swank-openmcl.lisp
diff -u slime/swank-openmcl.lisp:1.65 slime/swank-openmcl.lisp:1.66
--- slime/swank-openmcl.lisp:1.65	Thu Feb 26 13:38:00 2004
+++ slime/swank-openmcl.lisp	Fri Feb 27 07:32:06 2004
@@ -627,6 +627,9 @@
 (defimplementation all-threads ()
   (ccl:all-processes))
 
+(defimplementation kill-thread (thread)
+  (ccl:process-kill thread))
+
 (defimplementation interrupt-thread (thread fn)
   (ccl:process-interrupt thread fn))
 


Index: slime/swank.lisp
diff -u slime/swank.lisp:1.127 slime/swank.lisp:1.128
--- slime/swank.lisp:1.127	Thu Feb 26 02:13:01 2004
+++ slime/swank.lisp	Fri Feb 27 07:32:06 2004
@@ -156,9 +156,9 @@
 (defvar *swank-in-background* nil)
 (defvar *log-events* nil)
 
-(defun start-server (port-file)
+(defun start-server (port-file &optional (background *swank-in-background*))
   (setup-server 0 (lambda (port) (announce-server-port port-file port))
-                *swank-in-background*))
+                background))
                      
 (defun create-swank-server (&optional (port +server-port+)
                             (background *swank-in-background*)
@@ -1518,6 +1518,32 @@
 
 (defslimefun quit-thread-browser ()
   (setq *thread-list* nil))
+
+(defun lookup-thread-by-id (id)
+  (nth id (all-threads)))
+
+(defun debug-thread (thread-id)
+  (interrupt-thread (lookup-thread-by-id thread-id)
+                    (let ((pack *package*))
+                      (lambda ()
+                        (catch 'slime-toplevel
+                          (let ((*debugger-hook* (lambda (c h)
+                                                   (declare (ignore h))
+                                                   ;; cut 'n paste from swank-debugger-hook
+                                                   (let ((*swank-debugger-condition* c)
+                                                         (*buffer-package* pack)
+                                                         (*package* pack)
+                                                         (*sldb-level* (1+ *sldb-level*))
+                                                         (*swank-state-stack* (cons :swank-debugger-hook *swank-state-stack*)))
+                                                     (force-user-output)
+                                                     (call-with-debugging-environment
+                                                      (lambda () (sldb-loop *sldb-level*)))))))
+                            (restart-case
+                                (error (make-condition 'simple-error
+                                                       :format-control "Interrupt from Emacs"))
+                              (un-interrupt ()
+                                :report "Abandon control of this thread."
+                                nil))))))))
 
 ;;; Local Variables:
 ;;; eval: (font-lock-add-keywords 'lisp-mode '(("(\\(defslimefun\\)\\s +\\(\\(\\w\\|\\s_\\)+\\)"  (1 font-lock-keyword-face) (2 font-lock-function-name-face))))




From Jazzmin13 at sbcglobal.net  Sat Feb 28 01:28:02 2004
From: Jazzmin13 at sbcglobal.net (Damera Dagen)
Date: Sat, 28 Feb 2004 02:28:02 +0100
Subject: [slime-cvs] Re: Payment Due, account
Message-ID: <440391947670.2310.QRQN>

An HTML attachment was scrubbed...
URL: <https://mailman.common-lisp.net/pipermail/slime-cvs/attachments/20040228/3358df80/attachment.html>

From heller at common-lisp.net  Sat Feb 28 09:06:50 2004
From: heller at common-lisp.net (Helmut Eller)
Date: Sat, 28 Feb 2004 04:06:50 -0500
Subject: [slime-cvs] CVS update: slime/swank.lisp 
Message-ID: <E1Ax0Qs-0006WQ-00@common-lisp.net>

Update of /project/slime/cvsroot/slime
In directory common-lisp.net:/tmp/cvs-serv25066

Modified Files:
	swank.lisp 
Log Message:
(*initial-pprint-dispatch-table*, *arglist-pprint-dispatch-table*):
Workaround for bug in CLISP. Don't supply nil as argument to
copy-pprint-dispatch.

(print-cons-argument): Insert a space after the car.

Date: Sat Feb 28 04:06:50 2004
Author: heller

Index: slime/swank.lisp
diff -u slime/swank.lisp:1.128 slime/swank.lisp:1.129
--- slime/swank.lisp:1.128	Fri Feb 27 07:32:06 2004
+++ slime/swank.lisp	Sat Feb 28 04:06:50 2004
@@ -340,11 +340,8 @@
 (defun interrupt-worker-thread (thread)
   (let ((thread (etypecase thread
                   ((member t) (cdr (car *active-threads*)))
-                  (fixnum (lookup-thread-id thread))))
-        (hook #'swank-debugger-hook))
-    (interrupt-thread thread (lambda ()
-			       (let ((*debugger-hook* hook))
-				 (simple-break))))))
+                  (fixnum (lookup-thread-id thread)))))
+    (interrupt-thread thread #'simple-break)))
 
 (defun dispatch-event (event socket-io)
   (log-event "DISPATCHING: ~S~%" event)
@@ -697,11 +694,12 @@
 ;;; cover cases like (&key (function #'cons) (quote 'quote)).  Too
 ;;; much code for such a minor feature?
 
-(defvar *initial-pprint-dispatch-table* (copy-pprint-dispatch nil))
+(defvar *initial-pprint-dispatch-table* (copy-pprint-dispatch))
 
 (defun print-cons-argument (stream object)
   (pprint-logical-block (stream object :prefix "(" :suffix ")")
     (princ (car object) stream)
+    (write-char #\space stream)
     (let ((*print-pprint-dispatch* *initial-pprint-dispatch-table*))
       (pprint-fill stream (cdr object) nil))))
 
@@ -710,7 +708,7 @@
     (princ object stream)))
 
 (defvar *arglist-pprint-dispatch-table* 
-  (let ((table (copy-pprint-dispatch nil)))
+  (let ((table (copy-pprint-dispatch)))
     (set-pprint-dispatch 'cons #'print-cons-argument 0 table)
     (set-pprint-dispatch 'symbol #'print-symbol-argument 0 table)
     table))




From heller at common-lisp.net  Sat Feb 28 09:11:23 2004
From: heller at common-lisp.net (Helmut Eller)
Date: Sat, 28 Feb 2004 04:11:23 -0500
Subject: [slime-cvs] CVS update: slime/slime.el 
Message-ID: <E1Ax0VH-0003ys-00@common-lisp.net>

Update of /project/slime/cvsroot/slime
In directory common-lisp.net:/tmp/cvs-serv15264

Modified Files:
	slime.el 
Log Message:
(slime-compilation-finished-hook): New hook variable.
(slime-compilation-finished): Call it.
(slime-maybe-show-xrefs-for-notes): New function.

(slime-make-default-connection): Use the current connection.

(slime-connection-at-point): New function.
(slime-goto-connection, slime-connection-list-make-default): Use it.
(slime-draw-connection-list): Minor cleanups.

Define selectors for t and c for thread and connection list.



Date: Sat Feb 28 04:11:23 2004
Author: heller

Index: slime/slime.el
diff -u slime/slime.el:1.223 slime/slime.el:1.224
--- slime/slime.el:1.223	Fri Feb 27 07:32:06 2004
+++ slime/slime.el	Sat Feb 28 04:11:23 2004
@@ -255,6 +255,12 @@
 (def-sldb-face local-value "local variable values")
 (def-sldb-face catch-tag "catch tags")
 
+(defcustom slime-compilation-finished-hook '() 
+  "Hook called with a list of compiler notes after a compilation."
+  :group 'slime
+  :type 'hook
+  :options '(slime-list-compiler-notes slime-maybe-show-xrefs-for-notes))
+  
 
 ;;; Minor modes
 
@@ -1284,9 +1290,9 @@
              (slime-lisp-implementation-type-name))))
 
 (defun slime-make-default-connection ()
-  "Make the current buffer connection the default connection."
+  "Make the current connection the default connection."
   (interactive)
-  (slime-select-connection slime-buffer-connection)
+  (slime-select-connection (slime-connection))
   (message "Connection #%S (%s) now default SLIME connection."
            (slime-connection-number)
            (slime-lisp-implementation-type-name)))
@@ -2304,7 +2310,7 @@
     (slime-eval-async
      `(swank:swank-compile-file ,lisp-filename ,(if load t nil))
      nil
-     (slime-compilation-finished-continuation t))
+     (slime-compilation-finished-continuation))
     (message "Compiling %s.." lisp-filename)))
 
 (defun slime-find-asd ()
@@ -2329,7 +2335,7 @@
   (slime-eval-async
    `(swank:swank-load-system ,system-name)
    nil
-   (slime-compilation-finished-continuation t))
+   (slime-compilation-finished-continuation))
   (message "Compiling system %s.." system-name))
 
 (defun slime-compile-defun ()
@@ -2353,7 +2359,7 @@
   (slime-eval-async 
    `(swank:swank-compile-string ,string ,(buffer-name) ,start-offset)
    (slime-buffer-package)
-   (slime-compilation-finished-continuation nil)))
+   (slime-compilation-finished-continuation)))
 
 (defvar slime-hide-style-warning-count-if-zero t)
 
@@ -2413,25 +2419,18 @@
     (decf n))
   list)
 
-(defun slime-compilation-finished (result buffer show-notes-buffer)
+(defun slime-compilation-finished (result buffer)
   (let ((notes (slime-compiler-notes)))
     (with-current-buffer buffer
       (multiple-value-bind (result secs) result
         (slime-show-note-counts notes secs)
         (slime-highlight-notes notes)))
-    (when (and show-notes-buffer (slime-length> notes 0))
-      (slime-list-compiler-notes notes))
-    ;;(let ((xrefs (slime-xrefs-for-notes notes)))
-    ;;  (when (> (length xrefs) 1) ; >1 file
-    ;;    (slime-show-xrefs
-    ;;     xrefs 'definition "Compiler notes" (slime-buffer-package))))
-    ))
-
-(defun slime-compilation-finished-continuation (show-notes-buffer)
-  (lexical-let ((buffer (current-buffer))
-                (show-notes-buffer show-notes-buffer))
+    (run-hook-with-args 'slime-compiler-finished-hook notes)))
+
+(defun slime-compilation-finished-continuation ()
+  (lexical-let ((buffer (current-buffer)))
     (lambda (result) 
-      (slime-compilation-finished result buffer show-notes-buffer))))
+      (slime-compilation-finished result buffer))))
 
 (defun slime-highlight-notes (notes)
   "Highlight compiler notes, warnings, and errors in the buffer."
@@ -2457,7 +2456,17 @@
 
 ;;;;; Compiler notes list
 
+(defun slime-maybe-show-xrefs-for-notes (&optional notes)
+  "Show the compiler notes NOTES in a xref buffer if they come from
+more than one file."
+  (let* ((notes (or notes (slime-compiler-notes))) 
+         (xrefs (slime-xrefs-for-notes notes)))
+    (when (> (length xrefs) 1)          ; >1 file
+      (slime-show-xrefs
+       xrefs 'definition "Compiler notes" (slime-buffer-package)))))
+
 (defun slime-list-compiler-notes (&optional notes)
+  "Show the compiler notes NOTES in tree view."
   (interactive)
   (let ((notes (or notes (slime-compiler-notes))))
     (with-current-buffer (get-buffer-create "*compiler notes*")
@@ -4735,16 +4744,18 @@
   ("d"         'slime-connection-list-make-default)
   ("q"         'slime-temp-buffer-quit))
 
+(defun slime-connection-at-point ()
+  (or (get-text-property (point) 'slime-connection)
+      (error "No connection at point")))
+
 (defun slime-goto-connection ()
   (interactive)
-  (let ((slime-dispatching-connection 
-         (get-text-property (point) 'slime-connection)))
+  (let ((slime-dispatching-connection (slime-connection-at-point)))
     (slime-switch-to-output-buffer)))
 
 (defun slime-connection-list-make-default ()
   (interactive)
-  (let ((slime-dispatching-connection 
-         (get-text-property (point) 'slime-connection)))
+  (let ((slime-dispatching-connection (slime-connection-at-point))) 
     (slime-make-default-connection)
     (slime-draw-connection-list)))
 
@@ -4752,36 +4763,32 @@
   "Display a list of all connections."
   (interactive)
   (when (get-buffer "*SLIME connections*")
-    (kill-buffer  "*SLIME connections*"))
+    (kill-buffer "*SLIME connections*"))
   (slime-draw-connection-list))
 
 (defun slime-draw-connection-list ()
   (let ((default-pos nil))
     (slime-with-output-to-temp-buffer "*SLIME connections*"
       (slime-connection-list-mode)
-      (let ((default (slime-connection)))
-        (insert
-         (format "%s%2s  %-7s  %-17s  %-7s %-s\n" " " "Nr" "Name" "Port" "Pid" "Type"))
+      (let ((default (slime-connection))
+            (fstring "%s%2s  %-7s  %-17s  %-7s %-s\n"))
         (insert
-         (format "%s%2s  %-7s  %-17s  %-7s %-s\n" " " "--" "----" "----" "---" "----"))
+         (format fstring " " "Nr" "Name" "Port" "Pid" "Type")
+         (format fstring " " "--" "----" "----" "---" "----"))
         (dolist (p (reverse slime-net-processes))
-          (let ((slime-dispatching-connection p)
-                (line-start (point)))
-            (if (eq default p) (setf default-pos line-start))
-            (insert
-             (slime-with-connection-buffer (p)
-               (format "%s%2d  %-7s  %-17s  %-7s %-s\n"
-                       (if (eq default p) "*" " ")
-                       (slime-connection-number)
-                       (slime-lisp-implementation-type-name)
-                       (or (process-id p) (process-contact p))
-                       (slime-pid)
-                       (slime-lisp-implementation-type))))
-            (add-text-properties line-start (point) (list 'slime-connection p))))))
-    (with-current-buffer (get-buffer "*SLIME connections*")
+          (when (eq default p) (setf default-pos (point)))
+          (slime-insert-propertized 
+           (list 'slime-connection p)
+           (format fstring
+                   (if (eq default p) "*" " ")
+                   (slime-connection-number p)
+                   (slime-lisp-implementation-type-name p)
+                   (or (process-id p) (process-contact p))
+                   (slime-pid p)
+                   (slime-lisp-implementation-type p))))))
+    (with-current-buffer "*SLIME connections*"
       (goto-char default-pos))))
 
-
 
 ;;; Inspector
 
@@ -4967,6 +4974,16 @@
 (def-slime-selector-method ?e
   "the most recently visited emacs-lisp-mode buffer."
   (slime-recently-visited-buffer 'emacs-lisp-mode))
+
+(def-slime-selector-method ?c
+  "the SLIME connections buffer."
+  (slime-list-connections)
+  "*SLIME connections*")
+
+(def-slime-selector-method ?t
+  "the SLIME threads buffer."
+  (slime-list-threads)
+  "*slime-threads*")
 
 (defun slime-recently-visited-buffer (mode)
   "Return the most recently visited buffer whose major-mode is MODE.




From heller at common-lisp.net  Sat Feb 28 09:13:27 2004
From: heller at common-lisp.net (Helmut Eller)
Date: Sat, 28 Feb 2004 04:13:27 -0500
Subject: [slime-cvs] CVS update: slime/ChangeLog 
Message-ID: <E1Ax0XH-00054h-00@common-lisp.net>

Update of /project/slime/cvsroot/slime
In directory common-lisp.net:/tmp/cvs-serv19495

Modified Files:
	ChangeLog 
Log Message:
*** empty log message ***
Date: Sat Feb 28 04:13:27 2004
Author: heller

Index: slime/ChangeLog
diff -u slime/ChangeLog:1.272 slime/ChangeLog:1.273
--- slime/ChangeLog:1.272	Fri Feb 27 07:32:06 2004
+++ slime/ChangeLog	Sat Feb 28 04:13:26 2004
@@ -1,3 +1,21 @@
+2004-02-28  Helmut Eller  <e9626484 at stud3.tuwien.ac.at>
+
+	* slime.el (slime-compilation-finished-hook): New hook variable.
+	(slime-compilation-finished): Call it.
+	(slime-maybe-show-xrefs-for-notes): New function.
+	(slime-make-default-connection): Use the current connection.
+	(slime-connection-at-point): New function.
+	(slime-goto-connection, slime-connection-list-make-default): Use
+	it.
+	(slime-draw-connection-list): Minor cleanups.
+
+	Define selectors for t and c for thread and connection list.
+
+	* swank.lisp: (*initial-pprint-dispatch-table*)
+	(*arglist-pprint-dispatch-table*): Workaround for bug in
+	CLISP. Don't supply nil as argument to copy-pprint-dispatch.
+	(print-cons-argument): Insert a space after the car.
+
 2004-02-27  Marco Baringer  <mb at bese.it>
 
 	* slime.el (slime-read-port-and-connect,




From heller at common-lisp.net  Sun Feb 29 08:59:28 2004
From: heller at common-lisp.net (Helmut Eller)
Date: Sun, 29 Feb 2004 03:59:28 -0500
Subject: [slime-cvs] CVS update: slime/swank.lisp 
Message-ID: <E1AxMnI-000224-00@common-lisp.net>

Update of /project/slime/cvsroot/slime
In directory common-lisp.net:/tmp/cvs-serv7713

Modified Files:
	swank.lisp 
Log Message:
(format-arglist): Don't use custom pprint table.  Didn't work with
CLISP and the behavior was different in SBCL and Lispworks.

(completions): Factorize.
(parse-completion-arguments, format-completion-set,
(completion-set, find-matching-symbols, find-completions): New functions.
(simple-completions): New function.
(prefix-match-p) New function.

Date: Sun Feb 29 03:59:28 2004
Author: heller

Index: slime/swank.lisp
diff -u slime/swank.lisp:1.129 slime/swank.lisp:1.130
--- slime/swank.lisp:1.129	Sat Feb 28 04:06:50 2004
+++ slime/swank.lisp	Sun Feb 29 03:59:28 2004
@@ -687,32 +687,6 @@
     (cond (package (values symbol package))
           (t (error "Unknown symbol: ~S [in ~A]" string default-package)))))
 
-;;; We use a special pprint-dispatch table for printing the arglist.
-;;; An argument is either a symbol or a list.  The name of the
-;;; argument is PRINCed but the other components of an argument
-;;; --default value or type-- are PPRINTed.  We do this to nicely
-;;; cover cases like (&key (function #'cons) (quote 'quote)).  Too
-;;; much code for such a minor feature?
-
-(defvar *initial-pprint-dispatch-table* (copy-pprint-dispatch))
-
-(defun print-cons-argument (stream object)
-  (pprint-logical-block (stream object :prefix "(" :suffix ")")
-    (princ (car object) stream)
-    (write-char #\space stream)
-    (let ((*print-pprint-dispatch* *initial-pprint-dispatch-table*))
-      (pprint-fill stream (cdr object) nil))))
-
-(defun print-symbol-argument (stream object)
-  (let ((*print-pprint-dispatch* *initial-pprint-dispatch-table*))
-    (princ object stream)))
-
-(defvar *arglist-pprint-dispatch-table* 
-  (let ((table (copy-pprint-dispatch)))
-    (set-pprint-dispatch 'cons #'print-cons-argument 0 table)
-    (set-pprint-dispatch 'symbol #'print-symbol-argument 0 table)
-    table))
-
 (defun format-arglist (function-name lambda-list-fn)
   "Use LAMBDA-LIST-FN to format the arglist for FUNCTION-NAME.
 Call LAMBDA-LIST-FN with the symbol corresponding to FUNCTION-NAME."
@@ -723,11 +697,9 @@
           (values (funcall lambda-list-fn symbol))))
     (cond (condition (format nil "(-- ~A)" condition))
           (t (let ((*print-case* :downcase)
-                   (*print-pprint-dispatch* *arglist-pprint-dispatch-table*)
                    (*print-level* nil)
                    (*print-length* nil))
-               (with-output-to-string (stream)
-                 (pprint-fill stream arglist)))))))
+               (princ-to-string arglist))))))
 
 
 ;;;; Debugger
@@ -1068,6 +1040,50 @@
         (find-package (case-convert n))
         *buffer-package*)))
 
+(defun parse-completion-arguments (string default-package-name)
+  (multiple-value-bind (name package-name internal-p)
+      (tokenize-symbol-designator string)
+    (let ((package (carefully-find-package package-name default-package-name)))
+      (values name package-name package internal-p))))
+
+(defun format-completion-set (symbols internal-p package-name)
+  (mapcar (lambda (s)
+            (cond (internal-p 
+                   (format nil "~A::~A" package-name s))
+                  (package-name 
+                   (format nil "~A:~A" package-name s))
+                  (t
+                   (format nil "~A" s))))
+          (remove-duplicates (sort symbols #'string< :key #'symbol-name))))
+
+(defun find-matching-symbols (string package external matchp)
+  (let ((completions '()))
+    (flet ((symbol-matches-p (symbol)
+             (and (funcall matchp string (symbol-name symbol))
+                  (or (not external)
+                      (symbol-external-p symbol package)))))
+      (do-symbols (symbol package)
+        (when (symbol-matches-p symbol)
+          (push symbol completions))))
+    completions))
+
+(defun completion-set (string default-package-name matchp)
+  (declare (type simple-base-string string))
+  (multiple-value-bind (name package-name package internal-p)
+      (parse-completion-arguments string default-package-name)
+    (let ((completions (and package
+                            (find-matching-symbols name package
+                                                   (and (not internal-p)
+                                                        package-name)
+                                                   matchp)))
+          (*print-case* (if (find-if #'upper-case-p string)
+                            :upcase :downcase)))
+      (format-completion-set completions internal-p package-name))))
+
+(defun find-completions (string default-package-name matchp)
+  (let ((completion-set (completion-set string default-package-name matchp)))
+    (list completion-set (longest-completion completion-set))))
+
 (defslimefun completions (string default-package-name)
   "Return a list of completions for a symbol designator STRING.  
 
@@ -1086,35 +1102,11 @@
   FOO      - Symbols with matching prefix and accessible in the buffer package.
   PKG:FOO  - Symbols with matching prefix and external in package PKG.
   PKG::FOO - Symbols with matching prefix and accessible in package PKG."
-  (declare (type simple-base-string string))
-  (multiple-value-bind (name package-name internal-p)
-      (tokenize-symbol-designator string)
-    (let ((package (carefully-find-package package-name default-package-name))
-          (completions nil))
-      (flet ((symbol-matches-p (symbol)
-               (and (compound-prefix-match name (symbol-name symbol))
-                    (or internal-p 
-                        (null package-name)
-                        (symbol-external-p symbol package)))))
-        (when package 
-          (do-symbols (symbol package)
-            (when (symbol-matches-p symbol)
-              (push symbol completions)))))
-      (let ((*print-case* (if (find-if #'upper-case-p string)
-                              :upcase :downcase)))
-        (let ((completion-set
-               (mapcar (lambda (s)
-                         (cond (internal-p 
-                                (format nil "~A::~A" package-name s))
-                               (package-name 
-                                (format nil "~A:~A" package-name s))
-                               (t
-                                (format nil "~A" s))))
-                       ;; DO-SYMBOLS can consider the same symbol more than
-                       ;; once, so remove duplicates.
-                       (remove-duplicates (sort completions #'string<
-                                                :key #'symbol-name)))))
-          (list completion-set (longest-completion completion-set)))))))
+  (find-completions string default-package-name #'compound-prefix-match))
+
+(defslimefun simple-completions (string default-package-name)
+  "Return a list of completions for a symbol designator STRING."
+  (find-completions string default-package-name #'prefix-match-p))
 
 (defun tokenize-symbol-designator (string)
   "Parse STRING as a symbol designator.
@@ -1160,6 +1152,10 @@
                         (char-equal ch (aref target tpos))))
         do (incf tpos)))
 
+(defun prefix-match-p (prefix string)
+  "Return true if PREFIX is a prefix of STRING."
+  (eql (search prefix string :test #'char-equal) 0))
+
 
 ;;;;; Extending the input string by completion
 
@@ -1206,14 +1202,12 @@
 (defslimefun apropos-list-for-emacs  (name &optional external-only package)
   "Make an apropos search for Emacs.
 The result is a list of property lists."
-  (mapcan (listify #'briefly-describe-symbol-for-emacs)
-          (sort (apropos-symbols name
-                                 external-only
-                                 (if package
-                                     (or (find-package (read-from-string package))
-                                         (error "No such package: ~S" package))
-                                     nil))
-                #'present-symbol-before-p)))
+  (let ((package (if package
+                     (or (find-package (read-from-string package))
+                         (error "No such package: ~S" package)))))
+    (mapcan (listify #'briefly-describe-symbol-for-emacs)
+            (sort (apropos-symbols name external-only package)
+                  #'present-symbol-before-p))))
 
 (defun briefly-describe-symbol-for-emacs (symbol)
   "Return a property list describing SYMBOL.




From heller at common-lisp.net  Sun Feb 29 09:05:05 2004
From: heller at common-lisp.net (Helmut Eller)
Date: Sun, 29 Feb 2004 04:05:05 -0500
Subject: [slime-cvs] CVS update: slime/slime.el 
Message-ID: <E1AxMsj-0003lc-00@common-lisp.net>

Update of /project/slime/cvsroot/slime
In directory common-lisp.net:/tmp/cvs-serv14464

Modified Files:
	slime.el 
Log Message:
(slime-complete-symbol): Make slime-complete-symbol customizable.  I
don't understand how the ILISP style completion is supposed to work,
and find it unintuitive.  
(slime-complete-symbol-function): New variable.
(slime-complete-symbol*): New function.
(slime-simple-complete-symbol, slime-simple-completions): New function.

(slime-compiler-notes-to-tree): Return a list of trees, not single
tree.
Date: Sun Feb 29 04:05:05 2004
Author: heller

Index: slime/slime.el
diff -u slime/slime.el:1.224 slime/slime.el:1.225
--- slime/slime.el:1.224	Sat Feb 28 04:11:23 2004
+++ slime/slime.el	Sun Feb 29 04:05:05 2004
@@ -260,6 +260,12 @@
   :group 'slime
   :type 'hook
   :options '(slime-list-compiler-notes slime-maybe-show-xrefs-for-notes))
+
+(defcustom slime-complete-symbol-function 'slime-complete-symbol*
+  "Function to perform symbol completion."
+  :group 'slime
+  :type 'function
+  :options '(slime-complete-symbol* slime-simple-complete-symbol))
   
 
 ;;; Minor modes
@@ -2425,7 +2431,7 @@
       (multiple-value-bind (result secs) result
         (slime-show-note-counts notes secs)
         (slime-highlight-notes notes)))
-    (run-hook-with-args 'slime-compiler-finished-hook notes)))
+    (run-hook-with-args 'slime-compilation-finished-hook notes)))
 
 (defun slime-compilation-finished-continuation ()
   (lexical-let ((buffer (current-buffer)))
@@ -2472,7 +2478,9 @@
     (with-current-buffer (get-buffer-create "*compiler notes*")
       (let ((inhibit-read-only t))
         (erase-buffer)
-        (slime-tree-insert (slime-compiler-notes-to-tree notes) ""))
+        (dolist (tree (slime-compiler-notes-to-tree notes))
+          (slime-tree-insert tree "")
+          (insert "\n")))
       (slime-compiler-notes-mode)
       (setq buffer-read-only t)
       (make-local-variable 'slime-compiler-notes-saved-window-configuration)
@@ -2525,13 +2533,11 @@
                    :collapsed-p collapsed-p))
 
 (defun slime-compiler-notes-to-tree (notes)
-  (let ((kids (let* ((alist (slime-alistify notes #'slime-note.severity #'eq))
-                     (collapsed-p (slime-length> alist 1)))
-                (loop for (severity . notes) in alist
-                      collect (slime-tree-for-severity severity notes 
-                                                       collapsed-p)))))
-    (make-slime-tree :item (format "All (%d)"  (length notes))
-                     :kids kids :collapsed-p nil)))
+  (let* ((alist (slime-alistify notes #'slime-note.severity #'eq))
+         (collapsed-p (slime-length> alist 1)))
+    (loop for (severity . notes) in alist
+          collect (slime-tree-for-severity severity notes 
+                                           collapsed-p))))
 
 (defvar slime-compiler-notes-mode-map)
 
@@ -2607,7 +2613,8 @@
   (loop for (elt . rest) on list 
 	do (cond (rest
 		  (insert prefix " |")
-		  (slime-tree-insert elt (concat prefix " |")))
+		  (slime-tree-insert elt (concat prefix " |"))
+                  (insert "\n"))
 		 (t
 		  (insert prefix " `")
 		  (slime-tree-insert elt (concat prefix "  "))))))
@@ -2628,17 +2635,18 @@
 (defun slime-tree-insert (tree prefix)
   "Insert TREE prefixed with PREFIX at point."
   (with-struct (slime-tree. print-fn kids collapsed-p start-mark end-mark) tree
-    (setf start-mark (point-marker))
-    (slime-tree-insert-decoration tree)
-    (funcall print-fn tree)
-    (slime-tree-indent-item start-mark (point) (concat prefix "   "))
-    (let ((end (point)))
-      (terpri (current-buffer))
-      (add-text-properties start-mark end (list 'slime-tree tree)))
-    (when (and kids (not collapsed-p))
-      (slime-tree-insert-list kids prefix))
-    (setf (slime-tree.prefix tree) prefix)
-    (setf end-mark (point-marker))))
+    (let ((line-start (line-beginning-position)))
+      (setf start-mark (point-marker))
+      (slime-tree-insert-decoration tree)
+      (funcall print-fn tree)
+      (slime-tree-indent-item start-mark (point) (concat prefix "   "))
+      (add-text-properties line-start (point) (list 'slime-tree tree))
+      (set-marker-insertion-type start-mark t)
+      (when (and kids (not collapsed-p))
+        (terpri (current-buffer))
+        (slime-tree-insert-list kids prefix))
+      (setf (slime-tree.prefix tree) prefix)
+      (setf end-mark (point-marker)))))
 
 (defun slime-tree-at-point ()
   (cond ((get-text-property (point) 'slime-tree))
@@ -2654,9 +2662,8 @@
   (with-struct (slime-tree. collapsed-p start-mark end-mark prefix) tree
     (setf collapsed-p (not collapsed-p))
     (slime-tree-delete tree)
-    (goto-char end-mark)
-    (insert-before-markers " ") ; keep markers separated
-    (backward-char)
+    (insert-before-markers " ") ; move parent's end-mark
+    (backward-char 1)
     (slime-tree-insert tree prefix)
     (delete-char 1)
     (goto-char start-mark)))
@@ -3231,13 +3238,17 @@
      ;; errors propagate.
      (message "Error in slime-complete-forget-window-configuration: %S" err))))
   
-(defun* slime-complete-symbol ()
+(defun slime-complete-symbol ()
   "Complete the symbol at point.
 If the symbol lacks an explicit package prefix, the current buffer's
 package is used."
+  (interactive)
+  (funcall slime-complete-symbol-function))
+
+(defun slime-complete-symbol* ()
+  "Expand abbreviations and complete the symbol at point."
   ;; NB: It is only the name part of the symbol that we actually want
   ;; to complete -- the package prefix, if given, is just context.
-  (interactive)
   (when (save-excursion (re-search-backward "\"[^ \t\n]+\\=" nil t))
     (return-from slime-complete-symbol (comint-dynamic-complete-as-filename)))
   (let* ((end (move-marker (make-marker) (slime-symbol-end-pos)))
@@ -3272,6 +3283,33 @@
                (with-output-to-temp-buffer "*Completions*"
                  (display-completion-list completion-set))
                (slime-complete-delay-restoration)))))))
+
+(defun* slime-simple-complete-symbol ()
+  "Complete the symbol at point.  
+Perform completion more similar to Emacs' complete-symbol."
+  (when (save-excursion (re-search-backward "\"[^ \t\n]+\\=" nil t))
+    (return-from slime-complete-symbol (comint-dynamic-complete-as-filename)))
+  (let* ((end (point))
+         (beg (slime-symbol-start-pos))
+         (prefix (buffer-substring-no-properties beg end)))
+    (destructuring-bind (completion-set completed-prefix)
+        (slime-simple-completions prefix)
+      (if (null completion-set)
+          (progn (slime-minibuffer-respecting-message
+                  "Can't find completion for \"%s\"" prefix)
+                 (ding)
+                 (slime-complete-restore-window-configuration))
+        (insert-and-inherit (substring completed-prefix (length prefix)))
+        (cond ((= (length completion-set) 1)
+               (slime-minibuffer-respecting-message "Sole completion")
+               (slime-complete-restore-window-configuration))
+              ;; Incomplete
+              (t
+               (slime-minibuffer-respecting-message "Complete but not unique")
+               (slime-complete-maybe-save-window-configuration)
+               (with-output-to-temp-buffer "*Completions*"
+                 (display-completion-list completion-set))
+               (slime-complete-delay-restoration)))))))
         
 (defun slime-minibuffer-respecting-message (format &rest format-args)
   "Display TEXT as a message, without hiding any minibuffer contents."
@@ -3335,6 +3373,12 @@
 				    ,(or default-package
 					 (slime-find-buffer-package)
 					 (slime-buffer-package))))))
+
+(defun slime-simple-completions (prefix)
+  (slime-eval `(swank:simple-completions 
+                ,prefix 
+                ,(or (slime-find-buffer-package)
+                     (slime-buffer-package)))))
 
 
 ;;; Interpreting Elisp symbols as CL symbols (package qualifiers)




From heller at common-lisp.net  Sun Feb 29 09:07:07 2004
From: heller at common-lisp.net (Helmut Eller)
Date: Sun, 29 Feb 2004 04:07:07 -0500
Subject: [slime-cvs] CVS update: slime/ChangeLog 
Message-ID: <E1AxMuh-0005cQ-00@common-lisp.net>

Update of /project/slime/cvsroot/slime
In directory common-lisp.net:/tmp/cvs-serv21248

Modified Files:
	ChangeLog 
Log Message:
*** empty log message ***
Date: Sun Feb 29 04:07:07 2004
Author: heller

Index: slime/ChangeLog
diff -u slime/ChangeLog:1.273 slime/ChangeLog:1.274
--- slime/ChangeLog:1.273	Sat Feb 28 04:13:26 2004
+++ slime/ChangeLog	Sun Feb 29 04:07:07 2004
@@ -1,3 +1,25 @@
+2004-02-29  Helmut Eller  <e9626484 at stud3.tuwien.ac.at>
+
+	* slime.el (slime-complete-symbol): Make slime-complete-symbol
+	customizable.  I don't understand how the ILISP style completion
+	is supposed to work and find it unintuitive.
+	(slime-complete-symbol-function): New variable.
+	(slime-complete-symbol*): Renamed from slime-complete-symbol.
+	(slime-simple-complete-symbol, slime-simple-completions): New
+	function.
+	(slime-compiler-notes-to-tree): Return a list of trees, not a single
+	tree.
+
+	* swank.lisp (format-arglist): Don't use a custom pprint table.
+	Didn't work with CLISP and the behavior was different in SBCL and
+	Lispworks.
+	(completions): Factorize.
+	(parse-completion-arguments, format-completion-set,
+	(completion-set, find-matching-symbols, find-completions): New
+	functions.
+	(simple-completions): New function.
+	(prefix-match-p) New function.
+
 2004-02-28  Helmut Eller  <e9626484 at stud3.tuwien.ac.at>
 
 	* slime.el (slime-compilation-finished-hook): New hook variable.