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)