window.c

早期freebsd实现

    }
}

static
make_dummy_parent (window)
     Lisp_Object window;
{
  register Lisp_Object old, new;
  register struct window *o, *p;

  old = window;
  XSETTYPE (old, Lisp_Vector);
  new = Fcopy_sequence (old);
  XSETTYPE (new, Lisp_Window);

  o = XWINDOW (old);
  p = XWINDOW (new);
  XFASTINT (p->sequence_number) = ++sequence_number;

  /* Put new into window structure in place of window */
  replace_window (window, new);

  o->next = Qnil;
  o->prev = Qnil;
  o->vchild = Qnil;
  o->hchild = Qnil;
  o->parent = new;

  p->start = Qnil;
  p->pointm = Qnil;
  p->buffer = Qnil;
}

DEFUN ("split-window", Fsplit_window, Ssplit_window, 0, 3, "",
  "Split WINDOW, putting SIZE lines in the first of the pair.\n\
WINDOW defaults to selected one and SIZE to half its size.\n\
If optional third arg HOR-FLAG is non-nil, split side by side\n\
and put SIZE columns in the first of the pair.")
  (window, chsize, horflag)
     Lisp_Object window, chsize, horflag;
{
  register Lisp_Object new;
  register struct window *o, *p;
  register int size;

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

  o = XWINDOW (window);

  if (NULL (chsize))
    {
      if (!NULL (horflag))
	/* Add 1 so we round up rather than down.
	   This puts an excess column into the left-hand window,
	   which is the one that certainly contains a border line.  */
	size = (1 + XFASTINT (o->width)) >> 1;
      else
	size = XFASTINT (o->height) >> 1;
    }
  else
    {
      CHECK_NUMBER (chsize, 1);
      size = XINT (chsize);
    }

  if (EQ (window, minibuf_window))
    error ("Attempt to split minibuffer window");

  if (NULL (horflag))
    {
      if (window_min_height < 2)
	window_min_height = 2;

      if (size < window_min_height ||
	  size + window_min_height > XFASTINT (o->height))
	args_out_of_range_3 (window, chsize, horflag);
      if (NULL (o->parent) ||
	  NULL (XWINDOW (o->parent)->vchild))
	{
	  make_dummy_parent (window);
	  new = o->parent;
	  XWINDOW (new)->vchild = window;
	}
    }
  else
    {
      if (size < window_min_width ||
	  size + window_min_width > XFASTINT (o->width))
	args_out_of_range_3 (window, chsize, horflag);
      if (NULL (o->parent) ||
	  NULL (XWINDOW (o->parent)->hchild))
	{
	  make_dummy_parent (window);
	  new = o->parent;
	  XWINDOW (new)->hchild = window;
	}
    }

  /* Now we know that window's parent is a vertical combination
     if we are dividing vertically, or a horizontal combination
     if we are making side-by-side windows */

  windows_or_buffers_changed++;
  new = make_window ();
  p = XWINDOW (new);

  p->next = o->next;
  if (!NULL (p->next))
    XWINDOW (p->next)->prev = new;
  p->prev = window;
  o->next = new;
  p->parent = o->parent;

  Fset_window_buffer (new, o->buffer);

  /* Apportion the available screen space among the two new windows */

  if (!NULL (horflag))
    {
      p->height = o->height;
      p->top = o->top;
      XFASTINT (p->width) = XFASTINT (o->width) - size;
      XFASTINT (o->width) = size;
      XFASTINT (p->left) = XFASTINT (o->left) + size;
    }
  else
    {
      p->left = o->left;
      p->width = o->width;
      XFASTINT (p->height) = XFASTINT (o->height) - size;
      XFASTINT (o->height) = size;
      XFASTINT (p->top) = XFASTINT (o->top) + size;
    }

  return new;
}

DEFUN ("enlarge-window", Fenlarge_window, Senlarge_window, 1, 2, "p",
  "Make current window ARG lines bigger.\n\
From program, optional second arg non-nil means grow sideways ARG columns.")
  (n, side)
     register Lisp_Object n, side;
{
  CHECK_NUMBER (n, 0);
  change_window_height (XINT (n), !NULL (side));
  return Qnil;
}

DEFUN ("shrink-window", Fshrink_window, Sshrink_window, 1, 2, "p",
  "Make current window ARG lines smaller.\n\
From program, optional second arg non-nil means shrink sideways ARG columns.")
  (n, side)
     register Lisp_Object n, side;
{
  CHECK_NUMBER (n, 0);
  change_window_height (-XINT (n), !NULL (side));
  return Qnil;
}

int
window_height (window)
     Lisp_Object window;
{
  register struct window *p = XWINDOW (window);
  return XFASTINT (p->height);
}

int
window_width (window)
     Lisp_Object window;
{
  register struct window *p = XWINDOW (window);
  return XFASTINT (p->width);
}

#define MINSIZE(window) \
  (widthflag ? window_min_width  \
   : (EQ (window, minibuf_window) ? 1 : window_min_height))

#define CURBEG(w) \
  *(widthflag ? (int *) &w->left : (int *) &w->top)

