Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Open sidebar
emacs
emacs
Commits
dc6f92b8
Commit
dc6f92b8
authored
May 25, 1991
by
Jim Blandy
Browse files
Initial revision
parent
ecca85de
Changes
2
Hide whitespace changes
Inline
Side-by-side
Showing
2 changed files
with
4854 additions
and
0 deletions
+4854
-0
src/frame.c
src/frame.c
+1056
-0
src/xterm.c
src/xterm.c
+3798
-0
No files found.
src/frame.c
0 → 100644
View file @
dc6f92b8
/* 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
;