[mcclim-cvs] CVS mcclim/Drei

thenriksen thenriksen at common-lisp.net
Mon Jan 7 22:01:59 UTC 2008


Update of /project/mcclim/cvsroot/mcclim/Drei
In directory clnet:/tmp/cvs-serv12937/Drei

Modified Files:
	fundamental-syntax.lisp lr-syntax.lisp packages.lisp 
	syntax.lisp views.lisp 
Log Message:
Changed the update-syntax protocol to use a nonstandard method
combination for added job security.


--- /project/mcclim/cvsroot/mcclim/Drei/fundamental-syntax.lisp	2008/01/03 16:25:16	1.10
+++ /project/mcclim/cvsroot/mcclim/Drei/fundamental-syntax.lisp	2008/01/07 22:01:53	1.11
@@ -90,24 +90,8 @@
            (cons (- (1+ chunk-end-offset)
                     line-start-offset) t)))))
 
-(defmethod initialize-instance :after ((line line-object)
-                                       &rest initargs)
-  (declare (ignore initargs))
-  (loop with buffer = (buffer (start-mark line))
-     with line-start-offset = (offset (start-mark line))
-     with line-end-offset = (+ line-start-offset (line-length line))
-     with chunk-start-offset = line-start-offset
-     for chunk-info = (get-chunk buffer
-                                 line-start-offset
-                                 chunk-start-offset line-end-offset)
-     do (vector-push-extend chunk-info (chunks line))
-     (setf chunk-start-offset (+ (car chunk-info)
-                                 line-start-offset))
-     when (= chunk-start-offset line-end-offset)
-     do (loop-finish)))
-
-(defmethod update-syntax ((syntax fundamental-syntax) prefix-size suffix-size
-                          &optional begin end)
+(defmethod update-syntax values-max-min ((syntax fundamental-syntax) prefix-size suffix-size
+                                         &optional begin end)
   (declare (ignore begin end))
   (let ((low-mark (make-buffer-mark (buffer syntax) prefix-size :left))
         (high-mark (make-buffer-mark
@@ -144,7 +128,25 @@
                          (if (end-of-buffer-p scan)
                              (loop-finish)
                              ;; skip newline
-                             (forward-object scan))))))))))
+                             (forward-object scan))))))))
+    ;; Fundamental syntax always parses the entire buffer.
+    (values 0 (size (buffer syntax)))))
+
+(defmethod initialize-instance :after ((line line-object)
+                                       &rest initargs)
+  (declare (ignore initargs))
+  (loop with buffer = (buffer (start-mark line))
+     with line-start-offset = (offset (start-mark line))
+     with line-end-offset = (+ line-start-offset (line-length line))
+     with chunk-start-offset = line-start-offset
+     for chunk-info = (get-chunk buffer
+                                 line-start-offset
+                                 chunk-start-offset line-end-offset)
+     do (vector-push-extend chunk-info (chunks line))
+     (setf chunk-start-offset (+ (car chunk-info)
+                                 line-start-offset))
+     when (= chunk-start-offset line-end-offset)
+     do (loop-finish)))
 		
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;
--- /project/mcclim/cvsroot/mcclim/Drei/lr-syntax.lisp	2008/01/07 15:32:15	1.10
+++ /project/mcclim/cvsroot/mcclim/Drei/lr-syntax.lisp	2008/01/07 22:01:58	1.11
@@ -356,10 +356,9 @@
 ;;;
 ;;; update syntax
 