#define CURSIZE(w) \
  *(widthflag ? (int *) &w->width : (int *) &w->height)

/* Unlike set_window_height, this function
 also changes the heights of the siblings so as to
 keep everything consistent. */

change_window_height (delta, widthflag)
     register int delta;
     int widthflag;
{
  register Lisp_Object parent;
  Lisp_Object window;
  register struct window *p;
  int *sizep;
  int (*sizefun) () = widthflag ? window_width : window_height;
  register int (*setsizefun) () = widthflag ? set_window_width : set_window_height;

  if (window_min_height < 2)
    window_min_height = 2;

  window = selected_window;
  while (1)
    {
      p = XWINDOW (window);
      parent = p->parent;
      if (NULL (parent))
	{
	  if (widthflag)
	    error ("No other window to side of this one");
	  break;
	}
      if (widthflag ? !NULL (XWINDOW (parent)->hchild)
	  : !NULL (XWINDOW (parent)->vchild))
	break;
      window = parent;
    }

  sizep = &CURSIZE (p);

  if (*sizep + delta < MINSIZE (window))
    {
      Fdelete_window (window);
      return;
    }

  {
    register int maxdelta;
    register Lisp_Object tem;

    maxdelta = (!NULL (parent) ? (*sizefun) (parent) - *sizep
		: (tem = (!NULL (p->next) ? p->next : p->prev),
		   (*sizefun) (tem) - MINSIZE (tem)));

    if (delta > maxdelta)
      /* This case traps trying to make the minibuffer
	 the full screen, or make the only window aside from the
	 minibuffer the full screen.  */
      delta = maxdelta;
  }

  if (!NULL (p->next) &&
      (*sizefun) (p->next) - delta >= MINSIZE (p->next))
    {
      (*setsizefun) (p->next, (*sizefun) (p->next) - delta, 0);
      (*setsizefun) (window, *sizep + delta, 0);
      CURBEG (XWINDOW (p->next)) += delta;
      /* This does not change size of p->next,
	 but it propagates the new top edge to its children */
      (*setsizefun) (p->next, (*sizefun) (p->next), 0);
    }
  else if (!NULL (p->prev) &&
	   (*sizefun) (p->prev) - delta >= MINSIZE (p->prev))
    {
      (*setsizefun) (p->prev, (*sizefun) (p->prev) - delta, 0);
      CURBEG (p) -= delta;
      (*setsizefun) (window, *sizep + delta, 0);
    }
  else
    {
      register int delta1;
      register int opht = (*sizefun) (parent);

      /* If trying to grow this window to or beyond size of the parent,
	 make delta1 so big that, on shrinking back down,
	 all the siblings end up with less than one line and are deleted.  */
      if (opht <= *sizep + delta)
	delta1 = opht * opht * 2;
      /* Otherwise, make delta1 just right so that if we add delta1
	 lines to this window and to the parent, and then shrink
	 the parent back to its original size, the new proportional
	 size of this window will increase by delta.  */
      else
	delta1 = (delta * opht * 100) / ((opht - *sizep - delta) * 100);

      /* Add delta1 lines or columns to this window, and to the parent,
	 keeping things consistent while not affecting siblings.  */
      CURSIZE (XWINDOW (parent)) = opht + delta1;
      (*setsizefun) (window, *sizep + delta1, 0);

      /* Squeeze out delta1 lines or columns from our parent,
	 shriking this window and siblings proportionately.
	 This brings parent back to correct size.
	 Delta1 was calculated so this makes this window the desired size,
	 taking it all out of the siblings.  */
      (*setsizefun) (parent, opht, 0);
    }

  XFASTINT (p->last_modified) = 0;
}
#undef MINSIZE
#undef CURBEG
#undef CURSIZE


static
window_scroll (window, n)
     Lisp_Object window;
     int n;
{
  register struct window *w = XWINDOW (window);
  register int opoint = point;
  register int ht, pos;
  register Lisp_Object tem;
  int lose;
  Lisp_Object bolp;

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

  XFASTINT (tem) = point;
  tem = Fpos_visible_in_window_p (tem, window);

  if (NULL (tem))
    {
      Fvertical_motion (make_number (- ht / 2));
      XFASTINT (tem) = point;
      Fset_marker (w->start, tem, w->buffer);
      w->force_start = Qt;
    }

  SET_PT (marker_position (w->start));
  lose = n < 0 && point == BEGV;
  Fvertical_motion (make_number (n));
  pos = point;
  bolp = Fbolp ();
  SET_PT (opoint);

  if (lose)
    Fsignal (Qbeginning_of_buffer, Qnil);

  if (pos < ZV)
    {
      set_marker_restricted (w->start, make_number (pos), w->buffer);
      w->start_at_line_beg = bolp;
      w->update_mode_line = Qt;
      XFASTINT (w->last_modified) = 0;
      if (pos > opoint)
	SET_PT (pos);
      if (n < 0)
	{
	  SET_PT (pos);
	  tem = Fvertical_motion (make_number (ht));
	  if (point > opoint || XFASTINT (tem) < ht)
	    SET_PT (opoint);
	  else
	    Fvertical_motion (make_number (-1));
	}
    }
  else
    Fsignal (Qend_of_buffer, Qnil);
}

