Initial revision

src/frame.c

+/* Generic screen functions.
+   Copyright (C) 1989 Free Software Foundation.
+
+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 "screen.h"
+#include "window.h"
+
+Lisp_Object Vemacs_iconified;
+Lisp_Object Qscreenp;
+Lisp_Object Vscreen_list;
+Lisp_Object Vterminal_screen;
+Lisp_Object Vglobal_minibuffer_screen;
+
+extern Lisp_Object Vminibuffer_list;
+extern Lisp_Object get_minibuffer ();
+
+DEFUN ("screenp", Fscreenp, Sscreenp, 1, 1, 0,
+  "Return non-nil if OBJECT is a screen.\n\
+Value is t for a termcap screen (a character-only terminal),\n\
+`x' for an Emacs screen that is really an X window.")
+  (screen)
+     Lisp_Object screen;
+{
+  if (XTYPE (screen) != Lisp_Screen)
+    return Qnil;
+  switch (XSCREEN (screen)->output_method)
+    {
+    case output_termcap:
+      return Qt;
+    case output_x_window:
+      return intern ("x");
+    default:
+      abort ();
+    }
+}
+
+struct screen *
+make_screen (mini_p)
+     int mini_p;
+{
+  Lisp_Object screen;
+  register struct screen *s;
+  register Lisp_Object root_window;
+  register Lisp_Object mini_window;
+
+  screen = Fmake_vector (sizeof (struct screen) - sizeof (Lisp_Vector) + 1,
+			 make_number (0));
+  XSETTYPE (screen, Lisp_Screen);
+  s = XSCREEN (screen);
+
+  s->cursor_x = 0;
+  s->cursor_y = 0;
+  s->current_glyphs = 0;
+  s->desired_glyphs = 0;
+  s->visible = 0;
+  s->display.nothing = 0;
+  s->iconified = 0;
+  s->wants_modeline = 1;
+  s->auto_raise = 0;
+  s->auto_lower = 0;
+  s->no_split = 0;
+  s->garbaged = 0;
+  s->has_minibuffer = mini_p;
+
+  s->param_alist = Qnil;
+
+  root_window = make_window (0);
+  if (mini_p)
+    {
+      mini_window = make_window (0);
+      XWINDOW (root_window)->next = mini_window;
+      XWINDOW (mini_window)->prev = root_window;
+      XWINDOW (mini_window)->mini_p = Qt;
+      XWINDOW (mini_window)->screen = screen;
+      s->minibuffer_window = mini_window;
+    }
+  else
+    {
+      mini_window = Qnil;
+      XWINDOW (root_window)->next = Qnil;
+      s->minibuffer_window = Qnil;
+    }
+
+  XWINDOW (root_window)->screen = screen;
+
+  /* 10 is arbitrary,
+     just so that there is "something there."
+     Correct size will be set up later with change_screen_size.  */
+
+  s->width = 10;
+  s->height = 10;
+
+  XFASTINT (XWINDOW (root_window)->width) = 10;
+  XFASTINT (XWINDOW (root_window)->height) = (mini_p ? 9 : 10);
+
+  if (mini_p)
+    {
+      XFASTINT (XWINDOW (mini_window)->width) = 10;
+      XFASTINT (XWINDOW (mini_window)->top) = 9;
+      XFASTINT (XWINDOW (mini_window)->height) = 1;
+    }
+
+  XWINDOW (root_window)->buffer = Qt;
+  Fset_window_buffer (root_window, Fcurrent_buffer ());
+  if (mini_p)
+    {
+      XWINDOW (mini_window)->buffer = Qt;
+      Fset_window_buffer (mini_window,
+			  (NULL (Vminibuffer_list)
+			   ? get_minibuffer (0)
+			   : Fcar (Vminibuffer_list)));
+    }
+
+  s->selected_window = root_window;
+  s->root_window = root_window;
+
+  Vscreen_list = Fcons (screen, Vscreen_list);
+
+  return s;
+}
+
+/* Make a screen using a separate minibuffer window on another screen.
+   MINI_WINDOW is the minibuffer window to use.  nil means use the
+   default (the global minibuffer).  */
+
+struct screen *
+make_screen_without_minibuffer (mini_window)
+     register Lisp_Object mini_window;
+{
+  register struct screen *s;
+
+  /* Choose the minibuffer window to use.  */
+  if (NULL (mini_window))
+    {
+      CHECK_SCREEN (Vglobal_minibuffer_screen, 0);
+      mini_window = XSCREEN (Vglobal_minibuffer_screen)->minibuffer_window;
+    }
+  else
+    {
+      CHECK_WINDOW (mini_window, 0);
+    }
+
+  /* Make a screen containing just a root window.  */
+  s = make_screen (0);
+
+  /* Install the chosen minibuffer window, with proper buffer.  */
+  s->minibuffer_window = mini_window;
+  Fset_window_buffer (mini_window,
+		      (NULL (Vminibuffer_list)
+		       ? get_minibuffer (0)
+		       : Fcar (Vminibuffer_list)));
+  return s;
+}
+
+/* Make a screen containing only a minibuffer window.  */
+
+struct screen *
+make_minibuffer_screen ()
+{
+  /* First make a screen containing just a root window, no minibuffer.  */
+
+  register struct screen *s = make_screen (0);
+  register Lisp_Object mini_window;
+  register Lisp_Object screen;
+
+  XSET (screen, Lisp_Screen, s);
+
+  /* ??? Perhaps leave it to the user program to set auto_raise.  */
+  s->auto_raise = 1;
+  s->auto_lower = 0;
+  s->no_split = 1;
+  s->wants_modeline = 0;
+  /* Note we leave has_minibuffer as 0.  This is a little strange.  */
+
+  /* Now label the root window as also being the minibuffer.
+     Avoid infinite looping on the window chain by marking next pointer
+     as nil. */
+
+  mini_window = s->minibuffer_window = s->root_window;
+  XWINDOW (mini_window)->mini_p = Qt;
+  XWINDOW (mini_window)->next = Qnil;
+  XWINDOW (mini_window)->prev = mini_window;
+  XWINDOW (mini_window)->screen = screen;
+
+  /* Put the proper buffer in that window.  */
+
+  Fset_window_buffer (mini_window,
+		      (NULL (Vminibuffer_list)
+		       ? get_minibuffer (0)
+		       : Fcar (Vminibuffer_list)));
+  return s;
+}
+
+/* Construct a screen that refers to the terminal (stdin and stdout).  */
+
+struct screen *
+make_terminal_screen ()
+{
+  register struct screen *s;
+
+  Vscreen_list = Qnil;
+  s = make_screen (1);
+  s->name = build_string ("terminal");
+  s->visible = 1;
+  s->display.nothing = 1;   /* Nonzero means screen isn't deleted.  */
+  XSET (Vterminal_screen, Lisp_Screen, s);
+  return s;
+}
+
+DEFUN ("select-screen", Fselect_screen, Sselect_screen, 1, 2, 0,
+  "Select the screen S.  S's selected window becomes \"the\"\n\
+selected window.  If the optional parameter NO-ENTER is non-nil, don't
+focus on that screen.")
+  (screen, no_enter)
+     Lisp_Object screen, no_enter;
+{
+  CHECK_SCREEN (screen, 0);
+
+  if (selected_screen == XSCREEN (screen))
+    return screen;
+
+  selected_screen = XSCREEN (screen);
+  Fselect_window (XSCREEN (screen)->selected_window);
+
+#ifdef HAVE_X_WINDOWS
+#ifdef MULTI_SCREEN
+  if (XSCREEN (screen)->output_method == output_x_window
+      && NULL (no_enter))
+    {
+      Ffocus_screen (screen);
+    }
+#endif
+#endif
+  choose_minibuf_screen ();
+
+  return screen;
+}
+
+DEFUN ("selected-screen", Fselected_screen, Sselected_screen, 0, 0, 0,
+  "Return the screen that is now selected.")
+  ()
+{
+  Lisp_Object tem;
+  XSET (tem, Lisp_Screen, selected_screen);
+  return tem;
+}
+
+DEFUN ("window-screen", Fwindow_screen, Swindow_screen, 1, 1, 0,
+  "Return the screen object that window WINDOW is on.")
+  (window)
+     Lisp_Object window;
+{
+  CHECK_WINDOW (window, 0);
+  return XWINDOW (window)->screen;
+}
+
+DEFUN ("screen-root-window", Fscreen_root_window, Sscreen_root_window, 0, 1, 0,
+       "Returns the root-window of SCREEN.")
+  (screen)
+     Lisp_Object screen;
+{
+  if (NULL (screen))
+    XSET (screen, Lisp_Screen, selected_screen);
+  CHECK_SCREEN (screen, 0);
+
+  return XSCREEN (screen)->root_window;
+}
+
+DEFUN ("screen-selected-window", Fscreen_selected_window,
+       Sscreen_selected_window, 0, 1, 0,
+  "Return the selected window of screen object SCREEN.")
+  (screen)
+     Lisp_Object screen;
+{
+  if (NULL (screen))
+    XSET (screen, Lisp_Screen, selected_screen);
+  CHECK_SCREEN (screen, 0);
+
+  return XSCREEN (screen)->selected_window;
+}
+
+DEFUN ("screen-list", Fscreen_list, Sscreen_list,
+       0, 0, 0,
+       "Return a list of all screens.")
+  ()
+{
+  return Fcopy_sequence (Vscreen_list);
+}
+
+#ifdef MULTI_SCREEN
+Lisp_Object
+next_screen (screen, mini_screen)
+     Lisp_Object screen;
+     int mini_screen;
+{
+  Lisp_Object tail;
+  int passed = 0;
+
+  while (1)
+    for (tail = Vscreen_list; CONSP (tail); tail = XCONS (tail)->cdr)
+      {
+	if (passed)
+	  if (!mini_screen
+	      && EQ (XCONS (tail)->car, Vglobal_minibuffer_screen))
+	    continue;
+	  else
+	    return XCONS (tail)->car;
+
+	if (EQ (screen, XCONS (tail)->car))
+	  passed++;
+      }
+}
+
+Lisp_Object
+prev_screen (screen, mini_screen)
+     Lisp_Object screen;
+     int mini_screen;
+{
+  Lisp_Object tail;
+  Lisp_Object prev;
+
+  prev = Qnil;
+  while (1)
+    for (tail = Vscreen_list; CONSP (tail); tail = XCONS (tail)->cdr)
+      {
+	if (EQ (screen, XCONS (tail)->car))
+	  {
+	    if (!NULL (prev) && (mini_screen
+				 || !EQ (XCONS (tail)->car,
+					 Vglobal_minibuffer_screen)))
+	      return prev;
+	  }
+	prev = XCONS (tail)->car;
+      }
+}
+
+DEFUN ("next-screen", Fnext_screen, Snext_screen,
+       0, 2, 0,
+       "Return the next screen in the screen list after SCREEN.\n\
+If MINISCREEN is non-nil, include the global-minibuffer-screen if it\n\
+has its own screen.")
+  (screen, miniscreen)
+Lisp_Object screen, miniscreen;
+{
+  Lisp_Object tail;
+
+  if (NULL (screen))
+    XSET (screen, Lisp_Screen, selected_screen);
+  CHECK_SCREEN (screen, 0);
+
+  return next_screen (screen, (NULL (miniscreen) ? 0 : 1));
+}
+#endif /* MULTI_SCREEN */
+
+DEFUN ("delete-screen", Fdelete_screen, Sdelete_screen,
+       0, 1, "",
+       "Delete SCREEN, permanently eliminating it from use.\n\
+Default is current screen.")
+  (screen)
+     Lisp_Object screen;
+{
+  struct screen *s;
+  union display displ;
+
+  if (EQ (screen, Qnil))
+    {
+      s = selected_screen;
+      XSET (screen, Lisp_Screen, s);
+    }
+  else
+    {
+      CHECK_SCREEN (screen, 0);
+      s = XSCREEN (screen);
+    }
+
+  /* Don't allow deleted screen to remain selected.  */
+  if (s == selected_screen)
+    {
+      Lisp_Object next;
+
+      next = next_screen (screen, 0);
+      if (EQ (next, screen))
+	error ("Attempt to delete the only screen");
+      Fselect_screen (next, Qnil);
+    }
+
+  /* Don't allow the global minibuffer screen to be deleted */
+  if (s == XSCREEN (Vglobal_minibuffer_screen))
+    error ("Attempt to delete the global minibuffer screen");
+
+  /* Don't allow minibuf_window to remain on a deleted screen.  */
+  if (EQ (s->minibuffer_window, minibuf_window))
+    {
+      Fset_window_buffer (selected_screen->minibuffer_window,
+			  XWINDOW (minibuf_window)->buffer);
+      minibuf_window = selected_screen->minibuffer_window;
+    }
+
+  Vscreen_list = Fdelq (screen, Vscreen_list);
+  s->visible = 0;
+  displ = s->display;
+  s->display.nothing = 0;
+
+  if (s->output_method == output_x_window)
+    x_destroy_window (s, displ);
+
+  return Qnil;
+}
+
+/* Return mouse position in character cell units.  */
+
+static
+read_mouse_position (screen, x, y)
+     Lisp_Object screen;
+     int *x, *y;
+{
+  CHECK_SCREEN (screen, 0);
+
+  *x = 1;
+  *y = 1;
+
+#ifdef HAVE_X_WINDOWS
+  if (XSCREEN (screen)->output_method == output_x_window)
+    x_read_mouse_position (XSCREEN (screen), x, y);
+#endif
+}
+
+DEFUN ("read-mouse-position", Fread_mouse_position, Sread_mouse_position, 1, 1, 0,
+  "Return a cons (x . y) which represents the position of the mouse.")
+  (screen)
+     Lisp_Object screen;
+{
+  int x, y;
+  struct screen *s;
+
+  CHECK_SCREEN (screen, 0);
+
+  read_mouse_position (screen, &x, &y);
+  return Fcons (make_number (x), make_number (y));
+}
+
+DEFUN ("set-mouse-position", Fset_mouse_position, Sset_mouse_position, 3, 3, 0,
+  "Move the mouse pointer to the center of cell (X,Y) in SCREEN.\n\
+WARNING:  If you use this under X, you should do unfocus-screen afterwards.")
+  (screen, x, y)
+     Lisp_Object screen, x, y;
+{
+  CHECK_SCREEN (screen, 0);
+  CHECK_NUMBER (x, 2);
+  CHECK_NUMBER (y, 1);
+
+#ifdef HAVE_X_WINDOWS
+  if (XSCREEN (screen)->output_method == output_x_window)
+    /* Warping the mouse will cause  enternotify and focus events. */
+    x_set_mouse_position (XSCREEN (screen), x, y);
+#endif
+
+  return Qnil;
+}
+
+#if 0
+/* ??? Can this be replaced with a Lisp function?
+   It is used in minibuf.c.  Can we get rid of that?  */
+
+DEFUN ("screen-configuration", Fscreen_configuration, Sscreen_configuration,
+       0, 0, 0,
+  "Return object describing current screen configuration.\n\
+The screen configuration is the current mouse position and selected screen.\n\
+This object can be given to `restore-screen-configuration'\n\
+to restore this screen configuration.")
+  ()
+{
+  int x, y;
+  Lisp_Object c, screen;
+  struct screen *s;
+  
+  c = Fmake_vector (make_number(3), Qnil);
+  XVECTOR (c)->contents[0] = screen = Fselected_screen();
+  read_mouse_position (screen, &x, &y);
+  XVECTOR (c)->contents[1] = make_number (x);
+  XVECTOR (c)->contents[2] = make_number (y);
+
+  return c;
+}
+
+DEFUN ("restore-screen-configuration", Frestore_screen_configuration,
+       Srestore_screen_configuration,
+       1, 1, 0,
+  "Restores screen configuration CONFIGURATION.")
+  (config)
+  Lisp_Object config;
+{
+  Lisp_Object x_pos, y_pos, screen;
+
+  CHECK_VECTOR (config, 0);
+  if (XVECTOR (config)->size != 3)
+    {
+      error ("Wrong size vector passed to restore-screen-configuration");
+    }
+  screen = XVECTOR (config)->contents[0];
+  CHECK_SCREEN (screen, 0);
+
+  Fselect_screen (screen, Qnil);
+
+#if 0
+  /* This seems to interfere with the screen selection mechanism. jla */
+  x_pos = XVECTOR (config)->contents[1];
+  y_pos = XVECTOR (config)->contents[2];
+  set_mouse_position (screen, XINT (x_pos), XINT (y_pos));
+#endif
+
+  return screen;
+}    
+#endif
+
+DEFUN ("make-screen-visible", Fmake_screen_visible, Smake_screen_visible,
+       1, 1, 0,
+  "Make the screen SCREEN visible (assuming it is an X-window).\n\
+Also raises the screen so that nothing obscures it.")
+  (screen)
+     Lisp_Object screen;
+{
+  CHECK_SCREEN (screen, 0);
+
+  if (XSCREEN (screen)->display.nothing == 0)
+    error ("Cannot make a dead screen object visible");
+
+  if (XSCREEN (screen)->output_method == output_x_window)
+    x_make_screen_visible (XSCREEN (screen));
+
+  return screen;
+}
+
+DEFUN ("make-screen-invisible", Fmake_screen_invisible, Smake_screen_invisible,
+       1, 1, 0,
+  "Make the screen SCREEN invisible (assuming it is an X-window).")
+  (screen)
+     Lisp_Object screen;
+{
+  CHECK_SCREEN (screen, 0);
+
+  if (XSCREEN (screen)->output_method == output_x_window)
+    x_make_screen_invisible (XSCREEN (screen));
+
+  return Qnil;
+}
+
+DEFUN ("iconify-screen", Ficonify_screen, Siconify_screen,
+       1, 1, 0,
+  "Make the screen SCREEN into an icon.")
+  (screen)
+     Lisp_Object screen;
+{
+  CHECK_SCREEN (screen, 0);
+
+  if (XSCREEN (screen)->display.nothing == 0)
+    error ("Cannot make a dead screen object iconified.");
+
+  if (XSCREEN (screen)->output_method == output_x_window)
+      x_iconify_screen (XSCREEN (screen));
+
+  return Qnil;
+}
+
+DEFUN ("deiconify-screen", Fdeiconify_screen, Sdeiconify_screen,
+       1, 1, 0,
+  "Open (de-iconify) the iconified screen SCREEN.")
+  (screen)
+     Lisp_Object screen;
+{
+  CHECK_SCREEN (screen, 0);
+
+  if (XSCREEN (screen)->display.nothing == 0)
+    error ("Cannot deiconify a dead screen object.");
+
+  if (XSCREEN (screen)->output_method == output_x_window)
+      x_make_screen_visible (XSCREEN (screen));
+
+  return screen;
+}
+
+DEFUN ("screen-visible-p", Fscreen_visible_p, Sscreen_visible_p,
+       1, 1, 0,
+       "Return t if SCREEN is now \"visible\" (actually in use for display).\n\
+A screen that is not \"visible\" is not updated and, if it works through\n\
+a window system, it may not show at all.\n\
+Return the symbol `icon' if window is visible only as an icon.")
+  (screen)
+     Lisp_Object screen;
+{
+  CHECK_SCREEN (screen, 0);
+
+  if (XSCREEN (screen)->visible)
+    return Qt;
+  if (XSCREEN (screen)->iconified)
+    return intern ("icon");
+  return Qnil;
+}
+
+DEFUN ("visible-screen-list", Fvisible_screen_list, Svisible_screen_list,
+       0, 0, 0,
+       "Return a list of all screens now \"visible\" (being updated).")
+  ()
+{
+  Lisp_Object tail, screen;
+  struct screen *s;
+  Lisp_Object value;
+
+  value = Qnil;
+  for (tail = Vscreen_list; CONSP (tail); tail = XCONS (tail)->cdr)
+    {
+      screen = XCONS (tail)->car;
+      if (XTYPE (screen) != Lisp_Screen)
+	continue;
+      s = XSCREEN (screen);
+      if (s->visible)
+	value = Fcons (screen, value);
+    }
+  return value;
+}
+
+Lisp_Object
+get_screen_param (screen, prop)
+     register struct screen *screen;
+     Lisp_Object prop;