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

Modified Files: lisp-syntax.lisp Log Message: Fixed the `form-{before, after, around}-in-children' functions.

--- /project/climacs/cvsroot/climacs/lisp-syntax.lisp 2006/04/23 14:38:57 1.53 +++ /project/climacs/cvsroot/climacs/lisp-syntax.lisp 2006/04/23 15:04:52 1.54 @@ -1547,25 +1547,26 @@

(defun form-before-in-children (children offset) (loop for (first . rest) on children - unless (typep first 'comment) - do (cond ((< (start-offset first) offset (end-offset first)) - (return (if (null (children first)) - nil - (form-before-in-children (children first) offset)))) - ((and (>= offset (end-offset first)) - (or (null rest) - ;; `first-noncomment' may return NIL if there are nothing but - ;; comments left; in that case, just take a comment - ;; with `first'. - (<= offset (start-offset (or (first-noncomment rest) - (first rest)))))) - (return (let ((potential-form - (when (typep first 'list-form) - (form-before-in-children (children first) offset)))) - (or potential-form - (when (typep first 'form) - first))))) - (t nil)))) + if (typep first 'form) + do + (cond ((< (start-offset first) offset (end-offset first)) + (return (if (null (children first)) + nil + (form-before-in-children (children first) offset)))) + ((and (>= offset (end-offset first)) + (or (null (first-form rest)) + (<= offset (start-offset (first-form rest))))) + (return (let ((potential-form + (when (typep first 'list-form) + (form-before-in-children (children first) offset)))) + (if (not (null potential-form)) + (if (<= (end-offset first) + (end-offset potential-form)) + potential-form + first) + (when (typep first 'form) + first))))) + (t nil)))) (defun form-before (syntax offset) (with-slots (stack-top) syntax @@ -1576,17 +1577,21 @@

(defun form-after-in-children (children offset) (loop for child in children - unless (typep child 'comment) - do (cond ((< (start-offset child) offset (end-offset child)) - (return (if (null (children child)) - nil - (form-after-in-children (children child) offset)))) - ((<= offset (start-offset child)) - (return (let ((potential-form (form-after-in-children (children child) offset))) - (or potential-form - (when (typep child 'form) - child))))) - (t nil)))) + if (typep child 'form) + do (cond ((< (start-offset child) offset (end-offset child)) + (return (if (null (children child)) + nil + (form-after-in-children (children child) offset)))) + ((<= offset (start-offset child)) + (return (let ((potential-form (form-after-in-children (children child) offset))) + (if (not (null potential-form)) + (if (<= (start-offset child) + (start-offset potential-form)) + child + potential-form) + (when (typep child 'form) + child))))) + (t nil)))) (defun form-after (syntax offset) (with-slots (stack-top) syntax @@ -1597,13 +1602,15 @@ (defun form-around-in-children (children offset) (loop for child in children - unless (typep child 'comment) - do (cond ((< (start-offset child) offset (end-offset child)) - (return (if (null (children child)) + if (typep child 'form) + do (cond ((<= (start-offset child) offset (end-offset child)) + (return (if (null (first-form (children child))) (when (typep child 'form) child) - (form-around-in-children (children child) offset)))) - ((<= offset (start-offset child)) + (or (form-around-in-children (children child) offset) + (when (typep child 'form) + child))))) + ((< offset (start-offset child)) (return nil)) (t nil))))