window.c

早期freebsd实现

/* Window creation, deletion and examination for GNU Emacs.
   Does not include redisplay.
   Copyright (C) 1985, 1986, 1987, 1990 Free Software Foundation, Inc.

This file is part of GNU Emacs.

GNU Emacs is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 1, or (at your option)
any later version.

GNU Emacs is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
along with GNU Emacs; see the file COPYING.  If not, write to
the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  */


#include "config.h"
#include "lisp.h"
#include "buffer.h"
#include "window.h"
#include "commands.h"
#include "indent.h"
#include "termchar.h"

Lisp_Object Qwindowp;

Lisp_Object Fnext_window (), Fdelete_window (), Fselect_window ();
Lisp_Object Fset_window_buffer (), Fsplit_window (), Frecenter ();

/* This is the window which displays the minibuffer.
It is always the same window.  */

Lisp_Object minibuf_window;

/* This is the window in which the terminal's cursor should
 be left when nothing is being done with it.  This must
 always be a leaf window, and its buffer is selected by
 the top level editing loop at the end of each command.  */

Lisp_Object selected_window;

/* Non-nil means it is the window for C-M-v to scroll
   when the minibuffer is selected.  */

Lisp_Object Vminibuf_scroll_window;

/* Non-nil means it's function to call to display temp buffers.  */

Lisp_Object Vtemp_buffer_show_hook;

/* If a window gets smaller than either of these, it is removed. */

int window_min_height;
int window_min_width;

/* Nonzero implies pop_to_buffer should create windows. */

int pop_up_windows;

/* display-buffer always splits the largest window 
 if that window is more than this high */

int split_height_threshold;

/* Number of lines of continuity in scrolling by screenfuls.  */

int next_screen_context_lines;

/* Incremented for each window created.  */

static int sequence_number;

DEFUN ("windowp", Fwindowp, Swindowp, 1, 1, 0,
  "Returns t if OBJ is a window.")
  (obj)
     Lisp_Object obj;
{
  return XTYPE (obj) == Lisp_Window ? Qt : Qnil;
}

static Lisp_Object
make_window ()
{
  register Lisp_Object val;
  register struct window *p;

  /* Add sizeof (Lisp_Object) here because sizeof (struct Lisp_Vector)
     includes the first element.  */
  val = Fmake_vector (
    make_number ((sizeof (struct window) - sizeof (struct Lisp_Vector)
		  + sizeof (Lisp_Object))
		 / sizeof (Lisp_Object)),
    Qnil);
  XSETTYPE (val, Lisp_Window);
  p = XWINDOW (val);
  XFASTINT (p->sequence_number) = ++sequence_number;
  XFASTINT (p->left) = XFASTINT (p->top)
    = XFASTINT (p->height) = XFASTINT (p->width)
      = XFASTINT (p->hscroll) = 0;
  XFASTINT (p->last_point_x) = XFASTINT (p->last_point_y) = 0;
  p->start = Fmake_marker ();
  p->pointm = Fmake_marker ();
  XFASTINT (p->use_time) = 0;
  return val;
}

DEFUN ("selected-window", Fselected_window, Sselected_window, 0, 0, 0,
  "Return the window that the cursor now appears in and commands apply to.")
  ()
{
  return selected_window;
}

DEFUN ("minibuffer-window", Fminibuffer_window, Sminibuffer_window, 0, 0, 0,
  "Return the window used for minibuffers.")
  ()
{
  return minibuf_window;
}

