Mercurial > hg > xemacs-beta
annotate src/event-unixoid.c @ 4906:6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
-------------------- ChangeLog entries follow: --------------------
lisp/ChangeLog addition:
2010-02-01 Ben Wing <ben@xemacs.org>
* cl-extra.el:
* cl-extra.el (cl-string-vector-equalp): Removed.
* cl-extra.el (cl-bit-vector-vector-equalp): Removed.
* cl-extra.el (cl-vector-array-equalp): Removed.
* cl-extra.el (cl-hash-table-contents-equalp): Removed.
* cl-extra.el (equalp): Removed.
* cl-extra.el (cl-mapcar-many):
Comment out the whole `equalp' implementation for the moment;
remove once we're sure the C implementation works.
* cl-macs.el:
* cl-macs.el (equalp):
Simplify the compiler-macro for `equalp' -- once it's in C,
we don't need to try so hard to expand it.
src/ChangeLog addition:
2010-02-01 Ben Wing <ben@xemacs.org>
* abbrev.c (abbrev_match_mapper):
* buffer.h (CANON_TABLE_OF):
* buffer.h:
* editfns.c (Fchar_equal):
* minibuf.c (scmp_1):
* text.c (qxestrcasecmp_i18n):
* text.c (qxestrncasecmp_i18n):
* text.c (qxetextcasecmp):
* text.c (qxetextcasecmp_matching):
Create new macro CANONCASE that converts to a canonical mapping
and use it to do caseless comparisons instead of DOWNCASE.
* alloc.c:
* alloc.c (cons_equal):
* alloc.c (vector_equal):
* alloc.c (string_equal):
* bytecode.c (compiled_function_equal):
* chartab.c (char_table_entry_equal):
* chartab.c (char_table_equal):
* data.c (weak_list_equal):
* data.c (weak_box_equal):
* data.c (ephemeron_equal):
* device-msw.c (equal_devmode):
* elhash.c (hash_table_equal):
* events.c (event_equal):
* extents.c (properties_equal):
* extents.c (extent_equal):
* faces.c:
* faces.c (face_equal):
* faces.c (face_hash):
* floatfns.c (float_equal):
* fns.c:
* fns.c (bit_vector_equal):
* fns.c (plists_differ):
* fns.c (Fplists_eq):
* fns.c (Fplists_equal):
* fns.c (Flax_plists_eq):
* fns.c (Flax_plists_equal):
* fns.c (internal_equal):
* fns.c (internal_equalp):
* fns.c (internal_equal_0):
* fns.c (syms_of_fns):
* glyphs.c (image_instance_equal):
* glyphs.c (glyph_equal):
* glyphs.c (glyph_hash):
* gui.c (gui_item_equal):
* lisp.h:
* lrecord.h (struct lrecord_implementation):
* marker.c (marker_equal):
* number.c (bignum_equal):
* number.c (ratio_equal):
* number.c (bigfloat_equal):
* objects.c (color_instance_equal):
* objects.c (font_instance_equal):
* opaque.c (equal_opaque):
* opaque.c (equal_opaque_ptr):
* rangetab.c (range_table_equal):
* specifier.c (specifier_equal):
Add a `foldcase' param to the equal() method and use it to implement
`equalp' comparisons. Also add to plists_differ(), although we
don't currently use it here.
Rewrite internal_equalp(). Implement cross-type vector comparisons.
Don't implement our own handling of numeric promotion -- just use
the `=' primitive.
Add internal_equal_0(), which takes a `foldcase' param and calls
either internal_equal() or internal_equalp().
* buffer.h:
When given a 0 for buffer (which is the norm when functions don't
have a specific buffer available), use the current buffer's table,
not `standard-case-table'; otherwise the current settings are
ignored.
* casetab.c:
* casetab.c (set_case_table):
When handling old-style vectors of 256 in `set-case-table' don't
overwrite the existing table! Instead create a new table and
populate.
* device-msw.c (sync_printer_with_devmode):
* lisp.h:
* text.c (lisp_strcasecmp_ascii):
Rename lisp_strcasecmp to lisp_strcasecmp_ascii and use
lisp_strcasecmp_i18n for caseless comparisons in some places.
* elhash.c:
Delete unused lisp_string_hash and lisp_string_equal().
* events.h:
* keymap-buttons.h:
* keymap.h:
* keymap.c (keymap_lookup_directly):
* keymap.c (keymap_store):
* keymap.c (FROB):
* keymap.c (key_desc_list_to_event):
* keymap.c (describe_map_mapper):
* keymap.c (INCLUDE_BUTTON_ZERO):
New file keymap-buttons.h; use to handle buttons 1-26 in place of
duplicating code 26 times.
* frame-gtk.c (allocate_gtk_frame_struct):
* frame-msw.c (mswindows_init_frame_1):
Fix some comments about internal_equal() in redisplay that don't
apply any more.
* keymap-slots.h:
* keymap.c:
New file keymap-slots.h. Use it to notate the slots in a keymap
structure, similar to frameslots.h or coding-system-slots.h.
* keymap.c (MARKED_SLOT):
* keymap.c (keymap_equal):
* keymap.c (keymap_hash):
Implement.
tests/ChangeLog addition:
2010-02-01 Ben Wing <ben@xemacs.org>
* automated/case-tests.el:
* automated/case-tests.el (uni-mappings):
* automated/search-tests.el:
Delete old pristine-case-table code. Rewrite the Unicode torture
test to take into account whether overlapping mappings exist for
more than one character, and not doing the upcase/downcase
comparisons in such cases.
* automated/lisp-tests.el (foo):
* automated/lisp-tests.el (string-variable):
* automated/lisp-tests.el (featurep):
Replace Assert (equal ... with Assert-equal; same for other types
of equality. Replace some awkward equivalents of Assert-equalp
with Assert-equalp. Add lots of equalp tests.
* automated/case-tests.el:
* automated/regexp-tests.el:
* automated/search-tests.el:
Fix up the comments at the top of the files. Move rules about where
to put tests into case-tests.el.
* automated/test-harness.el:
* automated/test-harness.el (test-harness-aborted-summary-template): New.
* automated/test-harness.el (test-harness-from-buffer):
* automated/test-harness.el (batch-test-emacs):
Fix Assert-test-not. Create Assert-not-equal and variants.
Delete the doc strings from all these convenience functions to avoid
excessive repetition; instead use one copy in a comment.
author | Ben Wing <ben@xemacs.org> |
---|---|
date | Mon, 01 Feb 2010 01:02:40 -0600 |
parents | 2fd201d73a92 |
children | 70e8a00896e9 |
rev | line source |
---|---|
428 | 1 /* Code shared between all event loops that use select() and have a |
2 different input descriptor for each device. | |
3 Copyright (C) 1991, 1992, 1993, 1994, 1995 Free Software Foundation, Inc. | |
4 Copyright (C) 1995 Board of Trustees, University of Illinois. | |
5 Copyright (C) 1995 Sun Microsystems, Inc. | |
1268 | 6 Copyright (C) 1995, 1996, 2001, 2002, 2003 Ben Wing. |
428 | 7 |
8 This file is part of XEmacs. | |
9 | |
10 XEmacs is free software; you can redistribute it and/or modify it | |
11 under the terms of the GNU General Public License as published by the | |
12 Free Software Foundation; either version 2, or (at your option) any | |
13 later version. | |
14 | |
15 XEmacs is distributed in the hope that it will be useful, but WITHOUT | |
16 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or | |
17 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License | |
18 for more details. | |
19 | |
20 You should have received a copy of the GNU General Public License | |
21 along with XEmacs; see the file COPYING. If not, write to | |
22 the Free Software Foundation, Inc., 59 Temple Place - Suite 330, | |
23 Boston, MA 02111-1307, USA. */ | |
24 | |
25 /* Synched up with: Not in FSF. */ | |
26 | |
27 /* This file has been Mule-ized. */ | |
28 | |
29 #include <config.h> | |
30 #include "lisp.h" | |
31 | |
872 | 32 #include "console-stream-impl.h" |
33 #include "console-tty-impl.h" | |
1204 | 34 #include "device-impl.h" |
428 | 35 #include "events.h" |
36 #include "lstream.h" | |
37 #include "process.h" | |
38 | |
39 #include "sysdep.h" | |
40 #include "sysfile.h" | |
41 #include "sysproc.h" /* select stuff */ | |
42 #include "systime.h" | |
43 | |
44 /* Mask of bits indicating the descriptors that we wait for input on. | |
45 These work as follows: | |
46 | |
1268 | 47 In event-tty.c we call select() directly on this |
48 to retrieve an event. In event-Xt.c we use | |
49 XtAppAddInput() and the call to select() is down in | |
50 the guts of Xt, but we still use the masks when checking for pending input, even in event-Xt.c. (We can't use XtAppPending() because of the presence of the signal event pipe.) | |
51 | |
428 | 52 input_wait_mask == mask of all file descriptors we select() on, |
53 including TTY/stream console descriptors, | |
54 process descriptors, and the signal event pipe. | |
55 | |
56 non_fake_input_wait_mask == same as input_wait_mask but minus the | |
57 signal event pipe. Also only used in | |
58 event-tty.c. | |
59 | |
60 process_only_mask == only the process descriptors. | |
61 | |
62 tty_only_mask == only the TTY/stream console descriptors. | |
63 */ | |
64 SELECT_TYPE input_wait_mask, non_fake_input_wait_mask; | |
65 SELECT_TYPE process_only_mask, tty_only_mask; | |
66 | |
67 /* This is used to terminate the select(), when an event came in | |
68 through a signal (e.g. window-change or C-g on controlling TTY). */ | |
69 int signal_event_pipe[2]; | |
70 | |
71 int signal_event_pipe_initialized; | |
72 | |
73 int fake_event_occurred; | |
74 | |
1204 | 75 struct console * |
76 find_tty_or_stream_console_from_fd (int fd) | |
77 { | |
78 Lisp_Object concons; | |
79 | |
80 CONSOLE_LOOP (concons) | |
81 { | |
82 struct console *c; | |
83 | |
84 c = XCONSOLE (XCAR (concons)); | |
85 if ((CONSOLE_TTY_P (c) && CONSOLE_TTY_DATA (c)->infd == fd) || | |
86 (CONSOLE_STREAM_P (c) && fileno (CONSOLE_STREAM_DATA (c)->in) == fd)) | |
87 return c; | |
88 } | |
89 | |
90 return 0; | |
91 } | |
92 | |
428 | 93 int |
771 | 94 read_event_from_tty_or_stream_desc (Lisp_Event *event, struct console *con) |
428 | 95 { |
867 | 96 Ichar ch; |
793 | 97 Lisp_Object console = wrap_console (con); |
428 | 98 |
771 | 99 if (CONSOLE_TTY_P (con)) |
867 | 100 ch = Lstream_get_ichar (XLSTREAM (CONSOLE_TTY_DATA (con)->instream)); |
771 | 101 else |
102 { | |
103 /* #### Definitely something strange here. We should be setting | |
104 the stdio handle unbuffered and reading from it instead of mixing | |
105 stdio and raw io calls. */ | |
106 int nread = retry_read (fileno (CONSOLE_STREAM_DATA (con)->in), &ch, 1); | |
107 if (nread <= 0) | |
108 ch = -1; | |
109 } | |
110 | |
111 if (ch < 0) | |
428 | 112 { |
113 /* deleting the console might not be safe right now ... */ | |
114 enqueue_magic_eval_event (io_error_delete_console, console); | |
115 /* but we definitely need to unselect it to avoid infinite | |
116 loops reading EOF's */ | |
117 Fconsole_disable_input (console); | |
118 } | |
119 else | |
120 { | |
4780
2fd201d73a92
Call character_to_event on characters received from XIM, event-Xt.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
4031
diff
changeset
|
121 character_to_event (ch, event, con, use_console_meta_flag, 1); |
428 | 122 event->channel = console; |
123 return 1; | |
124 } | |
125 return 0; | |
126 } | |
127 | |
128 void | |
129 signal_fake_event (void) | |
130 { | |
131 char byte = 0; | |
132 /* We do the write always. Formerly I tried to "optimize" this | |
133 by setting a flag indicating whether we're blocking and only | |
134 doing the write in that case, but there is a race condition | |
135 if the signal occurs after we've checked for the signal | |
136 occurrence (which could occur in many places throughout | |
137 an iteration of the command loop, e.g. in status_notify()), | |
138 but before we set the blocking flag. | |
139 | |
771 | 140 This should be OK as long as write() is reentrant, which I'm fairly |
141 sure it is since it's a system call. */ | |
428 | 142 |
143 if (signal_event_pipe_initialized) | |
144 /* In case a signal comes through while we're dumping */ | |
145 { | |
146 int old_errno = errno; | |
771 | 147 retry_write (signal_event_pipe[1], &byte, 1); |
428 | 148 errno = old_errno; |
149 } | |
150 } | |
151 | |
152 void | |
153 drain_signal_event_pipe (void) | |
154 { | |
155 char chars[128]; | |
156 /* The input end of the pipe has been set to non-blocking. */ | |
771 | 157 while (retry_read (signal_event_pipe[0], chars, sizeof (chars)) > 0) |
428 | 158 ; |
159 } | |
160 | |
1204 | 161 void |
162 drain_tty_devices (void) | |
163 { | |
164 Lisp_Object devcons, concons; | |
165 CONSOLE_LOOP (concons) | |
166 { | |
167 struct console *con = XCONSOLE (XCAR (concons)); | |
168 if (!con->input_enabled) | |
169 continue; | |
170 | |
171 CONSOLE_DEVICE_LOOP (devcons, con) | |
172 { | |
173 struct device *d = XDEVICE (XCAR (devcons)); | |
174 if (DEVICE_TTY_P (d)) | |
175 { | |
176 SELECT_TYPE temp_mask; | |
177 int infd = DEVICE_INFD (d); | |
178 | |
179 FD_ZERO (&temp_mask); | |
180 FD_SET (infd, &temp_mask); | |
181 | |
182 while (1) | |
183 { | |
184 Lisp_Object event; | |
185 | |
186 if (!poll_fds_for_input (temp_mask)) | |
187 break; | |
188 | |
189 event = Fmake_event (Qnil, Qnil); | |
190 if (!read_event_from_tty_or_stream_desc (XEVENT (event), | |
191 con)) | |
192 /* EOF, or something ... */ | |
193 break; | |
194 | |
195 /* queue the read event to be read for real later. */ | |
196 enqueue_dispatch_event (event); | |
197 } | |
198 } | |
199 } | |
200 } | |
201 } | |
202 | |
428 | 203 int |
204 event_stream_unixoid_select_console (struct console *con) | |
205 { | |
206 int infd; | |
207 | |
208 if (CONSOLE_STREAM_P (con)) | |
209 infd = fileno (CONSOLE_STREAM_DATA (con)->in); | |
210 else | |
211 { | |
212 assert (CONSOLE_TTY_P (con)); | |
213 infd = CONSOLE_TTY_DATA (con)->infd; | |
214 } | |
215 | |
216 assert (infd >= 0); | |
217 | |
218 FD_SET (infd, &input_wait_mask); | |
219 FD_SET (infd, &non_fake_input_wait_mask); | |
220 FD_SET (infd, &tty_only_mask); | |
221 return infd; | |
222 } | |
223 | |
224 int | |
225 event_stream_unixoid_unselect_console (struct console *con) | |
226 { | |
227 int infd; | |
228 | |
229 if (CONSOLE_STREAM_P (con)) | |
230 infd = fileno (CONSOLE_STREAM_DATA (con)->in); | |
231 else | |
232 { | |
233 assert (CONSOLE_TTY_P (con)); | |
234 infd = CONSOLE_TTY_DATA (con)->infd; | |
235 } | |
236 | |
237 assert (infd >= 0); | |
238 | |
239 FD_CLR (infd, &input_wait_mask); | |
240 FD_CLR (infd, &non_fake_input_wait_mask); | |
241 FD_CLR (infd, &tty_only_mask); | |
242 return infd; | |
243 } | |
244 | |
245 static int | |
440 | 246 get_process_infd (Lisp_Process *p) |
428 | 247 { |
853 | 248 Lisp_Object instr, outstr, errstr; |
249 get_process_streams (p, &instr, &outstr, &errstr); | |
428 | 250 assert (!NILP (instr)); |
251 return filedesc_stream_fd (XLSTREAM (instr)); | |
252 } | |
253 | |
853 | 254 static int |
255 get_process_errfd (Lisp_Process *p) | |
428 | 256 { |
853 | 257 Lisp_Object instr, outstr, errstr; |
258 get_process_streams (p, &instr, &outstr, &errstr); | |
259 if (!NILP (errstr)) | |
260 return filedesc_stream_fd (XLSTREAM (errstr)); | |
261 else | |
262 return -1; | |
428 | 263 } |
264 | |
853 | 265 void |
266 event_stream_unixoid_select_process (Lisp_Process *proc, int doin, int doerr, | |
267 int *infd, int *errfd) | |
428 | 268 { |
853 | 269 if (doin) |
270 { | |
271 *infd = get_process_infd (proc); | |
272 FD_SET (*infd, &input_wait_mask); | |
273 FD_SET (*infd, &non_fake_input_wait_mask); | |
274 FD_SET (*infd, &process_only_mask); | |
275 } | |
276 | |
277 if (doerr) | |
278 { | |
279 *errfd = get_process_errfd (proc); | |
428 | 280 |
853 | 281 if (*errfd >= 0) |
282 { | |
283 FD_SET (*errfd, &input_wait_mask); | |
284 FD_SET (*errfd, &non_fake_input_wait_mask); | |
285 FD_SET (*errfd, &process_only_mask); | |
286 } | |
287 } | |
288 } | |
289 | |
290 void | |
291 event_stream_unixoid_unselect_process (Lisp_Process *proc, int doin, int doerr, | |
292 int *infd, int *errfd) | |
293 { | |
294 if (doin) | |
295 { | |
296 *infd = get_process_infd (proc); | |
297 FD_CLR (*infd, &input_wait_mask); | |
298 FD_CLR (*infd, &non_fake_input_wait_mask); | |
299 FD_CLR (*infd, &process_only_mask); | |
300 } | |
301 | |
302 if (doerr) | |
303 { | |
304 *errfd = get_process_errfd (proc); | |
305 | |
306 if (*errfd >= 0) | |
307 { | |
308 FD_CLR (*errfd, &input_wait_mask); | |
309 FD_CLR (*errfd, &non_fake_input_wait_mask); | |
310 FD_CLR (*errfd, &process_only_mask); | |
311 } | |
312 } | |
428 | 313 } |
314 | |
315 int | |
316 poll_fds_for_input (SELECT_TYPE mask) | |
317 { | |
318 EMACS_TIME sometime; | |
319 EMACS_SELECT_TIME select_time; | |
320 SELECT_TYPE temp_mask; | |
321 int retval; | |
322 | |
323 while (1) | |
324 { | |
325 EMACS_SET_SECS_USECS (sometime, 0, 0); | |
326 EMACS_TIME_TO_SELECT_TIME (sometime, select_time); | |
327 temp_mask = mask; | |
328 /* To effect a poll, tell select() to block for zero seconds. */ | |
329 retval = select (MAXDESC, &temp_mask, 0, 0, &select_time); | |
330 if (retval >= 0) | |
331 return retval; | |
332 if (errno != EINTR) | |
333 { | |
334 /* Something went seriously wrong; don't abort since maybe | |
335 the TTY just died at the wrong time. */ | |
442 | 336 stderr_out ("xemacs: select failed: errno = %d\n", errno); |
428 | 337 return 0; |
338 } | |
339 /* else, we got interrupted by a signal, so try again. */ | |
340 } | |
341 | |
1204 | 342 RETURN_NOT_REACHED (0); |
428 | 343 } |
344 | |
345 /****************************************************************************/ | |
346 /* Unixoid (file descriptors based) process I/O streams routines */ | |
347 /****************************************************************************/ | |
348 | |
853 | 349 void |
350 event_stream_unixoid_create_io_streams (void* inhandle, void* outhandle, | |
351 void *errhandle, Lisp_Object* instream, | |
352 Lisp_Object* outstream, | |
353 Lisp_Object* errstream, | |
354 USID* in_usid, | |
355 USID* err_usid, | |
356 int flags) | |
428 | 357 { |
853 | 358 int infd, outfd, errfd; |
428 | 359 /* Decode inhandle and outhandle. Their meaning depends on |
360 the process implementation being used. */ | |
4031 | 361 /* We are passed plain old file descs, which are ints, so */ |
362 /* if sizeof(EMACS_INT) > sizeof(int) it's OK. */ | |
363 infd = (EMACS_INT) inhandle; | |
364 outfd = (EMACS_INT) outhandle; | |
365 errfd = (EMACS_INT) errhandle; | |
428 | 366 |
367 *instream = (infd >= 0 | |
368 ? make_filedesc_input_stream (infd, 0, -1, 0) | |
369 : Qnil); | |
370 | |
371 *outstream = (outfd >= 0 | |
372 ? make_filedesc_output_stream (outfd, 0, -1, LSTR_BLOCKED_OK) | |
373 : Qnil); | |
374 | |
853 | 375 *errstream = (errfd >= 0 |
376 ? make_filedesc_input_stream (errfd, 0, -1, 0) | |
377 : Qnil); | |
378 | |
428 | 379 /* FLAGS is process->pty_flag for UNIX_PROCESSES */ |
380 if ((flags & STREAM_PTY_FLUSHING) && outfd >= 0) | |
381 { | |
867 | 382 Ibyte eof_char = get_eof_char (outfd); |
428 | 383 int pty_max_bytes = get_pty_max_bytes (outfd); |
853 | 384 filedesc_stream_set_pty_flushing (XLSTREAM (*outstream), pty_max_bytes, |
385 eof_char); | |
428 | 386 } |
387 | |
853 | 388 *in_usid = FD_TO_USID (infd); |
389 *err_usid = FD_TO_USID (errfd); | |
428 | 390 } |
391 | |
853 | 392 void |
393 event_stream_unixoid_delete_io_streams (Lisp_Object instream, | |
394 Lisp_Object outstream, | |
395 Lisp_Object errstream, | |
396 USID *in_usid, | |
397 USID *err_usid) | |
428 | 398 { |
853 | 399 int in = (NILP (instream) ? -1 |
428 | 400 : filedesc_stream_fd (XLSTREAM (instream))); |
853 | 401 int out = (NILP (outstream) ? -1 |
428 | 402 : filedesc_stream_fd (XLSTREAM (outstream))); |
853 | 403 int err = (NILP (errstream) ? -1 |
404 : filedesc_stream_fd (XLSTREAM (errstream))); | |
428 | 405 |
406 if (in >= 0) | |
771 | 407 retry_close (in); |
428 | 408 if (out != in && out >= 0) |
771 | 409 retry_close (out); |
853 | 410 if (err != in && err != out && err >= 0) |
411 retry_close (err); | |
428 | 412 |
853 | 413 *in_usid = FD_TO_USID (in); |
414 *err_usid = FD_TO_USID (err); | |
428 | 415 } |
416 | |
417 | |
418 void | |
419 init_event_unixoid (void) | |
420 { | |
421 /* Do this first; the init_event_*_late() functions | |
422 pay attention to it. */ | |
423 if (pipe (signal_event_pipe) < 0) | |
424 { | |
425 perror ("XEmacs: can't open pipe"); | |
426 exit (-1); | |
427 } | |
428 signal_event_pipe_initialized = 1; | |
429 | |
430 /* Set it non-blocking so we can drain its output. */ | |
431 set_descriptor_non_blocking (signal_event_pipe[0]); | |
432 | |
433 /* Also set the write descriptor non-blocking so we don't | |
434 hang in case a long time passes between times when | |
435 we drain the pipe. */ | |
436 set_descriptor_non_blocking (signal_event_pipe[1]); | |
437 | |
438 /* WARNING: In order for the signal-event pipe to work correctly | |
439 and not cause lockups, the following need to be followed: | |
440 | |
441 1) event_pending_p() must ignore input on the signal-event pipe. | |
442 2) As soon as next_event() notices input on the signal-event | |
443 pipe, it must drain it. */ | |
444 FD_ZERO (&input_wait_mask); | |
445 FD_ZERO (&non_fake_input_wait_mask); | |
446 FD_ZERO (&process_only_mask); | |
447 FD_ZERO (&tty_only_mask); | |
448 | |
449 FD_SET (signal_event_pipe[0], &input_wait_mask); | |
450 } |