Changeset 6571 for branches


Ignore:
Timestamp:
May 20, 2007, 12:48:02 AM (18 years ago)
Author:
Gary Byers
Message:

Keep gap info in each buffer, not in special variables or symbol-macros.

Location:
branches/ide-1.0/ccl/hemlock/src
Files:
10 edited

Legend:

Unmodified
Added
Removed

  • branches/ide-1.0/ccl/hemlock/src/cursor.lisp

    r775 r6571  
    145145;;;
    146146(defun cached-real-line-length (line width start end)
    147   (declare (fixnum width start end) (ignore line))
    148   (let ((offset (- *right-open-pos* *left-open-pos*))
     147  (declare (fixnum width start end))
     148  (let* ((buffer (line-%buffer line))
     149         (offset (- (buffer-right-open-pos buffer) (buffer-left-open-pos buffer)))
    149150        (bound 0))
    150151    (declare (fixnum offset bound))
    151152    (cond
    152      ((>= start *left-open-pos*)
     153     ((>= start (buffer-left-open-pos buffer))
    153154      (setq start (+ start offset)  bound (setq end (+ end offset))))
    154      ((> end *left-open-pos*)
    155       (setq bound *left-open-pos*  end (+ end offset)))
     155     ((> end (buffer-left-open-pos buffer))
     156      (setq bound (buffer-left-open-pos buffer)  end (+ end offset)))
    156157     (t
    157158      (setq bound end)))
    … …  
    166167      (when (= start bound)
    167168        (when (= start end) (return (values xpos ypos)))
    168         (setq start *right-open-pos*  bound end))
    169       (setq losing (%fcwa *open-chars* start bound losing-char))
     169        (setq start (buffer-right-open-pos buffer)  bound end))
     170      (setq losing (%fcwa (buffer-open-chars buffer) start bound losing-char))
    170171      (cond
    171172       (losing
    … …  
    173174          (truncate (+ xpos (- losing start)) width))
    174175        (setq ypos (+ ypos dy)  start losing)
    175         (do ((last (or (%fcwa *open-chars* start bound winning-char) bound)) str)
     176        (do ((last (or (%fcwa (buffer-open-chars buffer) start bound winning-char) bound)) str)
    176177            ((= start last))
    177178          (declare (fixnum last))
    178           (setq str (get-rep (schar *open-chars* start)))
     179          (setq str (get-rep (schar (buffer-open-chars buffer) start)))
    179180          (incf start)
    180181          (unless (simple-string-p str) (setq str (funcall str xpos)))
    … …  
    296297  an infinitely wide screen.  This takes into account tabs and control
    297298  characters."
    298   (let ((charpos (mark-charpos mark))
    299         (line (mark-line mark)))
    300     (if (eq line *open-line*)
    301         (values (cached-real-line-length line 10000 0 charpos))
    302         (values (real-line-length line 10000 0 charpos)))))
     299  (let* ((charpos (mark-charpos mark))
     300         (line (mark-line mark))
     301         (buffer (line-%buffer line)))
     302    (if (eq line (buffer-open-line buffer))
     303      (values (cached-real-line-length line 10000 0 charpos))
     304      (values (real-line-length line 10000 0 charpos)))))
    303305
    304306
    … …  
    310312;;;
    311313(defun find-position (line position start end width)
    312   (do* ((cached (eq line *open-line*))
     314  (do* ((buffer (line-%buffer line))
     315        (cached (eq line (buffer-open-line buffer)))
    313316        (lo start)
    314317        (hi (1- end))

  • branches/ide-1.0/ccl/hemlock/src/files.lisp

    r798 r6571  
    6262                          :element-type 'base-char
    6363                          :if-exists if-exists-action)
    64       (close-line)
     64      (close-line (line-%buffer (mark-line (region-start region))))
    6565      (fast-write-file region file))
    6666    ;; ### access is always ignored

  • branches/ide-1.0/ccl/hemlock/src/htext1.lisp

    r2064 r6571  
    5050
    5151
    52 #+no
    53 (defvar *line-cache-length* 200
    54   "Length of Open-Chars.")
    55 
    56 
    57 
    58 #+no
    59 (defvar *open-line* ()
    60   "Line open for hacking on.")
    61 
    62 
    63 
    64 #+no
    65 (defvar *open-chars*  (make-string *line-cache-length*)
    66   "Vector of characters for hacking on.")
    67 
    68 
    69 
    70 #+no
    71 (defvar *left-open-pos* 0
    72   "Index to first free character to left of mark in *Open-Chars*.")
    73 
    74 
    75 
    76 #+no
    77 (defvar *right-open-pos* 0
    78   "Index to first used character to right of mark in *Open-Chars*.")
    79 
    80 (defun grow-open-chars (&optional (new-length (* *line-cache-length* 2)))
     52
     53(defun grow-open-chars (buffer &optional (new-length (* (buffer-line-cache-length buffer) 2)))
    8154  "Grows *Open-Chars* to twice its current length, or the New-Length if
    8255  specified."
    8356  (let ((new-chars (make-string new-length))
    84         (new-right (- new-length (- *line-cache-length* *right-open-pos*))))
    85     (%sp-byte-blt *open-chars* 0 new-chars 0 *left-open-pos*)
    86     (%sp-byte-blt *open-chars* *right-open-pos* new-chars new-right new-length)
    87     (setf *right-open-pos* new-right)
    88     (setf *open-chars* new-chars)
    89     (setf *line-cache-length* new-length)))
    90 
    91 
    92 (defun close-line ()
     57        (new-right (- new-length (- (buffer-line-cache-length buffer)
     58                                    (buffer-right-open-pos buffer)))))
     59    (%sp-byte-blt (buffer-open-chars buffer) 0 new-chars 0 (buffer-left-open-pos buffer))
     60    (%sp-byte-blt (buffer-open-chars buffer) (buffer-right-open-pos buffer) new-chars new-right new-length)
     61    (setf (buffer-right-open-pos buffer) new-right)
     62    (setf (buffer-open-chars buffer) new-chars)
     63    (setf (buffer-line-cache-length buffer) new-length)))
     64
     65
     66(defun close-line (buffer)
    9367  "Stuffs the characters in the currently open line back into the line they
    94   came from, and sets *open-line* to Nil."
    95   (when *open-line*
     68  came from, and sets (buffer-open-line buffer) to Nil."
     69  (when (buffer-open-line buffer)
    9670    (hemlock-ext:without-interrupts
    97       (let* ((length (+ *left-open-pos* (- *line-cache-length* *right-open-pos*)))
     71      (let* ((length (+ (buffer-left-open-pos buffer)
     72                        (- (buffer-line-cache-length buffer)
     73                           (buffer-right-open-pos buffer))))
    9874             (string (make-string length)))
    99         (%sp-byte-blt *open-chars* 0 string 0 *left-open-pos*)
    100         (%sp-byte-blt *open-chars* *right-open-pos*  string *left-open-pos* length)
    101         (setf (line-chars *open-line*) string)
    102         (setf *open-line* nil)))))
     75        (%sp-byte-blt (buffer-open-chars buffer) 0 string 0 (buffer-left-open-pos buffer))
     76        (%sp-byte-blt (buffer-open-chars buffer) (buffer-right-open-pos buffer)  string (buffer-left-open-pos buffer) length)
     77        (setf (line-chars (buffer-open-line buffer)) string)
     78        (setf (buffer-open-line buffer) nil)))))
    10379
    10480;;; We stick decrementing fixnums in the line-chars slot of the open line
    … …  
    11389  "Closes the current *Open-Line* and opens the given Line at the Mark.
    11490  Don't call this, use modifying-line instead."
    115   (cond ((eq line *open-line*)
     91  (let* ((buffer (line-%buffer line)))
     92    (cond ((eq line (buffer-open-line buffer))
    11693           (let ((charpos (mark-charpos mark)))
    117              (cond ((< charpos *left-open-pos*) ; BLT 'em right!
    118                     (let ((right-start (- *right-open-pos*
    119                                           (- *left-open-pos* charpos))))
    120                       (%sp-byte-blt *open-chars*
     94             (cond ((< charpos (buffer-left-open-pos buffer)) ; BLT 'em right!
     95                    (let ((right-start (- (buffer-right-open-pos buffer)
     96                                          (- (buffer-left-open-pos buffer)
     97                                             charpos))))
     98                      (%sp-byte-blt (buffer-open-chars buffer)
    12199                                    charpos
    122                                     *open-chars*
     100                                    (buffer-open-chars buffer)
    123101                                    right-start
    124                                     *right-open-pos*)
    125                       (setf *left-open-pos* charpos)
    126                       (setf *right-open-pos* right-start)))
    127                    ((> charpos *left-open-pos*) ; BLT 'em left!
    128                     (%sp-byte-blt *open-chars*
    129                                   *right-open-pos*
    130                                   *open-chars*
    131                                   *left-open-pos*
     102                                    (buffer-right-open-pos buffer))
     103                      (setf (buffer-left-open-pos buffer) charpos)
     104                      (setf (buffer-right-open-pos buffer) right-start)))
     105                   ((> charpos (buffer-left-open-pos buffer)) ; BLT 'em left!
     106                    (%sp-byte-blt (buffer-open-chars buffer)
     107                                  (buffer-right-open-pos buffer)
     108                                  (buffer-open-chars buffer)
     109                                  (buffer-left-open-pos buffer)
    132110                                  charpos)
    133                     (setf *right-open-pos*
    134                           (+ *right-open-pos*
    135                              (- charpos *left-open-pos*)))
    136                     (setf *left-open-pos* charpos)))))
     111                    (setf (buffer-right-open-pos buffer)
     112                          (+ (buffer-right-open-pos buffer)
     113                             (- charpos (buffer-left-open-pos buffer))))
     114                    (setf (buffer-left-open-pos buffer) charpos)))))
    137115
    138116          (t
    139            (close-line)
     117           (close-line buffer)
    140118           (let* ((chars (line-chars line))
    141119                  (len (length chars)))
    142120             (declare (simple-string chars))
    143              (when (> len *line-cache-length*)
    144                (setf *line-cache-length* (* len 2))
    145                (setf *open-chars* (make-string *line-cache-length*)))
    146              (setf *open-line* line)
    147              (setf *left-open-pos* (mark-charpos mark))
    148              (setf *right-open-pos*
    149                    (- *line-cache-length*
    150                       (- (length chars) *left-open-pos*)))
    151              (%sp-byte-blt chars 0 *open-chars* 0
    152                            *left-open-pos*)
    153              (%sp-byte-blt chars *left-open-pos*
    154                            *open-chars*
    155                            *right-open-pos*
    156                            *line-cache-length*)))))
     121             (when (> len (buffer-line-cache-length buffer))
     122               (setf (buffer-line-cache-length buffer) (* len 2))
     123               (setf (buffer-open-chars buffer)
     124                     (make-string (buffer-line-cache-length buffer))))
     125             (setf (buffer-open-line buffer) line)
     126             (setf (buffer-left-open-pos buffer) (mark-charpos mark))
     127             (setf (buffer-right-open-pos buffer)
     128                   (- (buffer-line-cache-length buffer)
     129                      (- (length chars) (buffer-left-open-pos buffer))))
     130             (%sp-byte-blt chars 0 (buffer-open-chars buffer) 0
     131                           (buffer-left-open-pos buffer))
     132             (%sp-byte-blt chars (buffer-left-open-pos buffer)
     133                           (buffer-open-chars buffer)
     134                           (buffer-right-open-pos buffer)
     135                           (buffer-line-cache-length buffer)))))))
    157136
    158137
    … …  
    162141(defmacro modifying-line (line mark)
    163142  "Checks to see if the Line is already opened at the Mark, and calls Open-Line
    164   if not.  Sticks a tick in the *open-line*'s chars.  This must be called within
     143  if not.  Sticks a tick in the (buffer-open-line buffer)'s chars.  This must be called within
    165144  the body of a Modifying-Buffer form."
    166   `(progn
    167     (unless (and (= (mark-charpos ,mark) *left-open-pos*) (eq ,line *open-line*))
     145  (let* ((buffer (gensym)))
     146  `(let* ((,buffer (line-%buffer ,line)))
     147    (unless (and (= (mark-charpos ,mark) (buffer-left-open-pos ,buffer))
     148                 (eq ,line (buffer-open-line ,buffer)))
    168149      (open-line ,line ,mark))
    169     (setf (line-chars *open-line*) (decf *cache-modification-tick*))))
     150    (setf (line-chars (buffer-open-line ,buffer)) (decf *cache-modification-tick*)))))
    170151
    171152;;; Now-Tick tells us when now is and isn't.
    … …  
    360341  "Returns the characters in the line as a string.  The resulting string
    361342  must not be destructively modified.  This may be set with Setf."
    362   (if (eq line *open-line*)
    363     (close-line))
    364   (line-chars line))
     343  (let* ((buffer (line-%buffer line)))
     344    (if (eq line (buffer-open-line buffer))
     345      (close-line buffer))
     346    (line-chars line)))
    365347
    366348(defun %set-line-string (line string)
    … …  
    369351      (unless (simple-string-p string)
    370352        (setq string (coerce string 'simple-string)))
    371       (when (eq line *open-line*) (setq *open-line* nil))
     353      (when (eq line (buffer-open-line buffer))
     354        (setf (buffer-open-line buffer) nil))
    372355      (let ((length (length (the simple-string string))))
    373356        (dolist (m (line-marks line))
    … …  
    380363  "Return the Index'th character in Line.  If the index is the length of the
    381364  line then #\newline is returned."
    382   (if (eq line *open-line*)
    383       (if (< index *left-open-pos*)
    384           (schar *open-chars* index)
    385           (let ((index (+ index (- *right-open-pos* *left-open-pos*))))
    386             (if (= index *line-cache-length*)
    387                 #\newline
    388                 (schar *open-chars* index))))
     365  (let* ((buffer (line-%buffer line)))
     366    (if (eq line (buffer-open-line buffer))
     367      (if (< index (buffer-left-open-pos buffer))
     368        (schar (buffer-open-chars buffer) index)
     369        (let ((index (+ index (- (buffer-right-open-pos buffer)
     370                                 (buffer-left-open-pos buffer)))))
     371          (if (= index (buffer-line-cache-length buffer))
     372            #\newline
     373            (schar (buffer-open-chars buffer) index))))
    389374      (let ((chars (line-chars line)))
    390375        (declare (simple-string chars))
    391376        (if (= index (length chars))
    392             #\newline
    393             (schar chars index)))))
     377          #\newline
     378          (schar chars index))))))
    394379
    395380
    … …  
    561546  "Returns T if the line pointer to by Mark contains no characters, Nil
    562547  or otherwise."
    563   (let ((line (mark-line mark)))
    564     (if (eq line *open-line*)
    565         (and (= *left-open-pos* 0) (= *right-open-pos* *line-cache-length*))
     548  (let* ((line (mark-line mark))
     549         (buffer (line-%buffer line)))
     550    (if (eq line (buffer-open-line buffer))
     551        (and (= (buffer-left-open-pos buffer) 0)
     552             (= (buffer-right-open-pos buffer)
     553                (buffer-line-cache-length buffer)))
    566554        (= (length (line-chars line)) 0))))
    567555
    … …  
    578566;;;
    579567(defun blank-between-positions (line start end)
    580   (if (eq line *open-line*)
    581       (let ((gap (- *right-open-pos* *left-open-pos*)))
    582         (cond ((>= start *left-open-pos*)
    583                (check-range *open-chars* (+ start gap) (+ end gap)))
    584               ((<= end *left-open-pos*)
    585                (check-range *open-chars* start end))
    586               (t
    587                (and (check-range *open-chars* start *left-open-pos*)
    588                     (check-range *open-chars* *right-open-pos* (+ end gap))))))
     568  (let* ((buffer (line-%buffer line)))
     569    (if (eq line (buffer-open-line buffer))
     570      (let ((gap (- (buffer-right-open-pos buffer)
     571                    (buffer-left-open-pos buffer))))
     572        (cond ((>= start (buffer-left-open-pos buffer))
     573               (check-range (buffer-open-chars buffer) (+ start gap) (+ end gap)))
     574              ((<= end (buffer-left-open-pos buffer))
     575               (check-range (buffer-open-chars buffer) start end))
     576              (t
     577               (and (check-range (buffer-open-chars buffer) start (buffer-left-open-pos buffer))
     578                    (check-range (buffer-open-chars buffer) (buffer-right-open-pos buffer) (+ end gap))))))
    589579      (let ((chars (line-chars line)))
    590         (check-range chars start end))))
     580        (check-range chars start end)))))
    591581
    592582(defun blank-line-p (line)

  • branches/ide-1.0/ccl/hemlock/src/htext2.lisp

    r2064 r6571  
    2626(defun region-to-string (region)
    2727  "Returns a string containing the characters in the given Region."
    28   (close-line)
     28  (close-line (line-%buffer (mark-line (region-start region))))
    2929  (let* ((dst-length (count-characters region))
    3030         (string (make-string dst-length))
    … …  
    9999(defun previous-character (mark)
    100100  "Returns the character immediately before the given Mark."
    101   (let ((line (mark-line mark))
    102         (charpos (mark-charpos mark)))
     101  (let* ((line (mark-line mark))
     102         (buffer (line-%buffer line))
     103         (charpos (mark-charpos mark)))
    103104    (if (= charpos 0)
    104         (if (line-previous line)
    105             #\newline
    106             nil)
    107         (if (eq line *open-line*)
    108             (char (the simple-string *open-chars*)
    109                   (if (<= charpos *left-open-pos*)
    110                       (1- charpos)
    111                       (1- (+ *right-open-pos* (- charpos *left-open-pos*)))))
    112             (schar (line-chars line) (1- charpos))))))
     105      (if (line-previous line)
     106        #\newline
     107        nil)
     108      (if (eq line (buffer-open-line buffer))
     109        (schar (the simple-string (buffer-open-chars buffer))
     110               (if (<= charpos (buffer-left-open-pos buffer))
     111                 (1- charpos)
     112                 (1- (+ (buffer-right-open-pos buffer)
     113                        (- charpos (buffer-left-open-pos buffer))))))
     114        (schar (line-chars line) (1- charpos))))))
    113115
    114116(defun next-character (mark)
    115117  "Returns the character immediately after the given Mark."
    116   (let ((line (mark-line mark))
    117         (charpos (mark-charpos mark)))
    118     (if (eq line *open-line*)
    119         (if (= charpos (- *line-cache-length* (- *right-open-pos* *left-open-pos*)))
    120             (if (line-next line)
    121                 #\newline
    122                 nil)
    123             (schar *open-chars*
    124                    (if (< charpos *left-open-pos*)
    125                        charpos
    126                        (+ *right-open-pos* (- charpos *left-open-pos*)))))
    127         (let ((chars (line-chars line)))
    128           (if (= charpos (strlen chars))
    129               (if (line-next line)
    130                   #\newline
    131                   nil)
    132               (schar chars charpos))))))
     118  (let* ((line (mark-line mark))
     119         (buffer (line-%buffer line))
     120         (charpos (mark-charpos mark)))
     121    (if (eq line (buffer-open-line buffer))
     122      (if (= charpos (- (buffer-line-cache-length buffer)
     123                        (- (buffer-right-open-pos buffer)
     124                           (buffer-left-open-pos buffer))))
     125        (if (line-next line)
     126          #\newline
     127          nil)
     128        (schar (buffer-open-chars buffer)
     129               (if (< charpos (buffer-left-open-pos buffer))
     130                 charpos
     131                 (+ (buffer-right-open-pos buffer)
     132                    (- charpos (buffer-left-open-pos buffer))))))
     133      (let ((chars (line-chars line)))
     134        (if (= charpos (strlen chars))
     135          (if (line-next line)
     136            #\newline
     137            nil)
     138          (schar chars charpos))))))
    133139
    134140
    … …  
    148154      (modifying-line line mark)
    149155      (cond ((= (mark-charpos mark)
    150                 (- *line-cache-length* (- *right-open-pos* *left-open-pos*)))
     156                (- (buffer-line-cache-length buffer) (- (buffer-right-open-pos buffer) (buffer-left-open-pos buffer))))
    151157             ;; The mark is at the end of the line.
    152158             (unless next
    … …  
    157163               (let ((chars (line-chars next)))
    158164                 (declare (simple-string chars))
    159                  (setq *right-open-pos* (- *line-cache-length* (length chars)))
    160                  (when (<= *right-open-pos* *left-open-pos*)
    161                    (grow-open-chars (* (+ (length chars) *left-open-pos* 1) 2)))
    162                  (%sp-byte-blt chars 0 *open-chars* *right-open-pos*
    163                                *line-cache-length*)
    164                  (setf (schar *open-chars* *left-open-pos*) character)
    165                  (incf *left-open-pos*))
     165                 (setf (buffer-right-open-pos buffer) (- (buffer-line-cache-length buffer) (length chars)))
     166                 (when (<= (buffer-right-open-pos buffer) (buffer-left-open-pos buffer))
     167                   (grow-open-chars buffer (* (+ (length chars) (buffer-left-open-pos buffer) 1) 2)))
     168                 (%sp-byte-blt chars 0 (buffer-open-chars buffer) (buffer-right-open-pos buffer)
     169                               (buffer-line-cache-length buffer))
     170                 (setf (schar (buffer-open-chars buffer) (buffer-left-open-pos buffer)) character)
     171                 (incf (buffer-left-open-pos buffer)))
    166172               (move-some-marks (charpos next line)
    167                                 (+ charpos *left-open-pos*))
     173                                (+ charpos (buffer-left-open-pos buffer)))
    168174               (setq next (line-next next))
    169175               (setf (line-next line) next)
    … …  
    171177            ((char= character #\newline)
    172178             ;; The char is being changed to a newline, so we must split lines.
    173              (incf *right-open-pos*)
    174              (let* ((len (- *line-cache-length* *right-open-pos*))         
     179             (incf (buffer-right-open-pos buffer))
     180             (let* ((len (- (buffer-line-cache-length buffer) (buffer-right-open-pos buffer)))     
    175181                    (chars (make-string len))
    176182                    (new (make-line :chars chars  :previous line
    177183                                    :next next  :%buffer buffer)))
    178                (%sp-byte-blt *open-chars* *right-open-pos* chars 0 len)
    179                (maybe-move-some-marks* (charpos line new) *left-open-pos*
    180                                        (- charpos *left-open-pos* 1))
     184               (%sp-byte-blt (buffer-open-chars buffer) (buffer-right-open-pos buffer) chars 0 len)
     185               (maybe-move-some-marks* (charpos line new) (buffer-left-open-pos buffer)
     186                                       (- charpos (buffer-left-open-pos buffer) 1))
    181187               (setf (line-next line) new)
    182188               (when next (setf (line-previous next) new))
    183                (setq *right-open-pos* *line-cache-length*)
     189               (setf (buffer-right-open-pos buffer) (buffer-line-cache-length buffer))
    184190               (number-line new)))
    185191            (t
    186              (setf (char (the simple-string *open-chars*) *right-open-pos*)
     192             (setf (char (the simple-string (buffer-open-chars buffer)) (buffer-right-open-pos buffer))
    187193                   character)
    188194             (hi::buffer-note-modification buffer mark 1)))))
    … …  
    380386
    381387(defun %print-whole-line (structure stream)
    382   (cond ((eq structure *open-line*)
    383          (write-string *open-chars* stream :end *left-open-pos*)
    384          (write-string *open-chars* stream :start *right-open-pos*
    385                        :end *line-cache-length*))
    386         (t
    387          (write-string (line-chars structure) stream))))
     388  (let* ((buffer (line-%buffer structure)))
     389    (cond ((eq structure (buffer-open-line buffer))
     390           (write-string (buffer-open-chars buffer) stream :end (buffer-left-open-pos buffer))
     391           (write-string (buffer-open-chars buffer) stream :start (buffer-right-open-pos buffer)
     392                         :end (buffer-line-cache-length buffer)))
     393          (t
     394           (write-string (line-chars structure) stream)))))
    388395
    389396(defun %print-before-mark (mark stream)
    390397  (if (mark-line mark)
     398    (let* ((line (mark-line mark))
     399           (buffer (line-%buffer line))
     400           (chars (line-chars line))
     401           (charpos (mark-charpos mark))
     402           (length (line-length line)))
     403      (declare (simple-string chars))
     404      (cond ((or (> charpos length) (< charpos 0))
     405             (write-string "{bad mark}" stream))
     406            ((eq line (buffer-open-line buffer))
     407             (cond ((< charpos (buffer-left-open-pos buffer))
     408                    (write-string (buffer-open-chars buffer) stream :end charpos))
     409                   (t
     410                    (write-string (buffer-open-chars buffer) stream :end (buffer-left-open-pos buffer))
     411                    (let ((p (+ charpos (- (buffer-right-open-pos buffer) (buffer-left-open-pos buffer)))))
     412                      (write-string (buffer-open-chars buffer) stream  :start (buffer-right-open-pos buffer)
     413                                    :end p)))))
     414            (t
     415             (write-string chars stream :end charpos))))
     416    (write-string "{deleted mark}" stream)))
     417
     418
     419(defun %print-after-mark (mark stream)
     420  (if (mark-line mark)
    391421      (let* ((line (mark-line mark))
     422             (buffer (line-%buffer line))
    392423             (chars (line-chars line))
    393424             (charpos (mark-charpos mark))
    … …  
    396427        (cond ((or (> charpos length) (< charpos 0))
    397428               (write-string "{bad mark}" stream))
    398               ((eq line *open-line*)
    399                (cond ((< charpos *left-open-pos*)
    400                       (write-string *open-chars* stream :end charpos))
     429              ((eq line (buffer-open-line buffer))
     430               (cond ((< charpos (buffer-left-open-pos buffer))
     431                      (write-string (buffer-open-chars buffer) stream  :start charpos
     432                                    :end (buffer-left-open-pos buffer))
     433                      (write-string (buffer-open-chars buffer) stream  :start (buffer-right-open-pos buffer)
     434                                    :end (buffer-line-cache-length buffer)))
    401435                     (t
    402                       (write-string *open-chars* stream :end *left-open-pos*)
    403                       (let ((p (+ charpos (- *right-open-pos* *left-open-pos*))))
    404                         (write-string *open-chars* stream  :start *right-open-pos*
    405                                       :end p)))))
    406               (t
    407                (write-string chars stream :end charpos))))
    408       (write-string "{deleted mark}" stream)))
    409 
    410 
    411 (defun %print-after-mark (mark stream)
    412   (if (mark-line mark)
    413       (let* ((line (mark-line mark))
    414              (chars (line-chars line))
    415              (charpos (mark-charpos mark))
    416              (length (line-length line)))
    417         (declare (simple-string chars))
    418         (cond ((or (> charpos length) (< charpos 0))
    419                (write-string "{bad mark}" stream))
    420               ((eq line *open-line*)
    421                (cond ((< charpos *left-open-pos*)
    422                       (write-string *open-chars* stream  :start charpos
    423                                     :end *left-open-pos*)
    424                       (write-string *open-chars* stream  :start *right-open-pos*
    425                                     :end *line-cache-length*))
    426                      (t
    427                       (let ((p (+ charpos (- *right-open-pos* *left-open-pos*))))
    428                         (write-string *open-chars* stream :start p
    429                                       :end *line-cache-length*)))))
     436                      (let ((p (+ charpos (- (buffer-right-open-pos buffer) (buffer-left-open-pos buffer)))))
     437                        (write-string (buffer-open-chars buffer) stream :start p
     438                                      :end (buffer-line-cache-length buffer))))))
    430439              (t
    431440               (write-string chars stream  :start charpos  :end length))))
    … …  
    455464         (end (region-end region))
    456465         (first-line (mark-line start))
     466         (buffer (line-%buffer first-line))
    457467         (last-line (mark-line end)))
    458468    (cond
    … …  
    469479                ((or (< cs 0) (> ce len))
    470480                 (write-string "{bad region}" stream))
    471                 ((eq first-line *open-line*)
    472                  (let ((gap (- *right-open-pos* *left-open-pos*)))
     481                ((eq first-line (buffer-open-line buffer))
     482                 (let ((gap (- (buffer-right-open-pos buffer) (buffer-left-open-pos buffer))))
    473483                   (cond
    474                     ((<= ce *left-open-pos*)
    475                      (write-string *open-chars* stream  :start cs  :end ce))
    476                     ((>= cs *left-open-pos*)
    477                      (write-string *open-chars* stream  :start (+ cs gap)
     484                    ((<= ce (buffer-left-open-pos buffer))
     485                     (write-string (buffer-open-chars buffer) stream  :start cs  :end ce))
     486                    ((>= cs (buffer-left-open-pos buffer))
     487                     (write-string (buffer-open-chars buffer) stream  :start (+ cs gap)
    478488                                   :end (+ ce gap)))
    479489                    (t
    480                      (write-string *open-chars* stream :start cs
    481                                    :end *left-open-pos*)
    482                      (write-string *open-chars* stream :start *right-open-pos*
     490                     (write-string (buffer-open-chars buffer) stream :start cs
     491                                   :end (buffer-left-open-pos buffer))
     492                     (write-string (buffer-open-chars buffer) stream :start (buffer-right-open-pos buffer)
    483493                                   :end (+ gap ce))))))
    484494                (t

  • branches/ide-1.0/ccl/hemlock/src/htext3.lisp

    r2064 r6571  
    4747                      (cond ((char= character #\newline)
    4848                             (let* ((next (line-next line))
    49                                     (new-chars (subseq (the simple-string *open-chars*)
    50                                                        0 *left-open-pos*))
     49                                    (new-chars (subseq (the simple-string (buffer-open-chars buffer))
     50                                                       0 (buffer-left-open-pos buffer)))
    5151                                    (new-line (make-line :%buffer buffer
    5252                                                         :chars (decf *cache-modification-tick*)
    5353                                                         :previous line
    5454                                                         :next next)))
    55                                (maybe-move-some-marks (charpos line new-line) *left-open-pos*
    56                                                       (- charpos *left-open-pos*))
     55                               (maybe-move-some-marks (charpos line new-line) (buffer-left-open-pos buffer)
     56                                                      (- charpos (buffer-left-open-pos buffer)))
    5757                               (setf (line-%chars line) new-chars)
    5858                               (setf (line-next line) new-line)
    5959                               (if next (setf (line-previous next) new-line))
    6060                               (number-line new-line)
    61                                (setq *open-line* new-line  *left-open-pos* 0)))
     61                               (setf (buffer-open-line buffer) new-line
     62                                     (buffer-left-open-pos buffer) 0)))
    6263                            (t
    63                              (if (= *right-open-pos* *left-open-pos*)
    64                                (grow-open-chars))
     64                             (if (= (buffer-right-open-pos buffer)
     65                                    (buffer-left-open-pos buffer))
     66                               (grow-open-chars buffer))
    6567             
    66                              (maybe-move-some-marks (charpos line) *left-open-pos*
     68                             (maybe-move-some-marks (charpos line) (buffer-left-open-pos buffer)
    6769                                                    (1+ charpos))
    6870             
    6971                             (cond
    7072                               ((eq (mark-%kind mark) :right-inserting)
    71                                 (decf *right-open-pos*)
    72                                 (setf (char (the simple-string *open-chars*) *right-open-pos*)
     73                                (decf (buffer-right-open-pos buffer))
     74                                (setf (char (the simple-string (buffer-open-chars buffer)) (buffer-right-open-pos buffer))
    7375                                      character))
    7476                               (t
    75                                 (setf (char (the simple-string *open-chars*) *left-open-pos*)
     77                                (setf (char (the simple-string (buffer-open-chars buffer)) (buffer-left-open-pos buffer))
    7678                                      character)
    77                                 (incf *left-open-pos*)))))
     79                                (incf (buffer-left-open-pos buffer))))))
    7880                      (buffer-note-insertion buffer mark 1))))
    7981
    … …  
    107109         (modifying-line line mark)
    108110         (let ((length (- end start)))
    109            (if (<= *right-open-pos* (+ *left-open-pos* end))
    110              (grow-open-chars (* (+ *line-cache-length* end) 2)))
     111           (if (<= (buffer-right-open-pos buffer) (+ (buffer-left-open-pos buffer) end))
     112             (grow-open-chars buffer (* (+ (buffer-line-cache-length buffer) end) 2)))
    111113             
    112            (maybe-move-some-marks (charpos line) *left-open-pos*
     114           (maybe-move-some-marks (charpos line) (buffer-left-open-pos buffer)
    113115                                  (+ charpos length))
    114116           (cond
    115117             ((eq (mark-%kind mark) :right-inserting)
    116               (let ((new (- *right-open-pos* length)))
    117                 (%sp-byte-blt string start *open-chars* new *right-open-pos*)
    118                 (setq *right-open-pos* new)))
     118              (let ((new (- (buffer-right-open-pos buffer) length)))
     119                (%sp-byte-blt string start (buffer-open-chars buffer) new (buffer-right-open-pos buffer))
     120                (setf (buffer-right-open-pos buffer) new)))
    119121             (t
    120               (let ((new (+ *left-open-pos* length)))
    121                 (%sp-byte-blt string start *open-chars* *left-open-pos* new)
    122                 (setq *left-open-pos* new)))))
     122              (let ((new (+ (buffer-left-open-pos buffer) length)))
     123                (%sp-byte-blt string start (buffer-open-chars buffer) (buffer-left-open-pos buffer) new)
     124                (setf (buffer-left-open-pos buffer) new)))))
    123125         (buffer-note-insertion buffer mark (- end start)))))))
    124126
    … …  
    133135         (end (region-end region))
    134136         (first-line (mark-line start))
     137         (buffer (line-%buffer first-line))
    135138         (last-line (mark-line end))
    136139         (first-charpos (mark-charpos start))
    … …  
    140143     ((eq first-line last-line)
    141144      ;; simple case -- just BLT the characters in with insert-string
    142       (if (eq first-line *open-line*) (close-line))
     145      (if (eq first-line (buffer-open-line buffer))
     146        (close-line buffer))
    143147      (insert-string mark (line-chars first-line) first-charpos last-charpos))
    144148     (t
    145       (close-line)
     149      (close-line buffer)
    146150      (let* ((line (mark-line mark))
    147151             (next (line-next line))
    148152             (charpos (mark-charpos mark))
    149              (buffer (line-%buffer line))
    150153             (old-chars (line-chars line)))
    151154        (declare (simple-string old-chars))
    … …  
    205208         (first-charpos (mark-charpos start))
    206209         (last-charpos (mark-charpos end))
    207          (nins (count-characters region)))
     210         (nins (count-characters region))
     211         (buffer (line-%buffer (mark-line mark))))
    208212    (cond
    209213     ((eq first-line last-line)
    210214      ;; Simple case -- just BLT the characters in with insert-string.
    211       (if (eq first-line *open-line*) (close-line))
     215      (if (eq first-line (buffer-open-line buffer))
     216        (close-line buffer))
    212217      (insert-string mark (line-chars first-line) first-charpos last-charpos))
    213218     (t
    214219      (when (bufferp (line-%buffer first-line))
    215220        (error "Region is linked into Buffer ~S." (line-%buffer first-line)))
    216       (close-line)
     221      (close-line buffer)
    217222      (let* ((line (mark-line mark))
    218223             (second-line (line-next first-line))
    219224             (next (line-next line))
    220225             (charpos (mark-charpos mark))
    221              (buffer (line-%buffer line))
    222226             (old-chars (line-chars line)))
    223227        (declare (simple-string old-chars))

  • branches/ide-1.0/ccl/hemlock/src/htext4.lisp

    r2064 r6571  
    4444                         (cond
    4545                           ((minusp n)
    46                             (setq *left-open-pos* (+ *left-open-pos* n))
     46                            (incf (buffer-left-open-pos buffer) n)
    4747                            (move-some-marks (pos line)
    48                                              (if (> pos *left-open-pos*)
    49                                                (if (<= pos charpos) *left-open-pos* (+ pos n))
     48                                             (if (> pos (buffer-left-open-pos buffer))
     49                                               (if (<= pos charpos) (buffer-left-open-pos buffer) (+ pos n))
    5050                                               pos)))
    5151         
    5252                           (t
    53                             (setq *right-open-pos* (+ *right-open-pos* n))
     53                            (incf (buffer-right-open-pos buffer) n)
    5454                            (let ((bound (+ charpos n)))
    5555                              (move-some-marks (pos line)
    5656                                               (if (> pos charpos)
    57                                                  (if (<= pos bound) *left-open-pos* (- pos n))
     57                                                 (if (<= pos bound) (buffer-left-open-pos buffer) (- pos n))
    5858                                                 pos)))))
    5959                         (buffer-note-deletion buffer mark n)
    … …  
    9999               (modifying-line first-line start)
    100100               (let ((num (- last-charpos first-charpos)))
    101                  (setq *right-open-pos* (+ *right-open-pos* num))
     101                 (incf (buffer-right-open-pos buffer) num)
    102102                 ;; and fix up any marks in there:
    103103                 (move-some-marks (charpos first-line)
    … …  
    109109              (t
    110110               ;; hairy case -- squish lines together:
    111                (close-line)
     111               (close-line buffer)
    112112               (let* ((first-chars (line-chars first-line))
    113113                      (last-chars (line-chars last-line))
    … …  
    177177                   (modifying-line first-line start)
    178178                   (let* ((num (- last-charpos first-charpos))
    179                           (new-right (+ *right-open-pos* num))
     179                          (new-right (+ (buffer-right-open-pos buffer) num))
    180180                          (new-chars (make-string num))
    181181                          (new-line (make-line
    … …  
    183183                                     :%buffer (incf *disembodied-buffer-counter*))))
    184184                     (declare (simple-string new-chars))
    185                      (%sp-byte-blt *open-chars* *right-open-pos* new-chars 0 num)
    186                      (setq *right-open-pos* new-right)
     185                     (%sp-byte-blt (buffer-open-chars buffer) (buffer-right-open-pos buffer) new-chars 0 num)
     186                     (setf (buffer-right-open-pos buffer) new-right)
    187187                     ;; and fix up any marks in there:
    188188                     (move-some-marks (charpos first-line)
    … …  
    197197                  (t
    198198                   ;; hairy case -- squish lines together:
    199                    (close-line)
     199                   (close-line buffer)
    200200                   (let* ((first-chars (line-chars first-line))
    201201                          (last-chars (line-chars last-line))
    … …  
    271271         (end (region-end region))
    272272         (first-line (mark-line start))
     273         (buffer (line-%buffer first-line))
    273274         (last-line (mark-line end))
    274275         (first-charpos (mark-charpos start))
    … …  
    277278    (cond
    278279     ((eq first-line last-line)
    279       (when (eq first-line *open-line*) (close-line))
     280      (when (eq first-line (buffer-open-line buffer)) (close-line buffer))
    280281      (let* ((length (- last-charpos first-charpos))
    281282             (chars (make-string length))
    … …  
    285286                              (mark line length :left-inserting))))
    286287     (t
    287       (close-line)
     288      (close-line buffer)
    288289      (let* ((first-chars (line-chars first-line))
    289290             (length (- (length first-chars) first-charpos))
    … …  
    352353      (modifying-line end-line end)
    353354      (cond ((eq start-line end-line)
    354              (let* ((res (fcs function (subseq *open-chars* first last)))
     355             (let* ((res (fcs function (subseq (buffer-open-chars buffer)
     356                                               first last)))
    355357                    (rlen (length res))
    356358                    (new-left (+ first rlen))
    357                     (delta (- new-left *left-open-pos*)))
     359                    (delta (- new-left (buffer-left-open-pos buffer))))
    358360               (declare (simple-string res))
    359                (when (> new-left *right-open-pos*)
    360                  (grow-open-chars (+ new-left *line-cache-length*)))
    361                (%sp-byte-blt res 0 *open-chars* first *left-open-pos*)
     361               (when (> new-left (buffer-right-open-pos buffer))
     362                 (grow-open-chars buffer (+ new-left (buffer-line-cache-length buffer))))
     363               (%sp-byte-blt res 0 (buffer-open-chars buffer) first (buffer-left-open-pos buffer))
    362364               ;;
    363365               ;; Move marks to start or end of region, depending on kind.
    … …  
    370372                                   new-left first)
    371373                               (+ charpos delta))))))
    372                (setq *left-open-pos* new-left)))
     374               (setf (buffer-left-open-pos buffer) new-left)))
    373375            (t
    374376             ;;
    … …  
    403405             ;;
    404406             ;; Do the last line, which is cached.
    405              (let* ((res (fcs function (subseq (the simple-string *open-chars*)
     407             (let* ((res (fcs function (subseq (the simple-string (buffer-open-chars buffer))
    406408                                               0 last)))
    407409                    (rlen (length res))
    408410                    (delta (- rlen last)))
    409411               (declare (simple-string res))
    410                (when (> rlen *right-open-pos*)
    411                  (grow-open-chars (+ rlen *line-cache-length*)))
    412                (%sp-byte-blt res 0 *open-chars* 0 rlen)
    413                (setq *left-open-pos* rlen)
     412               (when (> rlen (buffer-right-open-pos buffer))
     413                 (grow-open-chars buffer (+ rlen (buffer-line-cache-length buffer))))
     414               (%sp-byte-blt res 0 (buffer-open-chars buffer) 0 rlen)
     415               (setf (buffer-left-open-pos buffer) rlen)
    414416               ;;
    415417               ;; Adjust marks after the end of the region and save ones in it.

  • branches/ide-1.0/ccl/hemlock/src/line.lisp

    r60 r6571  
    140140(defmacro line-length* (line)
    141141  "Returns the number of characters on the line, but it's a macro!"
    142   `(cond ((eq ,line *open-line*)
    143           (+ *left-open-pos* (- *line-cache-length* *right-open-pos*)))
    144          ((line-buffered-p ,line))
    145          (t
    146           (length (the simple-string (line-%chars ,line))))))
     142  (let* ((buffer (gensym)))
     143    `(let* ((,buffer (line-%buffer ,line)))
     144      (cond ((eq ,line (buffer-open-line ,buffer))
     145             (+ (buffer-left-open-pos ,buffer) (- (buffer-line-cache-length ,buffer) (buffer-right-open-pos ,buffer))))
     146            ((line-buffered-p ,line))
     147            (t
     148             (length (the simple-string (line-%chars ,line))))))))

  • branches/ide-1.0/ccl/hemlock/src/search1.lisp

    r6 r6571  
    634634  If there is no match for the pattern then Mark is not modified and NIL
    635635  is returned."
    636   (close-line)
     636  (close-line (line-%buffer (mark-line mark)))
    637637  (multiple-value-bind (line start matched)
    638638                       (funcall (search-pattern-search-function search-pattern)
    … …  
    650650  in the text starting at the given Mark.  If N is Nil, all occurrences
    651651  following the Mark are replaced."
    652   (close-line)
    653   (do* ((replacement (coerce replacement 'simple-string))
    654         (new (length (the simple-string replacement)))
    655         (fun (search-pattern-search-function search-pattern))
    656         (forward-p (eq (search-pattern-direction search-pattern) :forward))
    657         (n (if n (1- n) -1) (1- n))
    658         (m (copy-mark mark :temporary)) line start matched)
    659        (())
    660     (multiple-value-setq (line start matched)
    661       (funcall fun search-pattern (mark-line m) (mark-charpos m)))
    662     (unless matched (return m))
    663     (setf (mark-line m) line  (mark-charpos m) start)
    664     (delete-characters m matched)
    665     (insert-string m replacement)
    666     (when forward-p (character-offset m new))
    667     (when (zerop n) (return m))
    668     (close-line)))
     652  (let* ((buffer (line-%buffer (mark-line mark))))
     653    (close-line buffer)
     654    (do* ((replacement (coerce replacement 'simple-string))
     655          (new (length (the simple-string replacement)))
     656          (fun (search-pattern-search-function search-pattern))
     657          (forward-p (eq (search-pattern-direction search-pattern) :forward))
     658          (n (if n (1- n) -1) (1- n))
     659          (m (copy-mark mark :temporary)) line start matched)
     660         (())
     661      (multiple-value-setq (line start matched)
     662        (funcall fun search-pattern (mark-line m) (mark-charpos m)))
     663      (unless matched (return m))
     664      (setf (mark-line m) line  (mark-charpos m) start)
     665      (delete-characters m matched)
     666      (insert-string m replacement)
     667      (when forward-p (character-offset m new))
     668      (when (zerop n) (return m))
     669      (close-line buffer))))

  • branches/ide-1.0/ccl/hemlock/src/struct.lisp

    r807 r6571  
    111111  (external-format :unix)     ; Line-termination, for the time being
    112112  process                     ; Maybe a listener
    113   (gap-context )              ; The value of *buffer-gap-context*
    114                               ; in the thread that can modify the buffer.
     113  (line-cache-length 200)     ; Length of string used for per-buffer gap.
     114  (open-chars (make-string 200)) ; String used for per-buffer cache
     115  (left-open-pos 0)           ; Index of first free character to left of
     116                              ; gap in open-chars.
     117  (right-open-pos 0)          ; Index of first used character to right of
     118                              ; gap in open-chars
     119  %open-line                  ; line which open-chars represent, or nil.
    115120  protected-region            ; (optional) write-protected region
    116121  (font-regions (ccl::init-dll-header (ccl::make-dll-header)))
    117122                                        ; a doubly-linked list of font regions.
    118123  active-font-region                    ; currently active font region
     124  (lock (ccl:make-lock))
    119125  )
    120126
    … …  
    679685   any buffer whose fields list contains the field.")
    680686
    681 ;;; Shared buffer-gap context, used to communicate between command threads
    682 ;;; and the event thread.  Note that this isn't buffer-specific; in particular,
    683 ;;; OPEN-LINE and friends may not point at a line that belongs to any
    684 ;;; buffer.
    685 
    686 (defstruct buffer-gap-context
    687   (lock (ccl::make-lock))
    688   (left-open-pos 0)
    689   (right-open-pos 0)
    690   (line-cache-length 200)
    691   (open-line nil)
    692   (open-chars (make-string 200))
    693 )
    694 
    695 (define-symbol-macro *line-cache-length* (buffer-gap-context-line-cache-length *buffer-gap-context*))
    696 (define-symbol-macro *open-line* (buffer-gap-context-open-line *buffer-gap-context*))
    697 (define-symbol-macro *open-chars* (buffer-gap-context-open-chars *buffer-gap-context*))
    698 (define-symbol-macro *left-open-pos* (buffer-gap-context-left-open-pos *buffer-gap-context*))
    699 (define-symbol-macro *right-open-pos* (buffer-gap-context-right-open-pos *buffer-gap-context*))
    700 
     687
     688
     689(defun buffer-open-line (buffer)
     690  (if (typep buffer 'buffer)
     691    (buffer-%open-line buffer)))
     692
     693(defun (setf buffer-open-line) (line buffer)
     694  (setf (buffer-%open-line buffer) line))
     695
     696
     697
     698
     699
     700             

  • branches/ide-1.0/ccl/hemlock/src/syntax.lisp

    r55 r6571  
    455455                   chars ,start (strlen chars) ,vector ,mask))))
    456456;;;
    457 (defmacro cache-find-attribute (start result vector mask)
    458   `(let ((gap (- *right-open-pos* *left-open-pos*)))
     457(defmacro cache-find-attribute (buffer start result vector mask)
     458  `(let ((gap (- (buffer-right-open-pos buffer)
     459                 (buffer-left-open-pos buffer))))
    459460     (declare (fixnum gap))
    460461     (cond
    461       ((>= ,start *left-open-pos*)
     462      ((>= ,start (buffer-left-open-pos buffer))
    462463       (setq ,result
    463464             (%sp-find-character-with-attribute
    464               *open-chars* (+ ,start gap) *line-cache-length* ,vector ,mask))
     465              (buffer-open-chars buffer) (+ ,start gap) (buffer-line-cache-length buffer) ,vector ,mask))
    465466       (when ,result (decf ,result gap)))
    466467      ((setq ,result (%sp-find-character-with-attribute
    467                       *open-chars* ,start *left-open-pos* ,vector ,mask)))
     468                      (buffer-open-chars buffer) ,start (buffer-left-open-pos buffer) ,vector ,mask)))
    468469      (t
    469470       (setq ,result
    470471             (%sp-find-character-with-attribute
    471               *open-chars* *right-open-pos* *line-cache-length* ,vector ,mask))
     472              (buffer-open-chars buffer) (buffer-right-open-pos buffer) (buffer-line-cache-length buffer) ,vector ,mask))
    472473       (when ,result (decf ,result gap))))))
    473474); eval-when (:compile-toplevel :execute)
    … …  
    475476(defun find-attribute (mark attribute &optional (test #'not-zerop))
    476477  "Find the next character whose attribute value satisfies test."
    477   (let ((charpos (mark-charpos mark))
     478  (let* ((charpos (mark-charpos mark))
    478479        (line (mark-line mark))
     480        (buffer (line-%buffer line))
    479481        (mask 0)
    480482        vector end-wins)
    … …  
    484486    (cond
    485487     ((cond
    486        ((eq line *open-line*)
    487         (when (cache-find-attribute charpos charpos vector mask)
     488       ((eq line (buffer-open-line buffer))
     489        (when (cache-find-attribute buffer charpos charpos vector mask)
    488490          (setf (mark-charpos mark) charpos) mark))
    489491       (t
    … …  
    504506              (return (line-end mark prev))
    505507              (return nil)))
    506          ((eq line *open-line*)
    507           (when (cache-find-attribute 0 charpos vector mask)
     508         ((eq line (buffer-open-line buffer))
     509          (when (cache-find-attribute buffer 0 charpos vector mask)
    508510            (return (move-to-position mark charpos line))))
    509511         (t
    … …  
    523525                    chars 0 ,(or start '(strlen chars)) ,vector ,mask))))
    524526;;;
    525 (defmacro rev-cache-find-attribute (start result vector mask)
    526   `(let ((gap (- *right-open-pos* *left-open-pos*)))
     527(defmacro rev-cache-find-attribute (buffer start result vector mask)
     528  `(let ((gap (- (buffer-right-open-pos buffer) (buffer-left-open-pos buffer))))
    527529     (declare (fixnum gap))
    528530     (cond
    529531      ,@(when start
    530           `(((<= ,start *left-open-pos*)
     532          `(((<= ,start (buffer-left-open-pos buffer))
    531533             (setq ,result
    532534                   (%sp-reverse-find-character-with-attribute
    533                     *open-chars* 0 ,start ,vector ,mask)))))
     535                    (buffer-open-chars buffer) 0 ,start ,vector ,mask)))))
    534536      ((setq ,result (%sp-reverse-find-character-with-attribute
    535                       *open-chars* *right-open-pos*
    536                       ,(if start `(+ ,start gap) '*line-cache-length*)
     537                      (buffer-open-chars buffer) (buffer-right-open-pos buffer)
     538                      ,(if start `(+ ,start gap) '(buffer-line-cache-length buffer))
    537539                      ,vector ,mask))
    538540       (decf ,result gap))
    … …  
    540542       (setq ,result
    541543             (%sp-reverse-find-character-with-attribute
    542               *open-chars* 0 *left-open-pos* ,vector ,mask))))))
     544              (buffer-open-chars buffer) 0 (buffer-left-open-pos buffer) ,vector ,mask))))))
    543545
    544546); eval-when (:compile-toplevel :execute)
    … …  
    547549  "Find the previous character whose attribute value satisfies test."
    548550  (let* ((charpos (mark-charpos mark))
    549          (line (mark-line mark)) vector mask end-wins)
     551         (line (mark-line mark))
     552         (buffer (line-%buffer line))
     553         vector mask end-wins)
    550554    (declare (type (or (simple-array (mod 256)) null) vector)
    551555             (type (or fixnum null) charpos))
    … …  
    553557    (cond
    554558     ((cond
    555        ((eq line *open-line*)
    556         (when (rev-cache-find-attribute charpos charpos vector mask)
     559       ((eq line (buffer-open-line buffer))
     560        (when (rev-cache-find-attribute buffer charpos charpos vector mask)
    557561          (setf (mark-charpos mark) (1+ charpos)) mark))
    558562       (t
    … …  
    572576              (return (line-start mark next))
    573577              (return nil)))
    574          ((eq line *open-line*)
    575           (when (rev-cache-find-attribute nil charpos vector mask)
     578         ((eq line (buffer-open-line buffer))
     579          (when (rev-cache-find-attribute buffer nil charpos vector mask)
    576580            (return (move-to-position mark (1+ charpos) line))))
    577581         (t
Note: See TracChangeset for help on using the changeset viewer.