[mcclim-cvs] CVS mcclim/Drei
thenriksen
thenriksen at common-lisp.net
Wed Dec 19 17:17:37 UTC 2007
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)))
More information about the Mcclim-cvs
mailing list