Update of /project/mcclim/cvsroot/mcclim/Drei In directory clnet:/tmp/cvs-serv1637/Drei

Modified Files: lisp-syntax.lisp packages.lisp Log Message: Some generalisations in Lisp syntax.

--- /project/mcclim/cvsroot/mcclim/Drei/lisp-syntax.lisp 2008/03/02 15:55:28 1.76 +++ /project/mcclim/cvsroot/mcclim/Drei/lisp-syntax.lisp 2008/05/03 09:12:25 1.77 @@ -1420,18 +1420,23 @@ `mark-or-offset' is returned." (form-toplevel syntax (expression-at-mark syntax mark-or-offset)))

-(defun list-at-mark (syntax mark-or-offset) - "Return the list form that `mark-or-offset' is inside, or NIL -if no such form exists." +(defun form-of-type-at-mark (syntax mark-or-offset test) + "Return the form that `mark-or-offset' is inside and for which +`test' returns true, or NIL if no such form exists." (as-offsets ((offset mark-or-offset)) (update-parse syntax) (let ((form-around (form-around syntax offset))) (when form-around - (if (and (form-list-p form-around) + (if (and (funcall test form-around) (> offset (start-offset form-around))) form-around (find-list-parent form-around))))))

+(defun list-at-mark (syntax mark-or-offset) + "Return the list form that `mark-or-offset' is inside, or NIL +if no such form exists." + (form-of-type-at-mark syntax mark-or-offset #'form-list-p)) + (defun symbol-at-mark (syntax mark-or-offset &optional (form-fetcher 'expression-at-mark)) "Return a symbol token at `mark-or-offset'. This function will @@ -2044,41 +2049,67 @@ nil (form-around-in-children syntax (children stack-top) offset))))))

+(defun find-parent-of-type (form test) + "Find a parent of `form' for which the function `test' is true +and return it. If a such a parent cannot be found, return nil." + (let ((parent (parent form))) + (cond ((null parent) + nil) + ((funcall test parent) + parent) + (t (find-parent-of-type parent test))))) + +(defun find-parent-of-type-offset (form test fn) + "Find a parent of `form' for which the function `test' is true +and return `fn' applied to this parent form. `Fn' should be a +function that returns an offset when applied to a +form (eg. `start-offset' or `end-offset'). If such a parent +cannot be found, return nil" + (let ((parent (find-parent-of-type form test))) + (when parent + (funcall fn parent)))) + +(defun find-child-of-type (form test) + "Find the first child of `form' for which the function `test' +is true and return it. If such a child cannot be found, return +nil." + (find-if #'(lambda (child) + (cond ((funcall test child) child) + ((formp child) (find-child-of-type child test)))) + (children form))) + +(defun find-child-of-type-offset (form test fn) + "Find the first child of `form' for which the function `test' is true and return `fn' applied to this child. +`Fn' should be a function that returns an offset when applied to +a form (eg. `start-offset' or `end-offset'). If such a child +cannot be found, return nil." + (let ((child (find-child-of-type form test))) + (when child + (funcall fn child)))) + (defun find-list-parent (form) "Find a list parent of `form' and return it. If a list parent cannot be found, return nil." - (let ((parent (parent form))) - (typecase parent - (list-form parent) - ((or form* null) nil) - (t (find-list-parent parent))))) + (find-parent-of-type form #'form-list-p))

(defun find-list-parent-offset (form fn) "Find a list parent of `form' and return `fn' applied to this parent token. `Fn' should be a function that returns an offset when applied to a token (eg. `start-offset' or `end-offset'). If a list parent cannot be found, return nil" - (let ((list-parent (find-list-parent form))) - (when list-parent - (funcall fn list-parent)))) + (find-parent-of-type-offset form #'form-list-p fn))

(defun find-list-child (form) "Find the first list child of `form' and return it. If a list child cannot be found, return nil." - (find-if #'(lambda (child) - (typecase child - (list-form child) - (form (find-list-child child)))) - (children form))) + (find-child-of-type form #'form-list-p))

(defun find-list-child-offset (form fn) "Find a list child of `form' and return `fn' applied to this child. `Fn' should be a function that returns an offset when applied to a form (eg. `start-offset' or `end-offset'). If a list child cannot be found, return nil." - (let ((list-child (find-list-child form))) - (when list-child - (funcall fn list-child)))) + (find-child-of-type-offset form #'form-list-p fn))

(defmethod backward-one-expression (mark (syntax lisp-syntax)) (update-parse syntax 0 (offset mark)) --- /project/mcclim/cvsroot/mcclim/Drei/packages.lisp 2008/02/15 13:16:17 1.53 +++ /project/mcclim/cvsroot/mcclim/Drei/packages.lisp 2008/05/03 09:12:25 1.54 @@ -562,6 +562,7 @@ #:find-list-parent #:expression-at-mark #:definition-at-mark + #:form-of-type-at-mark #:list-at-mark #:symbol-at-mark #:fully-quoted-form