DEFUN ("pos-visible-in-window-p", Fpos_visible_in_window_p,
  Spos_visible_in_window_p, 0, 2, 0,
  "Return t if position POS is currently on the screen in WINDOW.\n\
Returns nil if that position is scrolled vertically out of view.\n\
POS defaults to point; WINDOW, to the selected window.")
  (pos, window)
     Lisp_Object pos, window;
{
  register struct window *w;
  register int top;
  register int height;
  register int posint;
  register struct buffer *buf;
  struct position posval;

  if (NULL (pos))
    posint = point;
  else
    {
      CHECK_NUMBER_COERCE_MARKER (pos, 0);
      posint = XINT (pos);
    }

  if (NULL (window))
    window = selected_window;
  else
    CHECK_WINDOW (window, 1);
  w = XWINDOW (window);
  top = marker_position (w->start);

  if (posint < top)
    return Qnil;

  height = XFASTINT (w->height) - !EQ (window, minibuf_window);

  buf = XBUFFER (w->buffer);
  if (XFASTINT (w->last_modified) >= BUF_MODIFF (buf))
    {
      /* If screen is up to date,
	 use the info recorded about how much text fit on it. */
      if (posint < BUF_Z (buf) - XFASTINT (w->window_end_pos)
	  || (XFASTINT (w->window_end_vpos) < height))
	return Qt;
      return Qnil;
    }
  else
    {
      if (posint > BUF_Z (buf))
	return Qnil;
      /* If that info is not correct, calculate afresh */
      posval = *compute_motion (top, 0, 0,
			       posint, height, 0,
			       XFASTINT (w->width) - 1
			       - (XFASTINT (w->width) + XFASTINT (w->left) != XFASTINT (XWINDOW (minibuf_window)->width)),

			       XINT (w->hscroll), 0);
      return posval.vpos < height ? Qt : Qnil;
    }
}

static struct window *
decode_window (window)
     register Lisp_Object window;
{
  if (NULL (window))
    return XWINDOW (selected_window);

  CHECK_WINDOW (window, 0);
  return XWINDOW (window);
}

DEFUN ("window-buffer", Fwindow_buffer, Swindow_buffer, 0, 1, 0,
  "Return the buffer that WINDOW is displaying.")
  (window)
     Lisp_Object window;
{
  return decode_window (window)->buffer;
}

DEFUN ("window-height", Fwindow_height, Swindow_height, 0, 1, 0,
  "Return the number of lines in WINDOW (including its mode line).")
  (window)
     Lisp_Object window;
{
  return decode_window (window)->height;
}

DEFUN ("window-width", Fwindow_width, Swindow_width, 0, 1, 0,
  "Return the number of columns in WINDOW.")
  (window)
     Lisp_Object window;
{
  register int w = decode_window (window)->width;
  /* If this window does not end at the right margin,
     must deduct one column for the border */
  if (w + decode_window (window)->left == screen_width)
    return w;
  return w - 1;
}

DEFUN ("window-hscroll", Fwindow_hscroll, Swindow_hscroll, 0, 1, 0,
  "Return the number of columns by which WINDOW is scrolled from left margin.")
  (window)
     Lisp_Object window;
{
  return decode_window (window)->hscroll;
}

DEFUN ("set-window-hscroll", Fset_window_hscroll, Sset_window_hscroll, 2, 2, 0,
  "Set number of columns WINDOW is scrolled from left margin to NCOL.\n\
NCOL should be zero or positive.")
  (window, ncol)
     register Lisp_Object window, ncol;
{
  register struct window *w;

  CHECK_NUMBER (ncol, 1);
  if (XINT (ncol) < 0) XFASTINT (ncol) = 0;
  if (XFASTINT (ncol) >= (1 << (SHORTBITS - 1)))
    args_out_of_range (ncol, Qnil);
  w = decode_window (window);
  if (w->hscroll != ncol)
    clip_changed = 1;		/* Prevent redisplay shortcuts */
  w->hscroll = ncol;
  return ncol;
}

