[climacs-cvs] CVS climacs - climacs-cvs@common-lisp.net - mailman3.common-lisp.net

21 Jul 2006

Update of /project/climacs/cvsroot/climacs
In directory clnet:/tmp/cvs-serv7707
Modified Files:
    lisp-syntax.lisp 
Log Message:
Climacs will now check whether the current argument indices are valid
when figuring out which operator to display the arglist for. This
permits more intelligent display of arglists. For example (with "|"
being point):
(with-output-to-string (list |)
 )
Previously, Swine (and SLIME for that matter) would display the
arglist for `list', despite the fact that point is really in the
arguments for `with-output-to-string'. It it still not perfect, this,
for example, confuses it:
(with-input-from-string (with-output-to-string (list |)))

--- /project/climacs/cvsroot/climacs/lisp-syntax.lisp	2006/07/21 06:15:40	1.91
+++ /project/climacs/cvsroot/climacs/lisp-syntax.lisp	2006/07/21 09:09:43	1.92
@@ -3137,6 +3137,10 @@
 (defparameter +cl-garbage-keywords+
   '(&whole &environment))
+(defun arglist-keyword-p (arg)
+  "Return T if `arg' is an arglist keyword. NIL otherwise."
+  (member arg +cl-arglist-keywords+))
+
 (defun split-arglist-on-keywords (arglist)
   "Return an alist keying lambda list keywords of `arglist'
 to the symbols affected by the keywords."
@@ -3149,7 +3153,7 @@
       (push (subseq arglist 0 2) sing-result)
       (setf arglist (cddr arglist)))
     (do ((llk '(&mandatory &optional &key &allow-other-keys &aux &rest &body))
-         (args (if (member (first arglist) +cl-arglist-keywords+)
+         (args (if (arglist-keyword-p (first arglist))
                    arglist
                    (cons '&mandatory arglist))
                (cdr args))
@@ -3597,6 +3601,22 @@
         ((listp operator)
          (eq (first operator) 'cl:lambda))))
+(defun indices-match-arglist (arglist arg-indices)
+  "Check whether the argument indices `arg-indices' could refer
+  to a direct argument for the operator with the argument list
+  `arglist'. Returns T if they could, NIL otherwise. This
+  functions does not care about the argument quantity, only their
+  structure."
+  (let* ((index (first arg-indices))
+         (pure-arglist (remove-if #'arglist-keyword-p arglist))
+         (arg (when (< index (length pure-arglist))
+                (elt pure-arglist index))))
+    (if (and (not (null arg))
+             (listp arg)
+             (rest arg-indices))
+        (indices-match-arglist arg (rest arg-indices))
+        (null (rest arg-indices)))))
+
 (defmacro with-code-insight (mark syntax (&key operator preceding-operand
                                                form preceding-operand-indices
                                                operands)
@@ -3609,7 +3629,7 @@
         (operands-sym (or operands (gensym)))
         (form-sym (or form (gensym)))
         (operand-indices-sym (or preceding-operand-indices (gensym)))
-        ;; My kingdom for with-gensyms!
+        ;; My kingdom for with-gensyms (or once-only)!
         (mark-value-sym (gensym))
         (syntax-value-sym (gensym)))
     `(let* ((,mark-value-sym ,mark)
@@ -3626,12 +3646,18 @@
                ;; cannot find a form with a valid operator, just
                ;; return the form `mark' is in.
                (labels ((recurse (form)
-                          (if (valid-operator-p (form-operator
-                                                 form
-                                                 ,syntax-value-sym))
-                              form
-                              (when (and form (parent form))
-                                (recurse (parent form))))))
+                          (if (and (valid-operator-p (form-operator
+                                                      form
+                                                      ,syntax-value-sym))
+                                   (indices-match-arglist
+                                    (arglist (image syntax)
+                                             (form-operator
+                                              form
+                                              ,syntax-value-sym))
+                                    (second (multiple-value-list (find-operand-info ,mark-value-sym ,syntax-value-sym form)))))
+                              (or (when (and form (parent form))
+                                    (recurse (parent form)))
+                                  form))))
                  (or (recurse (when immediate-form (parent immediate-form)))
                      (when immediate-form (parent immediate-form))))))
             ;; If we cannot find a form, there's no point in looking
@@ -3643,15 +3669,15 @@
          ,@body))))
(defun show-arglist-for-form-at-mark (mark syntax)
-   "Display the argument list for the operator of `form'. The
+  "Display the argument list for the operator of `form'. The
 list need not be complete. If an argument list cannot be
 retrieved for the operator, nothing will be displayed."
   (with-code-insight mark syntax (:operator operator
                                             :preceding-operand preceding-operand
                                             :preceding-operand-indices preceding-operand-indices
                                             :operands operands)
-     (when (valid-operator-p operator) 
-       (show-arglist-silent operator preceding-operand-indices preceding-operand operands))))
+    (when (valid-operator-p operator) 
+      (show-arglist-silent operator preceding-operand-indices preceding-operand operands))))
;;; Definition editing

    