window.lisp

   1 (in-package :lice)
   2
   3 (defvar *next-screen-context-lines* 2
   4   "Number of lines of continuity when scrolling by screenfuls.")
   5
   6 (defvar *window-min-height* 4
   7   "Delete any window less than this tall (including its mode line).")
   8
   9 (defvar *window-min-width* 10
  10   "Delete any window less than this wide.")
  11
  12 ;; we just want a fast and easy dumping area for data. start and end
  13 ;; are inclusive.
  14 (defstruct cache-item
  15    (start 0 :type integer)
  16    (end 0 :type integer))
  17
  18 (defun make-empty-cache-item-vector ()
  19 ;;   (make-array 0 :element-type 'cache-item
  20 ;;            :adjustable t
  21 ;;            :fill-pointer 0)
  22   ())
  23
  24 ;; start and end are inclusive and are buffer points
  25 (defclass line-cache ()
  26   ((start :type integer :initform 0 :initarg :start :accessor lc-start)
  27    (end :type integer :initform 0 :initarg :end :accessor lc-end)
  28    (valid :type boolean :initform nil :initarg :valid :accessor lc-valid)
  29    (cache :type list ;;(array cache-item 1)
  30           :initform nil ;; (make-array 0 :element-type 'cache-item
  31 ;;                         :adjustable t
  32 ;;                         :fill-pointer 0)
  33           :initarg :cache :accessor lc-cache)))
  34
  35 (defun item-in-cache (window n)
  36   "Return the Nth item in the cache or NIL if it doesn't exist."
  37   (elt (lc-cache (window-cache window)) n))
  38 ;;   (when (< n (length (lc-cache (window-cache window))))
  39 ;;     (aref (lc-cache (window-cache window)) n)))
  40
  41 (defclass window ()
  42   ((frame :initarg :frame :accessor window-frame)
  43    (x :type integer :initarg :x :accessor window-x)
  44    (y :type integer :initarg :y :accessor window-y)
  45    (w :type integer :initarg :w :documentation
  46       "The width of the window's contents.")
  47    (h :type integer :initarg :h :documentation
  48       "The total height of the window, including the mode-line.")
  49    (seperator :type boolean :initform nil :accessor window-seperator :documentation
  50               "T when the window is to draw a vertical seperator. used in horizontal splits.")
  51    (line-state :type (array integer 1) :initarg :line-state :accessor window-line-state)
  52    (cache :type line-cache :initarg :cache :accessor window-cache)
  53    ;; Indices into cache (inclusive) that describe the range of the
  54    ;; cache that will be displayed.
  55    (top-line :type integer :initarg :top-line :accessor window-top-line)
  56    (bottom-line :type integer :initarg :bottom-line :accessor window-bottom-line)
  57    (point-col :type integer :initarg :point-col :accessor window-point-col)
  58    (point-line :type integer :initarg :point-line :accessor window-point-line)
  59    ;; The rest refer to points in the buffer
  60    (buffer :type buffer :initarg :buffer :accessor window-buffer)
  61    (bpoint :type marker :initarg :bpoint :accessor window-bpoint :documentation
  62            "A marker marking where in the text the window point is.")
  63    (top :type marker :initarg :top :accessor window-top :documentation
  64         "The point in buffer that is the first character displayed in the window")
  65    (bottom :type marker :initarg :bottom :accessor window-bottom :documentation
  66            "The point in buffer that is the last character displayed
  67 in the window. This should only be used if bottom-valid is T.")
  68    (bottom-valid :type boolean :initform nil :accessor window-bottom-valid :documentation
  69                  "When this is T then bottom should be used to
  70 calculate the visible contents of the window. This is used when
  71 scrolling up (towards the beginning of the buffer)."))
  72   (:documentation "A Lice Window."))
  73
  74 ;; (defun update-window-display-arrays (window)
  75 ;;   "Used to update the window display structures for window splits."
  76 ;;   (let* ((rows (window-height window t))
  77 ;;       (cols (window-width window t))
  78 ;;       (l (make-array (* rows cols)
  79 ;;                      :element-type 'character))
  80 ;;       (d (make-array (list rows cols)
  81 ;;                      :element-type 'character
  82 ;;                      :displaced-to l :displaced-index-offset 0)))
  83 ;;     ;; FIXME: This forces needless redraw because the arrays are
  84 ;;     ;; reset.
  85 ;;     (setf (window-display window) l
  86 ;;        (window-2d-display window) d)))
  87
  88 (defun make-window (&key x y cols rows buffer frame
  89                          (top (make-marker 0 buffer))
  90                          (bpoint (make-marker))
  91                          (type 'window))
  92   "Return a new window. This is handy for setting up all the pesky
  93 display structures.
  94
  95 TYPE isn't used yet. it's just there for hype."
  96   (let* ((w (make-instance type
  97                            :frame frame
  98                            :x x :y y :w cols :h rows
  99                            :line-state (make-array rows :element-type 'integer :initial-element -1)
 100                            :cache (make-instance 'line-cache :valid t)
 101                            :top-line 0
 102                            :bottom-line 0
 103                            :point-col 0
 104                            :point-line 0
 105                            :buffer buffer
 106                            :top top
 107                            :bottom (make-marker 0 buffer)
 108                            :bpoint bpoint
 109                            :point-col 0
 110                            :point-line 0)))
 111     w))
 112
 113 (defun make-test-window (buffer)
 114   (make-window :x 0 :y 0 :cols 60 :rows 20 :buffer buffer))
 115
 116 \f
 117 ;;; Other non-display related functions
 118
 119 (defun window-height (w &optional include-mode-line)
 120   "Return the height of the window. By default, the mode-line is not
 121 included in the height."
 122   ;; if the mode-line is nil, then there is no modeline.
 123   (if (or include-mode-line
 124           (null (buffer-mode-line (window-buffer w))))
 125       (slot-value w 'h)
 126     (1- (slot-value w 'h))))
 127
 128 (defun window-width (w &optional include-seperator)
 129   "Return the width of the window. By default, the vertical seperator,
 130 for horizontal splits, is not included in the width."
 131   ;; if the mode-line is nil, then there is no modeline.
 132   (if (or include-seperator
 133           (not (window-seperator w)))
 134       (slot-value w 'w)
 135     (1- (slot-value w 'w))))
 136
 137 (defun get-current-window (&optional (frame (selected-frame)))
 138   "Return the current window in the current frame. If FRAME is
 139 specified, use that frame instead."
 140   (frame-current-window frame))
 141
 142 (defun set-window-buffer (window buffer &optional keep-margins)
 143   "Make WINDOW display BUFFER as its contents.
 144 BUFFER can be a buffer or buffer name.
 145 Optional third arg KEEP-MARGINS non-nil means that WINDOW's current
 146 display margins, fringe widths, and scroll bar settings are maintained;
 147 the default is to reset these from BUFFER's local settings or the frame
 148 defaults."
 149   ;; this is redundant if buffer is a string, since its
 150   ;; looked up already.
 151   (declare (type window window)
 152            (type buffer buffer)
 153            (type boolean keep-margins))
 154   (let ((buf (get-buffer buffer)))
 155     (unless buf
 156       (error "No buffer named ~a" buffer))
 157     (unless (eq (window-buffer window) buf)
 158       ;; update buffer time stamps
 159       (incf (buffer-display-count buf))
 160       ;; MOVITZ doesn't have get-universal-time
 161       ;; (setf (buffer-display-time buf) (get-universal-time))
 162       ;; update buffer list
 163       (bring-buffer-to-front buf)
 164       ;; display stuff
 165       (set-marker (window-top window) 0 buf)
 166       (set-marker (window-bottom window) 100 buf)
 167       (set-marker (window-bpoint window) (marker-position (buffer-point buf)) buf)
 168       ;; finally set the buffer
 169       (setf (window-buffer window) buf)
 170       ;; TODO: run hooks
 171       )))
 172
 173 (defgeneric cache-size (object))
 174
 175 (defmethod cache-size ((object line-cache))
 176   (length (lc-cache object)))
 177
 178 (defmethod cache-size ((object window))
 179   (cache-size (window-cache object)))
 180
 181 (defun reset-line-state (window)
 182   (fill (window-line-state window) -1))
 183
 184 (defun window-reset-cache (window)
 185   (with-slots (cache) window
 186     (setf (lc-cache cache) nil
 187           (lc-start cache) 0
 188           (lc-end cache) 0
 189           (lc-valid cache) t)))
 190
 191 (defun point-in-line-cache (line-cache p)
 192   "Return the line in the cache that P is on. NIL if p is not in range"
 193   (declare (type integer p))
 194   (position-if (lambda (l)
 195                  (and (>= p (cache-item-start l))
 196                       (<= p (cache-item-end l))))
 197                line-cache))
 198
 199 \f
 200 ;;; Display related functions. Generate the line cache based on
 201 ;;; character cells, not pixels.
 202
 203 (defun add-line-to-cache (cache from to &optional at-beginning)
 204   "Add a single line to the cache list. Return the new cache list."
 205   (let ((line (make-cache-item :start from :end to)))
 206     (if at-beginning
 207         (cons line cache)
 208       (nconc1 cache line))))
 209 ;;      (progn
 210 ;;        (grow-vector lines 1 line)
 211 ;;        (replace lines lines :start1 1)
 212 ;;        (setf (elt lines 0) line))
 213 ;;       (vector-push-extend line lines))))
 214
 215
 216 ;; (defun generate-lines-region (cache buffer width from to)
 217 ;;   "FROM must not be a newline (It should be the character after a new
 218 ;; line or the beginning of the buffer) and TO must be newline or the
 219 ;; end of the buffer."
 220 ;;   (declare (type line-cache cache)
 221 ;;         (type buffer buffer)
 222 ;;         (type integer width from to))
 223 ;;   (let ((lines (make-array 0 :element-type 'cache-item
 224 ;;                         :adjustable t
 225 ;;                         :fill-pointer 0))
 226 ;;      (rplc-start (= (1+ to) (lc-start cache)))
 227 ;;      (rplc-end (= (1- from) (lc-end cache)))
 228 ;;      (empty-cache (= (length (lc-cache cache)) 0)))
 229 ;;     (dformat +debug-vvv+ "generate-n-lines: ~a ~a~%" from to)
 230 ;;     ;; Make sure either from-1 or to+1 is already in the cache, its
 231 ;;     ;; the first one. A point cannot exist in 2 cache lines because
 232 ;;     ;; points are inclusive.
 233 ;;     (when (or rplc-start rplc-end empty-cache)
 234 ;;       ;; search for newlines until we hit TO
 235 ;;       (do ((last-p from (1+ p))
 236 ;;         (p (buffer-scan-newline buffer from to 1)
 237 ;;            (buffer-scan-newline buffer (1+ p) to 1))
 238 ;;         (l 0 (1+ l)))
 239 ;;        (nil)
 240
 241 ;;      ;; Break the buffer line into chunks that fit on one window line
 242 ;;      (dformat +debug-vvv+ "last-p: ~a p:~a~%" last-p p)
 243 ;;      (loop for i from last-p by width
 244 ;;            do (vector-push-extend (make-cache-item :start i
 245 ;;                                                    :end (if (<= (+ i (1- width)) p)
 246 ;;                                                             (+ i (1- width))
 247 ;;                                                           p))
 248 ;;                                   lines)
 249 ;;            always (< (+ i (1- width)) p))
 250 ;;      ;; Once we've processed the new line, check if we've run out of
 251 ;;      ;; buffer to process.
 252 ;;      (when (= p to)
 253 ;;        (return)))
 254 ;;       ;; Add these new items to the cache
 255 ;;       (let ((carray (lc-cache cache)))
 256 ;;      (adjust-array cache
 257 ;;                    (+ (length carray)
 258 ;;                       (length lines))
 259 ;;                    :initial-element (aref lines 0)
 260 ;;                    :fill-pointer (+ (length carray)
 261 ;;                                     (length lines)))
 262 ;;      (cond (rplc-start
 263 ;;             ;; Put it at the beginning
 264 ;;             (dformat +debug-vvv+ "rplc-start~%")
 265 ;;             (setf (lc-start cache) from)
 266 ;;             (replace carray carray :start1 (length lines))
 267 ;;             (replace carray lines))
 268 ;;            (rplc-end
 269 ;;             (dformat +debug-vvv+ "rplc-end~%")
 270 ;;             (setf (lc-end cache) to)
 271 ;;             (replace carray lines :start1 (- (length carray)
 272 ;;                                             (length lines))))
 273 ;;            (empty-cache
 274 ;;             (dformat +debug-vvv+ "empty-cache~%")
 275 ;;             (setf (lc-start cache) from)
 276 ;;             (setf (lc-end cache) to)
 277 ;;             ;; FIXME: we could just use lines instead of copy them over, right?
 278 ;;             (replace carray lines))))))
 279 ;;   (dformat +debug-vvv+ "after gen-n-lines: ~a~%" (lc-cache cache)))
 280
 281 (defun generate-n-lines-forward (buffer width from n-lines)
 282   "Return an array of cache-items for N-LINES lines in BUFFER rendered
 283 with WIDTH columns starting at FROM. The array will have length at
 284 least N-LINES."
 285   (declare (type buffer buffer)
 286            (type integer width from))
 287   (let ((lines (make-empty-cache-item-vector))
 288         (to (1- (buffer-size buffer))))
 289     (dformat +debug-vvv+ "generate-n-lines: ~a ~a~%" from to)
 290     ;; search for newlines until we hit TO
 291     (do ((last-p from (1+ p))
 292          (p (buffer-scan-newline buffer from to 1)
 293             (buffer-scan-newline buffer (1+ p) to 1))
 294          (l 0 (1+ l)))
 295         (nil)
 296
 297       ;; Break the buffer line into chunks that fit on one window line
 298       (dformat +debug-vvv+ "last-p: ~a p:~a~%" last-p p)
 299       (loop for i from last-p by width
 300             do (setf lines (add-line-to-cache lines i (if (<= (+ i (1- width)) p)
 301                                                           (+ i (1- width))
 302                                                         p)))
 303 ;; (vector-push-extend (make-cache-item :start i
 304 ;;                                                  :end (if (<= (+ i (1- width)) p)
 305 ;;                                                           (+ i (1- width))
 306 ;;                                                         p))
 307 ;;                                 lines)
 308             always (< (+ i (1- width)) p))
 309       ;; Once we've processed the new line, check if we've generated
 310       ;; enough lines. Return LINES we're done.
 311       (when (or (>= (length lines) n-lines)
 312                 (>= p to))
 313         (return lines)))))
 314
 315 (defun generate-n-lines-backward (buffer width from n-lines)
 316   "Return an array of cache-items for N-LINES lines in BUFFER rendered
 317 with WIDTH columns starting at FROM and going backward. The array will
 318 have length at least N-LINES.
 319
 320 FROM is assumed to the char pos of the newline at the end of the
 321 starting line."
 322   (declare (type buffer buffer)
 323            (type integer width from))
 324   (let ((lines (make-empty-cache-item-vector))
 325         (to 0))
 326     (dformat +debug-vvv+ "generate-n-lines: ~a ~a~%" from to)
 327     ;; search for newlines until we hit TO.
 328     (do ((last-p from p)
 329          (p (buffer-scan-newline buffer (1- from) to -1)
 330             (buffer-scan-newline buffer (1- p) to -1))
 331          (l 0 (1+ l)))
 332         (nil)
 333
 334       ;; Break the buffer line into chunks that fit on one window line
 335       (dformat +debug-vvv+ "last-p: ~a p:~a~%" last-p p)
 336       ;; unless we're at the beginning of the buffer, we want the char
 337       ;; after p because p will be a newline. last-p will be the
 338       ;; newline at the end of the line, 1+ p will be the beginning.
 339       ;;
 340       ;; this is a bit hairy because we're going backwards, but we go
 341       ;; through the line forward.
 342       ;;(let ((items (make-empty-cache-item-vector)))
 343       (loop for i from (if (zerop p) 0 (1+ p)) by width
 344             do (setf lines (add-line-to-cache lines
 345                                               i
 346                                               (if (<= (+ i (1- width)) last-p)
 347                                                   (+ i (1- width))
 348                                                 last-p)
 349                                               t))
 350             ;; (vector-push-extend (make-cache-item :start i
 351             ;;                                                :end (if (<= (+ i (1- width)) last-p)
 352             ;;                                                         (+ i (1- width))
 353             ;;                                                       last-p))
 354             ;;                               items)
 355             always (< (+ i (1- width)) last-p))
 356         ;;(vector-append lines (nreverse items)))
 357       ;; Once we've processed the new line, check if we've generated
 358       ;; enough lines. Return LINES we're done.
 359       (when (or (>= (length lines) n-lines)
 360                 (<= p to))
 361         (return  lines ;; (nreverse lines)
 362                  )))))
 363
 364 ;; (defun update-cache (cache buffer width point n-many)
 365 ;;   "Add N-MANY lines to the end of the line cache CACHE unless N-MANY
 366 ;; is negative. In that case add (abs n-many) to the beginning. This
 367 ;; function requires at least 1 line in the cache already.
 368
 369 ;; Lines are WIDTH in length. BUFFER is the data for caching."
 370 ;;   ;; Fill in above the cache
 371 ;;   (dformat +debug-vv+ "update-cache: ~a~%" n-many)
 372 ;;   (if (> n-many 0)
 373 ;;       (let* ((end (1+ (lc-end cache)))
 374 ;;           pt)
 375 ;;      ;; Go forward
 376 ;;      (when (< end (1- (buffer-size buffer)))
 377 ;;          ;; Add cache entries
 378 ;;        (setf pt (buffer-scan-newline buffer
 379 ;;                                      end (1- (buffer-size buffer))
 380 ;;                                      n-many))
 381 ;;        (generate-lines-region cache buffer width end pt)))
 382 ;;     ;; Go backward
 383 ;;     (let* ((start (1- (lc-start cache)))
 384 ;;         pt)
 385 ;;       ;; We need this because start is a newline, which we want to skip over
 386 ;;       (setf n-many (1- n-many))
 387 ;;       (dformat +debug-vvv+ "backward: ~a ~a ~a~%"
 388 ;;             start n-many (lc-cache cache))
 389 ;;       (when (and (> start 0)
 390 ;;               (/= n-many 0))
 391 ;;      ;; Add cache entries
 392 ;;      (setf pt (buffer-scan-newline buffer start 0 n-many))
 393 ;;      (generate-lines-region cache buffer width (if (> pt 0) (1+ pt) pt) start)))))
 394
 395 (defun add-end-of-buffer (buffer lines)
 396   "The point can be at (buffer-size buffer) but we only scan to
 397   1- that. So if we're scanned to the end of the buffer properly
 398   alter LINES to contain that point."
 399   (let ((end (1- (buffer-size buffer)))
 400         (last-elt (elt lines (1- (length lines)))))
 401     (when (= (cache-item-end last-elt) end)
 402       (if (char= (buffer-char-after buffer end) #\Newline)
 403           (add-line-to-cache lines (buffer-size buffer) (buffer-size buffer))
 404         (incf (cache-item-end last-elt))))))
 405
 406 (defun window-framer-from-top (window point &optional always-return-lines)
 407   "Fill in window's line cache from WINDOW-TOP with a full window's
 408 worth of lines and return T if POINT was in the line cache. otherwise
 409 don't change anything and return nil."
 410   (let* ((lines (generate-n-lines-forward (window-buffer window) (window-width window)
 411                                           (marker-position (window-top window))
 412                                           (window-height window))))
 413     (add-end-of-buffer (window-buffer window) lines)
 414     (when (or always-return-lines
 415               (point-in-line-cache lines point))
 416       lines)))
 417
 418 (defun window-framer-from-bottom (window point &optional always-return-lines)
 419   "Fill in window's line cache from WINDOW-BOTTOM with a full window's
 420 worth of lines and return T if POINT was in the line cache. otherwise
 421 don't change anything and return nil."
 422   (let* ((lines (generate-n-lines-backward (window-buffer window) (window-width window)
 423                                            (marker-position (window-bottom window))
 424                                            (window-height window))))
 425     (add-end-of-buffer (window-buffer window) lines)
 426     (when (or always-return-lines
 427               (point-in-line-cache lines point))
 428       lines)))
 429
 430 (defun window-framer-around-point (window point n-many)
 431   "Fill in window's line cache going out from point with n-many lines
 432 above WINDOW-POINT, or as many as possible if we hit the top of the window."
 433   ;; Add the line with the pointer on it
 434   (let* ((max (1- (buffer-size (window-buffer window))))
 435          (b (buffer-scan-newline (window-buffer window) point 0 0))
 436          (e (buffer-scan-newline (window-buffer window) point max 1))
 437          (lines-above (generate-n-lines-backward (window-buffer window) (window-width window)
 438                                                  e n-many))
 439          (lines-below (when (< e max)
 440                         (generate-n-lines-forward (window-buffer window) (window-width window)
 441                                                   (1+ e)
 442                                                   (- (window-height window)
 443                                                      (min n-many
 444                                                           (length lines-above)))))))
 445     (if lines-below
 446         (add-end-of-buffer (window-buffer window) lines-below)
 447       (add-end-of-buffer (window-buffer window) lines-above))
 448     (when (or (point-in-line-cache lines-above point)
 449               (point-in-line-cache lines-below point))
 450       (if lines-below
 451           (nconc lines-above lines-below)
 452 ;;        (grow-vector lines-above (length lines-below) (elt lines-below 0))
 453 ;;        (replace lines-above lines-below :start1 end))
 454       lines-above))))
 455
 456 (defun window-framer (window point n-many)
 457   "fill in window's line-cache."
 458   ;; first try the top/bottom markers. if point isn't in there then
 459   ;; center the window around point.
 460   (let* ((bot (and (window-bottom-valid window)
 461                    (window-framer-from-bottom window point)))
 462          (top (unless bot
 463                 (window-framer-from-top window point)))
 464          (around (unless top
 465                    (window-framer-around-point window point n-many)))
 466          (lines (or bot top around)))
 467     (assert lines)
 468     ;; set the top marker
 469     (setf (window-bottom-valid window) nil)
 470     (cond (bot
 471            (let* ((tl (max 0 (- (length lines) (window-height window))))
 472                   (bl (min (1- (length lines)) (+ tl (1- (window-height window))))))
 473              (setf (marker-position (window-top window))
 474                    (cache-item-start (elt lines tl))
 475                    (window-top-line window) tl
 476                    (marker-position (window-bottom window)) (cache-item-end (elt lines bl)))))
 477           (top
 478            (let* ((tl (point-in-line-cache lines (marker-position (window-top window))))
 479                   (bl (min (1- (length lines)) (+ tl (1- (window-height window))))))
 480              (setf (window-top-line window) tl
 481                    (marker-position (window-bottom window)) (cache-item-end (elt lines bl)))))
 482           (around
 483            (let* ((pl (point-in-line-cache lines point))
 484                   (tl (max 0 (- pl n-many)))
 485                   (bl (min (1- (length lines)) (+ tl (1- (window-height window))))))
 486              (setf (marker-position (window-top window))
 487                    (cache-item-start (elt lines tl))
 488                    (window-top-line window) tl
 489                    (marker-position (window-bottom window)) (cache-item-end (elt lines bl))))))
 490     ;; fill in window's cache
 491     (with-slots (cache) window
 492       (setf (lc-cache cache) lines
 493             (lc-start cache) (cache-item-start (elt lines 0))
 494             (lc-end cache) (cache-item-end (elt lines (1- (length lines))))
 495             (lc-valid cache) t))))
 496
 497
 498 ;; (defun window-framer (window point n-many)
 499 ;;   "Decide what part of the buffer to display in window. Sets top,
 500 ;; bottom, point-col, and point-line in window. N-MANY is the number of
 501 ;; lines from point to the top of the window."
 502 ;;   ;; Add the line with the pointer on it
 503 ;;   (let ((b (buffer-scan-newline (window-buffer window) point 0 0))
 504 ;;      (e (buffer-scan-newline (window-buffer window)
 505 ;;                              point (1- (buffer-size (window-buffer window))) 1)))
 506 ;;     (dformat +debug-vv+ "point line: ~a ~a~%" b e)
 507 ;;     (generate-lines-region window (if (= b 0) b (1+ b)) e))
 508 ;;   ;; search up n-many the window height
 509 ;;   (update-cache window (- n-many))
 510 ;;   (dformat +debug-vvv+ "cache s/e: ~a ~a~%"
 511 ;;         (lc-start (window-cache window))
 512 ;;         (lc-end (window-cache window)))
 513 ;;   ;; search down height - n-many + 1 (we've already generated the point's line)
 514 ;;   (update-cache window (- (window-height window) n-many -1))
 515 ;;   ;; Special case. if we got to the end of the buffer and it ends with
 516 ;;   ;; a newline. Add an extra cache line for line after that which
 517 ;;   ;; could contain the cursor.
 518 ;;   (when (= (lc-end (window-cache window))
 519 ;;         (1- (buffer-size (window-buffer window))))
 520 ;;     (add-line-to-cache window
 521 ;;                     (buffer-size (window-buffer window))
 522 ;;                     (buffer-size (window-buffer window))
 523 ;;                     nil t nil))
 524 ;;   ;; if we find window-top or window bottom in the cache then we
 525 ;;   ;; should use it as the top/bottom and generate the remaining lines
 526 ;;   (let ((wtop (point-window-line window (marker-position (window-top window))))
 527 ;;      (pline (point-window-line window point))
 528 ;;      (wbot (point-window-line window (marker-position (window-bottom window)))))
 529 ;;     (dformat +debug-vvv+ "cache: ~a~%" (lc-cache (window-cache window)))
 530 ;;     (dformat +debug-vv+ ">>>wtop: ~a ~a pline: ~a ~a wbot: ~a ~a~%"
 531 ;;           wtop (marker-position (window-top window))
 532 ;;           pline point
 533 ;;           wbot (marker-position (window-bottom window)))
 534 ;;     (cond ((and wtop
 535 ;;              (<= wtop pline))
 536 ;;         (dformat +debug-vv+ "wtop. ~a ~%" (cache-size window))
 537 ;;         (let ((lines-left (- (window-height window)
 538 ;;                              (- (cache-size window) wtop))))
 539 ;;           (when (> lines-left 0)
 540 ;;             (update-cache window lines-left))
 541 ;;           (dformat +debug-vvv+ "wtop cache: ~a~%" (lc-cache (window-cache window)))
 542 ;;           (setf (window-top-line window) wtop
 543 ;;                 (marker-position (window-top window)) (cache-item-start
 544 ;;                                                        (aref (lc-cache (window-cache window)) wtop))
 545 ;;                 (window-bottom-line window) (min (1- (cache-size window))
 546 ;;                                                  (+ wtop (window-height window) -1))
 547 ;;                 (marker-position (window-bottom window)) (cache-item-end
 548 ;;                                                           (aref (lc-cache (window-cache window))
 549 ;;                                                                 (window-bottom-line window))))))
 550 ;;        ((and wbot
 551 ;;              (>= wbot pline))
 552 ;;         (dformat +debug-vv+ "wbot. ~a ~%" (cache-size window))
 553 ;;         (let ((lines-left (- (window-height window) wbot 1)))
 554 ;;           (when (> lines-left 0)
 555 ;;             (update-cache window (- lines-left)))
 556 ;;           (dformat +debug-vvv+ "wbot cache: ~a~%" (lc-cache (window-cache window)))
 557 ;;           ;; we need to rescan bottom since lines may have been
 558 ;;           ;; added above it, invalidating wbot
 559 ;;           (setf wbot (point-window-line window (marker-position (window-bottom window)))
 560 ;;                 (window-bottom-line window) wbot
 561 ;;                 (marker-position (window-bottom window)) (cache-item-end (aref
 562 ;;                                                                           (lc-cache (window-cache window))
 563 ;;                                                                           wbot))
 564 ;;                 (window-top-line window) (max 0 (- wbot (window-height window) 1))
 565 ;;                 (marker-position (window-top window)) (cache-item-start (aref
 566 ;;                                                                          (lc-cache (window-cache window))
 567 ;;                                                                          (window-top-line window))))))
 568 ;;         (t
 569 ;;          (dformat +debug-vv+ "we need to scroll. ~a ~%" (cache-size window))
 570 ;;          (setf (window-top-line window) (max 0 (- pline n-many))
 571 ;;                (marker-position (window-top window)) (cache-item-start (aref (lc-cache (window-cache window))
 572 ;;                                                                              (window-top-line window)))
 573 ;;                (window-bottom-line window) (min
 574 ;;                                             (1- (cache-size window))
 575 ;;                                             (+ (window-top-line window) (window-height window) -1))
 576 ;;                (marker-position (window-bottom window)) (cache-item-end
 577 ;;                                                          (aref (lc-cache (window-cache window))
 578 ;;                                                                (window-bottom-line window)))))))
 579 ;;   (setf (window-point-line window) (point-window-line window point))
 580 ;;   (dformat +debug-vv+ "<<<top: ~a ~a pt: ~a ~a bot: ~a ~a~%"
 581 ;;         (window-top-line window) (marker-position (window-top window))
 582 ;;         (window-point-line window) point
 583 ;;         (window-bottom-line window) (marker-position (window-bottom window))))
 584
 585 (defun window-point (&optional window)
 586   "Return current value of point in WINDOW. For a nonselected window,
 587 this is the value point would have if that window were selected."
 588   (if (eq window (get-current-window))
 589       (point (window-buffer window))
 590     (marker-position (window-bpoint window))))
 591
 592 (defun set-window-point (window pos)
 593   (let ((mark (if (eq window (get-current-window))
 594                   (buffer-point (window-buffer window))
 595                 (window-bpoint window))))
 596     (if (and (<= pos (buffer-max (window-buffer window)))
 597              (>= pos (buffer-min (window-buffer window))))
 598         (setf (marker-position mark) pos)
 599       (error "out of range"))))
 600
 601 (defun get-buffer-window (buffer &optional frame)
 602   "Return a window currently displaying BUFFER, or nil if none.
 603 If optional argument FRAME is `visible', search all visible frames.
 604 If optional argument FRAME is 0, search all visible and iconified frames.
 605 If FRAME is t, search all frames.
 606 If FRAME is nil, search only the selected frame.
 607 If FRAME is a frame, search only that frame."
 608   ;; TODO: honour FRAME
 609   (setf frame (selected-frame)
 610         buffer (get-buffer buffer))
 611   (find buffer (frame-window-list frame) :key 'window-buffer))
 612
 613 (defun window-scroll-up (window n-lines)
 614   "scroll the window up (go torwards the end of the buffer) LINES many
 615 lines, moving the window point to be visible."
 616   (let* ((len (+ (window-height window) n-lines))
 617          (lines (generate-n-lines-forward (window-buffer window) (window-width window)
 618                                          (marker-position (window-top window))
 619                                          len)))
 620     ;; if there aren't n-lines left in the buffer then signal
 621     ;; an end-of-buffer error.
 622 ;;     (unless (>= (length lines) n-lines)
 623 ;;       (error "end of buffer"))
 624     (setf (marker-position (window-top window)) (cache-item-start (elt lines
 625                                                                        (1- (min (length lines)
 626                                                                                 n-lines)))))
 627     ;; FIXME: for now, set the point at the top of the window if it
 628     ;; isn't visible.
 629     (when (or (< (window-point window) (marker-position (window-top window)))
 630               (not (point-in-line-cache lines (window-point window))))
 631       (set-window-point window (marker-position (window-top window))))))
 632
 633 (defun window-scroll-down (window n-lines)
 634   "scroll the window down (go torwards the beginning of the buffer)
 635 LINES many lines, moving the window point to be visible."
 636   (let* ((len (+ (window-height window) n-lines))
 637          ;; FIXME: this is basically, gross.
 638          (above (generate-n-lines-backward (window-buffer window) (window-width window)
 639                                            (max (buffer-min (window-buffer window))
 640                                                 (1- (marker-position (window-top window))))
 641                                            n-lines))
 642          (lines (generate-n-lines-forward (window-buffer window) (window-width window)
 643                                           (cache-item-start
 644                                            (elt above (max 0 (- (length above) n-lines))))
 645                                           len)))
 646     ;; if there aren't n-lines left in the buffer then signal
 647     ;; an end-of-buffer error.
 648 ;;     (unless (>= (length above) n-lines)
 649 ;;       (error "beginning of buffer"))
 650     (setf (marker-position (window-top window)) (cache-item-start (elt lines 0)))
 651     ;; FIXME: for now, set the point at the bottom of the window if it
 652     ;; isn't visible.
 653     (let ((eow (elt lines (1- (min (length lines)
 654                                    (window-height window))))))
 655       (when (or (> (window-point window) (cache-item-end eow))
 656                 (not (point-in-line-cache lines (window-point window))))
 657         (set-window-point window (cache-item-start eow))))))
 658
 659 (defun window-save-point (window)
 660   "Save WINDOW's buffer's point to WINDOW-BPOINT."
 661   (setf (marker-position (window-bpoint window)) (point (window-buffer window))))
 662
 663 (defun window-restore-point (window)
 664   "Restore the WINDOW's buffer's point from WINDOW-BPOINT."
 665   ;; restore the point
 666   (setf (marker-position (buffer-point (window-buffer window)))
 667         (marker-position (window-bpoint window))))
 668
 669 (provide :lice-0.1/window)