DEFUN ("window-edges", Fwindow_edges, Swindow_edges, 0, 1, 0,
  "Return a list of the edge coordinates of WINDOW.\n\
\(LEFT TOP RIGHT BOTTOM), all relative to 0, 0 at top left corner of screen.\n\
RIGHT is one more than the rightmost column used by WINDOW,\n\
and BOTTOM is one more than the bottommost row used by WINDOW\n\
 and its mode-line.")
  (window)
     Lisp_Object window;
{
  register struct window *w = decode_window (window);

  return Fcons (w->left, Fcons (w->top,
           Fcons (make_number (XFASTINT (w->left) + XFASTINT (w->width)),
		  Fcons (make_number (XFASTINT (w->top)
				      + XFASTINT (w->height)),
			 Qnil))));
}

DEFUN ("window-point", Fwindow_point, Swindow_point, 0, 1, 0,
  "Return current value of point in WINDOW.\n\
For a nonselected window, this is the value point would have\n\
if that window were selected.\n\
\n\
Note that, when WINDOW is the selected window and its buffer\n\
is also currently selected, the value returned is the same as (point).\n\
It would be more strictly correct to return the `top-level' value\n\
of point, outside of any  save-excursion  forms.\n\
But that is hard to define.")
  (window)
     Lisp_Object window;
{
  register struct window *w = decode_window (window);

  if (w == XWINDOW (selected_window)
      && current_buffer == XBUFFER (w->buffer))
    return Fpoint ();
  return Fmarker_position (w->pointm);
}

DEFUN ("window-start", Fwindow_start, Swindow_start, 0, 1, 0,
  "Return position at which display currently starts in WINDOW.")
  (window)
     Lisp_Object window;
{
  return Fmarker_position (decode_window (window)->start);
}

DEFUN ("set-window-point", Fset_window_point, Sset_window_point, 2, 2, 0,
  "Make point value in WINDOW be at position POS in WINDOW's buffer.")
  (window, pos)
     Lisp_Object window, pos;
{
  register struct window *w = decode_window (window);

  CHECK_NUMBER_COERCE_MARKER (pos, 1);
  if (w == XWINDOW (selected_window))
    Fgoto_char (pos);
  else
    set_marker_restricted (w->pointm, pos, w->buffer);
  return pos;
}

DEFUN ("set-window-start", Fset_window_start, Sset_window_start, 2, 3, 0,
  "Make display in WINDOW start at position POS in WINDOW's buffer.\n\
Optional third arg NOFORCE non-nil inhibits next redisplay\n\
from overriding motion of point in order to display at this exact start.")
  (window, pos, noforce)
     Lisp_Object window, pos, noforce;
{
  register struct window *w = decode_window (window);

  CHECK_NUMBER_COERCE_MARKER (pos, 1);
  set_marker_restricted (w->start, pos, w->buffer);
  /* this is not right, but much easier than doing what is right.  */
  w->start_at_line_beg = Qnil;
  if (NULL (noforce))
    w->force_start = Qt;
  w->update_mode_line = Qt;
  XFASTINT (w->last_modified) = 0;
  return pos;
}

DEFUN ("delete-window", Fdelete_window, Sdelete_window, 0, 1, "",
  "Remove WINDOW from the display.  Default is selected window.")
  (window)
     register Lisp_Object window;
{
  int osize;
  register Lisp_Object tem, parent;
  register struct window *p;
  register struct window *par;

  if (NULL (window))
    window = selected_window;
  else
    CHECK_WINDOW (window, 0);

  p = XWINDOW (window);
  parent = p->parent;
  if (NULL (parent))
    error ("Attempt to delete minibuffer or sole ordinary window");
  par=XWINDOW (parent);

  windows_or_buffers_changed++;

  if (EQ (window, selected_window))
    Fselect_window (Fnext_window (window, Qnil));

  tem = p->buffer;
  /* tem is null for dummy parent windows
     (which have inferiors but not any contents themselves) */
  if (!NULL (tem))
    {
      unshow_buffer (p);
      unchain_marker (p->pointm);
      unchain_marker (p->start);
    }

  tem = p->next;
  if (!NULL (tem))
    XWINDOW (tem)->prev = p->prev;

  tem = p->prev;
  if (!NULL (tem))
    XWINDOW (tem)->next = p->next;

  if (EQ (window, par->hchild))
    par->hchild = p->next;
  if (EQ (window, par->vchild))
    par->vchild = p->next;

  /* Stretch the siblings to use all the available space */
  if (!NULL (par->vchild))
    {
      /* It's a vertical combination */
      osize = XFASTINT (par->height);
      XFASTINT (par->height)
	-= XFASTINT (p->height);
      set_window_height (parent, osize, 1);
    }
  if (!NULL (par->hchild))
    {
      /* It's a horizontal combination */
      osize = XFASTINT (par->width);
      XFASTINT (par->width)
	-= XFASTINT (p->width);
      set_window_width (parent, osize, 1);
    }

  /* If parent now has only one child,
     put the child into the parent's place.  */

  tem = par->hchild;
  if (NULL (tem))
    tem = par->vchild;
  if (NULL (XWINDOW (tem)->next))
    replace_window (parent, tem);
  return Qnil;
}

