[mcclim-cvs] CVS mcclim/Drei
thenriksen
thenriksen at common-lisp.net
Tue Jan 8 21:05:50 UTC 2008
Update of /project/mcclim/cvsroot/mcclim/Drei
In directory clnet:/tmp/cvs-serv9990/Drei
Modified Files:
lisp-syntax.lisp lr-syntax.lisp views.lisp
Log Message:
Pretend to to incremental reparse for Lr syntaxes.
This required some fixed in the view mechanism, and doesn't affect
much yet. Except that I had to disable intelligent package-handling in
Lisp syntax.
--- /project/mcclim/cvsroot/mcclim/Drei/lisp-syntax.lisp 2008/01/07 23:00:51 1.58
+++ /project/mcclim/cvsroot/mcclim/Drei/lisp-syntax.lisp 2008/01/08 21:05:50 1.59
@@ -1272,8 +1272,9 @@
(setf (form-before-cache syntax) (make-hash-table :test #'equal)
(form-after-cache syntax) (make-hash-table :test #'equal)
(form-around-cache syntax) (make-hash-table :test #'equal))
- (when (need-to-update-package-list-p prefix-size suffix-size syntax)
- (update-package-list syntax)))
+ #+nil(when (need-to-update-package-list-p prefix-size suffix-size syntax)
+ (update-package-list syntax))
+ (setf (package-list syntax) nil))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
--- /project/mcclim/cvsroot/mcclim/Drei/lr-syntax.lisp 2008/01/07 22:55:11 1.13
+++ /project/mcclim/cvsroot/mcclim/Drei/lr-syntax.lisp 2008/01/08 21:05:50 1.14
@@ -267,30 +267,31 @@
(print-unreadable-object (mark stream :type t :identity t)
(format stream "~s" (offset mark))))
-(defun parse-patch (syntax)
+(defun parse-patch (syntax begin end)
+ (declare (ignore begin))
(with-slots (current-state stack-top scan potentially-valid-trees) syntax
- (parser-step syntax)
- (finish-output *trace-output*)
- (cond ((parse-tree-equal stack-top potentially-valid-trees)
- (unless (or (null (parent potentially-valid-trees))
- (eq potentially-valid-trees
- (car (last (children (parent potentially-valid-trees))))))
- (loop for tree = (cadr (member potentially-valid-trees
- (children (parent potentially-valid-trees))
- :test #'eq))
- then (car (children tree))
- until (null tree)
- do (setf (slot-value tree 'preceding-parse-tree)
- stack-top))
- (setf stack-top (prev-tree (parent potentially-valid-trees))))
- (setf potentially-valid-trees (parent potentially-valid-trees))
- (setf current-state (new-state syntax (parser-state stack-top) stack-top))
- (setf (offset scan) (end-offset stack-top)))
- (t (loop until (or (null potentially-valid-trees)
- (>= (start-offset potentially-valid-trees)
- (end-offset stack-top)))
- do (setf potentially-valid-trees
- (next-tree potentially-valid-trees)))))))
+ (parser-step syntax)
+ (finish-output *trace-output*)
+ (cond ((parse-tree-equal stack-top potentially-valid-trees)
+ (unless (or (null (parent potentially-valid-trees))
+ (eq potentially-valid-trees
+ (car (last (children (parent potentially-valid-trees))))))
+ (loop for tree = (cadr (member potentially-valid-trees
+ (children (parent potentially-valid-trees))
+ :test #'eq))
+ then (car (children tree))
+ until (null tree)
+ do (setf (slot-value tree 'preceding-parse-tree)
+ stack-top))
+ (setf stack-top (prev-tree (parent potentially-valid-trees))))
+ (setf potentially-valid-trees (parent potentially-valid-trees))
+ (setf current-state (new-state syntax (parser-state stack-top) stack-top))
+ (setf (offset scan) (end-offset stack-top)))
+ (t (loop until (or (null potentially-valid-trees)
+ (>= (start-offset potentially-valid-trees)
+ (end-offset stack-top)))
+ do (setf potentially-valid-trees
+ (next-tree potentially-valid-trees)))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
@@ -357,8 +358,7 @@
;;; update syntax
(defmethod update-syntax values-max-min ((syntax lr-syntax-mixin) prefix-size suffix-size
- &optional begin end)
- (declare (ignore begin end))
+ &optional (begin 0) (end (size (buffer syntax))))
(let* ((low-mark-offset prefix-size)
(high-mark-offset (- (size (buffer syntax)) suffix-size)))
(when (<= low-mark-offset high-mark-offset)
@@ -377,8 +377,8 @@
(new-state syntax
(parser-state stack-top)
stack-top)))
- (loop do (parse-patch syntax))))))
- (values 0 (size (buffer syntax))))
+ (loop do (parse-patch syntax begin end)))))
+ (values 0 end)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
@@ -496,7 +496,7 @@
(defmethod pump-state-for-offset-with-syntax ((view textual-drei-syntax-view)
(syntax lr-syntax-mixin) (offset integer))
- (update-parse syntax 0 offset)
+ (update-parse syntax 0 (size (buffer view)))
(let ((parser-symbol (parser-symbol-containing-offset syntax offset))
(highlighting-rules (syntax-highlighting-rules syntax)))
(labels ((initial-drawing-options (parser-symbol)
--- /project/mcclim/cvsroot/mcclim/Drei/views.lisp 2008/01/08 19:53:28 1.14
+++ /project/mcclim/cvsroot/mcclim/Drei/views.lisp 2008/01/08 21:05:50 1.15
@@ -657,8 +657,7 @@
(when (or (and (> begin (prefix-size view))
(> high-offset begin))
(and (> end (prefix-size view))
- (or (> end high-offset)
- (>= (prefix-size view) begin)))
+ (>= (prefix-size view) begin))
(/= (size (buffer view)) (buffer-size view))
force-p)
(call-next-method))))
@@ -673,12 +672,14 @@
(suffix-size (suffix-size view)))
;; Set some minimum values here so if `update-syntax' calls
;; `update-parse' itself, we won't end with infinite recursion.
- (setf (prefix-size view) (if (> begin prefix-size)
- prefix-size
- end)
- (suffix-size view) (if (>= end (- (size (buffer view)) suffix-size))
- (- (size (buffer view)) (prefix-size view))
- suffix-size)
+ (setf (prefix-size view) (max (if (> begin prefix-size)
+ prefix-size
+ end)
+ prefix-size)
+ (suffix-size view) (max (if (>= end (- (size (buffer view)) suffix-size))
+ (max (- (size (buffer view)) begin) suffix-size)
+ suffix-size)
+ suffix-size)
(buffer-size view) (size (buffer view)))
(multiple-value-bind (parsed-start parsed-end)
(update-syntax (syntax view) prefix-size suffix-size begin end)
More information about the Mcclim-cvs
mailing list