view src/gpmevent.c @ 4953:304aebb79cd3

function renamings to track names of char typedefs -------------------- ChangeLog entries follow: -------------------- man/ChangeLog addition: 2010-01-27 Ben Wing <ben@xemacs.org> * internals/internals.texi (lrecords): * internals/internals.texi (The DFC API): * internals/internals.texi (Conversion to and from External Data): * internals/internals.texi (Mule-izing Code): * internals/internals.texi (Pervasive changes throughout XEmacs sources): * internals/internals.texi (Ben's README): * internals/internals.texi (Future Work -- Localized Text/Messages): * emodules.texi (Defining Variables): Rename: write_c_string -> write_cistring build_intstring -> build_istring build_string -> build_cistring build_ext_string -> build_extstring make_ext_string -> make_extstring buffer_insert_c_string -> buffer_insert_ascstring intern_int -> intern_istring See comment in src/ChangeLog about this. modules/ChangeLog addition: 2010-01-27 Ben Wing <ben@xemacs.org> * postgresql/postgresql.c (print_pgconn): * postgresql/postgresql.c (print_pgresult): * postgresql/postgresql.c (Fpq_conn_defaults): * postgresql/postgresql.c (Fpq_pgconn): * postgresql/postgresql.c (Fpq_res_status): * postgresql/postgresql.c (Fpq_result_error_message): * postgresql/postgresql.c (Fpq_fname): * postgresql/postgresql.c (Fpq_get_value): * postgresql/postgresql.c (Fpq_cmd_status): * postgresql/postgresql.c (Fpq_cmd_tuples): * postgresql/postgresql.c (Fpq_notifies): * postgresql/postgresql.c (Fpq_get_line): * postgresql/postgresql.c (Fpq_get_line_async): * postgresql/postgresql.c (FROB): * postgresql/postgresql.c (init_postgresql_from_environment): * ldap/eldap.c: * ldap/eldap.c (Fldap_open): * ldap/eldap.c (Fldap_search_basic): * canna/canna_api.c: * canna/canna_api.c (make_euc_string): Rename: write_c_string -> write_cistring build_intstring -> build_istring build_string -> build_cistring build_ext_string -> build_extstring make_ext_string -> make_extstring buffer_insert_c_string -> buffer_insert_ascstring intern_int -> intern_istring See comment in src/ChangeLog about this. src/ChangeLog addition: 2010-01-27 Ben Wing <ben@xemacs.org> * .gdbinit.in.in: * README: * abbrev.c (write_abbrev): * abbrev.c (describe_abbrev): * alloc.c (make_extstring): * alloc.c (build_istring): * alloc.c (build_cistring): * alloc.c (build_ascstring): * alloc.c (build_extstring): * alloc.c (build_msg_istring): * alloc.c (build_defer_istring): * buffer.c (Fgenerate_new_buffer_name): * buffer.c (init_buffer_2): * console-tty.c (tty_init_console): * console-x.c (get_display_arg_connection): * console-x.c (x_perhaps_init_unseen_key_defaults): * database.c (dbm_map): * database.c (dbm_get): * database.c (berkdb_get): * database.c (berkdb_map): * device-gtk.c (FROB_PIXMAP): * device-gtk.c (Fgtk_style_info): * device-msw.c (msprinter_default_printer): * device-msw.c (sync_printer_with_devmode): * device-x.c (coding_system_of_xrm_database): * device-x.c (x_init_device): * device-x.c (signal_if_x_error): * device-x.c (Fx_get_resource): * device-x.c (Fx_server_vendor): * device-x.c (Fx_get_font_path): * dialog-x.c (maybe_run_dbox_text_callback): * doc.c (extract_object_file_name): * doc.c (unparesseuxify_doc_string): * doc.c (get_doc_string): * doc.c (get_object_file_name): * doc.c (Fdocumentation): * doc.c (Fsnarf_documentation): * doc.c (Fsubstitute_command_keys): * editfns.c (init_editfns): * editfns.c (Ftemp_directory): * editfns.c (Fuser_login_name): * editfns.c (Fuser_real_login_name): * editfns.c (Fuser_home_directory): * editfns.c (Fformat_time_string): * editfns.c (Fcurrent_time_string): * editfns.c (Fcurrent_time_zone): * emacs.c: * emacs.c (main_1): * emodules.c (Flist_modules): * emodules.c (emodules_load): * emodules.c (emodules_doc_sym): * emodules.c (vars_of_module): * event-Xt.c (x_has_keysym): * event-gtk.c (emacs_gtk_format_magic_event): * event-gtk.c (dragndrop_data_received): * event-gtk.c (gtk_reset_key_mapping): * event-msw.c (mswindows_dde_callback): * event-msw.c (mswindows_wnd_proc): * faces.c (complex_vars_of_faces): * file-coding.c (find_coding_system): * file-coding.c (setup_eol_coding_systems): * file-coding.c (make_coding_system_1): * file-coding.c (snarf_coding_system): * fileio.c: * fileio.c (lisp_strerror): * fileio.c (Ffile_name_directory): * fileio.c (Ffile_name_as_directory): * fileio.c (Fdirectory_file_name): * fileio.c (if): * fileio.c (Ffile_symlink_p): * fileio.c (Fencrypt_string): * fileio.c (Fdecrypt_string): * filelock.c (lock_file): * filelock.c (Ffile_locked_p): * floatfns.c (matherr): * font-mgr.c (build_fcapi_string): * font-mgr.c (make_xlfd_font_regexp): * frame-msw.c (mswindows_window_id): * frame-msw.c (mswindows_frame_property): * frame-x.c: * frame-x.c (color_to_string): * frame-x.c (maybe_set_frame_title_format): * frame-x.c (x_cde_transfer_callback): * frame-x.c (Fx_window_id): * glade.c (connector): * glade.c (Fglade_xml_textdomain): * glade.c (syms_of_glade): * glyphs-eimage.c (jpeg_instantiate): * glyphs-eimage.c (png_instantiate): * glyphs-eimage.c (tiff_instantiate): * glyphs-gtk.c (font_instantiate): * glyphs-gtk.c (BUILD_GLYPH_INST): * glyphs-x.c (x_locate_pixmap_file): * glyphs-x.c (font_instantiate): * glyphs-x.c (x_widget_property): * glyphs-x.c (BUILD_GLYPH_INST): * glyphs.c (print_image_instance): * glyphs.c (bitmap_to_lisp_data): * glyphs.c (pixmap_to_lisp_data): * gpmevent.c (turn_off_gpm): * gpmevent.c (Fgpm_enabled_p): * gpmevent.c (Fgpm_enable): * gtk-glue.c (__make_string_mapper): * gtk-glue.c (xemacs_gtklist_to_list): * gtk-xemacs.c (FROB_FACE): * gtk-xemacs.c (xemacs_gtk_convert_color): * hpplay.c (player_error_internal): * hpplay.c (myHandler): * insdel.c (buffer_insert_ascstring_1): * insdel.h: * insdel.h (buffer_insert_ascstring): * intl.c (Fcurrent_locale): * intl.c (Fset_current_locale): * keymap.c (make_key_description): * keymap.c (Ftext_char_description): * keymap.c (describe_command): * keymap.c (describe_map): * lisp.h: * lread.c: * lread.c (locate_file_in_directory_mapper): * lread.c (locate_file_construct_suffixed_files_mapper): * mule-charset.c (Fmake_charset): * nt.c (Fmswindows_short_file_name): * nt.c (Fmswindows_long_file_name): * objects-gtk.c (__get_gtk_font_truename): * objects-gtk.c (__gtk_font_list_internal): * objects-msw.c (font_enum_callback_2): * objects-msw.c (create_hfont_from_font_spec): * objects-msw.c (mswindows_font_list): * objects-msw.c (mswindows_font_spec_matches_charset_stage_2): * objects-tty.c (tty_initialize_font_instance): * objects-x.c (x_font_truename): * objects-x.c (x_font_instance_truename): * objects-x.c (x_font_instance_properties): * objects-x.c (x_font_list): * print.c (write_cistring): * print.c (print_vector_internal): * print.c (print_cons): * process-nt.c (nt_canonicalize_host_name): * process-unix.c (unix_create_process): * process-unix.c (unix_canonicalize_host_name): * process.c (status_message): * process.c (status_notify): * process.c (init_xemacs_process): * process.c (syms_of_process): * redisplay-tty.c (term_get_fkeys_1): * redisplay-tty.c (CONDITIONAL_REASSIGN): * search.c (compile_pattern_1): * select-common.h (selection_data_to_lisp_data): * select-gtk.c (atom_to_symbol): * select-gtk.c (PROCESSING_GTK_CODE): * select-msw.c (mswindows_get_foreign_selection): * select-x.c (x_atom_to_symbol): * select-x.c (Fx_get_cutbuffer_internal): * symbols.c (intern_istring): * symbols.c (intern): * symbols.c (intern_converting_underscores_to_dashes): * symbols.c (Fintern): * sysdep.c (init_system_name): * sysdll.c (dll_error): * sysdll.c (dll_open): * syswindows.h: * syswindows.h (build_tstr_string): * tests.c (DFC_CHECK_LENGTH): * tests.c (DFC_CHECK_CONTENT): * tests.c (DFC_RESULT_PASS): * tests.c (Ftest_data_format_conversion): * text.c: * text.c (new_dfc_convert_now_damn_it): * text.h: * text.h (build_wext_string): * tooltalk.c (tt_build_c_string): * tooltalk.c (Ftooltalk_default_procid): * tooltalk.c (Ftooltalk_default_session): * tooltalk.c (init_tooltalk): * ui-byhand.c (Fgtk_clist_get_text): * ui-byhand.c (Fgtk_clist_get_pixtext): * ui-byhand.c (Fgtk_label_get): * ui-byhand.c (Fgtk_notebook_query_tab_label_packing): * ui-gtk.c (emacs_gtk_object_printer): * ui-gtk.c (emacs_gtk_boxed_printer): * ui-gtk.c (gtk_type_to_lisp): * ui-gtk.c (symbol_to_enum): * ui-gtk.c (enum_to_symbol): * unexaix.c (report_error): * unexaix.c (ERROR0): * unexec.c (report_error): * unexec.c (ERROR0): * unicode.c (unicode_to_ichar): * win32.c (tstr_to_local_file_format): * win32.c (Fmswindows_cygwin_to_win32_path): * win32.c (struct read_link_hash): * xemacs.def.in.in: Rename: write_c_string -> write_cistring build_intstring -> build_istring build_string -> build_cistring build_ext_string -> build_extstring make_ext_string -> make_extstring buffer_insert_c_string -> buffer_insert_ascstring intern_int -> intern_istring These functions have been renamed so that the naming harmonizes with the typedefs for strings: `cistring' along with CIbyte *, `istring' along with Ibyte *, `extstring' along with Extbyte *, `ascstring' along with Ascbyte *. Also make buffer_insert_ascstring take Ascbyte * and assert that its argument is ASCII.
author Ben Wing <ben@xemacs.org>
date Wed, 27 Jan 2010 00:35:36 -0600
parents facf3239ba30
children 2aa9cd456ae7
line wrap: on
line source

/* GPM (General purpose mouse) functions
   Copyright (C) 1997 William M. Perry <wmperry@gnu.org>
   Copyright (C) 1999 Free Software Foundation, Inc.
   Copyright (C) 2002 Ben Wing.
   
   This file is part of XEmacs.
   
   XEmacs is free software; you can redistribute it and/or modify it
   under the terms of the GNU General Public License as published by the
   Free Software Foundation; either version 2, or (at your option) any
   later version.
   
   XEmacs is distributed in the hope that it will be useful, but WITHOUT
   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
   for more details.
   
   You should have received a copy of the GNU General Public License
   along with XEmacs; see the file COPYING.  If not, write to
   the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
   Boston, MA 02111-1307, USA.  */

/* Synched up with: Not in FSF. */

/* Authors: William Perry */

#include <config.h>
#include "lisp.h"

#include "commands.h"
#include "console-tty.h"
#include "console.h"
#include "device.h"
#include "events.h"
#include "lstream.h"
#include "process.h"
#include "sysdep.h"
#include "frame.h"
#include "device-impl.h"
#include "console-impl.h"
#include "console-tty-impl.h"

#include "sysproc.h" /* for MAXDESC */

#ifdef HAVE_GPM
#include "gpmevent.h"
#include <gpm.h>

#define KG_SHIFT	0
#define KG_CTRL		2
#define KG_ALT		3

extern int gpm_tried;
extern void *gpm_stack;

static int (*orig_event_pending_p) (int);
static void (*orig_next_event_cb) (Lisp_Event *);

static Lisp_Object gpm_event_queue;
static Lisp_Object gpm_event_queue_tail;

struct __gpm_state
{
  int gpm_tried;
  int gpm_flag;
  void *gpm_stack;
};

static struct __gpm_state gpm_state_information[MAXDESC];

static void
store_gpm_state (int fd)
{
  gpm_state_information[fd].gpm_tried = gpm_tried;
  gpm_state_information[fd].gpm_flag = gpm_flag;
  gpm_state_information[fd].gpm_stack = gpm_stack;
}

static void
restore_gpm_state (int fd)
{
  gpm_tried = gpm_state_information[fd].gpm_tried;
  gpm_flag = gpm_state_information[fd].gpm_flag;
  gpm_stack = gpm_state_information[fd].gpm_stack;
  gpm_consolefd = gpm_fd = fd;
}

static void
clear_gpm_state (int fd)
{
  if (fd >= 0)
    memset (&gpm_state_information[fd], '\0', sizeof (struct __gpm_state));
  gpm_tried = gpm_flag = 1;
  gpm_fd = gpm_consolefd = -1;
  gpm_stack = NULL;
}

static int
get_process_infd (Lisp_Process *p)
{
  Lisp_Object instr, outstr, errstr;
  get_process_streams (p, &instr, &outstr, &errstr);
  assert (!NILP (instr));
  return filedesc_stream_fd (XLSTREAM (instr));
}

DEFUN ("receive-gpm-event", Freceive_gpm_event, 0, 2, 0, /*
Run GPM_GetEvent().
This function is the process handler for the GPM connection.
*/
       (process, UNUSED (string)))
{
  Gpm_Event ev;
  int modifiers = 0;
  int button = 1;
  Lisp_Object fake_event = Qnil;
  Lisp_Event *event = NULL;
  struct gcpro gcpro1;
  static int num_events;

  CHECK_PROCESS (process);

  restore_gpm_state (get_process_infd (XPROCESS (process)));

  if (!Gpm_GetEvent (&ev))
    {
      warn_when_safe (Qnil, Qerror,
		      "Gpm_GetEvent failed - %d", gpm_fd);
      return (Qzero);
    }

  GCPRO1 (fake_event);

  num_events++;

  fake_event = Fmake_event (Qnil, Qnil);
  event = XEVENT (fake_event);

  event->timestamp = 0;
  event->channel = Fselected_frame (Qnil); /* CONSOLE_SELECTED_FRAME (con); */

  /* Whow, wouldn't named defines be NICE!?!?! */
  modifiers = 0;

  if (ev.modifiers & 1)   modifiers |= XEMACS_MOD_SHIFT;
  if (ev.modifiers & 2)   modifiers |= XEMACS_MOD_META;
  if (ev.modifiers & 4)   modifiers |= XEMACS_MOD_CONTROL;
  if (ev.modifiers & 8)   modifiers |= XEMACS_MOD_META;

  if (ev.buttons & GPM_B_LEFT)
    button = 1;
  else if (ev.buttons & GPM_B_MIDDLE)
    button = 2;
  else if (ev.buttons & GPM_B_RIGHT)
    button = 3;

  switch (GPM_BARE_EVENTS (ev.type))
    {
    case GPM_DOWN:
    case GPM_UP:
      SET_EVENT_TYPE (event,
	(ev.type & GPM_DOWN) ? button_press_event : button_release_event);
      SET_EVENT_BUTTON_X (event, ev.x);
      SET_EVENT_BUTTON_Y (event, ev.y);
      SET_EVENT_BUTTON_BUTTON (event, button);
      SET_EVENT_BUTTON_MODIFIERS (event, modifiers);
      break;
    case GPM_MOVE:
    case GPM_DRAG:
      SET_EVENT_TYPE (event, pointer_motion_event);
      SET_EVENT_MOTION_X (event, ev.x);
      SET_EVENT_MOTION_Y (event, ev.y);
      SET_EVENT_MOTION_MODIFIERS (event, modifiers);
    default:
      /* This will never happen */
      break;
    }

  /* Handle the event */
  enqueue_event (fake_event, &gpm_event_queue, &gpm_event_queue_tail);

  UNGCPRO;

  return (Qzero);
}

static void turn_off_gpm (char *process_name)
{
  Lisp_Object process = Fget_process (build_cistring (process_name));
  int fd = -1;

  if (NILP (process))
    /* Something happened to our GPM process - fail silently */
    return;

  fd = get_process_infd (XPROCESS (process));

  restore_gpm_state (fd);

  Gpm_Close();

  clear_gpm_state (fd);

  Fdelete_process (build_cistring (process_name));
}

#ifdef TIOCLINUX
static Lisp_Object
tty_get_foreign_selection (Lisp_Object UNUSED (selection_symbol),
			   Lisp_Object UNUSED (target_type))
{
  /* This function can GC */
  struct device *d = decode_device (Qnil);
  int fd = DEVICE_INFD (d);
  char c = 3;
  Lisp_Object output_stream = Qnil;
  Lisp_Object terminal_stream = Qnil;
  Lisp_Object output_string = Qnil;
  struct gcpro gcpro1,gcpro2,gcpro3;

  GCPRO3(output_stream,terminal_stream,output_string);

  /* The ioctl() to paste actually puts things in the input queue of
   ** the virtual console, so we need to trap that data, since we are
   ** supposed to return the actual string selection from this
   ** function.
   */

  /* I really hate doing this, but it doesn't seem to cause any
   ** problems, and it makes the Lstream_read stuff further down
   ** error out correctly instead of trying to indefinitely read from
   ** the console.
   **
   ** There is no set_descriptor_blocking() function call, but in my
   ** testing under linux, it has not proved fatal to leave the
   ** descriptor in non-blocking mode.
   **
   ** William Perry Nov 5, 1999
   */
  set_descriptor_non_blocking (fd);

  /* We need two streams, one for reading from the selected device,
   ** and one to write the data into.  There is no writable version
   ** of the lisp-string lstream, so we make do with a resizing
   ** buffer stream, and make a string out of it after we are
   ** done.
   */
  output_stream = make_resizing_buffer_output_stream ();
  terminal_stream = make_filedesc_input_stream (fd, 0, -1, LSTR_BLOCKED_OK);
  output_string = Qnil;

  /* #### We should arguably use a specbind() and an unwind routine here,
   ** #### but I don't care that much right now.
   */
  if (NILP (output_stream) || NILP (terminal_stream))
    /* Should we signal an error here? */
    goto out;

  if (ioctl (fd, TIOCLINUX, &c) < 0)
    {
      /* Could not get the selection - eek */
      UNGCPRO;
      return (Qnil);
    }

  while (1)
    {
      Ibyte tempbuf[1024];	/* some random amount */
      Bytecount i;
      Bytecount size_in_bytes =
	Lstream_read (XLSTREAM (terminal_stream),
		      tempbuf, sizeof (tempbuf));

      if (size_in_bytes <= 0)
	/* end of the stream */
	break;

      /* convert CR->LF */
      for (i = 0; i < size_in_bytes; i++)
	{
	  if (tempbuf[i] == '\r')
	    tempbuf[i] = '\n';
	}

      Lstream_write (XLSTREAM (output_stream), tempbuf, size_in_bytes);
    }

  Lstream_flush (XLSTREAM (output_stream));

  output_string =
    make_string (resizing_buffer_stream_ptr (XLSTREAM (output_stream)),
		 Lstream_byte_count (XLSTREAM (output_stream)));

  Lstream_delete (XLSTREAM (output_stream));
  Lstream_delete (XLSTREAM (terminal_stream));

 out:
  UNGCPRO;
  return (output_string);
}

static Lisp_Object
tty_selection_exists_p (Lisp_Object UNUSED (selection),
			Lisp_Object UNUSED (selection_type))
{
  return (Qt);
}
#endif /* TIOCLINUX */

#if 0
static Lisp_Object
tty_own_selection (Lisp_Object selection_name, Lisp_Object selection_value,
		   Lisp_Object how_to_add, Lisp_Object selection_type)
{
  /* There is no way to do this cleanly - the GPM selection
   ** 'protocol' (actually the TIOCLINUX ioctl) requires a start and
   ** end position on the _screen_, not a string to stick in there.
   ** Lame.
   **
   ** William Perry Nov 4, 1999
   */
}
#endif

/* This function appears to work once in a blue moon.  I'm not sure
 ** exactly why either.  *sigh*
 **
 ** William Perry Nov 4, 1999
 **
 ** Apparently, this is the way (mouse-position) is supposed to work,
 ** and I was just expecting something else.  (mouse-pixel-position)
 ** works just fine.
 **
 ** William Perry Nov 7, 1999
 */
static int
tty_get_mouse_position (struct device *d, Lisp_Object *frame, int *x, int *y)
{
  Gpm_Event ev;
  int num_buttons;

  memset(&ev,'\0',sizeof(ev));

  num_buttons = Gpm_GetSnapshot(&ev);

  if (!num_buttons)
    /* This means there are events pending... */

    /* #### In theory, we should drain the events pending, stick
     ** #### them in the queue, and return the mouse position
     ** #### anyway.
     */
    return (-1);
  *x = ev.x;
  *y = ev.y;
  *frame = DEVICE_SELECTED_FRAME (d);
  return (1);
}

static void
tty_set_mouse_position (struct window *UNUSED (w), int UNUSED (x),
			int UNUSED (y))
{
  /*
     #### I couldn't find any GPM functions that set the mouse position.
     #### Mr. Perry had left this function empty; that must be why.
     #### karlheg
     */
}

static int gpm_event_pending_p (int user_p)
{
  Lisp_Object event;

  EVENT_CHAIN_LOOP (event, gpm_event_queue)
    {
      if (!user_p || command_event_p (event))
	return (1);
    }
  return (orig_event_pending_p (user_p));
}

static void gpm_next_event_cb (Lisp_Event *event)
{
  /* #### It would be nice to preserve some sort of ordering of the
   ** #### different types of events, but that would be quite a bit
   ** #### of work, and would more than likely break the abstraction
   ** #### between the other event loops and this one.
   */

  if (!NILP (gpm_event_queue))
    {
      Lisp_Object queued_event =
	dequeue_event (&gpm_event_queue, &gpm_event_queue_tail);
      *event = *(XEVENT (queued_event));

      if (event->event_type == pointer_motion_event)
	{
	  struct device *d = decode_device (event->channel);
	  int fd = DEVICE_INFD (d);

	  /* Ok, now this is just freaky.  Bear with me though.
	   **
	   ** If you run gnuclient and attach to a XEmacs running in
	   ** X or on another TTY, the mouse cursor does not get
	   ** drawn correctly.  This is because the ioctl() fails
	   ** with EPERM because the TTY specified is not our
	   ** controlling terminal.  If you are the superuser, it
	   ** will work just spiffy.  The appropriate source file (at
	   ** least in linux 2.2.x) is
	   ** .../linux/drivers/char/console.c in the function
	   ** tioclinux().  The following bit of code is brutal to
	   ** us:
	   **
	   ** if (current->tty != tty && !suser())
	   **    return -EPERM;
	   **
	   ** I even tried setting us as a process leader, removing
	   ** our controlling terminal, and then using the TIOCSCTTY
	   ** to set up a new controlling terminal, all with no luck.
	   **
	   ** What is even weirder is if you run XEmacs in a VC, and
	   ** attach to it from another VC with gnuclient, go back to
	   ** the original VC and hit a key, the mouse pointer
	   ** displays (in BOTH VCs), until you hit a key in the
	   ** second VC, after which it does not display in EITHER
	   ** VC.  Bizarre, no?
	   **
	   ** All I can say is thank god Linux comes with source code
	   ** or I would have been completely confused.  Well, ok,
	   ** I'm still completely confused.  I don't see why they
	   ** don't just check the permissions on the device
	   ** (actually, if you have enough access to it to get the
	   ** console's file descriptor, you should be able to do
	   ** with it as you wish, but maybe that is just me).
	   **
	   ** William M. Perry - Nov 9, 1999
	   */

	  Gpm_DrawPointer (EVENT_MOTION_X (event),EVENT_MOTION_Y (event), fd);
	}

      return;
    }

  orig_next_event_cb (event);
}

static void hook_event_callbacks_once (void)
{
  static int hooker;

  if (!hooker)
    {
      orig_event_pending_p = event_stream->event_pending_p;
      orig_next_event_cb = event_stream->next_event_cb;
      event_stream->event_pending_p = gpm_event_pending_p;
      event_stream->next_event_cb = gpm_next_event_cb;
      hooker = 1;
    }
}

static void hook_console_methods_once (void)
{
  static int hooker;

  if (!hooker)
    {
      /* Install the mouse position methods for the TTY console type */
      CONSOLE_HAS_METHOD (tty, get_mouse_position);
      CONSOLE_HAS_METHOD (tty, set_mouse_position);
      CONSOLE_HAS_METHOD (tty, get_foreign_selection);
      CONSOLE_HAS_METHOD (tty, selection_exists_p);
#if 0
      CONSOLE_HAS_METHOD (tty, own_selection);
#endif
    }
}

DEFUN ("gpm-enabled-p", Fgpm_enabled_p, 0, 1, 0, /*
Return non-nil if GPM mouse support is currently enabled on DEVICE.
*/
       (device))
{
  char *console_name = ttyname (DEVICE_INFD (decode_device (device)));
  char process_name[1024];
  Lisp_Object proc;

  if (!console_name)
    return (Qnil);

  memset (process_name, '\0', sizeof(process_name));
  snprintf (process_name, sizeof(process_name) - 1, "gpm for %s",
	    console_name);

  proc = Fget_process (build_cistring (process_name));

  if (NILP (proc))
    return (Qnil);

  if (1)			/* (PROCESS_LIVE_P (proc)) */
    return (Qt);
  return (Qnil);
}

DEFUN ("gpm-enable", Fgpm_enable, 0, 2, 0, /*
Toggle accepting of GPM mouse events.
*/
       (device, arg))
{
  Gpm_Connect conn;
  int rval;
  Lisp_Object gpm_process;
  Lisp_Object gpm_filter;
  struct device *d = decode_device (device);
  int fd = DEVICE_INFD (d);
  char *console_name = ttyname (fd);
  char process_name[1024];

  hook_event_callbacks_once ();
  hook_console_methods_once ();

  if (noninteractive)
    invalid_operation ("Can't connect to GPM in batch mode", Qunbound);

  if (!console_name)
    /* Something seriously wrong here... */
    return (Qnil);

  memset (process_name, '\0', sizeof(process_name));
  snprintf (process_name, sizeof(process_name) - 1, "gpm for %s",
	    console_name);

  if (NILP (arg))
    {
      turn_off_gpm (process_name);
      return (Qnil);
    }

  /* DANGER DANGER.
   ** Though shalt not call (gpm-enable t) after we have already
   ** started, or stuff blows up.
   */
  if (!NILP (Fgpm_enabled_p (device)))
    invalid_operation ("GPM already enabled for this console", Qunbound);

  conn.eventMask = GPM_DOWN|GPM_UP|GPM_MOVE|GPM_DRAG;
  conn.defaultMask = GPM_MOVE;
  conn.minMod = 0;
  conn.maxMod = ((1 << KG_SHIFT) | (1 << KG_ALT) | (1 << KG_CTRL));

  /* Reset some silly static variables so that multiple Gpm_Open()
   ** calls have even a slight chance of working
   */
  gpm_tried = 0;
  gpm_flag = 0;
  gpm_stack = NULL;

  /* Make sure Gpm_Open() does ioctl() on the correct
   ** descriptor, or it can get the wrong terminal sizes, etc.
   */
  gpm_consolefd = fd;

  /* We have to pass the virtual console manually, otherwise if you
   ** use `gnuclient -nw' to connect to an XEmacs that is running in
   ** X, Gpm_Open() tries to use ttyname(0 | 1 | 2) to find out which
   ** console you are using, which is of course not correct for the
   ** new tty device.
   */
  if (strncmp (console_name, "/dev/tty", 8) || !isdigit (console_name[8]))
    /* Urk, something really wrong */
    return (Qnil);

  rval = Gpm_Open (&conn, atoi (console_name + 8));

  switch (rval)
    {
    case -1:			/* General failure */
      break;
    case -2:			/* We are running under an XTerm */
      Gpm_Close();
      break;
    default:
      /* Is this really necessary? */
      set_descriptor_non_blocking (gpm_fd);
      store_gpm_state (gpm_fd);
      gpm_process =
	connect_to_file_descriptor (build_cistring (process_name), Qnil,
				    make_int (gpm_fd),
				    make_int (gpm_fd));

      if (!NILP (gpm_process))
	{
	  rval = 0;
	  Fprocess_kill_without_query (gpm_process, Qnil);
	  gpm_filter = GET_DEFUN_LISP_OBJECT (Freceive_gpm_event);
	  set_process_filter (gpm_process, gpm_filter, 1, 0);

	  /* Keep track of the device for later */
	  /* Fput (gpm_process, intern ("gpm-device"), device); */
	}
      else
	{
	  Gpm_Close ();
	  rval = -1;
	}
    }

  return (rval ? Qnil : Qt);
}

void vars_of_gpmevent (void)
{
  gpm_event_queue = Qnil;
  gpm_event_queue_tail = Qnil;
  staticpro (&gpm_event_queue);
  staticpro (&gpm_event_queue_tail);
  dump_add_root_lisp_object (&gpm_event_queue);
  dump_add_root_lisp_object (&gpm_event_queue_tail);
}

void syms_of_gpmevent (void)
{
  DEFSUBR (Freceive_gpm_event);
  DEFSUBR (Fgpm_enable);
  DEFSUBR (Fgpm_enabled_p);
}

#endif /* HAVE_GPM */