scroll_command (n, direction)
     register Lisp_Object n;
     int direction;
{
  register int defalt
    = direction * (window_height (selected_window) - 1
		   - next_screen_context_lines);

  if (NULL (n))
    window_scroll (selected_window, defalt);
  else if (EQ (n, Qminus))
    window_scroll (selected_window, - defalt);
  else
    {
      n = Fprefix_numeric_value (n);
      window_scroll (selected_window, XINT (n) * direction);
    }
}

DEFUN ("scroll-up", Fscroll_up, Sscroll_up, 0, 1, "P",
  "Scroll text of current window upward ARG lines; or near full screen if no ARG.\n\
When calling from a program, supply a number as argument or nil.")
  (n)
     Lisp_Object n;
{
  scroll_command (n, 1);
  return Qnil;
}

DEFUN ("scroll-down", Fscroll_down, Sscroll_down, 0, 1, "P",
  "Scroll text of current window downward ARG lines; or near full screen if no ARG.\n\
When calling from a program, supply a number as argument or nil.")
  (n)
     Lisp_Object n;
{
  scroll_command (n, -1);
  return Qnil;
}

DEFUN ("scroll-left", Fscroll_left, Sscroll_left, 1, 1, "P",
  "Scroll selected window display ARG columns left.\n\
Default for ARG is window width minus 2.")
  (arg)
     register Lisp_Object arg;
{
  if (NULL (arg))
    XFASTINT (arg) = XFASTINT (XWINDOW (selected_window)->width) - 2;
  else
    arg = Fprefix_numeric_value (arg);

  return Fset_window_hscroll (selected_window,
			      make_number (XINT (XWINDOW (selected_window)->hscroll)
					   + XINT (arg)));
}

DEFUN ("scroll-right", Fscroll_right, Sscroll_right, 1, 1, "P",
  "Scroll selected window display ARG columns right.\n\
Default for ARG is window width minus 2.")
  (arg)
     register Lisp_Object arg;
{
  if (NULL (arg))
    XFASTINT (arg) = XFASTINT (XWINDOW (selected_window)->width) - 2;
  else
    arg = Fprefix_numeric_value (arg);

  return Fset_window_hscroll (selected_window,
			      make_number (XINT (XWINDOW (selected_window)->hscroll)
					   - XINT (arg)));
}

DEFUN ("scroll-other-window", Fscroll_other_window, Sscroll_other_window, 0, 1, "P",
  "Scroll text of next window upward ARG lines; or near full screen if no ARG.\n\
The next window is the one below the current one; or the one at the top\n\
if the current one is at the bottom.\n\
When calling from a program, supply a number as argument or nil.")
  (n)
     register Lisp_Object n;
{
  register Lisp_Object window;
  struct buffer *old = current_buffer;
  register int ht;
  register int opoint = point;
  register struct window *w;

  if (EQ (selected_window, minibuf_window)
      && !NULL (Vminibuf_scroll_window))
    window = Vminibuf_scroll_window;
  else
    window = Fnext_window (selected_window, Qnil);
  CHECK_WINDOW (window, 0);
  ht = window_height (window) - 1;

  if (EQ (window, selected_window))
    error ("There is no other window");

  w = XWINDOW (window);
  Fset_buffer (w->buffer);
  SET_PT (marker_position (w->pointm));

  if (NULL (n))
    window_scroll (window, ht - next_screen_context_lines);
  else if (EQ (n, Qminus))
    window_scroll (window, next_screen_context_lines - ht);
  else
    {
      if (XTYPE (n) == Lisp_Cons)
	n = Fcar (n);
      CHECK_NUMBER (n, 0);
      window_scroll (window, XINT (n));
    }

  Fset_marker (w->pointm, make_number (point), Qnil);
  set_buffer_internal (old);
  SET_PT (opoint);
  return Qnil;
}

DEFUN ("recenter", Frecenter, Srecenter, 0, 1, "P",
  "Center point in window and redisplay screen.  With ARG, put point on line ARG.\n\
The desired position of point is always relative to the current window.\n\
Just C-u as prefix means put point in the center of the screen.\n\
No arg (i.e., it is nil) erases the entire screen and then\n\
redraws with point in the center.")
  (n)
     register Lisp_Object n;
{
  register int ht = window_height (selected_window)
    - !EQ (selected_window, minibuf_window);
  register struct window *w = XWINDOW (selected_window);
  register int opoint = point;

  if (NULL (n))
    {
      extern int screen_garbaged;
      screen_garbaged++;
      XFASTINT (n) = ht / 2;
    }
  else if (XTYPE (n) == Lisp_Cons) /* Just C-u. */
    {
      XFASTINT (n) = ht / 2;
    }
  else
    {
      n = Fprefix_numeric_value (n);
      CHECK_NUMBER (n, 0);
    }

  if (XINT (n) < 0)