![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to window.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [CSRG BSD Unix] / 43BSDReno / contrib / emacs-18.55 / src|
Return to window.c CVS log | Up to [CSRG BSD Unix] / 43BSDReno / contrib / emacs-18.55 / src |
1.1 root 1: /* Window creation, deletion and examination for GNU Emacs.
2: Does not include redisplay.
3: Copyright (C) 1985, 1986, 1987 Free Software Foundation, Inc.
4:
5: This file is part of GNU Emacs.
6:
7: GNU Emacs is distributed in the hope that it will be useful,
8: but WITHOUT ANY WARRANTY. No author or distributor
9: accepts responsibility to anyone for the consequences of using it
10: or for whether it serves any particular purpose or works at all,
11: unless he says so in writing. Refer to the GNU Emacs General Public
12: License for full details.
13:
14: Everyone is granted permission to copy, modify and redistribute
15: GNU Emacs, but only under the conditions described in the
16: GNU Emacs General Public License. A copy of this license is
17: supposed to have been given to you along with GNU Emacs so you
18: can know your rights and responsibilities. It should be in a
19: file named COPYING. Among other things, the copyright notice
20: and this notice must be preserved on all copies. */
21:
22:
23: #include "config.h"
24: #include "lisp.h"
25: #include "buffer.h"
26: #include "window.h"
27: #include "commands.h"
28: #include "indent.h"
29: #include "termchar.h"
30:
31: Lisp_Object Qwindowp;
32:
33: Lisp_Object Fnext_window (), Fdelete_window (), Fselect_window ();
34: Lisp_Object Fset_window_buffer (), Fsplit_window (), Frecenter ();
35:
36: /* This is the window which displays the minibuffer.
37: It is always the same window. */
38:
39: Lisp_Object minibuf_window;
40:
41: /* This is the window in which the terminal's cursor should
42: be left when nothing is being done with it. This must
43: always be a leaf window, and its buffer is selected by
44: the top level editing loop at the end of each command. */
45:
46: Lisp_Object selected_window;
47:
48: /* Non-nil means it is the window for C-M-v to scroll
49: when the minibuffer is selected. */
50:
51: Lisp_Object Vminibuf_scroll_window;
52:
53: /* Non-nil means it's function to call to display temp buffers. */
54:
55: Lisp_Object Vtemp_buffer_show_hook;
56:
57: /* If a window gets smaller than either of these, it is removed. */
58:
59: int window_min_height;
60: int window_min_width;
61:
62: /* Nonzero implies pop_to_buffer should create windows. */
63:
64: int pop_up_windows;
65:
66: /* display-buffer always splits the largest window
67: if that window is more than this high */
68:
69: int split_height_threshold;
70:
71: /* Number of lines of continuity in scrolling by screenfuls. */
72:
73: int next_screen_context_lines;
74:
75: /* Incremented for each window created. */
76:
77: static int sequence_number;
78:
79: DEFUN ("windowp", Fwindowp, Swindowp, 1, 1, 0,
80: "Returns t if OBJ is a window.")
81: (obj)
82: Lisp_Object obj;
83: {
84: return XTYPE (obj) == Lisp_Window ? Qt : Qnil;
85: }
86:
87: static Lisp_Object
88: make_window ()
89: {
90: register Lisp_Object val;
91: register struct window *p;
92:
93: /* Add sizeof (Lisp_Object) here because sizeof (struct Lisp_Vector)
94: includes the first element. */
95: val = Fmake_vector (
96: make_number ((sizeof (struct window) - sizeof (struct Lisp_Vector)
97: + sizeof (Lisp_Object))
98: / sizeof (Lisp_Object)),
99: Qnil);
100: XSETTYPE (val, Lisp_Window);
101: p = XWINDOW (val);
102: XFASTINT (p->sequence_number) = ++sequence_number;
103: XFASTINT (p->left) = XFASTINT (p->top)
104: = XFASTINT (p->height) = XFASTINT (p->width)
105: = XFASTINT (p->hscroll) = 0;
106: XFASTINT (p->last_point_x) = XFASTINT (p->last_point_y) = 0;
107: p->start = Fmake_marker ();
108: p->pointm = Fmake_marker ();
109: XFASTINT (p->use_time) = 0;
110: return val;
111: }
112:
113: DEFUN ("selected-window", Fselected_window, Sselected_window, 0, 0, 0,
114: "Return the window that the cursor now appears in and commands apply to.")
115: ()
116: {
117: return selected_window;
118: }
119:
120: DEFUN ("minibuffer-window", Fminibuffer_window, Sminibuffer_window, 0, 0, 0,
121: "Return the window used for minibuffers.")
122: ()
123: {
124: return minibuf_window;
125: }
126:
127: DEFUN ("pos-visible-in-window-p", Fpos_visible_in_window_p,
128: Spos_visible_in_window_p, 0, 2, 0,
129: "Return t if position POS is currently on the screen in WINDOW.\n\
130: Returns nil if that position is scrolled vertically out of view.\n\
131: POS defaults to point; WINDOW, to the selected window.")
132: (pos, window)
133: Lisp_Object pos, window;
134: {
135: register struct window *w;
136: register int top;
137: register int height;
138: register int posint;
139: register struct buffer_text *text;
140: struct position posval;
141:
142: if (NULL (pos))
143: posint = point;
144: else
145: {
146: CHECK_NUMBER_COERCE_MARKER (pos, 0);
147: posint = XINT (pos);
148: }
149:
150: if (NULL (window))
151: window = selected_window;
152: else
153: CHECK_WINDOW (window, 1);
154: w = XWINDOW (window);
155: top = marker_position (w->start);
156:
157: if (posint < top)
158: return Qnil;
159:
160: height = XFASTINT (w->height) - !EQ (window, minibuf_window);
161:
162: bf_cur->text = bf_text;
163: text = &XBUFFER (w->buffer)->text;
164: if (XFASTINT (w->last_modified) >= text->modified)
165: {
166: /* If screen is up to date,
167: use the info recorded about how much text fit on it. */
168: if (posint < text->size1 + text->size2 + 1 - XFASTINT (w->window_end_pos)
169: || (XFASTINT (w->window_end_vpos) < height))
170: return Qt;
171: return Qnil;
172: }
173: else
174: {
175: if (posint > text->size1 + text->size2 + 1)
176: return Qnil;
177: /* If that info is not correct, calculate afresh */
178: posval = *compute_motion (top, 0, 0,
179: posint, height, 0,
180: XFASTINT (w->width) - 1
181: - (XFASTINT (w->width) + XFASTINT (w->left) != XFASTINT (XWINDOW (minibuf_window)->width)),
182:
183: XINT (w->hscroll), 0);
184: return posval.vpos < height ? Qt : Qnil;
185: }
186: }
187:
188: static struct window *
189: decode_window (window)
190: register Lisp_Object window;
191: {
192: if (NULL (window))
193: return XWINDOW (selected_window);
194:
195: CHECK_WINDOW (window, 0);
196: return XWINDOW (window);
197: }
198:
199: DEFUN ("window-buffer", Fwindow_buffer, Swindow_buffer, 0, 1, 0,
200: "Return the buffer that WINDOW is displaying.")
201: (window)
202: Lisp_Object window;
203: {
204: return decode_window (window)->buffer;
205: }
206:
207: DEFUN ("window-height", Fwindow_height, Swindow_height, 0, 1, 0,
208: "Return the number of lines in WINDOW (including its mode line).")
209: (window)
210: Lisp_Object window;
211: {
212: return decode_window (window)->height;
213: }
214:
215: DEFUN ("window-width", Fwindow_width, Swindow_width, 0, 1, 0,
216: "Return the number of columns in WINDOW.")
217: (window)
218: Lisp_Object window;
219: {
220: register int w = decode_window (window)->width;
221: /* If this window does not end at the right margin,
222: must deduct one column for the border */
223: if (w + decode_window (window)->left == screen_width)
224: return w;
225: return w - 1;
226: }
227:
228: DEFUN ("window-hscroll", Fwindow_hscroll, Swindow_hscroll, 0, 1, 0,
229: "Return the number of columns by which WINDOW is scrolled from left margin.")
230: (window)
231: Lisp_Object window;
232: {
233: return decode_window (window)->hscroll;
234: }
235:
236: DEFUN ("set-window-hscroll", Fset_window_hscroll, Sset_window_hscroll, 2, 2, 0,
237: "Set number of columns WINDOW is scrolled from left margin to NCOL.\n\
238: NCOL should be zero or positive.")
239: (window, ncol)
240: register Lisp_Object window, ncol;
241: {
242: register struct window *w;
243:
244: CHECK_NUMBER (ncol, 1);
245: if (XINT (ncol) < 0) XFASTINT (ncol) = 0;
246: if (XFASTINT (ncol) >= (1 << (SHORTBITS - 1)))
247: args_out_of_range (ncol, Qnil);
248: w = decode_window (window);
249: if (w->hscroll != ncol)
250: clip_changed = 1; /* Prevent redisplay shortcuts */
251: w->hscroll = ncol;
252: return ncol;
253: }
254:
255: DEFUN ("window-edges", Fwindow_edges, Swindow_edges, 0, 1, 0,
256: "Return a list of the edge coordinates of WINDOW.\n\
257: \(LEFT TOP RIGHT BOTTOM), all relative to 0, 0 at top left corner of screen.\n\
258: RIGHT is one more than the rightmost column used by WINDOW,\n\
259: and BOTTOM is one more than the bottommost row used by WINDOW\n\
260: and its mode-line.")
261: (window)
262: Lisp_Object window;
263: {
264: register struct window *w = decode_window (window);
265:
266: return Fcons (w->left, Fcons (w->top,
267: Fcons (make_number (XFASTINT (w->left) + XFASTINT (w->width)),
268: Fcons (make_number (XFASTINT (w->top)
269: + XFASTINT (w->height)),
270: Qnil))));
271: }
272:
273: DEFUN ("window-point", Fwindow_point, Swindow_point, 0, 1, 0,
274: "Return current value of point in WINDOW.\n\
275: For a nonselected window, this is the value point would have\n\
276: if that window were selected.\n\
277: \n\
278: Note that, when WINDOW is the selected window and its buffer\n\
279: is also currently selected, the value returned is the same as (point).\n\
280: It would be more strictly correct to return the `top-level' value\n\
281: of point, outside of any save-excursion forms.\n\
282: But that is hard to define.")
283: (window)
284: Lisp_Object window;
285: {
286: register struct window *w = decode_window (window);
287:
288: if (w == XWINDOW (selected_window)
289: && bf_cur == XBUFFER (w->buffer))
290: return Fpoint ();
291: return Fmarker_position (w->pointm);
292: }
293:
294: DEFUN ("window-start", Fwindow_start, Swindow_start, 0, 1, 0,
295: "Return position at which display currently starts in WINDOW.")
296: (window)
297: Lisp_Object window;
298: {
299: return Fmarker_position (decode_window (window)->start);
300: }
301:
302: DEFUN ("set-window-point", Fset_window_point, Sset_window_point, 2, 2, 0,
303: "Make point value in WINDOW be at position POS in WINDOW's buffer.")
304: (window, pos)
305: Lisp_Object window, pos;
306: {
307: register struct window *w = decode_window (window);
308:
309: CHECK_NUMBER_COERCE_MARKER (pos, 1);
310: if (w == XWINDOW (selected_window))
311: Fgoto_char (pos);
312: else
313: Fset_marker (w->pointm, pos, w->buffer);
314: return pos;
315: }
316:
317: DEFUN ("set-window-start", Fset_window_start, Sset_window_start, 2, 3, 0,
318: "Make display in WINDOW start at position POS in WINDOW's buffer.\n\
319: Optional third arg NOFORCE non-nil inhibits next redisplay\n\
320: from overriding motion of point in order to display at this exact start.")
321: (window, pos, noforce)
322: Lisp_Object window, pos, noforce;
323: {
324: register struct window *w = decode_window (window);
325:
326: CHECK_NUMBER_COERCE_MARKER (pos, 1);
327: Fset_marker (w->start, pos, w->buffer);
328: /* this is not right, but much easier than doing what is right. */
329: w->start_at_line_beg = Qnil;
330: if (NULL (noforce))
331: w->force_start = Qt;
332: w->redo_mode_line = Qt;
333: XFASTINT (w->last_modified) = 0;
334: return pos;
335: }
336:
337: DEFUN ("delete-window", Fdelete_window, Sdelete_window, 0, 1, "",
338: "Remove WINDOW from the display. Default is selected window.")
339: (window)
340: register Lisp_Object window;
341: {
342: int osize;
343: register Lisp_Object tem, parent;
344: register struct window *p;
345: register struct window *par;
346:
347: if (NULL (window))
348: window = selected_window;
349: else
350: CHECK_WINDOW (window, 0);
351:
352: p = XWINDOW (window);
353: parent = p->parent;
354: if (NULL (parent))
355: error ("Attempt to delete minibuffer or sole ordinary window");
356: par=XWINDOW (parent);
357:
358: windows_or_buffers_changed++;
359:
360: if (EQ (window, selected_window))
361: Fselect_window (Fnext_window (window, Qnil));
362:
363: tem = p->buffer;
364: /* tem is null for dummy parent windows
365: (which have inferiors but not any contents themselves) */
366: if (!NULL (tem))
367: {
368: unshow_buffer (p);
369: unchain_marker (p->pointm);
370: unchain_marker (p->start);
371: }
372:
373: tem = p->next;
374: if (!NULL (tem))
375: XWINDOW (tem)->prev = p->prev;
376:
377: tem = p->prev;
378: if (!NULL (tem))
379: XWINDOW (tem)->next = p->next;
380:
381: if (EQ (window, par->hchild))
382: par->hchild = p->next;
383: if (EQ (window, par->vchild))
384: par->vchild = p->next;
385:
386: /* Stretch the siblings to use all the available space */
387: if (!NULL (par->vchild))
388: {
389: /* It's a vertical combination */
390: osize = XFASTINT (par->height);
391: XFASTINT (par->height)
392: -= XFASTINT (p->height);
393: set_window_height (parent, osize, 1);
394: }
395: if (!NULL (par->hchild))
396: {
397: /* It's a horizontal combination */
398: osize = XFASTINT (par->width);
399: XFASTINT (par->width)
400: -= XFASTINT (p->width);
401: set_window_width (parent, osize, 1);
402: }
403:
404: /* If parent now has only one child,
405: put the child into the parent's place. */
406:
407: tem = par->hchild;
408: if (NULL (tem))
409: tem = par->vchild;
410: if (NULL (XWINDOW (tem)->next))
411: replace_window (parent, tem);
412: return Qnil;
413: }
414:
415: /* Put replacement into the window structure in place of old. */
416: static
417: replace_window (old, replacement)
418: Lisp_Object old, replacement;
419: {
420: register Lisp_Object tem;
421: register struct window *o = XWINDOW (old), *p = XWINDOW (replacement);
422:
423: p->left = o->left;
424: p->top = o->top;
425: p->width = o->width;
426: p->height = o->height;
427:
428: p->next = tem = o->next;
429: if (!NULL (tem))
430: XWINDOW (tem)->prev = replacement;
431:
432: p->prev = tem = o->prev;
433: if (!NULL (tem))
434: XWINDOW (tem)->next = replacement;
435:
436: p->parent = tem = o->parent;
437: if (!NULL (tem))
438: {
439: if (EQ (XWINDOW (tem)->vchild, old))
440: XWINDOW (tem)->vchild = replacement;
441: if (EQ (XWINDOW (tem)->hchild, old))
442: XWINDOW (tem)->hchild = replacement;
443: }
444:
445: /*** Here, if replacement is a vertical combination
446: and so is its new parent, we should make replacement's
447: children be children of that parent instead. ***/
448: }
449:
450: DEFUN ("next-window", Fnext_window, Snext_window, 0, 2, 0,
451: "Return next window after WINDOW in canonical ordering of windows.\n\
452: Optional second arg MINIBUF t means count the minibuffer window\n\
453: even if not active. If MINIBUF is neither t nor nil it means\n\
454: not to count the minibuffer even if it is active.")
455: (window, mini)
456: register Lisp_Object window, mini;
457: {
458: register Lisp_Object tem;
459: if (NULL (window))
460: window = selected_window;
461: else
462: CHECK_WINDOW (window, 0);
463: do
464: {
465: while (tem = XWINDOW (window)->next, NULL (tem))
466: if (tem = XWINDOW (window)->parent, !NULL (tem))
467: window = tem;
468: else /* window must be minibuf_window now */
469: {
470: tem = XWINDOW (window)->prev;
471: break;
472: }
473: window = tem;
474: while (1)
475: {
476: if (!NULL (XWINDOW (window)->hchild))
477: window = XWINDOW (window)->hchild;
478: else if (!NULL (XWINDOW (window)->vchild))
479: window = XWINDOW (window)->vchild;
480: else break;
481: }
482: }
483: while (EQ (window, minibuf_window) && !EQ (mini, Qt)
484: && (!NULL (mini) || !MinibufDepth));
485: return window;
486: }
487:
488: DEFUN ("previous-window", Fprevious_window, Sprevious_window, 0, 1, 0,
489: "Return previous window before WINDOW in canonical ordering of windows.")
490: (window)
491: register Lisp_Object window;
492: {
493: register Lisp_Object tem;
494: if (NULL (window))
495: window = selected_window;
496: else
497: CHECK_WINDOW (window, 0);
498: do /* at least once, and until not the minibuffer */
499: {
500: while (tem = XWINDOW (window)->prev, NULL (tem))
501: if (tem = XWINDOW (window)->parent, !NULL (tem))
502: window = tem;
503: else /* window must be the root window now */
504: {
505: tem = minibuf_window;
506: break;
507: }
508: window = tem;
509: while (1)
510: {
511: if (!NULL (XWINDOW (window)->hchild))
512: window = XWINDOW (window)->hchild;
513: else if (!NULL (XWINDOW (window)->vchild))
514: window = XWINDOW (window)->vchild;
515: else break;
516: while (tem = XWINDOW (window)->next, !NULL (tem))
517: window = tem;
518: }
519: }
520: while (EQ (window, minibuf_window) && !MinibufDepth);
521: return window;
522: }
523:
524: DEFUN ("other-window", Fother_window, Sother_window, 1, 1, "p",
525: "Select the ARG'th different window.")
526: (n)
527: register Lisp_Object n;
528: {
529: register int i;
530: register Lisp_Object w;
531:
532: CHECK_NUMBER (n, 0);
533: w = selected_window;
534: i = XINT (n);
535:
536: while (i > 0)
537: {
538: w = Fnext_window (w, Qnil);
539: i--;
540: }
541: while (i < 0)
542: {
543: w = Fprevious_window (w);
544: i++;
545: }
546: Fselect_window (w);
547: return Qnil;
548: }
549:
550: static Lisp_Object
551: window_loop (type, obj)
552: int type;
553: register Lisp_Object obj;
554: {
555: register Lisp_Object w, tem, ret_w;
556: Lisp_Object w1, start_w;
557: register struct window *p, *q;
558:
559: w = minibuf_window;
560: ret_w = Qnil;
561: while (1)
562: {
563: p = XWINDOW (w);
564: w1 = Fnext_window (w, Qt);
565: if (!EQ (w, minibuf_window))
566: switch (type)
567: {
568: case 1:
569: if (XBUFFER (p->buffer) == XBUFFER (obj))
570: return w;
571: break;
572:
573: case 2:
574: /* t as arg means consider only full-width windows */
575: if (!NULL (obj) && XFASTINT (p->width) != screen_width)
576: break;
577: if (NULL (ret_w) ||
578: XFASTINT (XWINDOW (ret_w)->use_time) > XFASTINT (p->use_time))
579: ret_w = w;
580: break;
581:
582: case 3:
583: if (p != XWINDOW (obj))
584: Fdelete_window (w);
585: break;
586:
587: case 4:
588: if (EQ (p->buffer, obj))
589: {
590: if (NULL (p->parent))
591: {
592: tem = Fother_buffer (obj);
593: if (NULL (tem))
594: tem = Fget_buffer_create (build_string ("*scratch*"));
595: Fset_window_buffer (w, tem);
596: Fset_buffer (p->buffer);
597: }
598: else
599: Fdelete_window (w);
600: }
601: break;
602:
603: case 5:
604: q = XWINDOW (ret_w);
605: if (NULL (ret_w) ||
606: (XFASTINT (p->height) * XFASTINT (p->width))
607: >
608: (XFASTINT (q->height) * XFASTINT (q->width)))
609: ret_w = w;
610: break;
611:
612: case 6:
613: if (EQ (p->buffer, obj))
614: {
615: tem = Fother_buffer (obj);
616: if (NULL (tem))
617: tem = Fget_buffer_create (build_string ("*scratch*"));
618: Fset_window_buffer (w, tem);
619: Fset_buffer (p->buffer);
620: }
621: break;
622: }
623: w = w1;
624: if (EQ (w, minibuf_window))
625: return ret_w;
626: }
627: }
628:
629: DEFUN ("get-lru-window", Fget_lru_window, Sget_lru_window, 0, 0, 0,
630: "Return the window least recently selected or used for display.")
631: ()
632: {
633: register Lisp_Object w;
634: /* First try for a window that is full-width */
635: w = window_loop (2, Qt);
636: if (!NULL (w) && !EQ (w, selected_window))
637: return w;
638: /* If none of them, try the rest */
639: return window_loop (2, Qnil);
640: }
641:
642: DEFUN ("get-largest-window", Fget_largest_window, Sget_largest_window, 0, 0, 0,
643: "Return the largest window in area.")
644: ()
645: {
646: return window_loop (5, Qnil);
647: }
648:
649: DEFUN ("get-buffer-window", Fget_buffer_window, Sget_buffer_window, 1, 1, 0,
650: "Return a window currently displaying BUFFER, or nil if none.")
651: (buffer)
652: Lisp_Object buffer;
653: {
654: buffer = Fget_buffer (buffer);
655: if (XTYPE (buffer) == Lisp_Buffer)
656: return window_loop (1, buffer);
657: else return Qnil;
658: }
659:
660: DEFUN ("delete-other-windows", Fdelete_other_windows, Sdelete_other_windows,
661: 0, 1, "",
662: "Make WINDOW (or the selected window) fill the screen.")
663: (w)
664: Lisp_Object w;
665: {
666: window_loop (3, !NULL (w) ? w : selected_window);
667: return Qnil;
668: }
669:
670: DEFUN ("delete-windows-on", Fdelete_windows_on, Sdelete_windows_on,
671: 1, 1, "bDelete windows on (buffer): ",
672: "Delete all windows showing BUFFER.")
673: (buffer)
674: Lisp_Object buffer;
675: {
676: if (!NULL (buffer))
677: {
678: buffer = Fget_buffer (buffer);
679: CHECK_BUFFER (buffer, 0);
680: window_loop (4, buffer);
681: }
682: return Qnil;
683: }
684:
685: DEFUN ("replace-buffer-in-windows", Freplace_buffer_in_windows,
686: Sreplace_buffer_in_windows,
687: 1, 1, "bReplace buffer in windows: ",
688: "Replace BUFFER with some other buffer in all windows showing it.")
689: (buffer)
690: Lisp_Object buffer;
691: {
692: if (!NULL (buffer))
693: {
694: buffer = Fget_buffer (buffer);
695: CHECK_BUFFER (buffer, 0);
696: window_loop (6, buffer);
697: }
698: return Qnil;
699: }
700:
701: /* Set the height of WINDOW and all its inferiors. */
702: /* Normally the window is deleted if it gets too small.
703: nodelete nonzero means do not do this.
704: (The caller should check later and do so if appropriate) */
705:
706: set_window_height (window, height, nodelete)
707: Lisp_Object window;
708: int height;
709: int nodelete;
710: {
711: register struct window *w = XWINDOW (window);
712: register struct window *c;
713: int oheight = XFASTINT (w->height);
714: int top, pos, lastbot, opos, lastobot;
715: Lisp_Object child;
716:
717: if (window_min_height < 2)
718: window_min_height = 2;
719:
720: if (!nodelete &&
721: height < (EQ(window, minibuf_window) ? 1 : window_min_height))
722: {
723: Fdelete_window (window);
724: return;
725: }
726:
727: XFASTINT (w->last_modified) = 0;
728: windows_or_buffers_changed++;
729: XFASTINT (w->height) = height;
730: if (!NULL (w->hchild))
731: {
732: for (child = w->hchild; !NULL (child); child = XWINDOW (child)->next)
733: {
734: XWINDOW (child)->top = w->top;
735: set_window_height (child, height, nodelete);
736: }
737: }
738: else if (!NULL (w->vchild))
739: {
740: lastbot = top = XFASTINT (w->top);
741: lastobot = 0;
742: for (child = w->vchild; !NULL (child); child = c->next)
743: {
744: c = XWINDOW (child);
745:
746: opos = lastobot + XFASTINT (c->height);
747:
748: XFASTINT (c->top) = lastbot;
749:
750: pos = (((opos * height) << 1) + oheight) / (oheight << 1);
751:
752: /* Avoid confusion: inhibit deletion of child if becomes too small */
753: set_window_height (child, pos + top - lastbot, 1);
754:
755: /* Now advance child to next window,
756: and set lastbot if child was not just deleted. */
757: lastbot = pos + top, lastobot = opos;
758: }
759: /* Now delete any children that became too small. */
760: if (!nodelete)
761: for (child = w->vchild; !NULL (child); child = XWINDOW (child)->next)
762: {
763: set_window_height (child, XINT (XWINDOW (child)->height), 0);
764: }
765: }
766: }
767:
768: /* Recursively set width of WINDOW and its inferiors. */
769:
770: set_window_width (window, width, nodelete)
771: Lisp_Object window;
772: int width;
773: int nodelete;
774: {
775: register struct window *w = XWINDOW (window);
776: register struct window *c;
777: int owidth = XFASTINT (w->width);
778: int left, pos, lastright, opos, lastoright;
779: Lisp_Object child;
780:
781: if (!nodelete && width < window_min_width)
782: {
783: Fdelete_window (window);
784: return;
785: }
786:
787: XFASTINT (w->last_modified) = 0;
788: windows_or_buffers_changed++;
789: XFASTINT (w->width) = width;
790: if (!NULL (w->vchild))
791: {
792: for (child = w->vchild; !NULL (child); child = XWINDOW (child)->next)
793: {
794: XWINDOW (child)->left = w->left;
795: set_window_width (child, width, nodelete);
796: }
797: }
798: else if (!NULL (w->hchild))
799: {
800: lastright = left = XFASTINT (w->left);
801: lastoright = 0;
802: for (child = w->hchild; !NULL (child); child = c->next)
803: {
804: c = XWINDOW (child);
805:
806: opos = lastoright + XFASTINT (c->width);
807:
808: XFASTINT (c->left) = lastright;
809:
810: pos = (((opos * width) << 1) + owidth) / (owidth << 1);
811:
812: /* Inhibit deletion for becoming too small */
813: set_window_width (child, pos + left - lastright, 1);
814:
815: /* Now advance child to next window,
816: and set lastright if child was not just deleted. */
817: lastright = pos + left, lastoright = opos;
818: }
819: /* Delete children that became too small */
820: if (!nodelete)
821: for (child = w->hchild; !NULL (child); child = XWINDOW (child)->next)
822: {
823: set_window_width (child, XINT (XWINDOW (child)->width), 0);
824: }
825: }
826: }
827:
828: static int window_select_count;
829:
830: DEFUN ("set-window-buffer", Fset_window_buffer, Sset_window_buffer, 2, 2, 0,
831: "Make WINDOW display BUFFER as its contents.\n\
832: BUFFER can be a buffer or buffer name.")
833: (window, buffer)
834: register Lisp_Object window, buffer;
835: {
836: register Lisp_Object tem;
837: register struct window *w = decode_window (window);
838:
839: buffer = Fget_buffer (buffer);
840: CHECK_BUFFER (buffer, 1);
841:
842: if (NULL (XBUFFER (buffer)->name))
843: error ("Attempt to display deleted buffer");
844:
845: tem = w->buffer;
846: if (!NULL (tem))
847: unshow_buffer (w);
848:
849: w->buffer = buffer;
850: Fset_marker (w->pointm,
851: make_number (XBUFFER (buffer) == bf_cur
852: ? point : XBUFFER (buffer)->text.pointloc),
853: buffer);
854: Fset_marker (w->start, make_number (XBUFFER (buffer)->last_window_start),
855: buffer);
856: w->start_at_line_beg = Qnil;
857: XFASTINT (w->last_modified) = 0;
858: windows_or_buffers_changed++;
859: if (EQ (window, selected_window))
860: Fset_buffer (buffer);
861:
862: return Qnil;
863: }
864:
865: /* Record info on buffer window w is displaying
866: when it is about to cease to display that buffer. */
867: static
868: unshow_buffer (w)
869: register struct window *w;
870: {
871: register Lisp_Object buf;
872: buf = w->buffer;
873:
874: if (XBUFFER (buf) != XMARKER (w->pointm)->buffer)
875: abort ();
876:
877: if (w != XWINDOW (selected_window)
878: && EQ (buf, XWINDOW (selected_window)->buffer))
879: return;
880:
881: if (XBUFFER (buf) == bf_cur)
882: {
883: if (w != XWINDOW (selected_window))
884: point = marker_position (w->pointm);
885: }
886: else
887: XBUFFER (buf)->text.pointloc =
888: marker_position (w->pointm);
889: XBUFFER (buf)->last_window_start =
890: marker_position (w->start);
891: }
892:
893: DEFUN ("select-window", Fselect_window, Sselect_window, 1, 1, 0,
894: "Select WINDOW. Most editing will apply to WINDOW's buffer.\n\
895: The main editor command loop selects the buffer of the selected window\n\
896: before each command.")
897: (window)
898: register Lisp_Object window;
899: {
900: register struct window *w;
901: register struct window *ow = XWINDOW (selected_window);
902:
903: CHECK_WINDOW (window, 0);
904:
905: w = XWINDOW (window);
906:
907: if (NULL (w->buffer))
908: error ("Trying to select window with no buffer");
909:
910: XFASTINT (w->use_time) = ++window_select_count;
911: if (EQ (window, selected_window))
912: return window;
913:
914: if (bf_cur == XBUFFER (ow->buffer))
915: Fset_marker (ow->pointm, make_number (point), ow->buffer);
916:
917: selected_window = window;
918:
919: record_buffer (w->buffer);
920: Fset_buffer (w->buffer);
921: if (bf_cur == XBUFFER (ow->buffer))
922: {
923: /* If the new and old windows show the same buffer,
924: Fset_buffer did nothing. So we must switch to
925: the new buffer's value of point. */
926: SetPoint (marker_position (w->pointm));
927: if (point < FirstCharacter)
928: point = FirstCharacter;
929: if (point > NumCharacters + 1)
930: point = NumCharacters + 1;
931: }
932:
933: windows_or_buffers_changed++;
934:
935: return window;
936: }
937:
938: DEFUN ("display-buffer", Fdisplay_buffer, Sdisplay_buffer, 1, 2, 0,
939: "Make BUFFER appear in some window but don't select it.\n\
940: BUFFER can be a buffer or a buffer name.\n\
941: If BUFFER is shown already in some window, just uses that one,\n\
942: unless the window is the selected window and NOTTHISWINDOW is non-nil.\n\
943: Returns the window displaying BUFFER.")
944: (buffer, notthiswindow)
945: register Lisp_Object buffer, notthiswindow;
946: {
947: register Lisp_Object window;
948:
949: buffer = Fget_buffer (buffer);
950: CHECK_BUFFER (buffer, 0);
951:
952: if (NULL (notthiswindow)
953: && XBUFFER (XWINDOW (selected_window)->buffer) == XBUFFER (buffer))
954: return selected_window;
955:
956: window = Fget_buffer_window (buffer);
957: if (!NULL (window)
958: && (NULL (notthiswindow) || !EQ (window, selected_window)))
959: return window;
960:
961: if (pop_up_windows)
962: {
963: /* Don't try to create a window if would get an error */
964: if (window_min_height < 2)
965: window_min_height = 2;
966: if (split_height_threshold < window_min_height << 1)
967: split_height_threshold = window_min_height << 1;
968:
969: window = Fget_largest_window ();
970: if (window_height (window) >= split_height_threshold
971: &&
972: XFASTINT (XWINDOW (window)->width) == screen_width)
973: window = Fsplit_window (window, Qnil, Qnil);
974: else
975: {
976: window = Fget_lru_window ();
977: if ((EQ (window, selected_window)
978: || (EQ (selected_window, minibuf_window)
979: && EQ (window, XWINDOW (minibuf_window)->prev)))
980: && window_height (window) >= window_min_height << 1)
981: window = Fsplit_window (window, Qnil, Qnil);
982: }
983: }
984: else
985: window = Fget_lru_window ();
986:
987: Fset_window_buffer (window, buffer);
988: return window;
989: }
990:
991: temp_output_buffer_show (buf)
992: register Lisp_Object buf;
993: {
994: register struct buffer *old = bf_cur;
995: register Lisp_Object window;
996: register struct window *w;
997:
998: Fset_buffer (buf);
999: XBUFFER (buf)->save_modified = bf_modified;
1000: SetPoint (1);
1001: bf_head_clip = 1;
1002: bf_tail_clip = 0;
1003: clip_changed = 1;
1004: SetBfp (old);
1005:
1006: if (!EQ (Vtemp_buffer_show_hook, Qnil))
1007: call1 (Vtemp_buffer_show_hook, buf);
1008: else
1009: {
1010: window = Fdisplay_buffer (buf, Qnil);
1011: Vminibuf_scroll_window = window;
1012: w = XWINDOW (window);
1013: XFASTINT (w->hscroll) = 0;
1014: Fset_marker (w->start, make_number (1), buf);
1015: Fset_marker (w->pointm, make_number (1), buf);
1016: }
1017: }
1018:
1019: static
1020: make_dummy_parent (window)
1021: Lisp_Object window;
1022: {
1023: register Lisp_Object old, new;
1024: register struct window *o, *p;
1025:
1026: old = window;
1027: XSETTYPE (old, Lisp_Vector);
1028: new = Fcopy_sequence (old);
1029: XSETTYPE (new, Lisp_Window);
1030:
1031: o = XWINDOW (old);
1032: p = XWINDOW (new);
1033: XFASTINT (p->sequence_number) = ++sequence_number;
1034:
1035: /* Put new into window structure in place of window */
1036: replace_window (window, new);
1037:
1038: o->next = Qnil;
1039: o->prev = Qnil;
1040: o->vchild = Qnil;
1041: o->hchild = Qnil;
1042: o->parent = new;
1043:
1044: p->start = Qnil;
1045: p->pointm = Qnil;
1046: p->buffer = Qnil;
1047: }
1048:
1049: DEFUN ("split-window", Fsplit_window, Ssplit_window, 0, 3, "",
1050: "Split WINDOW, putting SIZE lines in the first of the pair.\n\
1051: WINDOW defaults to selected one and SIZE to half its size.\n\
1052: If optional third arg HOR-FLAG is non-nil, split side by side\n\
1053: and put SIZE columns in the first of the pair.")
1054: (window, chsize, horflag)
1055: Lisp_Object window, chsize, horflag;
1056: {
1057: register Lisp_Object new;
1058: register struct window *o, *p;
1059: register int size;
1060:
1061: if (NULL (window))
1062: window = selected_window;
1063: else
1064: CHECK_WINDOW (window, 0);
1065:
1066: o = XWINDOW (window);
1067:
1068: if (NULL (chsize))
1069: {
1070: if (!NULL (horflag))
1071: size = XFASTINT (o->width) >> 1;
1072: else
1073: size = XFASTINT (o->height) >> 1;
1074: }
1075: else
1076: {
1077: CHECK_NUMBER (chsize, 1);
1078: size = XINT (chsize);
1079: }
1080:
1081: if (EQ (window, minibuf_window))
1082: error ("Attempt to split minibuffer window");
1083:
1084: if (NULL (horflag))
1085: {
1086: if (window_min_height < 2)
1087: window_min_height = 2;
1088:
1089: if (size < window_min_height ||
1090: size + window_min_height > XFASTINT (o->height))
1091: args_out_of_range_3 (window, chsize, horflag);
1092: if (NULL (o->parent) ||
1093: NULL (XWINDOW (o->parent)->vchild))
1094: {
1095: make_dummy_parent (window);
1096: new = o->parent;
1097: XWINDOW (new)->vchild = window;
1098: }
1099: }
1100: else
1101: {
1102: if (size < window_min_width ||
1103: size + window_min_width > XFASTINT (o->width))
1104: args_out_of_range_3 (window, chsize, horflag);
1105: if (NULL (o->parent) ||
1106: NULL (XWINDOW (o->parent)->hchild))
1107: {
1108: make_dummy_parent (window);
1109: new = o->parent;
1110: XWINDOW (new)->hchild = window;
1111: }
1112: }
1113:
1114: /* Now we know that window's parent is a vertical combination
1115: if we are dividing vertically, or a horizontal combination
1116: if we are making side-by-side windows */
1117:
1118: windows_or_buffers_changed++;
1119: new = make_window ();
1120: p = XWINDOW (new);
1121:
1122: p->next = o->next;
1123: if (!NULL (p->next))
1124: XWINDOW (p->next)->prev = new;
1125: p->prev = window;
1126: o->next = new;
1127: p->parent = o->parent;
1128:
1129: Fset_window_buffer (new, o->buffer);
1130:
1131: /* Apportion the available screen space among the two new windows */
1132:
1133: if (!NULL (horflag))
1134: {
1135: p->height = o->height;
1136: p->top = o->top;
1137: XFASTINT (p->width) = XFASTINT (o->width) - size;
1138: XFASTINT (o->width) = size;
1139: XFASTINT (p->left) = XFASTINT (o->left) + size;
1140: }
1141: else
1142: {
1143: p->left = o->left;
1144: p->width = o->width;
1145: XFASTINT (p->height) = XFASTINT (o->height) - size;
1146: XFASTINT (o->height) = size;
1147: XFASTINT (p->top) = XFASTINT (o->top) + size;
1148: }
1149:
1150: return new;
1151: }
1152:
1153: DEFUN ("enlarge-window", Fenlarge_window, Senlarge_window, 1, 2, "p",
1154: "Make current window ARG lines bigger.\n\
1155: From program, optional second arg non-nil means grow sideways ARG columns.")
1156: (n, side)
1157: register Lisp_Object n, side;
1158: {
1159: CHECK_NUMBER (n, 0);
1160: change_window_height (XINT (n), !NULL (side));
1161: return Qnil;
1162: }
1163:
1164: DEFUN ("shrink-window", Fshrink_window, Sshrink_window, 1, 2, "p",
1165: "Make current window ARG lines smaller.\n\
1166: From program, optional second arg non-nil means shrink sideways ARG columns.")
1167: (n, side)
1168: register Lisp_Object n, side;
1169: {
1170: CHECK_NUMBER (n, 0);
1171: change_window_height (-XINT (n), !NULL (side));
1172: return Qnil;
1173: }
1174:
1175: int
1176: window_height (window)
1177: Lisp_Object window;
1178: {
1179: register struct window *p = XWINDOW (window);
1180: return XFASTINT (p->height);
1181: }
1182:
1183: int
1184: window_width (window)
1185: Lisp_Object window;
1186: {
1187: register struct window *p = XWINDOW (window);
1188: return XFASTINT (p->width);
1189: }
1190:
1191: #define MINSIZE(window) \
1192: (widthflag ? window_min_width \
1193: : (EQ (window, minibuf_window) ? 1 : window_min_height))
1194:
1195: #define CURBEG(w) \
1196: *(widthflag ? (int *) &w->left : (int *) &w->top)
1197:
1198: #define CURSIZE(w) \
1199: *(widthflag ? (int *) &w->width : (int *) &w->height)
1200:
1201: /* Unlike set_window_height, this function
1202: also changes the heights of the siblings so as to
1203: keep everything consistent. */
1204:
1205: change_window_height (delta, widthflag)
1206: register int delta;
1207: int widthflag;
1208: {
1209: register Lisp_Object parent;
1210: Lisp_Object window;
1211: register struct window *p;
1212: int *sizep;
1213: int (*sizefun) () = widthflag ? window_width : window_height;
1214: register int (*setsizefun) () = widthflag ? set_window_width : set_window_height;
1215:
1216: if (window_min_height < 2)
1217: window_min_height = 2;
1218:
1219: window = selected_window;
1220: while (1)
1221: {
1222: p = XWINDOW (window);
1223: parent = p->parent;
1224: if (NULL (parent))
1225: {
1226: if (widthflag)
1227: error ("No other window to side of this one");
1228: break;
1229: }
1230: if (widthflag ? !NULL (XWINDOW (parent)->hchild)
1231: : !NULL (XWINDOW (parent)->vchild))
1232: break;
1233: window = parent;
1234: }
1235:
1236: sizep = &CURSIZE (p);
1237:
1238: if (*sizep + delta < MINSIZE (window))
1239: {
1240: Fdelete_window (window);
1241: return;
1242: }
1243:
1244: {
1245: register int maxdelta;
1246: register Lisp_Object tem;
1247:
1248: maxdelta = (!NULL (parent) ? (*sizefun) (parent) - *sizep
1249: : (tem = (!NULL (p->next) ? p->next : p->prev),
1250: (*sizefun) (tem) - MINSIZE (tem)));
1251:
1252: if (delta > maxdelta)
1253: /* This case traps trying to make the minibuffer
1254: the full screen, or make the only window aside from the
1255: minibuffer the full screen. */
1256: delta = maxdelta;
1257: }
1258:
1259: if (!NULL (p->next) &&
1260: (*sizefun) (p->next) - delta >= MINSIZE (p->next))
1261: {
1262: (*setsizefun) (p->next, (*sizefun) (p->next) - delta, 0);
1263: (*setsizefun) (window, *sizep + delta, 0);
1264: CURBEG (XWINDOW (p->next)) += delta;
1265: /* This does not change size of p->next,
1266: but it propagates the new top edge to its children */
1267: (*setsizefun) (p->next, (*sizefun) (p->next), 0);
1268: }
1269: else if (!NULL (p->prev) &&
1270: (*sizefun) (p->prev) - delta >= MINSIZE (p->prev))
1271: {
1272: (*setsizefun) (p->prev, (*sizefun) (p->prev) - delta, 0);
1273: CURBEG (p) -= delta;
1274: (*setsizefun) (window, *sizep + delta, 0);
1275: }
1276: else
1277: {
1278: register int delta1;
1279: register int opht = (*sizefun) (parent);
1280:
1281: /* If trying to grow this window to or beyond size of the parent,
1282: make delta1 so big that, on shrinking back down,
1283: all the siblings end up with less than one line and are deleted. */
1284: if (opht <= *sizep + delta)
1285: delta1 = opht * opht * 2;
1286: /* Otherwise, make delta1 just right so that if we add delta1
1287: lines to this window and to the parent, and then shrink
1288: the parent back to its original size, the new proportional
1289: size of this window will increase by delta. */
1290: else
1291: delta1 = (delta * opht * 100) / ((opht - *sizep - delta) * 100);
1292:
1293: /* Add delta1 lines or columns to this window, and to the parent,
1294: keeping things consistent while not affecting siblings. */
1295: CURSIZE (XWINDOW (parent)) = opht + delta1;
1296: (*setsizefun) (window, *sizep + delta1, 0);
1297:
1298: /* Squeeze out delta1 lines or columns from our parent,
1299: shriking this window and siblings proportionately.
1300: This brings parent back to correct size.
1301: Delta1 was calculated so this makes this window the desired size,
1302: taking it all out of the siblings. */
1303: (*setsizefun) (parent, opht, 0);
1304: }
1305:
1306: XFASTINT (p->last_modified) = 0;
1307: }
1308: #undef MINSIZE
1309: #undef CURBEG
1310: #undef CURSIZE
1311:
1312:
1313: static
1314: window_scroll (window, n)
1315: Lisp_Object window;
1316: int n;
1317: {
1318: register struct window *w = XWINDOW (window);
1319: register int opoint = point;
1320: register int ht, pos;
1321: register Lisp_Object tem;
1322: int lose;
1323: Lisp_Object bolp;
1324:
1325: ht = XFASTINT (w->height) - !EQ (window, minibuf_window);
1326:
1327: XFASTINT (tem) = point;
1328: tem = Fpos_visible_in_window_p (tem, window);
1329:
1330: if (NULL (tem))
1331: {
1332: Fvertical_motion (make_number (- ht / 2));
1333: XFASTINT (tem) = point;
1334: Fset_marker (w->start, tem, w->buffer);
1335: w->force_start = Qt;
1336: }
1337:
1338: SetPoint (marker_position (w->start));
1339: lose = n < 0 && point == FirstCharacter;
1340: Fvertical_motion (make_number (n));
1341: pos = point;
1342: bolp = Fbolp ();
1343: SetPoint (opoint);
1344:
1345: if (lose)
1346: Fsignal (Qbeginning_of_buffer, Qnil);
1347:
1348: if (pos < NumCharacters + 1)
1349: {
1350: Fset_marker (w->start, make_number (pos), w->buffer);
1351: w->start_at_line_beg = bolp;
1352: w->redo_mode_line = Qt;
1353: XFASTINT (w->last_modified) = 0;
1354: if (pos > opoint)
1355: SetPoint (pos);
1356: if (n < 0)
1357: {
1358: SetPoint (pos);
1359: tem = Fvertical_motion (make_number (ht));
1360: if (point > opoint || XFASTINT (tem) < ht)
1361: SetPoint (opoint);
1362: else
1363: Fvertical_motion (make_number (-1));
1364: }
1365: }
1366: else
1367: Fsignal (Qend_of_buffer, Qnil);
1368: }
1369:
1370: scroll_command (n, direction)
1371: register Lisp_Object n;
1372: int direction;
1373: {
1374: register int defalt
1375: = direction * (window_height (selected_window) - 1
1376: - next_screen_context_lines);
1377:
1378: if (NULL (n))
1379: window_scroll (selected_window, defalt);
1380: else if (EQ (n, Qminus))
1381: window_scroll (selected_window, - defalt);
1382: else
1383: {
1384: n = Fprefix_numeric_value (n);
1385: window_scroll (selected_window, XINT (n) * direction);
1386: }
1387: }
1388:
1389: DEFUN ("scroll-up", Fscroll_up, Sscroll_up, 0, 1, "P",
1390: "Scroll text of current window upward ARG lines; or near full screen if no ARG.\n\
1391: When calling from a program, supply a number as argument or nil.")
1392: (n)
1393: Lisp_Object n;
1394: {
1395: scroll_command (n, 1);
1396: return Qnil;
1397: }
1398:
1399: DEFUN ("scroll-down", Fscroll_down, Sscroll_down, 0, 1, "P",
1400: "Scroll text of current window downward ARG lines; or near full screen if no ARG.\n\
1401: When calling from a program, supply a number as argument or nil.")
1402: (n)
1403: Lisp_Object n;
1404: {
1405: scroll_command (n, -1);
1406: return Qnil;
1407: }
1408:
1409: DEFUN ("scroll-left", Fscroll_left, Sscroll_left, 1, 1, "P",
1410: "Scroll selected window display ARG columns left.\n\
1411: Default for ARG is window width minus 2.")
1412: (arg)
1413: register Lisp_Object arg;
1414: {
1415: if (NULL (arg))
1416: XFASTINT (arg) = XFASTINT (XWINDOW (selected_window)->width) - 2;
1417: else
1418: arg = Fprefix_numeric_value (arg);
1419:
1420: return Fset_window_hscroll (selected_window,
1421: make_number (XINT (XWINDOW (selected_window)->hscroll)
1422: + XINT (arg)));
1423: }
1424:
1425: DEFUN ("scroll-right", Fscroll_right, Sscroll_right, 1, 1, "P",
1426: "Scroll selected window display ARG columns right.\n\
1427: Default for ARG is window width minus 2.")
1428: (arg)
1429: register Lisp_Object arg;
1430: {
1431: if (NULL (arg))
1432: XFASTINT (arg) = XFASTINT (XWINDOW (selected_window)->width) - 2;
1433: else
1434: arg = Fprefix_numeric_value (arg);
1435:
1436: return Fset_window_hscroll (selected_window,
1437: make_number (XINT (XWINDOW (selected_window)->hscroll)
1438: - XINT (arg)));
1439: }
1440:
1441: DEFUN ("scroll-other-window", Fscroll_other_window, Sscroll_other_window, 0, 1, "P",
1442: "Scroll text of next window upward ARG lines; or near full screen if no ARG.\n\
1443: The next window is the one below the current one; or the one at the top\n\
1444: if the current one is at the bottom.\n\
1445: When calling from a program, supply a number as argument or nil.")
1446: (n)
1447: register Lisp_Object n;
1448: {
1449: register Lisp_Object window;
1450: struct buffer *old = bf_cur;
1451: register int ht;
1452: register int opoint = point;
1453: register struct window *w;
1454:
1455: if (EQ (selected_window, minibuf_window)
1456: && !NULL (Vminibuf_scroll_window))
1457: window = Vminibuf_scroll_window;
1458: else
1459: window = Fnext_window (selected_window, Qnil);
1460: CHECK_WINDOW (window, 0);
1461: ht = window_height (window) - 1;
1462:
1463: if (EQ (window, selected_window))
1464: error ("There is no other window");
1465:
1466: w = XWINDOW (window);
1467: Fset_buffer (w->buffer);
1468: SetPoint (marker_position (w->pointm));
1469:
1470: if (NULL (n))
1471: window_scroll (window, ht - next_screen_context_lines);
1472: else if (EQ (n, Qminus))
1473: window_scroll (window, next_screen_context_lines - ht);
1474: else
1475: {
1476: if (XTYPE (n) == Lisp_Cons)
1477: n = Fcar (n);
1478: CHECK_NUMBER (n, 0);
1479: window_scroll (window, XINT (n));
1480: }
1481:
1482: Fset_marker (w->pointm, make_number (point), Qnil);
1483: SetBfp (old);
1484: SetPoint (opoint);
1485: return Qnil;
1486: }
1487:
1488: DEFUN ("recenter", Frecenter, Srecenter, 0, 1, "P",
1489: "Center point in window and redisplay screen. With ARG, put point on line ARG.\n\
1490: The desired position of point is always relative to the current window.\n\
1491: Just C-u as prefix means put point in the center of the screen.\n\
1492: No arg (i.e., it is nil) erases the entire screen and then\n\
1493: redraws with point in the center.")
1494: (n)
1495: register Lisp_Object n;
1496: {
1497: register int ht = window_height (selected_window)
1498: - !EQ (selected_window, minibuf_window);
1499: register struct window *w = XWINDOW (selected_window);
1500: register int opoint = point;
1501:
1502: if (NULL (n))
1503: {
1504: extern int screen_garbaged;
1505: screen_garbaged++;
1506: XFASTINT (n) = ht / 2;
1507: }
1508: else if (XTYPE (n) == Lisp_Cons) /* Just C-u. */
1509: {
1510: XFASTINT (n) = ht / 2;
1511: }
1512: else
1513: {
1514: n = Fprefix_numeric_value (n);
1515: CHECK_NUMBER (n, 0);
1516: }
1517:
1518: if (XINT (n) < 0)
1519: XSETINT (n, XINT (n) + ht);
1520:
1521: XSETINT (n, - XINT (n));
1522:
1523: Fvertical_motion (n);
1524: Fset_marker (w->start, make_number (point), w->buffer);
1525: w->start_at_line_beg = Fbolp ();
1526:
1527: SetPoint (opoint);
1528: w->force_start = Qt;
1529:
1530: return Qnil;
1531: }
1532:
1533: DEFUN ("move-to-window-line", Fmove_to_window_line, Smove_to_window_line,
1534: 1, 1, "P",
1535: "Position point relative to window.\n\
1536: With no argument, position at text at center of window.\n\
1537: An argument specifies screen line; zero means top of window,\n\
1538: negative means relative to bottom of window.")
1539: (arg)
1540: register Lisp_Object arg;
1541: {
1542: register struct window *w = XWINDOW (selected_window);
1543: register int height = XFASTINT (w->height);
1544: register int start;
1545:
1546: if (!EQ (selected_window, minibuf_window)) height--;
1547:
1548: if (NULL (arg))
1549: XFASTINT (arg) = height / 2;
1550: else
1551: {
1552: arg = Fprefix_numeric_value (arg);
1553: if (XINT (arg) < 0)
1554: XSETINT (arg, XINT (arg) + height);
1555: }
1556:
1557: start = marker_position (w->start);
1558: if (start < FirstCharacter || start > NumCharacters + 1)
1559: {
1560: Fvertical_motion (make_number (- height / 2));
1561: Fset_marker (w->start, make_number (point), w->buffer);
1562: w->start_at_line_beg = Fbolp ();
1563: w->force_start = Qt;
1564: }
1565: else
1566: SetPoint (start);
1567:
1568: return Fvertical_motion (arg);
1569: }
1570:
1571: struct save_window_data
1572: {
1573: int size_from_Lisp_Vector_struct;
1574: struct Lisp_Vector *next_from_Lisp_Vector_struct;
1575: Lisp_Object screen_width, screen_height;
1576: Lisp_Object current_window;
1577: Lisp_Object current_buffer;
1578: Lisp_Object minibuf_scroll_window;
1579: /* A vector, interpreted as a struct saved_window */
1580: Lisp_Object saved_windows;
1581: };
1582: #define SAVE_WINDOW_DATA_SIZE 6 /* Arg to Fmake_vector */
1583:
1584: /* This is saved as a Lisp_Vector */
1585: struct saved_window
1586: {
1587: /* these first two must agree with struct Lisp_Vector in lisp.h */
1588: int size_from_Lisp_Vector_struct;
1589: struct Lisp_Vector *next_from_Lisp_Vector_struct;
1590:
1591: Lisp_Object window;
1592: Lisp_Object buffer, start, pointm, mark;
1593: Lisp_Object left, top, width, height, hscroll;
1594: Lisp_Object parent, prev;
1595: Lisp_Object start_at_line_beg;
1596: };
1597: #define SAVED_WINDOW_VECTOR_SIZE 13 /* Arg to Fmake_vector */
1598:
1599: #define SAVED_WINDOW_N(swv,n) \
1600: ((struct saved_window *) (XVECTOR ((swv)->contents[(n)])))
1601:
1602: DEFUN ("set-window-configuration",
1603: Fset_window_configuration, Sset_window_configuration,
1604: 1, 1, 0,
1605: "Restore the configuration of Emacs' windows and buffers to\n\
1606: the state specified by CONFIGURATION. CONFIGURATION must be a value\n\
1607: retrned by current-window-configuration -- see the documentation of that\n\
1608: function for more information.")
1609: (arg)
1610: Lisp_Object arg;
1611: {
1612: register struct window *w;
1613: register struct save_window_data *data;
1614: struct Lisp_Vector *saved_windows;
1615: register struct saved_window *p;
1616: register Lisp_Object tem;
1617: Lisp_Object new_current_buffer;
1618: int k;
1619:
1620: /* Save screen height here so we can go back to it at the end. */
1621: int previous_screen_height = screen_height;
1622: int previous_screen_width = screen_width;
1623: int screen_size_change = 0;
1624:
1625: while (XTYPE (arg) != Lisp_Window_Configuration)
1626: {
1627: /* the function window-configuration-p isn't actually defined
1628: at present --- is there a need for it? */
1629: arg = wrong_type_argument (intern ("window-configuration-p"), arg);
1630: }
1631:
1632: data = (struct save_window_data *) XVECTOR (arg);
1633: saved_windows = XVECTOR (data->saved_windows);
1634:
1635: /* Set the screen height to the value it had at save time. */
1636: if (XFASTINT (data->screen_height) != screen_height
1637: || XFASTINT (data->screen_width) != screen_width)
1638: {
1639: change_screen_size (data->screen_height, data->screen_width, 0);
1640: screen_size_change = 1;
1641: }
1642:
1643: windows_or_buffers_changed++;
1644: new_current_buffer = data->current_buffer;
1645: if (NULL (XBUFFER (new_current_buffer)->name))
1646: new_current_buffer = Qnil;
1647:
1648: for (k = 0; k < saved_windows->size; k++)
1649: {
1650: p = SAVED_WINDOW_N (saved_windows, k);
1651: w = XWINDOW (p->window);
1652: w->next = Qnil;
1653:
1654: if (!NULL (p->parent))
1655: w->parent = SAVED_WINDOW_N (saved_windows, XFASTINT (p->parent))->window;
1656: else
1657: w->parent = Qnil;
1658:
1659: if (!NULL (p->prev))
1660: {
1661: w->prev = SAVED_WINDOW_N (saved_windows, XFASTINT (p->prev))->window;
1662: XWINDOW (w->prev)->next = p->window;
1663: }
1664: else
1665: {
1666: w->prev = Qnil;
1667: if (!NULL (w->parent))
1668: {
1669: if (EQ (p->width, XWINDOW (w->parent)->width))
1670: {
1671: XWINDOW (w->parent)->vchild = p->window;
1672: XWINDOW (w->parent)->hchild = Qnil;
1673: }
1674: else
1675: {
1676: XWINDOW (w->parent)->hchild = p->window;
1677: XWINDOW (w->parent)->vchild = Qnil;
1678: }
1679: }
1680: }
1681: w->left = p->left;
1682: w->top = p->top;
1683: w->width = p->width;
1684: w->height = p->height;
1685: w->hscroll = p->hscroll;
1686: XFASTINT (w->last_modified) = 0;
1687:
1688: /* Reinstall the saved buffer and pointers into it. */
1689: if (NULL (p->buffer))
1690: w->buffer = p->buffer;
1691: else
1692: {
1693: if (!NULL (XBUFFER (p->buffer)->name))
1694: /* If saved buffer is alive, install it. */
1695: {
1696: w->buffer = p->buffer;
1697: w->start_at_line_beg = p->start_at_line_beg;
1698: Fset_marker (w->start, Fmarker_position (p->start), w->buffer);
1699: Fset_marker (w->pointm, Fmarker_position (p->pointm), w->buffer);
1700: Fset_marker (XBUFFER (w->buffer)->mark,
1701: Fmarker_position (p->mark), w->buffer);
1702:
1703: if (!EQ (p->buffer, new_current_buffer) &&
1704: XBUFFER (p->buffer) == bf_cur)
1705: Fgoto_char (w->pointm);
1706: }
1707: else if (NULL (XBUFFER (w->buffer)->name))
1708: /* Else if window's old buffer is dead too, get a live one. */
1709: {
1710: w->buffer = Fcdr (Fcar (Vbuffer_alist));
1711: /* Set window markers at start of buffer.
1712: Rely on Fset_marker to put them within the restriction. */
1713: Fset_marker (w->start, make_number (0), w->buffer);
1714: Fset_marker (w->pointm, make_number (0), w->buffer);
1715: w->start_at_line_beg = Qt;
1716: }
1717: else
1718: /* Keeping window's old buffer; make sure the markers are real. */
1719: /* Else if window's old buffer is dead too, get a live one. */
1720: {
1721: /* Set window markers at start of buffer.
1722: Rely on Fset_marker to put them within the restriction. */
1723: if (XMARKER (w->start)->buffer == 0)
1724: Fset_marker (w->start, make_number (0), w->buffer);
1725: if (XMARKER (w->pointm)->buffer == 0)
1726: Fset_marker (w->pointm,
1727: make_number (XBUFFER (w->buffer) == bf_cur
1728: ? point
1729: : XBUFFER (w->buffer)->text.pointloc),
1730: w->buffer);
1731: w->start_at_line_beg = Qt;
1732: }
1733: }
1734: }
1735:
1736: /* Set the screen height to the value it had before this function. */
1737: if (screen_size_change)
1738: change_screen_size (previous_screen_height, previous_screen_width, 0);
1739:
1740: Fselect_window (data->current_window);
1741: if (!NULL (new_current_buffer))
1742: Fset_buffer (new_current_buffer);
1743: else
1744: Fset_buffer (XWINDOW (selected_window)->buffer);
1745: Vminibuf_scroll_window = data->minibuf_scroll_window;
1746: return (Qnil);
1747: }
1748:
1749:
1750: static int
1751: count_windows (window)
1752: register struct window *window;
1753: {
1754: register int count = 1;
1755: if (!NULL (window->next))
1756: count += count_windows (XWINDOW (window->next));
1757: if (!NULL (window->vchild))
1758: count += count_windows (XWINDOW (window->vchild));
1759: if (!NULL (window->hchild))
1760: count += count_windows (XWINDOW (window->hchild));
1761: return count;
1762: }
1763:
1764: DEFUN ("current-window-configuration",
1765: Fcurrent_window_configuration, Scurrent_window_configuration, 0, 0, 0,
1766: "Return an object representing Emacs' current window configuration,\n\
1767: namely the number of windows, their sizes and current buffers, and for\n\
1768: each displayed buffer, where display starts, and the positions of\n\
1769: point and mark. An exception is made for point in (current-buffer) --\n\
1770: its value is -not- saved.")
1771: ()
1772: {
1773: register Lisp_Object tem;
1774: register int n_windows;
1775: register struct save_window_data *data;
1776: register int i;
1777:
1778: n_windows = count_windows (XWINDOW (XWINDOW (minibuf_window)->prev));
1779: data = (struct save_window_data *)
1780: XVECTOR (Fmake_vector (make_number (SAVE_WINDOW_DATA_SIZE),
1781: Qnil));
1782: XFASTINT (data->screen_width) = screen_width;
1783: XFASTINT (data->screen_height) = screen_height;
1784: data->current_window = selected_window;
1785: XSET (data->current_buffer, Lisp_Buffer, bf_cur);
1786: data->minibuf_scroll_window = Vminibuf_scroll_window;
1787: tem = Fmake_vector (make_number (n_windows), Qnil);
1788: data->saved_windows = tem;
1789: for (i = 0; i < n_windows; i++)
1790: XVECTOR (tem)->contents[i]
1791: = Fmake_vector (make_number (SAVED_WINDOW_VECTOR_SIZE), Qnil);
1792: save_window_save (XWINDOW (minibuf_window)->prev,
1793: XVECTOR (tem),
1794: 0);
1795: XSET (tem, Lisp_Window_Configuration, data);
1796: return (tem);
1797: }
1798:
1799: static int
1800: save_window_save (window, vector, i)
1801: Lisp_Object window;
1802: struct Lisp_Vector *vector;
1803: int i;
1804: {
1805: register struct saved_window *p;
1806: register struct window *w;
1807: register Lisp_Object tem;
1808:
1809: for (;!NULL (window); window = w->next)
1810: {
1811: p = SAVED_WINDOW_N (vector, i);
1812: w = XWINDOW (window);
1813:
1814: XFASTINT (w->temslot) = i++;
1815: p->window = window;
1816: p->buffer = w->buffer;
1817: p->left = w->left;
1818: p->top = w->top;
1819: p->width = w->width;
1820: p->height = w->height;
1821: p->hscroll = w->hscroll;
1822: if (!NULL (w->buffer))
1823: {
1824: if (EQ (window, selected_window)
1825: && XBUFFER (w->buffer) == bf_cur)
1826: p->pointm = Fpoint_marker ();
1827: else
1828: p->pointm = Fcopy_marker (w->pointm);
1829:
1830: p->start = Fcopy_marker (w->start);
1831: p->start_at_line_beg = w->start_at_line_beg;
1832:
1833: tem = XBUFFER (w->buffer)->mark;
1834: p->mark = Fcopy_marker (tem);
1835: }
1836: else
1837: {
1838: p->pointm = Qnil;
1839: p->start = Qnil;
1840: p->mark = Qnil;
1841: p->start_at_line_beg = Qnil;
1842: }
1843:
1844: if (NULL (w->parent))
1845: p->parent = Qnil;
1846: else
1847: p->parent = XWINDOW (w->parent)->temslot;
1848:
1849: if (NULL (w->prev))
1850: p->prev = Qnil;
1851: else
1852: p->prev = XWINDOW (w->prev)->temslot;
1853:
1854: if (!NULL (w->vchild))
1855: i = save_window_save (w->vchild, vector, i);
1856: if (!NULL (w->hchild))
1857: i = save_window_save (w->hchild, vector, i);
1858: }
1859:
1860: return i;
1861: }
1862:
1863: DEFUN ("save-window-excursion", Fsave_window_excursion, Ssave_window_excursion,
1864: 0, UNEVALLED, 0,
1865: "Execute body, preserving window sizes and contents.\n\
1866: Restores which buffer appears in which window, where display starts,\n\
1867: as well as the current buffer.\n\
1868: Does not restore the value of point in current buffer.")
1869: (args)
1870: Lisp_Object args;
1871: {
1872: register Lisp_Object val;
1873: register int count = specpdl_ptr - specpdl;
1874:
1875: record_unwind_protect (Fset_window_configuration,
1876: Fcurrent_window_configuration ());
1877: val = Fprogn (args);
1878: unbind_to (count);
1879: return val;
1880: }
1881:
1882: init_window_once ()
1883: {
1884: extern Lisp_Object get_minibuffer ();
1885: register Lisp_Object root_window;
1886:
1887: root_window = make_window (0);
1888: minibuf_window = make_window (0);
1889:
1890: XWINDOW (root_window)->next = minibuf_window;
1891: XWINDOW (minibuf_window)->prev = root_window;
1892:
1893: /* These values 9 and 10 are arbitrary,
1894: just so that there is "something there."
1895: Correct values are put in in init_xdisp */
1896:
1897: XFASTINT (XWINDOW (root_window)->width) = 10;
1898: XFASTINT (XWINDOW (minibuf_window)->width) = 10;
1899:
1900: XFASTINT (XWINDOW (root_window)->height) = 9;
1901: XFASTINT (XWINDOW (minibuf_window)->top) = 9;
1902: XFASTINT (XWINDOW (minibuf_window)->height) = 1;
1903:
1904: Fset_window_buffer (root_window, Fcurrent_buffer ());
1905: Fset_window_buffer (minibuf_window, get_minibuffer (0));
1906:
1907: selected_window = root_window;
1908: }
1909:
1910: syms_of_window ()
1911: {
1912: Qwindowp = intern ("windowp");
1913: staticpro (&Qwindowp);
1914:
1915: /* Make sure all windows get marked */
1916: staticpro (&minibuf_window);
1917:
1918: DEFVAR_LISP ("temp-buffer-show-hook", &Vtemp_buffer_show_hook,
1919: "Non-nil means call as function to display a help buffer.\n\
1920: Used by with-output-to-temp-buffer.");
1921: Vtemp_buffer_show_hook = Qnil;
1922:
1923: DEFVAR_LISP ("minibuffer-scroll-window", &Vminibuf_scroll_window,
1924: "Non-nil means it is the window that C-M-v in minibuffer should scroll.");
1925: Vminibuf_scroll_window = Qnil;
1926:
1927: DEFVAR_BOOL ("pop-up-windows", &pop_up_windows,
1928: "*Non-nil means display-buffer should make new windows.");
1929: pop_up_windows = 1;
1930:
1931: DEFVAR_INT ("next-screen-context-lines", &next_screen_context_lines,
1932: "*Number of lines of continuity when scrolling by screenfuls.");
1933: next_screen_context_lines = 2;
1934:
1935: DEFVAR_INT ("split-height-threshold", &split_height_threshold,
1936: "*display-buffer would prefer to split the largest window if this large.\n\
1937: If there is only one window, it is split regardless of this value.");
1938: split_height_threshold = 500;
1939:
1940: DEFVAR_INT ("window-min-height", &window_min_height,
1941: "*Delete any window less than this tall (including its mode line).");
1942: window_min_height = 4;
1943:
1944: DEFVAR_INT ("window-min-width", &window_min_width,
1945: "*Delete any window less than this wide.");
1946: window_min_width = 10;
1947:
1948: defsubr (&Sselected_window);
1949: defsubr (&Sminibuffer_window);
1950: defsubr (&Swindowp);
1951: defsubr (&Spos_visible_in_window_p);
1952: defsubr (&Swindow_buffer);
1953: defsubr (&Swindow_height);
1954: defsubr (&Swindow_width);
1955: defsubr (&Swindow_hscroll);
1956: defsubr (&Sset_window_hscroll);
1957: defsubr (&Swindow_edges);
1958: defsubr (&Swindow_point);
1959: defsubr (&Swindow_start);
1960: defsubr (&Sset_window_point);
1961: defsubr (&Sset_window_start);
1962: defsubr (&Snext_window);
1963: defsubr (&Sprevious_window);
1964: defsubr (&Sother_window);
1965: defsubr (&Sget_lru_window);
1966: defsubr (&Sget_largest_window);
1967: defsubr (&Sget_buffer_window);
1968: defsubr (&Sdelete_other_windows);
1969: defsubr (&Sdelete_windows_on);
1970: defsubr (&Sreplace_buffer_in_windows);
1971: defsubr (&Sdelete_window);
1972: defsubr (&Sset_window_buffer);
1973: defsubr (&Sselect_window);
1974: defsubr (&Sdisplay_buffer);
1975: defsubr (&Ssplit_window);
1976: defsubr (&Senlarge_window);
1977: defsubr (&Sshrink_window);
1978: defsubr (&Sscroll_up);
1979: defsubr (&Sscroll_down);
1980: defsubr (&Sscroll_left);
1981: defsubr (&Sscroll_right);
1982: defsubr (&Sscroll_other_window);
1983: defsubr (&Srecenter);
1984: defsubr (&Smove_to_window_line);
1985: defsubr (&Sset_window_configuration);
1986: defsubr (&Scurrent_window_configuration);
1987: defsubr (&Ssave_window_excursion);
1988: }
1989:
1990: keys_of_window ()
1991: {
1992: defkey (CtlXmap, '1', "delete-other-windows");
1993: defkey (CtlXmap, '2', "split-window");
1994: defkey (CtlXmap, '0', "delete-window");
1995: defkey (CtlXmap, 'o', "other-window");
1996: defkey (CtlXmap, '^', "enlarge-window");
1997: defkey (CtlXmap, '<', "scroll-left");
1998: defkey (CtlXmap, '>', "scroll-right");
1999:
2000: defkey (GlobalMap, Ctl ('V'), "scroll-up");
2001: defkey (ESCmap, Ctl ('V'), "scroll-other-window");
2002: defkey (ESCmap, 'v', "scroll-down");
2003:
2004: defkey (GlobalMap, Ctl('L'), "recenter");
2005: defkey (ESCmap, 'r', "move-to-window-line");
2006: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.