Update of /project/climacs/cvsroot/climacs In directory clnet:/tmp/cvs-serv25727

Modified Files: lisp-syntax.lisp Log Message: More work on arglist intelligence. I think it works now. Please report any breakage.

--- /project/climacs/cvsroot/climacs/lisp-syntax.lisp 2006/07/21 09:09:43 1.92 +++ /project/climacs/cvsroot/climacs/lisp-syntax.lisp 2006/07/21 11:35:28 1.93 @@ -3551,18 +3551,21 @@ (worker (parent operand-form))))))))) (nreverse (worker operand-form t)))))

-(defun find-operand-info (mark syntax operator-form) - "Returns two values: The operand preceding `mark' and the path - from `operator-form' to the operand." - (let* ((preceding-arg-token (form-before syntax (offset mark))) +(defun find-operand-info (mark-or-offset syntax operator-form) + "Returns two values: The operand preceding `mark-or-offset' and + the path from `operator-form' to the operand." + (let* ((offset (if (numberp mark-or-offset) + mark-or-offset + (offset mark-or-offset))) + (preceding-arg-token (form-before syntax offset)) (indexing-start-arg (let* ((candidate-before preceding-arg-token) (candidate-after (when (null candidate-before) - (let ((after (form-after syntax (offset mark)))) + (let ((after (form-after syntax offset))) (when after (parent after))))) (candidate-around (when (null candidate-after) - (form-around syntax (offset mark)))) + (form-around syntax offset))) (candidate (or candidate-before candidate-after candidate-around))) @@ -3617,6 +3620,32 @@ (indices-match-arglist arg (rest arg-indices)) (null (rest arg-indices)))))

+(defun direct-arg-p (form syntax) + "Check whether `form' is a direct argument to one of its + parents." + (labels ((recurse (parent) + (let ((operator (form-operator + parent + syntax))) + (or (and + ;; An operator is not an argument to itself... + (not (= (start-offset form) + (start-offset (first-form (children parent))))) + (valid-operator-p operator) + (indices-match-arglist + (arglist (image syntax) + operator) + (second + (multiple-value-list + (find-operand-info + (start-offset form) + syntax + parent))))) + (when (parent parent) + (recurse (parent parent))))))) + (when (parent form) + (recurse (parent form))))) + (defmacro with-code-insight (mark syntax (&key operator preceding-operand form preceding-operand-indices operands) @@ -3645,21 +3674,25 @@ ;; regard to the structure of the lambda list. If we ;; cannot find a form with a valid operator, just ;; return the form `mark' is in. - (labels ((recurse (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)))))) + (unless (null immediate-form) + (labels ((recurse (form) + (unless (null form) + (if (and (valid-operator-p (form-operator + form + ,syntax-value-sym)) + (indices-match-arglist + (arglist (image ,syntax-value-sym) + (form-operator + form + ,syntax-value-sym)) + (second + (multiple-value-list + (find-operand-info ,mark-value-sym ,syntax-value-sym form))))) + (or (recurse (parent form)) + (unless (direct-arg-p form ,syntax-value-sym) + form)))))) + (or (recurse (parent immediate-form)) + immediate-form))))) ;; If we cannot find a form, there's no point in looking ;; up any of this stuff. (,operator-sym (when ,form-sym (form-operator ,form-sym ,syntax-value-sym)))