Update of /project/mcclim/cvsroot/mcclim/Drei In directory clnet:/tmp/cvs-serv9380/Drei
Modified Files: lisp-syntax.lisp lr-syntax.lisp packages.lisp views.lisp Log Message: Added a bunch of neat convenience functions to Lisp syntax.
--- /project/mcclim/cvsroot/mcclim/Drei/lisp-syntax.lisp 2007/12/13 07:30:37 1.36 +++ /project/mcclim/cvsroot/mcclim/Drei/lisp-syntax.lisp 2007/12/19 17:17:37 1.37 @@ -1315,6 +1315,10 @@ "Returns the third formw in list." (nth-form 2 list))
+(defun form-children (form) + "Return the children of `form' that are themselves forms." + (remove-if-not #'formp (children form))) + (defgeneric form-operator (syntax form) (:documentation "Return the operator of `form' as a token. Returns nil if none can be found.") @@ -1448,6 +1452,9 @@ (define-form-predicate form-comma-p (comma-form)) (define-form-predicate form-comma-at-p (comma-at-form)) (define-form-predicate form-comma-dot-p (comma-dot-form)) +(define-form-predicate form-character-p (complete-character-lexeme + incomplete-character-lexeme)) +(define-form-predicate form-simple-vector-p (simple-vector-form))
(define-form-predicate comment-p (comment))
@@ -1460,6 +1467,176 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; +;;; Asking about parse state at some point + +(defun in-type-p-in-children (children offset type) + (loop for child in children + do (cond ((<= (start-offset child) offset (end-offset child)) + (return (if (typep child type) + child + (in-type-p-in-children (children child) offset type)))) + ((<= offset (start-offset child)) + (return nil)) + (t nil)))) + +(defun in-type-p (syntax mark-or-offset type) + (as-offsets ((offset mark-or-offset)) + (update-parse syntax 0 offset) + (with-slots (stack-top) syntax + (if (or (null (start-offset stack-top)) + (> offset (end-offset stack-top)) + (< offset (start-offset stack-top))) + nil + (in-type-p-in-children (children stack-top) offset type))))) + +(defun in-string-p (syntax mark-or-offset) + "Return true if `mark-or-offset' is inside a Lisp string." + (as-offsets ((offset mark-or-offset)) + (let ((string (in-type-p syntax offset 'string-form))) + (and string + (< (start-offset string) offset) + (< offset (end-offset string)))))) + +(defun in-comment-p (syntax mark-or-offset) + "Return true if `mark-or-offset' is inside a Lisp +comment (line-based or long form)." + (as-offsets ((offset mark-or-offset)) + (let ((comment (in-type-p syntax mark-or-offset 'comment))) + (and comment + (or (when (typep comment 'line-comment-form) + (< (start-offset comment) offset)) + (when (typep comment 'complete-long-comment-form) + (< (1+ (start-offset comment) ) offset + (1- (end-offset comment)))) + (when (typep comment 'incomplete-long-comment-form) + (< (1+ (start-offset comment)) offset))))))) + +(defun in-character-p (syntax mark-or-offset) + "Return true if `mark-or-offset' is inside a Lisp character lexeme." + (as-offsets ((offset mark-or-offset)) + (let ((form (form-around syntax offset))) + (typecase form + (complete-character-lexeme + (> (end-offset form) offset (+ (start-offset form) 1))) + (incomplete-character-lexeme + (= offset (end-offset form))))))) + +(defgeneric at-beginning-of-form-p (syntax form offset) + (:documentation "Return true if `offset' is at the beginning of +the list-like `form', false otherwise. "Beginning" is defined +at the earliest point the contents could be entered, for example +right after the opening parenthesis for a list.") + (:method ((syntax lisp-syntax) (form form) (offset integer)) + nil) + (:method :before ((syntax lisp-syntax) (form form) (offset integer)) + (update-parse syntax 0 offset))) + +(defgeneric at-end-of-form-p (syntax form offset) + (:documentation "Return true if `offset' is at the end of the +list-like `form', false otherwise.") + (:method ((syntax lisp-syntax) (form form) (offset integer)) + nil) + (:method :before ((syntax lisp-syntax) (form form) (offset integer)) + (update-parse syntax 0 offset))) + +(defmethod at-beginning-of-form-p ((syntax lisp-syntax) (form list-form) + (offset integer)) + (= offset (1+ (start-offset form)))) + +(defmethod at-end-of-form-p ((syntax lisp-syntax) (form list-form) + (offset integer)) + (= offset (1- (end-offset form)))) + +(defmethod at-beginning-of-form-p ((syntax lisp-syntax) (form string-form) + (offset integer)) + (= offset (1+ (start-offset form)))) + +(defmethod at-end-of-form-p ((syntax lisp-syntax) (form string-form) + (offset integer)) + (= offset (1- (end-offset form)))) + +(defmethod at-beginning-of-form-p ((syntax lisp-syntax) (form simple-vector-form) + (offset integer)) + (= offset (+ 2 (start-offset form)))) + +(defmethod at-end-of-form-p ((syntax lisp-syntax) (form simple-vector-form) + (offset integer)) + (= offset (1- (end-offset form)))) + +(defun location-at-beginning-of-form (syntax mark-or-offset) + "Return true if the position `mark-or-offset' is at the +beginning of some structural form, false otherwise. "Beginning" +is defined by what type of form is at `mark-or-offset', but for a +list form, it would be right after the opening parenthesis." + (as-offsets ((offset mark-or-offset)) + (update-parse syntax 0 offset) + (let ((form-around (form-around syntax offset))) + (when form-around + (labels ((recurse (form) + (or (at-beginning-of-form-p syntax form offset) + (unless (form-at-top-level-p form) + (recurse (parent form)))))) + (recurse form-around)))))) + +(defun location-at-end-of-form (syntax mark-or-offset) + "Return true if the position `mark-or-offset' is at the +end of some structural form, false otherwise. "End" +is defined by what type of form is at `mark-or-offset', but for a +list form, it would be right before the closing parenthesis." + (as-offsets ((offset mark-or-offset)) + (update-parse syntax 0 offset) + (let ((form-around (form-around syntax offset))) + (when form-around + (labels ((recurse (form) + (or (at-end-of-form-p syntax form offset) + (unless (form-at-top-level-p form) + (recurse (parent form)))))) + (recurse form-around)))))) + +(defun at-beginning-of-list-p (syntax mark-or-offset) + "Return true if the position `mark-or-offset' is at the +beginning of a list-like form, false otherwise. "Beginning" is +defined as the earliest point the contents could be entered, for +example right after the opening parenthesis for a list." + (as-offsets ((offset mark-or-offset)) + (update-parse syntax 0 offset) + (let ((form-around (form-around syntax offset))) + (when (form-list-p form-around) + (at-beginning-of-form-p syntax form-around offset))))) + +(defun at-end-of-list-p (syntax mark-or-offset) + "Return true if the position `mark-or-offset' is at the end of +a list-like form, false otherwise. "End" is defined as the +latest point the contents could be entered, for example right +before the closing parenthesis for a list." + (as-offsets ((offset mark-or-offset)) + (update-parse syntax 0 offset) + (let ((form-around (form-around syntax offset))) + (when (form-list-p form-around) + (at-end-of-form-p syntax (form-around syntax offset) offset))))) + +(defun at-beginning-of-string-p (syntax mark-or-offset) + "Return true if the position `mark-or-offset' is at the +beginning of a string form, false otherwise. "Beginning" is +right after the opening double-quote." + (as-offsets ((offset mark-or-offset)) + (update-parse syntax 0 offset) + (let ((form-around (form-around syntax offset))) + (when (form-string-p form-around) + (at-beginning-of-form-p syntax form-around offset))))) + +(defun at-end-of-string-p (syntax mark-or-offset) + "Return true if the position `mark-or-offset' is at the end of +a list-like form, false otherwise. "End" is right before the +ending double-quote." + (as-offsets ((offset mark-or-offset)) + (update-parse syntax 0 offset) + (let ((form-around (form-around syntax offset))) + (when (form-string-p form-around) + (at-end-of-form-p syntax form-around offset))))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; ;;; Useful functions for modifying forms based on the mark.
(defgeneric replace-symbol-at-mark (syntax mark string) @@ -1832,7 +2009,7 @@ a list parent cannot be found, return nil" (let ((parent (parent form))) (typecase parent - (list-form (funcall fn form)) + (list-form (funcall fn parent)) ((or form* null) nil) (t (find-list-parent-offset parent fn)))))
@@ -1956,31 +2133,6 @@ do (setf (offset mark) (end-offset form)) and do (return t))))
-(defun in-type-p-in-children (children offset type) - (loop for child in children - do (cond ((< (start-offset child) offset (end-offset child)) - (return (if (typep child type) - child - (in-type-p-in-children (children child) offset type)))) - ((<= offset (start-offset child)) - (return nil)) - (t nil)))) - -(defun in-type-p (mark-or-offset syntax type) - (as-offsets ((offset mark-or-offset)) - (with-slots (stack-top) syntax - (if (or (null (start-offset stack-top)) - (>= offset (end-offset stack-top)) - (<= offset (start-offset stack-top))) - nil) - (in-type-p-in-children (children stack-top) offset type)))) - -(defun in-string-p (mark-or-offset syntax) - (in-type-p mark-or-offset syntax 'string-form)) - -(defun in-comment-p (mark-or-offset syntax) - (in-type-p mark-or-offset syntax 'comment)) - (defmethod eval-defun ((mark mark) (syntax lisp-syntax)) (with-slots (stack-top) syntax (loop for form in (children stack-top) --- /project/mcclim/cvsroot/mcclim/Drei/lr-syntax.lisp 2007/12/10 21:25:12 1.4 +++ /project/mcclim/cvsroot/mcclim/Drei/lr-syntax.lisp 2007/12/19 17:17:37 1.5 @@ -84,7 +84,7 @@
(defclass parser-symbol () ((start-mark :initform nil :initarg :start-mark :reader start-mark) - (size :initform nil :initarg :size) + (size :initform nil :initarg :size :reader size) (parent :initform nil :accessor parent) (children :initform '() :initarg :children :reader children) (preceding-parse-tree :initform nil :reader preceding-parse-tree) --- /project/mcclim/cvsroot/mcclim/Drei/packages.lisp 2007/12/18 08:39:43 1.22 +++ /project/mcclim/cvsroot/mcclim/Drei/packages.lisp 2007/12/19 17:17:37 1.23 @@ -492,12 +492,49 @@ :drei-syntax :drei-fundamental-syntax :flexichain :drei :drei-motion :drei-editing :esa-utils :esa :drei-core :esa-io :drei-lr-syntax) - (:export #:lisp-syntax + (:export #:lisp-syntax #:lisp-table #:lisp-string #:edit-definition #:form #:form-to-object
+ ;; Selecting forms based on mark + #:form-around #:form-before #:form-after + #:expression-at-mark + #:definition-at-mark + #:symbol-at-mark + #:fully-quoted-form + #:fully-unquoted-form + #:this-form + + ;; Querying forms + #:formp #:form-list-p + #:form-incomplete-p #:form-complete-p + #:form-token-p #:form-string-p + #:form-quoted-p + #:form-comma-p #:form-comma-at-p #:form-comma-dot-p + #:form-character-p + #:form-simple-vector-p + #:comment-p + #:form-at-top-level-p + + ;; Querying form data + #:form-children + #:form-operator #:form-operands + #:form-toplevel + #:form-operator-p + + ;; Querying about state at mark + #:in-string-p + #:in-comment-p + #:in-character-p + #:location-at-beginning-of-form + #:location-at-end-of-form + #:at-beginning-of-list-p + #:at-end-of-list-p + #:at-beginning-of-string-p + #:at-end-of-string-p + ;; Lambda list classes. #:lambda-list #:semiordinary-lambda-list --- /project/mcclim/cvsroot/mcclim/Drei/views.lisp 2007/12/18 08:39:43 1.6 +++ /project/mcclim/cvsroot/mcclim/Drei/views.lisp 2007/12/19 17:17:37 1.7 @@ -520,7 +520,11 @@ (%suffix-size :accessor suffix-size :initform 0 :documentation "The number of unchanged objects -at the end of the buffer.")) +at the end of the buffer.") + (%recorded-buffer-size :accessor buffer-size + :initform 0 + :documentation "The size of the buffer +the last time the view was synchronized.")) (:documentation "A buffer-view that maintains a parse tree of the buffer, or otherwise pays attention to the syntax of the buffer.")) @@ -552,6 +556,7 @@ (point point) (mark mark) (suffix-size suffix-size) (prefix-size prefix-size) + (buffer-size buffer-size) (bot bot) (top top)) view (setf point (clone-mark (point buffer)) mark (clone-mark (point buffer) :right) @@ -559,6 +564,7 @@ view-syntax (make-syntax-for-view view (class-of view-syntax)) prefix-size 0 suffix-size 0 + buffer-size (size buffer) ;; Also set the top and bot marks. top (make-buffer-mark buffer 0 :left) bot (make-buffer-mark buffer (size buffer) :right)) @@ -573,7 +579,8 @@ ;; We need to reparse the buffer completely. Might as well do it ;; now. (setf (prefix-size view) 0 - (suffix-size view) 0) + (suffix-size view) 0 + (buffer-size view) (size (buffer view))) (synchronize-view view :force-p t))
(defmethod observer-notified ((view drei-syntax-view) (buffer drei-buffer) @@ -588,7 +595,8 @@ (defmethod synchronize-view :around ((view drei-syntax-view) &key force-p) ;; If nothing changed, then don't call the other methods. - (unless (and (= (prefix-size view) (suffix-size view) (size (buffer view))) + (unless (and (= (prefix-size view) (suffix-size view) + (size (buffer view)) (buffer-size view)) (not force-p)) (call-next-method)))
@@ -603,7 +611,8 @@ ;; Reset here so if `update-syntax' calls `update-parse' itself, ;; we won't end with infinite recursion. (setf (prefix-size view) (size (buffer view)) - (suffix-size view) (size (buffer view))) + (suffix-size view) (size (buffer view)) + (buffer-size view) (size (buffer view))) (update-syntax (syntax view) prefix-size suffix-size begin end)))