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