[slime-cvs] CVS update: slime/ChangeLog slime/swank.lisp

[Peter Seibel]

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

Modified Files:
	ChangeLog swank.lisp 
Log Message:
Changing computation of package name used in REPL prompt.

Date: Fri Jul  9 11:09:18 2004
Author: pseibel

Index: slime/ChangeLog
diff -u slime/ChangeLog:1.465 slime/ChangeLog:1.466
--- slime/ChangeLog:1.465	Fri Jul  9 05:09:18 2004
+++ slime/ChangeLog	Fri Jul  9 11:09:18 2004
@@ -1,3 +1,14 @@
+2004-07-09  Peter Seibel  <peter at javamonkey.com>
+
+	* swank.lisp (package-string-for-prompt): Change the way package
+	name in prompt is computed. N.B. after this change the name
+	displayed will not necsarily be either an actual name or nickname
+	of the package: if the name contains dots by default the prompt
+	will only display the last element, i.e. COM.GIGAMONKEYS.SPAM will
+	be shown as SPAM. This change also makes CL-USER the canonical
+	name for COMMON-LISP-USER even in implementations that provide a
+	shorter nickname such as USER.
+
 2004-07-09  Christophe Rhodes  <csr21 at cam.ac.uk>
 
 	* slime.el (sldb-lookup-reference): substitute hyphens for spaces


Index: slime/swank.lisp
diff -u slime/swank.lisp:1.210 slime/swank.lisp:1.211
--- slime/swank.lisp:1.210	Wed Jul  7 08:09:33 2004
+++ slime/swank.lisp	Fri Jul  9 11:09:18 2004
@@ -54,6 +54,13 @@
 (defconstant keyword-package (find-package :keyword)
   "The KEYWORD package.")
 
+(defvar *canonical-packge-nicknames*
+  '(("COMMON-LISP-USER" . "CL-USER"))
+  "Canonical package names to use instead of shortest name/nickname.")
+
+(defvar *auto-abbreviate-dotted-packages* t
+  "Automatically abbreviate dotted package names to their last component when T.")
+
 (defvar *swank-io-package*
   (let ((package (make-package :swank-io-package :use '())))
     (import '(nil t quote) package)
@@ -1309,15 +1316,32 @@
                            (return (values values -)))))
       (when (and package-update-p (not (eq *package* *buffer-package*)))
         (send-to-emacs 
-         (list :new-package (shortest-package-nickname *package*)))))))
+         (list :new-package (package-string-for-prompt *package*)))))))
+
+(defun package-string-for-prompt (package)
+  "Return the shortest nickname (or canonical name) of PACKAGE."
+  (or (canonical-package-nickname package)
+      (auto-abbreviated-package-name package)
+      (shortest-package-nickname package)))
+
+(defun canonical-package-nickname (package)
+  "Return the canonical package nickname, if any, of PACKAGE."
+  (cdr (assoc (package-name package) *canonical-packge-nicknames* :test #'string=)))
+
+(defun auto-abbreviated-package-name (package)
+  "Return an abbreviated 'name' for PACKAGE. N.B. this is not an actual package name or nickname."
+  (when *auto-abbreviate-dotted-packages*
+    (let ((last-dot (position #\. (package-name package) :from-end t)))
+      (when last-dot (subseq (package-name package) (1+ last-dot))))))
 
 (defun shortest-package-nickname (package)
   "Return the shortest nickname (or canonical name) of PACKAGE."
   (loop for name in (cons (package-name package) (package-nicknames package))
         for shortest = name then (if (< (length name) (length shortest))
-                                     name
-                                     shortest)
-        finally (return shortest)))
+                                   name
+                                   shortest)
+              finally (return shortest)))
+
 
 (defslimefun interactive-eval-region (string)
   (with-buffer-syntax ()
@@ -1371,9 +1395,9 @@
     (swank-pprint (multiple-value-list (eval (read-from-string string))))))
 
 (defslimefun set-package (package)
-  "Set *package* to PACKAGE and return its name and shortest nickname."
+  "Set *package* to PACKAGE and return its name and the string to use in the prompt."
   (let ((p (setq *package* (guess-package-from-string package))))
-    (list (package-name p) (shortest-package-nickname p))))
+    (list (package-name p) (package-string-for-prompt p))))
 
 (defslimefun listener-eval (string)
   (clear-user-input)