Changeset 12564


Ignore:
Timestamp:
Aug 11, 2009, 6:37:13 PM (10 years ago)
Author:
gz
Message:

Make buffers keep track of their lines in a vector, use that for a better implementation of move-to-absolute-position

Location:
trunk/source/cocoa-ide/hemlock/src
Files:
4 edited

Legend:

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

    r12324 r12564  
    504504  nil)
    505505
    506 
    507 
     506(defun buffer-lines (buffer)
     507  (let ((lines (buffer-%lines buffer)))
     508    (when (eql (fill-pointer lines) 0)
     509      (loop for origin = 0 then (+ origin (buffer-line-length l) 1)
     510            for l = (mark-line (region-start (buffer-%region buffer))) then (line-next l) while l
     511            do (setf (line-origin l) origin)
     512            do (vector-push-extend l lines)))
     513    lines))
     514
     515;; This will return the last line if posn is out of range (or first line if it's negative)
     516(defun buffer-line-at-absolute-position (buffer posn)
     517  (declare (optimize (speed 3) (safety 0)))
     518  (let* ((lines (buffer-lines (ccl:require-type buffer 'buffer)))
     519         (posn (ccl:require-type posn 'fixnum))
     520         (vec (ccl::array-data-and-offset lines))
     521         (start 0)
     522         (end (fill-pointer lines)))
     523    (declare (fixnum start end posn))
     524    (loop
     525      (let* ((middle (ash (the fixnum (+ start end)) -1))
     526             (line (svref vec middle)))
     527        (declare (fixnum middle))
     528        (when (= middle start)
     529          (return line))
     530        (if (< posn (the fixnum (line-origin line)))
     531          (setq end middle)
     532          (setq start middle))))))
     533
     534;; Called whenever change a line's next or previous pointer.  Don't update immediately
     535;; so don't thrash when inserting multiple lines.
     536(declaim (inline invalidate-buffer-lines))
     537(defun invalidate-buffer-lines (buffer)
     538  (setf (fill-pointer (buffer-%lines buffer)) 0))
    508539
    509540;;;; Buffer start and end marks.
  • trunk/source/cocoa-ide/hemlock/src/htext1.lisp

    r8428 r12564  
    335335  "Returns the number of characters on the line."
    336336  (if (linep line)
    337     (line-length* line)
     337    (buffer-line-length line)
    338338    (error "~S is not a line!" line)))
    339339
     
    444444
    445445(defun move-to-absolute-position (mark position)
    446   (with-mark ((m (buffer-start-mark (mark-buffer mark))))
    447     (when (character-offset m position)
    448       (move-mark mark m))))
     446  (let* ((buffer (mark-buffer mark))
     447         (line (buffer-line-at-absolute-position buffer position))
     448         (offset (- position (get-line-origin line))))
     449    (when (<= 0 offset (line-length line))
     450      (change-line mark line)
     451      (setf (mark-charpos mark) offset)
     452      mark)))
    449453
    450454(defun buffer-selection-range (buffer)
  • trunk/source/cocoa-ide/hemlock/src/line.lisp

    r12255 r12564  
    6666  ;; Pointers to the next and previous lines in the doubly linked list of
    6767  ;; line structures.
    68   previous
    69   next
     68  %previous
     69  %next
    7070  ;;
    7171  ;; A list of all the permanent marks pointing into this line.
     
    9191  ;; the buffer's default character properties.
    9292  charprops-changes)
     93
     94(declaim (inline line-next line-previous set-line-next set-line-previous))
     95(defun line-next (line) (line-%next line))
     96(defun line-previous (line) (line-%previous line))
     97
     98(defsetf line-next set-line-next)
     99(defsetf line-previous set-line-previous)
     100
     101(defun set-line-next (line next)
     102  (let ((buffer (line-buffer line)))
     103    (when buffer (invalidate-buffer-lines buffer)))
     104  (setf (line-%next line) next))
     105
     106(defun set-line-previous (line previous)
     107  (let ((buffer (line-buffer line)))
     108    (when buffer (invalidate-buffer-lines buffer)))
     109  (setf (line-%previous line) previous))
    93110
    94111(defstruct (charprops-change
     
    149166;;;
    150167(defmacro make-line (&rest keys)
    151   `(%make-line ,@(substitute :%chars :chars keys)))
     168  (loop for (old . new) in '((:chars . :%chars) (:next . :%next) (:previous . :%previous))
     169        do (setq keys (substitute new old keys)))
     170  `(%make-line ,@keys))
    152171
    153172(defmacro line-length* (line)
     
    158177          (length (the simple-string (line-%chars ,line))))))
    159178
    160 
     179(defun buffer-line-length (line)
     180  (let ((buffer (line-buffer line)))
     181    (cond ((null buffer)
     182           (line-length* line))
     183          ((eq line (buffer-open-line buffer))
     184           (buffer-open-line-length buffer))
     185          (t (length (line-chars line))))))
    161186
    162187(defun get-line-origin (line)
  • trunk/source/cocoa-ide/hemlock/src/struct.lisp

    r12542 r12564  
    120120  charprops                   ; the buffer's default charprops
    121121  (selection-set-by-command nil) ; boolean: true if selection set by (shifted) motion command.
     122  (%lines (make-array 10 :adjustable t :fill-pointer 0)) ;; all lines in the buffer
    122123  )
    123124
     
    372373  (buffer-gap-context-lock (ensure-buffer-gap-context buffer)))
    373374
     375(defun buffer-open-line (buffer)
     376  (buffer-gap-context-open-line (ensure-buffer-gap-context buffer)))
     377
     378(defun buffer-open-line-length (buffer)
     379  (let ((context (ensure-buffer-gap-context buffer)))
     380    (+ (buffer-gap-context-left-open-pos context)
     381       (-   (buffer-gap-context-line-cache-length context)
     382            (buffer-gap-context-right-open-pos context)))))
     383
     384(defun buffer-left-open-pos (buffer)
     385  (buffer-gap-context-left-open-pos (ensure-buffer-gap-context buffer)))
     386
     387(defun buffer-right-open-pos (buffer)
     388  (buffer-gap-context-right-open-pos (ensure-buffer-gap-context buffer)))
     389
     390(defun buffer-open-chars (buffer)
     391  (buffer-gap-context-open-chars (ensure-buffer-gap-context buffer)))
     392
    374393(defun current-gap-context ()
    375394  (unless (boundp '*current-buffer*)
Note: See TracChangeset for help on using the changeset viewer.