Changeset 12290


Ignore:
Timestamp:
Jun 24, 2009, 7:43:40 PM (10 years ago)
Author:
rme
Message:

delete-characters: reindent; add charprops support

delete-region: add charprops support; remove use of global temp region
and mark and just cons up new ones when we need to.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/source/cocoa-ide/hemlock/src/htext4.lisp

    r8428 r12290  
    2323
    2424;;;; DELETE-CHARACTERS.
    25 
    26 (defvar *internal-temp-region* (make-empty-region))
    27 (defvar *internal-temp-mark* (internal-make-mark nil nil :temporary))
    28 
    29 
    3025
    3126(defun delete-characters (mark &optional (n 1))
     
    3631    (check-buffer-modification (line-%buffer line) mark)
    3732    (cond
    38       ((zerop n) t)
    39       ;; Deleting chars on one line, just bump the pointers.
    40       ((<= 0 (+ charpos n) length)
    41        (let* ((buffer (line-%buffer line)))
    42        (modifying-buffer buffer
    43                          (modifying-line line mark)
    44                          (cond
    45                            ((minusp n)
    46                             (setf (current-left-open-pos) (+ (current-left-open-pos) n))
    47                             (move-some-marks (pos line)
    48                                              (if (> pos (current-left-open-pos))
    49                                                (if (<= pos charpos) (current-left-open-pos) (+ pos n))
    50                                                pos)))
    51          
    52                            (t
    53                             (setf (current-right-open-pos) (+ (current-right-open-pos) n))
    54                             (let ((bound (+ charpos n)))
    55                               (move-some-marks (pos line)
    56                                                (if (> pos charpos)
    57                                                  (if (<= pos bound) (current-left-open-pos) (- pos n))
    58                                                  pos)))))
    59                          (adjust-line-origins-forward line)
    60                          (buffer-note-deletion buffer mark n)
    61                          t)))
    62 
    63       ;; Deleting some newlines, punt out to delete-region.
    64       (t
    65        (setf (mark-line *internal-temp-mark*) line
    66              (mark-charpos *internal-temp-mark*) charpos)
    67        (let ((other-mark (character-offset *internal-temp-mark* n)))
    68          (cond
    69            (other-mark
    70             (if (< n 0)
    71               (setf (region-start *internal-temp-region*) other-mark
    72                     (region-end *internal-temp-region*) mark)
    73               (setf (region-start *internal-temp-region*) mark
    74                     (region-end *internal-temp-region*) other-mark))
    75             (delete-region *internal-temp-region*) t)
    76            (t nil)))))))
    77 
    78 
     33     ((zerop n) t)
     34     ;; Deleting chars on one line, just bump the pointers.
     35     ((<= 0 (+ charpos n) length)
     36      (let* ((buffer (line-%buffer line)))
     37        (modifying-buffer buffer
     38          (modifying-line line mark)
     39          (cond
     40           ((minusp n)
     41            (delete-line-charprops line :start (+ charpos n) :end charpos)
     42            (setf (current-left-open-pos) (+ (current-left-open-pos) n))
     43            (move-some-marks (pos line)
     44                             (if (> pos (current-left-open-pos))
     45                               (if (<= pos charpos) (current-left-open-pos) (+ pos n))
     46                               pos)))
     47           
     48           (t
     49            (delete-line-charprops line :start charpos :end (+ charpos n))
     50            (setf (current-right-open-pos) (+ (current-right-open-pos) n))
     51            (let ((bound (+ charpos n)))
     52              (move-some-marks (pos line)
     53                               (if (> pos charpos)
     54                                 (if (<= pos bound) (current-left-open-pos) (- pos n))
     55                                 pos)))))
     56          (adjust-line-origins-forward line)
     57          (buffer-note-deletion buffer mark n)
     58          t)))
     59     
     60     ;; Deleting some newlines, punt out to delete-region.
     61     (t
     62      (let* ((temp-mark (mark line charpos))
     63             (other-mark (character-offset temp-mark n))
     64             (temp-region (make-empty-region)))
     65        (cond
     66         (other-mark
     67          (if (< n 0)
     68            (setf (region-start temp-region) other-mark
     69                  (region-end temp-region) mark)
     70            (setf (region-start temp-region) mark
     71                  (region-end temp-region) other-mark))
     72          (delete-region temp-region) t)
     73         (t nil)))))))
    7974
    8075
     
    9994               (let ((num (- last-charpos first-charpos)))
    10095                 (setf (current-right-open-pos) (+ (current-right-open-pos) num))
    101                  ;; and fix up any marks in there:
     96                 ;; and fix up any charprops or marks in there:
     97                 (delete-line-charprops first-line :start first-charpos
     98                                        :end last-charpos)
    10299                 (move-some-marks (charpos first-line)
    103100                   (if (> charpos first-charpos)
     
    120117                                 length)
    121118                   (setf (line-chars first-line) new-chars))
     119                 (copy-line-charprops last-line :start last-charpos
     120                                      :end last-length)
    122121                 ;; fix up the first line's marks:
    123122                 (move-some-marks (charpos first-line)
     
    283282             (line (make-line :chars chars  :%buffer count  :number 0)))
    284283        (%sp-byte-blt (line-chars first-line) first-charpos chars 0 length)
     284        (setf (line-charprops-changes line)
     285              (copy-line-charprops line :start first-charpos :end last-charpos))
    285286        (internal-make-region (mark line 0 :right-inserting)
    286287                              (mark line length :left-inserting))))
     
    294295        (declare (simple-string first-chars))
    295296        (%sp-byte-blt first-chars first-charpos chars 0 length)
     297        (setf (line-charprops-changes first-copied-line)
     298              (copy-line-charprops first-line :start first-charpos
     299                                   :end last-charpos))
    296300        (do ((line (line-next first-line) (line-next line))
    297301             (previous first-copied-line)
     
    304308                                                 :previous previous)))
    305309               (%sp-byte-blt (line-chars last-line) 0 chars 0 last-charpos)
     310               (setf (line-charprops-changes last-copied-line)
     311                     (copy-line-charprops last-line :end last-charpos))
    306312               (setf (line-next previous) last-copied-line)
    307313               (internal-make-region
     
    311317                                       :number number
    312318                                       :previous previous)))
     319            ;; note that %copy-line also copies charprops changes
    313320            (setf (line-next previous) new-line)
    314321            (setq previous new-line))))))))
Note: See TracChangeset for help on using the changeset viewer.