#include <config.h>
#include <signal.h>
#include <stdio.h>
#include "termchar.h"
#include "termopts.h"
#include "lisp.h"
#include "termhooks.h"
#include "macros.h"
#include "keyboard.h"
#include "frame.h"
#include "window.h"
#include "commands.h"
#include "buffer.h"
#include "charset.h"
#include "disptab.h"
#include "dispextern.h"
#include "syntax.h"
#include "intervals.h"
#include "blockinput.h"
#include "puresize.h"
#include "systime.h"
#include "atimer.h"
#include <setjmp.h>
#include <errno.h>
#ifdef MSDOS
#include "msdos.h"
#include <time.h>
#else
#ifndef VMS
#include <sys/ioctl.h>
#endif
#endif
#include "syssignal.h"
#include "systty.h"
#include <sys/types.h>
#ifdef HAVE_UNISTD_H
#include <unistd.h>
#endif
#ifdef HAVE_X_WINDOWS
#include "xterm.h"
#endif
#ifdef HAVE_NTGUI
#include "w32term.h"
#endif
#ifdef macintosh
#include "macterm.h"
#endif
#include "systime.h"
#ifndef USE_CRT_DLL
extern int errno;
#endif
int interrupt_input_blocked;
int interrupt_input_pending;
extern int input_fd;
#ifdef HAVE_WINDOW_SYSTEM
#ifdef macintosh
#define KBD_BUFFER_SIZE 512
#else
#define KBD_BUFFER_SIZE 4096
#endif
#else
#define KBD_BUFFER_SIZE 4096
#endif
#define abs(x) ((x) >= 0 ? (x) : -(x))
struct backtrace
{
struct backtrace *next;
Lisp_Object *function;
Lisp_Object *args;
int nargs;
char evalargs;
};
#ifdef MULTI_KBOARD
KBOARD *initial_kboard;
KBOARD *current_kboard;
KBOARD *all_kboards;
int single_kboard;
#else
KBOARD the_only_kboard;
#endif
Lisp_Object Qdisabled, Qdisabled_command_hook;
#define NUM_RECENT_KEYS (100)
int recent_keys_index;
int total_keys;
Lisp_Object recent_keys;
Lisp_Object this_command_keys;
int this_command_key_count;
Lisp_Object raw_keybuf;
int raw_keybuf_count;
#define GROW_RAW_KEYBUF \
if (raw_keybuf_count == XVECTOR (raw_keybuf)->size) \
{ \
int newsize = 2 * XVECTOR (raw_keybuf)->size; \
Lisp_Object new; \
new = Fmake_vector (make_number (newsize), Qnil); \
bcopy (XVECTOR (raw_keybuf)->contents, XVECTOR (new)->contents, \
raw_keybuf_count * sizeof (Lisp_Object)); \
raw_keybuf = new; \
}
int this_single_command_key_start;
static int before_command_key_count;
static int before_command_echo_length;
static int before_command_key_count_1;
static int before_command_echo_length_1;
static int before_command_restore_flag;
extern int minbuf_level;
extern int message_enable_multibyte;
extern struct backtrace *backtrace_list;
Lisp_Object Vshow_help_function;
Lisp_Object Vpre_help_message;
static int menu_prompting;
static Lisp_Object menu_prompt_more_char;
static jmp_buf getcjmp;
int waiting_for_input;
int echoing;
static struct kboard *ok_to_echo_at_next_pause;
struct kboard *echo_kboard;
Lisp_Object echo_message_buffer;
static int inhibit_local_menu_bar_menus;
int immediate_quit;
Lisp_Object Vtty_erase_char;
Lisp_Object Vhelp_char;
Lisp_Object Vhelp_event_list;
Lisp_Object Vhelp_form;
Lisp_Object Vprefix_help_command;
Lisp_Object Vmenu_bar_final_items;
Lisp_Object Vsuggest_key_bindings;
Lisp_Object Vminibuffer_message_timeout;
int quit_char;
extern Lisp_Object current_global_map;
extern int minibuf_level;
Lisp_Object Voverriding_local_map;
Lisp_Object Voverriding_local_map_menu_flag;
Lisp_Object Vspecial_event_map;
int command_loop_level;
int num_input_keys;
Lisp_Object last_command_char;
Lisp_Object last_nonmenu_event;
Lisp_Object last_input_char;
Lisp_Object Vunread_command_events;
Lisp_Object Vunread_input_method_events;
Lisp_Object Vunread_post_input_method_events;
int unread_command_char;
Lisp_Object unread_switch_frame;
int extra_keyboard_modifiers;
Lisp_Object meta_prefix_char;
static int last_non_minibuf_size;
static Lisp_Object Vauto_save_timeout;
int num_input_events;
int num_nonmacro_input_events;
static int auto_save_interval;
int last_auto_save;
Lisp_Object Vthis_command;
Lisp_Object real_this_command;
int last_point_position;
Lisp_Object last_point_position_buffer;
Lisp_Object internal_last_event_frame;
Lisp_Object Vlast_event_frame;
unsigned long last_event_timestamp;
Lisp_Object Qself_insert_command;
Lisp_Object Qforward_char;
Lisp_Object Qbackward_char;
Lisp_Object Qundefined;
Lisp_Object Qtimer_event_handler;
Lisp_Object read_key_sequence_cmd;
Lisp_Object Vecho_keystrokes;
Lisp_Object Vtop_level;
Lisp_Object Vkeyboard_translate_table;
extern Lisp_Object Vfunction_key_map;
extern Lisp_Object Vkey_translation_map;
Lisp_Object Vinput_method_function;
Lisp_Object Qinput_method_function;
Lisp_Object Vinput_method_previous_message;
Lisp_Object Vdeactivate_mark;
Lisp_Object Vlucid_menu_bar_dirty_flag;
Lisp_Object Qrecompute_lucid_menubar, Qactivate_menubar_hook;
Lisp_Object Qecho_area_clear_hook;
Lisp_Object Qpre_command_hook, Vpre_command_hook;
Lisp_Object Qpost_command_hook, Vpost_command_hook;
Lisp_Object Qcommand_hook_internal, Vcommand_hook_internal;
Lisp_Object Qpost_command_idle_hook, Vpost_command_idle_hook;
int post_command_idle_delay;
Lisp_Object Vdeferred_action_list;
Lisp_Object Vdeferred_action_function;
Lisp_Object Qdeferred_action_function;
Lisp_Object Qinput_method_exit_on_first_char;
Lisp_Object Qinput_method_use_echo_area;
FILE *dribble;
int input_pending;
int meta_key;
int update_menu_bindings;
extern char *pending_malloc_warning;
static struct input_event kbd_buffer[KBD_BUFFER_SIZE];
static Lisp_Object kbd_buffer_gcpro;
static struct input_event *kbd_fetch_ptr;
static struct input_event * volatile kbd_store_ptr;
Lisp_Object do_mouse_tracking;
Lisp_Object Qmouse_movement;
Lisp_Object Qscroll_bar_movement;
Lisp_Object Qswitch_frame;
Lisp_Object Qdelete_frame;
Lisp_Object Qiconify_frame;
Lisp_Object Qmake_frame_visible;
Lisp_Object Qhelp_echo;
Lisp_Object Qfunction_key;
Lisp_Object Qmouse_click;
#ifdef WINDOWSNT
Lisp_Object Qmouse_wheel;
Lisp_Object Qlanguage_change;
#endif
Lisp_Object Qdrag_n_drop;
Lisp_Object Qevent_kind;
Lisp_Object Qevent_symbol_elements;
Lisp_Object Qmenu_alias;
Lisp_Object Qmenu_enable;
Lisp_Object QCenable, QCvisible, QChelp, QCfilter, QCkeys, QCkey_sequence;
Lisp_Object QCbutton, QCtoggle, QCradio;
extern Lisp_Object Vdefine_key_rebound_commands;
extern Lisp_Object Qmenu_item;
Lisp_Object Qevent_symbol_element_mask;
Lisp_Object Qmodifier_cache;
Lisp_Object Qmode_line;
Lisp_Object Qvertical_line;
Lisp_Object Qvertical_scroll_bar;
Lisp_Object Qmenu_bar;
Lisp_Object recursive_edit_unwind (), command_loop ();
Lisp_Object Fthis_command_keys ();
Lisp_Object Qextended_command_history;
EMACS_TIME timer_check ();
extern Lisp_Object Vhistory_length;
extern char *x_get_keysym_name ();
static void record_menu_key ();
Lisp_Object Qpolling_period;
Lisp_Object Vtimer_list;
Lisp_Object Vtimer_idle_list;
int timers_run;
extern Lisp_Object Vprint_level, Vprint_length;
EMACS_TIME *input_available_clear_time;
int interrupt_input;
int interrupts_deferred;
int flow_control;
#ifdef BROKEN_FIONREAD
#undef FIONREAD
#endif
#ifndef FIONREAD
#ifdef SIGIO
#undef SIGIO
#endif
#endif
#ifdef HAVE_WINDOW_SYSTEM
#define POLL_FOR_INPUT
#endif
Lisp_Object Vdisable_point_adjustment;
Lisp_Object Vglobal_disable_point_adjustment;
static EMACS_TIME timer_idleness_start_time;
void (*keyboard_init_hook) ();
static int read_avail_input P_ ((int));
static void get_input_pending P_ ((int *, int));
static int readable_events P_ ((int));
static Lisp_Object read_char_x_menu_prompt P_ ((int, Lisp_Object *,
Lisp_Object, int *));
static Lisp_Object read_char_x_menu_prompt ();
static Lisp_Object read_char_minibuf_menu_prompt P_ ((int, int,
Lisp_Object *));
static Lisp_Object make_lispy_event P_ ((struct input_event *));
#ifdef HAVE_MOUSE
static Lisp_Object make_lispy_movement P_ ((struct frame *, Lisp_Object,
enum scroll_bar_part,
Lisp_Object, Lisp_Object,
unsigned long));
#endif
static Lisp_Object modify_event_symbol P_ ((int, unsigned, Lisp_Object,
Lisp_Object, char **,
Lisp_Object *, unsigned));
static Lisp_Object make_lispy_switch_frame P_ ((Lisp_Object));
static int parse_solitary_modifier P_ ((Lisp_Object));
static int parse_solitary_modifier ();
static void save_getcjmp P_ ((jmp_buf));
static void save_getcjmp ();
static void restore_getcjmp P_ ((jmp_buf));
static Lisp_Object apply_modifiers P_ ((int, Lisp_Object));
static void clear_event P_ ((struct input_event *));
static void any_kboard_state P_ ((void));
static int cannot_suspend;
#define min(a,b) ((a)<(b)?(a):(b))
#define max(a,b) ((a)>(b)?(a):(b))
void
echo_prompt (str)
Lisp_Object str;
{
int nbytes = STRING_BYTES (XSTRING (str));
int multibyte_p = STRING_MULTIBYTE (str);
if (nbytes > ECHOBUFSIZE - 4)
{
if (multibyte_p)
{
unsigned char *p = XSTRING (str)->data;
unsigned char *pend = p + ECHOBUFSIZE - 4;
int char_len;
do
{
PARSE_MULTIBYTE_SEQ (p, pend - p, char_len);
p += char_len;
}
while (p < pend);
nbytes = p - XSTRING (str)->data - char_len;
}
else
nbytes = ECHOBUFSIZE - 4;
}
nbytes = copy_text (XSTRING (str)->data, current_kboard->echobuf, nbytes,
STRING_MULTIBYTE (str), 1);
current_kboard->echoptr = current_kboard->echobuf + nbytes;
*current_kboard->echoptr = '\0';
current_kboard->echo_after_prompt = nbytes;
echo_now ();
}
void
echo_char (c)
Lisp_Object c;
{
if (current_kboard->immediate_echo)
{
char *ptr = current_kboard->echoptr;
if (ptr != current_kboard->echobuf)
*ptr++ = ' ';
c = EVENT_HEAD (c);
if (INTEGERP (c))
{
int ch = XINT (c);
if (ptr - current_kboard->echobuf
> ECHOBUFSIZE - KEY_DESCRIPTION_SIZE)
return;
ptr = push_key_description (ch, ptr, 1);
}
else if (SYMBOLP (c))
{
struct Lisp_String *name = XSYMBOL (c)->name;
if ((ptr - current_kboard->echobuf) + STRING_BYTES (name) + 4
> ECHOBUFSIZE)
return;
ptr += copy_text (name->data, ptr, STRING_BYTES (name),
name->size_byte >= 0, 1);
}
if (current_kboard->echoptr == current_kboard->echobuf
&& help_char_p (c))
{
strcpy (ptr, " (Type ? for further options)");
ptr += strlen (ptr);
}
*ptr = 0;
current_kboard->echoptr = ptr;
echo_now ();
}
}
void
echo_dash ()
{
if (!current_kboard->immediate_echo
&& current_kboard->echoptr == current_kboard->echobuf)
return;
if (current_kboard->echo_after_prompt
== current_kboard->echoptr - current_kboard->echobuf)
return;
if (current_kboard->echoptr == 0)
return;
current_kboard->echoptr[0] = '-';
current_kboard->echoptr[1] = 0;
echo_now ();
}
void
echo_now ()
{
if (!current_kboard->immediate_echo)
{
int i;
current_kboard->immediate_echo = 1;
for (i = 0; i < this_command_key_count; i++)
{
Lisp_Object c;
c = XVECTOR (this_command_keys)->contents[i];
if (! (EVENT_HAS_PARAMETERS (c)
&& EQ (EVENT_HEAD_KIND (EVENT_HEAD (c)), Qmouse_movement)))
echo_char (c);
}
echo_dash ();
}
echoing = 1;
message2_nolog (current_kboard->echobuf, strlen (current_kboard->echobuf),
1);
echoing = 0;
echo_message_buffer = echo_area_buffer[0];
echo_kboard = current_kboard;
if (waiting_for_input && !NILP (Vquit_flag))
quit_throw_to_read_char ();
}
void
cancel_echoing ()
{
current_kboard->immediate_echo = 0;
current_kboard->echoptr = current_kboard->echobuf;
current_kboard->echo_after_prompt = -1;
ok_to_echo_at_next_pause = NULL;
echo_kboard = NULL;
echo_message_buffer = Qnil;
}
static int
echo_length ()
{
return current_kboard->echoptr - current_kboard->echobuf;
}
static void
echo_truncate (len)
int len;
{
current_kboard->echobuf[len] = '\0';
current_kboard->echoptr = current_kboard->echobuf + len;
truncate_echo_area (len);
}
static void
add_command_key (key)
Lisp_Object key;
{
if (before_command_restore_flag)
{
this_command_key_count = before_command_key_count_1;
if (this_command_key_count < this_single_command_key_start)
this_single_command_key_start = this_command_key_count;
echo_truncate (before_command_echo_length_1);
before_command_restore_flag = 0;
}
if (this_command_key_count >= ASIZE (this_command_keys))
this_command_keys = larger_vector (this_command_keys,
2 * ASIZE (this_command_keys),
Qnil);
AREF (this_command_keys, this_command_key_count) = key;
++this_command_key_count;
}
Lisp_Object
recursive_edit_1 ()
{
int count = specpdl_ptr - specpdl;
Lisp_Object val;
if (command_loop_level > 0)
{
specbind (Qstandard_output, Qt);
specbind (Qstandard_input, Qt);
}
#ifdef HAVE_X_WINDOWS
if (display_hourglass_p)
cancel_hourglass ();
#endif
specbind (Qinhibit_redisplay, Qnil);
redisplaying_p = 0;
val = command_loop ();
if (EQ (val, Qt))
Fsignal (Qquit, Qnil);
if (STRINGP (val))
Fsignal (Qerror, Fcons (val, Qnil));
return unbind_to (count, Qnil);
}
void
record_auto_save ()
{
last_auto_save = num_nonmacro_input_events;
}
void
force_auto_save_soon ()
{
last_auto_save = - auto_save_interval - 1;
record_asynch_buffer_change ();
}
DEFUN ("recursive-edit", Frecursive_edit, Srecursive_edit, 0, 0, "",
"Invoke the editor command loop recursively.\n\
To get out of the recursive edit, a command can do `(throw 'exit nil)';\n\
that tells this function to return.\n\
Alternately, `(throw 'exit t)' makes this function signal an error.\n\
This function is called by the editor initialization to begin editing.")
()
{
int count = specpdl_ptr - specpdl;
Lisp_Object buffer;
command_loop_level++;
update_mode_lines = 1;
if (command_loop_level
&& current_buffer != XBUFFER (XWINDOW (selected_window)->buffer))
buffer = Fcurrent_buffer ();
else
buffer = Qnil;
record_unwind_protect (recursive_edit_unwind,
Fcons (buffer, single_kboard ? Qt : Qnil));
recursive_edit_1 ();
return unbind_to (count, Qnil);
}
Lisp_Object
recursive_edit_unwind (info)
Lisp_Object info;
{
if (BUFFERP (XCAR (info)))
Fset_buffer (XCAR (info));
if (NILP (XCDR (info)))
any_kboard_state ();
else
single_kboard_state ();
command_loop_level--;
update_mode_lines = 1;
return Qnil;
}
static void
any_kboard_state ()
{
#ifdef MULTI_KBOARD
#if 0
if (CONSP (Vunread_command_events))
{
current_kboard->kbd_queue
= nconc2 (Vunread_command_events, current_kboard->kbd_queue);
current_kboard->kbd_queue_has_data = 1;
}
Vunread_command_events = Qnil;
#endif
single_kboard = 0;
#endif
}
void
single_kboard_state ()
{
#ifdef MULTI_KBOARD
single_kboard = 1;
#endif
}
struct kboard_stack
{
KBOARD *kboard;
struct kboard_stack *next;
};
static struct kboard_stack *kboard_stack;
void
push_frame_kboard (f)
FRAME_PTR f;
{
#ifdef MULTI_KBOARD
struct kboard_stack *p
= (struct kboard_stack *) xmalloc (sizeof (struct kboard_stack));
p->next = kboard_stack;
p->kboard = current_kboard;
kboard_stack = p;
current_kboard = FRAME_KBOARD (f);
#endif
}
void
pop_frame_kboard ()
{
#ifdef MULTI_KBOARD
struct kboard_stack *p = kboard_stack;
current_kboard = p->kboard;
kboard_stack = p->next;
xfree (p);
#endif
}
Lisp_Object
cmd_error (data)
Lisp_Object data;
{
Lisp_Object old_level, old_length;
char macroerror[50];
if (!NILP (executing_macro))
{
if (executing_macro_iterations == 1)
sprintf (macroerror, "After 1 kbd macro iteration: ");
else
sprintf (macroerror, "After %d kbd macro iterations: ",
executing_macro_iterations);
}
else
*macroerror = 0;
Vstandard_output = Qt;
Vstandard_input = Qt;
Vexecuting_macro = Qnil;
executing_macro = Qnil;
current_kboard->Vprefix_arg = Qnil;
current_kboard->Vlast_prefix_arg = Qnil;
cancel_echoing ();
old_level = Vprint_level;
old_length = Vprint_length;
XSETFASTINT (Vprint_level, 10);
XSETFASTINT (Vprint_length, 10);
cmd_error_internal (data, macroerror);
Vprint_level = old_level;
Vprint_length = old_length;
Vquit_flag = Qnil;
Vinhibit_quit = Qnil;
#ifdef MULTI_KBOARD
any_kboard_state ();
#endif
return make_number (0);
}
void
cmd_error_internal (data, context)
Lisp_Object data;
char *context;
{
Lisp_Object stream;
int kill_emacs_p = 0;
struct frame *sf = SELECTED_FRAME ();
Vquit_flag = Qnil;
Vinhibit_quit = Qt;
clear_message (1, 0);
if (!sf->glyphs_initialized_p
|| (!NILP (Vwindow_system)
&& !inhibit_window_system
&& FRAME_TERMCAP_P (sf))
|| noninteractive)
{
stream = Qexternal_debugging_output;
kill_emacs_p = 1;
}
else
{
Fdiscard_input ();
bitch_at_user ();
stream = Qt;
}
if (context != 0)
write_string_1 (context, -1, stream);
print_error_message (data, stream);
if (kill_emacs_p)
{
Fterpri (stream);
Fkill_emacs (make_number (-1));
}
}
Lisp_Object command_loop_1 ();
Lisp_Object command_loop_2 ();
Lisp_Object top_level_1 ();
Lisp_Object
command_loop ()
{
if (command_loop_level > 0 || minibuf_level > 0)
{
Lisp_Object val;
val = internal_catch (Qexit, command_loop_2, Qnil);
executing_macro = Qnil;
return val;
}
else
while (1)
{
internal_catch (Qtop_level, top_level_1, Qnil);
internal_catch (Qtop_level, command_loop_2, Qnil);
executing_macro = Qnil;
if (noninteractive)
Fkill_emacs (Qt);
}
}
Lisp_Object
command_loop_2 ()
{
register Lisp_Object val;
do
val = internal_condition_case (command_loop_1, Qerror, cmd_error);
while (!NILP (val));
return Qnil;
}
Lisp_Object
top_level_2 ()
{
return Feval (Vtop_level);
}
Lisp_Object
top_level_1 ()
{
if (!NILP (Vtop_level))
internal_condition_case (top_level_2, Qerror, cmd_error);
else if (!NILP (Vpurify_flag))
message ("Bare impure Emacs (standard Lisp code not loaded)");
else
message ("Bare Emacs (standard Lisp code not loaded)");
return Qnil;
}
DEFUN ("top-level", Ftop_level, Stop_level, 0, 0, "",
"Exit all recursive editing levels.")
()
{
#ifdef HAVE_X_WINDOWS
if (display_hourglass_p)
cancel_hourglass ();
#endif
return Fthrow (Qtop_level, Qnil);
}
DEFUN ("exit-recursive-edit", Fexit_recursive_edit, Sexit_recursive_edit, 0, 0, "",
"Exit from the innermost recursive edit or minibuffer.")
()
{
if (command_loop_level > 0 || minibuf_level > 0)
Fthrow (Qexit, Qnil);
error ("No recursive edit is in progress");
return Qnil;
}
DEFUN ("abort-recursive-edit", Fabort_recursive_edit, Sabort_recursive_edit, 0, 0, "",
"Abort the command that requested this recursive edit or minibuffer input.")
()
{
if (command_loop_level > 0 || minibuf_level > 0)
Fthrow (Qexit, Qt);
error ("No recursive edit is in progress");
return Qnil;
}
EXFUN (Fcommand_execute, 4);
static int read_key_sequence P_ ((Lisp_Object *, int, Lisp_Object,
int, int, int));
void safe_run_hooks P_ ((Lisp_Object));
static void adjust_point_for_property P_ ((int));
Lisp_Object
command_loop_1 ()
{
Lisp_Object cmd;
int lose;
int nonundocount;
Lisp_Object keybuf[30];
int i;
int no_direct;
int prev_modiff;
struct buffer *prev_buffer = NULL;
#ifdef MULTI_KBOARD
int was_locked = single_kboard;
#endif
current_kboard->Vprefix_arg = Qnil;
current_kboard->Vlast_prefix_arg = Qnil;
Vdeactivate_mark = Qnil;
waiting_for_input = 0;
cancel_echoing ();
nonundocount = 0;
this_command_key_count = 0;
this_single_command_key_start = 0;
if (!NILP (Vpost_command_hook) && !NILP (Vrun_hooks))
safe_run_hooks (Qpost_command_hook);
if (!NILP (echo_area_buffer[0]))
resize_echo_area_exactly ();
if (!NILP (Vdeferred_action_list))
call0 (Vdeferred_action_function);
if (!NILP (Vpost_command_idle_hook) && !NILP (Vrun_hooks))
{
if (NILP (Vunread_command_events)
&& NILP (Vunread_input_method_events)
&& NILP (Vunread_post_input_method_events)
&& NILP (Vexecuting_macro)
&& !NILP (sit_for (0, post_command_idle_delay, 0, 1, 1)))
safe_run_hooks (Qpost_command_idle_hook);
}
current_kboard->Vlast_command = Vthis_command;
current_kboard->Vreal_last_command = real_this_command;
while (1)
{
if (! FRAME_LIVE_P (XFRAME (selected_frame)))
Fkill_emacs (Qnil);
if (XBUFFER (XWINDOW (selected_window)->buffer) != current_buffer)
set_buffer_internal (XBUFFER (XWINDOW (selected_window)->buffer));
while (pending_malloc_warning)
display_malloc_warning ();
no_direct = 0;
Vdeactivate_mark = Qnil;
if (minibuf_level
&& !NILP (echo_area_buffer[0])
&& EQ (minibuf_window, echo_area_window)
&& NUMBERP (Vminibuffer_message_timeout))
{
int count = specpdl_ptr - specpdl;
specbind (Qinhibit_quit, Qt);
Fsit_for (Vminibuffer_message_timeout, Qnil, Qnil);
message2 (0, 0, 0);
safe_run_hooks (Qecho_area_clear_hook);
unbind_to (count, Qnil);
if (!NILP (Vquit_flag))
{
Vquit_flag = Qnil;
Vunread_command_events = Fcons (make_number (quit_char), Qnil);
}
}
#ifdef C_ALLOCA
alloca (0);
#endif
#if 0
if (FRAMEP (internal_last_event_frame)
&& !EQ (internal_last_event_frame, selected_frame))
Fselect_frame (internal_last_event_frame, Qnil);
#endif
if (! NILP (Vlucid_menu_bar_dirty_flag)
&& !NILP (Ffboundp (Qrecompute_lucid_menubar)))
call0 (Qrecompute_lucid_menubar);
before_command_key_count = this_command_key_count;
before_command_echo_length = echo_length ();
Vthis_command = Qnil;
real_this_command = Qnil;
i = read_key_sequence (keybuf, sizeof keybuf / sizeof keybuf[0],
Qnil, 0, 1, 1);
if (! FRAME_LIVE_P (XFRAME (selected_frame)))
Fkill_emacs (Qnil);
if (XBUFFER (XWINDOW (selected_window)->buffer) != current_buffer)
set_buffer_internal (XBUFFER (XWINDOW (selected_window)->buffer));
++num_input_keys;
if (i == 0)
return Qnil;
if (i == -1)
{
cancel_echoing ();
this_command_key_count = 0;
this_single_command_key_start = 0;
goto finalize;
}
last_command_char = keybuf[i - 1];
if (!NILP (XWINDOW (selected_window)->force_start))
{
struct buffer *b;
XWINDOW (selected_window)->force_start = Qnil;
b = XBUFFER (XWINDOW (selected_window)->buffer);
BUF_BEG_UNCHANGED (b) = BUF_END_UNCHANGED (b) = 0;
}
cmd = read_key_sequence_cmd;
if (!NILP (Vexecuting_macro))
{
if (!NILP (Vquit_flag))
{
Vexecuting_macro = Qt;
QUIT;
}
}
prev_buffer = current_buffer;
prev_modiff = MODIFF;
last_point_position = PT;
XSETBUFFER (last_point_position_buffer, prev_buffer);
Vdisable_point_adjustment = Qnil;
Vdeactivate_mark = Qnil;
Vthis_command = cmd;
real_this_command = cmd;
if (!NILP (Vpre_command_hook) && !NILP (Vrun_hooks))
safe_run_hooks (Qpre_command_hook);
if (NILP (Vthis_command))
{
bitch_at_user ();
current_kboard->defining_kbd_macro = Qnil;
update_mode_lines = 1;
current_kboard->Vprefix_arg = Qnil;
}
else
{
if (NILP (current_kboard->Vprefix_arg) && ! no_direct)
{
Vcurrent_prefix_arg = current_kboard->Vprefix_arg;
if (EQ (Vthis_command, Qforward_char) && PT < ZV)
{
struct Lisp_Char_Table *dp
= window_display_table (XWINDOW (selected_window));
lose = FETCH_CHAR (PT_BYTE);
SET_PT (PT + 1);
if ((dp
? (VECTORP (DISP_CHAR_VECTOR (dp, lose))
? XVECTOR (DISP_CHAR_VECTOR (dp, lose))->size == 1
: (NILP (DISP_CHAR_VECTOR (dp, lose))
&& (lose >= 0x20 && lose < 0x7f)))
: (lose >= 0x20 && lose < 0x7f))
&& (WIDTH_BY_CHAR_HEAD (FETCH_BYTE (PT_BYTE)) == 1)
&& (XFASTINT (XWINDOW (selected_window)->last_modified)
>= MODIFF)
&& (XFASTINT (XWINDOW (selected_window)->last_overlay_modified)
>= OVERLAY_MODIFF)
&& (XFASTINT (XWINDOW (selected_window)->last_point)
== PT - 1)
&& !windows_or_buffers_changed
&& EQ (current_buffer->selective_display, Qnil)
&& !detect_input_pending ()
&& NILP (XWINDOW (selected_window)->column_number_displayed)
&& NILP (Vexecuting_macro))
direct_output_forward_char (1);
goto directly_done;
}
else if (EQ (Vthis_command, Qbackward_char) && PT > BEGV)
{
struct Lisp_Char_Table *dp
= window_display_table (XWINDOW (selected_window));
SET_PT (PT - 1);
lose = FETCH_CHAR (PT_BYTE);
if ((dp
? (VECTORP (DISP_CHAR_VECTOR (dp, lose))
? XVECTOR (DISP_CHAR_VECTOR (dp, lose))->size == 1
: (NILP (DISP_CHAR_VECTOR (dp, lose))
&& (lose >= 0x20 && lose < 0x7f)))
: (lose >= 0x20 && lose < 0x7f))
&& (XFASTINT (XWINDOW (selected_window)->last_modified)
>= MODIFF)
&& (XFASTINT (XWINDOW (selected_window)->last_overlay_modified)
>= OVERLAY_MODIFF)
&& (XFASTINT (XWINDOW (selected_window)->last_point)
== PT + 1)
&& !windows_or_buffers_changed
&& EQ (current_buffer->selective_display, Qnil)
&& !detect_input_pending ()
&& NILP (XWINDOW (selected_window)->column_number_displayed)
&& NILP (Vexecuting_macro))
direct_output_forward_char (-1);
goto directly_done;
}
else if (EQ (Vthis_command, Qself_insert_command)
&& INTEGERP (last_command_char))
{
unsigned int c = XINT (last_command_char);
int value;
if (NILP (Vexecuting_macro)
&& !EQ (minibuf_window, selected_window))
{
if (!nonundocount || nonundocount >= 20)
{
Fundo_boundary ();
nonundocount = 0;
}
nonundocount++;
}
lose = ((XFASTINT (XWINDOW (selected_window)->last_modified)
< MODIFF)
|| (XFASTINT (XWINDOW (selected_window)->last_overlay_modified)
< OVERLAY_MODIFF)
|| (XFASTINT (XWINDOW (selected_window)->last_point)
!= PT)
|| MODIFF <= SAVE_MODIFF
|| windows_or_buffers_changed
|| !EQ (current_buffer->selective_display, Qnil)
|| detect_input_pending ()
|| !NILP (XWINDOW (selected_window)->column_number_displayed)
|| !NILP (Vexecuting_macro));
value = internal_self_insert (c, 0);
if (value == 2)
nonundocount = 0;
if (!lose && !value)
direct_output_for_insert (c);
goto directly_done;
}
}
#ifdef HAVE_X_WINDOWS
if (display_hourglass_p)
start_hourglass ();
#endif
nonundocount = 0;
if (NILP (current_kboard->Vprefix_arg))
Fundo_boundary ();
Fcommand_execute (Vthis_command, Qnil, Qnil, Qnil);
#ifdef HAVE_X_WINDOWS
if (display_hourglass_p)
cancel_hourglass ();
#endif
}
directly_done: ;
current_kboard->Vlast_prefix_arg = Vcurrent_prefix_arg;
if (!NILP (Vpost_command_hook) && !NILP (Vrun_hooks))
safe_run_hooks (Qpost_command_hook);
if (!NILP (echo_area_buffer[0]))
resize_echo_area_exactly ();
if (!NILP (Vdeferred_action_list))
safe_run_hooks (Qdeferred_action_function);
if (!NILP (Vpost_command_idle_hook) && !NILP (Vrun_hooks))
{
if (NILP (Vunread_command_events)
&& NILP (Vunread_input_method_events)
&& NILP (Vunread_post_input_method_events)
&& NILP (Vexecuting_macro)
&& !NILP (sit_for (0, post_command_idle_delay, 0, 1, 1)))
safe_run_hooks (Qpost_command_idle_hook);
}
if (NILP (current_kboard->Vprefix_arg) || CONSP (last_command_char))
{
current_kboard->Vlast_command = Vthis_command;
current_kboard->Vreal_last_command = real_this_command;
cancel_echoing ();
this_command_key_count = 0;
this_single_command_key_start = 0;
}
if (!NILP (current_buffer->mark_active) && !NILP (Vrun_hooks))
{
if (!NILP (Vdeactivate_mark) && !NILP (Vtransient_mark_mode))
{
current_buffer->mark_active = Qnil;
call1 (Vrun_hooks, intern ("deactivate-mark-hook"));
}
else if (current_buffer != prev_buffer || MODIFF != prev_modiff)
call1 (Vrun_hooks, intern ("activate-mark-hook"));
}
finalize:
if (current_buffer == prev_buffer
&& last_point_position != PT
&& NILP (Vdisable_point_adjustment)
&& NILP (Vglobal_disable_point_adjustment))
adjust_point_for_property (last_point_position);
if (!NILP (current_kboard->defining_kbd_macro)
&& NILP (current_kboard->Vprefix_arg))
finalize_kbd_macro_chars ();
#ifdef MULTI_KBOARD
if (!was_locked)
any_kboard_state ();
#endif
}
}
extern Lisp_Object Qcomposition, Qdisplay;
static void
adjust_point_for_property (last_pt)
int last_pt;
{
int start, end;
Lisp_Object val;
int check_composition = 1, check_display = 1;
while (check_composition || check_display)
{
if (check_composition
&& PT > BEGV && PT < ZV
&& get_property_and_range (PT, Qcomposition, &val, &start, &end, Qnil)
&& COMPOSITION_VALID_P (start, end, val)
&& start < PT && end > PT
&& (last_pt <= start || last_pt >= end))
{
if (PT < last_pt)
SET_PT (start);
else
SET_PT (end);
check_display = 1;
}
check_composition = 0;
if (check_display
&& PT > BEGV && PT < ZV
&& get_property_and_range (PT, Qdisplay, &val, &start, &end, Qnil)
&& display_prop_intangible_p (val)
&& start < PT && end > PT
&& (last_pt <= start || last_pt >= end))
{
if (PT < last_pt)
SET_PT (start);
else
SET_PT (end);
check_composition = 1;
}
check_display = 0;
}
}
static Lisp_Object
safe_run_hooks_1 (hook)
Lisp_Object hook;
{
return call1 (Vrun_hooks, Vinhibit_quit);
}
static Lisp_Object
safe_run_hooks_error (data)
Lisp_Object data;
{
return Fset (Vinhibit_quit, Qnil);
}
void
safe_run_hooks (hook)
Lisp_Object hook;
{
int count = specpdl_ptr - specpdl;
specbind (Qinhibit_quit, hook);
internal_condition_case (safe_run_hooks_1, Qt, safe_run_hooks_error);
unbind_to (count, Qnil);
}
int polling_period;
int poll_suppress_count;
struct atimer *poll_timer;
#ifdef POLL_FOR_INPUT
void
poll_for_input_1 ()
{
if (interrupt_input_blocked == 0
&& !waiting_for_input)
read_avail_input (0);
}
void
poll_for_input (timer)
struct atimer *timer;
{
if (poll_suppress_count == 0)
poll_for_input_1 ();
}
#endif
void
start_polling ()
{
#ifdef POLL_FOR_INPUT
if (read_socket_hook && !interrupt_input)
{
turn_on_atimers (1);
if (poll_timer == NULL
|| EMACS_SECS (poll_timer->interval) != polling_period)
{
EMACS_TIME interval;
if (poll_timer)
cancel_atimer (poll_timer);
EMACS_SET_SECS_USECS (interval, polling_period, 0);
poll_timer = start_atimer (ATIMER_CONTINUOUS, interval,
poll_for_input, NULL);
}
--poll_suppress_count;
}
#endif
}
int
input_polling_used ()
{
#ifdef POLL_FOR_INPUT
return read_socket_hook && !interrupt_input;
#else
return 0;
#endif
}
void
stop_polling ()
{
#ifdef POLL_FOR_INPUT
if (read_socket_hook && !interrupt_input)
++poll_suppress_count;
#endif
}
void
set_poll_suppress_count (count)
int count;
{
#ifdef POLL_FOR_INPUT
if (count == 0 && poll_suppress_count != 0)
{
poll_suppress_count = 1;
start_polling ();
}
else if (count != 0 && poll_suppress_count == 0)
{
stop_polling ();
}
poll_suppress_count = count;
#endif
}
void
bind_polling_period (n)
int n;
{
#ifdef POLL_FOR_INPUT
int new = polling_period;
if (n > new)
new = n;
stop_other_atimers (poll_timer);
stop_polling ();
specbind (Qpolling_period, make_number (new));
start_polling ();
#endif
}
int
make_ctrl_char (c)
int c;
{
int upper = c & ~0177;
c &= 0177;
if (c >= 0100 && c < 0140)
{
int oc = c;
c &= ~0140;
if (oc >= 'A' && oc <= 'Z')
c |= shift_modifier;
}
else if (c >= 'a' && c <= 'z')
c &= ~0140;
else if (c >= ' ')
c |= ctrl_modifier;
c |= (upper & ~ctrl_modifier);
return c;
}
void
show_help_echo (help, window, object, pos, ok_to_overwrite_keystroke_echo)
Lisp_Object help, window, object, pos;
int ok_to_overwrite_keystroke_echo;
{
if (!NILP (help) && !STRINGP (help))
{
if (FUNCTIONP (help))
{
Lisp_Object args[4];
args[0] = help;
args[1] = window;
args[2] = object;
args[3] = pos;
help = safe_call (4, args);
}
else
help = safe_eval (help);
if (!STRINGP (help))
return;
}
if (STRINGP (help) || NILP (help))
{
if (!NILP (Vshow_help_function))
call1 (Vshow_help_function, help);
else if (
!MINI_WINDOW_P (XWINDOW (selected_window))
&& (NILP (echo_message_buffer)
|| ok_to_overwrite_keystroke_echo)
&& !cursor_in_echo_area)
{
if (STRINGP (help))
{
int count = BINDING_STACK_SIZE ();
if (!help_echo_showing_p)
Vpre_help_message = current_message ();
specbind (Qmessage_truncate_lines, Qt);
message3_nolog (help, STRING_BYTES (XSTRING (help)),
STRING_MULTIBYTE (help));
unbind_to (count, Qnil);
}
else if (STRINGP (Vpre_help_message))
{
message3_nolog (Vpre_help_message,
STRING_BYTES (XSTRING (Vpre_help_message)),
STRING_MULTIBYTE (Vpre_help_message));
Vpre_help_message = Qnil;
}
else
message (0);
}
help_echo_showing_p = STRINGP (help);
}
}
Lisp_Object print_help ();
static Lisp_Object kbd_buffer_get_event ();
static void record_char ();
#ifdef MULTI_KBOARD
static jmp_buf wrong_kboard_jmpbuf;
#endif
Lisp_Object
read_char (commandflag, nmaps, maps, prev_event, used_mouse_menu)
int commandflag;
int nmaps;
Lisp_Object *maps;
Lisp_Object prev_event;
int *used_mouse_menu;
{
volatile Lisp_Object c;
int count;
jmp_buf local_getcjmp;
jmp_buf save_jump;
volatile int key_already_recorded = 0;
Lisp_Object tem, save;
volatile Lisp_Object previous_echo_area_message;
volatile Lisp_Object also_record;
volatile int reread;
struct gcpro gcpro1, gcpro2;
EMACS_TIME last_idle_start;
also_record = Qnil;
before_command_key_count = this_command_key_count;
before_command_echo_length = echo_length ();
c = Qnil;
previous_echo_area_message = Qnil;
GCPRO2 (c, previous_echo_area_message);
retry:
reread = 0;
if (CONSP (Vunread_post_input_method_events))
{
c = XCAR (Vunread_post_input_method_events);
Vunread_post_input_method_events
= XCDR (Vunread_post_input_method_events);
if (CONSP (c)
&& (SYMBOLP (XCAR (c)) || INTEGERP (XCAR (c)))
&& NILP (XCDR (c)))
c = XCAR (c);
reread = 1;
goto reread_first;
}
if (unread_command_char != -1)
{
XSETINT (c, unread_command_char);
unread_command_char = -1;
reread = 1;
goto reread_first;
}
if (CONSP (Vunread_command_events))
{
c = XCAR (Vunread_command_events);
Vunread_command_events = XCDR (Vunread_command_events);
if (CONSP (c)
&& EQ (XCDR (c), Qdisabled)
&& (SYMBOLP (XCAR (c)) || INTEGERP (XCAR (c))))
c = XCAR (c);
if (used_mouse_menu
&& (EQ (c, Qtool_bar) || EQ (c, Qmenu_bar)))
*used_mouse_menu = 1;
reread = 1;
goto reread_for_input_method;
}
if (CONSP (Vunread_input_method_events))
{
c = XCAR (Vunread_input_method_events);
Vunread_input_method_events = XCDR (Vunread_input_method_events);
if (CONSP (c)
&& (SYMBOLP (XCAR (c)) || INTEGERP (XCAR (c)))
&& NILP (XCDR (c)))
c = XCAR (c);
reread = 1;
goto reread_for_input_method;
}
before_command_restore_flag = 0;
if (!NILP (Vexecuting_macro))
{
Vlast_event_frame = internal_last_event_frame = Qmacro;
if (EQ (Vexecuting_macro, Qt)
|| executing_macro_index >= XFASTINT (Flength (Vexecuting_macro)))
{
XSETINT (c, -1);
RETURN_UNGCPRO (c);
}
c = Faref (Vexecuting_macro, make_number (executing_macro_index));
if (STRINGP (Vexecuting_macro)
&& (XINT (c) & 0x80))
XSETFASTINT (c, CHAR_META | (XINT (c) & ~0x80));
executing_macro_index++;
goto from_macro;
}
if (!NILP (unread_switch_frame))
{
c = unread_switch_frame;
unread_switch_frame = Qnil;
goto reread_first;
}
if (commandflag >= 0)
{
if (input_pending
|| detect_input_pending_run_timers (0))
swallow_events (0);
while (!input_pending)
{
if (help_echo_showing_p && !EQ (selected_window, minibuf_window))
redisplay_preserve_echo_area (5);
else
redisplay ();
if (!input_pending)
break;
swallow_events (0);
}
}
if (
!NILP (echo_area_buffer[0])
&& (
!EQ (echo_area_buffer[0], echo_message_buffer)
|| echo_kboard != current_kboard
|| ok_to_echo_at_next_pause == NULL))
cancel_echoing ();
else
echo_dash ();
c = Qnil;
if (nmaps > 0 && INTERACTIVE
&& !NILP (prev_event) && ! EVENT_HAS_PARAMETERS (prev_event)
&& NILP (Vunread_command_events)
&& unread_command_char < 0
&& !detect_input_pending_run_timers (0))
{
c = read_char_minibuf_menu_prompt (commandflag, nmaps, maps);
if (! NILP (c))
{
key_already_recorded = 1;
goto non_reread_1;
}
}
if (_setjmp (local_getcjmp))
{
XSETINT (c, quit_char);
internal_last_event_frame = selected_frame;
Vlast_event_frame = internal_last_event_frame;
if (!NILP (Vinhibit_quit))
Vquit_flag = Qnil;
#ifdef MULTI_KBOARD
{
KBOARD *kb = FRAME_KBOARD (XFRAME (selected_frame));
if (kb != current_kboard)
{
Lisp_Object *tailp = &kb->kbd_queue;
if (single_kboard)
abort ();
while (CONSP (*tailp))
tailp = &XCDR (*tailp);
if (!NILP (*tailp))
abort ();
*tailp = Fcons (c, Qnil);
kb->kbd_queue_has_data = 1;
current_kboard = kb;
UNGCPRO;
longjmp (wrong_kboard_jmpbuf, 1);
}
}
#endif
goto non_reread;
}
timer_start_idle ();
if (minibuf_level == 0
&& !current_kboard->immediate_echo
&& this_command_key_count > 0
&& ! noninteractive
&& (FLOATP (Vecho_keystrokes) || INTEGERP (Vecho_keystrokes))
&& NILP (Fzerop (Vecho_keystrokes))
&& (
NILP (echo_area_buffer[0])
|| (BUF_BEG (XBUFFER (echo_area_buffer[0]))
== BUF_Z (XBUFFER (echo_area_buffer[0])))
|| (echo_kboard && ok_to_echo_at_next_pause == echo_kboard)
|| (!echo_kboard && ok_to_echo_at_next_pause)))
{
Lisp_Object tem0;
if (EVENT_HAS_PARAMETERS (prev_event))
echo_now ();
else
{
int sec, usec;
double duration = extract_float (Vecho_keystrokes);
sec = (int) duration;
usec = (duration - sec) * 1000000;
save_getcjmp (save_jump);
restore_getcjmp (local_getcjmp);
tem0 = sit_for (sec, usec, 1, 1, 0);
restore_getcjmp (save_jump);
if (EQ (tem0, Qt)
&& ! CONSP (Vunread_command_events))
echo_now ();
}
}
if (commandflag != 0
&& auto_save_interval > 0
&& num_nonmacro_input_events - last_auto_save > max (auto_save_interval, 20)
&& !detect_input_pending_run_timers (0))
{
Fdo_auto_save (Qnil, Qnil);
redisplay ();
}
if (nmaps > 0 && INTERACTIVE
&& !NILP (prev_event)
&& EVENT_HAS_PARAMETERS (prev_event)
&& !EQ (XCAR (prev_event), Qmenu_bar)
&& !EQ (XCAR (prev_event), Qtool_bar)
&& NILP (Vunread_command_events)
&& unread_command_char < 0)
{
c = read_char_x_menu_prompt (nmaps, maps, prev_event, used_mouse_menu);
timer_stop_idle ();
RETURN_UNGCPRO (c);
}
if (INTERACTIVE && NILP (c))
{
int delay_level, buffer_size;
if (! MINI_WINDOW_P (XWINDOW (selected_window)))
last_non_minibuf_size = Z - BEG;
buffer_size = (last_non_minibuf_size >> 8) + 1;
delay_level = 0;
while (buffer_size > 64)
delay_level++, buffer_size -= buffer_size >> 2;
if (delay_level < 4) delay_level = 4;
if (commandflag != 0
&& num_nonmacro_input_events > last_auto_save
&& INTEGERP (Vauto_save_timeout)
&& XINT (Vauto_save_timeout) > 0)
{
Lisp_Object tem0;
save_getcjmp (save_jump);
restore_getcjmp (local_getcjmp);
tem0 = sit_for (delay_level * XFASTINT (Vauto_save_timeout) / 4,
0, 1, 1, 0);
restore_getcjmp (save_jump);
if (EQ (tem0, Qt)
&& ! CONSP (Vunread_command_events))
{
Fdo_auto_save (Qnil, Qnil);
if (!detect_input_pending_run_timers (0)
&& consing_since_gc > gc_cons_threshold / 2)
Fgarbage_collect ();
redisplay ();
}
}
}
if (CONSP (Vunread_command_events))
{
c = XCAR (Vunread_command_events);
Vunread_command_events = XCDR (Vunread_command_events);
}
if (NILP (c))
{
if (current_kboard->kbd_queue_has_data)
{
if (!CONSP (current_kboard->kbd_queue))
abort ();
c = XCAR (current_kboard->kbd_queue);
current_kboard->kbd_queue
= XCDR (current_kboard->kbd_queue);
if (NILP (current_kboard->kbd_queue))
current_kboard->kbd_queue_has_data = 0;
input_pending = readable_events (0);
if (EVENT_HAS_PARAMETERS (c)
&& EQ (EVENT_HEAD_KIND (EVENT_HEAD (c)), Qswitch_frame))
internal_last_event_frame = XCAR (XCDR (c));
Vlast_event_frame = internal_last_event_frame;
}
}
#ifdef MULTI_KBOARD
if (NILP (c) && !single_kboard)
{
KBOARD *kb;
for (kb = all_kboards; kb; kb = kb->next_kboard)
if (kb->kbd_queue_has_data)
{
current_kboard = kb;
UNGCPRO;
longjmp (wrong_kboard_jmpbuf, 1);
}
}
#endif
wrong_kboard:
stop_polling ();
if (NILP (c))
{
KBOARD *kb;
save_getcjmp (save_jump);
restore_getcjmp (local_getcjmp);
timer_start_idle ();
c = kbd_buffer_get_event (&kb, used_mouse_menu);
restore_getcjmp (save_jump);
#ifdef MULTI_KBOARD
if (! NILP (c) && (kb != current_kboard))
{
Lisp_Object *tailp = &kb->kbd_queue;
while (CONSP (*tailp))
tailp = &XCDR (*tailp);
if (!NILP (*tailp))
abort ();
*tailp = Fcons (c, Qnil);
kb->kbd_queue_has_data = 1;
c = Qnil;
if (single_kboard)
goto wrong_kboard;
current_kboard = kb;
UNGCPRO;
longjmp (wrong_kboard_jmpbuf, 1);
}
#endif
}
if (noninteractive && INTEGERP (c) && XINT (c) < 0)
Fkill_emacs (make_number (1));
if (INTEGERP (c))
{
if ((extra_keyboard_modifiers & CHAR_CTL)
|| ((extra_keyboard_modifiers & 0177) < ' '
&& (extra_keyboard_modifiers & 0177) != 0))
XSETINT (c, make_ctrl_char (XINT (c)));
XSETINT (c, XINT (c) | (extra_keyboard_modifiers & ~0xff7f & ~CHAR_CTL));
}
non_reread:
last_idle_start = timer_idleness_start_time;
timer_stop_idle ();
start_polling ();
if (NILP (c))
{
if (commandflag >= 0
&& !input_pending && !detect_input_pending_run_timers (0))
redisplay ();
goto wrong_kboard;
}
non_reread_1:
if (BUFFERP (c) || key_already_recorded)
RETURN_UNGCPRO (c);
save = Vquit_flag;
Vquit_flag = Qnil;
tem = access_keymap (get_keymap (Vspecial_event_map, 0, 1), c, 0, 0, 1);
Vquit_flag = save;
if (!NILP (tem))
{
int was_locked = single_kboard;
last_input_char = c;
Fcommand_execute (tem, Qnil, Fvector (1, &last_input_char), Qt);
if (!was_locked)
any_kboard_state ();
goto retry;
}
if (INTEGERP (c))
{
if (XINT (c) == -1)
RETURN_UNGCPRO (c);
if ((STRINGP (Vkeyboard_translate_table)
&& XSTRING (Vkeyboard_translate_table)->size > (unsigned) XFASTINT (c))
|| (VECTORP (Vkeyboard_translate_table)
&& XVECTOR (Vkeyboard_translate_table)->size > (unsigned) XFASTINT (c))
|| (CHAR_TABLE_P (Vkeyboard_translate_table)
&& CHAR_TABLE_ORDINARY_SLOTS > (unsigned) XFASTINT (c)))
{
Lisp_Object d;
d = Faref (Vkeyboard_translate_table, c);
if (!NILP (d))
c = d;
}
}
if (EVENT_HAS_PARAMETERS (c)
&& CONSP (XCDR (c))
&& CONSP (EVENT_START (c))
&& CONSP (XCDR (EVENT_START (c))))
{
Lisp_Object posn;
posn = POSN_BUFFER_POSN (EVENT_START (c));
if (EQ (posn, Qmenu_bar) || EQ (posn, Qtool_bar))
{
POSN_BUFFER_POSN (EVENT_START (c)) = Fcons (posn, Qnil);
also_record = c;
Vunread_command_events = Fcons (c, Vunread_command_events);
c = posn;
}
}
record_char (c);
if (! NILP (also_record))
record_char (also_record);
if (INTEGERP (c)
&& ! NILP (Vinput_method_function)
&& (unsigned) XINT (c) >= ' '
&& (unsigned) XINT (c) != 127
&& (unsigned) XINT (c) < 256)
{
previous_echo_area_message = Fcurrent_message ();
Vinput_method_previous_message = previous_echo_area_message;
}
if (!CONSP (c)
|| (!(EQ (Qhelp_echo, XCAR (c)))
&& !(EQ (Qswitch_frame, XCAR (c)))))
{
if (!NILP (echo_area_buffer[0]))
safe_run_hooks (Qecho_area_clear_hook);
clear_message (1, 0);
}
reread_for_input_method:
from_macro:
if (INTEGERP (c)
&& ! NILP (Vinput_method_function)
&& NILP (prev_event)
&& (unsigned) XINT (c) >= ' '
&& (unsigned) XINT (c) != 127
&& (unsigned) XINT (c) < 256)
{
Lisp_Object keys;
int key_count;
struct gcpro gcpro1;
int count = specpdl_ptr - specpdl;
int saved_immediate_echo = current_kboard->immediate_echo;
struct kboard *saved_ok_to_echo = ok_to_echo_at_next_pause;
int saved_echo_after_prompt = current_kboard->echo_after_prompt;
if (before_command_restore_flag)
{
this_command_key_count = before_command_key_count_1;
if (this_command_key_count < this_single_command_key_start)
this_single_command_key_start = this_command_key_count;
echo_truncate (before_command_echo_length_1);
before_command_restore_flag = 0;
}
key_count = this_command_key_count;
if (key_count > 0)
keys = Fcopy_sequence (this_command_keys);
else
keys = Qnil;
GCPRO1 (keys);
this_command_key_count = 0;
if (!NILP (echo_area_buffer[0]))
safe_run_hooks (Qecho_area_clear_hook);
clear_message (1, 0);
echo_truncate (0);
if (maps == 0)
{
specbind (Qinput_method_use_echo_area, Qt);
}
tem = call1 (Vinput_method_function, c);
tem = unbind_to (count, tem);
this_command_key_count = key_count;
if (key_count > 0)
this_command_keys = keys;
cancel_echoing ();
ok_to_echo_at_next_pause = saved_ok_to_echo;
current_kboard->echo_after_prompt = saved_echo_after_prompt;
if (saved_immediate_echo)
echo_now ();
UNGCPRO;
if (! CONSP (tem))
{
if (! NILP (previous_echo_area_message))
message_with_string ("%s", previous_echo_area_message, 0);
goto retry;
}
c = XCAR (tem);
Vunread_post_input_method_events
= nconc2 (XCDR (tem), Vunread_post_input_method_events);
}
reread_first:
if (CONSP (c) && EQ (XCAR (c), Qhelp_echo))
{
Lisp_Object help, object, position, window;
help = Fnth (make_number (2), c);
window = Fnth (make_number (3), c);
object = Fnth (make_number (4), c);
position = Fnth (make_number (5), c);
show_help_echo (help, window, object, position, 0);
timer_idleness_start_time = last_idle_start;
goto retry;
}
if (this_command_key_count == 0 || ! reread)
{
before_command_key_count = this_command_key_count;
before_command_echo_length = echo_length ();
if ((FLOATP (Vecho_keystrokes) || INTEGERP (Vecho_keystrokes))
&& NILP (Fzerop (Vecho_keystrokes))
&& ! (EVENT_HAS_PARAMETERS (c)
&& EQ (EVENT_HEAD_KIND (EVENT_HEAD (c)), Qmouse_movement)))
{
echo_char (c);
if (! NILP (also_record))
echo_char (also_record);
ok_to_echo_at_next_pause = current_kboard;
}
add_command_key (c);
if (! NILP (also_record))
add_command_key (also_record);
}
last_input_char = c;
num_input_events++;
if (!NILP (Vhelp_form) && help_char_p (c))
{
Lisp_Object tem0;
count = specpdl_ptr - specpdl;
record_unwind_protect (Fset_window_configuration,
Fcurrent_window_configuration (Qnil));
tem0 = Feval (Vhelp_form);
if (STRINGP (tem0))
internal_with_output_to_temp_buffer ("*Help*", print_help, tem0);
cancel_echoing ();
do
c = read_char (0, 0, 0, Qnil, 0);
while (BUFFERP (c));
unbind_to (count, Qnil);
redisplay ();
if (EQ (c, make_number (040)))
{
cancel_echoing ();
do
c = read_char (0, 0, 0, Qnil, 0);
while (BUFFERP (c));
}
}
RETURN_UNGCPRO (c);
}
static void
record_menu_key (c)
Lisp_Object c;
{
clear_message (1, 0);
record_char (c);
before_command_key_count = this_command_key_count;
before_command_echo_length = echo_length ();
if ((FLOATP (Vecho_keystrokes) || INTEGERP (Vecho_keystrokes))
&& NILP (Fzerop (Vecho_keystrokes)))
{
echo_char (c);
ok_to_echo_at_next_pause = 0;
}
add_command_key (c);
last_input_char = c;
num_input_events++;
}
int
help_char_p (c)
Lisp_Object c;
{
Lisp_Object tail;
if (EQ (c, Vhelp_char))
return 1;
for (tail = Vhelp_event_list; CONSP (tail); tail = XCDR (tail))
if (EQ (c, XCAR (tail)))
return 1;
return 0;
}
static void
record_char (c)
Lisp_Object c;
{
if (CONSP (c) && EQ (XCAR (c), Qhelp_echo))
{
Lisp_Object help;
help = Fnth (make_number (2), c);
if (STRINGP (help))
{
int last_idx;
Lisp_Object last_c, last_help;
last_idx = recent_keys_index - 1;
if (last_idx < 0)
last_idx = NUM_RECENT_KEYS - 1;
last_c = AREF (recent_keys, last_idx);
if (!CONSP (last_c)
|| !EQ (XCAR (last_c), Qhelp_echo)
|| (last_help = Fnth (make_number (2), last_c),
!EQ (last_help, help)))
{
total_keys++;
ASET (recent_keys, recent_keys_index, c);
if (++recent_keys_index >= NUM_RECENT_KEYS)
recent_keys_index = 0;
}
}
}
else
{
total_keys++;
ASET (recent_keys, recent_keys_index, c);
if (++recent_keys_index >= NUM_RECENT_KEYS)
recent_keys_index = 0;
}
if (dribble)
{
if (INTEGERP (c))
{
if (XUINT (c) < 0x100)
putc (XINT (c), dribble);
else
fprintf (dribble, " 0x%x", (int) XUINT (c));
}
else
{
Lisp_Object dribblee;
dribblee = EVENT_HEAD (c);
if (SYMBOLP (dribblee))
{
putc ('<', dribble);
fwrite (XSYMBOL (dribblee)->name->data, sizeof (char),
STRING_BYTES (XSYMBOL (dribblee)->name),
dribble);
putc ('>', dribble);
}
}
fflush (dribble);
}
if (!CONSP (c) || !EQ (Qhelp_echo, XCAR (c)))
store_kbd_macro_char (c);
num_nonmacro_input_events++;
}
Lisp_Object
print_help (object)
Lisp_Object object;
{
struct buffer *old = current_buffer;
Fprinc (object, Qnil);
set_buffer_internal (XBUFFER (Vstandard_output));
call0 (intern ("help-mode"));
set_buffer_internal (old);
return Qnil;
}
static void
save_getcjmp (temp)
jmp_buf temp;
{
bcopy (getcjmp, temp, sizeof getcjmp);
}
static void
restore_getcjmp (temp)
jmp_buf temp;
{
bcopy (temp, getcjmp, sizeof getcjmp);
}
#ifdef HAVE_MOUSE
static Lisp_Object
tracking_off (old_value)
Lisp_Object old_value;
{
do_mouse_tracking = old_value;
if (NILP (old_value))
{
if (!readable_events (1))
{
redisplay_preserve_echo_area (6);
get_input_pending (&input_pending, 1);
}
}
return Qnil;
}
DEFUN ("track-mouse", Ftrack_mouse, Strack_mouse, 0, UNEVALLED, 0,
"Evaluate BODY with mouse movement events enabled.\n\
Within a `track-mouse' form, mouse motion generates input events that\n\
you can read with `read-event'.\n\
Normally, mouse motion is ignored.")
(args)
Lisp_Object args;
{
int count = specpdl_ptr - specpdl;
Lisp_Object val;
record_unwind_protect (tracking_off, do_mouse_tracking);
do_mouse_tracking = Qt;
val = Fprogn (args);
return unbind_to (count, val);
}
static FRAME_PTR
some_mouse_moved ()
{
Lisp_Object tail, frame;
FOR_EACH_FRAME (tail, frame)
{
if (XFRAME (frame)->mouse_moved)
return XFRAME (frame);
}
return 0;
}
#endif
static int
readable_events (do_timers_now)
int do_timers_now;
{
if (do_timers_now)
timer_check (do_timers_now);
if (kbd_fetch_ptr != kbd_store_ptr)
return 1;
#ifdef HAVE_MOUSE
if (!NILP (do_mouse_tracking) && some_mouse_moved ())
return 1;
#endif
if (single_kboard)
{
if (current_kboard->kbd_queue_has_data)
return 1;
}
else
{
KBOARD *kb;
for (kb = all_kboards; kb; kb = kb->next_kboard)
if (kb->kbd_queue_has_data)
return 1;
}
return 0;
}
int stop_character;
#ifdef MULTI_KBOARD
static KBOARD *
event_to_kboard (event)
struct input_event *event;
{
Lisp_Object frame;
frame = event->frame_or_window;
if (CONSP (frame))
frame = XCAR (frame);
else if (WINDOWP (frame))
frame = WINDOW_FRAME (XWINDOW (frame));
if (!FRAMEP (frame) || !FRAME_LIVE_P (XFRAME (frame)))
return 0;
else
return FRAME_KBOARD (XFRAME (frame));
}
#endif
void
kbd_buffer_store_event (event)
register struct input_event *event;
{
if (event->kind == no_event)
abort ();
if (event->kind == ascii_keystroke)
{
register int c = event->code & 0377;
if (event->modifiers & ctrl_modifier)
c = make_ctrl_char (c);
c |= (event->modifiers
& (meta_modifier | alt_modifier
| hyper_modifier | super_modifier));
if (c == quit_char)
{
extern SIGTYPE interrupt_signal ();
#ifdef MULTI_KBOARD
KBOARD *kb;
struct input_event *sp;
if (single_kboard
&& (kb = FRAME_KBOARD (XFRAME (event->frame_or_window)),
kb != current_kboard))
{
kb->kbd_queue
= Fcons (make_lispy_switch_frame (event->frame_or_window),
Fcons (make_number (c), Qnil));
kb->kbd_queue_has_data = 1;
for (sp = kbd_fetch_ptr; sp != kbd_store_ptr; sp++)
{
if (sp == kbd_buffer + KBD_BUFFER_SIZE)
sp = kbd_buffer;
if (event_to_kboard (sp) == kb)
{
sp->kind = no_event;
sp->frame_or_window = Qnil;
sp->arg = Qnil;
}
}
return;
}
#endif
{
Lisp_Object focus;
focus = FRAME_FOCUS_FRAME (XFRAME (event->frame_or_window));
if (NILP (focus))
focus = event->frame_or_window;
internal_last_event_frame = focus;
Vlast_event_frame = focus;
}
last_event_timestamp = event->timestamp;
interrupt_signal ();
return;
}
if (c && c == stop_character)
{
sys_suspend ();
return;
}
}
else if (event->kind == buffer_switch_event
&& kbd_fetch_ptr != kbd_store_ptr
&& kbd_store_ptr->kind == buffer_switch_event)
return;
if (kbd_store_ptr - kbd_buffer == KBD_BUFFER_SIZE)
kbd_store_ptr = kbd_buffer;
if (kbd_fetch_ptr - 1 != kbd_store_ptr)
{
int idx;
#if 0
struct input_event *sp = kbd_store_ptr;
sp->kind = event->kind;
if (event->kind == selection_request_event)
{
bcopy (event, (char *) sp, sizeof (*event));
}
else
{
sp->code = event->code;
sp->part = event->part;
sp->frame_or_window = event->frame_or_window;
sp->arg = event->arg;
sp->modifiers = event->modifiers;
sp->x = event->x;
sp->y = event->y;
sp->timestamp = event->timestamp;
}
#else
*kbd_store_ptr = *event;
#endif
idx = 2 * (kbd_store_ptr - kbd_buffer);
ASET (kbd_buffer_gcpro, idx, event->frame_or_window);
ASET (kbd_buffer_gcpro, idx + 1, event->arg);
++kbd_store_ptr;
}
}
int
gen_help_event (bufp, size, help, frame, window, object, pos)
struct input_event *bufp;
int size;
Lisp_Object help, frame, object, window;
int pos;
{
int nevents_stored = 0;
if (size >= 2)
{
bufp->kind = HELP_EVENT;
bufp->frame_or_window = frame;
bufp->arg = object;
bufp->x = make_number (pos);
bufp->code = 0;
++bufp;
bufp->kind = HELP_EVENT;
bufp->frame_or_window = WINDOWP (window) ? window : frame;
bufp->arg = help;
bufp->code = 1;
nevents_stored = 2;
}
return nevents_stored;
}
void
kbd_buffer_store_help_event (frame, help)
Lisp_Object frame, help;
{
struct input_event event;
event.kind = HELP_EVENT;
event.frame_or_window = frame;
event.arg = Qnil;
event.x = make_number (0);
event.code = 0;
kbd_buffer_store_event (&event);
event.kind = HELP_EVENT;
event.frame_or_window = frame;
event.arg = help;
event.x = make_number (0);
event.code = 1;
kbd_buffer_store_event (&event);
}
void
discard_mouse_events ()
{
struct input_event *sp;
for (sp = kbd_fetch_ptr; sp != kbd_store_ptr; sp++)
{
if (sp == kbd_buffer + KBD_BUFFER_SIZE)
sp = kbd_buffer;
if (sp->kind == mouse_click
#ifdef WINDOWSNT
|| sp->kind == w32_scroll_bar_click
#endif
|| sp->kind == scroll_bar_click)
{
sp->kind = no_event;
}
}
}
int
kbd_buffer_events_waiting (discard)
int discard;
{
struct input_event *sp;
for (sp = kbd_fetch_ptr;
sp != kbd_store_ptr && sp->kind == no_event;
++sp)
{
if (sp == kbd_buffer + KBD_BUFFER_SIZE)
sp = kbd_buffer;
}
if (discard)
kbd_fetch_ptr = sp;
return sp != kbd_store_ptr && sp->kind != no_event;
}
static INLINE void
clear_event (event)
struct input_event *event;
{
int idx = 2 * (event - kbd_buffer);
ASET (kbd_buffer_gcpro, idx, Qnil);
ASET (kbd_buffer_gcpro, idx + 1, Qnil);
event->kind = no_event;
}
static Lisp_Object
kbd_buffer_get_event (kbp, used_mouse_menu)
KBOARD **kbp;
int *used_mouse_menu;
{
register int c;
Lisp_Object obj;
if (noninteractive)
{
c = getchar ();
XSETINT (obj, c);
*kbp = current_kboard;
return obj;
}
for (;;)
{
if (kbd_fetch_ptr != kbd_store_ptr)
break;
#ifdef HAVE_MOUSE
if (!NILP (do_mouse_tracking) && some_mouse_moved ())
break;
#endif
if (!NILP (Vquit_flag))
quit_throw_to_read_char ();
#ifdef OLDVMS
wait_for_kbd_input ();
#else
#ifdef SIGIO
gobble_input (0);
#endif
if (kbd_fetch_ptr != kbd_store_ptr)
break;
#ifdef HAVE_MOUSE
if (!NILP (do_mouse_tracking) && some_mouse_moved ())
break;
#endif
{
Lisp_Object minus_one;
XSETINT (minus_one, -1);
wait_reading_process_input (0, 0, minus_one, 1);
if (!interrupt_input && kbd_fetch_ptr == kbd_store_ptr)
read_avail_input (1);
}
#endif
}
if (CONSP (Vunread_command_events))
{
Lisp_Object first;
first = XCAR (Vunread_command_events);
Vunread_command_events = XCDR (Vunread_command_events);
*kbp = current_kboard;
return first;
}
if (kbd_fetch_ptr != kbd_store_ptr)
{
struct input_event *event;
event = ((kbd_fetch_ptr < kbd_buffer + KBD_BUFFER_SIZE)
? kbd_fetch_ptr
: kbd_buffer);
last_event_timestamp = event->timestamp;
#ifdef MULTI_KBOARD
*kbp = event_to_kboard (event);
if (*kbp == 0)
*kbp = current_kboard;
#else
*kbp = &the_only_kboard;
#endif
obj = Qnil;
if (event->kind == selection_request_event)
{
#ifdef HAVE_X11
struct input_event copy;
copy = *event;
kbd_fetch_ptr = event + 1;
input_pending = readable_events (0);
x_handle_selection_request (©);
#else
abort ();
#endif
}
else if (event->kind == selection_clear_event)
{
#ifdef HAVE_X11
struct input_event copy;
copy = *event;
kbd_fetch_ptr = event + 1;
input_pending = readable_events (0);
x_handle_selection_clear (©);
#else
abort ();
#endif
}
#if defined (HAVE_X11) || defined (HAVE_NTGUI) || defined (macintosh)
else if (event->kind == delete_window_event)
{
obj = Fcons (event->frame_or_window, Qnil);
obj = Fcons (Qdelete_frame, Fcons (obj, Qnil));
kbd_fetch_ptr = event + 1;
}
#endif
#if defined (HAVE_X11) || defined (HAVE_NTGUI)
else if (event->kind == iconify_event)
{
obj = Fcons (event->frame_or_window, Qnil);
obj = Fcons (Qiconify_frame, Fcons (obj, Qnil));
kbd_fetch_ptr = event + 1;
}
else if (event->kind == deiconify_event)
{
obj = Fcons (event->frame_or_window, Qnil);
obj = Fcons (Qmake_frame_visible, Fcons (obj, Qnil));
kbd_fetch_ptr = event + 1;
}
#endif
else if (event->kind == buffer_switch_event)
{
XSETBUFFER (obj, current_buffer);
kbd_fetch_ptr = event + 1;
}
#if defined (USE_X_TOOLKIT) || defined (HAVE_NTGUI) || defined (macintosh)
else if (event->kind == menu_bar_activate_event)
{
kbd_fetch_ptr = event + 1;
input_pending = readable_events (0);
if (FRAME_LIVE_P (XFRAME (event->frame_or_window)))
x_activate_menubar (XFRAME (event->frame_or_window));
}
#endif
#ifdef WINDOWSNT
else if (event->kind == language_change_event)
{
obj = Fcons (event->modifiers, Qnil);
obj = Fcons (event->code, Qnil);
obj = Fcons (event->frame_or_window, obj);
obj = Fcons (Qlanguage_change, Fcons (obj, Qnil));
kbd_fetch_ptr = event + 1;
}
#endif
else if (event->kind == no_event)
kbd_fetch_ptr = event + 1;
else if (event->kind == HELP_EVENT)
{
Lisp_Object object, position, help, frame, window;
xassert (event->code == 0);
frame = event->frame_or_window;
object = event->arg;
position = event->x;
clear_event (event);
kbd_fetch_ptr = event + 1;
event = ((kbd_fetch_ptr < kbd_buffer + KBD_BUFFER_SIZE)
? kbd_fetch_ptr
: kbd_buffer);
xassert (event->code == 1);
help = event->arg;
window = event->frame_or_window;
if (!WINDOWP (window))
window = Qnil;
obj = Fcons (Qhelp_echo,
list5 (frame, help, window, object, position));
clear_event (event);
kbd_fetch_ptr = event + 1;
}
else if (event->kind == FOCUS_IN_EVENT)
{
Lisp_Object frame, focus;
frame = event->frame_or_window;
focus = FRAME_FOCUS_FRAME (XFRAME (frame));
if (FRAMEP (focus))
frame = focus;
if (!EQ (frame, internal_last_event_frame)
&& !EQ (frame, selected_frame))
obj = make_lispy_switch_frame (frame);
internal_last_event_frame = frame;
kbd_fetch_ptr = event + 1;
}
else
{
Lisp_Object frame;
Lisp_Object focus;
frame = event->frame_or_window;
if (CONSP (frame))
frame = XCAR (frame);
else if (WINDOWP (frame))
frame = WINDOW_FRAME (XWINDOW (frame));
focus = FRAME_FOCUS_FRAME (XFRAME (frame));
if (! NILP (focus))
frame = focus;
if (! EQ (frame, internal_last_event_frame)
&& !EQ (frame, selected_frame))
obj = make_lispy_switch_frame (frame);
internal_last_event_frame = frame;
if (NILP (obj))
{
obj = make_lispy_event (event);
#if defined (USE_X_TOOLKIT) || defined (HAVE_NTGUI)
if (used_mouse_menu
&& !EQ (event->frame_or_window, event->arg)
&& (event->kind == MENU_BAR_EVENT
|| event->kind == TOOL_BAR_EVENT))
*used_mouse_menu = 1;
#endif
clear_event (event);
kbd_fetch_ptr = event + 1;
}
}
}
#ifdef HAVE_MOUSE
else if (!NILP (do_mouse_tracking) && some_mouse_moved ())
{
FRAME_PTR f = some_mouse_moved ();
Lisp_Object bar_window;
enum scroll_bar_part part;
Lisp_Object x, y;
unsigned long time;
*kbp = current_kboard;
x = Qnil;
(*mouse_position_hook) (&f, 0, &bar_window, &part, &x, &y, &time);
obj = Qnil;
if (!NILP (x) && f)
{
Lisp_Object frame;
frame = FRAME_FOCUS_FRAME (f);
if (NILP (frame))
XSETFRAME (frame, f);
if (! EQ (frame, internal_last_event_frame)
&& !EQ (frame, selected_frame))
obj = make_lispy_switch_frame (frame);
internal_last_event_frame = frame;
}
if (!NILP (x) && NILP (obj))
obj = make_lispy_movement (f, bar_window, part, x, y, time);
}
#endif
else
abort ();
input_pending = readable_events (0);
Vlast_event_frame = internal_last_event_frame;
return (obj);
}
void
swallow_events (do_display)
int do_display;
{
int old_timers_run;
while (kbd_fetch_ptr != kbd_store_ptr)
{
struct input_event *event;
event = ((kbd_fetch_ptr < kbd_buffer + KBD_BUFFER_SIZE)
? kbd_fetch_ptr
: kbd_buffer);
last_event_timestamp = event->timestamp;
if (event->kind == selection_request_event)
{
#ifdef HAVE_X11
struct input_event copy;
copy = *event;
kbd_fetch_ptr = event + 1;
input_pending = readable_events (0);
x_handle_selection_request (©);
#else
abort ();
#endif
}
else if (event->kind == selection_clear_event)
{
#ifdef HAVE_X11
struct input_event copy;
copy = *event;
kbd_fetch_ptr = event + 1;
input_pending = readable_events (0);
x_handle_selection_clear (©);
#else
abort ();
#endif
}
else
break;
}
old_timers_run = timers_run;
get_input_pending (&input_pending, 1);
if (timers_run != old_timers_run && do_display)
redisplay_preserve_echo_area (7);
}
void
timer_start_idle ()
{
Lisp_Object timers;
if (! EMACS_TIME_NEG_P (timer_idleness_start_time))
return;
EMACS_GET_TIME (timer_idleness_start_time);
for (timers = Vtimer_idle_list; CONSP (timers); timers = XCDR (timers))
{
Lisp_Object timer;
timer = XCAR (timers);
if (!VECTORP (timer) || XVECTOR (timer)->size != 8)
continue;
XVECTOR (timer)->contents[0] = Qnil;
}
}
void
timer_stop_idle ()
{
EMACS_SET_SECS_USECS (timer_idleness_start_time, -1, -1);
}
struct input_event last_timer_event;
EMACS_TIME
timer_check (do_it_now)
int do_it_now;
{
EMACS_TIME nexttime;
EMACS_TIME now, idleness_now;
Lisp_Object timers, idle_timers, chosen_timer;
struct gcpro gcpro1, gcpro2, gcpro3;
EMACS_SET_SECS (nexttime, -1);
EMACS_SET_USECS (nexttime, -1);
timers = Vtimer_list;
if (! EMACS_TIME_NEG_P (timer_idleness_start_time))
idle_timers = Vtimer_idle_list;
else
idle_timers = Qnil;
chosen_timer = Qnil;
GCPRO3 (timers, idle_timers, chosen_timer);
if (CONSP (timers) || CONSP (idle_timers))
{
EMACS_GET_TIME (now);
if (! EMACS_TIME_NEG_P (timer_idleness_start_time))
EMACS_SUB_TIME (idleness_now, now, timer_idleness_start_time);
}
while (CONSP (timers) || CONSP (idle_timers))
{
Lisp_Object *vector;
Lisp_Object timer = Qnil, idle_timer = Qnil;
EMACS_TIME timer_time, idle_timer_time;
EMACS_TIME difference, timer_difference, idle_timer_difference;
if (!NILP (timers))
{
timer = XCAR (timers);
if (!VECTORP (timer) || XVECTOR (timer)->size != 8)
{
timers = XCDR (timers);
continue;
}
vector = XVECTOR (timer)->contents;
if (!INTEGERP (vector[1]) || !INTEGERP (vector[2])
|| !INTEGERP (vector[3])
|| ! NILP (vector[0]))
{
timers = XCDR (timers);
continue;
}
}
if (!NILP (idle_timers))
{
timer = XCAR (idle_timers);
if (!VECTORP (timer) || XVECTOR (timer)->size != 8)
{
idle_timers = XCDR (idle_timers);
continue;
}
vector = XVECTOR (timer)->contents;
if (!INTEGERP (vector[1]) || !INTEGERP (vector[2])
|| !INTEGERP (vector[3])
|| ! NILP (vector[0]))
{
idle_timers = XCDR (idle_timers);
continue;
}
}
if (!NILP (timers))
{
timer = XCAR (timers);
vector = XVECTOR (timer)->contents;
EMACS_SET_SECS (timer_time,
(XINT (vector[1]) << 16) | (XINT (vector[2])));
EMACS_SET_USECS (timer_time, XINT (vector[3]));
EMACS_SUB_TIME (timer_difference, timer_time, now);
}
if (!NILP (idle_timers))
{
idle_timer = XCAR (idle_timers);
vector = XVECTOR (idle_timer)->contents;
EMACS_SET_SECS (idle_timer_time,
(XINT (vector[1]) << 16) | (XINT (vector[2])));
EMACS_SET_USECS (idle_timer_time, XINT (vector[3]));
EMACS_SUB_TIME (idle_timer_difference, idle_timer_time, idleness_now);
}
if (! NILP (timers) && ! NILP (idle_timers))
{
EMACS_TIME temp;
EMACS_SUB_TIME (temp, timer_difference, idle_timer_difference);
if (EMACS_TIME_NEG_P (temp))
{
chosen_timer = timer;
timers = XCDR (timers);
difference = timer_difference;
}
else
{
chosen_timer = idle_timer;
idle_timers = XCDR (idle_timers);
difference = idle_timer_difference;
}
}
else if (! NILP (timers))
{
chosen_timer = timer;
timers = XCDR (timers);
difference = timer_difference;
}
else
{
chosen_timer = idle_timer;
idle_timers = XCDR (idle_timers);
difference = idle_timer_difference;
}
vector = XVECTOR (chosen_timer)->contents;
if (EMACS_TIME_NEG_P (difference)
|| (EMACS_SECS (difference) == 0
&& EMACS_USECS (difference) == 0))
{
if (NILP (vector[0]))
{
int was_locked = single_kboard;
int count = BINDING_STACK_SIZE ();
Lisp_Object old_deactivate_mark = Vdeactivate_mark;
vector[0] = Qt;
specbind (Qinhibit_quit, Qt);
call1 (Qtimer_event_handler, chosen_timer);
Vdeactivate_mark = old_deactivate_mark;
timers_run++;
unbind_to (count, Qnil);
if (!was_locked)
any_kboard_state ();
}
}
else
{
UNGCPRO;
return difference;
}
}
UNGCPRO;
return nexttime;
}
static Lisp_Object accent_key_syms;
static Lisp_Object func_key_syms;
static Lisp_Object mouse_syms;
#ifdef WINDOWSNT
static Lisp_Object mouse_wheel_syms;
#endif
static Lisp_Object drag_n_drop_syms;
static int lispy_accent_codes[] =
{
#ifdef XK_dead_circumflex
XK_dead_circumflex,
#else
0,
#endif
#ifdef XK_dead_grave
XK_dead_grave,
#else
0,
#endif
#ifdef XK_dead_tilde
XK_dead_tilde,
#else
0,
#endif
#ifdef XK_dead_diaeresis
XK_dead_diaeresis,
#else
0,
#endif
#ifdef XK_dead_macron
XK_dead_macron,
#else
0,
#endif
#ifdef XK_dead_degree
XK_dead_degree,
#else
0,
#endif
#ifdef XK_dead_acute
XK_dead_acute,
#else
0,
#endif
#ifdef XK_dead_cedilla
XK_dead_cedilla,
#else
0,
#endif
#ifdef XK_dead_breve
XK_dead_breve,
#else
0,
#endif
#ifdef XK_dead_ogonek
XK_dead_ogonek,
#else
0,
#endif
#ifdef XK_dead_caron
XK_dead_caron,
#else
0,
#endif
#ifdef XK_dead_doubleacute
XK_dead_doubleacute,
#else
0,
#endif
#ifdef XK_dead_abovedot
XK_dead_abovedot,
#else
0,
#endif
};
static char *lispy_accent_keys[] =
{
"dead-circumflex",
"dead-grave",
"dead-tilde",
"dead-diaeresis",
"dead-macron",
"dead-degree",
"dead-acute",
"dead-cedilla",
"dead-breve",
"dead-ogonek",
"dead-caron",
"dead-doubleacute",
"dead-abovedot",
};
#ifdef HAVE_NTGUI
#define FUNCTION_KEY_OFFSET 0x0
char *lispy_function_keys[] =
{
0,
0,
0,
"cancel",
0,
0, 0, 0,
"backspace",
"tab",
0, 0,
"clear",
"return",
0, 0,
0,
0,
0,
"pause",
"capslock",
0, 0, 0, 0, 0, 0,
"escape",
0, 0, 0, 0,
0,
"prior",
"next",
"end",
"home",
"left",
"up",
"right",
"down",
"select",
"print",
"execute",
"snapshot",
"insert",
"delete",
"help",
0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0,
"lwindow",
"rwindow",
"apps",
0, 0,
"kp-0",
"kp-1",
"kp-2",
"kp-3",
"kp-4",
"kp-5",
"kp-6",
"kp-7",
"kp-8",
"kp-9",
"kp-multiply",
"kp-add",
"kp-separator",
"kp-subtract",
"kp-decimal",
"kp-divide",
"f1",
"f2",
"f3",
"f4",
"f5",
"f6",
"f7",
"f8",
"f9",
"f10",
"f11",
"f12",
"f13",
"f14",
"f15",
"f16",
"f17",
"f18",
"f19",
"f20",
"f21",
"f22",
"f23",
"f24",
0, 0, 0, 0,
0, 0, 0, 0,
"kp-numlock",
"scroll",
"kp-space",
"kp-enter",
"kp-prior",
"kp-next",
"kp-end",
"kp-home",
"kp-left",
"kp-up",
"kp-right",
"kp-down",
"kp-insert",
"kp-delete",
0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0,
"attn",
"crsel",
"exsel",
"ereof",
"play",
"zoom",
"noname",
"pa1",
"oem_clear",
0
};
#else
#ifdef XK_kana_A
static char *lispy_kana_keys[] =
{
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,"overline",0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0, "kana-fullstop", "kana-openingbracket", "kana-closingbracket",
"kana-comma", "kana-conjunctive", "kana-WO", "kana-a",
"kana-i", "kana-u", "kana-e", "kana-o",
"kana-ya", "kana-yu", "kana-yo", "kana-tsu",
"prolongedsound", "kana-A", "kana-I", "kana-U",
"kana-E", "kana-O", "kana-KA", "kana-KI",
"kana-KU", "kana-KE", "kana-KO", "kana-SA",
"kana-SHI", "kana-SU", "kana-SE", "kana-SO",
"kana-TA", "kana-CHI", "kana-TSU", "kana-TE",
"kana-TO", "kana-NA", "kana-NI", "kana-NU",
"kana-NE", "kana-NO", "kana-HA", "kana-HI",
"kana-FU", "kana-HE", "kana-HO", "kana-MA",
"kana-MI", "kana-MU", "kana-ME", "kana-MO",
"kana-YA", "kana-YU", "kana-YO", "kana-RA",
"kana-RI", "kana-RU", "kana-RE", "kana-RO",
"kana-WA", "kana-N", "voicedsound", "semivoicedsound",
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
};
#endif
#define FUNCTION_KEY_OFFSET 0xff00
static char *lispy_function_keys[] =
{
0, 0, 0, 0, 0, 0, 0, 0,
"backspace", "tab", "linefeed", "clear",
0, "return", 0, 0,
0, 0, 0, "pause",
0, 0, 0, 0, 0, 0, 0, "escape",
0, 0, 0, 0,
0, "kanji", "muhenkan", "henkan",
"romaji", "hiragana", "katakana", "hiragana-katakana",
"zenkaku", "hankaku", "zenkaku-hankaku", "touroku",
"massyo", "kana-lock", "kana-shift", "eisu-shift",
"eisu-toggle",
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
"home", "left", "up", "right",
"down", "prior", "next", "end",
"begin", 0, 0, 0, 0, 0, 0, 0,
"select",
"print",
"execute",
"insert",
0,
"undo",
"redo",
"menu",
"find",
"cancel",
"help",
"break",
0, 0, 0, 0,
0, 0, 0, 0, "backtab", 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, "kp-numlock",
"kp-space",
0, 0, 0, 0, 0, 0, 0, 0,
"kp-tab",
0, 0, 0,
"kp-enter",
0, 0, 0,
"kp-f1",
"kp-f2",
"kp-f3",
"kp-f4",
"kp-home",
"kp-left",
"kp-up",
"kp-right",
"kp-down",
"kp-prior",
"kp-next",
"kp-end",
"kp-begin",
"kp-insert",
"kp-delete",
0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
"kp-multiply",
"kp-add",
"kp-separator",
"kp-subtract",
"kp-decimal",
"kp-divide",
"kp-0",
"kp-1", "kp-2", "kp-3", "kp-4", "kp-5", "kp-6", "kp-7", "kp-8", "kp-9",
0,
0, 0,
"kp-equal",
"f1",
"f2",
"f3", "f4", "f5", "f6", "f7", "f8", "f9", "f10",
"f11", "f12", "f13", "f14", "f15", "f16", "f17", "f18",
"f19", "f20", "f21", "f22", "f23", "f24", "f25", "f26",
"f27", "f28", "f29", "f30", "f31", "f32", "f33", "f34",
"f35", 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, "delete"
};
#define ISO_FUNCTION_KEY_OFFSET 0xfe00
static char *iso_lispy_function_keys[] =
{
0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0,
"iso-lefttab",
"iso-move-line-up", "iso-move-line-down",
"iso-partial-line-up", "iso-partial-line-down",
"iso-partial-space-left", "iso-partial-space-right",
"iso-set-margin-left", "iso-set-margin-right",
"iso-release-margin-left", "iso-release-margin-right",
"iso-release-both-margins",
"iso-fast-cursor-left", "iso-fast-cursor-right",
"iso-fast-cursor-up", "iso-fast-cursor-down",
"iso-continuous-underline", "iso-discontinuous-underline",
"iso-emphasize", "iso-center-object", "iso-enter",
};
#endif
Lisp_Object Vlispy_mouse_stem;
#ifdef WINDOWSNT
static char *lispy_mouse_wheel_names[] =
{
"mouse-wheel"
};
#endif
static char *lispy_drag_n_drop_names[] =
{
"drag-n-drop"
};
Lisp_Object Qabove_handle, Qhandle, Qbelow_handle;
Lisp_Object Qup, Qdown, Qbottom, Qend_scroll;
Lisp_Object Qtop, Qratio;
Lisp_Object *scroll_bar_parts[] = {
&Qabove_handle, &Qhandle, &Qbelow_handle,
&Qup, &Qdown, &Qtop, &Qbottom, &Qend_scroll, &Qratio
};
Lisp_Object Qusr1_signal, Qusr2_signal;
Lisp_Object *lispy_user_signals[] =
{
&Qusr1_signal, &Qusr2_signal
};
static Lisp_Object button_down_location;
static int last_mouse_button;
static int last_mouse_x;
static int last_mouse_y;
static unsigned long button_down_time;
Lisp_Object Vdouble_click_time;
int double_click_fuzz;
int double_click_count;
static Lisp_Object
make_lispy_event (event)
struct input_event *event;
{
int i;
switch (SWITCH_ENUM_CAST (event->kind))
{
case ascii_keystroke:
{
Lisp_Object lispy_c;
int c = event->code & 0377;
if (event->modifiers & ctrl_modifier)
c = make_ctrl_char (c);
c |= (event->modifiers
& (meta_modifier | alt_modifier
| hyper_modifier | super_modifier));
if ((event->code & 0377) == 040
&& event->modifiers & shift_modifier)
c |= shift_modifier;
button_down_time = 0;
XSETFASTINT (lispy_c, c);
return lispy_c;
}
case multibyte_char_keystroke:
{
Lisp_Object lispy_c;
XSETFASTINT (lispy_c, event->code);
return lispy_c;
}
case non_ascii_keystroke:
button_down_time = 0;
for (i = 0; i < sizeof (lispy_accent_codes) / sizeof (int); i++)
if (event->code == lispy_accent_codes[i])
return modify_event_symbol (i,
event->modifiers,
Qfunction_key, Qnil,
lispy_accent_keys, &accent_key_syms,
(sizeof (lispy_accent_keys)
/ sizeof (lispy_accent_keys[0])));
if (event->code & (1 << 28))
{
if (NILP (current_kboard->system_key_syms))
current_kboard->system_key_syms = Fcons (Qnil, Qnil);
return modify_event_symbol (event->code,
event->modifiers,
Qfunction_key,
current_kboard->Vsystem_key_alist,
0, ¤t_kboard->system_key_syms,
(unsigned)-1);
}
#ifdef XK_kana_A
if (event->code >= 0x400 && event->code < 0x500)
return modify_event_symbol (event->code - 0x400,
event->modifiers & ~shift_modifier,
Qfunction_key, Qnil,
lispy_kana_keys, &func_key_syms,
(sizeof (lispy_kana_keys)
/ sizeof (lispy_kana_keys[0])));
#endif
#ifdef ISO_FUNCTION_KEY_OFFSET
if (event->code < FUNCTION_KEY_OFFSET
&& event->code >= ISO_FUNCTION_KEY_OFFSET)
return modify_event_symbol (event->code - ISO_FUNCTION_KEY_OFFSET,
event->modifiers,
Qfunction_key, Qnil,
iso_lispy_function_keys, &func_key_syms,
(sizeof (iso_lispy_function_keys)
/ sizeof (iso_lispy_function_keys[0])));
else
#endif
return modify_event_symbol (event->code - FUNCTION_KEY_OFFSET,
event->modifiers,
Qfunction_key, Qnil,
lispy_function_keys, &func_key_syms,
(sizeof (lispy_function_keys)
/ sizeof (lispy_function_keys[0])));
#ifdef HAVE_MOUSE
case mouse_click:
#ifndef USE_TOOLKIT_SCROLL_BARS
case scroll_bar_click:
#endif
{
int button = event->code;
int is_double;
Lisp_Object position;
Lisp_Object *start_pos_ptr;
Lisp_Object start_pos;
Lisp_Object window;
position = Qnil;
if (event->kind == mouse_click)
{
int part;
struct frame *f = XFRAME (event->frame_or_window);
Lisp_Object posn;
Lisp_Object string_info = Qnil;
int row, column;
if (! FRAME_LIVE_P (f))
return Qnil;
pixel_to_glyph_coords (f, XINT (event->x), XINT (event->y),
&column, &row, NULL, 1);
#ifndef USE_X_TOOLKIT
if (row >= 0 && row < FRAME_MENU_BAR_LINES (f)
&& (event->modifiers & down_modifier))
{
Lisp_Object items, item;
int hpos;
int i;
#if 0
if (! (event->modifiers & down_modifier))
return Qnil;
#endif
item = Qnil;
items = FRAME_MENU_BAR_ITEMS (f);
for (i = 0; i < XVECTOR (items)->size; i += 4)
{
Lisp_Object pos, string;
string = AREF (items, i + 1);
pos = AREF (items, i + 3);
if (NILP (string))
break;
if (column >= XINT (pos)
&& column < XINT (pos) + XSTRING (string)->size)
{
item = AREF (items, i);
break;
}
}
position
= Fcons (event->frame_or_window,
Fcons (Qmenu_bar,
Fcons (Fcons (event->x, event->y),
Fcons (make_number (event->timestamp),
Qnil))));
return Fcons (item, Fcons (position, Qnil));
}
#endif
window = window_from_coordinates (f, XINT (event->x),
XINT (event->y), &part, 0);
if (!WINDOWP (window))
{
window = event->frame_or_window;
posn = Qnil;
}
else
{
struct window *w = XWINDOW (window);
int wx = FRAME_TO_WINDOW_PIXEL_X (w, XINT (event->x));
int wy = FRAME_TO_WINDOW_PIXEL_Y (w, XINT (event->y));
XSETINT (event->x, wx);
XSETINT (event->y, wy);
if (part == 1 || part == 3)
{
Lisp_Object string;
int charpos;
posn = part == 1 ? Qmode_line : Qheader_line;
string = mode_line_string (w, wx, wy, part == 1, &charpos);
if (STRINGP (string))
string_info = Fcons (string, make_number (charpos));
}
else if (part == 2)
posn = Qvertical_line;
else
{
Lisp_Object object;
struct display_pos p;
buffer_posn_from_coords (w, &wx, &wy, &object, &p);
posn = make_number (CHARPOS (p.pos));
if (STRINGP (object))
string_info
= Fcons (object,
make_number (CHARPOS (p.string_pos)));
}
}
position
= Fcons (window,
Fcons (posn,
Fcons (Fcons (event->x, event->y),
Fcons (make_number (event->timestamp),
(NILP (string_info)
? Qnil
: Fcons (string_info, Qnil))))));
}
#ifndef USE_TOOLKIT_SCROLL_BARS
else
{
Lisp_Object portion_whole;
Lisp_Object part;
window = event->frame_or_window;
portion_whole = Fcons (event->x, event->y);
part = *scroll_bar_parts[(int) event->part];
position
= Fcons (window,
Fcons (Qvertical_scroll_bar,
Fcons (portion_whole,
Fcons (make_number (event->timestamp),
Fcons (part, Qnil)))));
}
#endif
if (button >= ASIZE (button_down_location))
{
button_down_location = larger_vector (button_down_location,
button + 1, Qnil);
mouse_syms = larger_vector (mouse_syms, button + 1, Qnil);
}
start_pos_ptr = &AREF (button_down_location, button);
start_pos = *start_pos_ptr;
*start_pos_ptr = Qnil;
{
struct frame *f;
int fuzz;
if (WINDOWP (event->frame_or_window))
f = XFRAME (XWINDOW (event->frame_or_window)->frame);
else if (FRAMEP (event->frame_or_window))
f = XFRAME (event->frame_or_window);
else
abort ();
if (FRAME_WINDOW_P (f))
fuzz = double_click_fuzz;
else
fuzz = double_click_fuzz / 8;
is_double = (button == last_mouse_button
&& (abs (XINT (event->x) - last_mouse_x) <= fuzz)
&& (abs (XINT (event->y) - last_mouse_y) <= fuzz)
&& button_down_time != 0
&& (EQ (Vdouble_click_time, Qt)
|| (INTEGERP (Vdouble_click_time)
&& ((int)(event->timestamp - button_down_time)
< XINT (Vdouble_click_time)))));
}
last_mouse_button = button;
last_mouse_x = XINT (event->x);
last_mouse_y = XINT (event->y);
if (event->modifiers & down_modifier)
{
if (is_double)
{
double_click_count++;
event->modifiers |= ((double_click_count > 2)
? triple_modifier
: double_modifier);
}
else
double_click_count = 1;
button_down_time = event->timestamp;
*start_pos_ptr = Fcopy_alist (position);
}
else if (event->modifiers & up_modifier)
{
if (!CONSP (start_pos))
return Qnil;
event->modifiers &= ~up_modifier;
#if 0
if (!CONSP (start_pos))
event->modifiers |= click_modifier;
else
#endif
{
Lisp_Object down;
down = Fnth (make_number (2), start_pos);
if (EQ (event->x, XCAR (down)) && EQ (event->y, XCDR (down)))
event->modifiers |= click_modifier;
else
{
Lisp_Object window1, window2, posn1, posn2;
window1 = Fnth (make_number (0), position);
posn1 = Fnth (make_number (1), position);
window2 = Fnth (make_number (0), start_pos);
posn2 = Fnth (make_number (1), start_pos);
if (EQ (window1, window2) && EQ (posn1, posn2))
event->modifiers |= click_modifier;
else
{
button_down_time = 0;
event->modifiers |= drag_modifier;
}
}
if (double_click_count > 1)
event->modifiers |= ((double_click_count > 2)
? triple_modifier
: double_modifier);
}
}
else
abort ();
{
Lisp_Object head;
head = modify_event_symbol (button,
event->modifiers,
Qmouse_click, Vlispy_mouse_stem,
NULL,
&mouse_syms,
XVECTOR (mouse_syms)->size);
if (event->modifiers & drag_modifier)
return Fcons (head,
Fcons (start_pos,
Fcons (position,
Qnil)));
else if (event->modifiers & (double_modifier | triple_modifier))
return Fcons (head,
Fcons (position,
Fcons (make_number (double_click_count),
Qnil)));
else
return Fcons (head,
Fcons (position,
Qnil));
}
}
#if USE_TOOLKIT_SCROLL_BARS
case scroll_bar_click:
{
Lisp_Object position, head, window, portion_whole, part;
window = event->frame_or_window;
portion_whole = Fcons (event->x, event->y);
part = *scroll_bar_parts[(int) event->part];
position
= Fcons (window,
Fcons (Qvertical_scroll_bar,
Fcons (portion_whole,
Fcons (make_number (event->timestamp),
Fcons (part, Qnil)))));
event->modifiers |= click_modifier;
head = modify_event_symbol (event->code,
event->modifiers,
Qmouse_click,
Vlispy_mouse_stem,
NULL, &mouse_syms,
XVECTOR (mouse_syms)->size);
return Fcons (head, Fcons (position, Qnil));
}
#endif
#ifdef WINDOWSNT
case w32_scroll_bar_click:
{
int button = event->code;
int is_double;
Lisp_Object position;
Lisp_Object *start_pos_ptr;
Lisp_Object start_pos;
{
Lisp_Object window;
Lisp_Object portion_whole;
Lisp_Object part;
window = event->frame_or_window;
portion_whole = Fcons (event->x, event->y);
part = *scroll_bar_parts[(int) event->part];
position
= Fcons (window,
Fcons (Qvertical_scroll_bar,
Fcons (portion_whole,
Fcons (make_number (event->timestamp),
Fcons (part, Qnil)))));
}
event->modifiers |= click_modifier;
{
Lisp_Object head;
head = modify_event_symbol (button,
event->modifiers,
Qmouse_click,
Vlispy_mouse_stem,
NULL, &mouse_syms,
XVECTOR (mouse_syms)->size);
return Fcons (head,
Fcons (position,
Qnil));
}
}
case mouse_wheel:
{
int part;
FRAME_PTR f = XFRAME (event->frame_or_window);
Lisp_Object window;
Lisp_Object posn;
Lisp_Object head, position;
int row, column;
if (! FRAME_LIVE_P (f))
return Qnil;
pixel_to_glyph_coords (f, XINT (event->x), XINT (event->y),
&column, &row, NULL, 1);
window = window_from_coordinates (f, XINT (event->x),
XINT (event->y), &part, 0);
if (!WINDOWP (window))
{
window = event->frame_or_window;
posn = Qnil;
}
else
{
int pixcolumn, pixrow;
column -= XINT (XWINDOW (window)->left);
row -= XINT (XWINDOW (window)->top);
glyph_to_pixel_coords (XWINDOW(window), column, row,
&pixcolumn, &pixrow);
XSETINT (event->x, pixcolumn);
XSETINT (event->y, pixrow);
if (part == 1)
posn = Qmode_line;
else if (part == 2)
posn = Qvertical_line;
else if (part == 3)
posn = Qheader_line;
else
{
Lisp_Object object;
struct display_pos p;
buffer_posn_from_coords (XWINDOW (window), &column, &row,
&object, &p);
posn = make_number (CHARPOS (p.pos));
}
}
{
Lisp_Object head, position;
position
= Fcons (window,
Fcons (posn,
Fcons (Fcons (event->x, event->y),
Fcons (make_number (event->timestamp),
Qnil))));
head = modify_event_symbol (0, event->modifiers,
Qmouse_wheel, Qnil,
lispy_mouse_wheel_names,
&mouse_wheel_syms, 1);
return Fcons (head,
Fcons (position,
Fcons (make_number (event->code),
Qnil)));
}
}
#endif
case drag_n_drop:
{
int part;
FRAME_PTR f;
Lisp_Object window;
Lisp_Object posn;
Lisp_Object files;
if (! CONSP (event->frame_or_window))
abort ();
f = XFRAME (XCAR (event->frame_or_window));
files = XCDR (event->frame_or_window);
if (! FRAME_LIVE_P (f))
return Qnil;
window = window_from_coordinates (f, XINT (event->x),
XINT (event->y), &part, 0);
if (!WINDOWP (window))
{
window = XCAR (event->frame_or_window);
posn = Qnil;
}
else
{
struct window *w = XWINDOW (window);
int wx = FRAME_TO_WINDOW_PIXEL_X (w, XINT (event->x));
int wy = FRAME_TO_WINDOW_PIXEL_Y (w, XINT (event->y));
XSETINT (event->x, wx);
XSETINT (event->y, wy);
if (part == 1)
posn = Qmode_line;
else if (part == 2)
posn = Qvertical_line;
else if (part == 3)
posn = Qheader_line;
else
{
Lisp_Object object;
struct display_pos p;
buffer_posn_from_coords (w, &wx, &wy, &object, &p);
posn = make_number (CHARPOS (p.pos));
}
}
{
Lisp_Object head, position;
position
= Fcons (window,
Fcons (posn,
Fcons (Fcons (event->x, event->y),
Fcons (make_number (event->timestamp),
Qnil))));
head = modify_event_symbol (0, event->modifiers,
Qdrag_n_drop, Qnil,
lispy_drag_n_drop_names,
&drag_n_drop_syms, 1);
return Fcons (head,
Fcons (position,
Fcons (files,
Qnil)));
}
}
#endif
#if defined (USE_X_TOOLKIT) || defined (HAVE_NTGUI) || defined (macintosh)
case MENU_BAR_EVENT:
if (EQ (event->arg, event->frame_or_window))
return Fcons (Qmenu_bar, Qnil);
return event->arg;
#endif
case TOOL_BAR_EVENT:
if (EQ (event->arg, event->frame_or_window))
return Fcons (Qtool_bar, Qnil);
else if (SYMBOLP (event->arg))
return apply_modifiers (event->modifiers, event->arg);
return event->arg;
case USER_SIGNAL_EVENT:
return *lispy_user_signals[event->code];
default:
abort ();
}
}
#ifdef HAVE_MOUSE
static Lisp_Object
make_lispy_movement (frame, bar_window, part, x, y, time)
FRAME_PTR frame;
Lisp_Object bar_window;
enum scroll_bar_part part;
Lisp_Object x, y;
unsigned long time;
{
if (frame && ! NILP (bar_window))
{
Lisp_Object part_sym;
part_sym = *scroll_bar_parts[(int) part];
return Fcons (Qscroll_bar_movement,
(Fcons (Fcons (bar_window,
Fcons (Qvertical_scroll_bar,
Fcons (Fcons (x, y),
Fcons (make_number (time),
Fcons (part_sym,
Qnil))))),
Qnil)));
}
else
{
int area;
Lisp_Object window;
Lisp_Object posn;
if (frame)
window = window_from_coordinates (frame, XINT (x), XINT (y), &area, 0);
else
window = Qnil;
if (WINDOWP (window))
{
struct window *w = XWINDOW (window);
int wx, wy;
wx = FRAME_TO_WINDOW_PIXEL_X (w, XINT (x));
wy = FRAME_TO_WINDOW_PIXEL_Y (w, XINT (y));
XSETINT (x, wx);
XSETINT (y, wy);
if (area == 1)
posn = Qmode_line;
else if (area == 2)
posn = Qvertical_line;
else if (area == 3)
posn = Qheader_line;
else
{
Lisp_Object object;
struct display_pos p;
buffer_posn_from_coords (w, &wx, &wy, &object, &p);
posn = make_number (CHARPOS (p.pos));
}
}
else if (frame != 0)
{
XSETFRAME (window, frame);
posn = Qnil;
}
else
{
window = Qnil;
posn = Qnil;
XSETFASTINT (x, 0);
XSETFASTINT (y, 0);
}
return Fcons (Qmouse_movement,
Fcons (Fcons (window,
Fcons (posn,
Fcons (Fcons (x, y),
Fcons (make_number (time),
Qnil)))),
Qnil));
}
}
#endif
static Lisp_Object
make_lispy_switch_frame (frame)
Lisp_Object frame;
{
return Fcons (Qswitch_frame, Fcons (frame, Qnil));
}
static int
parse_modifiers_uncached (symbol, modifier_end)
Lisp_Object symbol;
int *modifier_end;
{
struct Lisp_String *name;
int i;
int modifiers;
CHECK_SYMBOL (symbol, 1);
modifiers = 0;
name = XSYMBOL (symbol)->name;
for (i = 0; i+2 <= STRING_BYTES (name); )
{
int this_mod_end = 0;
int this_mod = 0;
switch (name->data[i])
{
#define SINGLE_LETTER_MOD(BIT) \
(this_mod_end = i + 1, this_mod = BIT)
case 'A':
SINGLE_LETTER_MOD (alt_modifier);
break;
case 'C':
SINGLE_LETTER_MOD (ctrl_modifier);
break;
case 'H':
SINGLE_LETTER_MOD (hyper_modifier);
break;
case 'M':
SINGLE_LETTER_MOD (meta_modifier);
break;
case 'S':
SINGLE_LETTER_MOD (shift_modifier);
break;
case 's':
SINGLE_LETTER_MOD (super_modifier);
break;
#undef SINGLE_LETTER_MOD
}
if (this_mod_end == 0)
break;
if (this_mod_end >= STRING_BYTES (name)
|| name->data[this_mod_end] != '-')
break;
modifiers |= this_mod;
i = this_mod_end + 1;
}
if (! (modifiers & (down_modifier | drag_modifier
| double_modifier | triple_modifier))
&& i + 7 == STRING_BYTES (name)
&& strncmp (name->data + i, "mouse-", 6) == 0
&& ('0' <= name->data[i + 6] && name->data[i + 6] <= '9'))
modifiers |= click_modifier;
if (modifier_end)
*modifier_end = i;
return modifiers;
}
static Lisp_Object
apply_modifiers_uncached (modifiers, base, base_len, base_len_byte)
int modifiers;
char *base;
int base_len, base_len_byte;
{
char *new_mods
= (char *) alloca (sizeof ("A-C-H-M-S-s-down-drag-double-triple-"));
int mod_len;
{
char *p = new_mods;
if (modifiers & up_modifier)
abort ();
if (modifiers & alt_modifier) { *p++ = 'A'; *p++ = '-'; }
if (modifiers & ctrl_modifier) { *p++ = 'C'; *p++ = '-'; }
if (modifiers & hyper_modifier) { *p++ = 'H'; *p++ = '-'; }
if (modifiers & meta_modifier) { *p++ = 'M'; *p++ = '-'; }
if (modifiers & shift_modifier) { *p++ = 'S'; *p++ = '-'; }
if (modifiers & super_modifier) { *p++ = 's'; *p++ = '-'; }
if (modifiers & double_modifier) { strcpy (p, "double-"); p += 7; }
if (modifiers & triple_modifier) { strcpy (p, "triple-"); p += 7; }
if (modifiers & down_modifier) { strcpy (p, "down-"); p += 5; }
if (modifiers & drag_modifier) { strcpy (p, "drag-"); p += 5; }
*p = '\0';
mod_len = p - new_mods;
}
{
Lisp_Object new_name;
new_name = make_uninit_multibyte_string (mod_len + base_len,
mod_len + base_len_byte);
bcopy (new_mods, XSTRING (new_name)->data, mod_len);
bcopy (base, XSTRING (new_name)->data + mod_len, base_len_byte);
return Fintern (new_name, Qnil);
}
}
static char *modifier_names[] =
{
"up", "down", "drag", "click", "double", "triple", 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, "alt", "super", "hyper", "shift", "control", "meta"
};
#define NUM_MOD_NAMES (sizeof (modifier_names) / sizeof (modifier_names[0]))
static Lisp_Object modifier_symbols;
static Lisp_Object
lispy_modifier_list (modifiers)
int modifiers;
{
Lisp_Object modifier_list;
int i;
modifier_list = Qnil;
for (i = 0; (1<<i) <= modifiers && i < NUM_MOD_NAMES; i++)
if (modifiers & (1<<i))
modifier_list = Fcons (XVECTOR (modifier_symbols)->contents[i],
modifier_list);
return modifier_list;
}
Lisp_Object
parse_modifiers (symbol)
Lisp_Object symbol;
{
Lisp_Object elements;
elements = Fget (symbol, Qevent_symbol_element_mask);
if (CONSP (elements))
return elements;
else
{
int end;
int modifiers = parse_modifiers_uncached (symbol, &end);
Lisp_Object unmodified;
Lisp_Object mask;
unmodified = Fintern (make_string (XSYMBOL (symbol)->name->data + end,
STRING_BYTES (XSYMBOL (symbol)->name) - end),
Qnil);
if (modifiers & ~(((EMACS_INT)1 << VALBITS) - 1))
abort ();
XSETFASTINT (mask, modifiers);
elements = Fcons (unmodified, Fcons (mask, Qnil));
Fput (symbol, Qevent_symbol_element_mask,
elements);
Fput (symbol, Qevent_symbol_elements,
Fcons (unmodified, lispy_modifier_list (modifiers)));
return elements;
}
}
static Lisp_Object
apply_modifiers (modifiers, base)
int modifiers;
Lisp_Object base;
{
Lisp_Object cache, index, entry, new_symbol;
modifiers &= ((EMACS_INT)1 << VALBITS) - 1;
cache = Fget (base, Qmodifier_cache);
XSETFASTINT (index, (modifiers & ~click_modifier));
entry = assq_no_quit (index, cache);
if (CONSP (entry))
new_symbol = XCDR (entry);
else
{
new_symbol = apply_modifiers_uncached (modifiers,
XSYMBOL (base)->name->data,
XSYMBOL (base)->name->size,
STRING_BYTES (XSYMBOL (base)->name));
entry = Fcons (index, new_symbol);
Fput (base, Qmodifier_cache, Fcons (entry, cache));
XSETFASTINT (index, modifiers);
Fput (new_symbol, Qevent_symbol_element_mask,
Fcons (base, Fcons (index, Qnil)));
Fput (new_symbol, Qevent_symbol_elements,
Fcons (base, lispy_modifier_list (modifiers)));
}
if (NILP (Fget (new_symbol, Qevent_kind)))
{
Lisp_Object kind;
kind = Fget (base, Qevent_kind);
if (! NILP (kind))
Fput (new_symbol, Qevent_kind, kind);
}
return new_symbol;
}
Lisp_Object
reorder_modifiers (symbol)
Lisp_Object symbol;
{
Lisp_Object parsed;
parsed = parse_modifiers (symbol);
return apply_modifiers ((int) XINT (XCAR (XCDR (parsed))),
XCAR (parsed));
}
static Lisp_Object
modify_event_symbol (symbol_num, modifiers, symbol_kind, name_alist_or_stem,
name_table, symbol_table, table_size)
int symbol_num;
unsigned modifiers;
Lisp_Object symbol_kind;
Lisp_Object name_alist_or_stem;
char **name_table;
Lisp_Object *symbol_table;
unsigned int table_size;
{
Lisp_Object value;
Lisp_Object symbol_int;
XSETINT (symbol_int, symbol_num & 0xffffff);
if (symbol_num < 0 || symbol_num >= table_size)
return Qnil;
if (CONSP (*symbol_table))
value = Fcdr (assq_no_quit (symbol_int, *symbol_table));
else
{
if (! VECTORP (*symbol_table)
|| XVECTOR (*symbol_table)->size != table_size)
{
Lisp_Object size;
XSETFASTINT (size, table_size);
*symbol_table = Fmake_vector (size, Qnil);
}
value = XVECTOR (*symbol_table)->contents[symbol_num];
}
if (NILP (value))
{
if (CONSP (name_alist_or_stem))
value = Fcdr_safe (Fassq (symbol_int, name_alist_or_stem));
else if (STRINGP (name_alist_or_stem))
{
int len = STRING_BYTES (XSTRING (name_alist_or_stem));
char *buf = (char *) alloca (len + 50);
sprintf (buf, "%s-%d", XSTRING (name_alist_or_stem)->data,
XINT (symbol_int) + 1);
value = intern (buf);
}
else if (name_table != 0 && name_table[symbol_num])
value = intern (name_table[symbol_num]);
#ifdef HAVE_WINDOW_SYSTEM
if (NILP (value))
{
char *name = x_get_keysym_name (symbol_num);
if (name)
value = intern (name);
}
#endif
if (NILP (value))
{
char buf[20];
sprintf (buf, "key-%d", symbol_num);
value = intern (buf);
}
if (CONSP (*symbol_table))
*symbol_table = Fcons (Fcons (symbol_int, value), *symbol_table);
else
XVECTOR (*symbol_table)->contents[symbol_num] = value;
apply_modifiers (modifiers & click_modifier, value);
Fput (value, Qevent_kind, symbol_kind);
}
return apply_modifiers (modifiers, value);
}
DEFUN ("event-convert-list", Fevent_convert_list, Sevent_convert_list, 1, 1, 0,
"Convert the event description list EVENT-DESC to an event type.\n\
EVENT-DESC should contain one base event type (a character or symbol)\n\
and zero or more modifier names (control, meta, hyper, super, shift, alt,\n\
drag, down, double or triple). The base must be last.\n\
The return value is an event type (a character or symbol) which\n\
has the same base event type and all the specified modifiers.")
(event_desc)
Lisp_Object event_desc;
{
Lisp_Object base;
int modifiers = 0;
Lisp_Object rest;
base = Qnil;
rest = event_desc;
while (CONSP (rest))
{
Lisp_Object elt;
int this = 0;
elt = XCAR (rest);
rest = XCDR (rest);
if (SYMBOLP (elt) && CONSP (rest))
this = parse_solitary_modifier (elt);
if (this != 0)
modifiers |= this;
else if (!NILP (base))
error ("Two bases given in one event");
else
base = elt;
}
if (SYMBOLP (base) && XSYMBOL (base)->name->size == 1)
XSETINT (base, XSYMBOL (base)->name->data[0]);
if (INTEGERP (base))
{
if ((modifiers & shift_modifier) != 0
&& (XINT (base) >= 'a' && XINT (base) <= 'z'))
{
XSETINT (base, XINT (base) - ('a' - 'A'));
modifiers &= ~shift_modifier;
}
if (modifiers & ctrl_modifier)
return make_number ((modifiers & ~ctrl_modifier)
| make_ctrl_char (XINT (base)));
else
return make_number (modifiers | XINT (base));
}
else if (SYMBOLP (base))
return apply_modifiers (modifiers, base);
else
{
error ("Invalid base event");
return Qnil;
}
}
static int
parse_solitary_modifier (symbol)
Lisp_Object symbol;
{
struct Lisp_String *name = XSYMBOL (symbol)->name;
switch (name->data[0])
{
#define SINGLE_LETTER_MOD(BIT) \
if (STRING_BYTES (name) == 1) \
return BIT;
#define MULTI_LETTER_MOD(BIT, NAME, LEN) \
if (LEN == STRING_BYTES (name) \
&& ! strncmp (name->data, NAME, LEN)) \
return BIT;
case 'A':
SINGLE_LETTER_MOD (alt_modifier);
break;
case 'a':
MULTI_LETTER_MOD (alt_modifier, "alt", 3);
break;
case 'C':
SINGLE_LETTER_MOD (ctrl_modifier);
break;
case 'c':
MULTI_LETTER_MOD (ctrl_modifier, "ctrl", 4);
MULTI_LETTER_MOD (ctrl_modifier, "control", 7);
break;
case 'H':
SINGLE_LETTER_MOD (hyper_modifier);
break;
case 'h':
MULTI_LETTER_MOD (hyper_modifier, "hyper", 5);
break;
case 'M':
SINGLE_LETTER_MOD (meta_modifier);
break;
case 'm':
MULTI_LETTER_MOD (meta_modifier, "meta", 4);
break;
case 'S':
SINGLE_LETTER_MOD (shift_modifier);
break;
case 's':
MULTI_LETTER_MOD (shift_modifier, "shift", 5);
MULTI_LETTER_MOD (super_modifier, "super", 5);
SINGLE_LETTER_MOD (super_modifier);
break;
case 'd':
MULTI_LETTER_MOD (drag_modifier, "drag", 4);
MULTI_LETTER_MOD (down_modifier, "down", 4);
MULTI_LETTER_MOD (double_modifier, "double", 6);
break;
case 't':
MULTI_LETTER_MOD (triple_modifier, "triple", 6);
break;
#undef SINGLE_LETTER_MOD
#undef MULTI_LETTER_MOD
}
return 0;
}
int
lucid_event_type_list_p (object)
Lisp_Object object;
{
Lisp_Object tail;
if (! CONSP (object))
return 0;
if (EQ (XCAR (object), Qhelp_echo)
|| EQ (XCAR (object), Qvertical_line)
|| EQ (XCAR (object), Qmode_line)
|| EQ (XCAR (object), Qheader_line))
return 0;
for (tail = object; CONSP (tail); tail = XCDR (tail))
{
Lisp_Object elt;
elt = XCAR (tail);
if (! (INTEGERP (elt) || SYMBOLP (elt)))
return 0;
}
return NILP (tail);
}
static void
get_input_pending (addr, do_timers_now)
int *addr;
int do_timers_now;
{
*addr = !NILP (Vquit_flag) || readable_events (do_timers_now);
if (*addr > 0 || (interrupt_input && ! interrupts_deferred))
return;
gobble_input (0);
*addr = !NILP (Vquit_flag) || readable_events (do_timers_now);
}
void
gobble_input (expected)
int expected;
{
#ifndef VMS
#ifdef SIGIO
if (interrupt_input)
{
SIGMASKTYPE mask;
mask = sigblock (sigmask (SIGIO));
read_avail_input (expected);
sigsetmask (mask);
}
else
#ifdef POLL_FOR_INPUT
if (read_socket_hook && !interrupt_input && poll_suppress_count == 0)
{
SIGMASKTYPE mask;
mask = sigblock (sigmask (SIGALRM));
read_avail_input (expected);
sigsetmask (mask);
}
else
#endif
#endif
read_avail_input (expected);
#endif
}
void
record_asynch_buffer_change ()
{
struct input_event event;
Lisp_Object tem;
event.kind = buffer_switch_event;
event.frame_or_window = Qnil;
event.arg = Qnil;
#ifdef subprocesses
tem = Fwaiting_for_user_input_p ();
if (NILP (tem))
return;
#else
return;
#endif
#ifdef SIGIO
if (interrupt_input)
{
SIGMASKTYPE mask;
mask = sigblock (sigmask (SIGIO));
kbd_buffer_store_event (&event);
sigsetmask (mask);
}
else
#endif
{
stop_polling ();
kbd_buffer_store_event (&event);
start_polling ();
}
}
#ifndef VMS
static int
read_avail_input (expected)
int expected;
{
struct input_event buf[KBD_BUFFER_SIZE];
register int i;
int nread;
if (read_socket_hook)
nread = (*read_socket_hook) (input_fd, buf, KBD_BUFFER_SIZE, expected);
else
{
unsigned char cbuf[KBD_BUFFER_SIZE - 1];
int n_to_read;
#ifdef WINDOWSNT
return 0;
#else
#ifdef MSDOS
n_to_read = dos_keysns ();
if (n_to_read == 0)
return 0;
#else
#ifdef FIONREAD
if (ioctl (input_fd, FIONREAD, &n_to_read) < 0)
kill (getpid (), SIGHUP);
if (n_to_read == 0)
return 0;
if (n_to_read > sizeof cbuf)
n_to_read = sizeof cbuf;
#else
#if defined (USG) || defined (DGUX)
n_to_read = sizeof cbuf;
fcntl (input_fd, F_SETFL, O_NDELAY);
#else
you lose;
#endif
#endif
#endif
#endif
do
{
#ifdef MSDOS
cbuf[0] = dos_keyread ();
nread = 1;
#else
nread = emacs_read (input_fd, cbuf, n_to_read);
#endif
if (nread == -1 && errno == EIO)
kill (0, SIGHUP);
#if defined (AIX) && (! defined (aix386) && defined (_BSD))
if (nread == 0)
kill (0, SIGHUP);
#endif
}
while (
#if 0
nread < 0 && (errno == EAGAIN
#ifdef EFAULT
|| errno == EFAULT
#endif
#ifdef EBADSLT
|| errno == EBADSLT
#endif
)
#else
0
#endif
);
#ifndef FIONREAD
#if defined (USG) || defined (DGUX)
fcntl (input_fd, F_SETFL, 0);
#endif
#endif
for (i = 0; i < nread; i++)
{
buf[i].kind = ascii_keystroke;
buf[i].modifiers = 0;
if (meta_key == 1 && (cbuf[i] & 0x80))
buf[i].modifiers = meta_modifier;
if (meta_key != 2)
cbuf[i] &= ~0x80;
buf[i].code = cbuf[i];
buf[i].frame_or_window = selected_frame;
buf[i].arg = Qnil;
}
}
for (i = 0; i < nread; i++)
{
kbd_buffer_store_event (&buf[i]);
if (buf[i].kind == ascii_keystroke
&& buf[i].code == quit_char)
break;
}
return nread;
}
#endif
#ifdef SIGIO
SIGTYPE
input_available_signal (signo)
int signo;
{
int old_errno = errno;
#ifdef BSD4_1
extern int select_alarmed;
#endif
#if defined (USG) && !defined (POSIX_SIGNALS)
signal (signo, input_available_signal);
#endif
#ifdef BSD4_1
sigisheld (SIGIO);
#endif
if (input_available_clear_time)
EMACS_SET_SECS_USECS (*input_available_clear_time, 0, 0);
while (1)
{
int nread;
nread = read_avail_input (1);
if (nread <= 0)
break;
#ifdef BSD4_1
select_alarmed = 1;
#endif
}
#ifdef BSD4_1
sigfree ();
#endif
errno = old_errno;
}
#endif
void
reinvoke_input_signal ()
{
#ifdef SIGIO
kill (getpid (), SIGIO);
#endif
}
Lisp_Object
map_prompt (map)
Lisp_Object map;
{
while (CONSP (map))
{
register Lisp_Object tem;
tem = Fcar (map);
if (STRINGP (tem))
return tem;
map = Fcdr (map);
}
return Qnil;
}
static void menu_bar_item P_ ((Lisp_Object, Lisp_Object));
static void menu_bar_one_keymap P_ ((Lisp_Object));
static Lisp_Object menu_bar_items_vector;
static int menu_bar_items_index;
Lisp_Object
menu_bar_items (old)
Lisp_Object old;
{
int nmaps;
Lisp_Object *maps;
Lisp_Object def, tail;
Lisp_Object result;
int mapno;
Lisp_Object oquit;
int i;
struct gcpro gcpro1;
oquit = Vinhibit_quit;
Vinhibit_quit = Qt;
if (!NILP (old))
menu_bar_items_vector = old;
else
menu_bar_items_vector = Fmake_vector (make_number (24), Qnil);
menu_bar_items_index = 0;
GCPRO1 (menu_bar_items_vector);
{
Lisp_Object *tmaps;
if (!NILP (Voverriding_local_map_menu_flag))
{
maps = (Lisp_Object *) alloca (3 * sizeof (maps[0]));
nmaps = 0;
if (!NILP (current_kboard->Voverriding_terminal_local_map))
maps[nmaps++] = current_kboard->Voverriding_terminal_local_map;
if (!NILP (Voverriding_local_map))
maps[nmaps++] = Voverriding_local_map;
}
else
{
int extra_maps = 2;
Lisp_Object map = get_local_map (PT, current_buffer, Qkeymap);
if (!NILP (map))
extra_maps = 3;
nmaps = current_minor_maps (NULL, &tmaps);
maps = (Lisp_Object *) alloca ((nmaps + extra_maps)
* sizeof (maps[0]));
bcopy (tmaps, maps, nmaps * sizeof (maps[0]));
if (!NILP (map))
maps[nmaps++] = map;
maps[nmaps++] = get_local_map (PT, current_buffer, Qlocal_map);
}
maps[nmaps++] = current_global_map;
}
result = Qnil;
for (mapno = nmaps - 1; mapno >= 0; mapno--)
if (!NILP (maps[mapno]))
{
def = get_keymap (access_keymap (maps[mapno], Qmenu_bar, 1, 0, 1),
0, 1);
if (CONSP (def))
menu_bar_one_keymap (def);
}
for (tail = Vmenu_bar_final_items; CONSP (tail); tail = XCDR (tail))
{
int i;
int end = menu_bar_items_index;
for (i = 0; i < end; i += 4)
if (EQ (XCAR (tail), XVECTOR (menu_bar_items_vector)->contents[i]))
{
Lisp_Object tem0, tem1, tem2, tem3;
tem0 = XVECTOR (menu_bar_items_vector)->contents[i + 0];
tem1 = XVECTOR (menu_bar_items_vector)->contents[i + 1];
tem2 = XVECTOR (menu_bar_items_vector)->contents[i + 2];
tem3 = XVECTOR (menu_bar_items_vector)->contents[i + 3];
if (end > i + 4)
bcopy (&XVECTOR (menu_bar_items_vector)->contents[i + 4],
&XVECTOR (menu_bar_items_vector)->contents[i],
(end - i - 4) * sizeof (Lisp_Object));
XVECTOR (menu_bar_items_vector)->contents[end - 4] = tem0;
XVECTOR (menu_bar_items_vector)->contents[end - 3] = tem1;
XVECTOR (menu_bar_items_vector)->contents[end - 2] = tem2;
XVECTOR (menu_bar_items_vector)->contents[end - 1] = tem3;
break;
}
}
i = menu_bar_items_index;
if (i + 4 > XVECTOR (menu_bar_items_vector)->size)
{
Lisp_Object tem;
tem = Fmake_vector (make_number (2 * i), Qnil);
bcopy (XVECTOR (menu_bar_items_vector)->contents,
XVECTOR (tem)->contents, i * sizeof (Lisp_Object));
menu_bar_items_vector = tem;
}
XVECTOR (menu_bar_items_vector)->contents[i++] = Qnil;
XVECTOR (menu_bar_items_vector)->contents[i++] = Qnil;
XVECTOR (menu_bar_items_vector)->contents[i++] = Qnil;
XVECTOR (menu_bar_items_vector)->contents[i++] = Qnil;
menu_bar_items_index = i;
Vinhibit_quit = oquit;
UNGCPRO;
return menu_bar_items_vector;
}
static Lisp_Object menu_bar_one_keymap_changed_items;
static void
menu_bar_one_keymap (keymap)
Lisp_Object keymap;
{
Lisp_Object tail, item;
menu_bar_one_keymap_changed_items = Qnil;
for (tail = keymap; CONSP (tail); tail = XCDR (tail))
{
item = XCAR (tail);
if (CONSP (item))
menu_bar_item (XCAR (item), XCDR (item));
else if (VECTORP (item))
{
int len = XVECTOR (item)->size;
int c;
for (c = 0; c < len; c++)
{
Lisp_Object character;
XSETFASTINT (character, c);
menu_bar_item (character, XVECTOR (item)->contents[c]);
}
}
}
}
Lisp_Object item_properties;
static void
menu_bar_item (key, item)
Lisp_Object key, item;
{
struct gcpro gcpro1;
int i;
Lisp_Object tem;
if (EQ (item, Qundefined))
{
for (i = 0; i < menu_bar_items_index; i += 4)
if (EQ (key, XVECTOR (menu_bar_items_vector)->contents[i]))
{
if (menu_bar_items_index > i + 4)
bcopy (&XVECTOR (menu_bar_items_vector)->contents[i + 4],
&XVECTOR (menu_bar_items_vector)->contents[i],
(menu_bar_items_index - i - 4) * sizeof (Lisp_Object));
menu_bar_items_index -= 4;
}
}
tem = Fmemq (key, menu_bar_one_keymap_changed_items);
if (!NILP (tem) || NILP (item))
return;
menu_bar_one_keymap_changed_items
= Fcons (key, menu_bar_one_keymap_changed_items);
GCPRO1 (key);
i = parse_menu_item (item, 0, 1);
UNGCPRO;
if (!i)
return;
item = XVECTOR (item_properties)->contents[ITEM_PROPERTY_DEF];
for (i = 0; i < menu_bar_items_index; i += 4)
if (EQ (key, XVECTOR (menu_bar_items_vector)->contents[i]))
break;
if (i == menu_bar_items_index)
{
if (i + 4 > XVECTOR (menu_bar_items_vector)->size)
{
Lisp_Object tem;
tem = Fmake_vector (make_number (2 * i), Qnil);
bcopy (XVECTOR (menu_bar_items_vector)->contents,
XVECTOR (tem)->contents, i * sizeof (Lisp_Object));
menu_bar_items_vector = tem;
}
XVECTOR (menu_bar_items_vector)->contents[i++] = key;
XVECTOR (menu_bar_items_vector)->contents[i++]
= XVECTOR (item_properties)->contents[ITEM_PROPERTY_NAME];
XVECTOR (menu_bar_items_vector)->contents[i++] = Fcons (item, Qnil);
XVECTOR (menu_bar_items_vector)->contents[i++] = make_number (0);
menu_bar_items_index = i;
}
else
{
Lisp_Object old;
old = XVECTOR (menu_bar_items_vector)->contents[i + 2];
XVECTOR (menu_bar_items_vector)->contents[i + 2] = Fcons (item, old);
}
}
static Lisp_Object
menu_item_eval_property_1 (arg)
Lisp_Object arg;
{
if (CONSP (arg) && EQ (XCAR (arg), Qquit))
Fsignal (Qquit, Qnil);
return Qnil;
}
Lisp_Object
menu_item_eval_property (sexpr)
Lisp_Object sexpr;
{
int count = specpdl_ptr - specpdl;
Lisp_Object val;
specbind (Qinhibit_redisplay, Qt);
val = internal_condition_case_1 (Feval, sexpr, Qerror,
menu_item_eval_property_1);
return unbind_to (count, val);
}
int
parse_menu_item (item, notreal, inmenubar)
Lisp_Object item;
int notreal, inmenubar;
{
Lisp_Object def, tem, item_string, start;
Lisp_Object cachelist;
Lisp_Object filter;
Lisp_Object keyhint;
int i;
int newcache = 0;
cachelist = Qnil;
filter = Qnil;
keyhint = Qnil;
if (!CONSP (item))
return 0;
if (NILP (item_properties))
item_properties
= Fmake_vector (make_number (ITEM_PROPERTY_ENABLE + 1), Qnil);
for (i = ITEM_PROPERTY_DEF; i < ITEM_PROPERTY_ENABLE; i++)
AREF (item_properties, i) = Qnil;
AREF (item_properties, ITEM_PROPERTY_ENABLE) = Qt;
AREF (item_properties, ITEM_PROPERTY_ITEM) = item;
item_string = XCAR (item);
start = item;
item = XCDR (item);
if (STRINGP (item_string))
{
AREF (item_properties, ITEM_PROPERTY_NAME) = item_string;
if (CONSP (item) && STRINGP (XCAR (item)))
{
AREF (item_properties, ITEM_PROPERTY_HELP) = XCAR (item);
start = item;
item = XCDR (item);
}
if (CONSP (item) && CONSP (XCAR (item))
&& (NILP (XCAR (XCAR (item)))
|| VECTORP (XCAR (XCAR (item)))))
{
cachelist = XCAR (item);
item = XCDR (item);
}
AREF (item_properties, ITEM_PROPERTY_DEF) = item;
if (SYMBOLP (item))
{
tem = Fget (item, Qmenu_enable);
if (!NILP (tem))
AREF (item_properties, ITEM_PROPERTY_ENABLE) = tem;
}
}
else if (EQ (item_string, Qmenu_item) && CONSP (item))
{
AREF (item_properties, ITEM_PROPERTY_NAME) = XCAR (item);
start = XCDR (item);
if (CONSP (start))
{
AREF (item_properties, ITEM_PROPERTY_DEF) = XCAR (start);
item = XCDR (start);
if (CONSP (item) && CONSP (XCAR (item)))
{
cachelist = XCAR (item);
item = XCDR (item);
}
while (CONSP (item) && CONSP (XCDR (item)))
{
tem = XCAR (item);
item = XCDR (item);
if (EQ (tem, QCenable))
AREF (item_properties, ITEM_PROPERTY_ENABLE) = XCAR (item);
else if (EQ (tem, QCvisible) && !notreal)
{
tem = menu_item_eval_property (XCAR (item));
if (NILP (tem))
return 0;
}
else if (EQ (tem, QChelp))
AREF (item_properties, ITEM_PROPERTY_HELP) = XCAR (item);
else if (EQ (tem, QCfilter))
filter = item;
else if (EQ (tem, QCkey_sequence))
{
tem = XCAR (item);
if (NILP (cachelist)
&& (SYMBOLP (tem) || STRINGP (tem) || VECTORP (tem)))
keyhint = item;
}
else if (EQ (tem, QCkeys))
{
tem = XCAR (item);
if (CONSP (tem) || (STRINGP (tem) && NILP (cachelist)))
AREF (item_properties, ITEM_PROPERTY_KEYEQ) = tem;
}
else if (EQ (tem, QCbutton) && CONSP (XCAR (item)))
{
Lisp_Object type;
tem = XCAR (item);
type = XCAR (tem);
if (EQ (type, QCtoggle) || EQ (type, QCradio))
{
AREF (item_properties, ITEM_PROPERTY_SELECTED)
= XCDR (tem);
AREF (item_properties, ITEM_PROPERTY_TYPE)
= type;
}
}
item = XCDR (item);
}
}
else if (inmenubar || !NILP (start))
return 0;
}
else
return 0;
item_string = AREF (item_properties, ITEM_PROPERTY_NAME);
if (!(STRINGP (item_string) || notreal))
{
item_string = menu_item_eval_property (item_string);
if (!STRINGP (item_string))
return 0;
AREF (item_properties, ITEM_PROPERTY_NAME) = item_string;
}
def = AREF (item_properties, ITEM_PROPERTY_DEF);
if (!NILP (filter))
{
def = menu_item_eval_property (list2 (XCAR (filter),
list2 (Qquote, def)));
AREF (item_properties, ITEM_PROPERTY_DEF) = def;
}
if (NILP (def))
return (inmenubar ? 0 : 1);
tem = AREF (item_properties, ITEM_PROPERTY_ENABLE);
if (!EQ (tem, Qt))
{
if (notreal)
tem = Qt;
else
tem = menu_item_eval_property (tem);
if (inmenubar && NILP (tem))
return 0;
AREF (item_properties, ITEM_PROPERTY_ENABLE) = tem;
}
def = AREF (item_properties, ITEM_PROPERTY_DEF);
tem = get_keymap (def, 0, 1);
if (CONSP (tem))
{
AREF (item_properties, ITEM_PROPERTY_MAP) = tem;
AREF (item_properties, ITEM_PROPERTY_DEF) = tem;
return 1;
}
if (inmenubar > 0)
return 1;
if (NILP (cachelist))
{
CHECK_IMPURE (start);
XCDR (start) = Fcons (Fcons (Qnil, Qnil), XCDR (start));
cachelist = XCAR (XCDR (start));
newcache = 1;
tem = AREF (item_properties, ITEM_PROPERTY_KEYEQ);
if (!NILP (keyhint))
{
XCAR (cachelist) = XCAR (keyhint);
newcache = 0;
}
else if (STRINGP (tem))
{
XCDR (cachelist) = Fsubstitute_command_keys (tem);
XCAR (cachelist) = Qt;
}
}
tem = XCAR (cachelist);
if (!EQ (tem, Qt))
{
int chkcache = 0;
Lisp_Object prefix;
if (!NILP (tem))
tem = Fkey_binding (tem, Qnil);
prefix = AREF (item_properties, ITEM_PROPERTY_KEYEQ);
if (CONSP (prefix))
{
def = XCAR (prefix);
prefix = XCDR (prefix);
}
else
def = AREF (item_properties, ITEM_PROPERTY_DEF);
if (!update_menu_bindings)
chkcache = 0;
else if (NILP (XCAR (cachelist)))
{
if (newcache
|| (CONSP (Vdefine_key_rebound_commands)
&& !NILP (Fmemq (def, Vdefine_key_rebound_commands))))
chkcache = 1;
}
else if (NILP (tem)
|| (!EQ (tem, def)
&& !(SYMBOLP (def) && EQ (tem, XSYMBOL (def)->function))))
chkcache = 1;
if (chkcache)
{
if (SYMBOLP (def)
&& SYMBOLP (XSYMBOL (def)->function)
&& ! NILP (Fget (def, Qmenu_alias)))
def = XSYMBOL (def)->function;
tem = Fwhere_is_internal (def, Qnil, Qt, Qnil);
XCAR (cachelist) = tem;
if (NILP (tem))
{
XCDR (cachelist) = Qnil;
chkcache = 0;
}
}
else if (!NILP (keyhint) && !NILP (XCAR (cachelist)))
{
tem = XCAR (cachelist);
chkcache = 1;
}
newcache = chkcache;
if (chkcache)
{
tem = Fkey_description (tem);
if (CONSP (prefix))
{
if (STRINGP (XCAR (prefix)))
tem = concat2 (XCAR (prefix), tem);
if (STRINGP (XCDR (prefix)))
tem = concat2 (tem, XCDR (prefix));
}
XCDR (cachelist) = tem;
}
}
tem = XCDR (cachelist);
if (newcache && !NILP (tem))
{
tem = concat3 (build_string (" ("), tem, build_string (")"));
XCDR (cachelist) = tem;
}
if (notreal)
return 1;
AREF (item_properties, ITEM_PROPERTY_KEYEQ) = tem;
tem = AREF (item_properties, ITEM_PROPERTY_SELECTED);
if (!NILP (tem))
AREF (item_properties, ITEM_PROPERTY_SELECTED)
= menu_item_eval_property (tem);
return 1;
}
static Lisp_Object tool_bar_items_vector;
static Lisp_Object tool_bar_item_properties;
static int ntool_bar_items;
extern Lisp_Object Qtool_bar;
Lisp_Object QCimage;
static void init_tool_bar_items P_ ((Lisp_Object));
static void process_tool_bar_item P_ ((Lisp_Object, Lisp_Object));
static int parse_tool_bar_item P_ ((Lisp_Object, Lisp_Object));
static void append_tool_bar_item P_ ((void));
Lisp_Object
tool_bar_items (reuse, nitems)
Lisp_Object reuse;
int *nitems;
{
Lisp_Object *maps;
int nmaps, i;
Lisp_Object oquit;
Lisp_Object *tmaps;
extern Lisp_Object Voverriding_local_map_menu_flag;
extern Lisp_Object Voverriding_local_map;
*nitems = 0;
oquit = Vinhibit_quit;
Vinhibit_quit = Qt;
init_tool_bar_items (reuse);
if (!NILP (Voverriding_local_map_menu_flag))
{
maps = (Lisp_Object *) alloca (3 * sizeof (maps[0]));
nmaps = 0;
if (!NILP (current_kboard->Voverriding_terminal_local_map))
maps[nmaps++] = current_kboard->Voverriding_terminal_local_map;
if (!NILP (Voverriding_local_map))
maps[nmaps++] = Voverriding_local_map;
}
else
{
int extra_maps = 2;
Lisp_Object map = get_local_map (PT, current_buffer, Qkeymap);
if (!NILP (map))
extra_maps = 3;
nmaps = current_minor_maps (NULL, &tmaps);
maps = (Lisp_Object *) alloca ((nmaps + extra_maps)
* sizeof (maps[0]));
bcopy (tmaps, maps, nmaps * sizeof (maps[0]));
if (!NILP (map))
maps[nmaps++] = map;
maps[nmaps++] = get_local_map (PT, current_buffer, Qlocal_map);
}
maps[nmaps++] = current_global_map;
for (i = nmaps - 1; i >= 0; --i)
if (!NILP (maps[i]))
{
Lisp_Object keymap;
keymap = get_keymap (access_keymap (maps[i], Qtool_bar, 1, 0, 1), 0, 1);
if (CONSP (keymap))
{
Lisp_Object tail;
for (tail = keymap; CONSP (tail); tail = XCDR (tail))
{
Lisp_Object keydef = XCAR (tail);
if (CONSP (keydef))
process_tool_bar_item (XCAR (keydef), XCDR (keydef));
}
}
}
Vinhibit_quit = oquit;
*nitems = ntool_bar_items / TOOL_BAR_ITEM_NSLOTS;
return tool_bar_items_vector;
}
static void
process_tool_bar_item (key, def)
Lisp_Object key, def;
{
int i;
extern Lisp_Object Qundefined;
struct gcpro gcpro1, gcpro2;
GCPRO2 (key, def);
if (EQ (def, Qundefined))
{
for (i = 0; i < ntool_bar_items; i += TOOL_BAR_ITEM_NSLOTS)
{
Lisp_Object *v = XVECTOR (tool_bar_items_vector)->contents + i;
if (EQ (key, v[TOOL_BAR_ITEM_KEY]))
{
if (ntool_bar_items > i + TOOL_BAR_ITEM_NSLOTS)
bcopy (v + TOOL_BAR_ITEM_NSLOTS, v,
((ntool_bar_items - i - TOOL_BAR_ITEM_NSLOTS)
* sizeof (Lisp_Object)));
ntool_bar_items -= TOOL_BAR_ITEM_NSLOTS;
break;
}
}
}
else if (parse_tool_bar_item (key, def))
append_tool_bar_item ();
UNGCPRO;
}
static int
parse_tool_bar_item (key, item)
Lisp_Object key, item;
{
#define PROP(IDX) XVECTOR (tool_bar_item_properties)->contents[IDX]
Lisp_Object filter = Qnil;
Lisp_Object caption;
extern Lisp_Object QCenable, QCvisible, QChelp, QCfilter;
extern Lisp_Object QCbutton, QCtoggle, QCradio;
int i;
if (!CONSP (item)
|| !EQ (XCAR (item), Qmenu_item)
|| (item = XCDR (item),
!CONSP (item)))
return 0;
if (VECTORP (tool_bar_item_properties))
{
for (i = 0; i < TOOL_BAR_ITEM_NSLOTS; ++i)
PROP (i) = Qnil;
}
else
tool_bar_item_properties
= Fmake_vector (make_number (TOOL_BAR_ITEM_NSLOTS), Qnil);
PROP (TOOL_BAR_ITEM_KEY) = key;
PROP (TOOL_BAR_ITEM_ENABLED_P) = Qt;
caption = XCAR (item);
if (!STRINGP (caption))
{
caption = menu_item_eval_property (caption);
if (!STRINGP (caption))
return 0;
}
PROP (TOOL_BAR_ITEM_CAPTION) = caption;
item = XCDR (item);
if (!CONSP (item))
return 0;
PROP (TOOL_BAR_ITEM_BINDING) = XCAR (item);
item = XCDR (item);
if (CONSP (item) && CONSP (XCAR (item)))
item = XCDR (item);
for (; CONSP (item) && CONSP (XCDR (item)); item = XCDR (XCDR (item)))
{
Lisp_Object key, value;
key = XCAR (item);
value = XCAR (XCDR (item));
if (EQ (key, QCenable))
PROP (TOOL_BAR_ITEM_ENABLED_P) = value;
else if (EQ (key, QCvisible))
{
if (NILP (menu_item_eval_property (value)))
return 0;
}
else if (EQ (key, QChelp))
PROP (TOOL_BAR_ITEM_HELP) = value;
else if (EQ (key, QCfilter))
filter = value;
else if (EQ (key, QCbutton) && CONSP (value))
{
Lisp_Object type, selected;
type = XCAR (value);
selected = XCDR (value);
if (EQ (type, QCtoggle) || EQ (type, QCradio))
{
PROP (TOOL_BAR_ITEM_SELECTED_P) = selected;
PROP (TOOL_BAR_ITEM_TYPE) = type;
}
}
else if (EQ (key, QCimage)
&& (CONSP (value)
|| (VECTORP (value) && XVECTOR (value)->size == 4)))
PROP (TOOL_BAR_ITEM_IMAGES) = value;
}
if (!NILP (filter))
PROP (TOOL_BAR_ITEM_BINDING)
= menu_item_eval_property (list2 (filter,
list2 (Qquote,
PROP (TOOL_BAR_ITEM_BINDING))));
if (CONSP (get_keymap (PROP (TOOL_BAR_ITEM_BINDING), 0, 1)))
return 0;
if (!EQ (PROP (TOOL_BAR_ITEM_ENABLED_P), Qt))
PROP (TOOL_BAR_ITEM_ENABLED_P)
= menu_item_eval_property (PROP (TOOL_BAR_ITEM_ENABLED_P));
if (!NILP (PROP (TOOL_BAR_ITEM_SELECTED_P)))
PROP (TOOL_BAR_ITEM_SELECTED_P)
= menu_item_eval_property (PROP (TOOL_BAR_ITEM_SELECTED_P));
return 1;
#undef PROP
}
static void
init_tool_bar_items (reuse)
Lisp_Object reuse;
{
if (VECTORP (reuse))
tool_bar_items_vector = reuse;
else
tool_bar_items_vector = Fmake_vector (make_number (64), Qnil);
ntool_bar_items = 0;
}
static void
append_tool_bar_item ()
{
Lisp_Object *to, *from;
if (ntool_bar_items + TOOL_BAR_ITEM_NSLOTS
>= XVECTOR (tool_bar_items_vector)->size)
{
Lisp_Object new_vector;
int old_size = XVECTOR (tool_bar_items_vector)->size;
new_vector = Fmake_vector (make_number (2 * old_size), Qnil);
bcopy (XVECTOR (tool_bar_items_vector)->contents,
XVECTOR (new_vector)->contents,
old_size * sizeof (Lisp_Object));
tool_bar_items_vector = new_vector;
}
to = XVECTOR (tool_bar_items_vector)->contents + ntool_bar_items;
from = XVECTOR (tool_bar_item_properties)->contents;
bcopy (from, to, TOOL_BAR_ITEM_NSLOTS * sizeof *to);
ntool_bar_items += TOOL_BAR_ITEM_NSLOTS;
}
static Lisp_Object
read_char_x_menu_prompt (nmaps, maps, prev_event, used_mouse_menu)
int nmaps;
Lisp_Object *maps;
Lisp_Object prev_event;
int *used_mouse_menu;
{
int mapno;
register Lisp_Object name;
if (used_mouse_menu)
*used_mouse_menu = 0;
if (! menu_prompting)
return Qnil;
if (inhibit_local_menu_bar_menus)
{
maps += (nmaps - 1);
nmaps = 1;
}
for (mapno = 0; mapno < nmaps; mapno++)
{
name = map_prompt (maps[mapno]);
if (!NILP (name))
break;
}
if (mapno >= nmaps)
return Qnil;
#ifdef HAVE_MENUS
if (EVENT_HAS_PARAMETERS (prev_event)
&& !EQ (XCAR (prev_event), Qmenu_bar)
&& !EQ (XCAR (prev_event), Qtool_bar))
{
Lisp_Object *realmaps
= (Lisp_Object *) alloca (nmaps * sizeof (Lisp_Object));
Lisp_Object value;
int nmaps1 = 0;
for (mapno = 0; mapno < nmaps; mapno++)
if (!NILP (maps[mapno]))
realmaps[nmaps1++] = maps[mapno];
value = Fx_popup_menu (prev_event, Flist (nmaps1, realmaps));
if (CONSP (value))
{
Lisp_Object tem;
record_menu_key (XCAR (value));
for (tem = XCDR (value); !NILP (tem); tem = XCDR (tem))
{
record_menu_key (XCAR (tem));
if (SYMBOLP (XCAR (tem))
|| INTEGERP (XCAR (tem)))
XCAR (tem) = Fcons (XCAR (tem), Qdisabled);
}
Vunread_command_events
= nconc2 (XCDR (value), Vunread_command_events);
value = XCAR (value);
}
else if (NILP (value))
value = Qt;
if (used_mouse_menu)
*used_mouse_menu = 1;
return value;
}
#endif
return Qnil ;
}
static char *read_char_minibuf_menu_text;
static int read_char_minibuf_menu_width;
static Lisp_Object
read_char_minibuf_menu_prompt (commandflag, nmaps, maps)
int commandflag ;
int nmaps;
Lisp_Object *maps;
{
int mapno;
register Lisp_Object name;
int nlength;
int width = FRAME_WIDTH (SELECTED_FRAME ()) - 4;
int idx = -1;
int nobindings = 1;
Lisp_Object rest, vector;
char *menu;
vector = Qnil;
if (! menu_prompting)
return Qnil;
if (read_char_minibuf_menu_text == 0)
{
read_char_minibuf_menu_width = width + 4;
read_char_minibuf_menu_text = (char *) xmalloc (width + 4);
}
else if (width + 4 > read_char_minibuf_menu_width)
{
read_char_minibuf_menu_width = width + 4;
read_char_minibuf_menu_text
= (char *) xrealloc (read_char_minibuf_menu_text, width + 4);
}
menu = read_char_minibuf_menu_text;
for (mapno = 0; mapno < nmaps; mapno++)
{
name = map_prompt (maps[mapno]);
if (!NILP (name))
break;
}
if (mapno >= nmaps)
return Qnil;
strcpy (menu, XSTRING (name)->data);
nlength = STRING_BYTES (XSTRING (name));
menu[nlength++] = ':';
menu[nlength++] = ' ';
menu[nlength] = 0;
mapno = 0;
rest = maps[mapno];
while (1)
{
int notfirst = 0;
int i = nlength;
Lisp_Object obj;
int ch;
Lisp_Object orig_defn_macro;
while (i < width)
{
Lisp_Object elt;
if (NILP (rest))
{
mapno++;
if (mapno == nmaps)
{
mapno = 0;
if (notfirst || nobindings) break;
}
rest = maps[mapno];
}
if (idx >= 0)
elt = XVECTOR (vector)->contents[idx];
else
elt = Fcar_safe (rest);
if (idx < 0 && VECTORP (elt))
{
rest = Fcdr_safe (rest);
vector = elt;
idx = 0;
}
else
{
Lisp_Object event, tem;
if (idx < 0)
{
event = Fcar_safe (elt);
elt = Fcdr_safe (elt);
}
else
{
XSETINT (event, idx);
}
if (INTEGERP (event) && parse_menu_item (elt, 0, -1))
{
int char_matches;
Lisp_Object upcased_event, downcased_event;
Lisp_Object desc = Qnil;
Lisp_Object s
= XVECTOR (item_properties)->contents[ITEM_PROPERTY_NAME];
upcased_event = Fupcase (event);
downcased_event = Fdowncase (event);
char_matches = (XINT (upcased_event) == XSTRING (s)->data[0]
|| XINT (downcased_event) == XSTRING (s)->data[0]);
if (! char_matches)
desc = Fsingle_key_description (event, Qnil);
tem
= XVECTOR (item_properties)->contents[ITEM_PROPERTY_KEYEQ];
if (!NILP (tem))
s = concat2 (s, tem);
tem
= XVECTOR (item_properties)->contents[ITEM_PROPERTY_TYPE];
if (EQ (tem, QCradio) || EQ (tem, QCtoggle))
{
Lisp_Object selected
= XVECTOR (item_properties)->contents[ITEM_PROPERTY_SELECTED];
if (EQ (tem, QCradio))
tem = build_string (NILP (selected) ? "(*) " : "( ) ");
else
tem = build_string (NILP (selected) ? "[X] " : "[ ] ");
s = concat2 (tem, s);
}
if ((XSTRING (s)->size + i + 2
+ (char_matches ? 0 : XSTRING (desc)->size + 3))
< width
|| !notfirst)
{
int thiswidth;
if (notfirst)
{
strcpy (menu + i, ", ");
i += 2;
}
notfirst = 1;
nobindings = 0 ;
if (! char_matches)
{
thiswidth = XSTRING (desc)->size;
if (thiswidth + i > width)
thiswidth = width - i;
bcopy (XSTRING (desc)->data, menu + i, thiswidth);
i += thiswidth;
strcpy (menu + i, " = ");
i += 3;
}
thiswidth = XSTRING (s)->size;
if (thiswidth + i > width)
thiswidth = width - i;
bcopy (XSTRING (s)->data, menu + i, thiswidth);
i += thiswidth;
menu[i] = 0;
}
else
{
strcpy (menu + i, "...");
break;
}
}
if (idx >= 0 && idx + 1 >= XVECTOR (vector)->size)
idx = -1;
if (idx >= 0)
idx++;
else
rest = Fcdr_safe (rest);
}
}
message2_nolog (menu, strlen (menu),
! NILP (current_buffer->enable_multibyte_characters));
orig_defn_macro = current_kboard->defining_kbd_macro;
current_kboard->defining_kbd_macro = Qnil;
do
obj = read_char (commandflag, 0, 0, Qt, 0);
while (BUFFERP (obj));
current_kboard->defining_kbd_macro = orig_defn_macro;
if (!INTEGERP (obj))
return obj;
else
ch = XINT (obj);
if (! EQ (obj, menu_prompt_more_char)
&& (!INTEGERP (menu_prompt_more_char)
|| ! EQ (obj, make_number (Ctl (XINT (menu_prompt_more_char))))))
{
if (!NILP (current_kboard->defining_kbd_macro))
store_kbd_macro_char (obj);
return obj;
}
}
}
static int
follow_key (key, nmaps, current, defs, next)
Lisp_Object key;
Lisp_Object *current, *defs, *next;
int nmaps;
{
int i, first_binding;
int did_meta = 0;
first_binding = nmaps;
for (i = nmaps - 1; i >= 0; i--)
{
if (! NILP (current[i]))
{
Lisp_Object map;
if (did_meta)
map = defs[i];
else
map = current[i];
defs[i] = access_keymap (map, key, 1, 0, 1);
if (! NILP (defs[i]))
first_binding = i;
}
else
defs[i] = Qnil;
}
if (first_binding < nmaps)
for (i = 0; i < nmaps; i++)
next[i] = NILP (defs[i]) ? Qnil : get_keymap (defs[i], 0, 1);
return first_binding;
}
static int
read_key_sequence (keybuf, bufsize, prompt, dont_downcase_last,
can_return_switch_frame, fix_current_buffer)
Lisp_Object *keybuf;
int bufsize;
Lisp_Object prompt;
int dont_downcase_last;
int can_return_switch_frame;
int fix_current_buffer;
{
volatile Lisp_Object from_string;
volatile int count = specpdl_ptr - specpdl;
volatile int t;
volatile int echo_start;
volatile int keys_start;
volatile int nmaps;
volatile int nmaps_allocated = 0;
Lisp_Object *volatile defs = NULL;
Lisp_Object *volatile submaps = NULL;
volatile Lisp_Object orig_local_map;
volatile Lisp_Object orig_keymap;
volatile int localized_local_map = 0;
volatile int first_binding;
volatile int mock_input = 0;
volatile int fkey_start = 0, fkey_end = 0;
volatile Lisp_Object fkey_map;
volatile int keytran_start = 0, keytran_end = 0;
volatile Lisp_Object keytran_map;
volatile Lisp_Object delayed_switch_frame;
#if defined (GOBBLE_FIRST_EVENT)
Lisp_Object first_event;
#endif
volatile Lisp_Object original_uppercase;
volatile int original_uppercase_position = -1;
int dummyflag = 0;
struct buffer *starting_buffer;
volatile int function_key_possible = 0;
volatile int key_translation_possible = 0;
volatile Lisp_Object fake_prefixed_keys = Qnil;
Lisp_Object prev_fkey_map;
int prev_fkey_start;
int prev_fkey_end;
Lisp_Object prev_keytran_map;
int prev_keytran_start;
int prev_keytran_end;
#if defined (GOBBLE_FIRST_EVENT)
int junk;
#endif
struct gcpro gcpro1;
GCPRO1 (fake_prefixed_keys);
raw_keybuf_count = 0;
last_nonmenu_event = Qnil;
delayed_switch_frame = Qnil;
fkey_map = Vfunction_key_map;
keytran_map = Vkey_translation_map;
if (!KEYMAPP (Vfunction_key_map))
fkey_start = fkey_end = bufsize + 1;
if (!KEYMAPP (Vkey_translation_map))
keytran_start = keytran_end = bufsize + 1;
if (INTERACTIVE)
{
if (!NILP (prompt))
echo_prompt (prompt);
else if (cursor_in_echo_area
&& (FLOATP (Vecho_keystrokes) || INTEGERP (Vecho_keystrokes))
&& NILP (Fzerop (Vecho_keystrokes)))
echo_dash ();
}
if (INTERACTIVE)
echo_start = echo_length ();
keys_start = this_command_key_count;
this_single_command_key_start = keys_start;
#if defined (GOBBLE_FIRST_EVENT)
first_event = read_char (NILP (prompt), 0, submaps, last_nonmenu_event,
&junk);
#endif
orig_local_map = get_local_map (PT, current_buffer, Qlocal_map);
orig_keymap = get_local_map (PT, current_buffer, Qkeymap);
from_string = Qnil;
replay_sequence:
starting_buffer = current_buffer;
function_key_possible = 0;
key_translation_possible = 0;
{
Lisp_Object *maps;
if (!NILP (current_kboard->Voverriding_terminal_local_map)
|| !NILP (Voverriding_local_map))
{
if (3 > nmaps_allocated)
{
submaps = (Lisp_Object *) alloca (3 * sizeof (submaps[0]));
defs = (Lisp_Object *) alloca (3 * sizeof (defs[0]));
nmaps_allocated = 3;
}
nmaps = 0;
if (!NILP (current_kboard->Voverriding_terminal_local_map))
submaps[nmaps++] = current_kboard->Voverriding_terminal_local_map;
if (!NILP (Voverriding_local_map))
submaps[nmaps++] = Voverriding_local_map;
}
else
{
int extra_maps = 2;
nmaps = current_minor_maps (0, &maps);
if (!NILP (orig_keymap))
extra_maps = 3;
if (nmaps + extra_maps > nmaps_allocated)
{
submaps = (Lisp_Object *) alloca ((nmaps+extra_maps)
* sizeof (submaps[0]));
defs = (Lisp_Object *) alloca ((nmaps+extra_maps)
* sizeof (defs[0]));
nmaps_allocated = nmaps + extra_maps;
}
bcopy (maps, (void *) submaps, nmaps * sizeof (submaps[0]));
if (!NILP (orig_keymap))
submaps[nmaps++] = orig_keymap;
submaps[nmaps++] = orig_local_map;
}
submaps[nmaps++] = current_global_map;
}
for (first_binding = 0; first_binding < nmaps; first_binding++)
if (! NILP (submaps[first_binding]))
break;
t = 0;
this_command_key_count = keys_start;
if (INTERACTIVE && t < mock_input)
echo_truncate (echo_start);
while ((first_binding < nmaps && ! NILP (submaps[first_binding]))
|| (first_binding >= nmaps
&& fkey_start < t
&& mock_input <= fkey_start)
|| (first_binding >= nmaps
&& keytran_start < t && key_translation_possible)
)
{
Lisp_Object key;
int used_mouse_menu = 0;
volatile int last_real_key_start;
volatile int echo_local_start, keys_local_start, local_first_binding;
if (t >= bufsize)
error ("Key sequence too long");
if (INTERACTIVE)
echo_local_start = echo_length ();
keys_local_start = this_command_key_count;
local_first_binding = first_binding;
replay_key:
if (INTERACTIVE && t < mock_input)
echo_truncate (echo_local_start);
this_command_key_count = keys_local_start;
first_binding = local_first_binding;
last_real_key_start = t;
if (t < mock_input)
{
key = keybuf[t];
add_command_key (key);
if ((FLOATP (Vecho_keystrokes) || INTEGERP (Vecho_keystrokes))
&& NILP (Fzerop (Vecho_keystrokes)))
echo_char (key);
}
else
{
{
#ifdef MULTI_KBOARD
KBOARD *interrupted_kboard = current_kboard;
struct frame *interrupted_frame = SELECTED_FRAME ();
if (setjmp (wrong_kboard_jmpbuf))
{
if (!NILP (delayed_switch_frame))
{
interrupted_kboard->kbd_queue
= Fcons (delayed_switch_frame,
interrupted_kboard->kbd_queue);
delayed_switch_frame = Qnil;
}
while (t > 0)
interrupted_kboard->kbd_queue
= Fcons (keybuf[--t], interrupted_kboard->kbd_queue);
if (CONSP (interrupted_kboard->kbd_queue)
&& (key = XCAR (interrupted_kboard->kbd_queue),
!(EVENT_HAS_PARAMETERS (key)
&& EQ (EVENT_HEAD_KIND (EVENT_HEAD (key)),
Qswitch_frame))))
{
Lisp_Object frame;
XSETFRAME (frame, interrupted_frame);
interrupted_kboard->kbd_queue
= Fcons (make_lispy_switch_frame (frame),
interrupted_kboard->kbd_queue);
}
mock_input = 0;
orig_local_map = get_local_map (PT, current_buffer, Qlocal_map);
orig_keymap = get_local_map (PT, current_buffer, Qkeymap);
goto replay_sequence;
}
#endif
key = read_char (NILP (prompt), nmaps,
(Lisp_Object *) submaps, last_nonmenu_event,
&used_mouse_menu);
}
if (EQ (key, Qt))
{
unbind_to (count, Qnil);
UNGCPRO;
return -1;
}
if (INTEGERP (key) && XINT (key) == -1)
{
t = 0;
dummyflag = 1;
break;
}
if (BUFFERP (key))
{
mock_input = t;
if (fix_current_buffer)
{
if (! FRAME_LIVE_P (XFRAME (selected_frame)))
Fkill_emacs (Qnil);
if (XBUFFER (XWINDOW (selected_window)->buffer) != current_buffer)
Fset_buffer (XWINDOW (selected_window)->buffer);
}
orig_local_map = get_local_map (PT, current_buffer, Qlocal_map);
orig_keymap = get_local_map (PT, current_buffer, Qkeymap);
goto replay_sequence;
}
if (INTEGERP (key)
&& XINT (key) == quit_char
&& current_buffer != starting_buffer)
{
GROW_RAW_KEYBUF;
XVECTOR (raw_keybuf)->contents[raw_keybuf_count++] = key;
keybuf[t++] = key;
mock_input = t;
Vquit_flag = Qnil;
orig_local_map = get_local_map (PT, current_buffer, Qlocal_map);
orig_keymap = get_local_map (PT, current_buffer, Qkeymap);
goto replay_sequence;
}
Vquit_flag = Qnil;
if (EVENT_HAS_PARAMETERS (key)
&& EQ (EVENT_HEAD_KIND (EVENT_HEAD (key)), Qswitch_frame))
{
if (t > 0 || !can_return_switch_frame)
{
delayed_switch_frame = key;
goto replay_key;
}
}
GROW_RAW_KEYBUF;
XVECTOR (raw_keybuf)->contents[raw_keybuf_count++] = key;
}
if (EVENT_HAS_PARAMETERS (key))
{
Lisp_Object kind;
kind = EVENT_HEAD_KIND (EVENT_HEAD (key));
if (EQ (kind, Qmouse_click))
{
Lisp_Object window, posn;
window = POSN_WINDOW (EVENT_START (key));
posn = POSN_BUFFER_POSN (EVENT_START (key));
if (CONSP (posn)
|| (!NILP (fake_prefixed_keys)
&& !NILP (Fmemq (key, fake_prefixed_keys))))
{
if (t > 0)
last_real_key_start = t - 1;
}
if (last_real_key_start == 0
&& WINDOWP (window)
&& BUFFERP (XWINDOW (window)->buffer)
&& XBUFFER (XWINDOW (window)->buffer) != current_buffer)
{
XVECTOR (raw_keybuf)->contents[raw_keybuf_count++] = key;
keybuf[t] = key;
mock_input = t + 1;
record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
if (! FRAME_LIVE_P (XFRAME (selected_frame)))
Fkill_emacs (Qnil);
set_buffer_internal (XBUFFER (XWINDOW (window)->buffer));
orig_local_map = get_local_map (PT, current_buffer,
Qlocal_map);
orig_keymap = get_local_map (PT, current_buffer, Qkeymap);
goto replay_sequence;
}
if (last_real_key_start == 0
&& CONSP (XCDR (key))
&& ! localized_local_map)
{
Lisp_Object map_here, start, pos;
localized_local_map = 1;
start = EVENT_START (key);
if (CONSP (start) && CONSP (XCDR (start)))
{
pos = POSN_BUFFER_POSN (start);
if (INTEGERP (pos)
&& XINT (pos) >= BEG && XINT (pos) <= Z)
{
map_here = get_local_map (XINT (pos),
current_buffer, Qlocal_map);
if (!EQ (map_here, orig_local_map))
{
orig_local_map = map_here;
keybuf[t] = key;
mock_input = t + 1;
goto replay_sequence;
}
map_here = get_local_map (XINT (pos),
current_buffer, Qkeymap);
if (!EQ (map_here, orig_keymap))
{
orig_keymap = map_here;
keybuf[t] = key;
mock_input = t + 1;
goto replay_sequence;
}
}
}
}
if (SYMBOLP (posn)
&& (NILP (fake_prefixed_keys)
|| NILP (Fmemq (key, fake_prefixed_keys))))
{
if (t + 1 >= bufsize)
error ("Key sequence too long");
keybuf[t] = posn;
keybuf[t + 1] = key;
mock_input = t + 2;
fake_prefixed_keys = Fcons (key, fake_prefixed_keys);
if (CONSP (POSN_STRING (EVENT_START (key))))
{
Lisp_Object string, pos, map, map2;
string = POSN_STRING (EVENT_START (key));
pos = XCDR (string);
string = XCAR (string);
if (XINT (pos) >= 0
&& XINT (pos) < XSTRING (string)->size)
{
map = Fget_text_property (pos, Qlocal_map, string);
if (!NILP (map))
orig_local_map = map;
map2 = Fget_text_property (pos, Qkeymap, string);
if (!NILP (map2))
orig_keymap = map2;
if (!NILP (map) || !NILP (map2))
goto replay_sequence;
}
}
goto replay_key;
}
else if (CONSP (POSN_STRING (EVENT_START (key)))
&& NILP (from_string))
{
Lisp_Object string, pos, map, map2;
string = POSN_STRING (EVENT_START (key));
pos = XCDR (string);
string = XCAR (string);
if (XINT (pos) >= 0
&& XINT (pos) < XSTRING (string)->size)
{
map = Fget_text_property (pos, Qlocal_map, string);
if (!NILP (map))
orig_local_map = map;
map2 = Fget_text_property (pos, Qkeymap, string);
if (!NILP (map2))
orig_keymap = map2;
if (!NILP (map) || !NILP (map2))
{
from_string = string;
goto replay_sequence;
}
}
}
}
else if (CONSP (XCDR (key))
&& CONSP (EVENT_START (key))
&& CONSP (XCDR (EVENT_START (key))))
{
Lisp_Object posn;
posn = POSN_BUFFER_POSN (EVENT_START (key));
if (EQ (posn, Qmenu_bar) || EQ (posn, Qtool_bar))
{
if (t + 1 >= bufsize)
error ("Key sequence too long");
keybuf[t] = posn;
keybuf[t+1] = key;
POSN_BUFFER_POSN (EVENT_START (key))
= Fcons (posn, Qnil);
mock_input = t + 2;
goto replay_sequence;
}
else if (CONSP (posn))
{
if (last_real_key_start == t && t > 0)
last_real_key_start = t - 1;
}
}
}
first_binding = (follow_key (key,
nmaps - first_binding,
submaps + first_binding,
defs + first_binding,
submaps + first_binding)
+ first_binding);
if (first_binding >= nmaps)
{
Lisp_Object head;
head = EVENT_HEAD (key);
if (help_char_p (head) && t > 0)
{
read_key_sequence_cmd = Vprefix_help_command;
keybuf[t++] = key;
last_nonmenu_event = key;
dummyflag = 1;
break;
}
if (SYMBOLP (head))
{
Lisp_Object breakdown;
int modifiers;
breakdown = parse_modifiers (head);
modifiers = XINT (XCAR (XCDR (breakdown)));
if (modifiers & (down_modifier | drag_modifier
| double_modifier | triple_modifier))
{
while (modifiers & (down_modifier | drag_modifier
| double_modifier | triple_modifier))
{
Lisp_Object new_head, new_click;
if (modifiers & triple_modifier)
modifiers ^= (double_modifier | triple_modifier);
else if (modifiers & double_modifier)
modifiers &= ~double_modifier;
else if (modifiers & drag_modifier)
modifiers &= ~drag_modifier;
else
{
if (t == last_real_key_start)
{
mock_input = 0;
goto replay_key;
}
else
{
mock_input = last_real_key_start;
goto replay_sequence;
}
}
new_head
= apply_modifiers (modifiers, XCAR (breakdown));
new_click
= Fcons (new_head, Fcons (EVENT_START (key), Qnil));
first_binding
= (follow_key (new_click,
nmaps - local_first_binding,
submaps + local_first_binding,
defs + local_first_binding,
submaps + local_first_binding)
+ local_first_binding);
if (first_binding < nmaps)
{
key = new_click;
break;
}
}
}
}
}
keybuf[t++] = key;
if (!used_mouse_menu)
last_nonmenu_event = key;
this_single_command_key_start = this_command_key_count - t;
prev_fkey_map = fkey_map;
prev_fkey_start = fkey_start;
prev_fkey_end = fkey_end;
prev_keytran_map = keytran_map;
prev_keytran_start = keytran_start;
prev_keytran_end = keytran_end;
if (first_binding >= nmaps
&& t >= mock_input)
{
Lisp_Object fkey_next;
while (fkey_end < t)
{
Lisp_Object key;
key = keybuf[fkey_end++];
fkey_next
= access_keymap (fkey_map, key, 1, 0, 1);
if (SYMBOLP (fkey_next) && ! NILP (Ffboundp (fkey_next))
&& CONSP (XSYMBOL (fkey_next)->function)
&& EQ (XCAR (XSYMBOL (fkey_next)->function), Qautoload))
do_autoload (XSYMBOL (fkey_next)->function,
fkey_next);
if (SYMBOLP (fkey_next) && ! NILP (Ffboundp (fkey_next))
&& (!NILP (Farrayp (XSYMBOL (fkey_next)->function))
|| KEYMAPP (XSYMBOL (fkey_next)->function)))
fkey_next = XSYMBOL (fkey_next)->function;
#if 0
if (SYMBOLP (key) && !NILP (Vinhibit_function_key_mapping))
fkey_next = Qnil;
#endif
if (SYMBOLP (fkey_next) && ! NILP (Ffboundp (fkey_next))
&& fkey_end == t)
{
struct gcpro gcpro1, gcpro2, gcpro3;
Lisp_Object tem;
tem = fkey_next;
GCPRO3 (fkey_map, keytran_map, delayed_switch_frame);
fkey_next = call1 (fkey_next, prompt);
UNGCPRO;
if (! (VECTORP (fkey_next) || STRINGP (fkey_next)))
error ("Function in key-translation-map returns invalid key sequence");
}
function_key_possible = ! NILP (fkey_next);
if ((VECTORP (fkey_next) || STRINGP (fkey_next))
&& fkey_end == t)
{
int len = XFASTINT (Flength (fkey_next));
t = fkey_start + len;
if (t >= bufsize)
error ("Key sequence too long");
if (VECTORP (fkey_next))
bcopy (XVECTOR (fkey_next)->contents,
keybuf + fkey_start,
(t - fkey_start) * sizeof (keybuf[0]));
else if (STRINGP (fkey_next))
{
int i;
for (i = 0; i < len; i++)
XSETFASTINT (keybuf[fkey_start + i],
XSTRING (fkey_next)->data[i]);
}
mock_input = t;
fkey_start = fkey_end = t;
fkey_map = Vfunction_key_map;
keytran_end = keytran_start;
keytran_map = Vkey_translation_map;
goto replay_sequence;
}
fkey_map = get_keymap (fkey_next, 0, 1);
if (!CONSP (fkey_map))
{
fkey_end = ++fkey_start;
fkey_map = Vfunction_key_map;
function_key_possible = 0;
}
}
}
{
Lisp_Object keytran_next;
while (keytran_end < t)
{
Lisp_Object key;
key = keybuf[keytran_end++];
keytran_next
= access_keymap (keytran_map, key, 1, 0, 1);
if (SYMBOLP (keytran_next) && ! NILP (Ffboundp (keytran_next))
&& CONSP (XSYMBOL (keytran_next)->function)
&& EQ (XCAR (XSYMBOL (keytran_next)->function), Qautoload))
do_autoload (XSYMBOL (keytran_next)->function,
keytran_next);
if (SYMBOLP (keytran_next) && ! NILP (Ffboundp (keytran_next))
&& (!NILP (Farrayp (XSYMBOL (keytran_next)->function))
|| KEYMAPP (XSYMBOL (keytran_next)->function)))
keytran_next = XSYMBOL (keytran_next)->function;
if (SYMBOLP (keytran_next) && ! NILP (Ffboundp (keytran_next))
&& keytran_end == t)
{
struct gcpro gcpro1, gcpro2, gcpro3;
Lisp_Object tem;
tem = keytran_next;
GCPRO3 (fkey_map, keytran_map, delayed_switch_frame);
keytran_next = call1 (keytran_next, prompt);
UNGCPRO;
if (! (VECTORP (keytran_next) || STRINGP (keytran_next)))
error ("Function in key-translation-map returns invalid key sequence");
}
key_translation_possible = ! NILP (keytran_next);
if ((VECTORP (keytran_next) || STRINGP (keytran_next))
&& keytran_end == t)
{
int len = XFASTINT (Flength (keytran_next));
t = keytran_start + len;
if (t >= bufsize)
error ("Key sequence too long");
if (VECTORP (keytran_next))
bcopy (XVECTOR (keytran_next)->contents,
keybuf + keytran_start,
(t - keytran_start) * sizeof (keybuf[0]));
else if (STRINGP (keytran_next))
{
int i;
for (i = 0; i < len; i++)
XSETFASTINT (keybuf[keytran_start + i],
XSTRING (keytran_next)->data[i]);
}
mock_input = t;
keytran_start = keytran_end = t;
keytran_map = Vkey_translation_map;
fkey_start = fkey_end = t;
fkey_map = Vfunction_key_map;
goto replay_sequence;
}
keytran_map = get_keymap (keytran_next, 0, 1);
if (!CONSP (keytran_map))
{
keytran_end = ++keytran_start;
keytran_map = Vkey_translation_map;
key_translation_possible = 0;
}
}
}
if (first_binding == nmaps && ! function_key_possible
&& ! key_translation_possible
&& INTEGERP (key)
&& ((((XINT (key) & 0x3ffff)
< XCHAR_TABLE (current_buffer->downcase_table)->size)
&& UPPERCASEP (XINT (key) & 0x3ffff))
|| (XINT (key) & shift_modifier)))
{
Lisp_Object new_key;
original_uppercase = key;
original_uppercase_position = t - 1;
if (XINT (key) & shift_modifier)
XSETINT (new_key, XINT (key) & ~shift_modifier);
else
XSETINT (new_key, (DOWNCASE (XINT (key) & 0x3ffff)
| (XINT (key) & ~0x3ffff)));
keybuf[t - 1] = new_key;
mock_input = t;
fkey_map = prev_fkey_map;
fkey_start = prev_fkey_start;
fkey_end = prev_fkey_end;
keytran_map = prev_keytran_map;
keytran_start = prev_keytran_start;
keytran_end = prev_keytran_end;
goto replay_sequence;
}
if (first_binding == nmaps && ! function_key_possible
&& ! key_translation_possible
&& SYMBOLP (key))
{
Lisp_Object breakdown;
int modifiers;
breakdown = parse_modifiers (key);
modifiers = XINT (XCAR (XCDR (breakdown)));
if (modifiers & shift_modifier)
{
Lisp_Object new_key;
original_uppercase = key;
original_uppercase_position = t - 1;
modifiers &= ~shift_modifier;
new_key = apply_modifiers (modifiers,
XCAR (breakdown));
keybuf[t - 1] = new_key;
mock_input = t;
fkey_map = prev_fkey_map;
fkey_start = prev_fkey_start;
fkey_end = prev_fkey_end;
keytran_map = prev_keytran_map;
keytran_start = prev_keytran_start;
keytran_end = prev_keytran_end;
goto replay_sequence;
}
}
}
if (!dummyflag)
read_key_sequence_cmd = (first_binding < nmaps
? defs[first_binding]
: Qnil);
unread_switch_frame = delayed_switch_frame;
unbind_to (count, Qnil);
if ((dont_downcase_last || first_binding >= nmaps)
&& t - 1 == original_uppercase_position)
keybuf[t - 1] = original_uppercase;
for (; t < mock_input; t++)
{
if ((FLOATP (Vecho_keystrokes) || INTEGERP (Vecho_keystrokes))
&& NILP (Fzerop (Vecho_keystrokes)))
echo_char (keybuf[t]);
add_command_key (keybuf[t]);
}
UNGCPRO;
return t;
}
#if 0
DEFUN ("read-key-sequence", Fread_key_sequence, Sread_key_sequence, 1, 4, 0,
"Read a sequence of keystrokes and return as a string or vector.\n\
The sequence is sufficient to specify a non-prefix command in the\n\
current local and global maps.\n\
\n\
First arg PROMPT is a prompt string. If nil, do not prompt specially.\n\
Second (optional) arg CONTINUE-ECHO, if non-nil, means this key echos\n\
as a continuation of the previous key.\n\
\n\
The third (optional) arg DONT-DOWNCASE-LAST, if non-nil, means do not\n\
convert the last event to lower case. (Normally any upper case event\n\
is converted to lower case if the original event is undefined and the lower\n\
case equivalent is defined.) A non-nil value is appropriate for reading\n\
a key sequence to be defined.\n\
\n\
A C-g typed while in this function is treated like any other character,\n\
and `quit-flag' is not set.\n\
\n\
If the key sequence starts with a mouse click, then the sequence is read\n\
using the keymaps of the buffer of the window clicked in, not the buffer\n\
of the selected window as normal.\n\
""\n\
`read-key-sequence' drops unbound button-down events, since you normally\n\
only care about the click or drag events which follow them. If a drag\n\
or multi-click event is unbound, but the corresponding click event would\n\
be bound, `read-key-sequence' turns the event into a click event at the\n\
drag's starting position. This means that you don't have to distinguish\n\
between click and drag, double, or triple events unless you want to.\n\
\n\
`read-key-sequence' prefixes mouse events on mode lines, the vertical\n\
lines separating windows, and scroll bars with imaginary keys\n\
`mode-line', `vertical-line', and `vertical-scroll-bar'.\n\
\n\
Optional fourth argument CAN-RETURN-SWITCH-FRAME non-nil means that this\n\
function will process a switch-frame event if the user switches frames\n\
before typing anything. If the user switches frames in the middle of a\n\
key sequence, or at the start of the sequence but CAN-RETURN-SWITCH-FRAME\n\
is nil, then the event will be put off until after the current key sequence.\n\
\n\
`read-key-sequence' checks `function-key-map' for function key\n\
sequences, where they wouldn't conflict with ordinary bindings. See\n\
`function-key-map' for more details.\n\
\n\
The optional fifth argument COMMAND-LOOP, if non-nil, means\n\
that this key sequence is being read by something that will\n\
read commands one after another. It should be nil if the caller\n\
will read just one key sequence.")
(prompt, continue_echo, dont_downcase_last, can_return_switch_frame, command-loop)
#endif
DEFUN ("read-key-sequence", Fread_key_sequence, Sread_key_sequence, 1, 5, 0,
0)
(prompt, continue_echo, dont_downcase_last, can_return_switch_frame,
command_loop)
Lisp_Object prompt, continue_echo, dont_downcase_last;
Lisp_Object can_return_switch_frame, command_loop;
{
Lisp_Object keybuf[30];
register int i;
struct gcpro gcpro1;
int count = specpdl_ptr - specpdl;
if (!NILP (prompt))
CHECK_STRING (prompt, 0);
QUIT;
specbind (Qinput_method_exit_on_first_char,
(NILP (command_loop) ? Qt : Qnil));
specbind (Qinput_method_use_echo_area,
(NILP (command_loop) ? Qt : Qnil));
bzero (keybuf, sizeof keybuf);
GCPRO1 (keybuf[0]);
gcpro1.nvars = (sizeof keybuf/sizeof (keybuf[0]));
if (NILP (continue_echo))
{
this_command_key_count = 0;
this_single_command_key_start = 0;
}
#ifdef HAVE_X_WINDOWS
if (display_hourglass_p)
cancel_hourglass ();
#endif
i = read_key_sequence (keybuf, (sizeof keybuf/sizeof (keybuf[0])),
prompt, ! NILP (dont_downcase_last),
! NILP (can_return_switch_frame), 0);
#if 0
#ifdef HAVE_X_WINDOWS
if (display_hourglass_p)
start_hourglass ();
#endif
#endif
if (i == -1)
{
Vquit_flag = Qt;
QUIT;
}
UNGCPRO;
return unbind_to (count, make_event_array (i, keybuf));
}
DEFUN ("read-key-sequence-vector", Fread_key_sequence_vector,
Sread_key_sequence_vector, 1, 5, 0,
"Like `read-key-sequence' but always return a vector.")
(prompt, continue_echo, dont_downcase_last, can_return_switch_frame,
command_loop)
Lisp_Object prompt, continue_echo, dont_downcase_last;
Lisp_Object can_return_switch_frame, command_loop;
{
Lisp_Object keybuf[30];
register int i;
struct gcpro gcpro1;
int count = specpdl_ptr - specpdl;
if (!NILP (prompt))
CHECK_STRING (prompt, 0);
QUIT;
specbind (Qinput_method_exit_on_first_char,
(NILP (command_loop) ? Qt : Qnil));
specbind (Qinput_method_use_echo_area,
(NILP (command_loop) ? Qt : Qnil));
bzero (keybuf, sizeof keybuf);
GCPRO1 (keybuf[0]);
gcpro1.nvars = (sizeof keybuf/sizeof (keybuf[0]));
if (NILP (continue_echo))
{
this_command_key_count = 0;
this_single_command_key_start = 0;
}
#ifdef HAVE_X_WINDOWS
if (display_hourglass_p)
cancel_hourglass ();
#endif
i = read_key_sequence (keybuf, (sizeof keybuf/sizeof (keybuf[0])),
prompt, ! NILP (dont_downcase_last),
! NILP (can_return_switch_frame), 0);
#ifdef HAVE_X_WINDOWS
if (display_hourglass_p)
start_hourglass ();
#endif
if (i == -1)
{
Vquit_flag = Qt;
QUIT;
}
UNGCPRO;
return unbind_to (count, Fvector (i, keybuf));
}
DEFUN ("command-execute", Fcommand_execute, Scommand_execute, 1, 4, 0,
"Execute CMD as an editor command.\n\
CMD must be a symbol that satisfies the `commandp' predicate.\n\
Optional second arg RECORD-FLAG non-nil\n\
means unconditionally put this command in `command-history'.\n\
Otherwise, that is done only if an arg is read using the minibuffer.\n\
The argument KEYS specifies the value to use instead of (this-command-keys)\n\
when reading the arguments; if it is nil, (this-command-keys) is used.\n\
The argument SPECIAL, if non-nil, means that this command is executing\n\
a special event, so ignore the prefix argument and don't clear it.")
(cmd, record_flag, keys, special)
Lisp_Object cmd, record_flag, keys, special;
{
register Lisp_Object final;
register Lisp_Object tem;
Lisp_Object prefixarg;
struct backtrace backtrace;
extern int debug_on_next_call;
debug_on_next_call = 0;
if (NILP (special))
{
prefixarg = current_kboard->Vprefix_arg;
Vcurrent_prefix_arg = prefixarg;
current_kboard->Vprefix_arg = Qnil;
}
else
prefixarg = Qnil;
if (SYMBOLP (cmd))
{
tem = Fget (cmd, Qdisabled);
if (!NILP (tem) && !NILP (Vrun_hooks))
{
tem = Fsymbol_value (Qdisabled_command_hook);
if (!NILP (tem))
return call1 (Vrun_hooks, Qdisabled_command_hook);
}
}
while (1)
{
final = Findirect_function (cmd);
if (CONSP (final) && (tem = Fcar (final), EQ (tem, Qautoload)))
{
struct gcpro gcpro1, gcpro2;
GCPRO2 (cmd, prefixarg);
do_autoload (final, cmd);
UNGCPRO;
}
else
break;
}
if (STRINGP (final) || VECTORP (final))
{
if (!NILP (record_flag))
{
Vcommand_history
= Fcons (Fcons (Qexecute_kbd_macro,
Fcons (final, Fcons (prefixarg, Qnil))),
Vcommand_history);
if (NUMBERP (Vhistory_length) && XINT (Vhistory_length) > 0)
{
tem = Fnthcdr (Vhistory_length, Vcommand_history);
if (CONSP (tem))
XCDR (tem) = Qnil;
}
}
return Fexecute_kbd_macro (final, prefixarg);
}
if (CONSP (final) || SUBRP (final) || COMPILEDP (final))
{
backtrace.next = backtrace_list;
backtrace_list = &backtrace;
backtrace.function = &Qcall_interactively;
backtrace.args = &cmd;
backtrace.nargs = 1;
backtrace.evalargs = 0;
tem = Fcall_interactively (cmd, record_flag, keys);
backtrace_list = backtrace.next;
return tem;
}
return Qnil;
}
DEFUN ("execute-extended-command", Fexecute_extended_command, Sexecute_extended_command,
1, 1, "P",
"Read function name, then read its arguments and call it.")
(prefixarg)
Lisp_Object prefixarg;
{
Lisp_Object function;
char buf[40];
Lisp_Object saved_keys;
Lisp_Object bindings, value;
struct gcpro gcpro1, gcpro2;
saved_keys = Fvector (this_command_key_count,
XVECTOR (this_command_keys)->contents);
buf[0] = 0;
GCPRO2 (saved_keys, prefixarg);
if (EQ (prefixarg, Qminus))
strcpy (buf, "- ");
else if (CONSP (prefixarg) && XINT (XCAR (prefixarg)) == 4)
strcpy (buf, "C-u ");
else if (CONSP (prefixarg) && INTEGERP (XCAR (prefixarg)))
{
if (sizeof (int) == sizeof (EMACS_INT))
sprintf (buf, "%d ", XINT (XCAR (prefixarg)));
else if (sizeof (long) == sizeof (EMACS_INT))
sprintf (buf, "%ld ", (long) XINT (XCAR (prefixarg)));
else
abort ();
}
else if (INTEGERP (prefixarg))
{
if (sizeof (int) == sizeof (EMACS_INT))
sprintf (buf, "%d ", XINT (prefixarg));
else if (sizeof (long) == sizeof (EMACS_INT))
sprintf (buf, "%ld ", (long) XINT (prefixarg));
else
abort ();
}
strcat (buf, "M-x ");
function = Fcompleting_read (build_string (buf),
Vobarray, Qcommandp,
Qt, Qnil, Qextended_command_history, Qnil,
Qnil);
if (STRINGP (function) && XSTRING (function)->size == 0)
error ("No command name given");
{
struct Lisp_String *str;
Lisp_Object *keys;
int i;
this_command_key_count = 0;
this_single_command_key_start = 0;
keys = XVECTOR (saved_keys)->contents;
for (i = 0; i < XVECTOR (saved_keys)->size; i++)
add_command_key (keys[i]);
str = XSTRING (function);
for (i = 0; i < str->size; i++)
add_command_key (Faref (function, make_number (i)));
add_command_key (make_number ('\015'));
}
UNGCPRO;
function = Fintern (function, Qnil);
current_kboard->Vprefix_arg = prefixarg;
Vthis_command = function;
real_this_command = function;
if (!NILP (Vsuggest_key_bindings)
&& NILP (Vexecuting_macro)
&& SYMBOLP (function))
bindings = Fwhere_is_internal (function, Voverriding_local_map,
Qt, Qnil);
else
bindings = Qnil;
value = Qnil;
GCPRO2 (bindings, value);
value = Fcommand_execute (function, Qt, Qnil, Qnil);
if (!NILP (bindings)
&& ! (VECTORP (bindings) && EQ (Faref (bindings, make_number (0)),
Qmouse_movement)))
{
int delay_time;
if (!NILP (echo_area_buffer[0]))
delay_time = (NUMBERP (Vsuggest_key_bindings)
? XINT (Vsuggest_key_bindings) : 2);
else
delay_time = 0;
if (!NILP (Fsit_for (make_number (delay_time), Qnil, Qnil))
&& ! CONSP (Vunread_command_events))
{
Lisp_Object binding;
char *newmessage;
int message_p = push_message ();
int count = BINDING_STACK_SIZE ();
record_unwind_protect (push_message_unwind, Qnil);
binding = Fkey_description (bindings);
newmessage
= (char *) alloca (XSYMBOL (function)->name->size
+ STRING_BYTES (XSTRING (binding))
+ 100);
sprintf (newmessage, "You can run the command `%s' with %s",
XSYMBOL (function)->name->data,
XSTRING (binding)->data);
message2_nolog (newmessage,
strlen (newmessage),
STRING_MULTIBYTE (binding));
if (!NILP (Fsit_for ((NUMBERP (Vsuggest_key_bindings)
? Vsuggest_key_bindings : make_number (2)),
Qnil, Qnil))
&& message_p)
restore_message ();
unbind_to (count, Qnil);
}
}
RETURN_UNGCPRO (value);
}
int
current_active_maps (maps_p)
Lisp_Object **maps_p;
{
Lisp_Object *tmaps, *maps;
int nmaps;
if (!NILP (Voverriding_local_map_menu_flag))
{
maps = (Lisp_Object *) xmalloc (3 * sizeof (maps[0]));
nmaps = 0;
if (!NILP (current_kboard->Voverriding_terminal_local_map))
maps[nmaps++] = current_kboard->Voverriding_terminal_local_map;
if (!NILP (Voverriding_local_map))
maps[nmaps++] = Voverriding_local_map;
}
else
{
int extra_maps = 2;
Lisp_Object map = get_local_map (PT, current_buffer, Qkeymap);
if (!NILP (map))
extra_maps = 3;
nmaps = current_minor_maps (NULL, &tmaps);
maps = (Lisp_Object *) alloca ((nmaps + extra_maps)
* sizeof (maps[0]));
bcopy (tmaps, maps, nmaps * sizeof (maps[0]));
if (!NILP (map))
maps[nmaps++] = map;
maps[nmaps++] = get_local_map (PT, current_buffer, Qlocal_map);
}
maps[nmaps++] = current_global_map;
*maps_p = maps;
return nmaps;
}
int
detect_input_pending ()
{
if (!input_pending)
get_input_pending (&input_pending, 0);
return input_pending;
}
int
detect_input_pending_run_timers (do_display)
int do_display;
{
int old_timers_run = timers_run;
if (!input_pending)
get_input_pending (&input_pending, 1);
if (old_timers_run != timers_run && do_display)
{
redisplay_preserve_echo_area (8);
if (rif)
rif->flush_display (NULL);
}
return input_pending;
}
void
clear_input_pending ()
{
input_pending = 0;
}
int
requeued_events_pending_p ()
{
return (!NILP (Vunread_command_events) || unread_command_char != -1);
}
DEFUN ("input-pending-p", Finput_pending_p, Sinput_pending_p, 0, 0, 0,
"T if command input is currently available with no waiting.\n\
Actually, the value is nil only if we can be sure that no input is available.")
()
{
if (!NILP (Vunread_command_events) || unread_command_char != -1)
return (Qt);
get_input_pending (&input_pending, 1);
return input_pending > 0 ? Qt : Qnil;
}
DEFUN ("recent-keys", Frecent_keys, Srecent_keys, 0, 0, 0,
"Return vector of last 100 events, not counting those from keyboard macros.")
()
{
Lisp_Object *keys = XVECTOR (recent_keys)->contents;
Lisp_Object val;
if (total_keys < NUM_RECENT_KEYS)
return Fvector (total_keys, keys);
else
{
val = Fvector (NUM_RECENT_KEYS, keys);
bcopy (keys + recent_keys_index,
XVECTOR (val)->contents,
(NUM_RECENT_KEYS - recent_keys_index) * sizeof (Lisp_Object));
bcopy (keys,
XVECTOR (val)->contents + NUM_RECENT_KEYS - recent_keys_index,
recent_keys_index * sizeof (Lisp_Object));
return val;
}
}
DEFUN ("this-command-keys", Fthis_command_keys, Sthis_command_keys, 0, 0, 0,
"Return the key sequence that invoked this command.\n\
The value is a string or a vector.")
()
{
return make_event_array (this_command_key_count,
XVECTOR (this_command_keys)->contents);
}
DEFUN ("this-command-keys-vector", Fthis_command_keys_vector, Sthis_command_keys_vector, 0, 0, 0,
"Return the key sequence that invoked this command, as a vector.")
()
{
return Fvector (this_command_key_count,
XVECTOR (this_command_keys)->contents);
}
DEFUN ("this-single-command-keys", Fthis_single_command_keys,
Sthis_single_command_keys, 0, 0, 0,
"Return the key sequence that invoked this command.\n\
Unlike `this-command-keys', this function's value\n\
does not include prefix arguments.\n\
The value is always a vector.")
()
{
return Fvector (this_command_key_count
- this_single_command_key_start,
(XVECTOR (this_command_keys)->contents
+ this_single_command_key_start));
}
DEFUN ("this-single-command-raw-keys", Fthis_single_command_raw_keys,
Sthis_single_command_raw_keys, 0, 0, 0,
"Return the raw events that were read for this command.\n\
Unlike `this-single-command-keys', this function's value\n\
shows the events before all translations (except for input methods).\n\
The value is always a vector.")
()
{
return Fvector (raw_keybuf_count,
(XVECTOR (raw_keybuf)->contents));
}
DEFUN ("reset-this-command-lengths", Freset_this_command_lengths,
Sreset_this_command_lengths, 0, 0, 0,
"Used for complicated reasons in `universal-argument-other-key'.\n\
\n\
`universal-argument-other-key' rereads the event just typed.\n\
It then gets translated through `function-key-map'.\n\
The translated event gets included in the echo area and in\n\
the value of `this-command-keys' in addition to the raw original event.\n\
That is not right.\n\
\n\
Calling this function directs the translated event to replace\n\
the original event, so that only one version of the event actually\n\
appears in the echo area and in the value of `this-command-keys'.")
()
{
before_command_restore_flag = 1;
before_command_key_count_1 = before_command_key_count;
before_command_echo_length_1 = before_command_echo_length;
return Qnil;
}
DEFUN ("clear-this-command-keys", Fclear_this_command_keys,
Sclear_this_command_keys, 0, 0, 0,
"Clear out the vector that `this-command-keys' returns.\n\
Clear vector containing last 100 events.")
()
{
int i;
this_command_key_count = 0;
for (i = 0; i < XVECTOR (recent_keys)->size; ++i)
XVECTOR (recent_keys)->contents[i] = Qnil;
total_keys = 0;
recent_keys_index = 0;
return Qnil;
}
DEFUN ("recursion-depth", Frecursion_depth, Srecursion_depth, 0, 0, 0,
"Return the current depth in recursive edits.")
()
{
Lisp_Object temp;
XSETFASTINT (temp, command_loop_level + minibuf_level);
return temp;
}
DEFUN ("open-dribble-file", Fopen_dribble_file, Sopen_dribble_file, 1, 1,
"FOpen dribble file: ",
"Start writing all keyboard characters to a dribble file called FILE.\n\
If FILE is nil, close any open dribble file.")
(file)
Lisp_Object file;
{
if (dribble)
{
fclose (dribble);
dribble = 0;
}
if (!NILP (file))
{
file = Fexpand_file_name (file, Qnil);
dribble = fopen (XSTRING (file)->data, "w");
if (dribble == 0)
report_file_error ("Opening dribble", Fcons (file, Qnil));
}
return Qnil;
}
DEFUN ("discard-input", Fdiscard_input, Sdiscard_input, 0, 0, 0,
"Discard the contents of the terminal input buffer.\n\
Also cancel any kbd macro being defined.")
()
{
current_kboard->defining_kbd_macro = Qnil;
update_mode_lines++;
Vunread_command_events = Qnil;
unread_command_char = -1;
discard_tty_input ();
kbd_fetch_ptr = kbd_store_ptr;
Ffillarray (kbd_buffer_gcpro, Qnil);
input_pending = 0;
return Qnil;
}
DEFUN ("suspend-emacs", Fsuspend_emacs, Ssuspend_emacs, 0, 1, "",
"Stop Emacs and return to superior process. You can resume later.\n\
If `cannot-suspend' is non-nil, or if the system doesn't support job\n\
control, run a subshell instead.\n\n\
If optional arg STUFFSTRING is non-nil, its characters are stuffed\n\
to be read as terminal input by Emacs's parent, after suspension.\n\
\n\
Before suspending, run the normal hook `suspend-hook'.\n\
After resumption run the normal hook `suspend-resume-hook'.\n\
\n\
Some operating systems cannot stop the Emacs process and resume it later.\n\
On such systems, Emacs starts a subshell instead of suspending.")
(stuffstring)
Lisp_Object stuffstring;
{
int count = specpdl_ptr - specpdl;
int old_height, old_width;
int width, height;
struct gcpro gcpro1;
if (!NILP (stuffstring))
CHECK_STRING (stuffstring, 0);
if (!NILP (Vrun_hooks))
call1 (Vrun_hooks, intern ("suspend-hook"));
GCPRO1 (stuffstring);
get_frame_size (&old_width, &old_height);
reset_sys_modes ();
record_unwind_protect ((Lisp_Object (*) P_ ((Lisp_Object))) init_sys_modes,
Qnil);
stuff_buffered_input (stuffstring);
if (cannot_suspend)
sys_subshell ();
else
sys_suspend ();
unbind_to (count, Qnil);
get_frame_size (&width, &height);
if (width != old_width || height != old_height)
change_frame_size (SELECTED_FRAME (), height, width, 0, 0, 0);
if (!NILP (Vrun_hooks))
call1 (Vrun_hooks, intern ("suspend-resume-hook"));
UNGCPRO;
return Qnil;
}
void
stuff_buffered_input (stuffstring)
Lisp_Object stuffstring;
{
#ifdef BSD_SYSTEM
#ifndef BSD4_1
register unsigned char *p;
if (STRINGP (stuffstring))
{
register int count;
p = XSTRING (stuffstring)->data;
count = STRING_BYTES (XSTRING (stuffstring));
while (count-- > 0)
stuff_char (*p++);
stuff_char ('\n');
}
for (; kbd_fetch_ptr != kbd_store_ptr; kbd_fetch_ptr++)
{
int idx;
if (kbd_fetch_ptr == kbd_buffer + KBD_BUFFER_SIZE)
kbd_fetch_ptr = kbd_buffer;
if (kbd_fetch_ptr->kind == ascii_keystroke)
stuff_char (kbd_fetch_ptr->code);
kbd_fetch_ptr->kind = no_event;
idx = 2 * (kbd_fetch_ptr - kbd_buffer);
ASET (kbd_buffer_gcpro, idx, Qnil);
ASET (kbd_buffer_gcpro, idx + 1, Qnil);
}
input_pending = 0;
#endif
#endif
}
void
set_waiting_for_input (time_to_clear)
EMACS_TIME *time_to_clear;
{
input_available_clear_time = time_to_clear;
waiting_for_input = 1;
if (!NILP (Vquit_flag))
quit_throw_to_read_char ();
}
void
clear_waiting_for_input ()
{
waiting_for_input = 0;
input_available_clear_time = 0;
}
SIGTYPE
interrupt_signal (signalnum)
int signalnum;
{
char c;
int old_errno = errno;
struct frame *sf = SELECTED_FRAME ();
#if defined (USG) && !defined (POSIX_SIGNALS)
if (!read_socket_hook && NILP (Vwindow_system))
{
signal (SIGINT, interrupt_signal);
signal (SIGQUIT, interrupt_signal);
}
#endif
cancel_echoing ();
if (!NILP (Vquit_flag)
&& (FRAME_TERMCAP_P (sf) || FRAME_MSDOS_P (sf)))
{
sigblock (sigmask (SIGINT));
fflush (stdout);
reset_sys_modes ();
#ifdef SIGTSTP
sys_suspend ();
#else
#ifdef VMS
if (sys_suspend () == -1)
{
printf ("Not running as a subprocess;\n");
printf ("you can continue or abort.\n");
}
#else
printf ("No support for stopping a process on this operating system;\n");
printf ("you can continue or abort.\n");
#endif
#endif
#ifdef MSDOS
cursor_to (0, 0);
#endif
if (!gc_in_progress)
{
printf ("Auto-save? (y or n) ");
fflush (stdout);
if (((c = getchar ()) & ~040) == 'Y')
{
Fdo_auto_save (Qt, Qnil);
#ifdef MSDOS
printf ("\r\nAuto-save done");
#else
printf ("Auto-save done\n");
#endif
}
while (c != '\n') c = getchar ();
}
else
{
Vinhibit_quit = Qnil;
#ifdef MSDOS
printf ("\r\n");
#endif
printf ("Garbage collection in progress; cannot auto-save now\r\n");
printf ("but will instead do a real quit after garbage collection ends\r\n");
fflush (stdout);
}
#ifdef MSDOS
printf ("\r\nAbort? (y or n) ");
#else
#ifdef VMS
printf ("Abort (and enter debugger)? (y or n) ");
#else
printf ("Abort (and dump core)? (y or n) ");
#endif
#endif
fflush (stdout);
if (((c = getchar ()) & ~040) == 'Y')
abort ();
while (c != '\n') c = getchar ();
#ifdef MSDOS
printf ("\r\nContinuing...\r\n");
#else
printf ("Continuing...\n");
#endif
fflush (stdout);
init_sys_modes ();
sigfree ();
}
else
{
if (immediate_quit && NILP (Vinhibit_quit))
{
struct gl_state_s saved;
struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
immediate_quit = 0;
sigfree ();
saved = gl_state;
GCPRO4 (saved.object, saved.global_code,
saved.current_syntax_table, saved.old_prop);
Fsignal (Qquit, Qnil);
gl_state = saved;
UNGCPRO;
}
else
Vquit_flag = Qt;
}
if (waiting_for_input && !echoing)
quit_throw_to_read_char ();
errno = old_errno;
}
void
quit_throw_to_read_char ()
{
sigfree ();
clear_waiting_for_input ();
input_pending = 0;
Vunread_command_events = Qnil;
unread_command_char = -1;
#if 0
#ifdef POLL_FOR_INPUT
if (poll_suppress_count == 0)
abort ();
#endif
#endif
if (FRAMEP (internal_last_event_frame)
&& !EQ (internal_last_event_frame, selected_frame))
do_switch_frame (make_lispy_switch_frame (internal_last_event_frame),
0, 0);
_longjmp (getcjmp, 1);
}
DEFUN ("set-input-mode", Fset_input_mode, Sset_input_mode, 3, 4, 0,
"Set mode of reading keyboard input.\n\
First arg INTERRUPT non-nil means use input interrupts;\n\
nil means use CBREAK mode.\n\
Second arg FLOW non-nil means use ^S/^Q flow control for output to terminal\n\
(no effect except in CBREAK mode).\n\
Third arg META t means accept 8-bit input (for a Meta key).\n\
META nil means ignore the top bit, on the assumption it is parity.\n\
Otherwise, accept 8-bit input and don't use the top bit for Meta.\n\
Optional fourth arg QUIT if non-nil specifies character to use for quitting.\n\
See also `current-input-mode'.")
(interrupt, flow, meta, quit)
Lisp_Object interrupt, flow, meta, quit;
{
if (!NILP (quit)
&& (!INTEGERP (quit) || XINT (quit) < 0 || XINT (quit) > 0400))
error ("set-input-mode: QUIT must be an ASCII character");
#ifdef POLL_FOR_INPUT
stop_polling ();
#endif
#ifndef DOS_NT
reset_sys_modes ();
#endif
#ifdef SIGIO
if (read_socket_hook)
{
#ifdef NO_SOCK_SIGIO
interrupt_input = 0;
#else
interrupt_input = 1;
#endif
}
else
interrupt_input = !NILP (interrupt);
#else
interrupt_input = 0;
#endif
#ifdef VMS
interrupt_input = 1;
#endif
flow_control = !NILP (flow);
if (NILP (meta))
meta_key = 0;
else if (EQ (meta, Qt))
meta_key = 1;
else
meta_key = 2;
if (!NILP (quit))
quit_char = XINT (quit) & (meta_key ? 0377 : 0177);
#ifndef DOS_NT
init_sys_modes ();
#endif
#ifdef POLL_FOR_INPUT
poll_suppress_count = 1;
start_polling ();
#endif
return Qnil;
}
DEFUN ("current-input-mode", Fcurrent_input_mode, Scurrent_input_mode, 0, 0, 0,
"Return information about the way Emacs currently reads keyboard input.\n\
The value is a list of the form (INTERRUPT FLOW META QUIT), where\n\
INTERRUPT is non-nil if Emacs is using interrupt-driven input; if\n\
nil, Emacs is using CBREAK mode.\n\
FLOW is non-nil if Emacs uses ^S/^Q flow control for output to the\n\
terminal; this does not apply if Emacs uses interrupt-driven input.\n\
META is t if accepting 8-bit input with 8th bit as Meta flag.\n\
META nil means ignoring the top bit, on the assumption it is parity.\n\
META is neither t nor nil if accepting 8-bit input and using\n\
all 8 bits as the character code.\n\
QUIT is the character Emacs currently uses to quit.\n\
The elements of this list correspond to the arguments of\n\
`set-input-mode'.")
()
{
Lisp_Object val[4];
val[0] = interrupt_input ? Qt : Qnil;
val[1] = flow_control ? Qt : Qnil;
val[2] = meta_key == 2 ? make_number (0) : meta_key == 1 ? Qt : Qnil;
XSETFASTINT (val[3], quit_char);
return Flist (sizeof (val) / sizeof (val[0]), val);
}
void
init_kboard (kb)
KBOARD *kb;
{
kb->Voverriding_terminal_local_map = Qnil;
kb->Vlast_command = Qnil;
kb->Vreal_last_command = Qnil;
kb->Vprefix_arg = Qnil;
kb->Vlast_prefix_arg = Qnil;
kb->kbd_queue = Qnil;
kb->kbd_queue_has_data = 0;
kb->immediate_echo = 0;
kb->echoptr = kb->echobuf;
kb->echo_after_prompt = -1;
kb->kbd_macro_buffer = 0;
kb->kbd_macro_bufsize = 0;
kb->defining_kbd_macro = Qnil;
kb->Vlast_kbd_macro = Qnil;
kb->reference_count = 0;
kb->Vsystem_key_alist = Qnil;
kb->system_key_syms = Qnil;
kb->Vdefault_minibuffer_frame = Qnil;
}
static void
wipe_kboard (kb)
KBOARD *kb;
{
if (kb->kbd_macro_buffer)
xfree (kb->kbd_macro_buffer);
}
#ifdef MULTI_KBOARD
void
delete_kboard (kb)
KBOARD *kb;
{
KBOARD **kbp;
for (kbp = &all_kboards; *kbp != kb; kbp = &(*kbp)->next_kboard)
if (*kbp == NULL)
abort ();
*kbp = kb->next_kboard;
if (kb == current_kboard
&& FRAMEP (selected_frame)
&& FRAME_LIVE_P (XFRAME (selected_frame)))
{
current_kboard = XFRAME (selected_frame)->kboard;
if (current_kboard == kb)
abort ();
}
wipe_kboard (kb);
xfree (kb);
}
#endif
void
init_keyboard ()
{
command_loop_level = -1;
immediate_quit = 0;
quit_char = Ctl ('g');
Vunread_command_events = Qnil;
unread_command_char = -1;
EMACS_SET_SECS_USECS (timer_idleness_start_time, -1, -1);
total_keys = 0;
recent_keys_index = 0;
kbd_fetch_ptr = kbd_buffer;
kbd_store_ptr = kbd_buffer;
kbd_buffer_gcpro = Fmake_vector (make_number (2 * KBD_BUFFER_SIZE), Qnil);
#ifdef HAVE_MOUSE
do_mouse_tracking = Qnil;
#endif
input_pending = 0;
internal_last_event_frame = Qnil;
Vlast_event_frame = internal_last_event_frame;
#ifdef MULTI_KBOARD
current_kboard = initial_kboard;
#endif
wipe_kboard (current_kboard);
init_kboard (current_kboard);
if (!noninteractive && !read_socket_hook && NILP (Vwindow_system))
{
signal (SIGINT, interrupt_signal);
#if defined (HAVE_TERMIO) || defined (HAVE_TERMIOS)
signal (SIGQUIT, interrupt_signal);
#endif
}
#ifdef SIGIO
if (!noninteractive)
signal (SIGIO, input_available_signal);
#endif
#ifdef INTERRUPT_INPUT
interrupt_input = 1;
#else
interrupt_input = 0;
#endif
#ifdef VMS
interrupt_input = 1;
#endif
sigfree ();
dribble = 0;
if (keyboard_init_hook)
(*keyboard_init_hook) ();
#ifdef POLL_FOR_INPUT
poll_suppress_count = 1;
start_polling ();
#endif
}
struct event_head {
Lisp_Object *var;
char *name;
Lisp_Object *kind;
};
struct event_head head_table[] = {
&Qmouse_movement, "mouse-movement", &Qmouse_movement,
&Qscroll_bar_movement, "scroll-bar-movement", &Qmouse_movement,
&Qswitch_frame, "switch-frame", &Qswitch_frame,
&Qdelete_frame, "delete-frame", &Qdelete_frame,
&Qiconify_frame, "iconify-frame", &Qiconify_frame,
&Qmake_frame_visible, "make-frame-visible", &Qmake_frame_visible,
};
void
syms_of_keyboard ()
{
Vpre_help_message = Qnil;
staticpro (&Vpre_help_message);
Vlispy_mouse_stem = build_string ("mouse");
staticpro (&Vlispy_mouse_stem);
QCimage = intern (":image");
staticpro (&QCimage);
staticpro (&Qhelp_echo);
Qhelp_echo = intern ("help-echo");
staticpro (&item_properties);
item_properties = Qnil;
staticpro (&tool_bar_item_properties);
tool_bar_item_properties = Qnil;
staticpro (&tool_bar_items_vector);
tool_bar_items_vector = Qnil;
staticpro (&real_this_command);
real_this_command = Qnil;
Qtimer_event_handler = intern ("timer-event-handler");
staticpro (&Qtimer_event_handler);
Qdisabled_command_hook = intern ("disabled-command-hook");
staticpro (&Qdisabled_command_hook);
Qself_insert_command = intern ("self-insert-command");
staticpro (&Qself_insert_command);
Qforward_char = intern ("forward-char");
staticpro (&Qforward_char);
Qbackward_char = intern ("backward-char");
staticpro (&Qbackward_char);
Qdisabled = intern ("disabled");
staticpro (&Qdisabled);
Qundefined = intern ("undefined");
staticpro (&Qundefined);
Qpre_command_hook = intern ("pre-command-hook");
staticpro (&Qpre_command_hook);
Qpost_command_hook = intern ("post-command-hook");
staticpro (&Qpost_command_hook);
Qpost_command_idle_hook = intern ("post-command-idle-hook");
staticpro (&Qpost_command_idle_hook);
Qdeferred_action_function = intern ("deferred-action-function");
staticpro (&Qdeferred_action_function);
Qcommand_hook_internal = intern ("command-hook-internal");
staticpro (&Qcommand_hook_internal);
Qfunction_key = intern ("function-key");
staticpro (&Qfunction_key);
Qmouse_click = intern ("mouse-click");
staticpro (&Qmouse_click);
#ifdef WINDOWSNT
Qmouse_wheel = intern ("mouse-wheel");
staticpro (&Qmouse_wheel);
Qlanguage_change = intern ("language-change");
staticpro (&Qlanguage_change);
#endif
Qdrag_n_drop = intern ("drag-n-drop");
staticpro (&Qdrag_n_drop);
Qusr1_signal = intern ("usr1-signal");
staticpro (&Qusr1_signal);
Qusr2_signal = intern ("usr2-signal");
staticpro (&Qusr2_signal);
Qmenu_enable = intern ("menu-enable");
staticpro (&Qmenu_enable);
Qmenu_alias = intern ("menu-alias");
staticpro (&Qmenu_alias);
QCenable = intern (":enable");
staticpro (&QCenable);
QCvisible = intern (":visible");
staticpro (&QCvisible);
QChelp = intern (":help");
staticpro (&QChelp);
QCfilter = intern (":filter");
staticpro (&QCfilter);
QCbutton = intern (":button");
staticpro (&QCbutton);
QCkeys = intern (":keys");
staticpro (&QCkeys);
QCkey_sequence = intern (":key-sequence");
staticpro (&QCkey_sequence);
QCtoggle = intern (":toggle");
staticpro (&QCtoggle);
QCradio = intern (":radio");
staticpro (&QCradio);
Qmode_line = intern ("mode-line");
staticpro (&Qmode_line);
Qvertical_line = intern ("vertical-line");
staticpro (&Qvertical_line);
Qvertical_scroll_bar = intern ("vertical-scroll-bar");
staticpro (&Qvertical_scroll_bar);
Qmenu_bar = intern ("menu-bar");
staticpro (&Qmenu_bar);
Qabove_handle = intern ("above-handle");
staticpro (&Qabove_handle);
Qhandle = intern ("handle");
staticpro (&Qhandle);
Qbelow_handle = intern ("below-handle");
staticpro (&Qbelow_handle);
Qup = intern ("up");
staticpro (&Qup);
Qdown = intern ("down");
staticpro (&Qdown);
Qtop = intern ("top");
staticpro (&Qtop);
Qbottom = intern ("bottom");
staticpro (&Qbottom);
Qend_scroll = intern ("end-scroll");
staticpro (&Qend_scroll);
Qratio = intern ("ratio");
staticpro (&Qratio);
Qevent_kind = intern ("event-kind");
staticpro (&Qevent_kind);
Qevent_symbol_elements = intern ("event-symbol-elements");
staticpro (&Qevent_symbol_elements);
Qevent_symbol_element_mask = intern ("event-symbol-element-mask");
staticpro (&Qevent_symbol_element_mask);
Qmodifier_cache = intern ("modifier-cache");
staticpro (&Qmodifier_cache);
Qrecompute_lucid_menubar = intern ("recompute-lucid-menubar");
staticpro (&Qrecompute_lucid_menubar);
Qactivate_menubar_hook = intern ("activate-menubar-hook");
staticpro (&Qactivate_menubar_hook);
Qpolling_period = intern ("polling-period");
staticpro (&Qpolling_period);
Qinput_method_function = intern ("input-method-function");
staticpro (&Qinput_method_function);
Qinput_method_exit_on_first_char = intern ("input-method-exit-on-first-char");
staticpro (&Qinput_method_exit_on_first_char);
Qinput_method_use_echo_area = intern ("input-method-use-echo-area");
staticpro (&Qinput_method_use_echo_area);
Fset (Qinput_method_exit_on_first_char, Qnil);
Fset (Qinput_method_use_echo_area, Qnil);
last_point_position_buffer = Qnil;
{
struct event_head *p;
for (p = head_table;
p < head_table + (sizeof (head_table) / sizeof (head_table[0]));
p++)
{
*p->var = intern (p->name);
staticpro (p->var);
Fput (*p->var, Qevent_kind, *p->kind);
Fput (*p->var, Qevent_symbol_elements, Fcons (*p->var, Qnil));
}
}
button_down_location = Fmake_vector (make_number (1), Qnil);
staticpro (&button_down_location);
mouse_syms = Fmake_vector (make_number (1), Qnil);
staticpro (&mouse_syms);
{
int i;
int len = sizeof (modifier_names) / sizeof (modifier_names[0]);
modifier_symbols = Fmake_vector (make_number (len), Qnil);
for (i = 0; i < len; i++)
if (modifier_names[i])
XVECTOR (modifier_symbols)->contents[i] = intern (modifier_names[i]);
staticpro (&modifier_symbols);
}
recent_keys = Fmake_vector (make_number (NUM_RECENT_KEYS), Qnil);
staticpro (&recent_keys);
this_command_keys = Fmake_vector (make_number (40), Qnil);
staticpro (&this_command_keys);
raw_keybuf = Fmake_vector (make_number (30), Qnil);
staticpro (&raw_keybuf);
Qextended_command_history = intern ("extended-command-history");
Fset (Qextended_command_history, Qnil);
staticpro (&Qextended_command_history);
kbd_buffer_gcpro = Fmake_vector (make_number (2 * KBD_BUFFER_SIZE), Qnil);
staticpro (&kbd_buffer_gcpro);
accent_key_syms = Qnil;
staticpro (&accent_key_syms);
func_key_syms = Qnil;
staticpro (&func_key_syms);
#ifdef WINDOWSNT
mouse_wheel_syms = Qnil;
staticpro (&mouse_wheel_syms);
drag_n_drop_syms = Qnil;
staticpro (&drag_n_drop_syms);
#endif
unread_switch_frame = Qnil;
staticpro (&unread_switch_frame);
internal_last_event_frame = Qnil;
staticpro (&internal_last_event_frame);
read_key_sequence_cmd = Qnil;
staticpro (&read_key_sequence_cmd);
menu_bar_one_keymap_changed_items = Qnil;
staticpro (&menu_bar_one_keymap_changed_items);
defsubr (&Sevent_convert_list);
defsubr (&Sread_key_sequence);
defsubr (&Sread_key_sequence_vector);
defsubr (&Srecursive_edit);
#ifdef HAVE_MOUSE
defsubr (&Strack_mouse);
#endif
defsubr (&Sinput_pending_p);
defsubr (&Scommand_execute);
defsubr (&Srecent_keys);
defsubr (&Sthis_command_keys);
defsubr (&Sthis_command_keys_vector);
defsubr (&Sthis_single_command_keys);
defsubr (&Sthis_single_command_raw_keys);
defsubr (&Sreset_this_command_lengths);
defsubr (&Sclear_this_command_keys);
defsubr (&Ssuspend_emacs);
defsubr (&Sabort_recursive_edit);
defsubr (&Sexit_recursive_edit);
defsubr (&Srecursion_depth);
defsubr (&Stop_level);
defsubr (&Sdiscard_input);
defsubr (&Sopen_dribble_file);
defsubr (&Sset_input_mode);
defsubr (&Scurrent_input_mode);
defsubr (&Sexecute_extended_command);
DEFVAR_LISP ("last-command-char", &last_command_char,
"Last input event that was part of a command.");
DEFVAR_LISP_NOPRO ("last-command-event", &last_command_char,
"Last input event that was part of a command.");
DEFVAR_LISP ("last-nonmenu-event", &last_nonmenu_event,
"Last input event in a command, except for mouse menu events.\n\
Mouse menus give back keys that don't look like mouse events;\n\
this variable holds the actual mouse event that led to the menu,\n\
so that you can determine whether the command was run by mouse or not.");
DEFVAR_LISP ("last-input-char", &last_input_char,
"Last input event.");
DEFVAR_LISP_NOPRO ("last-input-event", &last_input_char,
"Last input event.");
DEFVAR_LISP ("unread-command-events", &Vunread_command_events,
"List of events to be read as the command input.\n\
These events are processed first, before actual keyboard input.");
Vunread_command_events = Qnil;
DEFVAR_INT ("unread-command-char", &unread_command_char,
"If not -1, an object to be read as next command input event.");
DEFVAR_LISP ("unread-post-input-method-events", &Vunread_post_input_method_events,
"List of events to be processed as input by input methods.\n\
These events are processed after `unread-command-events', but\n\
before actual keyboard input.");
Vunread_post_input_method_events = Qnil;
DEFVAR_LISP ("unread-input-method-events", &Vunread_input_method_events,
"List of events to be processed as input by input methods.\n\
These events are processed after `unread-command-events', but\n\
before actual keyboard input.");
Vunread_input_method_events = Qnil;
DEFVAR_LISP ("meta-prefix-char", &meta_prefix_char,
"Meta-prefix character code.\n\
Meta-foo as command input turns into this character followed by foo.");
XSETINT (meta_prefix_char, 033);
DEFVAR_KBOARD ("last-command", Vlast_command,
"The last command executed.\n\
Normally a symbol with a function definition, but can be whatever was found\n\
in the keymap, or whatever the variable `this-command' was set to by that\n\
command.\n\
\n\
The value `mode-exit' is special; it means that the previous command\n\
read an event that told it to exit, and it did so and unread that event.\n\
In other words, the present command is the event that made the previous\n\
command exit.\n\
\n\
The value `kill-region' is special; it means that the previous command\n\
was a kill command.");
DEFVAR_KBOARD ("real-last-command", Vreal_last_command,
"Same as `last-command', but never altered by Lisp code.");
DEFVAR_LISP ("this-command", &Vthis_command,
"The command now being executed.\n\
The command can set this variable; whatever is put here\n\
will be in `last-command' during the following command.");
Vthis_command = Qnil;
DEFVAR_INT ("auto-save-interval", &auto_save_interval,
"*Number of input events between auto-saves.\n\
Zero means disable autosaving due to number of characters typed.");
auto_save_interval = 300;
DEFVAR_LISP ("auto-save-timeout", &Vauto_save_timeout,
"*Number of seconds idle time before auto-save.\n\
Zero or nil means disable auto-saving due to idleness.\n\
After auto-saving due to this many seconds of idle time,\n\
Emacs also does a garbage collection if that seems to be warranted.");
XSETFASTINT (Vauto_save_timeout, 30);
DEFVAR_LISP ("echo-keystrokes", &Vecho_keystrokes,
"*Nonzero means echo unfinished commands after this many seconds of pause.\n\
The value may be integer or floating point.");
Vecho_keystrokes = make_number (1);
DEFVAR_INT ("polling-period", &polling_period,
"*Interval between polling for input during Lisp execution.\n\
The reason for polling is to make C-g work to stop a running program.\n\
Polling is needed only when using X windows and SIGIO does not work.\n\
Polling is automatically disabled in all other cases.");
polling_period = 2;
DEFVAR_LISP ("double-click-time", &Vdouble_click_time,
"*Maximum time between mouse clicks to make a double-click.\n\
Measured in milliseconds. nil means disable double-click recognition;\n\
t means double-clicks have no time limit and are detected\n\
by position only.");
Vdouble_click_time = make_number (500);
DEFVAR_INT ("double-click-fuzz", &double_click_fuzz,
"*Maximum mouse movement between clicks to make a double-click.\n\
On window-system frames, value is the number of pixels the mouse may have\n\
moved horizontally or vertically between two clicks to make a double-click.\n\
On non window-system frames, value is interpreted in units of 1/8 characters\n\
instead of pixels.");
double_click_fuzz = 3;
DEFVAR_BOOL ("inhibit-local-menu-bar-menus", &inhibit_local_menu_bar_menus,
"*Non-nil means inhibit local map menu bar menus.");
inhibit_local_menu_bar_menus = 0;
DEFVAR_INT ("num-input-keys", &num_input_keys,
"Number of complete key sequences read as input so far.\n\
This includes key sequences read from keyboard macros.\n\
The number is effectively the number of interactive command invocations.");
num_input_keys = 0;
DEFVAR_INT ("num-nonmacro-input-events", &num_nonmacro_input_events,
"Number of input events read from the keyboard so far.\n\
This does not include events generated by keyboard macros.");
num_nonmacro_input_events = 0;
DEFVAR_LISP ("last-event-frame", &Vlast_event_frame,
"The frame in which the most recently read event occurred.\n\
If the last event came from a keyboard macro, this is set to `macro'.");
Vlast_event_frame = Qnil;
DEFVAR_LISP ("tty-erase-char", &Vtty_erase_char,
"The ERASE character as set by the user with stty.");
DEFVAR_LISP ("help-char", &Vhelp_char,
"Character to recognize as meaning Help.\n\
When it is read, do `(eval help-form)', and display result if it's a string.\n\
If the value of `help-form' is nil, this char can be read normally.");
XSETINT (Vhelp_char, Ctl ('H'));
DEFVAR_LISP ("help-event-list", &Vhelp_event_list,
"List of input events to recognize as meaning Help.\n\
These work just like the value of `help-char' (see that).");
Vhelp_event_list = Qnil;
DEFVAR_LISP ("help-form", &Vhelp_form,
"Form to execute when character `help-char' is read.\n\
If the form returns a string, that string is displayed.\n\
If `help-form' is nil, the help char is not recognized.");
Vhelp_form = Qnil;
DEFVAR_LISP ("prefix-help-command", &Vprefix_help_command,
"Command to run when `help-char' character follows a prefix key.\n\
This command is used only when there is no actual binding\n\
for that character after that prefix key.");
Vprefix_help_command = Qnil;
DEFVAR_LISP ("top-level", &Vtop_level,
"Form to evaluate when Emacs starts up.\n\
Useful to set before you dump a modified Emacs.");
Vtop_level = Qnil;
DEFVAR_LISP ("keyboard-translate-table", &Vkeyboard_translate_table,
"Translate table for keyboard input, or nil.\n\
Each character is looked up in this string and the contents used instead.\n\
The value may be a string, a vector, or a char-table.\n\
If it is a string or vector of length N,\n\
character codes N and up are untranslated.\n\
In a vector or a char-table, an element which is nil means \"no translation\".");
Vkeyboard_translate_table = Qnil;
DEFVAR_BOOL ("cannot-suspend", &cannot_suspend,
"Non-nil means to always spawn a subshell instead of suspending.\n\
\(Even if the operating system has support for stopping a process.\)");
cannot_suspend = 0;
DEFVAR_BOOL ("menu-prompting", &menu_prompting,
"Non-nil means prompt with menus when appropriate.\n\
This is done when reading from a keymap that has a prompt string,\n\
for elements that have prompt strings.\n\
The menu is displayed on the screen\n\
if X menus were enabled at configuration\n\
time and the previous event was a mouse click prefix key.\n\
Otherwise, menu prompting uses the echo area.");
menu_prompting = 1;
DEFVAR_LISP ("menu-prompt-more-char", &menu_prompt_more_char,
"Character to see next line of menu prompt.\n\
Type this character while in a menu prompt to rotate around the lines of it.");
XSETINT (menu_prompt_more_char, ' ');
DEFVAR_INT ("extra-keyboard-modifiers", &extra_keyboard_modifiers,
"A mask of additional modifier keys to use with every keyboard character.\n\
Emacs applies the modifiers of the character stored here to each keyboard\n\
character it reads. For example, after evaluating the expression\n\
(setq extra-keyboard-modifiers ?\\C-x)\n\
all input characters will have the control modifier applied to them.\n\
\n\
Note that the character ?\\C-@, equivalent to the integer zero, does\n\
not count as a control character; rather, it counts as a character\n\
with no modifiers; thus, setting `extra-keyboard-modifiers' to zero\n\
cancels any modification.");
extra_keyboard_modifiers = 0;
DEFVAR_LISP ("deactivate-mark", &Vdeactivate_mark,
"If an editing command sets this to t, deactivate the mark afterward.\n\
The command loop sets this to nil before each command,\n\
and tests the value when the command returns.\n\
Buffer modification stores t in this variable.");
Vdeactivate_mark = Qnil;
DEFVAR_LISP ("command-hook-internal", &Vcommand_hook_internal,
"Temporary storage of pre-command-hook or post-command-hook.");
Vcommand_hook_internal = Qnil;
DEFVAR_LISP ("pre-command-hook", &Vpre_command_hook,
"Normal hook run before each command is executed.\n\
If an unhandled error happens in running this hook,\n\
the hook value is set to nil, since otherwise the error\n\
might happen repeatedly and make Emacs nonfunctional.");
Vpre_command_hook = Qnil;
DEFVAR_LISP ("post-command-hook", &Vpost_command_hook,
"Normal hook run after each command is executed.\n\
If an unhandled error happens in running this hook,\n\
the hook value is set to nil, since otherwise the error\n\
might happen repeatedly and make Emacs nonfunctional.");
Vpost_command_hook = Qnil;
DEFVAR_LISP ("post-command-idle-hook", &Vpost_command_idle_hook,
"Normal hook run after each command is executed, if idle.\n\
Errors running the hook are caught and ignored.\n\
This feature is obsolete; use idle timers instead. See `etc/NEWS'.");
Vpost_command_idle_hook = Qnil;
DEFVAR_INT ("post-command-idle-delay", &post_command_idle_delay,
"Delay time before running `post-command-idle-hook'.\n\
This is measured in microseconds.");
post_command_idle_delay = 100000;
#if 0
DEFVAR_LISP ("echo-area-clear-hook", ...,
"Normal hook run when clearing the echo area.");
#endif
Qecho_area_clear_hook = intern ("echo-area-clear-hook");
XSYMBOL (Qecho_area_clear_hook)->value = Qnil;
DEFVAR_LISP ("lucid-menu-bar-dirty-flag", &Vlucid_menu_bar_dirty_flag,
"t means menu bar, specified Lucid style, needs to be recomputed.");
Vlucid_menu_bar_dirty_flag = Qnil;
DEFVAR_LISP ("menu-bar-final-items", &Vmenu_bar_final_items,
"List of menu bar items to move to the end of the menu bar.\n\
The elements of the list are event types that may have menu bar bindings.");
Vmenu_bar_final_items = Qnil;
DEFVAR_KBOARD ("overriding-terminal-local-map",
Voverriding_terminal_local_map,
"Per-terminal keymap that overrides all other local keymaps.\n\
If this variable is non-nil, it is used as a keymap instead of the\n\
buffer's local map, and the minor mode keymaps and text property keymaps.\n\
This variable is intended to let commands such as `universal-argument'\n\
set up a different keymap for reading the next command.");
DEFVAR_LISP ("overriding-local-map", &Voverriding_local_map,
"Keymap that overrides all other local keymaps.\n\
If this variable is non-nil, it is used as a keymap instead of the\n\
buffer's local map, and the minor mode keymaps and text property keymaps.");
Voverriding_local_map = Qnil;
DEFVAR_LISP ("overriding-local-map-menu-flag", &Voverriding_local_map_menu_flag,
"Non-nil means `overriding-local-map' applies to the menu bar.\n\
Otherwise, the menu bar continues to reflect the buffer's local map\n\
and the minor mode maps regardless of `overriding-local-map'.");
Voverriding_local_map_menu_flag = Qnil;
DEFVAR_LISP ("special-event-map", &Vspecial_event_map,
"Keymap defining bindings for special events to execute at low level.");
Vspecial_event_map = Fcons (intern ("keymap"), Qnil);
DEFVAR_LISP ("track-mouse", &do_mouse_tracking,
"*Non-nil means generate motion events for mouse motion.");
DEFVAR_KBOARD ("system-key-alist", Vsystem_key_alist,
"Alist of system-specific X windows key symbols.\n\
Each element should have the form (N . SYMBOL) where N is the\n\
numeric keysym code (sans the \"system-specific\" bit 1<<28)\n\
and SYMBOL is its name.");
DEFVAR_LISP ("deferred-action-list", &Vdeferred_action_list,
"List of deferred actions to be performed at a later time.\n\
The precise format isn't relevant here; we just check whether it is nil.");
Vdeferred_action_list = Qnil;
DEFVAR_LISP ("deferred-action-function", &Vdeferred_action_function,
"Function to call to handle deferred actions, after each command.\n\
This function is called with no arguments after each command\n\
whenever `deferred-action-list' is non-nil.");
Vdeferred_action_function = Qnil;
DEFVAR_LISP ("suggest-key-bindings", &Vsuggest_key_bindings,
"*Non-nil means show the equivalent key-binding when M-x command has one.\n\
The value can be a length of time to show the message for.\n\
If the value is non-nil and not a number, we wait 2 seconds.");
Vsuggest_key_bindings = Qt;
DEFVAR_LISP ("timer-list", &Vtimer_list,
"List of active absolute time timers in order of increasing time.");
Vtimer_list = Qnil;
DEFVAR_LISP ("timer-idle-list", &Vtimer_idle_list,
"List of active idle-time timers in order of increasing time.");
Vtimer_idle_list = Qnil;
DEFVAR_LISP ("input-method-function", &Vinput_method_function,
"If non-nil, the function that implements the current input method.\n\
It's called with one argument, a printing character that was just read.\n\
\(That means a character with code 040...0176.)\n\
Typically this function uses `read-event' to read additional events.\n\
When it does so, it should first bind `input-method-function' to nil\n\
so it will not be called recursively.\n\
\n\
The function should return a list of zero or more events\n\
to be used as input. If it wants to put back some events\n\
to be reconsidered, separately, by the input method,\n\
it can add them to the beginning of `unread-command-events'.\n\
\n\
The input method function can find in `input-method-previous-method'\n\
the previous echo area message.\n\
\n\
The input method function should refer to the variables\n\
`input-method-use-echo-area' and `input-method-exit-on-first-char'\n\
for guidance on what to do.");
Vinput_method_function = Qnil;
DEFVAR_LISP ("input-method-previous-message",
&Vinput_method_previous_message,
"When `input-method-function' is called, hold the previous echo area message.\n\
This variable exists because `read-event' clears the echo area\n\
before running the input method. It is nil if there was no message.");
Vinput_method_previous_message = Qnil;
DEFVAR_LISP ("show-help-function", &Vshow_help_function,
"If non-nil, the function that implements the display of help.\n\
It's called with one argument, the help string to display.");
Vshow_help_function = Qnil;
DEFVAR_LISP ("disable-point-adjustment", &Vdisable_point_adjustment,
"If non-nil, suppress point adjustment after executing a command.\n\
\n\
After a command is executed, if point is moved into a region that has\n\
special properties (e.g. composition, display), we adjust point to\n\
the boundary of the region. But, several special commands sets this\n\
variable to non-nil, then we suppress the point adjustment.\n\
\n\
This variable is set to nil before reading a command, and is checked\n\
just after executing the command.");
Vdisable_point_adjustment = Qnil;
DEFVAR_LISP ("global-disable-point-adjustment",
&Vglobal_disable_point_adjustment,
"*If non-nil, always suppress point adjustment.\n\
\n\
The default value is nil, in which case, point adjustment are\n\
suppressed only after special commands that set\n\
`disable-point-adjustment' (which see) to non-nil.");
Vglobal_disable_point_adjustment = Qnil;
DEFVAR_BOOL ("update-menu-bindings", &update_menu_bindings,
"Non-nil means updating menu bindings is allowed.\n\
A value of nil means menu bindings should not be updated.\n\
Used during Emacs' startup.");
update_menu_bindings = 1;
DEFVAR_LISP ("minibuffer-message-timeout", &Vminibuffer_message_timeout,
"*How long to display an echo-area message when the minibuffer is active.\n\
If the value is not a number, such messages don't time out.");
Vminibuffer_message_timeout = make_number (2);
}
void
keys_of_keyboard ()
{
initial_define_key (global_map, Ctl ('Z'), "suspend-emacs");
initial_define_key (control_x_map, Ctl ('Z'), "suspend-emacs");
initial_define_key (meta_map, Ctl ('C'), "exit-recursive-edit");
initial_define_key (global_map, Ctl (']'), "abort-recursive-edit");
initial_define_key (meta_map, 'x', "execute-extended-command");
initial_define_lispy_key (Vspecial_event_map, "delete-frame",
"handle-delete-frame");
initial_define_lispy_key (Vspecial_event_map, "iconify-frame",
"ignore-event");
initial_define_lispy_key (Vspecial_event_map, "make-frame-visible",
"ignore-event");
}