[slime-cvs] CVS update: slime/slime.el

Luke Gorrie lgorrie at common-lisp.net
Wed Jul 7 12:05:25 UTC 2004


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

Modified Files:
	slime.el 
Log Message:
(slime-alistify): Preserve order. This keeps the *compiler-notes*
right. Pointed out by Christophe Rhodes.

(slime-repl-update-banner-p): Renamed from slime-reply-..

(slime-changelog-date): Reintroduced for informational purposes.

(slime-repl-update-banner): Show ChangeLog date in the animation.

(slime-space): Do arglist lookup before inserting the space. Otherwise
we get a funky race condition: entering the space may trigger
`first-change-hook', which would send an async notification to Lisp,
which would put us in the 'busy' state and thus we wouldn't lookup the
arglist! Detective work by Edi Weitz.

(sldb-prune-initial-frames): More regexp fudgery :-(.

(read-directory-name): Use `file-name-as-directory' to ensure we have
the trailing / on the directory name.

(byte-compile-warnings): Bye-compile slime-alistify. Its inputs can be
pretty big.

Date: Wed Jul  7 05:05:24 2004
Author: lgorrie

Index: slime/slime.el
diff -u slime/slime.el:1.356 slime/slime.el:1.357
--- slime/slime.el:1.356	Sat Jul  3 20:21:43 2004
+++ slime/slime.el	Wed Jul  7 05:05:24 2004
@@ -122,7 +122,7 @@
 (defvar slime-space-information-p t
   "Whether the SPC key should offer information or not.")
 
-(defvar slime-reply-update-banner-p t
+(defvar slime-repl-update-banner-p t
   "Whether Slime should keep a repl banner updated or not.")
 
 (defvar slime-edit-definition-fallback-function nil
@@ -1235,6 +1235,26 @@
     (message "Initial handshake..." port)
     (slime-init-connection process)))
 
+(defun slime-changelog-date ()
+  "Return the datestring of the latest entry in the ChangeLog file.
+If the function is compiled (with the file-compiler) return the date
+of the newest at compile time.  If the function is interpreted read
+the ChangeLog file at runtime."
+  (macrolet ((date ()
+                   (let* ((dir (or (and (boundp 'byte-compile-current-file)
+                                        byte-compile-current-file
+                                        (file-name-directory
+                                         (file-truename
+                                          byte-compile-current-file)))
+                                   slime-path))
+                          (file (concat dir "ChangeLog"))
+                          (date (with-temp-buffer 
+                                  (insert-file-contents file nil 0 100)
+                                  (goto-char (point-min))
+                                  (symbol-name (read (current-buffer))))))
+                     `(quote ,date))))
+    (date)))
+
 (defun slime-disconnect ()
   "Disconnect all connections."
   (interactive)
@@ -1907,7 +1927,7 @@
                          (slime-pid)))
          ;; Emacs21 has the fancy persistent header-line.
          (use-header-p (and (boundp 'header-line-format) 
-                            slime-reply-update-banner-p))
+                            slime-repl-update-banner-p))
          ;; and dancing text
          (animantep (and (fboundp 'animate-string)
                          slime-startup-animation
@@ -1916,9 +1936,8 @@
       (setq header-line-format banner))
     (when animantep
       (pop-to-buffer (current-buffer))
-      (animate-string "; SLIME: The Superior Lisp Interaction Mode for Emacs"
-                      0 0))
-    (slime-repl-insert-prompt (if (or (not slime-reply-update-banner-p)
+      (animate-string (format "; SLIME %s" (slime-changelog-date)) 0 0))
+    (slime-repl-insert-prompt (if (or (not slime-repl-update-banner-p)
                                       use-header-p)
                                   ""
                                 (concat "; " banner)))))
@@ -3124,7 +3143,10 @@
 	(if probe
 	    (push e (cdr probe))
             (push (cons k (list e)) alist))))
-    alist))
+    ;; Put them back in order.
+    (loop for (key . value) in alist
+          collect (cons key (cons (car value)
+                                  (reverse (cdr value)))))))
 
 (defun slime-note.severity (note)
   (plist-get note :severity))
@@ -3686,20 +3708,21 @@
 Designed to be bound to the SPC key.  Prefix argument can be used to insert
 more than one space."
   (interactive "p")
-  (self-insert-command n)
-  (when (and slime-space-information-p
-             (slime-connected-p)
-	     (or (not (slime-busy-p))
-                 ;; XXX should we enable this?
-                 ;; (not slime-use-sigint-for-interrupt))
-                 ))
-    (let ((names (slime-enclosing-operator-names)))
-      (when names
-        (slime-eval-async 
-         `(swank:arglist-for-echo-area (quote ,names))
-         (slime-buffer-package)
-         (lambda (message)
-           (slime-background-message "%s" message)))))))
+  (unwind-protect 
+      (when (and slime-space-information-p
+                 (slime-connected-p)
+                 (or (not (slime-busy-p))
+                     ;; XXX should we enable this?
+                     ;; (not slime-use-sigint-for-interrupt))
+                     ))
+        (let ((names (slime-enclosing-operator-names)))
+          (when names
+            (slime-eval-async 
+             `(swank:arglist-for-echo-area (quote ,names))
+             (slime-buffer-package)
+             (lambda (message)
+               (slime-background-message "%s" message))))))
+    (self-insert-command n)))
 
 (defun slime-arglist (name)
   "Show the argument list for NAME."
@@ -5592,7 +5615,7 @@
 Regexp heuristics are used to avoid showing SWANK-internal frames."
   (or (loop for frame in frames
             for (number string) = frame
-            until (string-match "^(+\\(SWANK\\|swank\\)\\>" string)
+            until (string-match "^(*\\(SWANK\\|swank\\)\\>" string)
             collect frame)
       frames))
 
@@ -7478,7 +7501,7 @@
     (setq default-dirname
 	  (if initial (concat dir initial) default-directory)))
   (let ((file (read-file-name prompt dir default-dirname mustmatch initial)))
-    (setq file (expand-file-name file))
+    (setq file (file-name-as-directory (expand-file-name file)))
     (cond ((file-directory-p file)
            file)
           (t 
@@ -7517,7 +7540,8 @@
 (require 'bytecomp)
 (let ((byte-compile-warnings '()))
   (mapc #'byte-compile
-        '(slime-log-event
+        '(slime-alistify
+          slime-log-event
           slime-events-buffer
           slime-output-string 
           slime-output-buffer





More information about the slime-cvs mailing list