[slime-cvs] CVS slime

[CVS User alendvai]

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

Modified Files:
	ChangeLog slime.el swank-backend.lisp swank.lisp 
Log Message:
Smarten up the label-value-line macros.

- support a :label emacs font property
- added key args: padding-length, display-nil-value, hide-when-nil, splice-as-ispec, value-text
- label-value-line* will evaluate and splice the result of the form after a @ character


--- /project/slime/cvsroot/slime/ChangeLog	2010/10/09 23:02:32	1.2150
+++ /project/slime/cvsroot/slime/ChangeLog	2010/10/15 22:42:14	1.2151
@@ -1,3 +1,22 @@
+2010-10-16  Attila Lendvai  <attila.lendvai at gmail.com>
+
+	* swank-fuzzy.lisp: speed up by 2-4 times (on sbcl).
+
+	* fuzzy.el: Clean up fuzzy completion's keymap code, drop
+	mimic-key-bindings.
+
+	* slime.el: Added separate host and port history for
+	slime-connect.
+	(slime-lookup-lisp-implementation): better error reporting and
+	allow using a functionp to generate the arguments.
+
+	* swank.lisp: Smarten up the label-value-line macros:
+	  - support a :label emacs font property
+	  - added key args: padding-length, display-nil-value,
+	    hide-when-nil, splice-as-ispec, value-text
+	  - label-value-line* will evaluate and splice the result
+	    of the form after a @ character
+
 2010-10-09  Raymond Toy  <toy.raymond at gmail.com>
 
 	* swank-cmucl.lisp (codepoint-length): Implement codepoint-length
--- /project/slime/cvsroot/slime/slime.el	2010/10/15 16:25:50	1.1346
+++ /project/slime/cvsroot/slime/slime.el	2010/10/15 22:42:14	1.1347
@@ -6463,6 +6463,8 @@
                  'mouse-face 'highlight
                  'face 'slime-inspector-value-face)
          (insert string)))
+      ((:label string)
+       (insert (slime-inspector-fontify label string)))
       ((:action string id)
        (slime-insert-propertized (list 'slime-action-number id
                                        'mouse-face 'highlight
--- /project/slime/cvsroot/slime/swank-backend.lisp	2010/10/09 23:02:33	1.203
+++ /project/slime/cvsroot/slime/swank-backend.lisp	2010/10/15 22:42:14	1.204
@@ -1053,17 +1053,45 @@
 
 ;;; Utilities for inspector methods.
 ;;; 
-
-(defun label-value-line (label value &key (newline t))
-  "Create a control list which prints \"LABEL: VALUE\" in the inspector.
-If NEWLINE is non-NIL a `(:newline)' is added to the result."
-  
-  (list* (princ-to-string label) ": " `(:value ,value)
-         (if newline '((:newline)) nil)))
+(defun label-value-line (label value &key padding-length display-nil-value hide-when-nil
+                               splice-as-ispec value-text (newline t))
+  "Create a control list which prints \"LABEL: VALUE\" in the inspector."
+  (if (or value (not hide-when-nil))
+      `((:label ,(princ-to-string label) ":")
+        ,@(when (or value display-nil-value)
+                (list " "))
+        ,@(when (and (or value display-nil-value)
+                     padding-length)
+                (list (make-array padding-length
+                                  :element-type 'character
+                                  :initial-element #\Space)))
+        ,@(when (or value display-nil-value)
+                (if splice-as-ispec
+                    (if (listp value) value (list value))
+                    `((:value ,value ,@(when value-text (list value-text))))))
+        ,@(if newline '((:newline)) nil))
+      (values)))
 
 (defmacro label-value-line* (&rest label-values)
-  ` (append ,@(loop for (label value) in label-values
-                    collect `(label-value-line ,label ,value))))
+  (let ((longest-label-length (loop
+                                 :for (label value) :in label-values
+                                 :maximize (if (stringp label)
+                                               (length label)
+                                               0))))
+  `(append ,@(loop
+                :for entry :in label-values
+                :if (and (consp entry)
+                         (not (consp (first entry)))
+                         (string= (first entry) '@))
+                  :appending (rest entry)
+                :else
+                  :collect (destructuring-bind
+                                 (label value &rest args &key &allow-other-keys) entry
+                             `(label-value-line ,label ,value
+                                                :padding-length ,(when (stringp label)
+                                                                       (- longest-label-length
+                                                                          (length label)))
+                                                , at args))))))
 
 (definterface describe-primitive-type (object)
   "Return a string describing the primitive type of object."
--- /project/slime/cvsroot/slime/swank.lisp	2010/10/08 09:03:24	1.731
+++ /project/slime/cvsroot/slime/swank.lisp	2010/10/15 22:42:14	1.732
@@ -3479,6 +3479,8 @@
               ((:newline) (list newline))
               ((:value obj &optional str) 
                (list (value-part obj str (istate.parts istate))))
+              ((:label &rest strs)
+               (list (list :label (apply #'concatenate 'string (mapcar #'string strs)))))
               ((:action label lambda &key (refreshp t)) 
                (list (action-part label lambda refreshp
                                   (istate.actions istate))))