/* Put replacement into the window structure in place of old. */
static
replace_window (old, replacement)
     Lisp_Object old, replacement;
{
  register Lisp_Object tem;
  register struct window *o = XWINDOW (old), *p = XWINDOW (replacement);

  p->left = o->left;
  p->top = o->top;
  p->width = o->width;
  p->height = o->height;

  p->next = tem = o->next;
  if (!NULL (tem))
    XWINDOW (tem)->prev = replacement;

  p->prev = tem = o->prev;
  if (!NULL (tem))
    XWINDOW (tem)->next = replacement;

  p->parent = tem = o->parent;
  if (!NULL (tem))
    {
      if (EQ (XWINDOW (tem)->vchild, old))
	XWINDOW (tem)->vchild = replacement;
      if (EQ (XWINDOW (tem)->hchild, old))
	XWINDOW (tem)->hchild = replacement;
    }

/*** Here, if replacement is a vertical combination
and so is its new parent, we should make replacement's
children be children of that parent instead.  ***/
}

DEFUN ("next-window", Fnext_window, Snext_window, 0, 2, 0,
  "Return next window after WINDOW in canonical ordering of windows.\n\
Optional second arg MINIBUF t means count the minibuffer window\n\
even if not active.  If MINIBUF is neither t nor nil it means\n\
not to count the minibuffer even if it is active.")
  (window, mini)
     register Lisp_Object window, mini;
{
  register Lisp_Object tem;
  if (NULL (window))
    window = selected_window;
  else
    CHECK_WINDOW (window, 0);
  do
    {
      while (tem = XWINDOW (window)->next, NULL (tem))
	if (tem = XWINDOW (window)->parent, !NULL (tem))
	  window = tem;
        else  /* window must be minibuf_window now */
	  {
	    tem = XWINDOW (window)->prev;
	    break;
	  }
      window = tem;
      while (1)
	{
	  if (!NULL (XWINDOW (window)->hchild))
	    window = XWINDOW (window)->hchild;
	  else if (!NULL (XWINDOW (window)->vchild))
	    window = XWINDOW (window)->vchild;
	  else break;
	}
    }
  while (EQ (window, minibuf_window) && !EQ (mini, Qt)
	 && (!NULL (mini) || minibuf_level == 0));
  return window;
}

DEFUN ("previous-window", Fprevious_window, Sprevious_window, 0, 1, 0,
  "Return previous window before WINDOW in canonical ordering of windows.")
  (window)
     register Lisp_Object window;
{
  register Lisp_Object tem;
  if (NULL (window))
    window = selected_window;
  else
    CHECK_WINDOW (window, 0);
  do  /* at least once, and until not the minibuffer */
    {
      while (tem = XWINDOW (window)->prev, NULL (tem))
	if (tem = XWINDOW (window)->parent, !NULL (tem))
	  window = tem;
        else  /* window must be the root window now */
	  {
	    tem = minibuf_window;
	    break;
	  }
      window = tem;