3 (defvar *frame-list
* nil
4 "List of frames lice frames.")
6 ;; XXX: This is only temporary
7 (defvar *current-frame
* nil
8 "The frame that accepts input.")
10 (defun selected-frame ()
11 "Return the frame that is now selected."
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."))
23 (defun set-frame-minibuffer (frame minibuffer
)
24 "Make MINIBUFFER the minibuffer for FRAME."
25 (setf (window-buffer (frame-minibuffer-window frame
)) minibuffer
))
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."))
31 (defgeneric frame-end-render
(frame)
32 (:documentation
"Do any cleanup or refreshing after the frame is rendered."))
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."))
38 (defgeneric frame-read-event
(frame)
39 (:documentation
"Read a keyboard event for the specified frame."))
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."))
44 (defun frame-render (frame)
46 (let (cursor-x cursor-y win
)
47 (labels ((render (tree)
48 (cond ((null tree
) nil
)
51 (window-reset-cache tree
)
52 ;; Figure out what part to display
55 (truncate (window-height tree
) 2))
56 (dformat +debug-vvv
+ "after framer: ~a~%"
57 (lc-cache (window-cache tree
)))
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
))))
71 (defun resize-window (window amount
&optional
(dir :height
))
72 "grow or shrink window, resizing dependant windows as well."
73 (declare (ignore window amount dir
))
74 ;; (let* ((frame (frame-window-tree (frame-for-window window)))
75 ;; (sibling (tree-sibling frame window)))
79 (defun current-buffer ()
80 "Return the current buffer."
81 ;; FIXME: maybe this should just return *current-buffer*
83 ;;(window-buffer (frame-current-window (selected-frame)))
86 (defun active-minibuffer-window ()
87 "Return the currently active minibuffer window or nil if there isn't
89 (let ((frame (selected-frame)))
90 (unless (zerop (frame-minibuffers-active frame
))
91 (frame-minibuffer-window frame
))))
93 (defun frame-window-list (frame &optional minibuf
)
94 "Return the list of windows in FRAME. If MINIBUF is true then include the minibuffer window."
95 ;; (declare (type frame frame))
96 ;; FIXME: The reason we need to pass MB into flatten is because movitz can't "lend optional right now"
97 (labels ((flatten (tree mb
)
99 (unless (and (typep tree
'minibuffer-window
)
102 (nconc (flatten (first tree
) mb
)
103 (flatten (second tree
) mb
)))))
104 (flatten (frame-window-tree frame
) minibuf
)))
106 (defun window-tree-find-if (fn tree
&optional minibuf
)
107 "depth first search the tree. Return the element that satisfies FN."
110 thereis
(window-tree-find-if fn i minibuf
)))
111 ((typep tree
'minibuffer-window
)
116 (when (funcall fn tree
)
119 (defun replace-window-in-frame-tree (window new
)
120 (labels ((doit (tree window new
)
121 (let ((p (position window tree
)))
123 (setf (nth p tree
) new
)
126 (doit w window new
)))))))
127 (doit (frame-window-tree (window-frame window
))
131 ;; (defun replace-window-parent-in-frame-tree (window new)
132 ;; (labels ((doit (tree parent window new)
133 ;; (when (listp tree)
134 ;; (let (loop for i in (remove-if-not 'listp tree)
135 ;; thereis (find window i))
139 ;; (doit (frame-window-tree (window-frame window))
143 (defun split-window (&optional
(window (get-current-window)) size horflag
)
144 (when (typep window
'minibuffer-window
)
145 (error "Attempt to split minibuffer window"))
147 (setf size
(if horflag
148 (ceiling (window-width window t
) 2)
149 (ceiling (window-height window t
) 2))))
153 (when (< size
*window-min-width
*)
154 (error "Window width ~a too small (after splitting)" size
))
155 ;; will the other window be too big?
156 (when (> (+ size
*window-min-width
*)
157 (window-width window t
))
158 (error "Window width ~a too small (after splitting)" (- (window-width window t
) size
)))
159 (setf new
(make-window :x
(+ (window-x window
) size
)
161 :cols
(- (window-width window t
) size
)
162 :rows
(window-height window t
)
163 :buffer
(window-buffer window
)
164 :frame
(window-frame window
))
165 (window-seperator new
) (window-seperator window
)
166 (window-seperator window
) t
167 (slot-value window
'w
) size
)
168 ;;(update-window-display-arrays window)
171 (when (< size
*window-min-height
*)
172 (error "Window height ~a too small (after splitting)" size
))
173 ;; will the other window be too big?
174 (when (> (+ size
*window-min-height
*)
175 (window-height window t
))
176 (error "Window width ~a too small (after splitting)" (- (window-height window t
) size
)))
177 (setf new
(make-window :x
(window-x window
)
178 :y
(+ (window-y window
) size
)
179 :cols
(window-width window t
)
180 :rows
(- (window-height window t
) size
)
181 :buffer
(window-buffer window
)
182 :frame
(window-frame window
))
183 (window-seperator new
) (window-seperator window
)
184 (slot-value window
'h
) size
)
185 ;;(update-window-display-arrays window)
187 (replace-window-in-frame-tree window
(list window new
))
190 (defun next-window (window &optional minibuf
)
191 "Return next window after WINDOW in canonical ordering of windows.
192 FIXME: make this the same as Emacs' next-window."
193 (let* ((frame (window-frame window
))
194 (tree (frame-window-tree frame
))
196 ;; when we find WINDOW, set BIT to T and return the next window.
197 (w (window-tree-find-if (lambda (w)
203 (and minibuf
(> (frame-minibuffers-active frame
) 0)))))
204 ;; if we didn't find the next one, maybe it's the first one
206 (let ((other (window-tree-find-if #'identity tree
)))
207 (unless (eq window other
)
212 (defun select-window (window &optional norecord
)
213 "Select WINDOW. Most editing will apply to WINDOW's buffer.
214 If WINDOW is not already selected, also make WINDOW's buffer current.
215 Also make WINDOW the frame's selected window.
216 Optional second arg NORECORD non-nil means
217 do not put this buffer at the front of the list of recently selected ones.
219 **Note that the main editor command loop
220 **selects the buffer of the selected window before each command."
221 (declare (ignore norecord
))
222 ;; FIXME: get NORECORD working
223 (window-save-point (get-current-window))
224 ;; FIXME: this doesn't make sure window-frame is current.
225 (setf (frame-current-window (window-frame window
)) window
)
226 (set-buffer (window-buffer window
))
227 (window-restore-point window
))
229 (defun display-buffer (buffer &optional not-this-window frame
)
230 "Make BUFFER appear in some window but don't select it.
231 BUFFER can be a buffer or a buffer name.
232 If BUFFER is shown already in some window, just use that one,
233 unless the window is the selected window and the optional second
234 argument NOT-THIS-WINDOW is non-nil (interactively, with prefix arg).
235 **If `pop-up-frames' is non-nil, make a new frame if no window shows BUFFER.
236 **Returns the window displaying BUFFER.
237 **If `display-buffer-reuse-frames' is non-nil, and another frame is currently
238 **displaying BUFFER, then simply raise that frame."
239 (declare (ignore frame
))
240 (setf buffer
(get-buffer buffer
))
241 (let* ((cw (get-current-window))
242 (w (or (window-tree-find-if (lambda (w)
243 (and (not (and not-this-window
245 (eq (window-buffer w
) buffer
)))
246 (frame-window-tree (selected-frame)))
249 (set-window-buffer w buffer
)
250 (window-restore-point w
)
253 (defun pop-to-buffer (buffer &optional other-window norecord
)
254 "Select buffer BUFFER in some window, preferably a different one.
255 If `pop-up-windows' is non-nil, windows can be split to do this.
256 If optional second arg OTHER-WINDOW is non-nil, insist on finding another
257 window even if BUFFER is already visible in the selected window.
258 This uses the function `display-buffer' as a subroutine; see the documentation
259 of `display-buffer' for additional customization information.
261 **Optional third arg NORECORD non-nil means
262 **do not put this buffer at the front of the list of recently selected ones."
263 (declare (ignore norecord
))
264 ;; FIXME: honour NORECORD
265 (setf buffer
(if buffer
266 (or (get-buffer buffer
)
268 (get-buffer-create buffer
)))
269 ;; FIXME: (set-buffer-major-mode buffer)
270 (other-buffer (current-buffer))))
271 (select-window (display-buffer buffer other-window
)))
273 (defun sit-for (seconds &optional nodisp
)
274 "Perform redisplay, then wait for seconds seconds or until input is available.
275 seconds may be a floating-point value, meaning that you can wait for a
276 fraction of a second.
277 (Not all operating systems support waiting for a fraction of a second.)
278 Optional arg nodisp non-nil means don't redisplay, just wait for input.
279 Redisplay is preempted as always if input arrives, and does not happen
280 if input is available before it starts.
281 Value is t if waited the full time with no input arriving."
282 (declare (ignore seconds nodisp
))
283 ;; FIXME: actually sleep
284 (frame-render (selected-frame)))
286 (provide :lice-0.1
/frame
)