Changeset 6574 for branches

Timestamp:

May 20, 2007, 12:51:27 AM (18 years ago)

Author:

Gary Byers

Message:

Not sure if this needs to be used, but stop referencing gap-related
special vars.

File:

• branches/ide-1.0/ccl/hemlock/src/linimage.lisp (modified) (5 diffs)

branches/ide-1.0/ccl/hemlock/src/linimage.lisp

@@ -339 +339 @@
 ;;;    Like compute-normal-line-image, only works on the cached line.
 ;;;
-(defun compute-cached-line-image (index dis-line xpos width)
+(defun compute-cached-line-image (buffer index dis-line xpos width)
   (declare (fixnum index width) (type (or fixnum null) xpos))
-  (prog ((gap (- *right-open-pos* *left-open-pos*))
+  (prog ((gap (- (buffer-right-open-pos buffer) (buffer-left-open-pos buffer)))
          (dest (dis-line-chars dis-line))
-         (done-p (= *right-open-pos* *line-cache-length*))
+         (done-p (= (buffer-right-open-pos buffer)
+                    (buffer-line-cache-length buffer)))
          (losing 0)
          string underhang)
@@ -354 +355 @@
      ((null xpos)
       (update-and-punt dis-line width nil 0 index))
-     ((>= index *left-open-pos*)
+     ((>= index (buffer-left-open-pos buffer))
       (go RIGHT-START)))
-    (setq losing (%fcwa *open-chars* index *left-open-pos* losing-char))
+    (setq losing (%fcwa (buffer-open-chars buffer) index (buffer-left-open-pos buffer) losing-char))
     (cond
      (losing
-      (display-some-chars *open-chars* index losing dest xpos width nil)
+      (display-some-chars (buffer-open-chars buffer) index losing dest xpos width nil)
       ;; If we we didn't wrap then display some losers...
       (if xpos
-          (display-losing-chars *open-chars* index *left-open-pos* dest xpos
+          (display-losing-chars (buffer-open-chars buffer) index (buffer-left-open-pos buffer) dest xpos
                                 width string underhang string-get-rep
-                                (and done-p (= index *left-open-pos*)))
+                                (and done-p (= index (buffer-left-open-pos buffer))))
           (update-and-punt dis-line width nil 0 index)))
      (t
-      (display-some-chars *open-chars* index *left-open-pos* dest xpos width done-p)))
+      (display-some-chars (buffer-open-chars buffer) index (buffer-left-open-pos buffer) dest xpos width done-p)))
     (go LEFT-LOOP)
 
@@ -378 +379 @@
      ((null xpos)
       (update-and-punt dis-line width nil 0 (- index gap)))
-     ((= index *line-cache-length*)
+     ((= index (buffer-line-cache-length buffer))
       (update-and-punt dis-line xpos nil nil (- index gap))))
-    (setq losing (%fcwa *open-chars* index *line-cache-length* losing-char))
+    (setq losing (%fcwa (buffer-open-chars buffer) index (buffer-line-cache-length buffer) losing-char))
     (cond
      (losing
-      (display-some-chars *open-chars* index losing dest xpos width nil)
+      (display-some-chars (buffer-open-chars buffer) index losing dest xpos width nil)
       (cond
        ;; Did we wrap?
@@ -389 +390 @@
         (update-and-punt dis-line width nil 0 (- index gap)))
        (t
-        (display-losing-chars *open-chars* index *line-cache-length* dest xpos
+        (display-losing-chars (buffer-open-chars buffer) index (buffer-line-cache-length buffer) dest xpos
                               width string underhang string-get-rep))))
      (t
-      (display-some-chars *open-chars* index *line-cache-length* dest xpos width t)))
-    (go RIGHT-LOOP))) 
+      (display-some-chars (buffer-open-chars buffer) index (buffer-line-cache-length buffer) dest xpos width t)))
+    (go RIGHT-LOOP)))
 
 
@@ -442 +443 @@
 ;;;
 (defun compute-line-image (string underhang line offset dis-line width)
-  ;;
-  ;; Release any old font-changes.
-  (let ((changes (dis-line-font-changes dis-line)))
-    (when changes
-      (do ((prev changes current)
-           (current (font-change-next changes)
-                    (font-change-next current)))
-          ((null current)
-           (setf (dis-line-font-changes dis-line) nil)
-           (shiftf (font-change-next prev) *free-font-changes* changes))
-        (setf (font-change-mark current) nil))))
-  ;;
-  ;; If the line has any Font-Marks, add Font-Changes for them.
-  (let ((marks (line-marks line)))
-    (when (dolist (m marks nil)
-            (when (fast-font-mark-p m) (return t)))
-      (let ((prev nil))
-        ;;
-        ;; Find the last Font-Mark with charpos less than Offset.  If there is
-        ;; such a Font-Mark, then there is a font-change to this font at X = 0.
-        (let ((max -1)
-              (max-mark nil))
-          (dolist (m marks)
-            (when (fast-font-mark-p m)
-              (let ((charpos (mark-charpos m)))
-                (when (and (< charpos offset) (> charpos max))
-                  (setq max charpos  max-mark m)))))
-          (when max-mark
-            (setq prev (alloc-font-change 0 (font-mark-font max-mark) max-mark))
-            (setf (dis-line-font-changes dis-line) prev)))
-        ;;
-        ;; Repeatedly scan through marks, adding a font-change for the
-        ;; smallest Font-Mark with a charpos greater than Bound, until
-        ;; we find no such mark.
-        (do ((bound (1- offset) min)
-             (min most-positive-fixnum most-positive-fixnum)
-             (min-mark nil nil))
-            (())
-          (dolist (m marks)
-            (when (fast-font-mark-p m)
-              (let ((charpos (mark-charpos m)))
-                (when (and (> charpos bound) (< charpos min))
-                  (setq min charpos  min-mark m)))))
-          (unless min-mark (return nil))
-          (let ((len (if (eq line *open-line*)
+  (let* ((buffer (line-%buffer line)))
+    ;;
+    ;; Release any old font-changes.
+    (let ((changes (dis-line-font-changes dis-line)))
+      (when changes
+        (do ((prev changes current)
+             (current (font-change-next changes)
+                      (font-change-next current)))
+            ((null current)
+             (setf (dis-line-font-changes dis-line) nil)
+             (shiftf (font-change-next prev) *free-font-changes* changes))
+          (setf (font-change-mark current) nil))))
+    ;;
+    ;; If the line has any Font-Marks, add Font-Changes for them.
+    (let ((marks (line-marks line)))
+      (when (dolist (m marks nil)
+              (when (fast-font-mark-p m) (return t)))
+        (let ((prev nil))
+          ;;
+          ;; Find the last Font-Mark with charpos less than Offset.  If there is
+          ;; such a Font-Mark, then there is a font-change to this font at X = 0.
+          (let ((max -1)
+                (max-mark nil))
+            (dolist (m marks)
+              (when (fast-font-mark-p m)
+                (let ((charpos (mark-charpos m)))
+                  (when (and (< charpos offset) (> charpos max))
+                    (setq max charpos  max-mark m)))))
+            (when max-mark
+              (setq prev (alloc-font-change 0 (font-mark-font max-mark) max-mark))
+              (setf (dis-line-font-changes dis-line) prev)))
+          ;;
+          ;; Repeatedly scan through marks, adding a font-change for the
+          ;; smallest Font-Mark with a charpos greater than Bound, until
+          ;; we find no such mark.
+          (do ((bound (1- offset) min)
+               (min most-positive-fixnum most-positive-fixnum)
+               (min-mark nil nil))
+              (())
+            (dolist (m marks)
+              (when (fast-font-mark-p m)
+                (let ((charpos (mark-charpos m)))
+                  (when (and (> charpos bound) (< charpos min))
+                    (setq min charpos  min-mark m)))))
+            (unless min-mark (return nil))
+            (let ((len (if (eq line (buffer-open-line buffer))
                          (cached-real-line-length line 10000 offset min)
                          (real-line-length line 10000 offset min))))
-            (when (< len width)
-              (let ((new (alloc-font-change
-                          (+ len
-                             (if string
+              (when (< len width)
+                (let ((new (alloc-font-change
+                            (+ len
+                               (if string
                                  (- (length (the simple-string string)) underhang)
                                  0))
-                          (font-mark-font min-mark)
-                          min-mark)))
-                (if prev
+                            (font-mark-font min-mark)
+                            min-mark)))
+                  (if prev
                     (setf (font-change-next prev) new)
                     (setf (dis-line-font-changes dis-line) new))
-                (setq prev new))))))))
-  ;;
-  ;; Recompute the line image.
-  (cond
-   (string
-    (let ((len (strlen string))
-          (chars (dis-line-chars dis-line))
-          (xpos 0))
-      (declare (type (or fixnum null) xpos) (simple-string chars))
-      (display-some-chars string underhang len chars xpos width nil)
-      (cond
-       ((null xpos)
-        (values string underhang offset))          
-       ((eq line *open-line*)
-        (compute-cached-line-image offset dis-line xpos width))
-       ((line-buffered-p line)
-        (compute-buffered-line-image line offset dis-line xpos width))
-       (t
-        (compute-normal-line-image line offset dis-line xpos width)))))
-   ((eq line *open-line*)
-    (compute-cached-line-image offset dis-line 0 width))
-   ((line-buffered-p line)
-    (compute-buffered-line-image line offset dis-line 0 width))
-   (t
-    (compute-normal-line-image line offset dis-line 0 width))))
+                  (setq prev new))))))))
+    ;;
+    ;; Recompute the line image.
+    (cond
+      (string
+       (let ((len (strlen string))
+             (chars (dis-line-chars dis-line))
+             (xpos 0))
+         (declare (type (or fixnum null) xpos) (simple-string chars))
+         (display-some-chars string underhang len chars xpos width nil)
+         (cond
+           ((null xpos)
+            (values string underhang offset))      
+           ((eq line (buffer-open-line buffer))
+            (compute-cached-line-image buffer offset dis-line xpos width))
+           ((line-buffered-p line)
+            (compute-buffered-line-image line offset dis-line xpos width))
+           (t
+            (compute-normal-line-image line offset dis-line xpos width)))))
+      ((eq line (buffer-open-line buffer))
+       (compute-cached-line-image offset dis-line 0 width))
+      ((line-buffered-p line)
+       (compute-buffered-line-image line offset dis-line 0 width))
+      (t
+       (compute-normal-line-image line offset dis-line 0 width)))))