annotate src/gpmevent.c @ 794:3604075fb2a3

[xemacs-hg @ 2002-03-29 07:05:27 by jhar] xemacs.mak: Define STACK_TRACE_EYE_CATCHER
author jhar
date Fri, 29 Mar 2002 07:05:29 +0000
parents e38acbeb1cae
children 2b6fa2618f76
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
1 /* GPM (General purpose mouse) functions
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2 Copyright (C) 1997 William M. Perry <wmperry@gnu.org>
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3 Copyright (C) 1999 Free Software Foundation, Inc.
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
4 Copyright (C) 2002 Ben Wing.
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
5
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
6 This file is part of XEmacs.
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
7
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
8 XEmacs is free software; you can redistribute it and/or modify it
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
9 under the terms of the GNU General Public License as published by the
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
10 Free Software Foundation; either version 2, or (at your option) any
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
11 later version.
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
12
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
13 XEmacs is distributed in the hope that it will be useful, but WITHOUT
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
14 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
15 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
16 for more details.
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
17
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
18 You should have received a copy of the GNU General Public License
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
19 along with XEmacs; see the file COPYING. If not, write to
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
20 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
21 Boston, MA 02111-1307, USA. */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
22
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
23 /* Synched up with: Not in FSF. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
24
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
25 /* Authors: William Perry */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
26
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
27 #include <config.h>
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
28 #include "lisp.h"
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
29
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
30 #include "commands.h"
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
31 #include "console-tty.h"
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
32 #include "console.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
33 #include "device.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
34 #include "events.h"
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
35 #include "lstream.h"
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
36 #include "process.h"
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
37 #include "sysdep.h"
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
38
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
39 #include "sysproc.h" /* for MAXDESC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
40
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
41 #ifdef HAVE_GPM
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
42 #include "gpmevent.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
43 #include <gpm.h>
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
44
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
45 #define KG_SHIFT 0
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
46 #define KG_CTRL 2
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
47 #define KG_ALT 3
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
48
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
49 extern int gpm_tried;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
50 extern void *gpm_stack;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
51
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
52 static int (*orig_event_pending_p) (int);
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
53 static void (*orig_next_event_cb) (Lisp_Event *);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
54
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
55 static Lisp_Object gpm_event_queue;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
56 static Lisp_Object gpm_event_queue_tail;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
57
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
58 struct __gpm_state
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
59 {
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
60 int gpm_tried;
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
61 int gpm_flag;
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
62 void *gpm_stack;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
63 };
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
64
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
65 static struct __gpm_state gpm_state_information[MAXDESC];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
66
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
67 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
68 store_gpm_state (int fd)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
69 {
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
70 gpm_state_information[fd].gpm_tried = gpm_tried;
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
71 gpm_state_information[fd].gpm_flag = gpm_flag;
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
72 gpm_state_information[fd].gpm_stack = gpm_stack;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
73 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
74
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
75 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
76 restore_gpm_state (int fd)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
77 {
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
78 gpm_tried = gpm_state_information[fd].gpm_tried;
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
79 gpm_flag = gpm_state_information[fd].gpm_flag;
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
80 gpm_stack = gpm_state_information[fd].gpm_stack;
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
81 gpm_consolefd = gpm_fd = fd;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
82 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
83
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
84 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
85 clear_gpm_state (int fd)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
86 {
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
87 if (fd >= 0)
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
88 memset (&gpm_state_information[fd], '\0', sizeof (struct __gpm_state));
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
89 gpm_tried = gpm_flag = 1;
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
90 gpm_fd = gpm_consolefd = -1;
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
91 gpm_stack = NULL;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
92 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
93
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
94 static int
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
95 get_process_infd (Lisp_Process *p)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
96 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
97 Lisp_Object instr, outstr;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
98 get_process_streams (p, &instr, &outstr);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
99 assert (!NILP (instr));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
100 return filedesc_stream_fd (XLSTREAM (instr));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
101 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
102
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
103 DEFUN ("receive-gpm-event", Freceive_gpm_event, 0, 2, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
104 Run GPM_GetEvent().
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
105 This function is the process handler for the GPM connection.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
106 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
107 (process, string))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
108 {
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
109 Gpm_Event ev;
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
110 int modifiers = 0;
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
111 int button = 1;
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
112 Lisp_Object fake_event = Qnil;
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
113 Lisp_Event *event = NULL;
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
114 struct gcpro gcpro1;
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
115 static int num_events;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
116
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
117 CHECK_PROCESS (process);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
118
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
119 restore_gpm_state (get_process_infd (XPROCESS (process)));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
120
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
121 if (!Gpm_GetEvent (&ev))
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
122 {
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
123 warn_when_safe (Qnil, Qerror,
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
124 "Gpm_GetEvent failed - %d", gpm_fd);
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
125 return (Qzero);
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
126 }
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
127
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
128 GCPRO1 (fake_event);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
129
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
130 num_events++;
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
131
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
132 fake_event = Fmake_event (Qnil, Qnil);
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
133 event = XEVENT (fake_event);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
134
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
135 event->timestamp = 0;
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
136 event->channel = Fselected_frame (Qnil); /* CONSOLE_SELECTED_FRAME (con); */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
137
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
138 /* Whow, wouldn't named defines be NICE!?!?! */
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
139 modifiers = 0;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
140
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
141 if (ev.modifiers & 1) modifiers |= XEMACS_MOD_SHIFT;
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
142 if (ev.modifiers & 2) modifiers |= XEMACS_MOD_META;
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
143 if (ev.modifiers & 4) modifiers |= XEMACS_MOD_CONTROL;
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
144 if (ev.modifiers & 8) modifiers |= XEMACS_MOD_META;
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
145
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
146 if (ev.buttons & GPM_B_LEFT)
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
147 button = 1;
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
148 else if (ev.buttons & GPM_B_MIDDLE)
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
149 button = 2;
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
150 else if (ev.buttons & GPM_B_RIGHT)
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
151 button = 3;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
152
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
153 switch (GPM_BARE_EVENTS (ev.type))
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
154 {
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
155 case GPM_DOWN:
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
156 case GPM_UP:
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
157 event->event_type =
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
158 (ev.type & GPM_DOWN) ? button_press_event : button_release_event;
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
159 event->event.button.x = ev.x;
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
160 event->event.button.y = ev.y;
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
161 event->event.button.button = button;
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
162 event->event.button.modifiers = modifiers;
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
163 break;
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
164 case GPM_MOVE:
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
165 case GPM_DRAG:
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
166 event->event_type = pointer_motion_event;
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
167 event->event.motion.x = ev.x;
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
168 event->event.motion.y = ev.y;
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
169 event->event.motion.modifiers = modifiers;
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
170 default:
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
171 /* This will never happen */
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
172 break;
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
173 }
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
174
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
175 /* Handle the event */
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
176 enqueue_event (fake_event, &gpm_event_queue, &gpm_event_queue_tail);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
177
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
178 UNGCPRO;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
179
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
180 return (Qzero);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
181 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
182
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
183 static void turn_off_gpm (char *process_name)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
184 {
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
185 Lisp_Object process = Fget_process (build_string (process_name));
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
186 int fd = -1;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
187
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
188 if (NILP (process))
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
189 /* Something happened to our GPM process - fail silently */
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
190 return;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
191
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
192 fd = get_process_infd (XPROCESS (process));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
193
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
194 restore_gpm_state (fd);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
195
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
196 Gpm_Close();
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
197
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
198 clear_gpm_state (fd);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
199
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
200 Fdelete_process (build_string (process_name));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
201 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
202
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
203 #ifdef TIOCLINUX
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
204 static Lisp_Object
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
205 tty_get_foreign_selection (Lisp_Object selection_symbol,
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
206 Lisp_Object target_type)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
207 {
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
208 /* This function can GC */
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
209 struct device *d = decode_device (Qnil);
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
210 int fd = DEVICE_INFD (d);
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
211 char c = 3;
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
212 Lisp_Object output_stream = Qnil;
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
213 Lisp_Object terminal_stream = Qnil;
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
214 Lisp_Object output_string = Qnil;
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
215 struct gcpro gcpro1,gcpro2,gcpro3;
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
216
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
217 GCPRO3(output_stream,terminal_stream,output_string);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
218
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
219 /* The ioctl() to paste actually puts things in the input queue of
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
220 ** the virtual console, so we need to trap that data, since we are
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
221 ** supposed to return the actual string selection from this
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
222 ** function.
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
223 */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
224
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
225 /* I really hate doing this, but it doesn't seem to cause any
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
226 ** problems, and it makes the Lstream_read stuff further down
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
227 ** error out correctly instead of trying to indefinitely read from
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
228 ** the console.
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
229 **
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
230 ** There is no set_descriptor_blocking() function call, but in my
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
231 ** testing under linux, it has not proved fatal to leave the
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
232 ** descriptor in non-blocking mode.
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
233 **
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
234 ** William Perry Nov 5, 1999
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
235 */
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
236 set_descriptor_non_blocking (fd);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
237
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
238 /* We need two streams, one for reading from the selected device,
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
239 ** and one to write the data into. There is no writable version
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
240 ** of the lisp-string lstream, so we make do with a resizing
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
241 ** buffer stream, and make a string out of it after we are
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
242 ** done.
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
243 */
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
244 output_stream = make_resizing_buffer_output_stream ();
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
245 terminal_stream = make_filedesc_input_stream (fd, 0, -1, LSTR_BLOCKED_OK);
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
246 output_string = Qnil;
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
247
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
248 /* #### We should arguably use a specbind() and an unwind routine here,
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
249 ** #### but I don't care that much right now.
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
250 */
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
251 if (NILP (output_stream) || NILP (terminal_stream))
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
252 /* Should we signal an error here? */
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
253 goto out;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
254
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
255 if (ioctl (fd, TIOCLINUX, &c) < 0)
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
256 {
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
257 /* Could not get the selection - eek */
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
258 UNGCPRO;
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
259 return (Qnil);
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
260 }
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
261
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
262 while (1)
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
263 {
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
264 Intbyte tempbuf[1024]; /* some random amount */
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
265 Bytecount i;
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
266 Bytecount size_in_bytes =
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
267 Lstream_read (XLSTREAM (terminal_stream),
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
268 tempbuf, sizeof (tempbuf));
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
269
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
270 if (size_in_bytes <= 0)
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
271 /* end of the stream */
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
272 break;
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
273
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
274 /* convert CR->LF */
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
275 for (i = 0; i < size_in_bytes; i++)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
276 {
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
277 if (tempbuf[i] == '\r')
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
278 tempbuf[i] = '\n';
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
279 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
280
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
281 Lstream_write (XLSTREAM (output_stream), tempbuf, size_in_bytes);
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
282 }
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
283
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
284 Lstream_flush (XLSTREAM (output_stream));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
285
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
286 output_string =
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
287 make_string (resizing_buffer_stream_ptr (XLSTREAM (output_stream)),
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
288 Lstream_byte_count (XLSTREAM (output_stream)));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
289
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
290 Lstream_delete (XLSTREAM (output_stream));
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
291 Lstream_delete (XLSTREAM (terminal_stream));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
292
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
293 out:
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
294 UNGCPRO;
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
295 return (output_string);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
296 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
297
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
298 static Lisp_Object
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
299 tty_selection_exists_p (Lisp_Object selection, Lisp_Object selection_type)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
300 {
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
301 return (Qt);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
302 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
303 #endif /* TIOCLINUX */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
304
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
305 #if 0
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
306 static Lisp_Object
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
307 tty_own_selection (Lisp_Object selection_name, Lisp_Object selection_value,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
308 Lisp_Object how_to_add, Lisp_Object selection_type)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
309 {
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
310 /* There is no way to do this cleanly - the GPM selection
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
311 ** 'protocol' (actually the TIOCLINUX ioctl) requires a start and
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
312 ** end position on the _screen_, not a string to stick in there.
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
313 ** Lame.
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
314 **
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
315 ** William Perry Nov 4, 1999
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
316 */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
317 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
318 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
319
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
320 /* This function appears to work once in a blue moon. I'm not sure
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
321 ** exactly why either. *sigh*
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
322 **
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
323 ** William Perry Nov 4, 1999
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
324 **
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
325 ** Apparently, this is the way (mouse-position) is supposed to work,
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
326 ** and I was just expecting something else. (mouse-pixel-position)
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
327 ** works just fine.
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
328 **
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
329 ** William Perry Nov 7, 1999
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
330 */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
331 static int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
332 tty_get_mouse_position (struct device *d, Lisp_Object *frame, int *x, int *y)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
333 {
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
334 Gpm_Event ev;
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
335 int num_buttons;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
336
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
337 memset(&ev,'\0',sizeof(ev));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
338
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
339 num_buttons = Gpm_GetSnapshot(&ev);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
340
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
341 if (!num_buttons)
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
342 /* This means there are events pending... */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
343
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
344 /* #### In theory, we should drain the events pending, stick
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
345 ** #### them in the queue, and return the mouse position
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
346 ** #### anyway.
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
347 */
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
348 return (-1);
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
349 *x = ev.x;
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
350 *y = ev.y;
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
351 *frame = DEVICE_SELECTED_FRAME (d);
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
352 return (1);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
353 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
354
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
355 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
356 tty_set_mouse_position (struct window *w, int x, int y)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
357 {
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
358 /*
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
359 #### I couldn't find any GPM functions that set the mouse position.
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
360 #### Mr. Perry had left this function empty; that must be why.
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
361 #### karlheg
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
362 */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
363 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
364
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
365 static int gpm_event_pending_p (int user_p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
366 {
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
367 Lisp_Object event;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
368
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
369 EVENT_CHAIN_LOOP (event, gpm_event_queue)
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
370 {
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
371 if (!user_p || command_event_p (event))
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
372 return (1);
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
373 }
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
374 return (orig_event_pending_p (user_p));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
375 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
376
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
377 static void gpm_next_event_cb (Lisp_Event *event)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
378 {
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
379 /* #### It would be nice to preserve some sort of ordering of the
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
380 ** #### different types of events, but that would be quite a bit
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
381 ** #### of work, and would more than likely break the abstraction
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
382 ** #### between the other event loops and this one.
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
383 */
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
384
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
385 if (!NILP (gpm_event_queue))
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
386 {
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
387 Lisp_Object queued_event =
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
388 dequeue_event (&gpm_event_queue, &gpm_event_queue_tail);
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
389 *event = *(XEVENT (queued_event));
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
390
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
391 if (event->event_type == pointer_motion_event)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
392 {
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
393 struct device *d = decode_device (event->channel);
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
394 int fd = DEVICE_INFD (d);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
395
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
396 /* Ok, now this is just freaky. Bear with me though.
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
397 **
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
398 ** If you run gnuclient and attach to a XEmacs running in
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
399 ** X or on another TTY, the mouse cursor does not get
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
400 ** drawn correctly. This is because the ioctl() fails
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
401 ** with EPERM because the TTY specified is not our
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
402 ** controlling terminal. If you are the superuser, it
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
403 ** will work just spiffy. The appropriate source file (at
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
404 ** least in linux 2.2.x) is
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
405 ** .../linux/drivers/char/console.c in the function
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
406 ** tioclinux(). The following bit of code is brutal to
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
407 ** us:
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
408 **
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
409 ** if (current->tty != tty && !suser())
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
410 ** return -EPERM;
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
411 **
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
412 ** I even tried setting us as a process leader, removing
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
413 ** our controlling terminal, and then using the TIOCSCTTY
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
414 ** to set up a new controlling terminal, all with no luck.
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
415 **
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
416 ** What is even weirder is if you run XEmacs in a VC, and
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
417 ** attach to it from another VC with gnuclient, go back to
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
418 ** the original VC and hit a key, the mouse pointer
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
419 ** displays (in BOTH VCs), until you hit a key in the
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
420 ** second VC, after which it does not display in EITHER
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
421 ** VC. Bizarre, no?
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
422 **
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
423 ** All I can say is thank god Linux comes with source code
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
424 ** or I would have been completely confused. Well, ok,
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
425 ** I'm still completely confused. I don't see why they
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
426 ** don't just check the permissions on the device
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
427 ** (actually, if you have enough access to it to get the
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
428 ** console's file descriptor, you should be able to do
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
429 ** with it as you wish, but maybe that is just me).
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
430 **
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
431 ** William M. Perry - Nov 9, 1999
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
432 */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
433
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
434 Gpm_DrawPointer (event->event.motion.x,event->event.motion.y, fd);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
435 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
436
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
437 return;
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
438 }
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
439
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
440 orig_next_event_cb (event);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
441 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
442
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
443 static void hook_event_callbacks_once (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
444 {
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
445 static int hooker;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
446
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
447 if (!hooker)
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
448 {
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
449 orig_event_pending_p = event_stream->event_pending_p;
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
450 orig_next_event_cb = event_stream->next_event_cb;
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
451 event_stream->event_pending_p = gpm_event_pending_p;
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
452 event_stream->next_event_cb = gpm_next_event_cb;
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
453 hooker = 1;
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
454 }
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
455 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
456
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
457 static void hook_console_methods_once (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
458 {
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
459 static int hooker;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
460
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
461 if (!hooker)
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
462 {
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
463 /* Install the mouse position methods for the TTY console type */
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
464 CONSOLE_HAS_METHOD (tty, get_mouse_position);
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
465 CONSOLE_HAS_METHOD (tty, set_mouse_position);
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
466 CONSOLE_HAS_METHOD (tty, get_foreign_selection);
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
467 CONSOLE_HAS_METHOD (tty, selection_exists_p);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
468 #if 0
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
469 CONSOLE_HAS_METHOD (tty, own_selection);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
470 #endif
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
471 }
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
472 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
473
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
474 DEFUN ("gpm-enabled-p", Fgpm_enabled_p, 0, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
475 Return non-nil if GPM mouse support is currently enabled on DEVICE.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
476 */
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
477 (device))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
478 {
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
479 char *console_name = ttyname (DEVICE_INFD (decode_device (device)));
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
480 char process_name[1024];
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
481 Lisp_Object proc;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
482
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
483 if (!console_name)
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
484 return (Qnil);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
485
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
486 memset (process_name, '\0', sizeof(process_name));
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
487 snprintf (process_name, sizeof(process_name) - 1, "gpm for %s",
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
488 console_name);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
489
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
490 proc = Fget_process (build_string (process_name));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
491
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
492 if (NILP (proc))
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
493 return (Qnil);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
494
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
495 if (1) /* (PROCESS_LIVE_P (proc)) */
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
496 return (Qt);
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
497 return (Qnil);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
498 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
499
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
500 DEFUN ("gpm-enable", Fgpm_enable, 0, 2, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
501 Toggle accepting of GPM mouse events.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
502 */
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
503 (device, arg))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
504 {
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
505 Gpm_Connect conn;
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
506 int rval;
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
507 Lisp_Object gpm_process;
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
508 Lisp_Object gpm_filter;
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
509 struct device *d = decode_device (device);
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
510 int fd = DEVICE_INFD (d);
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
511 char *console_name = ttyname (fd);
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
512 char process_name[1024];
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
513
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
514 hook_event_callbacks_once ();
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
515 hook_console_methods_once ();
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
516
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
517 if (noninteractive)
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
518 invalid_operation ("Can't connect to GPM in batch mode", Qunbound);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
519
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
520 if (!console_name)
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
521 /* Something seriously wrong here... */
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
522 return (Qnil);
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
523
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
524 memset (process_name, '\0', sizeof(process_name));
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
525 snprintf (process_name, sizeof(process_name) - 1, "gpm for %s",
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
526 console_name);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
527
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
528 if (NILP (arg))
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
529 {
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
530 turn_off_gpm (process_name);
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
531 return (Qnil);
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
532 }
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
533
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
534 /* DANGER DANGER.
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
535 ** Though shalt not call (gpm-enable t) after we have already
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
536 ** started, or stuff blows up.
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
537 */
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
538 if (!NILP (Fgpm_enabled_p (device)))
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
539 invalid_operation ("GPM already enabled for this console", Qunbound);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
540
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
541 conn.eventMask = GPM_DOWN|GPM_UP|GPM_MOVE|GPM_DRAG;
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
542 conn.defaultMask = GPM_MOVE;
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
543 conn.minMod = 0;
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
544 conn.maxMod = ((1 << KG_SHIFT) | (1 << KG_ALT) | (1 << KG_CTRL));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
545
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
546 /* Reset some silly static variables so that multiple Gpm_Open()
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
547 ** calls have even a slight chance of working
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
548 */
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
549 gpm_tried = 0;
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
550 gpm_flag = 0;
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
551 gpm_stack = NULL;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
552
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
553 /* Make sure Gpm_Open() does ioctl() on the correct
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
554 ** descriptor, or it can get the wrong terminal sizes, etc.
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
555 */
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
556 gpm_consolefd = fd;
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
557
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
558 /* We have to pass the virtual console manually, otherwise if you
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
559 ** use 'gnuclient -nw' to connect to an XEmacs that is running in
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
560 ** X, Gpm_Open() tries to use ttyname(0 | 1 | 2) to find out which
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
561 ** console you are using, which is of course not correct for the
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
562 ** new tty device.
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
563 */
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
564 if (strncmp (console_name, "/dev/tty", 8) || !isdigit (console_name[8]))
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
565 /* Urk, something really wrong */
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
566 return (Qnil);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
567
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
568 rval = Gpm_Open (&conn, atoi (console_name + 8));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
569
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
570 switch (rval)
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
571 {
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
572 case -1: /* General failure */
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
573 break;
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
574 case -2: /* We are running under an XTerm */
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
575 Gpm_Close();
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
576 break;
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
577 default:
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
578 /* Is this really necessary? */
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
579 set_descriptor_non_blocking (gpm_fd);
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
580 store_gpm_state (gpm_fd);
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
581 gpm_process =
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
582 connect_to_file_descriptor (build_string (process_name), Qnil,
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
583 make_int (gpm_fd),
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
584 make_int (gpm_fd));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
585
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
586 if (!NILP (gpm_process))
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
587 {
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
588 rval = 0;
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
589 Fprocess_kill_without_query (gpm_process, Qnil);
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
590 gpm_filter = wrap_subr (&SFreceive_gpm_event);
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
591 set_process_filter (gpm_process, gpm_filter, 1);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
592
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
593 /* Keep track of the device for later */
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
594 /* Fput (gpm_process, intern ("gpm-device"), device); */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
595 }
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
596 else
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
597 {
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
598 Gpm_Close ();
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
599 rval = -1;
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
600 }
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
601 }
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
602
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
603 return (rval ? Qnil : Qt);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
604 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
605
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
606 void vars_of_gpmevent (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
607 {
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
608 gpm_event_queue = Qnil;
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
609 gpm_event_queue_tail = Qnil;
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
610 staticpro (&gpm_event_queue);
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
611 staticpro (&gpm_event_queue_tail);
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
612 dump_add_root_object (&gpm_event_queue);
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
613 dump_add_root_object (&gpm_event_queue_tail);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
614 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
615
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
616 void syms_of_gpmevent (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
617 {
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
618 DEFSUBR (Freceive_gpm_event);
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
619 DEFSUBR (Fgpm_enable);
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 665
diff changeset
620 DEFSUBR (Fgpm_enabled_p);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
621 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
622
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
623 #endif /* HAVE_GPM */