-(defmethod update-syntax ((syntax lr-syntax-mixin) prefix-size suffix-size
-                          &optional begin end)
+(defmethod update-syntax values-max-min ((syntax lr-syntax-mixin) prefix-size suffix-size
+                                         &optional begin end)
   (declare (ignore begin end))
-  (call-next-method)
   (let* ((low-mark-offset prefix-size)
 	 (high-mark-offset (- (size (buffer syntax)) suffix-size)))
     (when (<= low-mark-offset high-mark-offset)
@@ -378,7 +377,8 @@
                                   (new-state syntax
                                              (parser-state stack-top)
                                              stack-top)))
-          (loop do (parse-patch syntax)))))))
+          (loop do (parse-patch syntax))))))
+  (values 0 (size (buffer syntax))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;
--- /project/mcclim/cvsroot/mcclim/Drei/packages.lisp	2008/01/05 20:08:32	1.33
+++ /project/mcclim/cvsroot/mcclim/Drei/packages.lisp	2008/01/07 22:01:58	1.34
@@ -484,7 +484,7 @@
 
 (defpackage :drei-fundamental-syntax
   (:use :clim-lisp :clim :drei-buffer :drei-base 
-        :drei-syntax :flexichain :drei :drei-core)
+        :drei-syntax :flexichain :drei :drei-core :esa-utils)
   (:export #:fundamental-syntax #:scan
            #:start-mark #:line-length #:line-end-offset
            #:line-containing-offset #:offset-in-line-p)
--- /project/mcclim/cvsroot/mcclim/Drei/syntax.lisp	2007/12/28 10:08:34	1.9
+++ /project/mcclim/cvsroot/mcclim/Drei/syntax.lisp	2008/01/07 22:01:58	1.10
@@ -78,7 +78,15 @@
 that must have an up-to-date parse, defaulting to 0 and the size
 of the buffer respectively. It is perfectly valid for a syntax to
 ignore these hints and just make sure the entire syntax tree is
-up to date."))
+up to date, but it *must* make sure at at least the region
+delimited by `begin' and `end' has an up to date parse. Returns
+two values, offsets into the buffer of the syntax, denoting the
+buffer region thas has an up to date parse.")
+  (:method-combination values-max-min)
+  (:method values-max-min ((syntax syntax) (unchanged-prefix integer)
+                           (unchanged-suffix integer) &optional (begin 0)
+                           (end (- (size (buffer syntax)) unchanged-suffix)))
+    (values begin end)))
 
 (defgeneric eval-defun (mark syntax))
 
--- /project/mcclim/cvsroot/mcclim/Drei/views.lisp	2008/01/03 18:09:27	1.12
+++ /project/mcclim/cvsroot/mcclim/Drei/views.lisp	2008/01/07 22:01:58	1.13
@@ -659,12 +659,14 @@
   (call-next-method))
 
 (defmethod synchronize-view :around ((view drei-syntax-view) &key
-                                     force-p)
+                                     force-p (begin 0) (end (size (buffer view))))
   ;; If nothing changed, then don't call the other methods.
-  (unless (and (= (prefix-size view) (suffix-size view)
-                  (size (buffer view)) (buffer-size view))
-               (not force-p))
-    (call-next-method)))
+  (let ((high-offset (- (size (buffer view)) (suffix-size view))))
+    (when (or (and (>= begin (prefix-size view))
+                   (>= high-offset end))
+              (/= (size (buffer view)) (buffer-size view))
+              force-p)
+      (call-next-method))))
 
 (defmethod synchronize-view ((view drei-syntax-view)
                              &key (begin 0) (end (size (buffer view))))
@@ -674,12 +676,21 @@
 size of the buffer respectively."
   (let ((prefix-size (prefix-size view))
         (suffix-size (suffix-size view)))
-    ;; 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))
+    ;; 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)
           (buffer-size view) (size (buffer view)))
-    (update-syntax (syntax view) prefix-size suffix-size begin end)
+    (multiple-value-bind (parsed-start parsed-end)
+        (update-syntax (syntax view) prefix-size suffix-size begin end)
+      ;; Not set the proper new values for prefix-size and
+      ;; suffix-size.
+      (setf (prefix-size view) parsed-end
+            (suffix-size view) (- (size (buffer view)) parsed-start)))
     (call-next-method)))
 
 (defun make-syntax-for-view (view syntax-symbol &rest args)




More information about the Mcclim-cvs mailing list