Commit dc6f92b8 authored by Jim Blandy's avatar Jim Blandy
Browse files

Initial revision

parent ecca85de
/* 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;