Changeset 6580


Ignore:
Timestamp:
May 20, 2007, 9:05:07 AM (18 years ago)
Author:
Gary Byers
Message:

Back out of gap-context change, for now.

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

Legend:

Unmodified
Added
Removed

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

    r6571 r6580  
    5050
    5151
    52 
    53 (defun grow-open-chars (buffer &optional (new-length (* (buffer-line-cache-length buffer) 2)))
     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)))
    5481  "Grows *Open-Chars* to twice its current length, or the New-Length if
    5582  specified."
    5683  (let ((new-chars (make-string new-length))
    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)
     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 ()
    6793  "Stuffs the characters in the currently open line back into the line they
    68   came from, and sets (buffer-open-line buffer) to Nil."
    69   (when (buffer-open-line buffer)
     94  came from, and sets *open-line* to Nil."
     95  (when *open-line*
    7096    (hemlock-ext:without-interrupts
    71       (let* ((length (+ (buffer-left-open-pos buffer)
    72                         (- (buffer-line-cache-length buffer)
    73                            (buffer-right-open-pos buffer))))
     97      (let* ((length (+ *left-open-pos* (- *line-cache-length* *right-open-pos*)))
    7498             (string (make-string length)))
    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)))))
     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)))))
    79103
    80104;;; We stick decrementing fixnums in the line-chars slot of the open line
    … …  
    89113  "Closes the current *Open-Line* and opens the given Line at the Mark.
    90114  Don't call this, use modifying-line instead."
    91   (let* ((buffer (line-%buffer line)))
    92     (cond ((eq line (buffer-open-line buffer))
     115  (cond ((eq line *open-line*)
    93116           (let ((charpos (mark-charpos mark)))
    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)
     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*
    99121                                    charpos
    100                                     (buffer-open-chars buffer)
     122                                    *open-chars*
    101123                                    right-start
    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)
     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*
    110132                                  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)))))
     133                    (setf *right-open-pos*
     134                          (+ *right-open-pos*
     135                             (- charpos *left-open-pos*)))
     136                    (setf *left-open-pos* charpos)))))
    115137
    116138          (t
    117            (close-line buffer)
     139           (close-line)
    118140           (let* ((chars (line-chars line))
    119141                  (len (length chars)))
    120142             (declare (simple-string chars))
    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)))))))
     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*)))))
    136157
    137158
    … …  
    141162(defmacro modifying-line (line mark)
    142163  "Checks to see if the Line is already opened at the Mark, and calls Open-Line
    143   if not.  Sticks a tick in the (buffer-open-line buffer)'s chars.  This must be called within
     164  if not.  Sticks a tick in the *open-line*'s chars.  This must be called within
    144165  the body of a Modifying-Buffer form."
    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)))
     166  `(progn
     167    (unless (and (= (mark-charpos ,mark) *left-open-pos*) (eq ,line *open-line*))
    149168      (open-line ,line ,mark))
    150     (setf (line-chars (buffer-open-line ,buffer)) (decf *cache-modification-tick*)))))
     169    (setf (line-chars *open-line*) (decf *cache-modification-tick*))))
    151170
    152171;;; Now-Tick tells us when now is and isn't.
    … …  
    341360  "Returns the characters in the line as a string.  The resulting string
    342361  must not be destructively modified.  This may be set with Setf."
    343   (let* ((buffer (line-%buffer line)))
    344     (if (eq line (buffer-open-line buffer))
    345       (close-line buffer))
    346     (line-chars line)))
     362  (if (eq line *open-line*)
     363    (close-line))
     364  (line-chars line))
    347365
    348366(defun %set-line-string (line string)
    … …  
    351369      (unless (simple-string-p string)
    352370        (setq string (coerce string 'simple-string)))
    353       (when (eq line (buffer-open-line buffer))
    354         (setf (buffer-open-line buffer) nil))
     371      (when (eq line *open-line*) (setq *open-line* nil))
    355372      (let ((length (length (the simple-string string))))
    356373        (dolist (m (line-marks line))
    … …  
    363380  "Return the Index'th character in Line.  If the index is the length of the
    364381  line then #\newline is returned."
    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))))
     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))))
    374389      (let ((chars (line-chars line)))
    375390        (declare (simple-string chars))
    376391        (if (= index (length chars))
    377           #\newline
    378           (schar chars index))))))
     392            #\newline
     393            (schar chars index)))))
    379394
    380395
    … …  
    546561  "Returns T if the line pointer to by Mark contains no characters, Nil
    547562  or otherwise."
    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)))
     563  (let ((line (mark-line mark)))
     564    (if (eq line *open-line*)
     565        (and (= *left-open-pos* 0) (= *right-open-pos* *line-cache-length*))
    554566        (= (length (line-chars line)) 0))))
    555567
    … …  
    566578;;;
    567579(defun blank-between-positions (line start end)
    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))))))
     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))))))
    579589      (let ((chars (line-chars line)))
    580         (check-range chars start end)))))
     590        (check-range chars start end))))
    581591
    582592(defun blank-line-p (line)

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

    r6571 r6580  
    2626(defun region-to-string (region)
    2727  "Returns a string containing the characters in the given Region."
    28   (close-line (line-%buffer (mark-line (region-start region))))
     28  (close-line)
    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          (buffer (line-%buffer line))
    103          (charpos (mark-charpos mark)))
     101  (let ((line (mark-line mark))
     102        (charpos (mark-charpos mark)))
    104103    (if (= charpos 0)
    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))))))
     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))))))
    115113
    116114(defun next-character (mark)
    117115  "Returns the character immediately after the given Mark."
    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))))))
     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))))))
    139133
    140134
    … …  
    154148      (modifying-line line mark)
    155149      (cond ((= (mark-charpos mark)
    156                 (- (buffer-line-cache-length buffer) (- (buffer-right-open-pos buffer) (buffer-left-open-pos buffer))))
     150                (- *line-cache-length* (- *right-open-pos* *left-open-pos*)))
    157151             ;; The mark is at the end of the line.
    158152             (unless next
    … …  
    163157               (let ((chars (line-chars next)))
    164158                 (declare (simple-string chars))
    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)))
     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*))
    172166               (move-some-marks (charpos next line)
    173                                 (+ charpos (buffer-left-open-pos buffer)))
     167                                (+ charpos *left-open-pos*))
    174168               (setq next (line-next next))
    175169               (setf (line-next line) next)
    … …  
    177171            ((char= character #\newline)
    178172             ;; The char is being changed to a newline, so we must split lines.
    179              (incf (buffer-right-open-pos buffer))
    180              (let* ((len (- (buffer-line-cache-length buffer) (buffer-right-open-pos buffer)))     
     173             (incf *right-open-pos*)
     174             (let* ((len (- *line-cache-length* *right-open-pos*))         
    181175                    (chars (make-string len))
    182176                    (new (make-line :chars chars  :previous line
    183177                                    :next next  :%buffer buffer)))
    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))
     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))
    187181               (setf (line-next line) new)
    188182               (when next (setf (line-previous next) new))
    189                (setf (buffer-right-open-pos buffer) (buffer-line-cache-length buffer))
     183               (setq *right-open-pos* *line-cache-length*)
    190184               (number-line new)))
    191185            (t
    192              (setf (char (the simple-string (buffer-open-chars buffer)) (buffer-right-open-pos buffer))
     186             (setf (char (the simple-string *open-chars*) *right-open-pos*)
    193187                   character)
    194188             (hi::buffer-note-modification buffer mark 1)))))
    … …  
    386380
    387381(defun %print-whole-line (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)))))
     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))))
    395388
    396389(defun %print-before-mark (mark stream)
    397390  (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)
    421391      (let* ((line (mark-line mark))
    422              (buffer (line-%buffer line))
    423392             (chars (line-chars line))
    424393             (charpos (mark-charpos mark))
    … …  
    427396        (cond ((or (> charpos length) (< charpos 0))
    428397               (write-string "{bad mark}" stream))
    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)))
     398              ((eq line *open-line*)
     399               (cond ((< charpos *left-open-pos*)
     400                      (write-string *open-chars* stream :end charpos))
    435401                     (t
    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))))))
     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*)))))
    439430              (t
    440431               (write-string chars stream  :start charpos  :end length))))
    … …  
    464455         (end (region-end region))
    465456         (first-line (mark-line start))
    466          (buffer (line-%buffer first-line))
    467457         (last-line (mark-line end)))
    468458    (cond
    … …  
    479469                ((or (< cs 0) (> ce len))
    480470                 (write-string "{bad region}" stream))
    481                 ((eq first-line (buffer-open-line buffer))
    482                  (let ((gap (- (buffer-right-open-pos buffer) (buffer-left-open-pos buffer))))
     471                ((eq first-line *open-line*)
     472                 (let ((gap (- *right-open-pos* *left-open-pos*)))
    483473                   (cond
    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)
     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)
    488478                                   :end (+ ce gap)))
    489479                    (t
    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)
     480                     (write-string *open-chars* stream :start cs
     481                                   :end *left-open-pos*)
     482                     (write-string *open-chars* stream :start *right-open-pos*
    493483                                   :end (+ gap ce))))))
    494484                (t

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

    r6571 r6580  
    4747                      (cond ((char= character #\newline)
    4848                             (let* ((next (line-next line))
    49                                     (new-chars (subseq (the simple-string (buffer-open-chars buffer))
    50                                                        0 (buffer-left-open-pos buffer)))
     49                                    (new-chars (subseq (the simple-string *open-chars*)
     50                                                       0 *left-open-pos*))
    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) (buffer-left-open-pos buffer)
    56                                                       (- charpos (buffer-left-open-pos buffer)))
     55                               (maybe-move-some-marks (charpos line new-line) *left-open-pos*
     56                                                      (- charpos *left-open-pos*))
    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                                (setf (buffer-open-line buffer) new-line
    62                                      (buffer-left-open-pos buffer) 0)))
     61                               (setq *open-line* new-line  *left-open-pos* 0)))
    6362                            (t
    64                              (if (= (buffer-right-open-pos buffer)
    65                                     (buffer-left-open-pos buffer))
    66                                (grow-open-chars buffer))
     63                             (if (= *right-open-pos* *left-open-pos*)
     64                               (grow-open-chars))
    6765             
    68                              (maybe-move-some-marks (charpos line) (buffer-left-open-pos buffer)
     66                             (maybe-move-some-marks (charpos line) *left-open-pos*
    6967                                                    (1+ charpos))
    7068             
    7169                             (cond
    7270                               ((eq (mark-%kind mark) :right-inserting)
    73                                 (decf (buffer-right-open-pos buffer))
    74                                 (setf (char (the simple-string (buffer-open-chars buffer)) (buffer-right-open-pos buffer))
     71                                (decf *right-open-pos*)
     72                                (setf (char (the simple-string *open-chars*) *right-open-pos*)
    7573                                      character))
    7674                               (t
    77                                 (setf (char (the simple-string (buffer-open-chars buffer)) (buffer-left-open-pos buffer))
     75                                (setf (char (the simple-string *open-chars*) *left-open-pos*)
    7876                                      character)
    79                                 (incf (buffer-left-open-pos buffer))))))
     77                                (incf *left-open-pos*)))))
    8078                      (buffer-note-insertion buffer mark 1))))
    8179
    … …  
    109107         (modifying-line line mark)
    110108         (let ((length (- end start)))
    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)))
     109           (if (<= *right-open-pos* (+ *left-open-pos* end))
     110             (grow-open-chars (* (+ *line-cache-length* end) 2)))
    113111             
    114            (maybe-move-some-marks (charpos line) (buffer-left-open-pos buffer)
     112           (maybe-move-some-marks (charpos line) *left-open-pos*
    115113                                  (+ charpos length))
    116114           (cond
    117115             ((eq (mark-%kind mark) :right-inserting)
    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)))
     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)))
    121119             (t
    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)))))
     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)))))
    125123         (buffer-note-insertion buffer mark (- end start)))))))
    126124
    … …  
    135133         (end (region-end region))
    136134         (first-line (mark-line start))
    137          (buffer (line-%buffer first-line))
    138135         (last-line (mark-line end))
    139136         (first-charpos (mark-charpos start))
    … …  
    143140     ((eq first-line last-line)
    144141      ;; simple case -- just BLT the characters in with insert-string
    145       (if (eq first-line (buffer-open-line buffer))
    146         (close-line buffer))
     142      (if (eq first-line *open-line*) (close-line))
    147143      (insert-string mark (line-chars first-line) first-charpos last-charpos))
    148144     (t
    149       (close-line buffer)
     145      (close-line)
    150146      (let* ((line (mark-line mark))
    151147             (next (line-next line))
    152148             (charpos (mark-charpos mark))
     149             (buffer (line-%buffer line))
    153150             (old-chars (line-chars line)))
    154151        (declare (simple-string old-chars))
    … …  
    208205         (first-charpos (mark-charpos start))
    209206         (last-charpos (mark-charpos end))
    210          (nins (count-characters region))
    211          (buffer (line-%buffer (mark-line mark))))
     207         (nins (count-characters region)))
    212208    (cond
    213209     ((eq first-line last-line)
    214210      ;; Simple case -- just BLT the characters in with insert-string.
    215       (if (eq first-line (buffer-open-line buffer))
    216         (close-line buffer))
     211      (if (eq first-line *open-line*) (close-line))
    217212      (insert-string mark (line-chars first-line) first-charpos last-charpos))
    218213     (t
    219214      (when (bufferp (line-%buffer first-line))
    220215        (error "Region is linked into Buffer ~S." (line-%buffer first-line)))
    221       (close-line buffer)
     216      (close-line)
    222217      (let* ((line (mark-line mark))
    223218             (second-line (line-next first-line))
    224219             (next (line-next line))
    225220             (charpos (mark-charpos mark))
     221             (buffer (line-%buffer line))
    226222             (old-chars (line-chars line)))
    227223        (declare (simple-string old-chars))

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

    r6571 r6580  
    4444                         (cond
    4545                           ((minusp n)
    46                             (incf (buffer-left-open-pos buffer) n)
     46                            (setq *left-open-pos* (+ *left-open-pos* n))
    4747                            (move-some-marks (pos line)
    48                                              (if (> pos (buffer-left-open-pos buffer))
    49                                                (if (<= pos charpos) (buffer-left-open-pos buffer) (+ pos n))
     48                                             (if (> pos *left-open-pos*)
     49                                               (if (<= pos charpos) *left-open-pos* (+ pos n))
    5050                                               pos)))
    5151         
    5252                           (t
    53                             (incf (buffer-right-open-pos buffer) n)
     53                            (setq *right-open-pos* (+ *right-open-pos* n))
    5454                            (let ((bound (+ charpos n)))
    5555                              (move-some-marks (pos line)
    5656                                               (if (> pos charpos)
    57                                                  (if (<= pos bound) (buffer-left-open-pos buffer) (- pos n))
     57                                                 (if (<= pos bound) *left-open-pos* (- 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                  (incf (buffer-right-open-pos buffer) num)
     101                 (setq *right-open-pos* (+ *right-open-pos* 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 buffer)
     111               (close-line)
    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 (+ (buffer-right-open-pos buffer) num))
     179                          (new-right (+ *right-open-pos* 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 (buffer-open-chars buffer) (buffer-right-open-pos buffer) new-chars 0 num)
    186                      (setf (buffer-right-open-pos buffer) new-right)
     185                     (%sp-byte-blt *open-chars* *right-open-pos* new-chars 0 num)
     186                     (setq *right-open-pos* 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 buffer)
     199                   (close-line)
    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))
    274273         (last-line (mark-line end))
    275274         (first-charpos (mark-charpos start))
    … …  
    278277    (cond
    279278     ((eq first-line last-line)
    280       (when (eq first-line (buffer-open-line buffer)) (close-line buffer))
     279      (when (eq first-line *open-line*) (close-line))
    281280      (let* ((length (- last-charpos first-charpos))
    282281             (chars (make-string length))
    … …  
    286285                              (mark line length :left-inserting))))
    287286     (t
    288       (close-line buffer)
     287      (close-line)
    289288      (let* ((first-chars (line-chars first-line))
    290289             (length (- (length first-chars) first-charpos))
    … …  
    353352      (modifying-line end-line end)
    354353      (cond ((eq start-line end-line)
    355              (let* ((res (fcs function (subseq (buffer-open-chars buffer)
    356                                                first last)))
     354             (let* ((res (fcs function (subseq *open-chars* first last)))
    357355                    (rlen (length res))
    358356                    (new-left (+ first rlen))
    359                     (delta (- new-left (buffer-left-open-pos buffer))))
     357                    (delta (- new-left *left-open-pos*)))
    360358               (declare (simple-string res))
    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))
     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*)
    364362               ;;
    365363               ;; Move marks to start or end of region, depending on kind.
    … …  
    372370                                   new-left first)
    373371                               (+ charpos delta))))))
    374                (setf (buffer-left-open-pos buffer) new-left)))
     372               (setq *left-open-pos* new-left)))
    375373            (t
    376374             ;;
    … …  
    405403             ;;
    406404             ;; Do the last line, which is cached.
    407              (let* ((res (fcs function (subseq (the simple-string (buffer-open-chars buffer))
     405             (let* ((res (fcs function (subseq (the simple-string *open-chars*)
    408406                                               0 last)))
    409407                    (rlen (length res))
    410408                    (delta (- rlen last)))
    411409               (declare (simple-string res))
    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)
     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)
    416414               ;;
    417415               ;; Adjust marks after the end of the region and save ones in it.
Note: See TracChangeset for help on using the changeset viewer.