Changeset 12288


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

Changes primarily to support deletion. Still a work in progress.

append-line-charprops: new function
join-line-charprops: revised
delete-line-charprops: rewritten
coalesce-line-charprops: new function
adjust-charprops-changes: simplified

File:
1 edited

Legend:

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

    r12274 r12288  
    157157              (setq prior-change change))
    158158            (setq pivot i)))))))
     159
     160(defun append-line-charprops (line changes)
     161  (let* ((left (line-charprops-changes line))
     162         (len (line-length line))
     163         (right changes))
     164    (cond ((and left right)
     165           (loop for c across changes
     166             for new-change = (copy-charprops-change c)
     167             do (incf (charprops-change-index new-change) len)
     168                (push-charprops-change new-change left)))
     169          ((and (null left) right)
     170           (setq left (copy-charprops-changes changes))
     171           (adjust-charprops-change-indexes left len)
     172           (setf (line-charprops-changes line) left))
     173          ((and left (null right))
     174           (push-charprops-change (make-charprops-change len nil) left)))
     175    left))
    159176
    160177;;; Append the charprops-changes from line2 onto line1, modifying their
     
    208225   charprops in between start and end are the default charprops, return
    209226   NIL."
    210   (unless end
    211     (setq end (line-length line)))
    212   (let* ((changes (line-charprops-changes line))
    213          (new-changes (make-empty-charprops-changes)))
     227  (let ((changes (line-charprops-changes line)))
     228    ;; some early-out special cases
    214229    (cond ((null changes)
    215            (setq new-changes nil))
    216           ((and (= start 0)
    217                 (= end (line-length line)))
    218            (setq new-changes (copy-charprops-changes changes)))
    219           (t
    220            (let* ((start-idx (charprops-change-index-for-position changes start))
    221                   (end-idx (charprops-change-index-for-position changes (1- end))))
    222              (if (eql start-idx end-idx)
    223                (if (null start-idx)
    224                  (setq new-changes nil)
    225                  (let* ((change (aref changes start-idx))
    226                         (plist (charprops-change-plist change)))
    227                    (if (null plist)
    228                      (setq new-changes nil)
    229                      (push-charprops-change (make-charprops-change start plist)
    230                                          new-changes))))
    231                (do* ((i (or start-idx 0) (1+ i))
    232                      (change nil)
    233                      (index nil)
    234                      (plist nil))
    235                     ((> i end-idx))
    236                  (setq change (aref changes i))
    237                  (setq index (charprops-change-index change))
    238                  (setq plist (charprops-change-plist change))
    239                  (push-charprops-change (make-charprops-change
    240                                          (max 0 (- index start)) plist)
    241                                         new-changes))))))
    242     new-changes))
     230           (return-from copy-line-charprops))
     231          ((and (= start 0) (null end))
     232           (return-from copy-line-charprops (copy-charprops-changes changes))))
     233    (unless end
     234      (setq end (line-length line)))
     235    (let* ((new-changes (make-empty-charprops-changes))
     236           (start-idx (charprops-change-index-for-position changes start))
     237           (end-idx (charprops-change-index-for-position changes (1- end))))
     238      (if (eql start-idx end-idx)
     239        (if (null start-idx)
     240          (setq new-changes nil)
     241          (let* ((change (aref changes start-idx))
     242                 (plist (charprops-change-plist change)))
     243            (if (null plist)
     244              (setq new-changes nil)
     245              (push-charprops-change (make-charprops-change start plist)
     246                                     new-changes))))
     247        (do ((i (or start-idx 0) (1+ i)))
     248            ((> i end-idx))
     249          (let* ((change (aref changes i))
     250                 (index (charprops-change-index change))
     251                 (plist (charprops-change-plist change)))
     252          (push-charprops-change (make-charprops-change
     253                                  (max 0 (- index start)) plist)
     254                                 new-changes))))
     255      new-changes)))
    243256
    244257(defun delete-line-charprops (line &key (start 0) end)
    245   (unless end
    246     (setq end (line-length line)))
    247   (let* ((changes (line-charprops-changes line))
    248          (start-idx (charprops-change-index-for-position changes start))
    249          (end-idx (charprops-change-index-for-position changes (1- end))))
    250 
     258  (let ((changes (line-charprops-changes line)))
     259    ;; some early-out special cases
    251260    (cond ((null changes)
    252261           (return-from delete-line-charprops))
    253           ((and (= start 0) (= end (line-length line)))
     262          ((and (= start 0) (null end))
    254263           (setf (line-charprops-changes line) nil)
    255            (return-from delete-line-charprops))
    256           ((null start-idx)
    257            (if (null end-idx)
    258              (adjust-charprops-change-indexes changes (- start end) :start 0)
    259              (progn
    260                ;; delete changes before end-idx
    261                (replace changes changes :start1 0 :start2 end-idx)
    262                (decf (fill-pointer changes) end-idx)
    263                (setf (charprops-change-index (aref changes 0)) start)
    264                ;; move back start of subsequent changes, if there are any
    265                (when (> (length changes) 1)
    266                  (adjust-charprops-change-indexes changes (- start end) :start 1)
    267                  ;; if first change is now zero-length, remove it
    268                  (when (= (charprops-change-index (aref changes 0))
    269                           (charprops-change-index (aref changes 1)))
    270                    (delete-charprops-change changes 0)))
    271                ;; if first change's plist is nil, delete it, since a line
    272                ;; always starts with implicit nil charprops.
    273                (when (null (charprops-change-plist (aref changes 0)))
    274                  (if (= (length changes) 1)
    275                    (setf (line-charprops-changes line) nil)
    276                    (delete-charprops-change changes 0))))))
    277           ((eql start-idx end-idx)
    278            ;; The deletion takes place within the scope of a single
    279            ;; charprops run.  Note that start-idx will not be null.
    280            ;; move back indexes of subsequent changes, if there are any
    281            (when (> (length changes) (1+ start-idx))
    282              (adjust-charprops-change-indexes changes (- start end)
    283                                               :start (1+ start-idx))
    284              ;; if the change is now zero-length, remove it
    285              (when (= (charprops-change-index (aref changes start-idx))
    286                       (charprops-change-index (aref changes (1+ start-idx))))
    287                (delete-charprops-change changes start-idx)
    288                (decf start-idx))
    289              ;; if the first change and the second change have the same
    290              ;; charprops, merge them.
    291              (when (and (>= start-idx 0)
    292                         (> (length changes) (1+ start-idx))
    293                         (charprops-equal
    294                          (charprops-change-plist (aref changes start-idx))
    295                          (charprops-change-plist (aref changes (1+ start-idx)))))
    296                (delete-charprops-change changes (1+ start-idx)))))
    297           (t
    298            ;; Remove changes between start-idx and and end-idx.
    299            (replace changes changes :start1 (1+ start-idx)
    300                     :start2 end-idx)
    301            (decf (fill-pointer changes) (- end-idx (1+ start-idx)))
    302            ;;(setf (charprops-change-index (aref changes (1+ start-idx))) start)
    303            (when (> (length changes) (1+ start-idx))
    304              (adjust-charprops-change-indexes changes (- start end)
    305                                               :start (1+ start-idx))
    306              (when (>= (charprops-change-index (aref changes start-idx))
    307                        (charprops-change-index (aref changes (1+ start-idx))))
    308                (delete-charprops-change changes start-idx)
    309                (decf start-idx))
    310              (when (and (>= start-idx 0)
    311                         (> (length changes) (1+ start-idx))
    312                         (charprops-equal
    313                          (charprops-change-plist (aref changes start-idx))
    314                          (charprops-change-plist (aref changes (1+ start-idx)))))
    315                (delete-charprops-change changes (1+ start-idx))))))
    316     changes))
    317              
    318 
     264           (return-from delete-line-charprops)))
     265    (unless end
     266      (setq end (line-length line)))
     267    (assert (<= start end) (start end))
     268    (let* ((start-idx (charprops-change-index-for-position changes start))
     269           (end-idx (charprops-change-index-for-position changes (1- end))))
     270      (cond ((null start-idx)
     271             (if (null end-idx)
     272               (adjust-charprops-change-indexes changes (- start end) :start 0)
     273               (progn
     274                 ;; delete changes before end-idx
     275                 (replace changes changes :start1 0 :start2 end-idx)
     276                 (decf (fill-pointer changes) end-idx)
     277                 (setf (charprops-change-index (aref changes 0)) start)
     278                 ;; move back start of subsequent changes, if there are any
     279                 (when (> (length changes) 1)
     280                   (adjust-charprops-change-indexes changes (- start end)
     281                                                    :start 1)
     282                   ;; if the change is now zero-length, remove it
     283                   (when (= (charprops-change-index (aref changes 0))
     284                            (charprops-change-index (aref changes 1)))
     285                     (delete-charprops-change changes 0))))))
     286            ((eql start-idx end-idx)
     287             ;; The deletion takes place within the scope of a single
     288             ;; charprops run.
     289             ;; Move back start of subsequent changes, if there are any
     290             (when (> (length changes) (1+ start-idx))
     291               (adjust-charprops-change-indexes changes (- start end)
     292                                                :start (1+ start-idx))
     293               ;; if the change is now zero-length, remove it
     294               (when (= (charprops-change-index (aref changes start-idx))
     295                        (charprops-change-index (aref changes (1+ start-idx))))
     296                 (delete-charprops-change changes start-idx))))
     297            (t
     298             ;; Remove changes between start-idx and and end-idx.
     299             (replace changes changes :start1 (1+ start-idx)
     300                      :start2 end-idx)
     301             (decf (fill-pointer changes) (- end-idx (1+ start-idx)))
     302             (setf (charprops-change-index (aref changes (1+ start-idx))) start)
     303             (when (> (length changes) (1+ start-idx))
     304               (adjust-charprops-change-indexes changes (- start end)
     305                                                :start (+ 2 start-idx))
     306               ;; if first change is now zero-length, remove it
     307               (when (= (charprops-change-index (aref changes start-idx))
     308                        (charprops-change-index (aref changes (1+ start-idx))))
     309                 (delete-charprops-change changes start-idx))))))
     310    (coalesce-line-charprops line)))
     311
     312;;; Coalesce adjacent changes with CHARPROP-EQUAL plists.
     313;;; Maybe make this remove zero-length changes, too?
     314(defun coalesce-line-charprops (line)
     315  (let ((changes (line-charprops-changes line)))
     316    (do* ((i 0 (1+ i))
     317          (change nil))
     318         ((>= i (length changes)))
     319      (setq change (aref changes i))
     320      (loop with j = (1+ i)
     321        while (and (< j (length changes))
     322                   (charprops-equal (charprops-change-plist change)
     323                                    (charprops-change-plist (aref changes j))))
     324        do (delete-charprops-change changes j)))
     325    ;; Elide any changes with NIL plists at the start of the line.
     326    (loop
     327      while (and (> (length changes) 0)
     328                 (null (charprops-change-plist (aref changes 0))))
     329      do (delete-charprops-change changes 0))
     330    (when (zerop (length changes))
     331      (setf (line-charprops-changes line) nil)))
     332  (line-charprops-changes line))
     333     
    319334(defun adjust-charprops-change-indexes (changes delta &key (start 0))
    320335  (do* ((i start (1+ i))
     
    329344(defun adjust-charprops-changes (changes charpos delta)
    330345  (let ((start-idx (charprops-change-index-for-position changes charpos)))
    331     (cond
    332      ((plusp delta)
    333       ;; We're inserting something.  Adjust the charprops-change-indexes of
    334       ;; all changes after the one we belong to.
    335       (adjust-charprops-change-indexes changes delta :start (if start-idx
    336                                                           (1+ start-idx)
    337                                                           0)))
    338      ((minusp delta)
    339       ;; We're deleting something.
    340       (let* ((end (+ charpos (abs delta)))
    341              (end-idx (charprops-change-index-for-position changes end)))
    342         (if (eql start-idx end-idx)
    343           ;; The deletion takes place entirely within the scope of a
    344           ;; single charprops change.  We have only to adjust the
    345           ;; charprops-change-index of all changes after the one we
    346           ;; belong to.
    347           (adjust-charprops-change-indexes changes delta :start (if start-idx
    348                                                               (1+ start-idx)
    349                                                               0))
    350           ;; The deletion spans multiple charprops changes.
    351           (let* ((start-change (and start-idx (aref changes start-idx)))
    352                  (end-change (aref changes end-idx)))
    353             ;; Adjust the change at the end of the deletion.  (Note that
    354             ;; end-idx is sure be valid: the only way it could be nil is if
    355             ;; start-idx were also nil, but that case would have been
    356             ;; caught by the consequent of the IF.)
    357             (setf (charprops-change-index end-change)
    358                   (- end (charprops-change-index end-change)))
    359             (cond
    360              ((null start-idx)
    361               ;; There's a stretch of default properties at the start of
    362               ;; the line.
    363               (replace changes changes :start1 0 :start2 end-idx)
    364               (decf (fill-pointer changes) end-idx))
    365              ((= (charprops-change-index start-change)
    366                  (charprops-change-index end-change))
    367               ;; The start-change is being completely wiped out.
    368               (replace changes changes :start1 start-idx :start2 end-idx)
    369               (decf (fill-pointer changes) (- end-idx start-idx)))
    370              ((> (- end-idx start-idx) 1)
    371               ;; Delete the charprops changes between start-idx and end-idx.
    372               (replace changes changes :start1 (1+ start-idx) :start2 end-idx)
    373               (decf (fill-pointer changes) (- end-idx (1+ start-idx))))))))))))
     346    (adjust-charprops-change-indexes changes delta :start (if start-idx
     347                                                            (1+ start-idx)
     348                                                            0))))
    374349
    375350#|
Note: See TracChangeset for help on using the changeset viewer.