frame.lisp

   1 (in-package :lice)
   2
   3 (defvar *frame-list* nil
   4   "List of frames lice frames.")
   5
   6 ;; XXX: This is only temporary
   7 (defvar *current-frame* nil
   8   "The frame that accepts input.")
   9
  10 (defun selected-frame ()
  11   "Return the frame that is now selected."
  12   *current-frame*)
  13
  14 (defclass frame ()
  15   ((window-tree :type (or list window) :initarg :window-tree :accessor frame-window-tree)
  16    (width :type fixnum :initarg :width :accessor frame-width)
  17    (height :type fixnum :initarg :height :accessor frame-height)
  18    (minibuffer-window :type window :initarg :minibuffer-window :accessor frame-minibuffer-window)
  19    (minibuffers-active :type fixnum :initform 0 :initarg minibuffers-active :accessor frame-minibuffers-active)
  20    (current-window :type window :initarg :current-window :accessor frame-current-window))
  21   (:documentation "A Lice frame is super cool."))
  22
  23 (defun set-frame-minibuffer (frame minibuffer)
  24   "Make MINIBUFFER the minibuffer for FRAME."
  25   (setf (window-buffer (frame-minibuffer-window frame)) minibuffer))
  26
  27 ;; The defmethods are found in the *-render.lisp files
  28 (defgeneric frame-start-render (frame)
  29   (:documentation "Do any setup we need before we beginning rendering the frame."))
  30
  31 (defgeneric frame-end-render (frame)
  32   (:documentation "Do any cleanup or refreshing after the frame is rendered."))
  33
  34 ;; the defmethods are found in the *-render.lisp files
  35 (defgeneric window-render (window frame)
  36   (:documentation "Render the window in the given frame."))
  37
  38 (defgeneric frame-read-event (frame)
  39   (:documentation "Read a keyboard event for the specified frame."))
  40
  41 (defgeneric frame-move-cursor (frame window x y)
  42   (:documentation "Move the cursor to the X,Y location in WINDOW on the frame, FRAME."))
  43
  44 (defun frame-render (frame)
  45   "Render a frame."
  46   (let (cursor-x cursor-y win)
  47     (labels ((render (tree)
  48                      (cond ((null tree) nil)
  49                            ((atom tree)
  50                             ;; reset the cache
  51                             (window-reset-cache tree)
  52                             ;; Figure out what part to display
  53                             (window-framer tree
  54                                            (window-point tree)
  55                                            (truncate (window-height tree) 2))
  56                             (dformat +debug-vvv+ "after framer: ~a~%"
  57                                      (lc-cache (window-cache tree)))
  58                             ;; display it
  59                             (multiple-value-bind (x y) (window-render tree frame)
  60                               (when (eq tree (frame-current-window frame))
  61                                 (setf win tree cursor-x x cursor-y y))))
  62                            (t (cons (render (car tree))
  63                                     (render (cdr tree)))))))
  64       (frame-start-render frame)
  65       (render (frame-window-tree frame))
  66       (when (and win cursor-x cursor-y)
  67         (frame-move-cursor frame win cursor-x cursor-y))
  68       (frame-end-render frame))))
  69
  70
  71 (defun resize-window (window amount &optional (dir :height))
  72   "grow or shrink window, resizing dependant windows as well."
  73   (let* ((frame (frame-window-tree (frame-for-window window)))
  74          (sibling (tree-sibling frame window)))
  75     ))
  76
  77 (defun current-buffer ()
  78   "Return the current buffer."
  79   ;; FIXME: maybe this should just return *current-buffer*
  80   (or *current-buffer*
  81       (window-buffer (frame-current-window (selected-frame)))))
  82
  83 (defun active-minibuffer-window ()
  84   "Return the currently active minibuffer window or nil if there isn't
  85 one."
  86   (let ((frame (selected-frame)))
  87     (unless (zerop (frame-minibuffers-active frame))
  88       (frame-minibuffer-window frame))))
  89
  90 (defun frame-window-list (frame &optional minibuf)
  91   "Return the list of windows in FRAME. If MINIBUF is true then include the minibuffer window."
  92 ;;   (declare (type frame frame))
  93   ;; FIXME: The reason we need to pass MB into flatten is because movitz can't "lend optional right now"
  94   (labels ((flatten (tree mb)
  95              (if (atom tree)
  96                  (unless (and (typep tree 'minibuffer-window)
  97                               (not mb))
  98                    (list tree))
  99                (nconc (flatten (first tree) mb)
 100                       (flatten (second tree) mb)))))
 101     (flatten (frame-window-tree frame) minibuf)))
 102
 103 (defun window-tree-find-if (fn tree &optional minibuf)
 104   "depth first search the tree. Return the element that satisfies FN."
 105   (cond ((listp tree)
 106          (loop for i in tree
 107                thereis (window-tree-find-if fn i minibuf)))
 108         ((typep tree 'minibuffer-window)
 109          (when (and minibuf
 110                     (funcall fn tree))
 111            tree))
 112         (t
 113          (when (funcall fn tree)
 114            tree))))
 115
 116 (defun replace-window-in-frame-tree (window new)
 117   (labels ((doit (tree window new)
 118              (let ((p (position window tree)))
 119                (if p
 120                    (setf (nth p tree) new)
 121                  (loop for w in tree
 122                        until (and (listp w)
 123                                   (doit w window new)))))))
 124     (doit (frame-window-tree (window-frame window))
 125           window
 126           new)))
 127
 128 (defun split-window (&optional (window (get-current-window)) size horflag)
 129   (when (typep window 'minibuffer-window)
 130     (error "Attempt to split minibuffer window"))
 131   (when (null size)
 132     (setf size (if horflag
 133                    (ceiling (window-width window t) 2)
 134                  (ceiling (window-height window t) 2))))
 135   (let (new)
 136     (if horflag
 137         (progn
 138           (when (< size *window-min-width*)
 139             (error "Window width ~a too small (after splitting)" size))
 140           ;; will the other window be too big?
 141           (when (> (+ size *window-min-width*)
 142                    (window-width window t))
 143             (error "Window width ~a too small (after splitting)" (- (window-width window t) size)))
 144           (setf new (make-window :x (+ (window-x window) size)
 145                                  :y (window-y window)
 146                                  :cols (- (window-width window t) size)
 147                                  :rows (window-height window t)
 148                                  :buffer (window-buffer window)
 149                                  :frame (window-frame window))
 150                 (window-seperator new) (window-seperator window)
 151                 (window-seperator window) t
 152                 (slot-value window 'w) size)
 153           ;;(update-window-display-arrays window)
 154           )
 155       (progn
 156         (when (< size *window-min-height*)
 157           (error "Window height ~a too small (after splitting)" size))
 158         ;; will the other window be too big?
 159         (when (> (+ size *window-min-height*)
 160                  (window-height window t))
 161           (error "Window width ~a too small (after splitting)" (- (window-height window t) size)))
 162         (setf new (make-window :x (window-x window)
 163                                :y (+ (window-y window) size)
 164                                :cols (window-width window t)
 165                                :rows (- (window-height window t) size)
 166                                :buffer (window-buffer window)
 167                                :frame (window-frame window))
 168               (window-seperator new) (window-seperator window)
 169               (slot-value window 'h) size)
 170         ;;(update-window-display-arrays window)
 171         ))
 172     (replace-window-in-frame-tree window (list window new))
 173     new))
 174
 175 (defun next-window (window &optional minibuf)
 176   "Return next window after WINDOW in canonical ordering of windows.
 177 FIXME: make this the same as Emacs' next-window."
 178   (let* ((frame (window-frame window))
 179          (tree (frame-window-tree frame))
 180          bit
 181          ;; when we find WINDOW, set BIT to T and return the next window.
 182          (w (window-tree-find-if (lambda (w)
 183                                    (cond (bit w)
 184                                          ((eq w window)
 185                                           (setf bit t)
 186                                           nil)))
 187                                  tree
 188                                  (and minibuf (> (frame-minibuffers-active frame) 0)))))
 189     ;; if we didn't find the next one, maybe it's the first one
 190     (if (not w)
 191         (let ((other (window-tree-find-if #'identity tree)))
 192           (unless (eq window other)
 193             other))
 194       w)))
 195
 196
 197 (defun select-window (window &optional norecord)
 198   "Select WINDOW.  Most editing will apply to WINDOW's buffer.
 199 If WINDOW is not already selected, also make WINDOW's buffer current.
 200 Also make WINDOW the frame's selected window.
 201 Optional second arg NORECORD non-nil means
 202 do not put this buffer at the front of the list of recently selected ones.
 203
 204 **Note that the main editor command loop
 205 **selects the buffer of the selected window before each command."
 206   ;; FIXME: get NORECORD working
 207   (window-save-point (get-current-window))
 208   ;; FIXME: this doesn't make sure window-frame is current.
 209   (setf (frame-current-window (window-frame window)) window)
 210   (set-buffer (window-buffer window))
 211   (window-restore-point window))
 212
 213 (defun display-buffer (buffer &optional not-this-window frame)
 214   "Make BUFFER appear in some window but don't select it.
 215 BUFFER can be a buffer or a buffer name.
 216 If BUFFER is shown already in some window, just use that one,
 217 unless the window is the selected window and the optional second
 218 argument NOT-THIS-WINDOW is non-nil (interactively, with prefix arg).
 219 **If `pop-up-frames' is non-nil, make a new frame if no window shows BUFFER.
 220 **Returns the window displaying BUFFER.
 221 **If `display-buffer-reuse-frames' is non-nil, and another frame is currently
 222 **displaying BUFFER, then simply raise that frame."
 223   (setf buffer (get-buffer buffer))
 224   (let* ((cw (get-current-window))
 225          (w (or (window-tree-find-if (lambda (w)
 226                                        (and (not (and not-this-window
 227                                                       (eq w cw)))
 228                                             (eq (window-buffer w) buffer)))
 229                                      (frame-window-tree (selected-frame)))
 230                 (next-window cw)
 231                 (split-window cw))))
 232     (set-window-buffer w buffer)
 233     (window-restore-point w)
 234     w))
 235
 236 (defun pop-to-buffer (buffer &optional other-window norecord)
 237   "Select buffer BUFFER in some window, preferably a different one.
 238 If `pop-up-windows' is non-nil, windows can be split to do this.
 239 If optional second arg OTHER-WINDOW is non-nil, insist on finding another
 240 window even if BUFFER is already visible in the selected window.
 241 This uses the function `display-buffer' as a subroutine; see the documentation
 242 of `display-buffer' for additional customization information.
 243
 244 **Optional third arg NORECORD non-nil means
 245 **do not put this buffer at the front of the list of recently selected ones."
 246   ;; FIXME: honour NORECORD
 247   (setf buffer (if buffer
 248                    (or (get-buffer buffer)
 249                        (progn
 250                          (get-buffer-create buffer)))
 251                          ;; FIXME: (set-buffer-major-mode buffer)
 252                  (other-buffer (current-buffer))))
 253   (select-window (display-buffer buffer other-window)))
 254
 255 (defun sit-for (seconds &optional nodisp)
 256   "Perform redisplay, then wait for seconds seconds or until input is available.
 257 seconds may be a floating-point value, meaning that you can wait for a
 258 fraction of a second.
 259  (Not all operating systems support waiting for a fraction of a second.)
 260 Optional arg nodisp non-nil means don't redisplay, just wait for input.
 261 Redisplay is preempted as always if input arrives, and does not happen
 262 if input is available before it starts.
 263 Value is t if waited the full time with no input arriving."
 264   ;; FIXME: actually sleep
 265   (frame-render (selected-frame)))
 266
 267
 268 (provide :lice-0.1/frame)