diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/ChangeLog | 224 | ||||
| -rw-r--r-- | src/alloc.c | 126 | ||||
| -rw-r--r-- | src/buffer.c | 8 | ||||
| -rw-r--r-- | src/buffer.h | 2 | ||||
| -rw-r--r-- | src/callint.c | 8 | ||||
| -rw-r--r-- | src/casefiddle.c | 2 | ||||
| -rw-r--r-- | src/cmds.c | 8 | ||||
| -rw-r--r-- | src/coding.c | 9 | ||||
| -rw-r--r-- | src/data.c | 64 | ||||
| -rw-r--r-- | src/dispnew.c | 12 | ||||
| -rw-r--r-- | src/doc.c | 4 | ||||
| -rw-r--r-- | src/editfns.c | 4 | ||||
| -rw-r--r-- | src/eval.c | 126 | ||||
| -rw-r--r-- | src/fileio.c | 48 | ||||
| -rw-r--r-- | src/floatfns.c | 30 | ||||
| -rw-r--r-- | src/fns.c | 37 | ||||
| -rw-r--r-- | src/frame.c | 6 | ||||
| -rw-r--r-- | src/keyboard.c | 128 | ||||
| -rw-r--r-- | src/keyboard.h | 5 | ||||
| -rw-r--r-- | src/keymap.c | 16 | ||||
| -rw-r--r-- | src/lisp.h | 19 | ||||
| -rw-r--r-- | src/lread.c | 151 | ||||
| -rw-r--r-- | src/macselect.c | 8 | ||||
| -rw-r--r-- | src/macterm.c | 218 | ||||
| -rw-r--r-- | src/msdos.c | 6 | ||||
| -rw-r--r-- | src/print.c | 4 | ||||
| -rw-r--r-- | src/puresize.h | 2 | ||||
| -rw-r--r-- | src/search.c | 18 | ||||
| -rw-r--r-- | src/sound.c | 10 | ||||
| -rw-r--r-- | src/syntax.c | 23 | ||||
| -rw-r--r-- | src/textprop.c | 7 | ||||
| -rw-r--r-- | src/unexsol.c | 2 | ||||
| -rw-r--r-- | src/w32.c | 61 | ||||
| -rw-r--r-- | src/w32.h | 4 | ||||
| -rw-r--r-- | src/w32fns.c | 10 | ||||
| -rw-r--r-- | src/w32proc.c | 7 | ||||
| -rw-r--r-- | src/w32term.c | 44 | ||||
| -rw-r--r-- | src/window.c | 10 | ||||
| -rw-r--r-- | src/xdisp.c | 27 | ||||
| -rw-r--r-- | src/xfaces.c | 14 | ||||
| -rw-r--r-- | src/xfns.c | 4 | ||||
| -rw-r--r-- | src/xselect.c | 82 | ||||
| -rw-r--r-- | src/xterm.c | 4 |
43 files changed, 1058 insertions, 544 deletions
diff --git a/src/ChangeLog b/src/ChangeLog index 8437853d887..79271fe23fa 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,227 @@ +2006-07-26 Chong Yidong <cyd@stupidchicken.com> + + * keyboard.c (read_char): New arg END_TIME specifying timeout. + All callers changed. Turn off echoing if END_TIME is non-NULL. + (kbd_buffer_get_event): New arg END_TIME. + + * lread.c (read_filtered_event): New arg SECONDS to wait until. + (Fread_char, Fread_event, Fread_char_exclusive): New arg SECONDS. + + * lisp.h: Update read-char, read-event, and read_filtered_event + prototypes. + + * keyboard.h: Include systime.h. Update read_char prototype. + +2006-07-25 YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp> + + * alloc.c (find_string_data_in_pure): New function. + (make_pure_string): Use it to reuse existing string data if possible. + + * puresize.h (BASE_PURESIZE): Decrease to 1102000. + +2006-07-22 Stefan Monnier <monnier@iro.umontreal.ca> + + * keymap.c (Fdefine_key): If the key binding definition looks like an + XEmacs-style key sequence, convert it to Emacs's format. + +2006-07-22 Ralf Angeli <angeli@caeruleus.net> + + * w32fns.c (w32_createwindow): If `left' and/or `top' frame + parameters are bound to some values, use that instead of + CW_USEDEFAULT. + +2006-07-21 Eli Zaretskii <eliz@gnu.org> + + * w32.c (convert_time): Use explicit long double constants to + ensure long double arithmetics is used throughout. + +2006-07-20 YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp> + + * alloc.c (pure_bytes_used_lisp, pure_bytes_used_non_lisp): New vars. + (init_alloc_once): Initialize them. + (pure_alloc): Allocate non-Lisp objects from the end of pure storage + without alignment. + + * puresize.h (BASE_PURESIZE): Decrease to 1141000. + +2006-07-18 Francis Litterio <franl@world.std.com> + + * w32term.c (x_calc_absolute_position): Fix frame positioning + with negative X/Y coordinates. + +2006-07-18 Dan Nicolaescu <dann@ics.uci.edu> + + * xterm.c (x_connection_closed, x_error_quitter): Mark as NO_RETURN. + + * textprop.c (text_read_only): Likewise. + + * lread.c (end_of_file_error): Likewise. + + * lisp.h (circular_list_error, memory_full, buffer_memory_full): + Likewise. + + * eval.c (unwind_to_catch): Likewise. + + * buffer.h (buffer_slot_type_mismatch): Likewise. + +2006-07-18 Kim F. Storm <storm@cua.dk> + + Cleanup Fsignal calls that never returns; now only use it for Qquit. + + * eval.c (xsignal): New func. Like Fsignal, but marked no-return. + (xsignal0, xsignal1, xsignal2, xsignal3): New no-return functions. + (signal_error): New no-return function (from xfaces.c). + (Fthrow): Use xsignal2 instead of Fsignal + abort. + (error): Use xsignal1 instead of Fsignal + abort. + (FletX, Flet, grow_specpdl): Use signal_error. + (Feval, Ffuncall, funcall_lambda): Use xsignal1, xsignal2. + + * alloc.c (buffer_memory_full, memory_full): Use xsignal. Remove loop. + (list1): New function. + + * lisp.h (list1): Add EXFUN. + (xsignal, xsignal0, xsignal1, xsignal2, xsignal3, signal_error): + Add prototypes. Mark them as no-return. + + * buffer.c (Fbuffer_local_value, Fbarf_if_buffer_read_only): + Use xsignal1. + + * callint.c (check_mark): Use xsignal0. + + * casefiddle.c (casify_object): wrong_type_argument is no-return. + + * cmds.c (Fforward_char, Fdelete_char): Use xsignal0. + + * coding.c (Fcheck_coding_system): Use xsignal1. Remove loop. + (Fdefine_coding_system_internal): Use xsignal1. + + * data.c (circular_list_error): Use xsignal. + (wrong_type_argument): Use xsignal2. Don't care about return value. + (args_out_of_range, args_out_of_range_3): Use xsignal2, xsignal3. + Remove loop around Fsignal. + (indirect_variable, Fsymbol_value, set_internal, Fdefault_value) + (indirect_function, Findirect_function, Fstring_to_number) + (Fmakunbound, Ffmakunbound, Fsymbol_function, Ffset): Use xsignal1. + (arith_driver, float_arith_driver, Frem, Fmod, arith_error): + Use xsignal0. + + * doc.c (Fdocumentation): Use xsignal1. + + * editfns.c (region_limit, Fget_internal_run_time): Use xsignal0. + + * fileio.c (report_file_error): Use xsignal. + (barf_or_query_if_file_exists, Fcopy_file, Fdelete_file) + (Finsert_file_contents): Use xsignal2. + (syms_of_fileio): Use list2, list3. + + * floatfns.c (arith_error, range_error, domain_error): Use xsignal2. + (range_error2, domain_error2): Use xsignal3. + (rounding_driver, fmod_float): Use xsignal0. + (float_error): Use xsignal1. + (matherr): Use xsignal. + + * fns.c (Flength): wrong_type_argument is no-return. + (hashfn_user_defined, Fmake_hash_table): Use signal_error. + (Fmd5): Use xsignal1. + + * frame.c (x_set_line_spacing, x_set_screen_gamma): Use signal_error. + + * keyboard.c (recursive_edit_1): Use xsignal1. + + * keymap.c (Fmap_keymap): Use xsignal1. + + * lread.c (Fload): Use xsignal2, signal_error. + (end_of_file_error): Use xsignal0, xsignal1. + (read0): Use xsignal1. + (invalid_syntax): New error function marked no-return. + (read_integer, read1, read_list): Use it. + + * macselect.c (x_get_local_selection): Use signal_error. + + * msdos.c (Fmsdos_set_mouse_buttons): Use xsignal2. + + * search.c (compile_pattern_1): Use xsignal1. + (signal_failure): Remove (was only called once). + (search_command): Use xsignal1 instead of signal_failure. + + * syntax.c (scan_lists): Use xsignal3. + + * textprop.c (text_read_only): Use xsignal0, xsignal1. + + * unexsol.c (unexec): Use xsignal. + + * window.c (window_scroll_pixel_based, window_scroll_line_based): + Use xsignal0. + + * xfaces.c (signal_error): Move to eval.c. + (resolve_face_name): Use xsignal1. + + * xfns.c (x_decode_color): Use signal_error. + + * xselect.c (x_get_local_selection, copy_multiple_data) + (x_get_window_property_as_lisp_data) + (lisp_data_to_selection_data, CHECK_CUT_BUFFER) + (Fx_get_cut_buffer_internal): Use signal_error. + +2006-07-18 YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp> + + * macterm.c (XTread_socket): Undo previous change. + +2006-07-18 YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp> + + * macterm.c (keycode_to_xkeysym): Remove function. All uses now + directly lookup keycode_to_xkeysym_table. + [USE_MAC_TSM] (mac_handle_text_input_event): Don't construct + ASCII_KEYSTROKE_EVENT for non-zero keycode_to_xkeysym_table entries. + (XTread_socket): Use character codes to construct keypad key events. + (mac_initialize_display_info) [MAC_OSX]: Use CGDisplaySamplesPerPixel. + (x_delete_display): Apply 2006-07-04 change for xterm.c. + +2006-07-17 Kim F. Storm <storm@cua.dk> + + * xdisp.c (handle_single_display_spec): Ensure the right value of + it->position is saved by push_it. + (pop_it): Restore it->object for GET_FROM_BUFFER and GET_FROM_STRING. + (reseat_1): Don't setup it->object twice. + (set_iterator_to_next): No need to set it->object after pop_it. + (move_it_to): Explicitly check to see if last move reached to_charpos. + +2006-07-17 Thien-Thi Nguyen <ttn@gnu.org> + + * xdisp.c (display_mode_line): Preserve match data. + +2006-07-14 Kim F. Storm <storm@cua.dk> + + * w32.c (pfn_WSACreateEvent, pfn_WSACloseEvent): New func ptrs. + (init_winsock): Load them. Use ws2_32.dll. + (sys_listen): Undo last change. Just set FILE_LISTEN flag. + (sys_accept): Undo last change. Instead, set child status to + STATUS_READ_ACKNOWLEDGED and reset char_avail event so next + sys_select will wakeup the reader thread. + (_sys_wait_accept): New function used by reader thread to wait for + an incoming connection on a server socket. + + * w32.h (_sys_read_ahead, _sys_wait_accept): Add prototypes. + + * w32proc.c (reader_thread): Use _sys_wait_accept to wait on a + server socket (FILE_LISTEN flag). + +2006-07-14 Jan Dj,Ad(Brv <jan.h.d@swipnet.se> + + * sound.c (alsa_init): Call snd_pcm_close after successful snd_pcm_open. + +2006-07-14 Kim F. Storm <storm@cua.dk> + + * w32.c: Fix high cpu load for server sockets. + (pfn_WSAEventSelect): New function ptr. + (init_winsock): Load it. + (sys_listen): Set FILE_LISTEN flag. Set event mask for socket's + char_avail event object to FD_ACCEPT. + (sys_accept): Check FILE_LISTEN flag. Set event mask on new + socket's char_avail event object to FD_READ|FD_CLOSE. + + * w32.h (FILE_LISTEN): New filedesc flag value. + 2006-07-13 Kim F. Storm <storm@cua.dk> * bytecode.c (Fbyte_code): Use CAR, CDR for Bcar, Bcdr. diff --git a/src/alloc.c b/src/alloc.c index 8088540bb6b..e3609292749 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -289,10 +289,18 @@ static size_t pure_bytes_used_before_overflow; && ((PNTR_COMPARISON_TYPE) (P) \ >= (PNTR_COMPARISON_TYPE) purebeg)) -/* Index in pure at which next pure object will be allocated.. */ +/* Total number of bytes allocated in pure storage. */ EMACS_INT pure_bytes_used; +/* Index in pure at which next pure Lisp object will be allocated.. */ + +static EMACS_INT pure_bytes_used_lisp; + +/* Number of bytes allocated for non-Lisp objects in pure storage. */ + +static EMACS_INT pure_bytes_used_non_lisp; + /* If nonzero, this is a warning delivered by malloc and not yet displayed. */ @@ -561,8 +569,7 @@ buffer_memory_full () /* This used to call error, but if we've run out of memory, we could get infinite recursion trying to build the string. */ - while (1) - Fsignal (Qnil, Vmemory_signal_data); + xsignal (Qnil, Vmemory_signal_data); } @@ -2779,7 +2786,14 @@ check_cons_list () #endif } -/* Make a list of 2, 3, 4 or 5 specified objects. */ +/* Make a list of 1, 2, 3, 4 or 5 specified objects. */ + +Lisp_Object +list1 (arg1) + Lisp_Object arg1; +{ + return Fcons (arg1, Qnil); +} Lisp_Object list2 (arg1, arg2) @@ -3495,8 +3509,7 @@ memory_full () /* This used to call error, but if we've run out of memory, we could get infinite recursion trying to build the string. */ - while (1) - Fsignal (Qnil, Vmemory_signal_data); + xsignal (Qnil, Vmemory_signal_data); } /* If we released our reserve (due to running out of memory), @@ -4689,10 +4702,7 @@ valid_lisp_object_p (obj) /* Allocate room for SIZE bytes from pure Lisp storage and return a pointer to it. TYPE is the Lisp type for which the memory is - allocated. TYPE < 0 means it's not used for a Lisp object. - - If store_pure_type_info is set and TYPE is >= 0, the type of - the allocated object is recorded in pure_types. */ + allocated. TYPE < 0 means it's not used for a Lisp object. */ static POINTER_TYPE * pure_alloc (size, type) @@ -4717,8 +4727,21 @@ pure_alloc (size, type) #endif again: - result = ALIGN (purebeg + pure_bytes_used, alignment); - pure_bytes_used = ((char *)result - (char *)purebeg) + size; + if (type >= 0) + { + /* Allocate space for a Lisp object from the beginning of the free + space with taking account of alignment. */ + result = ALIGN (purebeg + pure_bytes_used_lisp, alignment); + pure_bytes_used_lisp = ((char *)result - (char *)purebeg) + size; + } + else + { + /* Allocate space for a non-Lisp object from the end of the free + space. */ + pure_bytes_used_non_lisp += size; + result = purebeg + pure_size - pure_bytes_used_non_lisp; + } + pure_bytes_used = pure_bytes_used_lisp + pure_bytes_used_non_lisp; if (pure_bytes_used <= pure_size) return result; @@ -4730,6 +4753,7 @@ pure_alloc (size, type) pure_size = 10000; pure_bytes_used_before_overflow += pure_bytes_used - size; pure_bytes_used = 0; + pure_bytes_used_lisp = pure_bytes_used_non_lisp = 0; goto again; } @@ -4745,6 +4769,73 @@ check_pure_size () } +/* Find the byte sequence {DATA[0], ..., DATA[NBYTES-1], '\0'} from + the non-Lisp data pool of the pure storage, and return its start + address. Return NULL if not found. */ + +static char * +find_string_data_in_pure (data, nbytes) + char *data; + int nbytes; +{ + int i, skip, bm_skip[256], last_char_skip, infinity, start, start_max; + unsigned char *p; + char *non_lisp_beg; + + if (pure_bytes_used_non_lisp < nbytes + 1) + return NULL; + + /* Set up the Boyer-Moore table. */ + skip = nbytes + 1; + for (i = 0; i < 256; i++) + bm_skip[i] = skip; + + p = (unsigned char *) data; + while (--skip > 0) + bm_skip[*p++] = skip; + + last_char_skip = bm_skip['\0']; + + non_lisp_beg = purebeg + pure_size - pure_bytes_used_non_lisp; + start_max = pure_bytes_used_non_lisp - (nbytes + 1); + + /* See the comments in the function `boyer_moore' (search.c) for the + use of `infinity'. */ + infinity = pure_bytes_used_non_lisp + 1; + bm_skip['\0'] = infinity; + + p = (unsigned char *) non_lisp_beg + nbytes; + start = 0; + do + { + /* Check the last character (== '\0'). */ + do + { + start += bm_skip[*(p + start)]; + } + while (start <= start_max); + + if (start < infinity) + /* Couldn't find the last character. */ + return NULL; + + /* No less than `infinity' means we could find the last + character at `p[start - infinity]'. */ + start -= infinity; + + /* Check the remaining characters. */ + if (memcmp (data, non_lisp_beg + start, nbytes) == 0) + /* Found. */ + return non_lisp_beg + start; + + start += last_char_skip; + } + while (start <= start_max); + + return NULL; +} + + /* Return a string allocated in pure space. DATA is a buffer holding NCHARS characters, and NBYTES bytes of string data. MULTIBYTE non-zero means make the result string multibyte. @@ -4763,11 +4854,15 @@ make_pure_string (data, nchars, nbytes, multibyte) struct Lisp_String *s; s = (struct Lisp_String *) pure_alloc (sizeof *s, Lisp_String); - s->data = (unsigned char *) pure_alloc (nbytes + 1, -1); + s->data = find_string_data_in_pure (data, nbytes); + if (s->data == NULL) + { + s->data = (unsigned char *) pure_alloc (nbytes + 1, -1); + bcopy (data, s->data, nbytes); + s->data[nbytes] = '\0'; + } s->size = nchars; s->size_byte = multibyte ? nbytes : -1; - bcopy (data, s->data, nbytes); - s->data[nbytes] = '\0'; s->intervals = NULL_INTERVAL; XSETSTRING (string, s); return string; @@ -6225,6 +6320,7 @@ init_alloc_once () purebeg = PUREBEG; pure_size = PURESIZE; pure_bytes_used = 0; + pure_bytes_used_lisp = pure_bytes_used_non_lisp = 0; pure_bytes_used_before_overflow = 0; /* Initialize the list of free aligned blocks. */ diff --git a/src/buffer.c b/src/buffer.c index 73db9d21419..dc6bcd8f6d3 100644 --- a/src/buffer.c +++ b/src/buffer.c @@ -951,10 +951,10 @@ is the default binding of the variable. */) result = XCDR (result); } - if (EQ (result, Qunbound)) - return Fsignal (Qvoid_variable, Fcons (variable, Qnil)); + if (!EQ (result, Qunbound)) + return result; - return result; + xsignal1 (Qvoid_variable, variable); } /* Return an alist of the Lisp-level buffer-local bindings of @@ -1991,7 +1991,7 @@ DEFUN ("barf-if-buffer-read-only", Fbarf_if_buffer_read_only, { if (!NILP (current_buffer->read_only) && NILP (Vinhibit_read_only)) - Fsignal (Qbuffer_read_only, (Fcons (Fcurrent_buffer (), Qnil))); + xsignal1 (Qbuffer_read_only, Fcurrent_buffer ()); return Qnil; } diff --git a/src/buffer.h b/src/buffer.h index 60aa3e7aaed..efe0252453a 100644 --- a/src/buffer.h +++ b/src/buffer.h @@ -833,7 +833,7 @@ extern void set_buffer_internal P_ ((struct buffer *)); extern void set_buffer_internal_1 P_ ((struct buffer *)); extern void set_buffer_temp P_ ((struct buffer *)); extern void record_buffer P_ ((Lisp_Object)); -extern void buffer_slot_type_mismatch P_ ((int)); +extern void buffer_slot_type_mismatch P_ ((int)) NO_RETURN; extern void fix_overlays_before P_ ((struct buffer *, EMACS_INT, EMACS_INT)); extern void mmap_set_vars P_ ((int)); diff --git a/src/callint.c b/src/callint.c index afb576cf5f6..e48168db164 100644 --- a/src/callint.c +++ b/src/callint.c @@ -174,7 +174,7 @@ check_mark (for_region) : "The mark is not set now"); if (!NILP (Vtransient_mark_mode) && NILP (Vmark_even_if_inactive) && NILP (current_buffer->mark_active)) - Fsignal (Qmark_inactive, Qnil); + xsignal0 (Qmark_inactive); } /* If the list of args INPUT was produced with an explicit call to @@ -563,7 +563,7 @@ If KEYS is omitted or nil, the return value of `this-command-keys' is used. */) break; case 'c': /* Character */ - args[i] = Fread_char (build_string (callint_message), Qnil); + args[i] = Fread_char (build_string (callint_message), Qnil, Qnil); message1_nolog ((char *) 0); /* Passing args[i] directly stimulates compiler bug */ teml = args[i]; @@ -635,7 +635,7 @@ If KEYS is omitted or nil, the return value of `this-command-keys' is used. */) /* Ignore first element, which is the base key. */ tem2 = Fmemq (intern ("down"), Fcdr (teml)); if (! NILP (tem2)) - up_event = Fread_event (Qnil, Qnil); + up_event = Fread_event (Qnil, Qnil, Qnil); } } break; @@ -663,7 +663,7 @@ If KEYS is omitted or nil, the return value of `this-command-keys' is used. */) /* Ignore first element, which is the base key. */ tem2 = Fmemq (intern ("down"), Fcdr (teml)); if (! NILP (tem2)) - up_event = Fread_event (Qnil, Qnil); + up_event = Fread_event (Qnil, Qnil, Qnil); } } break; diff --git a/src/casefiddle.c b/src/casefiddle.c index 76a24f48a82..0ad884310ed 100644 --- a/src/casefiddle.c +++ b/src/casefiddle.c @@ -111,7 +111,7 @@ casify_object (flag, obj) return obj; } - return wrong_type_argument (Qchar_or_string_p, obj); + wrong_type_argument (Qchar_or_string_p, obj); } DEFUN ("upcase", Fupcase, Supcase, 1, 1, 0, diff --git a/src/cmds.c b/src/cmds.c index 494ef14db99..b84b9d1d85e 100644 --- a/src/cmds.c +++ b/src/cmds.c @@ -77,12 +77,12 @@ On reaching end of buffer, stop and signal error. */) if (new_point < BEGV) { SET_PT (BEGV); - Fsignal (Qbeginning_of_buffer, Qnil); + xsignal0 (Qbeginning_of_buffer); } if (new_point > ZV) { SET_PT (ZV); - Fsignal (Qend_of_buffer, Qnil); + xsignal0 (Qend_of_buffer); } SET_PT (new_point); @@ -245,14 +245,14 @@ N was explicitly specified. */) if (XINT (n) < 0) { if (pos < BEGV) - Fsignal (Qbeginning_of_buffer, Qnil); + xsignal0 (Qbeginning_of_buffer); else del_range (pos, PT); } else { if (pos > ZV) - Fsignal (Qend_of_buffer, Qnil); + xsignal0 (Qend_of_buffer); else del_range (PT, pos); } diff --git a/src/coding.c b/src/coding.c index e35cb5ddc09..5b067b9dd2f 100644 --- a/src/coding.c +++ b/src/coding.c @@ -6068,7 +6068,7 @@ set_conversion_work_buffer (multibyte) /* As we are already in the work buffer, we must generate a new buffer for the work. */ Lisp_Object name; - + name = Fgenerate_new_buffer_name (Vcode_conversion_workbuf_name, Qnil); buffer = buffer_to_kill = Fget_buffer_create (name); buf = XBUFFER (buffer); @@ -6591,8 +6591,7 @@ The value of this property should be a vector of length 5. */) } if (!NILP (Fcoding_system_p (coding_system))) return coding_system; - while (1) - Fsignal (Qcoding_system_error, Fcons (coding_system, Qnil)); + xsignal1 (Qcoding_system_error, coding_system); } Lisp_Object @@ -7631,11 +7630,13 @@ This function is internal use only. */) Lisp_Object safe_chars, slot; if (NILP (Fcheck_coding_system (coding_system))) - Fsignal (Qcoding_system_error, Fcons (coding_system, Qnil)); + xsignal1 (Qcoding_system_error, coding_system); + safe_chars = coding_safe_chars (coding_system); if (! EQ (safe_chars, Qt) && ! CHAR_TABLE_P (safe_chars)) error ("No valid safe-chars property for %s", SDATA (SYMBOL_NAME (coding_system))); + if (EQ (safe_chars, Qt)) { if (NILP (Fmemq (coding_system, XCAR (Vcoding_system_safe_chars)))) diff --git a/src/data.c b/src/data.c index 8cca837028d..cc15431cd16 100644 --- a/src/data.c +++ b/src/data.c @@ -106,7 +106,7 @@ void circular_list_error (list) Lisp_Object list; { - Fsignal (Qcircular_list, list); + xsignal (Qcircular_list, list); } @@ -119,16 +119,7 @@ wrong_type_argument (predicate, value) if ((unsigned int) XGCTYPE (value) >= Lisp_Type_Limit) abort (); - Fsignal (Qwrong_type_argument, list2 (predicate, value)); - - /* This function is marked as NO_RETURN, gcc would warn if it has a - return statement or if falls off the function. Other compilers - warn if no return statement is present. */ -#ifndef __GNUC__ - return value; -#else - abort (); -#endif + xsignal2 (Qwrong_type_argument, predicate, value); } void @@ -141,16 +132,14 @@ void args_out_of_range (a1, a2) Lisp_Object a1, a2; { - while (1) - Fsignal (Qargs_out_of_range, Fcons (a1, Fcons (a2, Qnil))); + xsignal2 (Qargs_out_of_range, a1, a2); } void args_out_of_range_3 (a1, a2, a3) Lisp_Object a1, a2, a3; { - while (1) - Fsignal (Qargs_out_of_range, Fcons (a1, Fcons (a2, Fcons (a3, Qnil)))); + xsignal3 (Qargs_out_of_range, a1, a2, a3); } /* On some machines, XINT needs a temporary location. @@ -619,7 +608,7 @@ Return SYMBOL. */) { CHECK_SYMBOL (symbol); if (XSYMBOL (symbol)->constant) - return Fsignal (Qsetting_constant, Fcons (symbol, Qnil)); + xsignal1 (Qsetting_constant, symbol); Fset (symbol, Qunbound); return symbol; } @@ -632,7 +621,7 @@ Return SYMBOL. */) { CHECK_SYMBOL (symbol); if (NILP (symbol) || EQ (symbol, Qt)) - return Fsignal (Qsetting_constant, Fcons (symbol, Qnil)); + xsignal1 (Qsetting_constant, symbol); XSYMBOL (symbol)->function = Qunbound; return symbol; } @@ -643,9 +632,9 @@ DEFUN ("symbol-function", Fsymbol_function, Ssymbol_function, 1, 1, 0, register Lisp_Object symbol; { CHECK_SYMBOL (symbol); - if (EQ (XSYMBOL (symbol)->function, Qunbound)) - return Fsignal (Qvoid_function, Fcons (symbol, Qnil)); - return XSYMBOL (symbol)->function; + if (!EQ (XSYMBOL (symbol)->function, Qunbound)) + return XSYMBOL (symbol)->function; + xsignal1 (Qvoid_function, symbol); } DEFUN ("symbol-plist", Fsymbol_plist, Ssymbol_plist, 1, 1, 0, @@ -676,7 +665,7 @@ DEFUN ("fset", Ffset, Sfset, 2, 2, 0, { CHECK_SYMBOL (symbol); if (NILP (symbol) || EQ (symbol, Qt)) - return Fsignal (Qsetting_constant, Fcons (symbol, Qnil)); + xsignal1 (Qsetting_constant, symbol); if (!NILP (Vautoload_queue) && !EQ (XSYMBOL (symbol)->function, Qunbound)) Vautoload_queue = Fcons (Fcons (symbol, XSYMBOL (symbol)->function), Vautoload_queue); @@ -818,7 +807,7 @@ indirect_variable (symbol) tortoise = XSYMBOL (tortoise)->value; if (EQ (hare, tortoise)) - Fsignal (Qcyclic_variable_indirection, Fcons (symbol, Qnil)); + xsignal1 (Qcyclic_variable_indirection, symbol); } return hare; @@ -1130,10 +1119,10 @@ DEFUN ("symbol-value", Fsymbol_value, Ssymbol_value, 1, 1, 0, Lisp_Object val; val = find_symbol_value (symbol); - if (EQ (val, Qunbound)) - return Fsignal (Qvoid_variable, Fcons (symbol, Qnil)); - else + if (!EQ (val, Qunbound)) return val; + + xsignal1 (Qvoid_variable, symbol); } DEFUN ("set", Fset, Sset, 2, 2, 0, @@ -1197,7 +1186,7 @@ set_internal (symbol, newval, buf, bindflag) if (SYMBOL_CONSTANT_P (symbol) && (NILP (Fkeywordp (symbol)) || !EQ (newval, SYMBOL_VALUE (symbol)))) - return Fsignal (Qsetting_constant, Fcons (symbol, Qnil)); + xsignal1 (Qsetting_constant, symbol); innercontents = valcontents = SYMBOL_VALUE (symbol); @@ -1391,9 +1380,10 @@ local bindings in certain buffers. */) register Lisp_Object value; value = default_value (symbol); - if (EQ (value, Qunbound)) - return Fsignal (Qvoid_variable, Fcons (symbol, Qnil)); - return value; + if (!EQ (value, Qunbound)) + return value; + + xsignal1 (Qvoid_variable, symbol); } DEFUN ("set-default", Fset_default, Sset_default, 2, 2, 0, @@ -1950,7 +1940,7 @@ indirect_function (object) tortoise = XSYMBOL (tortoise)->function; if (EQ (hare, tortoise)) - Fsignal (Qcyclic_function_indirection, Fcons (object, Qnil)); + xsignal1 (Qcyclic_function_indirection, object); } return hare; @@ -1979,7 +1969,7 @@ function chain of symbols. */) return result; if (NILP (noerror)) - Fsignal (Qvoid_function, Fcons (object, Qnil)); + xsignal1 (Qvoid_function, object); return Qnil; } @@ -2519,7 +2509,7 @@ If the base used is not 10, floating point is not recognized. */) CHECK_NUMBER (base); b = XINT (base); if (b < 2 || b > 16) - Fsignal (Qargs_out_of_range, Fcons (base, Qnil)); + xsignal1 (Qargs_out_of_range, base); } /* Skip any whitespace at the front of the number. Some versions of @@ -2631,7 +2621,7 @@ arith_driver (code, nargs, args) else { if (next == 0) - Fsignal (Qarith_error, Qnil); + xsignal0 (Qarith_error); accum /= next; } break; @@ -2704,7 +2694,7 @@ float_arith_driver (accum, argnum, code, nargs, args) else { if (! IEEE_FLOATING_POINT && next == 0) - Fsignal (Qarith_error, Qnil); + xsignal0 (Qarith_error); accum /= next; } break; @@ -2786,7 +2776,7 @@ Both must be integers or markers. */) CHECK_NUMBER_COERCE_MARKER (y); if (XFASTINT (y) == 0) - Fsignal (Qarith_error, Qnil); + xsignal0 (Qarith_error); XSETINT (val, XINT (x) % XINT (y)); return val; @@ -2835,7 +2825,7 @@ Both X and Y must be numbers or markers. */) i2 = XINT (y); if (i2 == 0) - Fsignal (Qarith_error, Qnil); + xsignal0 (Qarith_error); i1 %= i2; @@ -3443,7 +3433,7 @@ arith_error (signo) #endif /* not BSD4_1 */ SIGNAL_THREAD_CHECK (signo); - Fsignal (Qarith_error, Qnil); + xsignal0 (Qarith_error); } void diff --git a/src/dispnew.c b/src/dispnew.c index 87d99fd9917..1d977898f60 100644 --- a/src/dispnew.c +++ b/src/dispnew.c @@ -6866,9 +6866,15 @@ init_display () For types defined in VMS, use set term /device=TYPE.\n\ For types not defined in VMS, use define emacs_term \"TYPE\".\n\ \(The quotation marks are necessary since terminal types are lower case.)\n"); -#else - fprintf (stderr, "Please set the environment variable TERM; see tset(1).\n"); -#endif +#else /* not VMS */ + +#ifdef HAVE_WINDOW_SYSTEM + if (! inhibit_window_system) + fprintf (stderr, "Please set the environment variable DISPLAY or TERM (see `tset').\n"); + else +#endif /* HAVE_WINDOW_SYSTEM */ + fprintf (stderr, "Please set the environment variable TERM; see `tset'.\n"); +#endif /* not VMS */ exit (1); } diff --git a/src/doc.c b/src/doc.c index 3dd5622d9df..93f372606a4 100644 --- a/src/doc.c +++ b/src/doc.c @@ -416,7 +416,7 @@ string is passed through `substitute-command-keys'. */) { funcar = Fcar (fun); if (!SYMBOLP (funcar)) - return Fsignal (Qinvalid_function, Fcons (fun, Qnil)); + xsignal1 (Qinvalid_function, fun); else if (EQ (funcar, Qkeymap)) return build_string ("Prefix command (definition is a keymap associating keystrokes with commands)."); else if (EQ (funcar, Qlambda) @@ -443,7 +443,7 @@ string is passed through `substitute-command-keys'. */) else { oops: - Fsignal (Qinvalid_function, Fcons (fun, Qnil)); + xsignal1 (Qinvalid_function, fun); } /* If DOC is 0, it's typically because of a dumped file missing diff --git a/src/editfns.c b/src/editfns.c index cf37c10a9d5..aea044db068 100644 --- a/src/editfns.c +++ b/src/editfns.c @@ -316,7 +316,7 @@ region_limit (beginningp) if (!NILP (Vtransient_mark_mode) && NILP (Vmark_even_if_inactive) && NILP (current_buffer->mark_active)) - Fsignal (Qmark_inactive, Qnil); + xsignal0 (Qmark_inactive); m = Fmarker_position (current_buffer->mark); if (NILP (m)) @@ -1480,7 +1480,7 @@ systems that do not provide resolution finer than a second. */) if (getrusage (RUSAGE_SELF, &usage) < 0) /* This shouldn't happen. What action is appropriate? */ - Fsignal (Qerror, Qnil); + xsignal0 (Qerror); /* Sum up user time and system time. */ secs = usage.ru_utime.tv_sec + usage.ru_stime.tv_sec; diff --git a/src/eval.c b/src/eval.c index a07ab32e76b..0d7a6a31038 100644 --- a/src/eval.c +++ b/src/eval.c @@ -198,6 +198,7 @@ Lisp_Object Vmacro_declaration_function; extern Lisp_Object Qrisky_local_variable; static Lisp_Object funcall_lambda P_ ((Lisp_Object, int, Lisp_Object*)); +static void unwind_to_catch P_ ((struct catchtag *, Lisp_Object)) NO_RETURN; void init_eval_once () @@ -983,9 +984,7 @@ usage: (let* VARLIST BODY...) */) if (SYMBOLP (elt)) specbind (elt, Qnil); else if (! NILP (Fcdr (Fcdr (elt)))) - Fsignal (Qerror, - Fcons (build_string ("`let' bindings can have only one value-form"), - elt)); + signal_error ("`let' bindings can have only one value-form", elt); else { val = Feval (Fcar (Fcdr (elt))); @@ -1032,9 +1031,7 @@ usage: (let VARLIST BODY...) */) if (SYMBOLP (elt)) temps [argnum++] = Qnil; else if (! NILP (Fcdr (Fcdr (elt)))) - Fsignal (Qerror, - Fcons (build_string ("`let' bindings can have only one value-form"), - elt)); + signal_error ("`let' bindings can have only one value-form", elt); else temps [argnum++] = Feval (Fcar (Fcdr (elt))); gcpro2.nvars = argnum; @@ -1295,8 +1292,7 @@ Both TAG and VALUE are evalled. */) if (EQ (c->tag, tag)) unwind_to_catch (c, value); } - Fsignal (Qno_catch, list2 (tag, value)); - abort (); + xsignal2 (Qno_catch, tag, value); } @@ -1704,6 +1700,78 @@ See also the function `condition-case'. */) fatal ("%s", SDATA (string), 0); } +/* Internal version of Fsignal that never returns. + Used for anything but Qquit (which can return from Fsignal). */ + +void +xsignal (error_symbol, data) + Lisp_Object error_symbol, data; +{ + Fsignal (error_symbol, data); + abort (); +} + +/* Like xsignal, but takes 0, 1, 2, or 3 args instead of a list. */ + +void +xsignal0 (error_symbol) + Lisp_Object error_symbol; +{ + xsignal (error_symbol, Qnil); +} + +void +xsignal1 (error_symbol, arg) + Lisp_Object error_symbol, arg; +{ + xsignal (error_symbol, list1 (arg)); +} + +void +xsignal2 (error_symbol, arg1, arg2) + Lisp_Object error_symbol, arg1, arg2; +{ + xsignal (error_symbol, list2 (arg1, arg2)); +} + +void +xsignal3 (error_symbol, arg1, arg2, arg3) + Lisp_Object error_symbol, arg1, arg2, arg3; +{ + xsignal (error_symbol, list3 (arg1, arg2, arg3)); +} + +/* Signal `error' with message S, and additional arg ARG. + If ARG is not a genuine list, make it a one-element list. */ + +void +signal_error (s, arg) + char *s; + Lisp_Object arg; +{ + Lisp_Object tortoise, hare; + + hare = tortoise = arg; + while (CONSP (hare)) + { + hare = XCDR (hare); + if (!CONSP (hare)) + break; + + hare = XCDR (hare); + tortoise = XCDR (tortoise); + + if (EQ (hare, tortoise)) + break; + } + + if (!NILP (hare)) + arg = Fcons (arg, Qnil); /* Make it a list. */ + + xsignal (Qerror, Fcons (build_string (s), arg)); +} + + /* Return nonzero iff LIST is a non-nil atom or a list containing one of CONDITIONS. */ @@ -1918,8 +1986,7 @@ error (m, a1, a2, a3) if (allocated) xfree (buffer); - Fsignal (Qerror, Fcons (string, Qnil)); - abort (); + xsignal1 (Qerror, string); } DEFUN ("commandp", Fcommandp, Scommandp, 1, 2, 0, @@ -2185,7 +2252,7 @@ DEFUN ("eval", Feval, Seval, 1, 1, 0, if (XINT (numargs) < XSUBR (fun)->min_args || (XSUBR (fun)->max_args >= 0 && XSUBR (fun)->max_args < XINT (numargs))) - Fsignal (Qwrong_number_of_arguments, list2 (original_fun, numargs)); + xsignal2 (Qwrong_number_of_arguments, original_fun, numargs); if (XSUBR (fun)->max_args == UNEVALLED) { @@ -2289,12 +2356,12 @@ DEFUN ("eval", Feval, Seval, 1, 1, 0, else { if (EQ (fun, Qunbound)) - Fsignal (Qvoid_function, Fcons (original_fun, Qnil)); + xsignal1 (Qvoid_function, original_fun); if (!CONSP (fun)) - Fsignal (Qinvalid_function, Fcons (original_fun, Qnil)); - funcar = Fcar (fun); + xsignal1 (Qinvalid_function, original_fun); + funcar = XCAR (fun); if (!SYMBOLP (funcar)) - Fsignal (Qinvalid_function, Fcons (original_fun, Qnil)); + xsignal1 (Qinvalid_function, original_fun); if (EQ (funcar, Qautoload)) { do_autoload (fun, original_fun); @@ -2305,7 +2372,7 @@ DEFUN ("eval", Feval, Seval, 1, 1, 0, else if (EQ (funcar, Qlambda)) val = apply_lambda (fun, original_args, 1); else - Fsignal (Qinvalid_function, Fcons (original_fun, Qnil)); + xsignal1 (Qinvalid_function, original_fun); } done: CHECK_CONS_LIST (); @@ -2885,11 +2952,11 @@ usage: (funcall FUNCTION &rest ARGUMENTS) */) || (XSUBR (fun)->max_args >= 0 && XSUBR (fun)->max_args < numargs)) { XSETFASTINT (lisp_numargs, numargs); - Fsignal (Qwrong_number_of_arguments, list2 (original_fun, lisp_numargs)); + xsignal2 (Qwrong_number_of_arguments, original_fun, lisp_numargs); } if (XSUBR (fun)->max_args == UNEVALLED) - Fsignal (Qinvalid_function, Fcons (original_fun, Qnil)); + xsignal1 (Qinvalid_function, original_fun); if (XSUBR (fun)->max_args == MANY) { @@ -2962,12 +3029,12 @@ usage: (funcall FUNCTION &rest ARGUMENTS) */) else { if (EQ (fun, Qunbound)) - Fsignal (Qvoid_function, Fcons (original_fun, Qnil)); + xsignal1 (Qvoid_function, original_fun); if (!CONSP (fun)) - Fsignal (Qinvalid_function, Fcons (original_fun, Qnil)); - funcar = Fcar (fun); + xsignal1 (Qinvalid_function, original_fun); + funcar = XCAR (fun); if (!SYMBOLP (funcar)) - Fsignal (Qinvalid_function, Fcons (original_fun, Qnil)); + xsignal1 (Qinvalid_function, original_fun); if (EQ (funcar, Qlambda)) val = funcall_lambda (fun, numargs, args + 1); else if (EQ (funcar, Qautoload)) @@ -2977,7 +3044,7 @@ usage: (funcall FUNCTION &rest ARGUMENTS) */) goto retry; } else - Fsignal (Qinvalid_function, Fcons (original_fun, Qnil)); + xsignal1 (Qinvalid_function, original_fun); } done: CHECK_CONS_LIST (); @@ -3053,7 +3120,7 @@ funcall_lambda (fun, nargs, arg_vector) if (CONSP (syms_left)) syms_left = XCAR (syms_left); else - Fsignal (Qinvalid_function, Fcons (fun, Qnil)); + xsignal1 (Qinvalid_function, fun); } else if (COMPILEDP (fun)) syms_left = AREF (fun, COMPILED_ARGLIST); @@ -3067,7 +3134,7 @@ funcall_lambda (fun, nargs, arg_vector) next = XCAR (syms_left); if (!SYMBOLP (next)) - Fsignal (Qinvalid_function, Fcons (fun, Qnil)); + xsignal1 (Qinvalid_function, fun); if (EQ (next, Qand_rest)) rest = 1; @@ -3081,15 +3148,15 @@ funcall_lambda (fun, nargs, arg_vector) else if (i < nargs) specbind (next, arg_vector[i++]); else if (!optional) - Fsignal (Qwrong_number_of_arguments, list2 (fun, make_number (nargs))); + xsignal2 (Qwrong_number_of_arguments, fun, make_number (nargs)); else specbind (next, Qnil); } if (!NILP (syms_left)) - Fsignal (Qinvalid_function, Fcons (fun, Qnil)); + xsignal1 (Qinvalid_function, fun); else if (i < nargs) - Fsignal (Qwrong_number_of_arguments, list2 (fun, make_number (nargs))); + xsignal2 (Qwrong_number_of_arguments, fun, make_number (nargs)); if (CONSP (fun)) val = Fprogn (XCDR (XCDR (fun))); @@ -3141,8 +3208,7 @@ grow_specpdl () if (max_specpdl_size < 400) max_specpdl_size = 400; if (specpdl_size >= max_specpdl_size) - Fsignal (Qerror, - Fcons (build_string ("Variable binding depth exceeds max-specpdl-size"), Qnil)); + signal_error ("Variable binding depth exceeds max-specpdl-size", Qnil); } specpdl_size *= 2; if (specpdl_size > max_specpdl_size) diff --git a/src/fileio.c b/src/fileio.c index 58b1863f225..8ac528cafb9 100644 --- a/src/fileio.c +++ b/src/fileio.c @@ -282,7 +282,7 @@ report_file_error (string, data) switch (errorno) { case EEXIST: - Fsignal (Qfile_already_exists, Fcons (errstring, data)); + xsignal (Qfile_already_exists, Fcons (errstring, data)); break; default: /* System error messages are capitalized. Downcase the initial @@ -290,7 +290,7 @@ report_file_error (string, data) if (SREF (errstring, 1) != '/') SSET (errstring, 0, DOWNCASE (SREF (errstring, 0))); - Fsignal (Qfile_error, + xsignal (Qfile_error, Fcons (build_string (string), Fcons (errstring, data))); } } @@ -2386,9 +2386,8 @@ barf_or_query_if_file_exists (absname, querystring, interactive, statptr, quick) if (lstat (SDATA (encoded_filename), &statbuf) >= 0) { if (! interactive) - Fsignal (Qfile_already_exists, - Fcons (build_string ("File already exists"), - Fcons (absname, Qnil))); + xsignal2 (Qfile_already_exists, + build_string ("File already exists"), absname); GCPRO1 (absname); tem = format2 ("File %s already exists; %s anyway? ", absname, build_string (querystring)); @@ -2398,9 +2397,8 @@ barf_or_query_if_file_exists (absname, querystring, interactive, statptr, quick) tem = do_yes_or_no_p (tem); UNGCPRO; if (NILP (tem)) - Fsignal (Qfile_already_exists, - Fcons (build_string ("File already exists"), - Fcons (absname, Qnil))); + xsignal2 (Qfile_already_exists, + build_string ("File already exists"), absname); if (statptr) *statptr = statbuf; } @@ -2502,9 +2500,8 @@ uid and gid of FILE to NEWNAME. */) { /* Restore original attributes. */ SetFileAttributes (filename, attributes); - Fsignal (Qfile_date_error, - Fcons (build_string ("Cannot set file date"), - Fcons (newname, Qnil))); + xsignal2 (Qfile_date_error, + build_string ("Cannot set file date"), newname); } /* Restore original attributes. */ SetFileAttributes (filename, attributes); @@ -2600,9 +2597,8 @@ uid and gid of FILE to NEWNAME. */) EMACS_SET_SECS_USECS (mtime, st.st_mtime, 0); if (set_file_times (SDATA (encoded_newname), atime, mtime)) - Fsignal (Qfile_date_error, - Fcons (build_string ("Cannot set file date"), - Fcons (newname, Qnil))); + xsignal2 (Qfile_date_error, + build_string ("Cannot set file date"), newname); } } @@ -2698,9 +2694,9 @@ If file has multiple names, it continues to exist with the other names. */) GCPRO1 (filename); if (!NILP (Ffile_directory_p (filename)) && NILP (Ffile_symlink_p (filename))) - Fsignal (Qfile_error, - Fcons (build_string ("Removing old name: is a directory"), - Fcons (filename, Qnil))); + xsignal2 (Qfile_error, + build_string ("Removing old name: is a directory"), + filename); UNGCPRO; filename = Fexpand_file_name (filename, Qnil); @@ -3850,9 +3846,8 @@ actually used. */) goto notfound; if (! NILP (replace) || ! NILP (beg) || ! NILP (end)) - Fsignal (Qfile_error, - Fcons (build_string ("not a regular file"), - Fcons (orig_filename, Qnil))); + xsignal2 (Qfile_error, + build_string ("not a regular file"), orig_filename); } #endif @@ -4725,9 +4720,8 @@ actually used. */) } #endif /* CLASH_DETECTION */ if (not_regular) - Fsignal (Qfile_error, - Fcons (build_string ("not a regular file"), - Fcons (orig_filename, Qnil))); + xsignal2 (Qfile_error, + build_string ("not a regular file"), orig_filename); } if (set_coding_system) @@ -6632,19 +6626,17 @@ of file names regardless of the current language environment. */); staticpro (&Qcar_less_than_car); Fput (Qfile_error, Qerror_conditions, - Fcons (Qfile_error, Fcons (Qerror, Qnil))); + list2 (Qfile_error, Qerror)); Fput (Qfile_error, Qerror_message, build_string ("File error")); Fput (Qfile_already_exists, Qerror_conditions, - Fcons (Qfile_already_exists, - Fcons (Qfile_error, Fcons (Qerror, Qnil)))); + list3 (Qfile_already_exists, Qfile_error, Qerror)); Fput (Qfile_already_exists, Qerror_message, build_string ("File already exists")); Fput (Qfile_date_error, Qerror_conditions, - Fcons (Qfile_date_error, - Fcons (Qfile_error, Fcons (Qerror, Qnil)))); + list3 (Qfile_date_error, Qfile_error, Qerror)); Fput (Qfile_date_error, Qerror_message, build_string ("Cannot set file date")); diff --git a/src/floatfns.c b/src/floatfns.c index d5ca50f9165..dd879de7eb8 100644 --- a/src/floatfns.c +++ b/src/floatfns.c @@ -201,17 +201,15 @@ static char *float_error_fn_name; while (0) #define arith_error(op,arg) \ - Fsignal (Qarith_error, Fcons (build_string ((op)), Fcons ((arg), Qnil))) + xsignal2 (Qarith_error, build_string ((op)), (arg)) #define range_error(op,arg) \ - Fsignal (Qrange_error, Fcons (build_string ((op)), Fcons ((arg), Qnil))) + xsignal2 (Qrange_error, build_string ((op)), (arg)) #define range_error2(op,a1,a2) \ - Fsignal (Qrange_error, Fcons (build_string ((op)), \ - Fcons ((a1), Fcons ((a2), Qnil)))) + xsignal3 (Qrange_error, build_string ((op)), (a1), (a2)) #define domain_error(op,arg) \ - Fsignal (Qdomain_error, Fcons (build_string ((op)), Fcons ((arg), Qnil))) + xsignal2 (Qdomain_error, build_string ((op)), (arg)) #define domain_error2(op,a1,a2) \ - Fsignal (Qdomain_error, Fcons (build_string ((op)), \ - Fcons ((a1), Fcons ((a2), Qnil)))) + xsignal3 (Qdomain_error, build_string ((op)), (a1), (a2)) /* Extract a Lisp number as a `double', or signal an error. */ @@ -756,7 +754,7 @@ rounding_driver (arg, divisor, double_round, int_round2, name) f1 = FLOATP (arg) ? XFLOAT_DATA (arg) : XINT (arg); f2 = (FLOATP (divisor) ? XFLOAT_DATA (divisor) : XINT (divisor)); if (! IEEE_FLOATING_POINT && f2 == 0) - Fsignal (Qarith_error, Qnil); + xsignal0 (Qarith_error); IN_FLOAT2 (f1 = (*double_round) (f1 / f2), name, arg, divisor); FLOAT_TO_INT2 (f1, arg, name, arg, divisor); @@ -767,7 +765,7 @@ rounding_driver (arg, divisor, double_round, int_round2, name) i2 = XINT (divisor); if (i2 == 0) - Fsignal (Qarith_error, Qnil); + xsignal0 (Qarith_error); XSETINT (arg, (*int_round2) (i1, i2)); return arg; @@ -907,7 +905,7 @@ fmod_float (x, y) f2 = FLOATP (y) ? XFLOAT_DATA (y) : XINT (y); if (! IEEE_FLOATING_POINT && f2 == 0) - Fsignal (Qarith_error, Qnil); + xsignal0 (Qarith_error); /* If the "remainder" comes out with the wrong sign, fix it. */ IN_FLOAT2 ((f1 = fmod (f1, f2), @@ -986,7 +984,7 @@ float_error (signo) SIGNAL_THREAD_CHECK (signo); in_float = 0; - Fsignal (Qarith_error, Fcons (float_error_arg, Qnil)); + xsignal1 (Qarith_error, float_error_arg); } /* Another idea was to replace the library function `infnan' @@ -1014,11 +1012,11 @@ matherr (x) : Qnil))); switch (x->type) { - case DOMAIN: Fsignal (Qdomain_error, args); break; - case SING: Fsignal (Qsingularity_error, args); break; - case OVERFLOW: Fsignal (Qoverflow_error, args); break; - case UNDERFLOW: Fsignal (Qunderflow_error, args); break; - default: Fsignal (Qarith_error, args); break; + case DOMAIN: xsignal (Qdomain_error, args); break; + case SING: xsignal (Qsingularity_error, args); break; + case OVERFLOW: xsignal (Qoverflow_error, args); break; + case UNDERFLOW: xsignal (Qunderflow_error, args); break; + default: xsignal (Qarith_error, args); break; } return (1); /* don't set errno or print a message */ } diff --git a/src/fns.c b/src/fns.c index 69e12bf25ce..0054e6fc998 100644 --- a/src/fns.c +++ b/src/fns.c @@ -182,7 +182,7 @@ To get the number of bytes, use `string-bytes'. */) else if (NILP (sequence)) XSETFASTINT (val, 0); else - val = wrong_type_argument (Qsequencep, sequence); + wrong_type_argument (Qsequencep, sequence); return val; } @@ -3251,8 +3251,7 @@ is nil and `use-dialog-box' is non-nil. */) } temporarily_switch_to_single_kboard (SELECTED_FRAME ()); - obj = read_filtered_event (1, 0, 0, 0); - + obj = read_filtered_event (1, 0, 0, 0, Qnil); cursor_in_echo_area = 0; /* If we need to quit, quit with cursor_in_echo_area = 0. */ QUIT; @@ -4491,10 +4490,7 @@ hashfn_user_defined (h, key) args[1] = key; hash = Ffuncall (2, args); if (!INTEGERP (hash)) - Fsignal (Qerror, - list2 (build_string ("Invalid hash code returned from \ -user-supplied hash function"), - hash)); + signal_error ("Invalid hash code returned from user-supplied hash function", hash); return XUINT (hash); } @@ -5250,8 +5246,7 @@ usage: (make-hash-table &rest KEYWORD-ARGS) */) prop = Fget (test, Qhash_table_test); if (!CONSP (prop) || !CONSP (XCDR (prop))) - Fsignal (Qerror, list2 (build_string ("Invalid hash table test"), - test)); + signal_error ("Invalid hash table test", test); user_test = XCAR (prop); user_hash = XCAR (XCDR (prop)); } @@ -5264,9 +5259,7 @@ usage: (make-hash-table &rest KEYWORD-ARGS) */) if (NILP (size)) size = make_number (DEFAULT_HASH_SIZE); else if (!INTEGERP (size) || XINT (size) < 0) - Fsignal (Qerror, - list2 (build_string ("Invalid hash table size"), - size)); + signal_error ("Invalid hash table size", size); /* Look for `:rehash-size SIZE'. */ i = get_key_arg (QCrehash_size, nargs, args, used); @@ -5274,9 +5267,7 @@ usage: (make-hash-table &rest KEYWORD-ARGS) */) if (!NUMBERP (rehash_size) || (INTEGERP (rehash_size) && XINT (rehash_size) <= 0) || XFLOATINT (rehash_size) <= 1.0) - Fsignal (Qerror, - list2 (build_string ("Invalid hash table rehash size"), - rehash_size)); + signal_error ("Invalid hash table rehash size", rehash_size); /* Look for `:rehash-threshold THRESHOLD'. */ i = get_key_arg (QCrehash_threshold, nargs, args, used); @@ -5284,9 +5275,7 @@ usage: (make-hash-table &rest KEYWORD-ARGS) */) if (!FLOATP (rehash_threshold) || XFLOATINT (rehash_threshold) <= 0.0 || XFLOATINT (rehash_threshold) > 1.0) - Fsignal (Qerror, - list2 (build_string ("Invalid hash table rehash threshold"), - rehash_threshold)); + signal_error ("Invalid hash table rehash threshold", rehash_threshold); /* Look for `:weakness WEAK'. */ i = get_key_arg (QCweakness, nargs, args, used); @@ -5298,14 +5287,12 @@ usage: (make-hash-table &rest KEYWORD-ARGS) */) && !EQ (weak, Qvalue) && !EQ (weak, Qkey_or_value) && !EQ (weak, Qkey_and_value)) - Fsignal (Qerror, list2 (build_string ("Invalid hash table weakness"), - weak)); + signal_error ("Invalid hash table weakness", weak); /* Now, all args should have been used up, or there's a problem. */ for (i = 0; i < nargs; ++i) if (!used[i]) - Fsignal (Qerror, - list2 (build_string ("Invalid argument list"), args[i])); + signal_error ("Invalid argument list", args[i]); return make_hash_table (test, size, rehash_size, rehash_threshold, weak, user_test, user_hash); @@ -5556,8 +5543,7 @@ guesswork fails. Normally, an error is signaled in such case. */) if (!NILP (noerror)) coding_system = Qraw_text; else - while (1) - Fsignal (Qcoding_system_error, Fcons (coding_system, Qnil)); + xsignal1 (Qcoding_system_error, coding_system); } if (STRING_MULTIBYTE (object)) @@ -5691,8 +5677,7 @@ guesswork fails. Normally, an error is signaled in such case. */) if (!NILP (noerror)) coding_system = Qraw_text; else - while (1) - Fsignal (Qcoding_system_error, Fcons (coding_system, Qnil)); + xsignal1 (Qcoding_system_error, coding_system); } } diff --git a/src/frame.c b/src/frame.c index 3fad2187ba4..fd10c3e273c 100644 --- a/src/frame.c +++ b/src/frame.c @@ -3337,8 +3337,7 @@ x_set_line_spacing (f, new_value, old_value) else if (NATNUMP (new_value)) f->extra_line_spacing = XFASTINT (new_value); else - Fsignal (Qerror, Fcons (build_string ("Invalid line-spacing"), - Fcons (new_value, Qnil))); + signal_error ("Invalid line-spacing", new_value); if (FRAME_VISIBLE_P (f)) redraw_frame (f); } @@ -3358,8 +3357,7 @@ x_set_screen_gamma (f, new_value, old_value) /* The value 0.4545 is the normal viewing gamma. */ f->gamma = 1.0 / (0.4545 * XFLOATINT (new_value)); else - Fsignal (Qerror, Fcons (build_string ("Invalid screen-gamma"), - Fcons (new_value, Qnil))); + signal_error ("Invalid screen-gamma", new_value); clear_face_cache (0); } diff --git a/src/keyboard.c b/src/keyboard.c index 025c8a3f85c..08b352c3c3a 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -238,6 +238,9 @@ static int inhibit_local_menu_bar_menus; /* Nonzero means C-g should cause immediate error-signal. */ int immediate_quit; +/* The user's hook function for outputting an error message. */ +Lisp_Object Vcommand_error_function; + /* The user's ERASE setting. */ Lisp_Object Vtty_erase_char; @@ -682,8 +685,6 @@ static void timer_start_idle P_ ((void)); static void timer_stop_idle P_ ((void)); static void timer_resume_idle P_ ((void)); -Lisp_Object read_char P_ ((int, int, Lisp_Object *, Lisp_Object, int *)); - /* Nonzero means don't try to suspend even if the operating system seems to support it. */ static int cannot_suspend; @@ -990,7 +991,7 @@ recursive_edit_1 () /* Handle throw from read_minibuf when using minibuffer while it's active but we're in another window. */ if (STRINGP (val)) - Fsignal (Qerror, Fcons (val, Qnil)); + xsignal1 (Qerror, val); return unbind_to (count, Qnil); } @@ -1185,11 +1186,12 @@ temporarily_switch_to_single_kboard (f) { if (f != NULL && FRAME_KBOARD (f) != current_kboard) /* We can not switch keyboards while in single_kboard mode. - This can legally happen when Lisp code calls - `recursive-edit' (or `read-minibuffer' or `y-or-n-p') after - it switched to a locked frame. This kind of situation is - likely to happen when server.el connects to a new - terminal. */ + In rare cases, Lisp code may call `recursive-edit' (or + `read-minibuffer' or `y-or-n-p') after it switched to a + locked frame. For example, this is likely to happen + when server.el connects to a new terminal while Emacs is in + single_kboard mode. It is best to throw an error instead + of presenting the user with a frozen screen. */ error ("Terminal %d is locked, cannot read from it", FRAME_TERMINAL (f)->id); else @@ -1304,48 +1306,43 @@ cmd_error_internal (data, context) Lisp_Object data; char *context; { - Lisp_Object stream; - int kill_emacs_p = 0; struct frame *sf = SELECTED_FRAME (); + /* The immediate context is not interesting for Quits, + since they are asyncronous. */ + if (EQ (XCAR (data), Qquit)) + Vsignaling_function = Qnil; + Vquit_flag = Qnil; Vinhibit_quit = Qt; - clear_message (1, 0); + /* Use user's specified output function if any. */ + if (!NILP (Vcommand_error_function)) + call3 (Vcommand_error_function, data, + build_string (context ? context : ""), + Vsignaling_function); /* If the window system or terminal frame hasn't been initialized - yet, or we're not interactive, it's best to dump this message out - to stderr and exit. */ - if (!sf->glyphs_initialized_p - || FRAME_INITIAL_P (sf) - || noninteractive) - { - stream = Qexternal_debugging_output; - kill_emacs_p = 1; + yet, or we're not interactive, write the message to stderr and exit. */ + else if (!sf->glyphs_initialized_p + || FRAME_INITIAL_P (sf) + || noninteractive) + { + print_error_message (data, Qexternal_debugging_output, + context, Vsignaling_function); + Fterpri (Qexternal_debugging_output); + Fkill_emacs (make_number (-1)); } else { + clear_message (1, 0); Fdiscard_input (); message_log_maybe_newline (); bitch_at_user (); - stream = Qt; - } - - /* The immediate context is not interesting for Quits, - since they are asyncronous. */ - if (EQ (XCAR (data), Qquit)) - Vsignaling_function = Qnil; - print_error_message (data, stream, context, Vsignaling_function); + print_error_message (data, Qt, context, Vsignaling_function); + } Vsignaling_function = Qnil; - - /* If the window system or terminal frame hasn't been initialized - yet, or we're in -batch mode, this error should cause Emacs to exit. */ - if (kill_emacs_p) - { - Fterpri (stream); - Fkill_emacs (make_number (-1)); - } } Lisp_Object command_loop_1 (); @@ -2470,15 +2467,20 @@ do { if (polling_stopped_here) start_polling (); \ Value is -2 when we find input on another keyboard. A second call to read_char will read it. + If END_TIME is non-null, it is a pointer to an EMACS_TIME + specifying the maximum time to wait until. If no input arrives by + that time, stop waiting and return nil. + Value is t if we showed a menu and the user rejected it. */ Lisp_Object -read_char (commandflag, nmaps, maps, prev_event, used_mouse_menu) +read_char (commandflag, nmaps, maps, prev_event, used_mouse_menu, end_time) int commandflag; int nmaps; Lisp_Object *maps; Lisp_Object prev_event; int *used_mouse_menu; + EMACS_TIME *end_time; { volatile Lisp_Object c; int count; @@ -2764,6 +2766,7 @@ read_char (commandflag, nmaps, maps, prev_event, used_mouse_menu) start echoing if enough time elapses. */ if (minibuf_level == 0 + && !end_time && !current_kboard->immediate_echo && this_command_key_count > 0 && ! noninteractive @@ -2959,11 +2962,19 @@ read_char (commandflag, nmaps, maps, prev_event, used_mouse_menu) { KBOARD *kb; + if (end_time) + { + EMACS_TIME now; + EMACS_GET_TIME (now); + if (EMACS_TIME_GE (now, *end_time)) + goto exit; + } + /* Actually read a character, waiting if necessary. */ save_getcjmp (save_jump); restore_getcjmp (local_getcjmp); timer_start_idle (); - c = kbd_buffer_get_event (&kb, used_mouse_menu); + c = kbd_buffer_get_event (&kb, used_mouse_menu, end_time); restore_getcjmp (save_jump); #ifdef MULTI_KBOARD @@ -3307,7 +3318,7 @@ read_char (commandflag, nmaps, maps, prev_event, used_mouse_menu) cancel_echoing (); do - c = read_char (0, 0, 0, Qnil, 0); + c = read_char (0, 0, 0, Qnil, 0, NULL); while (BUFFERP (c)); /* Remove the help from the frame */ unbind_to (count, Qnil); @@ -3317,7 +3328,7 @@ read_char (commandflag, nmaps, maps, prev_event, used_mouse_menu) { cancel_echoing (); do - c = read_char (0, 0, 0, Qnil, 0); + c = read_char (0, 0, 0, Qnil, 0, NULL); while (BUFFERP (c)); } } @@ -3994,9 +4005,10 @@ clear_event (event) We always read and discard one event. */ static Lisp_Object -kbd_buffer_get_event (kbp, used_mouse_menu) +kbd_buffer_get_event (kbp, used_mouse_menu, end_time) KBOARD **kbp; int *used_mouse_menu; + EMACS_TIME *end_time; { register int c; Lisp_Object obj; @@ -4040,13 +4052,24 @@ kbd_buffer_get_event (kbp, used_mouse_menu) if (!NILP (do_mouse_tracking) && some_mouse_moved ()) break; #endif - { + if (end_time) + { + EMACS_TIME duration; + EMACS_GET_TIME (duration); + EMACS_SUB_TIME (duration, *end_time, duration); + if (EMACS_TIME_NEG_P (duration)) + return Qnil; + else + wait_reading_process_output (EMACS_SECS (duration), + EMACS_USECS (duration), + -1, 1, Qnil, NULL, 0); + } + else wait_reading_process_output (0, 0, -1, 1, Qnil, NULL, 0); - if (!interrupt_input && kbd_fetch_ptr == kbd_store_ptr) - /* Pass 1 for EXPECT since we just waited to have input. */ - read_avail_input (1); - } + if (!interrupt_input && kbd_fetch_ptr == kbd_store_ptr) + /* Pass 1 for EXPECT since we just waited to have input. */ + read_avail_input (1); #endif /* not VMS */ } @@ -8469,7 +8492,7 @@ read_char_minibuf_menu_prompt (commandflag, nmaps, maps) orig_defn_macro = current_kboard->defining_kbd_macro; current_kboard->defining_kbd_macro = Qnil; do - obj = read_char (commandflag, 0, 0, Qt, 0); + obj = read_char (commandflag, 0, 0, Qt, 0, NULL); while (BUFFERP (obj)); current_kboard->defining_kbd_macro = orig_defn_macro; @@ -8839,7 +8862,7 @@ read_key_sequence (keybuf, bufsize, prompt, dont_downcase_last, /* Read the first char of the sequence specially, before setting up any keymaps, in case a filter runs and switches buffers on us. */ first_event = read_char (NILP (prompt), 0, submaps, last_nonmenu_event, - &junk); + &junk, NULL); #endif /* GOBBLE_FIRST_EVENT */ orig_local_map = get_local_map (PT, current_buffer, Qlocal_map); @@ -9018,7 +9041,7 @@ read_key_sequence (keybuf, bufsize, prompt, dont_downcase_last, #endif key = read_char (NILP (prompt), nmaps, (Lisp_Object *) submaps, last_nonmenu_event, - &used_mouse_menu); + &used_mouse_menu, NULL); #ifdef MULTI_KBOARD if (INTEGERP (key) && XINT (key) == -2) /* wrong_kboard_jmpbuf */ { @@ -11948,6 +11971,15 @@ The value of that variable is passed to `quit-flag' and later causes a peculiar kind of quitting. */); Vthrow_on_input = Qnil; + DEFVAR_LISP ("command-error-function", &Vcommand_error_function, + doc: /* If non-nil, function to output error messages. +The arguments are the error data, a list of the form + (SIGNALED-CONDITIONS . SIGNAL-DATA) +such as just as `condition-case' would bind its variable to, +the context (a string which normally goes at the start of the message), +and the Lisp function within which the error was signaled. */); + Vcommand_error_function = Qnil; + DEFVAR_LISP ("enable-disabled-menus-and-buttons", &Venable_disabled_menus_and_buttons, doc: /* If non-nil, don't ignore events produced by disabled menu items and tool-bar. diff --git a/src/keyboard.h b/src/keyboard.h index a3fa54b1042..8f1c5dd31a9 100644 --- a/src/keyboard.h +++ b/src/keyboard.h @@ -19,6 +19,8 @@ along with GNU Emacs; see the file COPYING. If not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. */ +#include "systime.h" /* for EMACS_TIME */ + /* Length of echobuf field in each KBOARD. */ /* Each KBOARD represents one logical input stream from which Emacs @@ -305,6 +307,9 @@ struct input_event; extern Lisp_Object parse_modifiers P_ ((Lisp_Object)); extern Lisp_Object reorder_modifiers P_ ((Lisp_Object)); +extern Lisp_Object read_char P_ ((int, int, Lisp_Object *, Lisp_Object, + int *, EMACS_TIME *)); + /* Parent keymap of terminal-local function-key-map instances. */ extern Lisp_Object Vfunction_key_map; diff --git a/src/keymap.c b/src/keymap.c index 0197319957c..9e1f01e7a79 100644 --- a/src/keymap.c +++ b/src/keymap.c @@ -751,7 +751,7 @@ usage: (map-keymap FUNCTION KEYMAP) */) if (INTEGERP (function)) /* We have to stop integers early since map_keymap gives them special significance. */ - Fsignal (Qinvalid_function, Fcons (function, Qnil)); + xsignal1 (Qinvalid_function, function); if (! NILP (sort_first)) return call3 (intern ("map-keymap-internal"), function, keymap, Qt); @@ -1142,6 +1142,20 @@ binding KEY to DEF is added at the front of KEYMAP. */) meta_bit = VECTORP (key) ? meta_modifier : 0x80; + if (VECTORP (def) && ASIZE (def) > 0 && CONSP (AREF (def, make_number (0)))) + { /* DEF is apparently an XEmacs-style keyboard macro. */ + Lisp_Object tmp = Fmake_vector (make_number (ASIZE (def)), Qnil); + int i = ASIZE (def); + while (--i >= 0) + { + Lisp_Object c = AREF (def, i); + if (CONSP (c) && lucid_event_type_list_p (c)) + c = Fevent_convert_list (c); + ASET (tmp, i, c); + } + def = tmp; + } + idx = 0; while (1) { diff --git a/src/lisp.h b/src/lisp.h index 7b70b0a9d17..4bdb0e67947 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -2174,7 +2174,7 @@ extern Lisp_Object Qnumberp, Qnumber_or_marker_p; extern Lisp_Object Qinteger; -extern void circular_list_error P_ ((Lisp_Object)); +extern void circular_list_error P_ ((Lisp_Object)) NO_RETURN; EXFUN (Finteractive_form, 1); /* Defined in frame.c */ @@ -2549,13 +2549,14 @@ extern void allocate_string_data P_ ((struct Lisp_String *, int, int)); extern void reset_malloc_hooks P_ ((void)); extern void uninterrupt_malloc P_ ((void)); extern void malloc_warning P_ ((char *)); -extern void memory_full P_ ((void)); -extern void buffer_memory_full P_ ((void)); +extern void memory_full P_ ((void)) NO_RETURN; +extern void buffer_memory_full P_ ((void)) NO_RETURN; extern int survives_gc_p P_ ((Lisp_Object)); extern void mark_object P_ ((Lisp_Object)); extern Lisp_Object Vpurify_flag; extern Lisp_Object Vmemory_full; EXFUN (Fcons, 2); +EXFUN (list1, 1); EXFUN (list2, 2); EXFUN (list3, 3); EXFUN (list4, 4); @@ -2644,9 +2645,9 @@ EXFUN (Fintern_soft, 2); EXFUN (Fload, 5); EXFUN (Fget_load_suffixes, 0); EXFUN (Fget_file_char, 0); -EXFUN (Fread_char, 2); -EXFUN (Fread_event, 2); -extern Lisp_Object read_filtered_event P_ ((int, int, int, int)); +EXFUN (Fread_char, 3); +EXFUN (Fread_event, 3); +extern Lisp_Object read_filtered_event P_ ((int, int, int, int, Lisp_Object)); EXFUN (Feval_region, 4); extern Lisp_Object intern P_ ((const char *)); extern Lisp_Object make_symbol P_ ((char *)); @@ -2708,6 +2709,12 @@ EXFUN (Fthrow, 2) NO_RETURN; EXFUN (Funwind_protect, UNEVALLED); EXFUN (Fcondition_case, UNEVALLED); EXFUN (Fsignal, 2); +extern void xsignal P_ ((Lisp_Object, Lisp_Object)) NO_RETURN; +extern void xsignal0 P_ ((Lisp_Object)) NO_RETURN; +extern void xsignal1 P_ ((Lisp_Object, Lisp_Object)) NO_RETURN; +extern void xsignal2 P_ ((Lisp_Object, Lisp_Object, Lisp_Object)) NO_RETURN; +extern void xsignal3 P_ ((Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object)) NO_RETURN; +extern void signal_error P_ ((char *, Lisp_Object)) NO_RETURN; EXFUN (Fautoload, 5); EXFUN (Fcommandp, 2); EXFUN (Feval, 1); diff --git a/src/lread.c b/src/lread.c index 91825bce152..ef76e72f75f 100644 --- a/src/lread.c +++ b/src/lread.c @@ -216,6 +216,9 @@ static void readevalloop P_ ((Lisp_Object, FILE*, Lisp_Object, static Lisp_Object load_unwind P_ ((Lisp_Object)); static Lisp_Object load_descriptor_unwind P_ ((Lisp_Object)); +static void invalid_syntax P_ ((const char *, int)) NO_RETURN; +static void end_of_file_error P_ (()) NO_RETURN; + /* Handle unreading and rereading of characters. Write READCHAR to read a character, @@ -436,8 +439,6 @@ static void substitute_in_interval P_ ((INTERVAL, Lisp_Object)); /* Get a character from the tty. */ -extern Lisp_Object read_char P_ ((int, int, Lisp_Object *, Lisp_Object, int *)); - /* Read input events until we get one that's acceptable for our purposes. If NO_SWITCH_FRAME is non-zero, switch-frame events are stashed @@ -454,14 +455,19 @@ extern Lisp_Object read_char P_ ((int, int, Lisp_Object *, Lisp_Object, int *)); character. If INPUT_METHOD is nonzero, we invoke the current input method - if the character warrants that. */ + if the character warrants that. + + If SECONDS is a number, we wait that many seconds for input, and + return Qnil if no input arrives within that time. */ Lisp_Object read_filtered_event (no_switch_frame, ascii_required, error_nonascii, - input_method) + input_method, seconds) int no_switch_frame, ascii_required, error_nonascii, input_method; + Lisp_Object seconds; { Lisp_Object val, delayed_switch_frame; + EMACS_TIME end_time; #ifdef HAVE_WINDOW_SYSTEM if (display_hourglass_p) @@ -470,10 +476,25 @@ read_filtered_event (no_switch_frame, ascii_required, error_nonascii, delayed_switch_frame = Qnil; - /* Read until we get an acceptable event. */ + /* Compute timeout. */ + if (NUMBERP (seconds)) + { + EMACS_TIME wait_time; + int sec, usec; + double duration = extract_float (seconds); + + sec = (int) duration; + usec = (duration - sec) * 1000000; + EMACS_GET_TIME (end_time); + EMACS_SET_SECS_USECS (wait_time, sec, usec); + EMACS_ADD_TIME (end_time, end_time, wait_time); + } + +/* Read until we get an acceptable event. */ retry: do - val = read_char (0, 0, 0, (input_method ? Qnil : Qt), 0); + val = read_char (0, 0, 0, (input_method ? Qnil : Qt), 0, + NUMBERP (seconds) ? &end_time : NULL); while (INTEGERP (val) && XINT (val) == -2); /* wrong_kboard_jmpbuf */ if (BUFFERP (val)) @@ -492,7 +513,7 @@ read_filtered_event (no_switch_frame, ascii_required, error_nonascii, goto retry; } - if (ascii_required) + if (ascii_required && !(NUMBERP (seconds) && NILP (val))) { /* Convert certain symbols to their ASCII equivalents. */ if (SYMBOLP (val)) @@ -537,7 +558,7 @@ read_filtered_event (no_switch_frame, ascii_required, error_nonascii, return val; } -DEFUN ("read-char", Fread_char, Sread_char, 0, 2, 0, +DEFUN ("read-char", Fread_char, Sread_char, 0, 3, 0, doc: /* Read a character from the command input (keyboard or macro). It is returned as a number. If the user generates an event which is not a character (i.e. a mouse @@ -550,43 +571,55 @@ If you want to read non-character events, or ignore them, call If the optional argument PROMPT is non-nil, display that as a prompt. If the optional argument INHERIT-INPUT-METHOD is non-nil and some input method is turned on in the current buffer, that input method -is used for reading a character. */) - (prompt, inherit_input_method) - Lisp_Object prompt, inherit_input_method; +is used for reading a character. +If the optional argument SECONDS is non-nil, it should be a number +specifying the maximum number of seconds to wait for input. If no +input arrives in that time, return nil. SECONDS may be a +floating-point value. */) + (prompt, inherit_input_method, seconds) + Lisp_Object prompt, inherit_input_method, seconds; { if (! NILP (prompt)) message_with_string ("%s", prompt, 0); - return read_filtered_event (1, 1, 1, ! NILP (inherit_input_method)); + return read_filtered_event (1, 1, 1, ! NILP (inherit_input_method), seconds); } -DEFUN ("read-event", Fread_event, Sread_event, 0, 2, 0, +DEFUN ("read-event", Fread_event, Sread_event, 0, 3, 0, doc: /* Read an event object from the input stream. If the optional argument PROMPT is non-nil, display that as a prompt. If the optional argument INHERIT-INPUT-METHOD is non-nil and some input method is turned on in the current buffer, that input method -is used for reading a character. */) - (prompt, inherit_input_method) - Lisp_Object prompt, inherit_input_method; +is used for reading a character. +If the optional argument SECONDS is non-nil, it should be a number +specifying the maximum number of seconds to wait for input. If no +input arrives in that time, return nil. SECONDS may be a +floating-point value. */) + (prompt, inherit_input_method, seconds) + Lisp_Object prompt, inherit_input_method, seconds; { if (! NILP (prompt)) message_with_string ("%s", prompt, 0); - return read_filtered_event (0, 0, 0, ! NILP (inherit_input_method)); + return read_filtered_event (0, 0, 0, ! NILP (inherit_input_method), seconds); } -DEFUN ("read-char-exclusive", Fread_char_exclusive, Sread_char_exclusive, 0, 2, 0, +DEFUN ("read-char-exclusive", Fread_char_exclusive, Sread_char_exclusive, 0, 3, 0, doc: /* Read a character from the command input (keyboard or macro). It is returned as a number. Non-character events are ignored. If the optional argument PROMPT is non-nil, display that as a prompt. If the optional argument INHERIT-INPUT-METHOD is non-nil and some input method is turned on in the current buffer, that input method -is used for reading a character. */) - (prompt, inherit_input_method) - Lisp_Object prompt, inherit_input_method; +is used for reading a character. +If the optional argument SECONDS is non-nil, it should be a number +specifying the maximum number of seconds to wait for input. If no +input arrives in that time, return nil. SECONDS may be a +floating-point value. */) + (prompt, inherit_input_method, seconds) + Lisp_Object prompt, inherit_input_method, seconds; { if (! NILP (prompt)) message_with_string ("%s", prompt, 0); - return read_filtered_event (1, 1, 0, ! NILP (inherit_input_method)); + return read_filtered_event (1, 1, 0, ! NILP (inherit_input_method), seconds); } DEFUN ("get-file-char", Fget_file_char, Sget_file_char, 0, 0, 0, @@ -799,10 +832,8 @@ Return t if the file exists and loads successfully. */) if (fd == -1) { if (NILP (noerror)) - Fsignal (Qfile_error, Fcons (build_string ("Cannot open load file"), - Fcons (file, Qnil))); - else - return Qnil; + xsignal2 (Qfile_error, build_string ("Cannot open load file"), file); + return Qnil; } /* Tell startup.el whether or not we found the user's init file. */ @@ -843,8 +874,7 @@ Return t if the file exists and loads successfully. */) { if (fd >= 0) emacs_close (fd); - Fsignal (Qerror, Fcons (build_string ("Recursive load"), - Fcons (found, Vloads_in_progress))); + signal_error ("Recursive load", Fcons (found, Vloads_in_progress)); } record_unwind_protect (record_load_unwind, Vloads_in_progress); Vloads_in_progress = Fcons (found, Vloads_in_progress); @@ -1341,11 +1371,9 @@ end_of_file_error () Lisp_Object data; if (STRINGP (Vload_file_name)) - data = Fcons (Vload_file_name, Qnil); - else - data = Qnil; + xsignal1 (Qend_of_file, Vload_file_name); - Fsignal (Qend_of_file, data); + xsignal0 (Qend_of_file); } /* UNIBYTE specifies how to set load_convert_to_unibyte @@ -1696,6 +1724,21 @@ read_internal_start (stream, start, end) return retval; } + +/* Signal Qinvalid_read_syntax error. + S is error string of length N (if > 0) */ + +static void +invalid_syntax (s, n) + const char *s; + int n; +{ + if (!n) + n = strlen (s); + xsignal1 (Qinvalid_read_syntax, make_string (s, n)); +} + + /* Use this for recursive reads, in contexts where internal tokens are not allowed. */ @@ -1707,12 +1750,11 @@ read0 (readcharfun) int c; val = read1 (readcharfun, &c, 0); - if (c) - Fsignal (Qinvalid_read_syntax, Fcons (Fmake_string (make_number (1), - make_number (c)), - Qnil)); + if (!c) + return val; - return val; + xsignal1 (Qinvalid_read_syntax, + Fmake_string (make_number (1), make_number (c))); } static int read_buffer_size; @@ -1980,7 +2022,6 @@ read_escape (readcharfun, stringp, byterep) } } - /* Read an integer in radix RADIX using READCHARFUN to read characters. RADIX must be in the interval [2..36]; if it isn't, a read error is signaled . Value is the integer read. Signals an @@ -2040,7 +2081,7 @@ read_integer (readcharfun, radix) { char buf[50]; sprintf (buf, "integer, radix %d", radix); - Fsignal (Qinvalid_read_syntax, Fcons (build_string (buf), Qnil)); + invalid_syntax (buf, 0); } return make_number (sign * number); @@ -2151,10 +2192,9 @@ read1 (readcharfun, pch, first_in_list) XCHAR_TABLE (tmp)->top = Qnil; return tmp; } - Fsignal (Qinvalid_read_syntax, - Fcons (make_string ("#^^", 3), Qnil)); + invalid_syntax ("#^^", 3); } - Fsignal (Qinvalid_read_syntax, Fcons (make_string ("#^", 2), Qnil)); + invalid_syntax ("#^", 2); } if (c == '&') { @@ -2176,8 +2216,7 @@ read1 (readcharfun, pch, first_in_list) Accept such input in case it came from an old version. */ && ! (XFASTINT (length) == (SCHARS (tmp) - 1) * BOOL_VECTOR_BITS_PER_CHAR)) - Fsignal (Qinvalid_read_syntax, - Fcons (make_string ("#&...", 5), Qnil)); + invalid_syntax ("#&...", 5); val = Fmake_bool_vector (length, Qnil); bcopy (SDATA (tmp), XBOOL_VECTOR (val)->data, @@ -2188,8 +2227,7 @@ read1 (readcharfun, pch, first_in_list) &= (1 << (XINT (length) % BOOL_VECTOR_BITS_PER_CHAR)) - 1; return val; } - Fsignal (Qinvalid_read_syntax, Fcons (make_string ("#&...", 5), - Qnil)); + invalid_syntax ("#&...", 5); } if (c == '[') { @@ -2209,7 +2247,7 @@ read1 (readcharfun, pch, first_in_list) /* Read the string itself. */ tmp = read1 (readcharfun, &ch, 0); if (ch != 0 || !STRINGP (tmp)) - Fsignal (Qinvalid_read_syntax, Fcons (make_string ("#", 1), Qnil)); + invalid_syntax ("#", 1); GCPRO1 (tmp); /* Read the intervals and their properties. */ while (1) @@ -2225,9 +2263,7 @@ read1 (readcharfun, pch, first_in_list) if (ch == 0) plist = read1 (readcharfun, &ch, 0); if (ch) - Fsignal (Qinvalid_read_syntax, - Fcons (build_string ("invalid string property list"), - Qnil)); + invalid_syntax ("Invalid string property list", 0); Fset_text_properties (beg, end, plist, tmp); } UNGCPRO; @@ -2380,7 +2416,7 @@ read1 (readcharfun, pch, first_in_list) return read_integer (readcharfun, 2); UNREAD (c); - Fsignal (Qinvalid_read_syntax, Fcons (make_string ("#", 1), Qnil)); + invalid_syntax ("#", 1); case ';': while ((c = READCHAR) >= 0 && c != '\n'); @@ -2474,10 +2510,10 @@ read1 (readcharfun, pch, first_in_list) || (new_backquote_flag && next_char == ',')))); } UNREAD (next_char); - if (!ok) - Fsignal (Qinvalid_read_syntax, Fcons (make_string ("?", 1), Qnil)); + if (ok) + return make_number (c); - return make_number (c); + invalid_syntax ("?", 1); } case '"': @@ -3122,8 +3158,7 @@ read_list (flag, readcharfun) { if (ch == ']') return val; - Fsignal (Qinvalid_read_syntax, - Fcons (make_string (") or . in a vector", 18), Qnil)); + invalid_syntax (") or . in a vector", 18); } if (ch == ')') return val; @@ -3216,9 +3251,9 @@ read_list (flag, readcharfun) return val; } - return Fsignal (Qinvalid_read_syntax, Fcons (make_string (". in wrong context", 18), Qnil)); + invalid_syntax (". in wrong context", 18); } - return Fsignal (Qinvalid_read_syntax, Fcons (make_string ("] in a list", 11), Qnil)); + invalid_syntax ("] in a list", 11); } tem = (read_pure && flag <= 0 ? pure_cons (elt, Qnil) diff --git a/src/macselect.c b/src/macselect.c index 3afea1e9813..67a28cf9e64 100644 --- a/src/macselect.c +++ b/src/macselect.c @@ -594,11 +594,9 @@ x_get_local_selection (selection_symbol, target_type, local_request) && INTEGERP (XCAR (XCDR (check))) && NILP (XCDR (XCDR (check)))))) return value; - else - return - Fsignal (Qerror, - Fcons (build_string ("invalid data returned by selection-conversion function"), - Fcons (handler_fn, Fcons (value, Qnil)))); + + signal_error ("Invalid data returned by selection-conversion function", + list2 (handler_fn, value)); } diff --git a/src/macterm.c b/src/macterm.c index 8d627446f65..c0128b496d3 100644 --- a/src/macterm.c +++ b/src/macterm.c @@ -8587,6 +8587,81 @@ extern int emacs_main (int, char **, char **); extern void initialize_applescript(); extern void terminate_applescript(); +/* Table for translating Mac keycode to X keysym values. Contributed + by Sudhir Shenoy. + Mapping for special keys is now identical to that in Apple X11 + except `clear' (-> <clear>) on the KeyPad, `enter' (-> <kp-enter>) + on the right of the Cmd key on laptops, and fn + `enter' (-> + <linefeed>). */ +static unsigned char keycode_to_xkeysym_table[] = { + /*0x00*/ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + /*0x10*/ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + /*0x20*/ 0, 0, 0, 0, 0x0d /*return*/, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + + /*0x30*/ 0x09 /*tab*/, 0 /*0x0020 space*/, 0, 0x08 /*backspace*/, + /*0x34*/ 0x8d /*enter on laptops*/, 0x1b /*escape*/, 0, 0, + /*0x38*/ 0, 0, 0, 0, + /*0x3C*/ 0, 0, 0, 0, + + /*0x40*/ 0, 0xae /*kp-decimal*/, 0, 0xaa /*kp-multiply*/, + /*0x44*/ 0, 0xab /*kp-add*/, 0, 0x0b /*clear*/, + /*0x48*/ 0, 0, 0, 0xaf /*kp-divide*/, + /*0x4C*/ 0x8d /*kp-enter*/, 0, 0xad /*kp-subtract*/, 0, + + /*0x50*/ 0, 0xbd /*kp-equal*/, 0xb0 /*kp-0*/, 0xb1 /*kp-1*/, + /*0x54*/ 0xb2 /*kp-2*/, 0xb3 /*kp-3*/, 0xb4 /*kp-4*/, 0xb5 /*kp-5*/, + /*0x58*/ 0xb6 /*kp-6*/, 0xb7 /*kp-7*/, 0, 0xb8 /*kp-8*/, + /*0x5C*/ 0xb9 /*kp-9*/, 0, 0, 0, + + /*0x60*/ 0xc2 /*f5*/, 0xc3 /*f6*/, 0xc4 /*f7*/, 0xc0 /*f3*/, + /*0x64*/ 0xc5 /*f8*/, 0xc6 /*f9*/, 0, 0xc8 /*f11*/, + /*0x68*/ 0, 0xca /*f13*/, 0xcd /*f16*/, 0xcb /*f14*/, + /*0x6C*/ 0, 0xc7 /*f10*/, 0x0a /*fn+enter on laptops*/, 0xc9 /*f12*/, + + /*0x70*/ 0, 0xcc /*f15*/, 0x6a /*help*/, 0x50 /*home*/, + /*0x74*/ 0x55 /*pgup*/, 0xff /*delete*/, 0xc1 /*f4*/, 0x57 /*end*/, + /*0x78*/ 0xbf /*f2*/, 0x56 /*pgdown*/, 0xbe /*f1*/, 0x51 /*left*/, + /*0x7C*/ 0x53 /*right*/, 0x54 /*down*/, 0x52 /*up*/, 0 +}; + +#ifdef MAC_OSX +/* Table for translating Mac keycode with the laptop `fn' key to that + without it. Destination symbols in comments are keys on US + keyboard, and they may not be the same on other types of keyboards. + If the destination is identical to the source (f1 ... f12), it + doesn't map `fn' key to a modifier. */ +static unsigned char fn_keycode_to_keycode_table[] = { + /*0x00*/ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + /*0x10*/ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + /*0x20*/ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + + /*0x30*/ 0, 0, 0, 0, + /*0x34*/ 0, 0, 0, 0, + /*0x38*/ 0, 0, 0, 0, + /*0x3C*/ 0, 0, 0, 0, + + /*0x40*/ 0, 0x2f /*kp-decimal -> '.'*/, 0, 0x23 /*kp-multiply -> 'p'*/, + /*0x44*/ 0, 0x2c /*kp-add -> '/'*/, 0, 0x16 /*clear -> '6'*/, + /*0x48*/ 0, 0, 0, 0x1d /*kp-/ -> '0'*/, + /*0x4C*/ 0x24 /*kp-enter -> return*/, 0, 0x29 /*kp-subtract -> ';'*/, 0, + + /*0x50*/ 0, 0x1b /*kp-equal -> '-'*/, 0x2e /*kp-0 -> 'm'*/, 0x26 /*kp-1 -> 'j'*/, + /*0x54*/ 0x28 /*kp-2 -> 'k'*/, 0x25 /*kp-3 -> 'l'*/, 0x20 /*kp-4 -> 'u'*/, 0x22 /*kp-5 ->'i'*/, + /*0x58*/ 0x1f /*kp-6 -> 'o'*/, 0x1a /*kp-7 -> '7'*/, 0, 0x1c /*kp-8 -> '8'*/, + /*0x5C*/ 0x19 /*kp-9 -> '9'*/, 0, 0, 0, + + /*0x60*/ 0x60 /*f5 = f5*/, 0x61 /*f6 = f6*/, 0x62 /*f7 = f7*/, 0x63 /*f3 = f3*/, + /*0x64*/ 0x64 /*f8 = f8*/, 0x65 /*f9 = f9*/, 0, 0x67 /*f11 = f11*/, + /*0x68*/ 0, 0, 0, 0, + /*0x6C*/ 0, 0x6d /*f10 = f10*/, 0, 0x6f /*f12 = f12*/, + + /*0x70*/ 0, 0, 0, 0x7b /*home -> left*/, + /*0x74*/ 0x7e /*pgup -> up*/, 0x33 /*delete -> backspace*/, 0x76 /*f4 = f4*/, 0x7c /*end -> right*/, + /*0x78*/ 0x78 /*f2 = f2*/, 0x7d /*pgdown -> down*/, 0x7a /*f1 = f1*/, 0, + /*0x7C*/ 0, 0, 0, 0 +}; +#endif /* MAC_OSX */ + static unsigned int #if USE_CARBON_EVENTS mac_to_emacs_modifiers (UInt32 mods) @@ -9650,7 +9725,6 @@ mac_handle_text_input_event (next_handler, event, data) { EventRef kbd_event; UInt32 actual_size, modifiers, mapped_modifiers; - UniChar code; err = GetEventParameter (event, kEventParamTextInputSendKeyboardEvent, typeEventRef, NULL, sizeof (EventRef), NULL, @@ -9678,26 +9752,37 @@ mac_handle_text_input_event (next_handler, event, data) err = GetEventParameter (kbd_event, kEventParamKeyUnicodes, typeUnicodeText, NULL, 0, &actual_size, NULL); - if (err == noErr) + if (err == noErr && actual_size == sizeof (UniChar)) { - if (actual_size == sizeof (UniChar)) - err = GetEventParameter (kbd_event, kEventParamKeyUnicodes, - typeUnicodeText, NULL, - sizeof (UniChar), NULL, &code); + UniChar code; + + err = GetEventParameter (kbd_event, kEventParamKeyUnicodes, + typeUnicodeText, NULL, + sizeof (UniChar), NULL, &code); if (err == noErr && code < 0x80) { /* ASCII character. Process it in XTread_socket. */ if (read_socket_inev && code >= 0x20 && code <= 0x7e) { - struct frame *f = mac_focus_frame (&one_mac_display_info); - - read_socket_inev->kind = ASCII_KEYSTROKE_EVENT; - read_socket_inev->code = code; - read_socket_inev->modifiers = - (extra_keyboard_modifiers - & (meta_modifier | alt_modifier - | hyper_modifier | super_modifier)); - XSETFRAME (read_socket_inev->frame_or_window, f); + UInt32 key_code; + + err = GetEventParameter (kbd_event, kEventParamKeyCode, + typeUInt32, NULL, sizeof (UInt32), + NULL, &key_code); + if (!(err == noErr && key_code <= 0x7f + && keycode_to_xkeysym_table [key_code])) + { + struct frame *f = + mac_focus_frame (&one_mac_display_info); + + read_socket_inev->kind = ASCII_KEYSTROKE_EVENT; + read_socket_inev->code = code; + read_socket_inev->modifiers = + (extra_keyboard_modifiers + & (meta_modifier | alt_modifier + | hyper_modifier | super_modifier)); + XSETFRAME (read_socket_inev->frame_or_window, f); + } } return eventNotHandledErr; } @@ -9970,89 +10055,6 @@ main (void) } #endif -/* Table for translating Mac keycode to X keysym values. Contributed - by Sudhir Shenoy. - Mapping for special keys is now identical to that in Apple X11 - except `clear' (-> <clear>) on the KeyPad, `enter' (-> <kp-enter>) - on the right of the Cmd key on laptops, and fn + `enter' (-> - <linefeed>). */ -static unsigned char keycode_to_xkeysym_table[] = { - /*0x00*/ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - /*0x10*/ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - /*0x20*/ 0, 0, 0, 0, 0x0d /*return*/, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - - /*0x30*/ 0x09 /*tab*/, 0 /*0x0020 space*/, 0, 0x08 /*backspace*/, - /*0x34*/ 0x8d /*enter on laptops*/, 0x1b /*escape*/, 0, 0, - /*0x38*/ 0, 0, 0, 0, - /*0x3C*/ 0, 0, 0, 0, - - /*0x40*/ 0, 0xae /*kp-.*/, 0, 0xaa /*kp-**/, - /*0x44*/ 0, 0xab /*kp-+*/, 0, 0x0b /*clear*/, - /*0x48*/ 0, 0, 0, 0xaf /*kp-/*/, - /*0x4C*/ 0x8d /*kp-enter*/, 0, 0xad /*kp--*/, 0, - - /*0x50*/ 0, 0xbd /*kp-=*/, 0xb0 /*kp-0*/, 0xb1 /*kp-1*/, - /*0x54*/ 0xb2 /*kp-2*/, 0xb3 /*kp-3*/, 0xb4 /*kp-4*/, 0xb5 /*kp-5*/, - /*0x58*/ 0xb6 /*kp-6*/, 0xb7 /*kp-7*/, 0, 0xb8 /*kp-8*/, - /*0x5C*/ 0xb9 /*kp-9*/, 0, 0, 0, - - /*0x60*/ 0xc2 /*f5*/, 0xc3 /*f6*/, 0xc4 /*f7*/, 0xc0 /*f3*/, - /*0x64*/ 0xc5 /*f8*/, 0xc6 /*f9*/, 0, 0xc8 /*f11*/, - /*0x68*/ 0, 0xca /*f13*/, 0xcd /*f16*/, 0xcb /*f14*/, - /*0x6C*/ 0, 0xc7 /*f10*/, 0x0a /*fn+enter on laptops*/, 0xc9 /*f12*/, - - /*0x70*/ 0, 0xcc /*f15*/, 0x6a /*help*/, 0x50 /*home*/, - /*0x74*/ 0x55 /*pgup*/, 0xff /*delete*/, 0xc1 /*f4*/, 0x57 /*end*/, - /*0x78*/ 0xbf /*f2*/, 0x56 /*pgdown*/, 0xbe /*f1*/, 0x51 /*left*/, - /*0x7C*/ 0x53 /*right*/, 0x54 /*down*/, 0x52 /*up*/, 0 -}; - - -static int -keycode_to_xkeysym (int keyCode, int *xKeySym) -{ - *xKeySym = keycode_to_xkeysym_table [keyCode & 0x7f]; - return *xKeySym != 0; -} - -#ifdef MAC_OSX -/* Table for translating Mac keycode with the laptop `fn' key to that - without it. Destination symbols in comments are keys on US - keyboard, and they may not be the same on other types of keyboards. - If the destination is identical to the source (f1 ... f12), it - doesn't map `fn' key to a modifier. */ -static unsigned char fn_keycode_to_keycode_table[] = { - /*0x00*/ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - /*0x10*/ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - /*0x20*/ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - - /*0x30*/ 0, 0, 0, 0, - /*0x34*/ 0, 0, 0, 0, - /*0x38*/ 0, 0, 0, 0, - /*0x3C*/ 0, 0, 0, 0, - - /*0x40*/ 0, 0x2f /*kp-. -> '.'*/, 0, 0x23 /*kp-* -> 'p'*/, - /*0x44*/ 0, 0x2c /*kp-+ -> '/'*/, 0, 0x16 /*clear -> '6'*/, - /*0x48*/ 0, 0, 0, 0x1d /*kp-/ -> '0'*/, - /*0x4C*/ 0x24 /*kp-enter -> return*/, 0, 0x29 /*kp-- -> ';'*/, 0, - - /*0x50*/ 0, 0x1b /*kp-= -> '-'*/, 0x2e /*kp-0 -> 'm'*/, 0x26 /*kp-1 -> 'j'*/, - /*0x54*/ 0x28 /*kp-2 -> 'k'*/, 0x25 /*kp-3 -> 'l'*/, 0x20 /*kp-4 -> 'u'*/, 0x22 /*kp-5 ->'i'*/, - /*0x58*/ 0x1f /*kp-6 -> 'o'*/, 0x1a /*kp-7 -> '7'*/, 0, 0x1c /*kp-8 -> '8'*/, - /*0x5C*/ 0x19 /*kp-9 -> '9'*/, 0, 0, 0, - - /*0x60*/ 0x60 /*f5 = f5*/, 0x61 /*f6 = f6*/, 0x62 /*f7 = f7*/, 0x63 /*f3 = f3*/, - /*0x64*/ 0x64 /*f8 = f8*/, 0x65 /*f9 = f9*/, 0, 0x67 /*f11 = f11*/, - /*0x68*/ 0, 0, 0, 0, - /*0x6C*/ 0, 0x6d /*f10 = f10*/, 0, 0x6f /*f12 = f12*/, - - /*0x70*/ 0, 0, 0, 0x7b /*home -> left*/, - /*0x74*/ 0x7e /*pgup -> up*/, 0x33 /*delete -> backspace*/, 0x76 /*f4 = f4*/, 0x7c /*end -> right*/, - /*0x78*/ 0x78 /*f2 = f2*/, 0x7d /*pgdown -> down*/, 0x7a /*f1 = f1*/, 0, - /*0x7C*/ 0, 0, 0, 0 -}; -#endif /* MAC_OSX */ - #if !USE_CARBON_EVENTS static RgnHandle mouse_region = NULL; @@ -10679,7 +10681,6 @@ XTread_socket (sd, expected, hold_quit) case autoKey: { int keycode = (er.message & keyCodeMask) >> 8; - int xkeysym; static SInt16 last_key_script = -1; SInt16 current_key_script; UInt32 modifiers = er.modifiers, mapped_modifiers; @@ -10758,10 +10759,10 @@ XTread_socket (sd, expected, hold_quit) && fn_keycode_to_keycode_table[keycode]) keycode = fn_keycode_to_keycode_table[keycode]; #endif - if (keycode_to_xkeysym (keycode, &xkeysym)) + if (keycode <= 0x7f && keycode_to_xkeysym_table [keycode]) { inev.kind = NON_ASCII_KEYSTROKE_EVENT; - inev.code = 0xff00 | xkeysym; + inev.code = 0xff00 | keycode_to_xkeysym_table [keycode]; #ifdef MAC_OSX if (modifiers & kEventKeyModifierFnMask && keycode <= 0x7f @@ -11101,7 +11102,7 @@ mac_initialize_display_info () #ifdef MAC_OSX /* HasDepth returns true if it is possible to have a 32 bit display, but this may not be what is actually used. Mac OSX can do better. */ - dpyinfo->color_p = 1; + dpyinfo->color_p = CGDisplaySamplesPerPixel (kCGDirectMainDisplay) > 1; dpyinfo->n_planes = CGDisplayBitsPerPixel (kCGDirectMainDisplay); dpyinfo->height = CGDisplayPixelsHigh (kCGDirectMainDisplay); dpyinfo->width = CGDisplayPixelsWide (kCGDirectMainDisplay); @@ -11232,11 +11233,14 @@ x_delete_display (dpyinfo) xfree (dpyinfo->font_table[i].name); } - if (dpyinfo->font_table->font_encoder) - xfree (dpyinfo->font_table->font_encoder); - - xfree (dpyinfo->font_table); - xfree (dpyinfo->mac_id_name); + if (dpyinfo->font_table) + { + if (dpyinfo->font_table->font_encoder) + xfree (dpyinfo->font_table->font_encoder); + xfree (dpyinfo->font_table); + } + if (dpyinfo->mac_id_name) + xfree (dpyinfo->mac_id_name); if (x_display_list == 0) { diff --git a/src/msdos.c b/src/msdos.c index 636ac75d000..b6f6a75ac60 100644 --- a/src/msdos.c +++ b/src/msdos.c @@ -204,9 +204,9 @@ them. This happens with wheeled mice on Windows 9X, for example. */) CHECK_NUMBER (nbuttons); n = XINT (nbuttons); if (n < 2 || n > 3) - Fsignal (Qargs_out_of_range, - Fcons (build_string ("only 2 or 3 mouse buttons are supported"), - Fcons (nbuttons, Qnil))); + xsignal2 (Qargs_out_of_range, + build_string ("only 2 or 3 mouse buttons are supported"), + nbuttons); mouse_setup_buttons (n); return Qnil; } diff --git a/src/print.c b/src/print.c index 0a560dbc2d9..5f42683753d 100644 --- a/src/print.c +++ b/src/print.c @@ -1032,7 +1032,9 @@ error message is constructed. */) } /* Print an error message for the error DATA onto Lisp output stream - STREAM (suitable for the print functions). */ + STREAM (suitable for the print functions). + CONTEXT is a C string describing the context of the error. + CALLER is the Lisp function inside which the error was signaled. */ void print_error_message (data, stream, context, caller) diff --git a/src/puresize.h b/src/puresize.h index c1e4624564c..d0ba0c4e57e 100644 --- a/src/puresize.h +++ b/src/puresize.h @@ -43,7 +43,7 @@ Boston, MA 02110-1301, USA. */ #endif #ifndef BASE_PURESIZE -#define BASE_PURESIZE (1240000 + SYSTEM_PURESIZE_EXTRA + SITELOAD_PURESIZE_EXTRA) +#define BASE_PURESIZE (1124000 + SYSTEM_PURESIZE_EXTRA + SITELOAD_PURESIZE_EXTRA) #endif /* Increase BASE_PURESIZE by a ratio depending on the machine's word size. */ diff --git a/src/search.c b/src/search.c index fe124091009..5d532a9d8dd 100644 --- a/src/search.c +++ b/src/search.c @@ -83,6 +83,9 @@ static Lisp_Object last_thing_searched; Lisp_Object Qinvalid_regexp; +/* Error condition used for failing searches */ +Lisp_Object Qsearch_failed; + Lisp_Object Vsearch_spaces_regexp; static void set_search_regs (); @@ -179,7 +182,7 @@ compile_pattern_1 (cp, pattern, translate, regp, posix, multibyte) re_set_syntax (old); UNBLOCK_INPUT; if (val) - Fsignal (Qinvalid_regexp, Fcons (build_string (val), Qnil)); + xsignal1 (Qinvalid_regexp, build_string (val)); cp->regexp = Fcopy_sequence (pattern); } @@ -266,16 +269,6 @@ compile_pattern (pattern, regp, translate, posix, multibyte) return &cp->buf; } -/* Error condition used for failing searches */ -Lisp_Object Qsearch_failed; - -Lisp_Object -signal_failure (arg) - Lisp_Object arg; -{ - Fsignal (Qsearch_failed, Fcons (arg, Qnil)); - return Qnil; -} static Lisp_Object looking_at_1 (string, posix) @@ -948,7 +941,8 @@ search_command (string, bound, noerror, count, direction, RE, posix) if (np <= 0) { if (NILP (noerror)) - return signal_failure (string); + xsignal1 (Qsearch_failed, string); + if (!EQ (noerror, Qt)) { if (lim < BEGV || lim > ZV) diff --git a/src/sound.c b/src/sound.c index af2369040cc..6f955a7d691 100644 --- a/src/sound.c +++ b/src/sound.c @@ -990,6 +990,7 @@ alsa_configure (sd) struct sound_device *sd; { int val, err, dir; + unsigned uval; struct alsa_params *p = (struct alsa_params *) sd->data; snd_pcm_uframes_t buffer_size; @@ -1017,8 +1018,8 @@ alsa_configure (sd) if (err < 0) alsa_sound_perror ("Could not set sound format", err); - val = sd->sample_rate; - err = snd_pcm_hw_params_set_rate_near (p->handle, p->hwparams, &val, 0); + uval = sd->sample_rate; + err = snd_pcm_hw_params_set_rate_near (p->handle, p->hwparams, &uval, 0); if (err < 0) alsa_sound_perror ("Could not set sample rate", err); @@ -1123,7 +1124,7 @@ alsa_close (sd) snd_pcm_sw_params_free (p->swparams); if (p->handle) { - snd_pcm_drain(p->handle); + snd_pcm_drain (p->handle); snd_pcm_close (p->handle); } free (p); @@ -1269,7 +1270,8 @@ alsa_init (sd) err = snd_pcm_open (&handle, file, SND_PCM_STREAM_PLAYBACK, 0); snd_lib_error_set_handler (NULL); if (err < 0) - return 0; + return 0; + snd_pcm_close (handle); sd->fd = -1; sd->open = alsa_open; diff --git a/src/syntax.c b/src/syntax.c index 9959c17ad47..eee9151f878 100644 --- a/src/syntax.c +++ b/src/syntax.c @@ -2347,10 +2347,9 @@ scan_lists (from, count, depth, sexpflag) close1: if (!--depth) goto done; if (depth < min_depth) - Fsignal (Qscan_error, - Fcons (build_string ("Containing expression ends prematurely"), - Fcons (make_number (last_good), - Fcons (make_number (from), Qnil)))); + xsignal3 (Qscan_error, + build_string ("Containing expression ends prematurely"), + make_number (last_good), make_number (from)); break; case Sstring: @@ -2499,10 +2498,9 @@ scan_lists (from, count, depth, sexpflag) open2: if (!--depth) goto done2; if (depth < min_depth) - Fsignal (Qscan_error, - Fcons (build_string ("Containing expression ends prematurely"), - Fcons (make_number (last_good), - Fcons (make_number (from), Qnil)))); + xsignal3 (Qscan_error, + build_string ("Containing expression ends prematurely"), + make_number (last_good), make_number (from)); break; case Sendcomment: @@ -2571,12 +2569,9 @@ scan_lists (from, count, depth, sexpflag) return val; lose: - Fsignal (Qscan_error, - Fcons (build_string ("Unbalanced parentheses"), - Fcons (make_number (last_good), - Fcons (make_number (from), Qnil)))); - abort (); - /* NOTREACHED */ + xsignal3 (Qscan_error, + build_string ("Unbalanced parentheses"), + make_number (last_good), make_number (from)); } DEFUN ("scan-lists", Fscan_lists, Sscan_lists, 3, 3, 0, diff --git a/src/textprop.c b/src/textprop.c index 0318d12913f..fd70f039d22 100644 --- a/src/textprop.c +++ b/src/textprop.c @@ -78,6 +78,8 @@ Lisp_Object Vtext_property_default_nonsticky; Lisp_Object interval_insert_behind_hooks; Lisp_Object interval_insert_in_front_hooks; +static void text_read_only P_ ((Lisp_Object)) NO_RETURN; + /* Signal a `text-read-only' error. This function makes it easier to capture that error in GDB by putting a breakpoint on it. */ @@ -86,7 +88,10 @@ static void text_read_only (propval) Lisp_Object propval; { - Fsignal (Qtext_read_only, STRINGP (propval) ? Fcons (propval, Qnil) : Qnil); + if (STRINGP (propval)) + xsignal1 (Qtext_read_only, propval); + + xsignal0 (Qtext_read_only); } diff --git a/src/unexsol.c b/src/unexsol.c index 426a7f7cb99..9f919faedc0 100644 --- a/src/unexsol.c +++ b/src/unexsol.c @@ -24,7 +24,7 @@ unexec (char *new_name, char *old_name, unsigned int data_start, errstring = code_convert_string_norecord (build_string (dlerror ()), Vlocale_coding_system, 0); - Fsignal (Qfile_error, + xsignal (Qfile_error, Fcons (build_string ("Cannot unexec"), Fcons (errstring, data))); } diff --git a/src/w32.c b/src/w32.c index f11ffb7a785..c093eab599e 100644 --- a/src/w32.c +++ b/src/w32.c @@ -2256,16 +2256,17 @@ convert_time (FILETIME ft) SystemTimeToFileTime (&st, &utc_base_ft); utc_base = (long double) utc_base_ft.dwHighDateTime - * 4096 * 1024 * 1024 + utc_base_ft.dwLowDateTime; + * 4096.0L * 1024.0L * 1024.0L + utc_base_ft.dwLowDateTime; init = 1; } if (CompareFileTime (&ft, &utc_base_ft) < 0) return 0; - ret = (long double) ft.dwHighDateTime * 4096 * 1024 * 1024 + ft.dwLowDateTime; + ret = (long double) ft.dwHighDateTime + * 4096.0L * 1024.0L * 1024.0L + ft.dwLowDateTime; ret -= utc_base; - return (time_t) (ret * 1e-7); + return (time_t) (ret * 1e-7L); } void @@ -2700,6 +2701,9 @@ utime (const char *name, struct utimbuf *times) int (PASCAL *pfn_WSAStartup) (WORD wVersionRequired, LPWSADATA lpWSAData); void (PASCAL *pfn_WSASetLastError) (int iError); int (PASCAL *pfn_WSAGetLastError) (void); +int (PASCAL *pfn_WSAEventSelect) (SOCKET s, HANDLE hEventObject, long lNetworkEvents); +HANDLE (PASCAL *pfn_WSACreateEvent) (void); +int (PASCAL *pfn_WSACloseEvent) (HANDLE hEvent); int (PASCAL *pfn_socket) (int af, int type, int protocol); int (PASCAL *pfn_bind) (SOCKET s, const struct sockaddr *addr, int namelen); int (PASCAL *pfn_connect) (SOCKET s, const struct sockaddr *addr, int namelen); @@ -2769,7 +2773,7 @@ init_winsock (int load_now) = (void *) GetProcAddress (GetModuleHandle ("kernel32.dll"), "SetHandleInformation"); - winsock_lib = LoadLibrary ("wsock32.dll"); + winsock_lib = LoadLibrary ("Ws2_32.dll"); if (winsock_lib != NULL) { @@ -2782,6 +2786,9 @@ init_winsock (int load_now) LOAD_PROC( WSAStartup ); LOAD_PROC( WSASetLastError ); LOAD_PROC( WSAGetLastError ); + LOAD_PROC( WSAEventSelect ); + LOAD_PROC( WSACreateEvent ); + LOAD_PROC( WSACloseEvent ); LOAD_PROC( socket ); LOAD_PROC( bind ); LOAD_PROC( connect ); @@ -3295,6 +3302,8 @@ sys_listen (int s, int backlog) int rc = pfn_listen (SOCK_HANDLE (s), backlog); if (rc == SOCKET_ERROR) set_errno (); + else + fd_info[s].flags |= FILE_LISTEN; return rc; } h_errno = ENOTSOCK; @@ -3332,14 +3341,18 @@ sys_accept (int s, struct sockaddr * addr, int * addrlen) } check_errno (); - if (fd_info[s].flags & FILE_SOCKET) + if (fd_info[s].flags & FILE_LISTEN) { SOCKET t = pfn_accept (SOCK_HANDLE (s), addr, addrlen); - if (t != INVALID_SOCKET) - return socket_to_fd (t); + int fd = -1; + if (t == INVALID_SOCKET) + set_errno (); + else + fd = socket_to_fd (t); - set_errno (); - return -1; + fd_info[s].cp->status = STATUS_READ_ACKNOWLEDGED; + ResetEvent (fd_info[s].cp->char_avail); + return fd; } h_errno = ENOTSOCK; return -1; @@ -3641,6 +3654,36 @@ _sys_read_ahead (int fd) return cp->status; } +int _sys_wait_accept (int fd) +{ + HANDLE hEv; + child_process * cp; + int rc; + + if (fd < 0 || fd >= MAXDESC) + return STATUS_READ_ERROR; + + cp = fd_info[fd].cp; + + if (cp == NULL || cp->fd != fd || cp->status != STATUS_READ_READY) + return STATUS_READ_ERROR; + + cp->status = STATUS_READ_FAILED; + + hEv = pfn_WSACreateEvent (); + rc = pfn_WSAEventSelect (SOCK_HANDLE (fd), hEv, FD_ACCEPT); + if (rc != SOCKET_ERROR) + { + rc = WaitForSingleObject (hEv, INFINITE); + pfn_WSAEventSelect (SOCK_HANDLE (fd), NULL, 0); + pfn_WSACloseEvent (hEv); + if (rc == WAIT_OBJECT_0) + cp->status = STATUS_READ_SUCCEEDED; + } + + return cp->status; +} + int sys_read (int fd, char * buffer, unsigned int count) { diff --git a/src/w32.h b/src/w32.h index ecc986269fb..1d5dbee6d40 100644 --- a/src/w32.h +++ b/src/w32.h @@ -93,6 +93,7 @@ extern filedesc fd_info [ MAXDESC ]; /* fd_info flag definitions */ #define FILE_READ 0x0001 #define FILE_WRITE 0x0002 +#define FILE_LISTEN 0x0004 #define FILE_BINARY 0x0010 #define FILE_LAST_CR 0x0020 #define FILE_AT_EOF 0x0040 @@ -136,6 +137,9 @@ extern void syms_of_w32menu (void); extern void globals_of_w32menu (void); extern void syms_of_fontset (void); +extern int _sys_read_ahead (int fd); +extern int _sys_wait_accept (int fd); + #endif /* EMACS_W32_H */ /* arch-tag: 02c36b00-312b-4c4d-a1d9-f905c5e968f0 diff --git a/src/w32fns.c b/src/w32fns.c index 66cac34b2d9..68fcced88c2 100644 --- a/src/w32fns.c +++ b/src/w32fns.c @@ -2066,6 +2066,7 @@ w32_createwindow (f) { HWND hwnd; RECT rect; + Lisp_Object top, left; rect.left = rect.top = 0; rect.right = FRAME_PIXEL_WIDTH (f); @@ -2081,12 +2082,17 @@ w32_createwindow (f) w32_init_class (hinst); } + /* When called with RES_TYPE_NUMBER, w32_get_arg will return zero + for anything that is not a number and is not Qunbound. */ + left = w32_get_arg (Qnil, Qleft, "left", "Left", RES_TYPE_NUMBER); + top = w32_get_arg (Qnil, Qtop, "top", "Top", RES_TYPE_NUMBER); + FRAME_W32_WINDOW (f) = hwnd = CreateWindow (EMACS_CLASS, f->namebuf, f->output_data.w32->dwStyle | WS_CLIPCHILDREN, - CW_USEDEFAULT, - SW_SHOW, + EQ (left, Qunbound) ? CW_USEDEFAULT : XINT (left), + EQ (top, Qunbound) ? CW_USEDEFAULT : XINT (top), rect.right - rect.left, rect.bottom - rect.top, NULL, diff --git a/src/w32proc.c b/src/w32proc.c index a9e0e0cb83f..d874d183b17 100644 --- a/src/w32proc.c +++ b/src/w32proc.c @@ -1,6 +1,6 @@ /* Process support for GNU Emacs on the Microsoft W32 API. Copyright (C) 1992, 1995, 1999, 2000, 2001, 2002, 2003, 2004, - 2005, 2006 Free Software Foundation, Inc. + 2005, 2006 Free Software Foundation, Inc. This file is part of GNU Emacs. @@ -280,7 +280,10 @@ reader_thread (void *arg) { int rc; - rc = _sys_read_ahead (cp->fd); + if (fd_info[cp->fd].flags & FILE_LISTEN) + rc = _sys_wait_accept (cp->fd); + else + rc = _sys_read_ahead (cp->fd); /* The name char_avail is a misnomer - it really just means the read-ahead has completed, whether successfully or not. */ diff --git a/src/w32term.c b/src/w32term.c index fdbbbb6327f..b564ed3bd2b 100644 --- a/src/w32term.c +++ b/src/w32term.c @@ -5312,20 +5312,52 @@ x_calc_absolute_position (f) { int flags = f->size_hint_flags; - /* Treat negative positions as relative to the leftmost bottommost + /* The sum of the widths of the frame's left and right borders, and + the sum of the heights of the frame's top and bottom borders (in + pixels) drawn by Windows. */ + unsigned int left_right_borders_width, top_bottom_borders_height; + + /* Try to get the actual values of these two variables. We compute + the border width (height) by subtracting the width (height) of + the frame's client area from the width (height) of the frame's + entire window. */ + WINDOWPLACEMENT wp = { 0 }; + RECT client_rect = { 0 }; + + if (GetWindowPlacement (FRAME_W32_WINDOW (f), &wp) + && GetClientRect (FRAME_W32_WINDOW (f), &client_rect)) + { + left_right_borders_width = + (wp.rcNormalPosition.right - wp.rcNormalPosition.left) - + (client_rect.right - client_rect.left); + + top_bottom_borders_height = + (wp.rcNormalPosition.bottom - wp.rcNormalPosition.top) - + (client_rect.bottom - client_rect.top); + } + else + { + /* Use sensible default values. */ + left_right_borders_width = 8; + top_bottom_borders_height = 32; + } + + /* Treat negative positions as relative to the rightmost bottommost position that fits on the screen. */ if (flags & XNegative) f->left_pos = (FRAME_W32_DISPLAY_INFO (f)->width - FRAME_PIXEL_WIDTH (f) - + f->left_pos); + + f->left_pos + - (left_right_borders_width - 1)); if (flags & YNegative) f->top_pos = (FRAME_W32_DISPLAY_INFO (f)->height - FRAME_PIXEL_HEIGHT (f) - + f->top_pos); - /* The left_pos and top_pos - are now relative to the top and left screen edges, - so the flags should correspond. */ + + f->top_pos + - (top_bottom_borders_height - 1)); + + /* The left_pos and top_pos are now relative to the top and left + screen edges, so the flags should correspond. */ f->size_hint_flags &= ~ (XNegative | YNegative); } diff --git a/src/window.c b/src/window.c index 77e155675dd..879777d25e1 100644 --- a/src/window.c +++ b/src/window.c @@ -4961,9 +4961,9 @@ window_scroll_pixel_based (window, n, whole, noerror) else if (noerror) return; else if (n < 0) /* could happen with empty buffers */ - Fsignal (Qbeginning_of_buffer, Qnil); + xsignal0 (Qbeginning_of_buffer); else - Fsignal (Qend_of_buffer, Qnil); + xsignal0 (Qend_of_buffer); } else { @@ -4974,7 +4974,7 @@ window_scroll_pixel_based (window, n, whole, noerror) else if (noerror) return; else - Fsignal (Qbeginning_of_buffer, Qnil); + xsignal0 (Qbeginning_of_buffer); } /* If control gets here, then we vscrolled. */ @@ -5175,7 +5175,7 @@ window_scroll_line_based (window, n, whole, noerror) if (noerror) return; else - Fsignal (Qbeginning_of_buffer, Qnil); + xsignal0 (Qbeginning_of_buffer); } if (pos < ZV) @@ -5261,7 +5261,7 @@ window_scroll_line_based (window, n, whole, noerror) if (noerror) return; else - Fsignal (Qend_of_buffer, Qnil); + xsignal0 (Qend_of_buffer); } } diff --git a/src/xdisp.c b/src/xdisp.c index 092c5d7c520..76ab430386c 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -3867,7 +3867,7 @@ handle_single_display_spec (it, spec, object, position, { Lisp_Object form; Lisp_Object location, value; - struct text_pos start_pos; + struct text_pos start_pos, save_pos; int valid_p; /* If SPEC is a list of the form `(when FORM . VALUE)', evaluate FORM. @@ -4084,7 +4084,10 @@ handle_single_display_spec (it, spec, object, position, /* Save current settings of IT so that we can restore them when we are finished with the glyph property value. */ + save_pos = it->position; + it->position = *position; push_it (it); + it->position = save_pos; it->area = TEXT_AREA; it->what = IT_IMAGE; @@ -4158,7 +4161,11 @@ handle_single_display_spec (it, spec, object, position, { /* Save current settings of IT so that we can restore them when we are finished with the glyph property value. */ + save_pos = it->position; + it->position = *position; push_it (it); + it->position = save_pos; + if (NILP (location)) it->area = TEXT_AREA; else if (EQ (location, Qleft_margin)) @@ -4969,6 +4976,12 @@ pop_it (it) case GET_FROM_STRETCH: it->object = p->u.comp.object; break; + case GET_FROM_BUFFER: + it->object = it->w->buffer; + break; + case GET_FROM_STRING: + it->object = it->string; + break; } it->end_charpos = p->end_charpos; it->string_nchars = p->string_nchars; @@ -5288,7 +5301,6 @@ reseat_1 (it, pos, set_stop_p) xassert (CHARPOS (pos) >= BEGV && CHARPOS (pos) <= ZV); it->current.pos = it->position = pos; - XSETBUFFER (it->object, current_buffer); it->end_charpos = ZV; it->dpvec = NULL; it->current.dpvec_index = -1; @@ -5786,14 +5798,12 @@ set_iterator_to_next (it, reseat_p) { IT_STRING_BYTEPOS (*it) += it->len; IT_STRING_CHARPOS (*it) += it->cmp_len; - it->object = it->string; goto consider_string_end; } else if (it->method == GET_FROM_BUFFER) { IT_BYTEPOS (*it) += it->len; IT_CHARPOS (*it) += it->cmp_len; - it->object = it->w->buffer; } break; @@ -6033,9 +6043,7 @@ next_element_from_string (it) } } - /* Record what we have and where it came from. Note that we store a - buffer position in IT->position although it could arguably be a - string position. */ + /* Record what we have and where it came from. */ it->what = IT_CHARACTER; it->object = it->string; it->position = position; @@ -6750,6 +6758,10 @@ move_it_to (it, to_charpos, to_x, to_y, to_vpos, op) if (reached) break; } + else if (BUFFERP (it->object) + && it->method == GET_FROM_BUFFER + && IT_CHARPOS (*it) >= to_charpos) + skip = MOVE_POS_MATCH_OR_ZV; else skip = move_it_in_display_line_to (it, to_charpos, -1, MOVE_TO_POS); @@ -16553,6 +16565,7 @@ display_mode_line (w, face_id, format) kboard-local variables in the mode_line_format will get the right values. */ push_kboard (FRAME_KBOARD (it.f)); + record_unwind_save_match_data (); display_mode_element (&it, 0, 0, 0, format, Qnil, 0); pop_kboard (); diff --git a/src/xfaces.c b/src/xfaces.c index 398b56f42b6..18e5d9a6119 100644 --- a/src/xfaces.c +++ b/src/xfaces.c @@ -489,7 +489,6 @@ static int font_scalable_p P_ ((struct font_name *)); static int get_lface_attributes P_ ((struct frame *, Lisp_Object, Lisp_Object *, int)); static int load_pixmap P_ ((struct frame *, Lisp_Object, unsigned *, unsigned *)); static unsigned char *xstrlwr P_ ((unsigned char *)); -static void signal_error P_ ((char *, Lisp_Object)); static struct frame *frame_or_selected_frame P_ ((Lisp_Object, int)); static void load_face_font P_ ((struct frame *, struct face *, int)); static void load_face_colors P_ ((struct frame *, struct face *, Lisp_Object *)); @@ -858,17 +857,6 @@ xstrlwr (s) } -/* Signal `error' with message S, and additional argument ARG. */ - -static void -signal_error (s, arg) - char *s; - Lisp_Object arg; -{ - Fsignal (Qerror, Fcons (build_string (s), Fcons (arg, Qnil))); -} - - /* If FRAME is nil, return a pointer to the selected frame. Otherwise, check that FRAME is a live frame, and return a pointer to it. NPARAM is the parameter number of FRAME, for @@ -3290,7 +3278,7 @@ resolve_face_name (face_name, signal_p) if (EQ (hare, tortoise)) { if (signal_p) - Fsignal (Qcircular_list, Fcons (orig_face, Qnil)); + xsignal1 (Qcircular_list, orig_face); return Qdefault; } } diff --git a/src/xfns.c b/src/xfns.c index 0e4b8860464..3cadc8504f4 100644 --- a/src/xfns.c +++ b/src/xfns.c @@ -770,9 +770,7 @@ x_decode_color (f, color_name, mono_color) if (x_defined_color (f, SDATA (color_name), &cdef, 1)) return cdef.pixel; - Fsignal (Qerror, Fcons (build_string ("Undefined color"), - Fcons (color_name, Qnil))); - return 0; + signal_error ("Undefined color", color_name); } diff --git a/src/xselect.c b/src/xselect.c index 5e6ffd806f0..211d207bac4 100644 --- a/src/xselect.c +++ b/src/xselect.c @@ -562,11 +562,9 @@ x_get_local_selection (selection_symbol, target_type, local_request) && INTEGERP (XCAR (XCDR (check))) && NILP (XCDR (XCDR (check)))))) return value; - else - return - Fsignal (Qerror, - Fcons (build_string ("invalid data returned by selection-conversion function"), - Fcons (handler_fn, Fcons (value, Qnil)))); + + signal_error ("Invalid data returned by selection-conversion function", + list2 (handler_fn, value)); } /* Subroutines of x_reply_selection_request. */ @@ -1356,8 +1354,7 @@ copy_multiple_data (obj) CHECK_VECTOR (vec2); if (XVECTOR (vec2)->size != 2) /* ??? Confusing error message */ - Fsignal (Qerror, Fcons (build_string ("vectors must be of length 2"), - Fcons (vec2, Qnil))); + signal_error ("Vectors must be of length 2", vec2); XVECTOR (vec)->contents [i] = Fmake_vector (2, Qnil); XVECTOR (XVECTOR (vec)->contents [i])->contents [0] = XVECTOR (vec2)->contents [0]; @@ -1734,19 +1731,15 @@ x_get_window_property_as_lisp_data (display, window, property, target_type, there_is_a_selection_owner = XGetSelectionOwner (display, selection_atom); UNBLOCK_INPUT; - Fsignal (Qerror, - there_is_a_selection_owner - ? Fcons (build_string ("selection owner couldn't convert"), - actual_type - ? Fcons (target_type, - Fcons (x_atom_to_symbol (display, - actual_type), - Qnil)) - : Fcons (target_type, Qnil)) - : Fcons (build_string ("no selection"), - Fcons (x_atom_to_symbol (display, - selection_atom), - Qnil))); + if (there_is_a_selection_owner) + signal_error ("Selection owner couldn't convert", + actual_type + ? list2 (target_type, + x_atom_to_symbol (display, actual_type)) + : target_type); + else + signal_error ("No selection", + x_atom_to_symbol (display, selection_atom)); } if (actual_type == dpyinfo->Xatom_INCR) @@ -1946,10 +1939,7 @@ lisp_data_to_selection_data (display, obj, { if (SCHARS (obj) < SBYTES (obj)) /* OBJ is a multibyte string containing a non-ASCII char. */ - Fsignal (Qerror, /* Qselection_error */ - Fcons (build_string - ("Non-ASCII string must be encoded in advance"), - Fcons (obj, Qnil))); + signal_error ("Non-ASCII string must be encoded in advance", obj); if (NILP (type)) type = QSTRING; *format_ret = 8; @@ -2010,10 +2000,7 @@ lisp_data_to_selection_data (display, obj, (*(Atom **) data_ret) [i] = symbol_to_x_atom (dpyinfo, display, XVECTOR (obj)->contents [i]); else - Fsignal (Qerror, /* Qselection_error */ - Fcons (build_string - ("all elements of selection vector must have same type"), - Fcons (obj, Qnil))); + signal_error ("All elements of selection vector must have same type", obj); } #if 0 /* #### MULTIPLE doesn't work yet */ else if (VECTORP (XVECTOR (obj)->contents [0])) @@ -2029,10 +2016,9 @@ lisp_data_to_selection_data (display, obj, { Lisp_Object pair = XVECTOR (obj)->contents [i]; if (XVECTOR (pair)->size != 2) - Fsignal (Qerror, - Fcons (build_string - ("elements of the vector must be vectors of exactly two elements"), - Fcons (pair, Qnil))); + signal_error ( + "Elements of the vector must be vectors of exactly two elements", + pair); (*(Atom **) data_ret) [i * 2] = symbol_to_x_atom (dpyinfo, display, @@ -2042,10 +2028,8 @@ lisp_data_to_selection_data (display, obj, XVECTOR (pair)->contents [1]); } else - Fsignal (Qerror, - Fcons (build_string - ("all elements of the vector must be of the same type"), - Fcons (obj, Qnil))); + signal_error ("All elements of the vector must be of the same type", + obj); } #endif @@ -2060,10 +2044,9 @@ lisp_data_to_selection_data (display, obj, if (CONSP (XVECTOR (obj)->contents [i])) *format_ret = 32; else if (!INTEGERP (XVECTOR (obj)->contents [i])) - Fsignal (Qerror, /* Qselection_error */ - Fcons (build_string - ("elements of selection vector must be integers or conses of integers"), - Fcons (obj, Qnil))); + signal_error (/* Qselection_error */ + "Elements of selection vector must be integers or conses of integers", + obj); /* Use sizeof(long) even if it is more than 32 bits. See comment in x_get_window_property and x_fill_property_data. */ @@ -2080,9 +2063,7 @@ lisp_data_to_selection_data (display, obj, } } else - Fsignal (Qerror, /* Qselection_error */ - Fcons (build_string ("unrecognized selection data"), - Fcons (obj, Qnil))); + signal_error (/* Qselection_error */ "Unrecognized selection data", obj); *type_ret = symbol_to_x_atom (dpyinfo, display, type); } @@ -2371,15 +2352,13 @@ initialize_cut_buffers (display, window) #define CHECK_CUT_BUFFER(symbol) \ - { CHECK_SYMBOL ((symbol)); \ + do { CHECK_SYMBOL ((symbol)); \ if (!EQ((symbol), QCUT_BUFFER0) && !EQ((symbol), QCUT_BUFFER1) \ && !EQ((symbol), QCUT_BUFFER2) && !EQ((symbol), QCUT_BUFFER3) \ && !EQ((symbol), QCUT_BUFFER4) && !EQ((symbol), QCUT_BUFFER5) \ && !EQ((symbol), QCUT_BUFFER6) && !EQ((symbol), QCUT_BUFFER7)) \ - Fsignal (Qerror, \ - Fcons (build_string ("doesn't name a cut buffer"), \ - Fcons ((symbol), Qnil))); \ - } + signal_error ("Doesn't name a cut buffer", (symbol)); \ + } while (0) DEFUN ("x-get-cut-buffer-internal", Fx_get_cut_buffer_internal, Sx_get_cut_buffer_internal, 1, 1, 0, @@ -2416,10 +2395,9 @@ DEFUN ("x-get-cut-buffer-internal", Fx_get_cut_buffer_internal, return Qnil; if (format != 8 || type != XA_STRING) - Fsignal (Qerror, - Fcons (build_string ("cut buffer doesn't contain 8-bit data"), - Fcons (x_atom_to_symbol (display, type), - Fcons (make_number (format), Qnil)))); + signal_error ("Cut buffer doesn't contain 8-bit data", + list2 (x_atom_to_symbol (display, type), + make_number (format))); ret = (bytes ? make_unibyte_string ((char *) data, bytes) : Qnil); /* Use xfree, not XFree, because x_get_window_property diff --git a/src/xterm.c b/src/xterm.c index 14e71fffa80..9c0b25b08bf 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -363,7 +363,7 @@ static void x_check_expected_move P_ ((struct frame *, int, int)); static void x_sync_with_move P_ ((struct frame *, int, int, int)); static int handle_one_xevent P_ ((struct x_display_info *, XEvent *, int *, struct input_event *)); -static SIGTYPE x_connection_closed P_ ((Display *, char *)); +static SIGTYPE x_connection_closed P_ ((Display *, char *)) NO_RETURN; /* Flush display of frame F, or of all frames if F is null. */ @@ -7807,7 +7807,7 @@ x_connection_closed (dpy, error_message) /* We specifically use it before defining it, so that gcc doesn't inline it, otherwise gdb doesn't know how to properly put a breakpoint on it. */ -static void x_error_quitter (Display *display, XErrorEvent *error); +static void x_error_quitter P_ ((Display *, XErrorEvent *)) NO_RETURN; /* This is the first-level handler for X protocol errors. It calls x_error_quitter or x_error_catcher. */ |