diff options
| author | Karoly Lorentey <lorentey@elte.hu> | 2006-07-14 05:56:32 +0000 |
|---|---|---|
| committer | Karoly Lorentey <lorentey@elte.hu> | 2006-07-14 05:56:32 +0000 |
| commit | 99715bbc447eb633e45ffa23b87284771ce3ac74 (patch) | |
| tree | 3a8a53dfe3dbdd9f8e36965e9f043eae522d3c0e /src | |
| parent | 556b89447234f15d1784a23dadbfe429464463a8 (diff) | |
| parent | 763bb2d43615bc3ae816422f965d76d5e1ae4bdd (diff) | |
| download | emacs-99715bbc447eb633e45ffa23b87284771ce3ac74.tar.gz emacs-99715bbc447eb633e45ffa23b87284771ce3ac74.tar.bz2 emacs-99715bbc447eb633e45ffa23b87284771ce3ac74.zip | |
Merged from emacs@sv.gnu.org.
Patches applied:
* emacs@sv.gnu.org/emacs--devo--0--patch-331
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-332
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-333
Merge from gnus--rel--5.10
* emacs@sv.gnu.org/emacs--devo--0--patch-334
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-335
Add note about "link" button-class to etc/TODO
* emacs@sv.gnu.org/emacs--devo--0--patch-336
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-337
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-338
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-339
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-340
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-341
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-342
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-343
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-344
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-345
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-346
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-347
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-348
Update for ERC 5.1.3.
* emacs@sv.gnu.org/emacs--devo--0--patch-349
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-350
Merge from gnus--rel--5.10
* emacs@sv.gnu.org/gnus--rel--5.10--patch-111
Update from CVS: texi/gnus.texi (Summary Buffer Lines): Fix typo.
* emacs@sv.gnu.org/gnus--rel--5.10--patch-112
Update from CVS
* emacs@sv.gnu.org/gnus--rel--5.10--patch-113
Merge from emacs--devo--0
* emacs@sv.gnu.org/gnus--rel--5.10--patch-114
Update from CVS
git-archimport-id: lorentey@elte.hu--2004/emacs--multi-tty--0--patch-572
Diffstat (limited to 'src')
| -rw-r--r-- | src/ChangeLog | 288 | ||||
| -rw-r--r-- | src/Makefile.in | 6 | ||||
| -rw-r--r-- | src/bytecode.c | 69 | ||||
| -rw-r--r-- | src/callint.c | 12 | ||||
| -rw-r--r-- | src/casefiddle.c | 108 | ||||
| -rw-r--r-- | src/casetab.c | 7 | ||||
| -rw-r--r-- | src/category.c | 4 | ||||
| -rw-r--r-- | src/category.h | 12 | ||||
| -rw-r--r-- | src/data.c | 88 | ||||
| -rw-r--r-- | src/dired.c | 3 | ||||
| -rw-r--r-- | src/dispextern.h | 1 | ||||
| -rw-r--r-- | src/dispnew.c | 109 | ||||
| -rw-r--r-- | src/editfns.c | 48 | ||||
| -rw-r--r-- | src/eval.c | 83 | ||||
| -rw-r--r-- | src/fileio.c | 20 | ||||
| -rw-r--r-- | src/fns.c | 131 | ||||
| -rw-r--r-- | src/fontset.c | 2 | ||||
| -rw-r--r-- | src/frame.h | 17 | ||||
| -rw-r--r-- | src/fringe.c | 4 | ||||
| -rw-r--r-- | src/insdel.c | 20 | ||||
| -rw-r--r-- | src/keyboard.c | 58 | ||||
| -rw-r--r-- | src/keymap.c | 6 | ||||
| -rw-r--r-- | src/lisp.h | 106 | ||||
| -rw-r--r-- | src/lread.c | 18 | ||||
| -rw-r--r-- | src/mac.c | 5 | ||||
| -rw-r--r-- | src/macfns.c | 3 | ||||
| -rw-r--r-- | src/macgui.h | 2 | ||||
| -rw-r--r-- | src/macros.c | 5 | ||||
| -rw-r--r-- | src/macterm.c | 93 | ||||
| -rw-r--r-- | src/marker.c | 3 | ||||
| -rw-r--r-- | src/minibuf.c | 2 | ||||
| -rw-r--r-- | src/process.c | 4 | ||||
| -rw-r--r-- | src/s/gnu-linux.h | 1 | ||||
| -rw-r--r-- | src/search.c | 3 | ||||
| -rw-r--r-- | src/sunfns.c | 2 | ||||
| -rw-r--r-- | src/syntax.c | 46 | ||||
| -rw-r--r-- | src/textprop.c | 11 | ||||
| -rw-r--r-- | src/w32console.c | 2 | ||||
| -rw-r--r-- | src/w32fns.c | 9 | ||||
| -rw-r--r-- | src/w32term.c | 17 | ||||
| -rw-r--r-- | src/window.c | 14 | ||||
| -rw-r--r-- | src/xdisp.c | 44 | ||||
| -rw-r--r-- | src/xfaces.c | 14 | ||||
| -rw-r--r-- | src/xfns.c | 4 | ||||
| -rw-r--r-- | src/xterm.c | 15 |
45 files changed, 906 insertions, 613 deletions
diff --git a/src/ChangeLog b/src/ChangeLog index 91694368fe0..8437853d887 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,291 @@ +2006-07-13 Kim F. Storm <storm@cua.dk> + + * bytecode.c (Fbyte_code): Use CAR, CDR for Bcar, Bcdr. + Use CAR_SAFE, CDR_SAFE for Bcar_safe, Bcdr_safe. + Simplify loops and use CAR for Bnth and Belt. + + * data.c (Findirect_function): Optimize for no indirection. + + * eval.c (Fthrow): Remove loop around Fsignal. + (Feval, Fapply, Ffuncall): Optimize for no function indirection. + Use original function name in all signaled errors. + Simplify Fsignal calls (no return). + (funcall_lambda): Simplify Fsignal calls (no return). + +2006-07-13 Andreas Schwab <schwab@suse.de> + + * syntax.c (scan_sexps_forward): Use EMACS_INT for out_bytepos and + out_charpos. + +2006-07-13 Kenichi Handa <handa@m17n.org> + + * editfns.c (Fformat): Fix calculation of text property positions + of format string. + +2006-07-12 Kim F. Storm <storm@cua.dk> + + * lisp.h (CHECK_TYPE): New macro for generic type checking. + (CAR_SAFE, CDR_SAFE): New macros. + (ARRAYP, CHECK_ARRAY): New macros. + (CHECK_VECTOR_OR_STRING, CHECK_SUBR): New macros. + (CHECK_WINDOW_CONFIGURATION): New macro. + (CHECK_LIST_CONS, CHECK_LIST_END): New checks for list traversal. + (CHECK_STRING_OR_BUFFER, CHECK_HASH_TABLE, CHECK_LIST) + (CHECK_STRING, CHECK_STRING_CAR, CHECK_CONS, CHECK_SYMBOL) + (CHECK_CHAR_TABLE, CHECK_VECTOR, CHECK_VECTOR_OR_CHAR_TABLE) + (CHECK_BUFFER, CHECK_WINDOW, CHECK_LIVE_WINDOW, CHECK_PROCESS) + (CHECK_NUMBER, CHECK_NATNUM, CHECK_MARKER, CHECK_OVERLAY) + (CHECK_NUMBER_COERCE_MARKER, CHECK_FLOAT, CHECK_NUMBER_OR_FLOAT) + (CHECK_NUMBER_OR_FLOAT_COERCE_MARKER): Use CHECK_TYPE. + + * category.h (CHECK_CATEGORY, CHECK_CATEGORY_SET): + * frame.h (CHECK_FRAME, CHECK_LIVE_FRAME): Use CHECK_TYPE. + + * callint.c (Fcall_interactively): + * casefiddle.c (casify_object): + * editfns.c (general_insert_function): + * fns.c (Flength, Felt, Ffillarray): + * data.c (Fcar, Fcdr): Remove loop around wrong_type_argument. + + * data.c (wrong_type_argument): Remove loop around Fsignal. + (Farrayp, Fsequencep): Use ARRAYP. + (Fcar): Use CAR. + (Fcar_safe): Use CAR_SAFE. + (Fcdr): Use CDR. + (Fcdr_safe): Use CDR_SAFE. + (Fsetcar, Fsetcdr): Use CHECK_CONS. + (Fsubr_arity, Fsubr_name): Use CHECK_SUBR. + (Faset): Use CHECK_ARRAY. + + * fns.c (Felt): Use CHECK_ARRAY. + (concat): Use CHECK_NUMBER. + (Fsubstring, substring_both): Use CHECK_VECTOR_OR_STRING. + (Fmemq): Use CHECK_LIST. + (Fassq, Fassoc, Frassq, Frassoc): Use CAR. + (assq_no_quit): Use CAR_SAFE. + (Fnthcdr, Fmember, Fdelq, Fdelete, Fnreverse, Fnconc): + Use CHECK_LIST_CONS. + (Freverse, Fplist_get, Flax_plist_get): Use CHECK_LIST_END. + + * bytecode.c (Fbyte_code): Use CHECK_VECTOR. + + * casetab.c (check_case_table): + * category.c (check_category_table): + * marker.c (Fcopy_marker): + * syntax.c (check_syntax_table): + * xfaces.c (load_pixmap): Use CHECK_TYPE. + + * fns.c (Fcopy_sequence, concat): + * fringe.c (Fdefine_fringe_bitmap): + * lread.c (check_obarray): Cleanup wrong_type_argument use. + + * keyboard.c (access_keymap_keyremap): Use ARRAYP. + + * keymap.c (Fdefine_key, Flookup_key): + * macros.c (Fstart_kbd_macro): Use CHECK_VECTOR_OR_STRING. + + * mac.c (Fmac_get_preference): Use CHECK_LIST_END. + + * search.c (Fset_match_data): Use CHECK_LIST. + + * sunfns.c (sun_item_create): Use CHECK_LIST_CONS. + + * window.c (Fwindow_configuration_frame, Fset_window_configuration): + (compare_window_configurations): Use CHECK_WINDOW_CONFIGURATION. + +2006-07-12 YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp> + + * Makefile.in (dired.o, editfns.o, fileio.o): Depend on blockinput.h. + + * dired.c: Include blockinput.h. + (Ffile_attributes): Add BLOCK_INPUT around getpwuid/getgrgid. + + * editfns.c: Include blockinput.h. + (Fuser_login_name, Fuser_full_name): Add BLOCK_INPUT around + getpwuid/getpwnam. + + * fileio.c: Include blockinput.h. + (Fexpand_file_name, search_embedded_absfilename): Add BLOCK_INPUT + around getpwnam. + (search_embedded_absfilename): Remove spurious xfree. + +2006-07-11 Kim F. Storm <storm@cua.dk> + + * dispnew.c (sit_for): Reduce number of args from 5 to 3. + Now just one TIMEOUT arg that can be a Lisp float or Lisp int. + Combine args DISPLAY and INITIAL_DISPLAY into one arg DO_DISPLAY. + Signal error if TIMEOUT is not a number. + Undo 2006-06-14 change for non-preemptive display if TIMEOUT < 0. + The rework of sit_for args also fixes several incorrect Qt args + which should have been 1. + (Fredisplay): Pass 1 instead of Qt to swallow_events and + detect_input_pending_run_timers. + + * lisp.h (sit_for): Update prototype. + (Fredisplay): Add EXFUN. + + * dispextern.h (sit_for): Remove prototype. + + * callint.c (Fcall_interactively): + * minibuf.c (temp_echo_area_glyphs): + * keyboard.c (command_loop_1, read_char, Fexecute_extended_command): + * fileio.c (Fdo_auto_save): Update/simplify sit_for calls. + +2006-07-11 Stefan Monnier <monnier@iro.umontreal.ca> + + * syntax.c (forw_comment): Also use EMACS_INT for buffer positions. + +2006-07-11 Kim F. Storm <storm@cua.dk> + + * dispnew.c (Fredisplay): Add FORCE argument to force redisplay when + input is available. Fix test for redisplay_dont_pause non-nil. + Specbind redisplay-dont-pause to t if FORCE non-nil. + +2006-07-10 Chong Yidong <cyd@stupidchicken.com> + + * puresize.h (BASE_PURESIZE): Increment to 1211000. + + * dispnew.c (Fredisplay): New function, equivalent to (sit-for 0). + (Fsit_for): Function deleted. + + * keyboard.c (command_loop_1, Fexecute_extended_command): + Call sit_for instead of Fsit_for. + + * minibuf.c (temp_echo_area_glyphs): Likewise. + +2006-07-09 Stefan Monnier <monnier@iro.umontreal.ca> + + * syntax.c (Fforward_comment): Revert the reversion. + (back_comment, scan_lists): Also use EMACS_INT for buffer positions. + +2006-07-09 John Paul Wallington <jpw@pobox.com> + + * syntax.c (Fforward_comment): Revert previous change. + +2006-07-09 Kim F. Storm <storm@cua.dk> + + * window.c (Fforce_window_update): Doc fix. + +2006-07-08 Stephen Gildea <gildea@stop.mail-abuse.org> + + * fileio.c (do_auto_save_make_dir): Make the auto-save-list-file + directory unreadable for better user privacy. + +2006-07-07 Stefan Monnier <monnier@iro.umontreal.ca> + + * syntax.c (Fforward_comment): Fix int-32 vs EMACS_INT-64 mixup. + + * lread.c (read_filtered_event): Remove `register' qualifier because it + causes compilation problem with gcc-4.0.2-20051125 on amd64. + (readevalloop): Remove unused var `bpos'. + Yet another int/Lisp_Object mixup (YAILOM). + +2006-07-07 Eli Zaretskii <eliz@gnu.org> + + * keyboard.c (Fexecute_extended_command): Mention the argument + PREFIXARG in the doc string. + +2006-07-07 Kim F. Storm <storm@cua.dk> + + * fringe.c (Fdefine_fringe_bitmap): Doc fix. + +2006-07-05 Chong Yidong <cyd@stupidchicken.com> + + * insdel.c (prepare_to_modify_buffer): For an indirect buffer, do + clash detection using the base buffer. + + * puresize.h (BASE_PURESIZE): Increment to 1210500. + +2006-07-04 Kim F. Storm <storm@cua.dk> + + * xterm.c (x_delete_display): Don't free or derefence NULL pointers. + +2006-07-04 Kenichi Handa <handa@m17n.org> + + * fontset.c (Fset_overriding_fontspec_internal): Check if we need + to update Voverriding_fontspec_alist. + +2006-07-03 Richard Stallman <rms@gnu.org> + + * xfns.c (Fx_create_frame): Move unwind_create_frame setup down. + + * xfaces.c (Fface_attribute_relative_p): Doc fix. + + * textprop.c (Fget_char_property_and_overlay): Doc fix. + + * eval.c (Fdefvaralias): Doc fix. + +2006-07-03 Kim F. Storm <storm@cua.dk> + + * dispnew.c (sit_for): Fix preempt condition. + +2006-07-02 Stefan Monnier <monnier@iro.umontreal.ca> + + * lread.c (read_filtered_event): Treat select-window just like + switch-frame. + +2006-07-02 Kim F. Storm <storm@cua.dk> + + * xdisp.c (display_tool_bar_line): Skip glyphs which are too big + to ever fit the tool-bar, + (MAX_FRAME_TOOL_BAR_HEIGHT): New macro. + (tool_bar_lines_needed): Use unused mode-line row as temp_row. + (redisplay_tool_bar): Only clear desired matrix if we actually + change the tool-bar window height. Only try to make the tool-bar + window bigger if there is actually room for it. + +2006-06-30 Ralf Angeli <angeli@caeruleus.net> + + * w32term.c (x_make_frame_visible): Use SystemParametersInfo with + SPI_GETWORKAREA to find the dimensions of the screen work area, + and adjust vertical position of the frame in order to avoid being + covered by the task bar. + + * w32fns.c (w32_createwindow): Use CW_USEDEFAULT instead of + f->left_pos and SH_SHOW instead of f->top_pos in the call to + CreateWindow. Record the actual position in f->left_pos and + f->top_pos. + +2006-06-30 John Paul Wallington <jpw@pobox.com> + + * w32console.c (syms_of_ntterm) <w32-use-full-screen-buffer>: + Doc fix - default value has changed. + +2006-06-28 YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp> + + * mac.c [!TARGET_API_MAC_CARBON]: Don't include FixMath.h or Scrap.h. + + * macfns.c (Fx_create_frame): Apply 2006-06-24 change for xfns.c. + + * macgui.h (USE_MAC_TSM) [TARGET_API_MAC_CARBON]: Set default to 1. + + * macterm.c (Qeql): Add extern. + (x_set_mouse_pixel_position) [MAC_OSX]: Use CGWarpMouseCursorPosition. + (fm_style_face_attributes_alist) [USE_ATSUI]: New variable. + (syms_of_macterm) [USE_ATSUI]: Initialize and staticpro it. + Change keys of Vmac_atsu_font_table from strings to numbers. + (fm_style_to_face_attributes) [USE_ATSUI]: New function. + (init_font_name_table) [USE_ATSUI]: Use it. + (saved_ts_script_language_on_focus) [USE_MAC_TSM]: New variable. + (syms_of_macterm) [USE_MAC_TSM]: Initialize and staticpro it. + [USE_MAC_TSM] (mac_tsm_resume): Restore script and language codes + only when saved_ts_script_language_on_focus coincides with + Vmac_ts_script_language_on_focus. + [USE_MAC_TSM] (mac_tsm_suspend): Save value of + Vmac_ts_script_language_on_focus to saved_ts_script_language_on_focus. + (XTread_socket) [USE_MAC_TSM]: Add Mac OS Classic support. + [USE_MAC_TSM] (mac_handle_text_input_event, init_tsm): Likewise. + +2006-06-27 Chong Yidong <cyd@stupidchicken.com> + + * editfns.c (Fdelete_field, Ffield_string, Ffield_beginning) + (Ffield_string_no_properties, Ffield_end): Mention + args-out-of-range error condition in docstring. + +2006-06-27 Kim F. Storm <storm@cua.dk> + + * xdisp.c (handle_composition_prop): Set stop_charpos before push_it. + 2006-06-25 Kim F. Storm <storm@cua.dk> * s/gnu-linux.h (SIGNALS_VIA_CHARACTERS): Define for Linux kernel diff --git a/src/Makefile.in b/src/Makefile.in index 89096b93b2d..cb9db5614a1 100644 --- a/src/Makefile.in +++ b/src/Makefile.in @@ -1114,7 +1114,7 @@ pre-crt0.o: pre-crt0.c ecrt0.o: ecrt0.c $(config_h) CRT0_COMPILE ${srcdir}/ecrt0.c dired.o: dired.c commands.h buffer.h $(config_h) charset.h coding.h regex.h \ - systime.h + systime.h blockinput.h dispnew.o: dispnew.c systime.h commands.h process.h frame.h \ window.h buffer.h dispextern.h termchar.h termopts.h termhooks.h cm.h \ disptab.h indent.h intervals.h \ @@ -1125,12 +1125,12 @@ doprnt.o: doprnt.c charset.h $(config_h) dosfns.o: buffer.h termchar.h termhooks.h frame.h blockinput.h window.h \ msdos.h dosfns.h dispextern.h charset.h coding.h $(config_h) editfns.o: editfns.c window.h buffer.h systime.h $(INTERVAL_SRC) charset.h \ - coding.h dispextern.h frame.h $(config_h) + coding.h dispextern.h frame.h blockinput.h $(config_h) emacs.o: emacs.c commands.h systty.h syssignal.h blockinput.h process.h \ termhooks.h buffer.h atimer.h systime.h $(INTERVAL_SRC) $(config_h) \ window.h dispextern.h keyboard.h keymap.h fileio.o: fileio.c window.h buffer.h systime.h $(INTERVAL_SRC) charset.h \ - coding.h ccl.h msdos.h dispextern.h $(config_h) + coding.h msdos.h dispextern.h blockinput.h $(config_h) filelock.o: filelock.c buffer.h charset.h coding.h systime.h epaths.h $(config_h) filemode.o: filemode.c $(config_h) frame.o: frame.c xterm.h window.h frame.h termhooks.h commands.h keyboard.h \ diff --git a/src/bytecode.c b/src/bytecode.c index 0d06890eabf..2facaa47062 100644 --- a/src/bytecode.c +++ b/src/bytecode.c @@ -433,8 +433,7 @@ If the third argument is incorrect, Emacs may crash. */) #endif CHECK_STRING (bytestr); - if (!VECTORP (vector)) - vector = wrong_type_argument (Qvectorp, vector); + CHECK_VECTOR (vector); CHECK_NUMBER (maxdepth); if (STRING_MULTIBYTE (bytestr)) @@ -542,14 +541,7 @@ If the third argument is incorrect, Emacs may crash. */) { Lisp_Object v1; v1 = TOP; - if (CONSP (v1)) - TOP = XCAR (v1); - else if (NILP (v1)) - TOP = Qnil; - else - { - wrong_type_argument (Qlistp, v1); - } + TOP = CAR (v1); break; } @@ -575,14 +567,7 @@ If the third argument is incorrect, Emacs may crash. */) { Lisp_Object v1; v1 = TOP; - if (CONSP (v1)) - TOP = XCDR (v1); - else if (NILP (v1)) - TOP = Qnil; - else - { - wrong_type_argument (Qlistp, v1); - } + TOP = CDR (v1); break; } @@ -917,23 +902,10 @@ If the third argument is incorrect, Emacs may crash. */) AFTER_POTENTIAL_GC (); op = XINT (v2); immediate_quit = 1; - while (--op >= 0) - { - if (CONSP (v1)) - v1 = XCDR (v1); - else if (!NILP (v1)) - { - immediate_quit = 0; - wrong_type_argument (Qlistp, v1); - } - } + while (--op >= 0 && CONSP (v1)) + v1 = XCDR (v1); immediate_quit = 0; - if (CONSP (v1)) - TOP = XCAR (v1); - else if (NILP (v1)) - TOP = Qnil; - else - wrong_type_argument (Qlistp, v1); + TOP = CAR (v1); break; } @@ -1556,23 +1528,10 @@ If the third argument is incorrect, Emacs may crash. */) AFTER_POTENTIAL_GC (); op = XINT (v2); immediate_quit = 1; - while (--op >= 0) - { - if (CONSP (v1)) - v1 = XCDR (v1); - else if (!NILP (v1)) - { - immediate_quit = 0; - wrong_type_argument (Qlistp, v1); - } - } + while (--op >= 0 && CONSP (v1)) + v1 = XCDR (v1); immediate_quit = 0; - if (CONSP (v1)) - TOP = XCAR (v1); - else if (NILP (v1)) - TOP = Qnil; - else - wrong_type_argument (Qlistp, v1); + TOP = CAR (v1); } else { @@ -1634,10 +1593,7 @@ If the third argument is incorrect, Emacs may crash. */) { Lisp_Object v1; v1 = TOP; - if (CONSP (v1)) - TOP = XCAR (v1); - else - TOP = Qnil; + TOP = CAR_SAFE (v1); break; } @@ -1645,10 +1601,7 @@ If the third argument is incorrect, Emacs may crash. */) { Lisp_Object v1; v1 = TOP; - if (CONSP (v1)) - TOP = XCDR (v1); - else - TOP = Qnil; + TOP = CDR_SAFE (v1); break; } diff --git a/src/callint.c b/src/callint.c index 2411617917f..afb576cf5f6 100644 --- a/src/callint.c +++ b/src/callint.c @@ -314,8 +314,6 @@ If KEYS is omitted or nil, the return value of `this-command-keys' is used. */) /* Save this now, since use of minibuffer will clobber it. */ prefix_arg = Vcurrent_prefix_arg; - retry: - if (SYMBOLP (function)) enable = Fget (function, Qenable_recursive_minibuffers); else @@ -334,8 +332,7 @@ If KEYS is omitted or nil, the return value of `this-command-keys' is used. */) up_event = Qnil; /* Decode the kind of function. Either handle it and return, - or go to `lose' if not interactive, or go to `retry' - to specify a different function, or set either STRING or SPECS. */ + or go to `lose' if not interactive, or set either STRING or SPECS. */ if (SUBRP (fun)) { @@ -343,8 +340,7 @@ If KEYS is omitted or nil, the return value of `this-command-keys' is used. */) if (!string) { lose: - function = wrong_type_argument (Qcommandp, function); - goto retry; + wrong_type_argument (Qcommandp, function); } } else if (COMPILEDP (fun)) @@ -721,10 +717,10 @@ If KEYS is omitted or nil, the return value of `this-command-keys' is used. */) do { Lisp_Object tem; - if (! first) + if (! first) { message ("Please enter a number."); - sit_for (1, 0, 0, 0, 0); + sit_for (make_number (1), 0, 0); } first = 0; diff --git a/src/casefiddle.c b/src/casefiddle.c index 02ec3f76b4e..76a24f48a82 100644 --- a/src/casefiddle.c +++ b/src/casefiddle.c @@ -45,75 +45,73 @@ casify_object (flag, obj) if (NILP (XCHAR_TABLE (current_buffer->downcase_table)->extras[1])) Fset_case_table (current_buffer->downcase_table); - while (1) + if (INTEGERP (obj)) { - if (INTEGERP (obj)) + int flagbits = (CHAR_ALT | CHAR_SUPER | CHAR_HYPER + | CHAR_SHIFT | CHAR_CTL | CHAR_META); + int flags = XINT (obj) & flagbits; + + /* If the character has higher bits set + above the flags, return it unchanged. + It is not a real character. */ + if ((unsigned) XFASTINT (obj) > (unsigned) flagbits) + return obj; + + c = DOWNCASE (XFASTINT (obj) & ~flagbits); + if (inword) + XSETFASTINT (obj, c | flags); + else if (c == (XFASTINT (obj) & ~flagbits)) { - int flagbits = (CHAR_ALT | CHAR_SUPER | CHAR_HYPER - | CHAR_SHIFT | CHAR_CTL | CHAR_META); - int flags = XINT (obj) & flagbits; - - /* If the character has higher bits set - above the flags, return it unchanged. - It is not a real character. */ - if ((unsigned) XFASTINT (obj) > (unsigned) flagbits) - return obj; - - c = DOWNCASE (XFASTINT (obj) & ~flagbits); - if (inword) - XSETFASTINT (obj, c | flags); - else if (c == (XFASTINT (obj) & ~flagbits)) - { - c = UPCASE1 ((XFASTINT (obj) & ~flagbits)); - XSETFASTINT (obj, c | flags); - } - return obj; + c = UPCASE1 ((XFASTINT (obj) & ~flagbits)); + XSETFASTINT (obj, c | flags); } + return obj; + } + + if (STRINGP (obj)) + { + int multibyte = STRING_MULTIBYTE (obj); + int n; + + obj = Fcopy_sequence (obj); + len = SBYTES (obj); - if (STRINGP (obj)) + /* I counts bytes, and N counts chars. */ + for (i = n = 0; i < len; n++) { - int multibyte = STRING_MULTIBYTE (obj); - int n; + int from_len = 1, to_len = 1; - obj = Fcopy_sequence (obj); - len = SBYTES (obj); + c = SREF (obj, i); - /* I counts bytes, and N counts chars. */ - for (i = n = 0; i < len; n++) + if (multibyte && c >= 0x80) + c = STRING_CHAR_AND_LENGTH (SDATA (obj) + i, len -i, from_len); + if (inword && flag != CASE_CAPITALIZE_UP) + c = DOWNCASE (c); + else if (!UPPERCASEP (c) + && (!inword || flag != CASE_CAPITALIZE_UP)) + c = UPCASE1 (c); + if ((ASCII_BYTE_P (c) && from_len == 1) + || (! multibyte && SINGLE_BYTE_CHAR_P (c))) + SSET (obj, i, c); + else { - int from_len = 1, to_len = 1; - - c = SREF (obj, i); - - if (multibyte && c >= 0x80) - c = STRING_CHAR_AND_LENGTH (SDATA (obj) + i, len -i, from_len); - if (inword && flag != CASE_CAPITALIZE_UP) - c = DOWNCASE (c); - else if (!UPPERCASEP (c) - && (!inword || flag != CASE_CAPITALIZE_UP)) - c = UPCASE1 (c); - if ((ASCII_BYTE_P (c) && from_len == 1) - || (! multibyte && SINGLE_BYTE_CHAR_P (c))) - SSET (obj, i, c); + to_len = CHAR_BYTES (c); + if (from_len == to_len) + CHAR_STRING (c, SDATA (obj) + i); else { - to_len = CHAR_BYTES (c); - if (from_len == to_len) - CHAR_STRING (c, SDATA (obj) + i); - else - { - Faset (obj, make_number (n), make_number (c)); - len += to_len - from_len; - } + Faset (obj, make_number (n), make_number (c)); + len += to_len - from_len; } - if ((int) flag >= (int) CASE_CAPITALIZE) - inword = SYNTAX (c) == Sword; - i += to_len; } - return obj; + if ((int) flag >= (int) CASE_CAPITALIZE) + inword = SYNTAX (c) == Sword; + i += to_len; } - obj = wrong_type_argument (Qchar_or_string_p, obj); + return obj; } + + return wrong_type_argument (Qchar_or_string_p, obj); } DEFUN ("upcase", Fupcase, Supcase, 1, 1, 0, diff --git a/src/casetab.c b/src/casetab.c index 5c7530eb480..5483f5663fa 100644 --- a/src/casetab.c +++ b/src/casetab.c @@ -1,5 +1,5 @@ /* GNU Emacs routines to deal with case tables. - Copyright (C) 1993, 1994, 2002, 2003, 2004, + Copyright (C) 1993, 1994, 2002, 2003, 2004, 2005, 2006 Free Software Foundation, Inc. This file is part of GNU Emacs. @@ -67,10 +67,7 @@ static Lisp_Object check_case_table (obj) Lisp_Object obj; { - register Lisp_Object tem; - - while (tem = Fcase_table_p (obj), NILP (tem)) - obj = wrong_type_argument (Qcase_table_p, obj); + CHECK_TYPE (!NILP (Fcase_table_p (obj)), Qcase_table_p, obj); return (obj); } diff --git a/src/category.c b/src/category.c index 929cd7ea1c0..6835d00d824 100644 --- a/src/category.c +++ b/src/category.c @@ -164,11 +164,9 @@ Lisp_Object check_category_table (table) Lisp_Object table; { - register Lisp_Object tem; if (NILP (table)) return current_buffer->category_table; - while (tem = Fcategory_table_p (table), NILP (tem)) - table = wrong_type_argument (Qcategory_table_p, table); + CHECK_TYPE (!NILP (Fcategory_table_p (table)), Qcategory_table_p, table); return table; } diff --git a/src/category.h b/src/category.h index ade8704db09..413505ece61 100644 --- a/src/category.h +++ b/src/category.h @@ -54,10 +54,8 @@ Boston, MA 02110-1301, USA. */ #define CATEGORYP(x) \ (INTEGERP ((x)) && XFASTINT ((x)) >= 0x20 && XFASTINT ((x)) <= 0x7E) -#define CHECK_CATEGORY(x) \ - do { \ - if (!CATEGORYP ((x))) x = wrong_type_argument (Qcategoryp, (x)); \ - } while (0) +#define CHECK_CATEGORY(x) \ + CHECK_TYPE (CATEGORYP (x), Qcategoryp, x) #define XCATEGORY_SET XBOOL_VECTOR @@ -72,10 +70,8 @@ Boston, MA 02110-1301, USA. */ #define SET_CATEGORY_SET(category_set, category, val) \ (Faset (category_set, category, val)) -#define CHECK_CATEGORY_SET(x) \ - do { \ - if (!CATEGORY_SET_P ((x))) x = wrong_type_argument (Qcategorysetp, (x)); \ - } while (0) +#define CHECK_CATEGORY_SET(x) \ + CHECK_TYPE (CATEGORY_SET_P (x), Qcategorysetp, x) /* Return 1 if CATEGORY_SET contains CATEGORY, else return 0. The faster version of `!NILP (Faref (category_set, category))'. */ diff --git a/src/data.c b/src/data.c index fdad80b2727..8cca837028d 100644 --- a/src/data.c +++ b/src/data.c @@ -114,18 +114,13 @@ Lisp_Object wrong_type_argument (predicate, value) register Lisp_Object predicate, value; { - register Lisp_Object tem; - do - { - /* If VALUE is not even a valid Lisp object, abort here - where we can get a backtrace showing where it came from. */ - if ((unsigned int) XGCTYPE (value) >= Lisp_Type_Limit) - abort (); + /* If VALUE is not even a valid Lisp object, abort here + where we can get a backtrace showing where it came from. */ + if ((unsigned int) XGCTYPE (value) >= Lisp_Type_Limit) + abort (); + + Fsignal (Qwrong_type_argument, list2 (predicate, value)); - value = Fsignal (Qwrong_type_argument, Fcons (predicate, Fcons (value, Qnil))); - tem = call1 (predicate, value); - } - while (NILP (tem)); /* 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. */ @@ -395,8 +390,7 @@ DEFUN ("arrayp", Farrayp, Sarrayp, 1, 1, 0, (object) Lisp_Object object; { - if (VECTORP (object) || STRINGP (object) - || CHAR_TABLE_P (object) || BOOL_VECTOR_P (object)) + if (ARRAYP (object)) return Qt; return Qnil; } @@ -406,8 +400,7 @@ DEFUN ("sequencep", Fsequencep, Ssequencep, 1, 1, 0, (object) register Lisp_Object object; { - if (CONSP (object) || NILP (object) || VECTORP (object) || STRINGP (object) - || CHAR_TABLE_P (object) || BOOL_VECTOR_P (object)) + if (CONSP (object) || NILP (object) || ARRAYP (object)) return Qt; return Qnil; } @@ -537,15 +530,7 @@ Lisp concepts such as car, cdr, cons cell and list. */) (list) register Lisp_Object list; { - while (1) - { - if (CONSP (list)) - return XCAR (list); - else if (EQ (list, Qnil)) - return Qnil; - else - list = wrong_type_argument (Qlistp, list); - } + return CAR (list); } DEFUN ("car-safe", Fcar_safe, Scar_safe, 1, 1, 0, @@ -553,10 +538,7 @@ DEFUN ("car-safe", Fcar_safe, Scar_safe, 1, 1, 0, (object) Lisp_Object object; { - if (CONSP (object)) - return XCAR (object); - else - return Qnil; + return CAR_SAFE (object); } DEFUN ("cdr", Fcdr, Scdr, 1, 1, 0, @@ -568,15 +550,7 @@ Lisp concepts such as cdr, car, cons cell and list. */) (list) register Lisp_Object list; { - while (1) - { - if (CONSP (list)) - return XCDR (list); - else if (EQ (list, Qnil)) - return Qnil; - else - list = wrong_type_argument (Qlistp, list); - } + return CDR (list); } DEFUN ("cdr-safe", Fcdr_safe, Scdr_safe, 1, 1, 0, @@ -584,10 +558,7 @@ DEFUN ("cdr-safe", Fcdr_safe, Scdr_safe, 1, 1, 0, (object) Lisp_Object object; { - if (CONSP (object)) - return XCDR (object); - else - return Qnil; + return CDR_SAFE (object); } DEFUN ("setcar", Fsetcar, Ssetcar, 2, 2, 0, @@ -595,9 +566,7 @@ DEFUN ("setcar", Fsetcar, Ssetcar, 2, 2, 0, (cell, newcar) register Lisp_Object cell, newcar; { - if (!CONSP (cell)) - cell = wrong_type_argument (Qconsp, cell); - + CHECK_CONS (cell); CHECK_IMPURE (cell); XSETCAR (cell, newcar); return newcar; @@ -608,9 +577,7 @@ DEFUN ("setcdr", Fsetcdr, Ssetcdr, 2, 2, 0, (cell, newcdr) register Lisp_Object cell, newcdr; { - if (!CONSP (cell)) - cell = wrong_type_argument (Qconsp, cell); - + CHECK_CONS (cell); CHECK_IMPURE (cell); XSETCDR (cell, newcdr); return newcdr; @@ -765,8 +732,7 @@ function with `&rest' args, or `unevalled' for a special form. */) Lisp_Object subr; { short minargs, maxargs; - if (!SUBRP (subr)) - wrong_type_argument (Qsubrp, subr); + CHECK_SUBR (subr); minargs = XSUBR (subr)->min_args; maxargs = XSUBR (subr)->max_args; if (maxargs == MANY) @@ -784,8 +750,7 @@ SUBR must be a built-in function. */) Lisp_Object subr; { const char *name; - if (!SUBRP (subr)) - wrong_type_argument (Qsubrp, subr); + CHECK_SUBR (subr); name = XSUBR (subr)->symbol_name; return make_string (name, strlen (name)); } @@ -2005,13 +1970,18 @@ function chain of symbols. */) { Lisp_Object result; - result = indirect_function (object); + /* Optimize for no indirection. */ + result = object; + if (SYMBOLP (result) && !EQ (result, Qunbound) + && (result = XSYMBOL (result)->function, SYMBOLP (result))) + result = indirect_function (result); + if (!EQ (result, Qunbound)) + return result; - if (EQ (result, Qunbound)) - return (NILP (noerror) - ? Fsignal (Qvoid_function, Fcons (object, Qnil)) - : Qnil); - return result; + if (NILP (noerror)) + Fsignal (Qvoid_function, Fcons (object, Qnil)); + + return Qnil; } /* Extract and set vector and string elements */ @@ -2173,9 +2143,7 @@ bool-vector. IDX starts at 0. */) CHECK_NUMBER (idx); idxval = XINT (idx); - if (!VECTORP (array) && !STRINGP (array) && !BOOL_VECTOR_P (array) - && ! CHAR_TABLE_P (array)) - array = wrong_type_argument (Qarrayp, array); + CHECK_ARRAY (array, Qarrayp); CHECK_IMPURE (array); if (VECTORP (array)) diff --git a/src/dired.c b/src/dired.c index 8b5d7851765..17a80a3ce4b 100644 --- a/src/dired.c +++ b/src/dired.c @@ -99,6 +99,7 @@ extern struct direct *readdir (); #include "charset.h" #include "coding.h" #include "regex.h" +#include "blockinput.h" /* Returns a search buffer, with a fastmap allocated and ready to go. */ extern struct re_pattern_buffer *compile_pattern (); @@ -951,10 +952,12 @@ Elements of the attribute list are: } else { + BLOCK_INPUT; pw = (struct passwd *) getpwuid (s.st_uid); values[2] = (pw ? build_string (pw->pw_name) : make_number (s.st_uid)); gr = (struct group *) getgrgid (s.st_gid); values[3] = (gr ? build_string (gr->gr_name) : make_number (s.st_gid)); + UNBLOCK_INPUT; } values[4] = make_time (s.st_atime); values[5] = make_time (s.st_mtime); diff --git a/src/dispextern.h b/src/dispextern.h index 6b5705a2865..52e549ebc0f 100644 --- a/src/dispextern.h +++ b/src/dispextern.h @@ -2955,7 +2955,6 @@ int scrolling P_ ((struct frame *)); void do_pending_window_change P_ ((int)); void change_frame_size P_ ((struct frame *, int, int, int, int, int)); void bitch_at_user P_ ((void)); -Lisp_Object sit_for P_ ((int, int, int, int, int)); void init_display P_ ((void)); void syms_of_display P_ ((void)); extern Lisp_Object Qredisplay_dont_pause; diff --git a/src/dispnew.c b/src/dispnew.c index 4f63bfa8578..87d99fd9917 100644 --- a/src/dispnew.c +++ b/src/dispnew.c @@ -6527,31 +6527,43 @@ Emacs was built without floating point support. /* This is just like wait_reading_process_output, except that - it does the redisplay. + it does redisplay. - It's also much like Fsit_for, except that it can be used for - waiting for input as well. */ + TIMEOUT is number of seconds to wait (float or integer). + READING is 1 if reading input. + If DO_DISPLAY is >0 display process output while waiting. + If DO_DISPLAY is >1 perform an initial redisplay before waiting. +*/ Lisp_Object -sit_for (sec, usec, reading, display, initial_display) - int sec, usec, reading, display, initial_display; +sit_for (timeout, reading, do_display) + Lisp_Object timeout; + int reading, do_display; { - int preempt = (sec >= 0) || (sec == 0 && usec >= 0); + int sec, usec; - swallow_events (display); + swallow_events (do_display); - if ((detect_input_pending_run_timers (display) && preempt) + if ((detect_input_pending_run_timers (do_display)) || !NILP (Vexecuting_kbd_macro)) return Qnil; - if (initial_display) + if (do_display >= 2) + redisplay_preserve_echo_area (2); + + if (INTEGERP (timeout)) { - int count = SPECPDL_INDEX (); - if (!preempt) - specbind (Qredisplay_dont_pause, Qt); - redisplay_preserve_echo_area (2); - unbind_to (count, Qnil); + sec = XINT (timeout); + usec = 0; } + else if (FLOATP (timeout)) + { + double seconds = XFLOAT_DATA (timeout); + sec = (int) seconds; + usec = (int) ((seconds - sec) * 1000000); + } + else + wrong_type_argument (Qnumberp, timeout); if (sec == 0 && usec == 0) return Qt; @@ -6560,63 +6572,34 @@ sit_for (sec, usec, reading, display, initial_display) gobble_input (0); #endif - wait_reading_process_output (sec, usec, reading ? -1 : 1, display, + wait_reading_process_output (sec, usec, reading ? -1 : 1, do_display, Qnil, NULL, 0); return detect_input_pending () ? Qnil : Qt; } -DEFUN ("sit-for", Fsit_for, Ssit_for, 1, 3, 0, - doc: /* Perform redisplay, then wait for SECONDS seconds or until input is available. -SECONDS may be a floating-point value, meaning that you can wait for a -fraction of a second. -\(Not all operating systems support waiting for a fraction of a second.) -Optional arg NODISP non-nil means don't redisplay, just wait for input. -Redisplay is preempted as always if input arrives, and does not happen -if input is available before it starts. -Value is t if waited the full time with no input arriving. - -Redisplay will occur even when input is available if SECONDS is negative. - -An obsolete but still supported form is -\(sit-for SECONDS &optional MILLISECONDS NODISP) -Where the optional arg MILLISECONDS specifies an additional wait period, -in milliseconds; this was useful when Emacs was built without -floating point support. -usage: (sit-for SECONDS &optional NODISP OLD-NODISP) */) - -/* The `old-nodisp' stuff is there so that the arglist has the correct - length. Otherwise, `defdvice' will redefine it with fewer args. */ - (seconds, milliseconds, nodisp) - Lisp_Object seconds, milliseconds, nodisp; +DEFUN ("redisplay", Fredisplay, Sredisplay, 0, 1, 0, + doc: /* Perform redisplay if no input is available. +If optional arg FORCE is non-nil or `redisplay-dont-pause' is non-nil, +perform a full redisplay even if input is available. */) + (force) + Lisp_Object force; { - int sec, usec; - - if (NILP (nodisp) && !NUMBERP (milliseconds)) - { /* New style. */ - nodisp = milliseconds; - milliseconds = Qnil; - } - - if (NILP (milliseconds)) - XSETINT (milliseconds, 0); - else - CHECK_NUMBER (milliseconds); - usec = XINT (milliseconds) * 1000; - - { - double duration = extract_float (seconds); - sec = (int) duration; - usec += (duration - sec) * 1000000; - } + int count; -#ifndef EMACS_HAS_USECS - if (usec != 0 && sec == 0) - error ("Millisecond `sit-for' not supported on %s", SYSTEM_TYPE); -#endif + swallow_events (1); + if ((detect_input_pending_run_timers (1) + && NILP (force) && !redisplay_dont_pause) + || !NILP (Vexecuting_kbd_macro)) + return Qnil; - return sit_for (sec, usec, 0, NILP (nodisp), NILP (nodisp)); + count = SPECPDL_INDEX (); + if (!NILP (force) && !redisplay_dont_pause) + specbind (Qredisplay_dont_pause, Qt); + redisplay_preserve_echo_area (2); + unbind_to (count, Qnil); + return Qt; } @@ -7038,7 +7021,7 @@ syms_of_display () defsubr (&Sframe_or_buffer_changed_p); defsubr (&Sopen_termscript); defsubr (&Sding); - defsubr (&Ssit_for); + defsubr (&Sredisplay); defsubr (&Ssleep_for); defsubr (&Ssend_string_to_terminal); defsubr (&Sinternal_show_cursor); diff --git a/src/editfns.c b/src/editfns.c index 85ce94c8f8a..cf37c10a9d5 100644 --- a/src/editfns.c +++ b/src/editfns.c @@ -56,6 +56,7 @@ Boston, MA 02110-1301, USA. */ #include "coding.h" #include "frame.h" #include "window.h" +#include "blockinput.h" #ifdef STDC_HEADERS #include <float.h> @@ -628,7 +629,10 @@ find_field (pos, merge_at_boundary, beg_limit, beg, end_limit, end) DEFUN ("delete-field", Fdelete_field, Sdelete_field, 0, 1, 0, doc: /* Delete the field surrounding POS. A field is a region of text with the same `field' property. -If POS is nil, the value of point is used for POS. */) +If POS is nil, the value of point is used for POS. + +An `args-out-of-range' error is signaled if POS is outside the +buffer's accessible portion. */) (pos) Lisp_Object pos; { @@ -642,7 +646,10 @@ If POS is nil, the value of point is used for POS. */) DEFUN ("field-string", Ffield_string, Sfield_string, 0, 1, 0, doc: /* Return the contents of the field surrounding POS as a string. A field is a region of text with the same `field' property. -If POS is nil, the value of point is used for POS. */) +If POS is nil, the value of point is used for POS. + +An `args-out-of-range' error is signaled if POS is outside the +buffer's accessible portion. */) (pos) Lisp_Object pos; { @@ -654,7 +661,10 @@ If POS is nil, the value of point is used for POS. */) DEFUN ("field-string-no-properties", Ffield_string_no_properties, Sfield_string_no_properties, 0, 1, 0, doc: /* Return the contents of the field around POS, without text-properties. A field is a region of text with the same `field' property. -If POS is nil, the value of point is used for POS. */) +If POS is nil, the value of point is used for POS. + +An `args-out-of-range' error is signaled if POS is outside the +buffer's accessible portion. */) (pos) Lisp_Object pos; { @@ -670,7 +680,10 @@ If POS is nil, the value of point is used for POS. If ESCAPE-FROM-EDGE is non-nil and POS is at the beginning of its field, then the beginning of the *previous* field is returned. If LIMIT is non-nil, it is a buffer position; if the beginning of the field -is before LIMIT, then LIMIT will be returned instead. */) +is before LIMIT, then LIMIT will be returned instead. + +An `args-out-of-range' error is signaled if POS is outside the +buffer's accessible portion. */) (pos, escape_from_edge, limit) Lisp_Object pos, escape_from_edge, limit; { @@ -686,7 +699,10 @@ If POS is nil, the value of point is used for POS. If ESCAPE-FROM-EDGE is non-nil and POS is at the end of its field, then the end of the *following* field is returned. If LIMIT is non-nil, it is a buffer position; if the end of the field -is after LIMIT, then LIMIT will be returned instead. */) +is after LIMIT, then LIMIT will be returned instead. + +An `args-out-of-range' error is signaled if POS is outside the +buffer's accessible portion. */) (pos, escape_from_edge, limit) Lisp_Object pos, escape_from_edge, limit; { @@ -1287,7 +1303,9 @@ with that uid, or nil if there is no such user. */) return Vuser_login_name; CHECK_NUMBER (uid); + BLOCK_INPUT; pw = (struct passwd *) getpwuid (XINT (uid)); + UNBLOCK_INPUT; return (pw ? build_string (pw->pw_name) : Qnil); } @@ -1341,9 +1359,17 @@ name, or nil if there is no such user. */) if (NILP (uid)) return Vuser_full_name; else if (NUMBERP (uid)) - pw = (struct passwd *) getpwuid ((uid_t) XFLOATINT (uid)); + { + BLOCK_INPUT; + pw = (struct passwd *) getpwuid ((uid_t) XFLOATINT (uid)); + UNBLOCK_INPUT; + } else if (STRINGP (uid)) - pw = (struct passwd *) getpwnam (SDATA (uid)); + { + BLOCK_INPUT; + pw = (struct passwd *) getpwnam (SDATA (uid)); + UNBLOCK_INPUT; + } else error ("Invalid UID specification"); @@ -2114,7 +2140,6 @@ general_insert_function (insert_func, insert_from_string_func, for (argnum = 0; argnum < nargs; argnum++) { val = args[argnum]; - retry: if (INTEGERP (val)) { unsigned char str[MAX_MULTIBYTE_LENGTH]; @@ -2139,10 +2164,7 @@ general_insert_function (insert_func, insert_from_string_func, inherit); } else - { - val = wrong_type_argument (Qchar_or_string_p, val); - goto retry; - } + wrong_type_argument (Qchar_or_string_p, val); } } @@ -3864,7 +3886,7 @@ usage: (format STRING &rest OBJECTS) */) /* Likewise adjust the property end position. */ pos = XINT (XCAR (XCDR (item))); - for (; bytepos < pos; bytepos++) + for (; position < pos; bytepos++) { if (! discarded[bytepos]) position++, translated++; diff --git a/src/eval.c b/src/eval.c index 5f8d266ec7b..a07ab32e76b 100644 --- a/src/eval.c +++ b/src/eval.c @@ -749,8 +749,7 @@ usage: (defmacro NAME ARGLIST [DOCSTRING] [DECL] BODY...) */) DEFUN ("defvaralias", Fdefvaralias, Sdefvaralias, 2, 3, 0, doc: /* Make NEW-ALIAS a variable alias for symbol BASE-VARIABLE. -Setting the value of NEW-ALIAS will subsequently set the value of BASE-VARIABLE, - and getting the value of NEW-ALIAS will return the value BASE-VARIABLE has. +Aliased variables always have the same value; setting one sets the other. Third arg DOCSTRING, if non-nil, is documentation for NEW-ALIAS. If it is omitted or nil, NEW-ALIAS gets the documentation string of BASE-VARIABLE, or of the variable at the end of the chain of aliases, if BASE-VARIABLE is @@ -1290,16 +1289,14 @@ Both TAG and VALUE are evalled. */) { register struct catchtag *c; - while (1) - { - if (!NILP (tag)) - for (c = catchlist; c; c = c->next) - { - if (EQ (c->tag, tag)) - unwind_to_catch (c, value); - } - tag = Fsignal (Qno_catch, Fcons (tag, Fcons (value, Qnil))); - } + if (!NILP (tag)) + for (c = catchlist; c; c = c->next) + { + if (EQ (c->tag, tag)) + unwind_to_catch (c, value); + } + Fsignal (Qno_catch, list2 (tag, value)); + abort (); } @@ -2167,7 +2164,12 @@ DEFUN ("eval", Feval, Seval, 1, 1, 0, /* At this point, only original_fun and original_args have values that will be used below */ retry: - fun = Findirect_function (original_fun, Qnil); + + /* Optimize for no indirection. */ + fun = original_fun; + if (SYMBOLP (fun) && !EQ (fun, Qunbound) + && (fun = XSYMBOL (fun)->function, SYMBOLP (fun))) + fun = indirect_function (fun); if (SUBRP (fun)) { @@ -2183,7 +2185,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))) - return Fsignal (Qwrong_number_of_arguments, Fcons (fun, Fcons (numargs, Qnil))); + Fsignal (Qwrong_number_of_arguments, list2 (original_fun, numargs)); if (XSUBR (fun)->max_args == UNEVALLED) { @@ -2286,11 +2288,13 @@ DEFUN ("eval", Feval, Seval, 1, 1, 0, val = apply_lambda (fun, original_args, 1); else { + if (EQ (fun, Qunbound)) + Fsignal (Qvoid_function, Fcons (original_fun, Qnil)); if (!CONSP (fun)) - return Fsignal (Qinvalid_function, Fcons (fun, Qnil)); + Fsignal (Qinvalid_function, Fcons (original_fun, Qnil)); funcar = Fcar (fun); if (!SYMBOLP (funcar)) - return Fsignal (Qinvalid_function, Fcons (fun, Qnil)); + Fsignal (Qinvalid_function, Fcons (original_fun, Qnil)); if (EQ (funcar, Qautoload)) { do_autoload (fun, original_fun); @@ -2301,7 +2305,7 @@ DEFUN ("eval", Feval, Seval, 1, 1, 0, else if (EQ (funcar, Qlambda)) val = apply_lambda (fun, original_args, 1); else - return Fsignal (Qinvalid_function, Fcons (fun, Qnil)); + Fsignal (Qinvalid_function, Fcons (original_fun, Qnil)); } done: CHECK_CONS_LIST (); @@ -2346,7 +2350,10 @@ usage: (apply FUNCTION &rest ARGUMENTS) */) numargs += nargs - 2; - fun = indirect_function (fun); + /* Optimize for no indirection. */ + if (SYMBOLP (fun) && !EQ (fun, Qunbound) + && (fun = XSYMBOL (fun)->function, SYMBOLP (fun))) + fun = indirect_function (fun); if (EQ (fun, Qunbound)) { /* Let funcall get the error */ @@ -2825,7 +2832,7 @@ usage: (funcall FUNCTION &rest ARGUMENTS) */) int nargs; Lisp_Object *args; { - Lisp_Object fun; + Lisp_Object fun, original_fun; Lisp_Object funcar; int numargs = nargs - 1; Lisp_Object lisp_numargs; @@ -2862,11 +2869,15 @@ usage: (funcall FUNCTION &rest ARGUMENTS) */) CHECK_CONS_LIST (); + original_fun = args[0]; + retry: - fun = args[0]; - - fun = Findirect_function (fun, Qnil); + /* Optimize for no indirection. */ + fun = original_fun; + if (SYMBOLP (fun) && !EQ (fun, Qunbound) + && (fun = XSYMBOL (fun)->function, SYMBOLP (fun))) + fun = indirect_function (fun); if (SUBRP (fun)) { @@ -2874,11 +2885,11 @@ usage: (funcall FUNCTION &rest ARGUMENTS) */) || (XSUBR (fun)->max_args >= 0 && XSUBR (fun)->max_args < numargs)) { XSETFASTINT (lisp_numargs, numargs); - return Fsignal (Qwrong_number_of_arguments, Fcons (fun, Fcons (lisp_numargs, Qnil))); + Fsignal (Qwrong_number_of_arguments, list2 (original_fun, lisp_numargs)); } if (XSUBR (fun)->max_args == UNEVALLED) - return Fsignal (Qinvalid_function, Fcons (fun, Qnil)); + Fsignal (Qinvalid_function, Fcons (original_fun, Qnil)); if (XSUBR (fun)->max_args == MANY) { @@ -2950,21 +2961,23 @@ usage: (funcall FUNCTION &rest ARGUMENTS) */) val = funcall_lambda (fun, numargs, args + 1); else { + if (EQ (fun, Qunbound)) + Fsignal (Qvoid_function, Fcons (original_fun, Qnil)); if (!CONSP (fun)) - return Fsignal (Qinvalid_function, Fcons (fun, Qnil)); + Fsignal (Qinvalid_function, Fcons (original_fun, Qnil)); funcar = Fcar (fun); if (!SYMBOLP (funcar)) - return Fsignal (Qinvalid_function, Fcons (fun, Qnil)); + Fsignal (Qinvalid_function, Fcons (original_fun, Qnil)); if (EQ (funcar, Qlambda)) val = funcall_lambda (fun, numargs, args + 1); else if (EQ (funcar, Qautoload)) { - do_autoload (fun, args[0]); + do_autoload (fun, original_fun); CHECK_CONS_LIST (); goto retry; } else - return Fsignal (Qinvalid_function, Fcons (fun, Qnil)); + Fsignal (Qinvalid_function, Fcons (original_fun, Qnil)); } done: CHECK_CONS_LIST (); @@ -3040,7 +3053,7 @@ funcall_lambda (fun, nargs, arg_vector) if (CONSP (syms_left)) syms_left = XCAR (syms_left); else - return Fsignal (Qinvalid_function, Fcons (fun, Qnil)); + Fsignal (Qinvalid_function, Fcons (fun, Qnil)); } else if (COMPILEDP (fun)) syms_left = AREF (fun, COMPILED_ARGLIST); @@ -3053,8 +3066,8 @@ funcall_lambda (fun, nargs, arg_vector) QUIT; next = XCAR (syms_left); - while (!SYMBOLP (next)) - next = Fsignal (Qinvalid_function, Fcons (fun, Qnil)); + if (!SYMBOLP (next)) + Fsignal (Qinvalid_function, Fcons (fun, Qnil)); if (EQ (next, Qand_rest)) rest = 1; @@ -3068,17 +3081,15 @@ funcall_lambda (fun, nargs, arg_vector) else if (i < nargs) specbind (next, arg_vector[i++]); else if (!optional) - return Fsignal (Qwrong_number_of_arguments, - Fcons (fun, Fcons (make_number (nargs), Qnil))); + Fsignal (Qwrong_number_of_arguments, list2 (fun, make_number (nargs))); else specbind (next, Qnil); } if (!NILP (syms_left)) - return Fsignal (Qinvalid_function, Fcons (fun, Qnil)); + Fsignal (Qinvalid_function, Fcons (fun, Qnil)); else if (i < nargs) - return Fsignal (Qwrong_number_of_arguments, - Fcons (fun, Fcons (make_number (nargs), Qnil))); + Fsignal (Qwrong_number_of_arguments, list2 (fun, make_number (nargs))); if (CONSP (fun)) val = Fprogn (XCDR (XCDR (fun))); diff --git a/src/fileio.c b/src/fileio.c index e5b81ddfd7b..58b1863f225 100644 --- a/src/fileio.c +++ b/src/fileio.c @@ -77,6 +77,7 @@ extern int errno; #include "charset.h" #include "coding.h" #include "window.h" +#include "blockinput.h" #include "frame.h" #include "dispextern.h" @@ -1388,7 +1389,9 @@ See also the function `substitute-in-file-name'. */) bcopy ((char *) nm, o, p - nm); o [p - nm] = 0; + BLOCK_INPUT; pw = (struct passwd *) getpwnam (o + 1); + UNBLOCK_INPUT; if (pw) { newdir = (unsigned char *) pw -> pw_dir; @@ -1919,7 +1922,9 @@ See also the function `substitute-in-file-name'.") o[len] = 0; /* Look up the user name. */ + BLOCK_INPUT; pw = (struct passwd *) getpwnam (o + 1); + UNBLOCK_INPUT; if (!pw) error ("\"%s\" isn't a registered user", o + 1); @@ -2113,10 +2118,11 @@ search_embedded_absfilename (nm, endp) /* If we have ~user and `user' exists, discard everything up to ~. But if `user' does not exist, leave ~user alone, it might be a literal file name. */ - if ((pw = getpwnam (o + 1))) + BLOCK_INPUT; + pw = getpwnam (o + 1); + UNBLOCK_INPUT; + if (pw) return p; - else - xfree (pw); } else return p; @@ -5855,7 +5861,11 @@ static Lisp_Object do_auto_save_make_dir (dir) Lisp_Object dir; { - return call2 (Qmake_directory, dir, Qt); + Lisp_Object mode; + + call2 (Qmake_directory, dir, Qt); + XSETFASTINT (mode, 0700); + return Fset_file_modes (dir, mode); } static Lisp_Object @@ -6053,7 +6063,7 @@ A non-nil CURRENT-ONLY argument means save only current buffer. */) { /* If we are going to restore an old message, give time to read ours. */ - sit_for (1, 0, 0, 0, 0); + sit_for (make_number (1), 0, 0); restore_message (); } else diff --git a/src/fns.c b/src/fns.c index 2fea9af40cd..69e12bf25ce 100644 --- a/src/fns.c +++ b/src/fns.c @@ -147,7 +147,6 @@ To get the number of bytes, use `string-bytes'. */) register Lisp_Object val; register int i; - retry: if (STRINGP (sequence)) XSETFASTINT (val, SCHARS (sequence)); else if (VECTORP (sequence)) @@ -176,18 +175,15 @@ To get the number of bytes, use `string-bytes'. */) QUIT; } - if (!NILP (sequence)) - wrong_type_argument (Qlistp, sequence); + CHECK_LIST_END (sequence, sequence); val = make_number (i); } else if (NILP (sequence)) XSETFASTINT (val, 0); else - { - sequence = wrong_type_argument (Qsequencep, sequence); - goto retry; - } + val = wrong_type_argument (Qsequencep, sequence); + return val; } @@ -529,7 +525,8 @@ with the original. */) } if (!CONSP (arg) && !VECTORP (arg) && !STRINGP (arg)) - arg = wrong_type_argument (Qsequencep, arg); + wrong_type_argument (Qsequencep, arg); + return concat (1, &arg, CONSP (arg) ? Lisp_Cons : XTYPE (arg), 0); } @@ -581,15 +578,13 @@ concat (nargs, args, target_type, last_special) else last_tail = Qnil; - /* Canonicalize each argument. */ + /* Check each argument. */ for (argnum = 0; argnum < nargs; argnum++) { this = args[argnum]; if (!(CONSP (this) || NILP (this) || VECTORP (this) || STRINGP (this) || COMPILEDP (this) || BOOL_VECTOR_P (this))) - { - args[argnum] = wrong_type_argument (Qsequencep, this); - } + wrong_type_argument (Qsequencep, this); } /* Compute total length in chars of arguments in RESULT_LEN. @@ -616,8 +611,7 @@ concat (nargs, args, target_type, last_special) for (i = 0; i < len; i++) { ch = XVECTOR (this)->contents[i]; - if (! INTEGERP (ch)) - wrong_type_argument (Qintegerp, ch); + CHECK_NUMBER (ch); this_len_byte = CHAR_BYTES (XINT (ch)); result_len_byte += this_len_byte; if (!SINGLE_BYTE_CHAR_P (XINT (ch))) @@ -629,8 +623,7 @@ concat (nargs, args, target_type, last_special) for (; CONSP (this); this = XCDR (this)) { ch = XCAR (this); - if (! INTEGERP (ch)) - wrong_type_argument (Qintegerp, ch); + CHECK_NUMBER (ch); this_len_byte = CHAR_BYTES (XINT (ch)); result_len_byte += this_len_byte; if (!SINGLE_BYTE_CHAR_P (XINT (ch))) @@ -1252,9 +1245,7 @@ This function allows vectors as well as strings. */) int from_char, to_char; int from_byte = 0, to_byte = 0; - if (! (STRINGP (string) || VECTORP (string))) - wrong_type_argument (Qarrayp, string); - + CHECK_VECTOR_OR_STRING (string); CHECK_NUMBER (from); if (STRINGP (string)) @@ -1378,8 +1369,7 @@ substring_both (string, from, from_byte, to, to_byte) int size; int size_byte; - if (! (STRINGP (string) || VECTORP (string))) - wrong_type_argument (Qarrayp, string); + CHECK_VECTOR_OR_STRING (string); if (STRINGP (string)) { @@ -1419,8 +1409,7 @@ DEFUN ("nthcdr", Fnthcdr, Snthcdr, 2, 2, 0, for (i = 0; i < num && !NILP (list); i++) { QUIT; - if (! CONSP (list)) - wrong_type_argument (Qlistp, list); + CHECK_LIST_CONS (list, list); list = XCDR (list); } return list; @@ -1441,16 +1430,12 @@ DEFUN ("elt", Felt, Selt, 2, 2, 0, register Lisp_Object sequence, n; { CHECK_NUMBER (n); - while (1) - { - if (CONSP (sequence) || NILP (sequence)) - return Fcar (Fnthcdr (n, sequence)); - else if (STRINGP (sequence) || VECTORP (sequence) - || BOOL_VECTOR_P (sequence) || CHAR_TABLE_P (sequence)) - return Faref (sequence, n); - else - sequence = wrong_type_argument (Qsequencep, sequence); - } + if (CONSP (sequence) || NILP (sequence)) + return Fcar (Fnthcdr (n, sequence)); + + /* Faref signals a "not array" error, so check here. */ + CHECK_ARRAY (sequence, Qsequencep); + return Faref (sequence, n); } DEFUN ("member", Fmember, Smember, 2, 2, 0, @@ -1464,8 +1449,7 @@ The value is actually the tail of LIST whose car is ELT. */) for (tail = list; !NILP (tail); tail = XCDR (tail)) { register Lisp_Object tem; - if (! CONSP (tail)) - wrong_type_argument (Qlistp, list); + CHECK_LIST_CONS (tail, list); tem = XCAR (tail); if (! NILP (Fequal (elt, tem))) return tail; @@ -1498,9 +1482,7 @@ whose car is ELT. */) QUIT; } - if (!CONSP (list) && !NILP (list)) - list = wrong_type_argument (Qlistp, list); - + CHECK_LIST (list); return list; } @@ -1511,8 +1493,6 @@ Elements of LIST that are not conses are ignored. */) (key, list) Lisp_Object key, list; { - Lisp_Object result; - while (1) { if (!CONSP (list) @@ -1536,14 +1516,7 @@ Elements of LIST that are not conses are ignored. */) QUIT; } - if (CONSP (list)) - result = XCAR (list); - else if (NILP (list)) - result = Qnil; - else - result = wrong_type_argument (Qlistp, list); - - return result; + return CAR (list); } /* Like Fassq but never report an error and do not allow quits. @@ -1558,7 +1531,7 @@ assq_no_quit (key, list) || !EQ (XCAR (XCAR (list)), key))) list = XCDR (list); - return CONSP (list) ? XCAR (list) : Qnil; + return CAR_SAFE (list); } DEFUN ("assoc", Fassoc, Sassoc, 2, 2, 0, @@ -1567,7 +1540,7 @@ The value is actually the first element of LIST whose car equals KEY. */) (key, list) Lisp_Object key, list; { - Lisp_Object result, car; + Lisp_Object car; while (1) { @@ -1595,14 +1568,7 @@ The value is actually the first element of LIST whose car equals KEY. */) QUIT; } - if (CONSP (list)) - result = XCAR (list); - else if (NILP (list)) - result = Qnil; - else - result = wrong_type_argument (Qlistp, list); - - return result; + return CAR (list); } DEFUN ("rassq", Frassq, Srassq, 2, 2, 0, @@ -1612,8 +1578,6 @@ The value is actually the first element of LIST whose cdr is KEY. */) register Lisp_Object key; Lisp_Object list; { - Lisp_Object result; - while (1) { if (!CONSP (list) @@ -1637,14 +1601,7 @@ The value is actually the first element of LIST whose cdr is KEY. */) QUIT; } - if (NILP (list)) - result = Qnil; - else if (CONSP (list)) - result = XCAR (list); - else - result = wrong_type_argument (Qlistp, list); - - return result; + return CAR (list); } DEFUN ("rassoc", Frassoc, Srassoc, 2, 2, 0, @@ -1653,7 +1610,7 @@ The value is actually the first element of LIST whose cdr equals KEY. */) (key, list) Lisp_Object key, list; { - Lisp_Object result, cdr; + Lisp_Object cdr; while (1) { @@ -1681,14 +1638,7 @@ The value is actually the first element of LIST whose cdr equals KEY. */) QUIT; } - if (CONSP (list)) - result = XCAR (list); - else if (NILP (list)) - result = Qnil; - else - result = wrong_type_argument (Qlistp, list); - - return result; + return CAR (list); } DEFUN ("delq", Fdelq, Sdelq, 2, 2, 0, @@ -1708,8 +1658,7 @@ to be sure of changing the value of `foo'. */) prev = Qnil; while (!NILP (tail)) { - if (! CONSP (tail)) - wrong_type_argument (Qlistp, list); + CHECK_LIST_CONS (tail, list); tem = XCAR (tail); if (EQ (elt, tem)) { @@ -1831,8 +1780,7 @@ to be sure of changing the value of `foo'. */) for (tail = seq, prev = Qnil; !NILP (tail); tail = XCDR (tail)) { - if (!CONSP (tail)) - wrong_type_argument (Qlistp, seq); + CHECK_LIST_CONS (tail, seq); if (!NILP (Fequal (elt, XCAR (tail)))) { @@ -1864,8 +1812,7 @@ Return the reversed list. */) while (!NILP (tail)) { QUIT; - if (! CONSP (tail)) - wrong_type_argument (Qlistp, list); + CHECK_LIST_CONS (tail, list); next = XCDR (tail); Fsetcdr (tail, prev); prev = tail; @@ -1887,8 +1834,7 @@ See also the function `nreverse', which is used more often. */) QUIT; new = Fcons (XCAR (list), new); } - if (!NILP (list)) - wrong_type_argument (Qconsp, list); + CHECK_LIST_END (list, list); return new; } @@ -2012,8 +1958,7 @@ one of the properties on the list. */) QUIT; } - if (!NILP (tail)) - wrong_type_argument (Qlistp, prop); + CHECK_LIST_END (tail, prop); return Qnil; } @@ -2129,8 +2074,7 @@ one of the properties on the list. */) QUIT; } - if (!NILP (tail)) - wrong_type_argument (Qlistp, prop); + CHECK_LIST_END (tail, prop); return Qnil; } @@ -2344,7 +2288,6 @@ ARRAY is a vector, string, char-table, or bool-vector. */) Lisp_Object array, item; { register int size, index, charval; - retry: if (VECTORP (array)) { register Lisp_Object *p = XVECTOR (array)->contents; @@ -2408,10 +2351,7 @@ ARRAY is a vector, string, char-table, or bool-vector. */) } } else - { - array = wrong_type_argument (Qarrayp, array); - goto retry; - } + wrong_type_argument (Qarrayp, array); return array; } @@ -3042,8 +2982,7 @@ usage: (nconc &rest LISTS) */) if (argnum + 1 == nargs) break; - if (!CONSP (tem)) - tem = wrong_type_argument (Qlistp, tem); + CHECK_LIST_CONS (tem, tem); while (CONSP (tem)) { diff --git a/src/fontset.c b/src/fontset.c index 23f3c57d241..47cda7f8601 100644 --- a/src/fontset.c +++ b/src/fontset.c @@ -1622,6 +1622,8 @@ It is intended that this function is called only from elt = Fcons (target, Fcons (Qnil, Fcons (Qnil, elt))); XSETCAR (tail, elt); } + if (! NILP (Fequal (fontlist, Voverriding_fontspec_alist))) + return Qnil; Voverriding_fontspec_alist = fontlist; clear_face_cache (0); ++windows_or_buffers_changed; diff --git a/src/frame.h b/src/frame.h index aa4a00d6dfa..9e3813c844a 100644 --- a/src/frame.h +++ b/src/frame.h @@ -748,18 +748,11 @@ typedef struct frame *FRAME_PTR; (f)->visible = (f)->async_visible, \ (f)->iconified = (f)->async_iconified) -#define CHECK_FRAME(x) \ - do { \ - if (! FRAMEP (x)) \ - x = wrong_type_argument (Qframep, (x)); \ - } while (0) - -#define CHECK_LIVE_FRAME(x) \ - do { \ - if (! FRAMEP (x) \ - || ! FRAME_LIVE_P (XFRAME (x))) \ - x = wrong_type_argument (Qframe_live_p, (x)); \ - } while (0) +#define CHECK_FRAME(x) \ + CHECK_TYPE (FRAMEP (x), Qframep, x) + +#define CHECK_LIVE_FRAME(x) \ + CHECK_TYPE (FRAMEP (x) && FRAME_LIVE_P (XFRAME (x)), Qframe_live_p, x) /* FOR_EACH_FRAME (LIST_VAR, FRAME_VAR) followed by a statement is a `for' loop which iterates over the elements of Vframe_list. The diff --git a/src/fringe.c b/src/fringe.c index 4b8ac34fe09..dd885beb1b6 100644 --- a/src/fringe.c +++ b/src/fringe.c @@ -1404,7 +1404,7 @@ init_fringe_bitmap (which, fb, once_p) DEFUN ("define-fringe-bitmap", Fdefine_fringe_bitmap, Sdefine_fringe_bitmap, 2, 5, 0, doc: /* Define fringe bitmap BITMAP from BITS of size HEIGHT x WIDTH. -BITMAP is a symbol or string naming the new fringe bitmap. +BITMAP is a symbol identifying the new fringe bitmap. BITS is either a string or a vector of integers. HEIGHT is height of bitmap. If HEIGHT is nil, use length of BITS. WIDTH must be an integer between 1 and 16, or nil which defaults to 8. @@ -1429,7 +1429,7 @@ If BITMAP already exists, the existing definition is replaced. */) else if (VECTORP (bits)) h = XVECTOR (bits)->size; else - bits = wrong_type_argument (Qsequencep, bits); + wrong_type_argument (Qsequencep, bits); if (NILP (height)) fb.height = h; diff --git a/src/insdel.c b/src/insdel.c index b9d9574788e..b97539c1cc2 100644 --- a/src/insdel.c +++ b/src/insdel.c @@ -2031,6 +2031,8 @@ prepare_to_modify_buffer (start, end, preserve_ptr) int start, end; int *preserve_ptr; { + struct buffer *base_buffer; + if (!NILP (current_buffer->read_only)) Fbarf_if_buffer_read_only (); @@ -2056,20 +2058,26 @@ prepare_to_modify_buffer (start, end, preserve_ptr) verify_interval_modification (current_buffer, start, end); } + /* For indirect buffers, use the base buffer to check clashes. */ + if (current_buffer->base_buffer != 0) + base_buffer = current_buffer->base_buffer; + else + base_buffer = current_buffer; + #ifdef CLASH_DETECTION - if (!NILP (current_buffer->file_truename) + if (!NILP (base_buffer->file_truename) /* Make binding buffer-file-name to nil effective. */ - && !NILP (current_buffer->filename) + && !NILP (base_buffer->filename) && SAVE_MODIFF >= MODIFF) - lock_file (current_buffer->file_truename); + lock_file (base_buffer->file_truename); #else /* At least warn if this file has changed on disk since it was visited. */ - if (!NILP (current_buffer->filename) + if (!NILP (base_buffer->filename) && SAVE_MODIFF >= MODIFF && NILP (Fverify_visited_file_modtime (Fcurrent_buffer ())) - && !NILP (Ffile_exists_p (current_buffer->filename))) + && !NILP (Ffile_exists_p (base_buffer->filename))) call1 (intern ("ask-user-about-supersession-threat"), - current_buffer->filename); + base_buffer->filename); #endif /* not CLASH_DETECTION */ signal_before_change (start, end, preserve_ptr); diff --git a/src/keyboard.c b/src/keyboard.c index 6e046aea7d6..025c8a3f85c 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -1564,7 +1564,8 @@ command_loop_1 () int count = SPECPDL_INDEX (); specbind (Qinhibit_quit, Qt); - Fsit_for (Vminibuffer_message_timeout, Qnil, Qnil); + sit_for (Vminibuffer_message_timeout, 0, 2); + /* Clear the echo area. */ message2 (0, 0, 0); safe_run_hooks (Qecho_area_clear_hook); @@ -2778,8 +2779,6 @@ read_char (commandflag, nmaps, maps, prev_event, used_mouse_menu) /* Or not echoing before and echoing allowed. */ || (!echo_kboard && ok_to_echo_at_next_pause))) { - Lisp_Object tem0; - /* After a mouse event, start echoing right away. This is because we are probably about to display a menu, and we don't want to delay before doing so. */ @@ -2787,13 +2786,11 @@ read_char (commandflag, nmaps, maps, prev_event, used_mouse_menu) echo_now (); else { - int sec, usec; - double duration = extract_float (Vecho_keystrokes); - sec = (int) duration; - usec = (duration - sec) * 1000000; + Lisp_Object tem0; + save_getcjmp (save_jump); restore_getcjmp (local_getcjmp); - tem0 = sit_for (sec, usec, 1, 1, 0); + tem0 = sit_for (Vecho_keystrokes, 1, 1); restore_getcjmp (save_jump); if (EQ (tem0, Qt) && ! CONSP (Vunread_command_events)) @@ -2860,11 +2857,11 @@ read_char (commandflag, nmaps, maps, prev_event, used_mouse_menu) && XINT (Vauto_save_timeout) > 0) { Lisp_Object tem0; + int timeout = delay_level * XFASTINT (Vauto_save_timeout) / 4; save_getcjmp (save_jump); restore_getcjmp (local_getcjmp); - tem0 = sit_for (delay_level * XFASTINT (Vauto_save_timeout) / 4, - 0, 1, 1, 0); + tem0 = sit_for (make_number (timeout), 1, 1); restore_getcjmp (save_jump); if (EQ (tem0, Qt) @@ -8574,7 +8571,7 @@ access_keymap_keyremap (map, key, prompt, do_funcall) /* Handle a symbol whose function definition is a keymap or an array. */ if (SYMBOLP (next) && !NILP (Ffboundp (next)) - && (!NILP (Farrayp (XSYMBOL (next)->function)) + && (ARRAYP (XSYMBOL (next)->function) || KEYMAPP (XSYMBOL (next)->function))) next = XSYMBOL (next)->function; @@ -9976,7 +9973,13 @@ a special event, so ignore the prefix argument and don't clear it. */) DEFUN ("execute-extended-command", Fexecute_extended_command, Sexecute_extended_command, 1, 1, "P", - doc: /* Read function name, then read its arguments and call it. */) + doc: /* Read function name, then read its arguments and call it. + +To pass a numeric argument to the command you are invoking with, specify +the numeric argument to this command. + +Noninteractively, the argument PREFIXARG is the prefix argument to +give to the command you invoke, if it asks for an argument. */) (prefixarg) Lisp_Object prefixarg; { @@ -10082,19 +10085,18 @@ DEFUN ("execute-extended-command", Fexecute_extended_command, Sexecute_extended_ Qmouse_movement))) { /* But first wait, and skip the message if there is input. */ - int delay_time; - if (!NILP (echo_area_buffer[0])) - /* This command displayed something in the echo area; - so wait a few seconds, then display our suggestion message. */ - delay_time = (NUMBERP (Vsuggest_key_bindings) - ? XINT (Vsuggest_key_bindings) : 2); + Lisp_Object waited; + + /* If this command displayed something in the echo area; + wait a few seconds, then display our suggestion message. */ + if (NILP (echo_area_buffer[0])) + waited = sit_for (make_number (0), 0, 2); + else if (NUMBERP (Vsuggest_key_bindings)) + waited = sit_for (Vminibuffer_message_timeout, 0, 2); else - /* This command left the echo area empty, - so display our message immediately. */ - delay_time = 0; + waited = sit_for (make_number (2), 0, 2); - if (!NILP (Fsit_for (make_number (delay_time), Qnil, Qnil)) - && ! CONSP (Vunread_command_events)) + if (!NILP (waited) && ! CONSP (Vunread_command_events)) { Lisp_Object binding; char *newmessage; @@ -10114,10 +10116,12 @@ DEFUN ("execute-extended-command", Fexecute_extended_command, Sexecute_extended_ message2_nolog (newmessage, strlen (newmessage), STRING_MULTIBYTE (binding)); - if (!NILP (Fsit_for ((NUMBERP (Vsuggest_key_bindings) - ? Vsuggest_key_bindings : make_number (2)), - Qnil, Qnil)) - && message_p) + if (NUMBERP (Vsuggest_key_bindings)) + waited = sit_for (Vsuggest_key_bindings, 0, 2); + else + waited = sit_for (make_number (2), 0, 2); + + if (!NILP (waited) && message_p) restore_message (); unbind_to (count, Qnil); diff --git a/src/keymap.c b/src/keymap.c index d856b058dc7..0197319957c 100644 --- a/src/keymap.c +++ b/src/keymap.c @@ -1131,8 +1131,7 @@ binding KEY to DEF is added at the front of KEYMAP. */) GCPRO3 (keymap, key, def); keymap = get_keymap (keymap, 1, 1); - if (!VECTORP (key) && !STRINGP (key)) - key = wrong_type_argument (Qarrayp, key); + CHECK_VECTOR_OR_STRING (key); length = XFASTINT (Flength (key)); if (length == 0) @@ -1242,8 +1241,7 @@ recognize the default bindings, just as `read-key-sequence' does. */) GCPRO2 (keymap, key); keymap = get_keymap (keymap, 1, 1); - if (!VECTORP (key) && !STRINGP (key)) - key = wrong_type_argument (Qarrayp, key); + CHECK_VECTOR_OR_STRING (key); length = XFASTINT (Flength (key)); if (length == 0) diff --git a/src/lisp.h b/src/lisp.h index 1a9e11b54dd..7b70b0a9d17 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -591,6 +591,12 @@ extern size_t pure_size; #define STRING_COPYIN(string, index, new, count) \ bcopy (new, XSTRING (string)->data + index, count) +/* Type checking. */ + +#define CHECK_TYPE(ok, Qxxxp, x) \ + do { if (!(ok)) wrong_type_argument (Qxxxp, (x)); } while (0) + + /* See the macros in intervals.h. */ @@ -598,8 +604,8 @@ typedef struct interval *INTERVAL; /* Complain if object is not string or buffer type */ #define CHECK_STRING_OR_BUFFER(x) \ - { if (!STRINGP ((x)) && !BUFFERP ((x))) \ - x = wrong_type_argument (Qbuffer_or_string_p, (x)); } + CHECK_TYPE (STRINGP (x) || BUFFERP (x), Qbuffer_or_string_p, x) + /* In a cons, the markbit of the car is the gc mark bit */ @@ -668,6 +674,13 @@ struct Lisp_Cons : NILP ((c)) ? Qnil \ : wrong_type_argument (Qlistp, (c))) +/* Take the car or cdr of something whose type is not known. */ +#define CAR_SAFE(c) \ + (CONSP ((c)) ? XCAR ((c)) : Qnil) + +#define CDR_SAFE(c) \ + (CONSP ((c)) ? XCDR ((c)) : Qnil) + /* Nonzero if STR is a multibyte string. */ #define STRING_MULTIBYTE(STR) \ (XSTRING (STR)->size_byte >= 0) @@ -1053,13 +1066,8 @@ struct Lisp_Hash_Table #define HASH_TABLE_P(OBJ) PSEUDOVECTORP (OBJ, PVEC_HASH_TABLE) #define GC_HASH_TABLE_P(x) GC_PSEUDOVECTORP (x, PVEC_HASH_TABLE) -#define CHECK_HASH_TABLE(x) \ - do \ - { \ - if (!HASH_TABLE_P ((x))) \ - x = wrong_type_argument (Qhash_table_p, (x)); \ - } \ - while (0) +#define CHECK_HASH_TABLE(x) \ + CHECK_TYPE (HASH_TABLE_P (x), Qhash_table_p, x) /* Value is the key part of entry IDX in hash table H. */ @@ -1524,41 +1532,57 @@ typedef unsigned char UCHAR; /* Test for image (image . spec) */ #define IMAGEP(x) (CONSP (x) && EQ (XCAR (x), Qimage)) +/* Array types. */ + +#define ARRAYP(x) \ + (VECTORP (x) || STRINGP (x) || CHAR_TABLE_P (x) || BOOL_VECTOR_P (x)) #define GC_EQ(x, y) EQ (x, y) #define CHECK_LIST(x) \ - do { if (!CONSP ((x)) && !NILP (x)) x = wrong_type_argument (Qlistp, (x)); } while (0) + CHECK_TYPE (CONSP (x) || NILP (x), Qlistp, x) + +#define CHECK_LIST_CONS(x, y) \ + CHECK_TYPE (CONSP (x), Qlistp, y) + +#define CHECK_LIST_END(x, y) \ + CHECK_TYPE (NILP (x), Qlistp, y) #define CHECK_STRING(x) \ - do { if (!STRINGP ((x))) x = wrong_type_argument (Qstringp, (x)); } while (0) + CHECK_TYPE (STRINGP (x), Qstringp, x) #define CHECK_STRING_CAR(x) \ - do { if (!STRINGP (XCAR (x))) XSETCAR (x, wrong_type_argument (Qstringp, XCAR (x))); } while (0) + CHECK_TYPE (STRINGP (XCAR (x)), Qstringp, XCAR (x)) #define CHECK_CONS(x) \ - do { if (!CONSP ((x))) x = wrong_type_argument (Qconsp, (x)); } while (0) + CHECK_TYPE (CONSP (x), Qconsp, x) #define CHECK_SYMBOL(x) \ - do { if (!SYMBOLP ((x))) x = wrong_type_argument (Qsymbolp, (x)); } while (0) + CHECK_TYPE (SYMBOLP (x), Qsymbolp, x) #define CHECK_CHAR_TABLE(x) \ - do { if (!CHAR_TABLE_P ((x))) \ - x = wrong_type_argument (Qchar_table_p, (x)); } while (0) + CHECK_TYPE (CHAR_TABLE_P (x), Qchar_table_p, x) #define CHECK_VECTOR(x) \ - do { if (!VECTORP ((x))) x = wrong_type_argument (Qvectorp, (x)); } while (0) + CHECK_TYPE (VECTORP (x), Qvectorp, x) -#define CHECK_VECTOR_OR_CHAR_TABLE(x) \ - do { if (!VECTORP ((x)) && !CHAR_TABLE_P ((x))) \ - x = wrong_type_argument (Qvector_or_char_table_p, (x)); \ - } while (0) +#define CHECK_VECTOR_OR_STRING(x) \ + CHECK_TYPE (VECTORP (x) || STRINGP (x), Qarrayp, x) + +#define CHECK_ARRAY(x, Qxxxp) \ + CHECK_TYPE (ARRAYP (x), Qxxxp, x) + +#define CHECK_VECTOR_OR_CHAR_TABLE(x) \ + CHECK_TYPE (VECTORP (x) || CHAR_TABLE_P (x), Qvector_or_char_table_p, x) #define CHECK_BUFFER(x) \ - do { if (!BUFFERP ((x))) x = wrong_type_argument (Qbufferp, (x)); } while (0) + CHECK_TYPE (BUFFERP (x), Qbufferp, x) #define CHECK_WINDOW(x) \ - do { if (!WINDOWP ((x))) x = wrong_type_argument (Qwindowp, (x)); } while (0) + CHECK_TYPE (WINDOWP (x), Qwindowp, x) + +#define CHECK_WINDOW_CONFIGURATION(x) \ + CHECK_TYPE (WINDOW_CONFIGURATIONP (x), Qwindow_configuration_p, x) /* This macro rejects windows on the interior of the window tree as "dead", which is what we want; this is an argument-checking macro, and @@ -1567,46 +1591,42 @@ typedef unsigned char UCHAR; A window of any sort, leaf or interior, is dead iff the buffer, vchild, and hchild members are all nil. */ -#define CHECK_LIVE_WINDOW(x) \ - do { \ - if (!WINDOWP ((x)) \ - || NILP (XWINDOW ((x))->buffer)) \ - x = wrong_type_argument (Qwindow_live_p, (x)); \ - } while (0) +#define CHECK_LIVE_WINDOW(x) \ + CHECK_TYPE (WINDOWP (x) && !NILP (XWINDOW (x)->buffer), Qwindow_live_p, x) #define CHECK_PROCESS(x) \ - do { if (!PROCESSP ((x))) x = wrong_type_argument (Qprocessp, (x)); } while (0) + CHECK_TYPE (PROCESSP (x), Qprocessp, x) + +#define CHECK_SUBR(x) \ + CHECK_TYPE (SUBRP (x), Qsubrp, x) #define CHECK_NUMBER(x) \ - do { if (!INTEGERP ((x))) x = wrong_type_argument (Qintegerp, (x)); } while (0) + CHECK_TYPE (INTEGERP (x), Qintegerp, x) #define CHECK_NATNUM(x) \ - do { if (!NATNUMP (x)) x = wrong_type_argument (Qwholenump, (x)); } while (0) + CHECK_TYPE (NATNUMP (x), Qwholenump, x) #define CHECK_MARKER(x) \ - do { if (!MARKERP ((x))) x = wrong_type_argument (Qmarkerp, (x)); } while (0) + CHECK_TYPE (MARKERP (x), Qmarkerp, x) #define CHECK_NUMBER_COERCE_MARKER(x) \ do { if (MARKERP ((x))) XSETFASTINT (x, marker_position (x)); \ - else if (!INTEGERP ((x))) x = wrong_type_argument (Qinteger_or_marker_p, (x)); } while (0) + else CHECK_TYPE (INTEGERP (x), Qinteger_or_marker_p, x); } while (0) #define XFLOATINT(n) extract_float((n)) #define CHECK_FLOAT(x) \ - do { if (!FLOATP (x)) \ - x = wrong_type_argument (Qfloatp, (x)); } while (0) + CHECK_TYPE (FLOATP (x), Qfloatp, x) #define CHECK_NUMBER_OR_FLOAT(x) \ - do { if (!FLOATP (x) && !INTEGERP (x)) \ - x = wrong_type_argument (Qnumberp, (x)); } while (0) + CHECK_TYPE (FLOATP (x) || INTEGERP (x), Qnumberp, x) #define CHECK_NUMBER_OR_FLOAT_COERCE_MARKER(x) \ do { if (MARKERP (x)) XSETFASTINT (x, marker_position (x)); \ - else if (!INTEGERP (x) && !FLOATP (x)) \ - x = wrong_type_argument (Qnumber_or_marker_p, (x)); } while (0) + else CHECK_TYPE (INTEGERP (x) || FLOATP (x), Qnumber_or_marker_p, x); } while (0) #define CHECK_OVERLAY(x) \ - do { if (!OVERLAYP ((x))) x = wrong_type_argument (Qoverlayp, (x));} while (0) + CHECK_TYPE (OVERLAYP (x), Qoverlayp, x) /* Since we can't assign directly to the CAR or CDR fields of a cons cell, use these when checking that those fields contain numbers. */ @@ -2469,8 +2489,8 @@ EXFUN (Fding, 1); EXFUN (Fredraw_frame, 1); EXFUN (Fredraw_display, 0); EXFUN (Fsleep_for, 2); -EXFUN (Fsit_for, 3); -extern Lisp_Object sit_for P_ ((int, int, int, int, int)); +EXFUN (Fredisplay, 1); +extern Lisp_Object sit_for P_ ((Lisp_Object, int, int)); extern void init_display P_ ((void)); extern void syms_of_display P_ ((void)); extern void safe_bcopy P_ ((const char *, char *, int)); diff --git a/src/lread.c b/src/lread.c index 8789ad03e1c..91825bce152 100644 --- a/src/lread.c +++ b/src/lread.c @@ -461,7 +461,7 @@ read_filtered_event (no_switch_frame, ascii_required, error_nonascii, input_method) int no_switch_frame, ascii_required, error_nonascii, input_method; { - volatile register Lisp_Object val, delayed_switch_frame; + Lisp_Object val, delayed_switch_frame; #ifdef HAVE_WINDOW_SYSTEM if (display_hourglass_p) @@ -486,7 +486,7 @@ read_filtered_event (no_switch_frame, ascii_required, error_nonascii, switch-frame events will read it and process it. */ if (no_switch_frame && EVENT_HAS_PARAMETERS (val) - && EQ (EVENT_HEAD (val), Qswitch_frame)) + && EQ (EVENT_HEAD_KIND (EVENT_HEAD (val)), Qswitch_frame)) { delayed_switch_frame = val; goto retry; @@ -1371,7 +1371,6 @@ readevalloop (readcharfun, stream, sourcename, evalfun, int count = SPECPDL_INDEX (); struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; struct buffer *b = 0; - int bpos; int continue_reading_p; /* Nonzero if reading an entire buffer. */ int whole_buffer = 0; @@ -1381,7 +1380,7 @@ readevalloop (readcharfun, stream, sourcename, evalfun, if (MARKERP (readcharfun)) { if (NILP (start)) - start = readcharfun; + start = readcharfun; } if (BUFFERP (readcharfun)) @@ -1404,8 +1403,8 @@ readevalloop (readcharfun, stream, sourcename, evalfun, /* Try to ensure sourcename is a truename, except whilst preloading. */ if (NILP (Vpurify_flag) - && !NILP (sourcename) && Ffile_name_absolute_p (sourcename) - && (!NILP (Ffboundp (Qfile_truename)))) + && !NILP (sourcename) && !NILP (Ffile_name_absolute_p (sourcename)) + && !NILP (Ffboundp (Qfile_truename))) sourcename = call1 (Qfile_truename, sourcename) ; LOADHIST_ATTACH (sourcename); @@ -1514,7 +1513,7 @@ readevalloop (readcharfun, stream, sourcename, evalfun, first_sexp = 0; } - build_load_history (sourcename, + build_load_history (sourcename, stream || whole_buffer); UNGCPRO; @@ -3252,12 +3251,11 @@ Lisp_Object check_obarray (obarray) Lisp_Object obarray; { - while (!VECTORP (obarray) || XVECTOR (obarray)->size == 0) + if (!VECTORP (obarray) || XVECTOR (obarray)->size == 0) { /* If Vobarray is now invalid, force it to be valid. */ if (EQ (Vobarray, obarray)) Vobarray = initial_obarray; - - obarray = wrong_type_argument (Qvectorp, obarray); + wrong_type_argument (Qvectorp, obarray); } return obarray; } diff --git a/src/mac.c b/src/mac.c index 5fc9ea4ee28..4652757fab3 100644 --- a/src/mac.c +++ b/src/mac.c @@ -46,11 +46,9 @@ Boston, MA 02110-1301, USA. */ #include <Folders.h> #include <Resources.h> #include <Aliases.h> -#include <FixMath.h> #include <Timer.h> #include <OSA.h> #include <AppleScript.h> -#include <Scrap.h> #include <Events.h> #include <Processes.h> #include <EPPC.h> @@ -4627,8 +4625,7 @@ otherwise. */) CHECK_CONS (key); for (tmp = key; CONSP (tmp); tmp = XCDR (tmp)) CHECK_STRING_CAR (tmp); - if (!NILP (tmp)) - wrong_type_argument (Qlistp, key); + CHECK_LIST_END (tmp, key); } if (!NILP (application)) CHECK_STRING (application); diff --git a/src/macfns.c b/src/macfns.c index a053bc66763..8716f072411 100644 --- a/src/macfns.c +++ b/src/macfns.c @@ -2646,8 +2646,7 @@ This function is an internal primitive--use `make-frame' instead. */) error ("Cannot find any usable font"); UNBLOCK_INPUT; - x_default_parameter (f, parms, Qfont, font, - "font", "Font", RES_TYPE_STRING); + x_set_frame_parameters (f, Fcons (Fcons (Qfont, font), Qnil)); } x_default_parameter (f, parms, Qborder_width, make_number (0), diff --git a/src/macgui.h b/src/macgui.h index a93131e565e..1ea53af59be 100644 --- a/src/macgui.h +++ b/src/macgui.h @@ -112,7 +112,7 @@ typedef unsigned long Time; /* Whether to use Text Services Manager. */ #ifndef USE_MAC_TSM -#ifdef MAC_OSX +#if TARGET_API_MAC_CARBON #define USE_MAC_TSM 1 #endif #endif diff --git a/src/macros.c b/src/macros.c index ef3ff8c0523..fb452e4e318 100644 --- a/src/macros.c +++ b/src/macros.c @@ -97,10 +97,7 @@ macro before appending to it. */) int cvt; /* Check the type of last-kbd-macro in case Lisp code changed it. */ - if (!STRINGP (current_kboard->Vlast_kbd_macro) - && !VECTORP (current_kboard->Vlast_kbd_macro)) - current_kboard->Vlast_kbd_macro - = wrong_type_argument (Qarrayp, current_kboard->Vlast_kbd_macro); + CHECK_VECTOR_OR_STRING (current_kboard->Vlast_kbd_macro); len = XINT (Flength (current_kboard->Vlast_kbd_macro)); diff --git a/src/macterm.c b/src/macterm.c index 19040392aa5..8d627446f65 100644 --- a/src/macterm.c +++ b/src/macterm.c @@ -196,6 +196,8 @@ static int input_signal_count; extern Lisp_Object Vsystem_name; +extern Lisp_Object Qeql; + /* A mask of extra modifier bits to put into every keyboard char. */ extern EMACS_INT extra_keyboard_modifiers; @@ -6031,13 +6033,28 @@ x_set_mouse_pixel_position (f, pix_x, pix_y) struct frame *f; int pix_x, pix_y; { -#if 0 /* MAC_TODO: CursorDeviceMoveTo is non-Carbon */ +#ifdef MAC_OSX + Point p; + CGPoint point; + + BLOCK_INPUT; + SetPortWindowPort (FRAME_MAC_WINDOW (f)); + p.h = pix_x; + p.v = pix_y; + LocalToGlobal (&p); + point.x = p.h; + point.y = p.v; + CGWarpMouseCursorPosition (point); + UNBLOCK_INPUT; +#else +#if 0 /* MAC_TODO: LMSetMouseLocation and CursorDeviceMoveTo are non-Carbon */ BLOCK_INPUT; XWarpPointer (FRAME_X_DISPLAY (f), None, FRAME_X_WINDOW (f), 0, 0, 0, 0, pix_x, pix_y); UNBLOCK_INPUT; #endif +#endif } /* focus shifting, raising and lowering. */ @@ -6897,6 +6914,8 @@ static Lisp_Object fm_font_family_alist; #if USE_ATSUI /* Hash table linking font family names to ATSU font IDs. */ static Lisp_Object atsu_font_id_hash; +/* Alist linking Font Manager style to face attributes. */ +static Lisp_Object fm_style_face_attributes_alist; static Lisp_Object Vmac_atsu_font_table; extern Lisp_Object QCfamily, QCweight, QCslant, Qnormal, Qbold, Qitalic; #endif @@ -7132,6 +7151,29 @@ add_mac_font_name (name, size, style, charset) } } +#if USE_ATSUI +static Lisp_Object +fm_style_to_face_attributes (fm_style) + FMFontStyle fm_style; +{ + Lisp_Object tem; + + fm_style &= (bold | italic); + tem = assq_no_quit (make_number (fm_style), + fm_style_face_attributes_alist); + if (!NILP (tem)) + return XCDR (tem); + + tem = list4 (QCweight, fm_style & bold ? Qbold : Qnormal, + QCslant, fm_style & italic ? Qitalic : Qnormal); + fm_style_face_attributes_alist = + Fcons (Fcons (make_number (fm_style), tem), + fm_style_face_attributes_alist); + + return tem; +} +#endif + /* Sets up the table font_name_table to contain the list of all fonts in the system the first time the table is used so that the Resource Manager need not be accessed every time this information is @@ -7200,14 +7242,12 @@ init_font_name_table () decode_mac_font_name (name, name_len + 1, Qnil); family = make_unibyte_string (name, name_len); FMGetFontFamilyInstanceFromFont (font_ids[i], &ff, &style); - Fputhash (make_unibyte_string ((char *)(font_ids + i), - sizeof (ATSUFontID)), + Fputhash ((font_ids[i] > MOST_POSITIVE_FIXNUM + ? make_float (font_ids[i]) + : make_number (font_ids[i])), Fcons (QCfamily, - list5 (family, - QCweight, - style & bold ? Qbold : Qnormal, - QCslant, - style & italic ? Qitalic : Qnormal)), + Fcons (family, + fm_style_to_face_attributes (style))), Vmac_atsu_font_table); if (*name != '.' && hash_lookup (h, family, &hash_code) < 0) @@ -8513,6 +8553,7 @@ static Lisp_Object Qupdate_active_input_area, Qunicode_for_key_event; static Lisp_Object Vmac_ts_active_input_overlay; extern Lisp_Object Qbefore_string; static Lisp_Object Vmac_ts_script_language_on_focus; +static Lisp_Object saved_ts_script_language_on_focus; static ScriptLanguageRecord saved_ts_language; static Component saved_ts_component; #endif @@ -8875,11 +8916,17 @@ mac_tsm_resume () if (err == noErr) { - if (EQ (Vmac_ts_script_language_on_focus, Qt)) + if (EQ (Vmac_ts_script_language_on_focus, Qt) + && EQ (saved_ts_script_language_on_focus, Qt)) slptr = &saved_ts_language; else if (CONSP (Vmac_ts_script_language_on_focus) && INTEGERP (XCAR (Vmac_ts_script_language_on_focus)) - && INTEGERP (XCDR (Vmac_ts_script_language_on_focus))) + && INTEGERP (XCDR (Vmac_ts_script_language_on_focus)) + && CONSP (saved_ts_script_language_on_focus) + && EQ (XCAR (saved_ts_script_language_on_focus), + XCAR (Vmac_ts_script_language_on_focus)) + && EQ (XCDR (saved_ts_script_language_on_focus), + XCDR (Vmac_ts_script_language_on_focus))) { slrec.fScript = XINT (XCAR (Vmac_ts_script_language_on_focus)); slrec.fLanguage = XINT (XCDR (Vmac_ts_script_language_on_focus)); @@ -8912,6 +8959,8 @@ mac_tsm_suspend () OSStatus err; ScriptLanguageRecord slrec, *slptr = NULL; + saved_ts_script_language_on_focus = Vmac_ts_script_language_on_focus; + if (EQ (Vmac_ts_script_language_on_focus, Qt)) { err = GetTextServiceLanguage (&saved_ts_language); @@ -9560,7 +9609,11 @@ mac_handle_text_input_event (next_handler, event, data) typeLongInteger, typeIntlWritingCode, typeLongInteger, +#ifdef MAC_OSX typeUnicodeText, +#else + typeChar, +#endif typeTextRangeArray, typeTextRangeArray, typeOffsetArray, @@ -10646,7 +10699,7 @@ XTread_socket (sd, expected, hold_quit) #endif mapped_modifiers &= modifiers; -#if USE_CARBON_EVENTS && defined (MAC_OSX) +#if USE_CARBON_EVENTS && (defined (MAC_OSX) || USE_MAC_TSM) /* When using Carbon Events, we need to pass raw keyboard events to the TSM ourselves. If TSM handles it, it will pass back noErr, otherwise it will pass back @@ -11302,7 +11355,11 @@ init_menu_bar () static void init_tsm () { +#ifdef MAC_OSX static InterfaceTypeList types = {kUnicodeDocument}; +#else + static InterfaceTypeList types = {kTextService}; +#endif NewTSMDocument (sizeof (types) / sizeof (types[0]), types, &tsm_document_id, 0); @@ -11491,6 +11548,14 @@ syms_of_macterm () #if USE_ATSUI staticpro (&atsu_font_id_hash); atsu_font_id_hash = Qnil; + + staticpro (&fm_style_face_attributes_alist); + fm_style_face_attributes_alist = Qnil; +#endif + +#if USE_MAC_TSM + staticpro (&saved_ts_script_language_on_focus); + saved_ts_script_language_on_focus = Qnil; #endif /* We don't yet support this, but defining this here avoids whining @@ -11603,11 +11668,9 @@ CODING_SYSTEM is a coding system corresponding to TEXT-ENCODING. */); #if USE_ATSUI DEFVAR_LISP ("mac-atsu-font-table", &Vmac_atsu_font_table, - doc: /* Hash table of ATSU font IDs vs plist of attributes and values. -Each font ID is represented as a four-byte string in native byte -order. */); + doc: /* Hash table of ATSU font IDs vs plist of attributes and values. */); Vmac_atsu_font_table = - make_hash_table (Qequal, make_number (DEFAULT_HASH_SIZE), + make_hash_table (Qeql, make_number (DEFAULT_HASH_SIZE), make_float (DEFAULT_REHASH_SIZE), make_float (DEFAULT_REHASH_THRESHOLD), Qnil, Qnil, Qnil); diff --git a/src/marker.c b/src/marker.c index 79a7d702bdf..20b660ddadd 100644 --- a/src/marker.c +++ b/src/marker.c @@ -835,8 +835,7 @@ see `marker-insertion-type'. */) { register Lisp_Object new; - if (! (INTEGERP (marker) || MARKERP (marker))) - marker = wrong_type_argument (Qinteger_or_marker_p, marker); + CHECK_TYPE (INTEGERP (marker) || MARKERP (marker), Qinteger_or_marker_p, marker); new = Fmake_marker (); Fset_marker (new, marker, diff --git a/src/minibuf.c b/src/minibuf.c index 9a1a3636e97..e4296ad8cd2 100644 --- a/src/minibuf.c +++ b/src/minibuf.c @@ -2698,7 +2698,7 @@ temp_echo_area_glyphs (string) insert_from_string (string, 0, 0, SCHARS (string), SBYTES (string), 0); SET_PT_BOTH (opoint, opoint_byte); Vinhibit_quit = Qt; - Fsit_for (make_number (2), Qnil, Qnil); + sit_for (make_number (2), 0, 2); del_range_both (osize, osize_byte, ZV, ZV_BYTE, 1); SET_PT_BOTH (opoint, opoint_byte); if (!NILP (Vquit_flag)) diff --git a/src/process.c b/src/process.c index 965b33c52c3..9dadc1ab4ab 100644 --- a/src/process.c +++ b/src/process.c @@ -5165,7 +5165,7 @@ read_process_output (proc, channel) #endif /* But do it only if the caller is actually going to read events. Otherwise there's no need to make him wake up, and it could - cause trouble (for example it would make Fsit_for return). */ + cause trouble (for example it would make sit_for return). */ if (waiting_for_user_input_p == -1) record_asynch_buffer_change (); @@ -6612,7 +6612,7 @@ exec_sentinel (proc, reason) #endif /* But do it only if the caller is actually going to read events. Otherwise there's no need to make him wake up, and it could - cause trouble (for example it would make Fsit_for return). */ + cause trouble (for example it would make sit_for return). */ if (waiting_for_user_input_p == -1) record_asynch_buffer_change (); diff --git a/src/s/gnu-linux.h b/src/s/gnu-linux.h index 5d247a1c9c8..817f1facdee 100644 --- a/src/s/gnu-linux.h +++ b/src/s/gnu-linux.h @@ -250,6 +250,7 @@ Boston, MA 02110-1301, USA. */ #define C_DEBUG_SWITCH #endif +/* 21 Jun 06: Eric Hanchrow <offby1@blarg.net> says this works. */ #ifdef LINUX_SIGNALS_VIA_CHARACTERS_DOES_WORK #define SIGNALS_VIA_CHARACTERS #endif diff --git a/src/search.c b/src/search.c index 99db7f184fc..fe124091009 100644 --- a/src/search.c +++ b/src/search.c @@ -2874,8 +2874,7 @@ If optional arg RESEAT is non-nil, make markers on LIST point nowhere. */) if (running_asynch_code) save_search_regs (); - if (!CONSP (list) && !NILP (list)) - list = wrong_type_argument (Qconsp, list); + CHECK_LIST (list); /* Unless we find a marker with a buffer or an explicit buffer in LIST, assume that this match data came from a string. */ diff --git a/src/sunfns.c b/src/sunfns.c index 1c04f1108a8..336f02221cf 100644 --- a/src/sunfns.c +++ b/src/sunfns.c @@ -363,7 +363,7 @@ sun_item_create (Pair) Lisp_Object String; Lisp_Object Value; - if (!CONSP(Pair)) wrong_type_argument(Qlistp, Pair); + CHECK_LIST_CONS (Pair, Pair); String = Fcar(Pair); CHECK_STRING(String); Value = Fcdr(Pair); diff --git a/src/syntax.c b/src/syntax.c index 9af4773a01b..9959c17ad47 100644 --- a/src/syntax.c +++ b/src/syntax.c @@ -97,10 +97,11 @@ static int find_start_modiff; static int find_defun_start P_ ((int, int)); -static int back_comment P_ ((int, int, int, int, int, int *, int *)); +static int back_comment P_ ((EMACS_INT, EMACS_INT, EMACS_INT, int, int, + EMACS_INT *, EMACS_INT *)); static int char_quoted P_ ((int, int)); static Lisp_Object skip_chars P_ ((int, int, Lisp_Object, Lisp_Object, int)); -static Lisp_Object scan_lists P_ ((int, int, int, int)); +static Lisp_Object scan_lists P_ ((EMACS_INT, EMACS_INT, EMACS_INT, int)); static void scan_sexps_forward P_ ((struct lisp_parse_state *, int, int, int, int, int, Lisp_Object, int)); @@ -471,9 +472,9 @@ prev_char_comend_first (pos, pos_byte) static int back_comment (from, from_byte, stop, comnested, comstyle, charpos_ptr, bytepos_ptr) - int from, from_byte, stop; + EMACS_INT from, from_byte, stop; int comnested, comstyle; - int *charpos_ptr, *bytepos_ptr; + EMACS_INT *charpos_ptr, *bytepos_ptr; { /* Look back, counting the parity of string-quotes, and recording the comment-starters seen. @@ -748,9 +749,8 @@ static void check_syntax_table (obj) Lisp_Object obj; { - if (!(CHAR_TABLE_P (obj) - && EQ (XCHAR_TABLE (obj)->purpose, Qsyntax_table))) - wrong_type_argument (Qsyntax_table_p, obj); + CHECK_TYPE (CHAR_TABLE_P (obj) && EQ (XCHAR_TABLE (obj)->purpose, Qsyntax_table), + Qsyntax_table_p, obj); } DEFUN ("syntax-table", Fsyntax_table, Ssyntax_table, 0, 0, 0, @@ -1890,9 +1890,10 @@ in_classes (c, iso_classes) static int forw_comment (from, from_byte, stop, nesting, style, prev_syntax, charpos_ptr, bytepos_ptr, incomment_ptr) - int from, from_byte, stop; + EMACS_INT from, from_byte, stop; int nesting, style, prev_syntax; - int *charpos_ptr, *bytepos_ptr, *incomment_ptr; + EMACS_INT *charpos_ptr, *bytepos_ptr; + int *incomment_ptr; { register int c, c1; register enum syntaxcode code; @@ -1992,16 +1993,16 @@ between them, return t; otherwise return nil. */) (count) Lisp_Object count; { - register int from; - int from_byte; - register int stop; + register EMACS_INT from; + EMACS_INT from_byte; + register EMACS_INT stop; register int c, c1; register enum syntaxcode code; int comstyle = 0; /* style of comment encountered */ int comnested = 0; /* whether the comment is nestable or not */ int found; - int count1; - int out_charpos, out_bytepos; + EMACS_INT count1; + EMACS_INT out_charpos, out_bytepos; int dummy; CHECK_NUMBER (count); @@ -2199,11 +2200,12 @@ between them, return t; otherwise return nil. */) static Lisp_Object scan_lists (from, count, depth, sexpflag) - register int from; - int count, depth, sexpflag; + register EMACS_INT from; + EMACS_INT count, depth; + int sexpflag; { Lisp_Object val; - register int stop = count > 0 ? ZV : BEGV; + register EMACS_INT stop = count > 0 ? ZV : BEGV; register int c, c1; int stringterm; int quoted; @@ -2212,11 +2214,11 @@ scan_lists (from, count, depth, sexpflag) int min_depth = depth; /* Err out if depth gets less than this. */ int comstyle = 0; /* style of comment encountered */ int comnested = 0; /* whether the comment is nestable or not */ - int temp_pos; - int last_good = from; + EMACS_INT temp_pos; + EMACS_INT last_good = from; int found; - int from_byte; - int out_bytepos, out_charpos; + EMACS_INT from_byte; + EMACS_INT out_bytepos, out_charpos; int temp, dummy; int multibyte_symbol_p = sexpflag && multibyte_syntax_as_symbol; @@ -2700,7 +2702,7 @@ scan_sexps_forward (stateptr, from, from_byte, end, targetdepth, int boundary_stop = commentstop == -1; int nofence; int found; - int out_bytepos, out_charpos; + EMACS_INT out_bytepos, out_charpos; int temp; prev_from = from; diff --git a/src/textprop.c b/src/textprop.c index 87fa6742919..0318d12913f 100644 --- a/src/textprop.c +++ b/src/textprop.c @@ -690,10 +690,11 @@ overlays are considered only if they are associated with OBJECT. */) DEFUN ("get-char-property-and-overlay", Fget_char_property_and_overlay, Sget_char_property_and_overlay, 2, 3, 0, doc: /* Like `get-char-property', but with extra overlay information. -Return a cons whose car is the return value of `get-char-property' -with the same arguments, that is, the value of POSITION's property -PROP in OBJECT, and whose cdr is the overlay in which the property was +The value is a cons cell. Its car is the return value of `get-char-property' +with the same arguments--that is, the value of POSITION's property +PROP in OBJECT. Its cdr is the overlay in which the property was found, or nil, if it was found as a text property or not found at all. + OBJECT is optional and defaults to the current buffer. OBJECT may be a string, a buffer or a window. For strings, the cdr of the return value is always nil, since strings do not have overlays. If OBJECT is @@ -1787,8 +1788,12 @@ text_property_stickiness (prop, pos, buffer) /* PROP is rear-non-sticky. */ is_rear_sticky = 0; } + else + return 0; /* Consider following character. */ + /* This signals an arg-out-of-range error if pos is outside the + buffer's accessible range. */ front_sticky = Fget_text_property (pos, Qfront_sticky, buffer); if (EQ (front_sticky, Qt) diff --git a/src/w32console.c b/src/w32console.c index dbadee3b10d..0fc652bf55f 100644 --- a/src/w32console.c +++ b/src/w32console.c @@ -705,7 +705,7 @@ syms_of_ntterm () DEFVAR_BOOL ("w32-use-full-screen-buffer", &w32_use_full_screen_buffer, doc: /* Non-nil means make terminal frames use the full screen buffer dimensions. -This is desirable when running Emacs over telnet, and is the default. +This is desirable when running Emacs over telnet. A value of nil means use the current console window dimensions; this may be preferrable when working directly at the console with a large scroll-back buffer. */); diff --git a/src/w32fns.c b/src/w32fns.c index 25aa22f0683..66cac34b2d9 100644 --- a/src/w32fns.c +++ b/src/w32fns.c @@ -2085,8 +2085,8 @@ w32_createwindow (f) = CreateWindow (EMACS_CLASS, f->namebuf, f->output_data.w32->dwStyle | WS_CLIPCHILDREN, - f->left_pos, - f->top_pos, + CW_USEDEFAULT, + SW_SHOW, rect.right - rect.left, rect.bottom - rect.top, NULL, @@ -2107,6 +2107,11 @@ w32_createwindow (f) /* Do this to discard the default setting specified by our parent. */ ShowWindow (hwnd, SW_HIDE); + + /* Update frame positions. */ + GetWindowRect (hwnd, &rect); + f->left_pos = rect.left; + f->top_pos = rect.top; } } diff --git a/src/w32term.c b/src/w32term.c index f85a5334022..fdbbbb6327f 100644 --- a/src/w32term.c +++ b/src/w32term.c @@ -5665,7 +5665,22 @@ x_make_frame_visible (f) before the window gets really visible. */ if (! FRAME_ICONIFIED_P (f) && ! f->output_data.w32->asked_for_visible) - x_set_offset (f, f->left_pos, f->top_pos, 0); + { + RECT workarea_rect; + RECT window_rect; + + /* Adjust vertical window position in order to avoid being + covered by a task bar placed at the bottom of the desktop. */ + SystemParametersInfo(SPI_GETWORKAREA, 0, &workarea_rect, 0); + GetWindowRect(FRAME_W32_WINDOW(f), &window_rect); + if (window_rect.bottom > workarea_rect.bottom + && window_rect.top > workarea_rect.top) + f->top_pos = max (window_rect.top + - window_rect.bottom + workarea_rect.bottom, + workarea_rect.top); + + x_set_offset (f, f->left_pos, f->top_pos, 0); + } f->output_data.w32->asked_for_visible = 1; diff --git a/src/window.c b/src/window.c index f3960b96f2a..77e155675dd 100644 --- a/src/window.c +++ b/src/window.c @@ -3678,7 +3678,7 @@ displayed. */) DEFUN ("force-window-update", Fforce_window_update, Sforce_window_update, 0, 1, 0, - doc: /* Force redisplay of all windows. + doc: /* Force all windows to be updated on next redisplay. If optional arg OBJECT is a window, force redisplay of that window only. If OBJECT is a buffer or buffer name, force redisplay of all windows displaying that buffer. */) @@ -5885,8 +5885,7 @@ DEFUN ("window-configuration-frame", Fwindow_configuration_frame, Swindow_config register struct save_window_data *data; struct Lisp_Vector *saved_windows; - if (! WINDOW_CONFIGURATIONP (config)) - wrong_type_argument (Qwindow_configuration_p, config); + CHECK_WINDOW_CONFIGURATION (config); data = (struct save_window_data *) XVECTOR (config); saved_windows = XVECTOR (data->saved_windows); @@ -5911,8 +5910,7 @@ the return value is nil. Otherwise the value is t. */) FRAME_PTR f; int old_point = -1; - while (!WINDOW_CONFIGURATIONP (configuration)) - wrong_type_argument (Qwindow_configuration_p, configuration); + CHECK_WINDOW_CONFIGURATION (configuration); data = (struct save_window_data *) XVECTOR (configuration); saved_windows = XVECTOR (data->saved_windows); @@ -6951,10 +6949,8 @@ compare_window_configurations (c1, c2, ignore_positions) struct Lisp_Vector *sw1, *sw2; int i; - if (!WINDOW_CONFIGURATIONP (c1)) - wrong_type_argument (Qwindow_configuration_p, c1); - if (!WINDOW_CONFIGURATIONP (c2)) - wrong_type_argument (Qwindow_configuration_p, c2); + CHECK_WINDOW_CONFIGURATION (c1); + CHECK_WINDOW_CONFIGURATION (c2); d1 = (struct save_window_data *) XVECTOR (c1); d2 = (struct save_window_data *) XVECTOR (c2); diff --git a/src/xdisp.c b/src/xdisp.c index c7e6eda58ca..092c5d7c520 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -4474,7 +4474,9 @@ handle_composition_prop (it) return HANDLED_RECOMPUTE_PROPS; } + it->stop_charpos = end; push_it (it); + it->method = GET_FROM_COMPOSITION; it->cmp_id = id; it->cmp_len = COMPOSITION_LENGTH (prop); @@ -4484,7 +4486,6 @@ handle_composition_prop (it) it->len = (STRINGP (it->string) ? string_char_to_byte (it->string, end) : CHAR_TO_BYTE (end)) - pos_byte; - it->stop_charpos = end; handled = HANDLED_RETURN; } } @@ -9608,6 +9609,12 @@ display_tool_bar_line (it, height) /* Glyph doesn't fit on line. Backtrack. */ row->used[TEXT_AREA] = n_glyphs_before; *it = it_before; + /* If this is the only glyph on this line, it will never fit on the + toolbar, so skip it. But ensure there is at least one glyph, + so we don't accidentally disable the tool-bar. */ + if (n_glyphs_before == 0 + && (it->vpos > 0 || IT_STRING_CHARPOS (*it) < it->end_charpos-1)) + break; goto out; } @@ -9666,6 +9673,11 @@ display_tool_bar_line (it, height) } +/* Max tool-bar height. */ + +#define MAX_FRAME_TOOL_BAR_HEIGHT(f) \ + ((FRAME_LINE_HEIGHT (f) * FRAME_LINES (f))) + /* Value is the number of screen lines needed to make all tool-bar items of frame F visible. The number of actual rows needed is returned in *N_ROWS if non-NULL. */ @@ -9677,7 +9689,10 @@ tool_bar_lines_needed (f, n_rows) { struct window *w = XWINDOW (f->tool_bar_window); struct it it; - struct glyph_row *temp_row = w->desired_matrix->rows; + /* tool_bar_lines_needed is called from redisplay_tool_bar after building + the desired matrix, so use (unused) mode-line row as temporary row to + avoid destroying the first tool-bar row. */ + struct glyph_row *temp_row = MATRIX_MODE_LINE_ROW (w->desired_matrix); /* Initialize an iterator for iteration over F->desired_tool_bar_string in the tool-bar window of frame F. */ @@ -9783,13 +9798,13 @@ redisplay_tool_bar (f) int old_height = WINDOW_TOTAL_LINES (w); XSETFRAME (frame, f); - clear_glyph_matrix (w->desired_matrix); Fmodify_frame_parameters (frame, Fcons (Fcons (Qtool_bar_lines, make_number (nlines)), Qnil)); if (WINDOW_TOTAL_LINES (w) != old_height) { + clear_glyph_matrix (w->desired_matrix); fonts_changed_p = 1; return 1; } @@ -9841,17 +9856,20 @@ redisplay_tool_bar (f) if (auto_resize_tool_bars_p) { - int nlines; + int nlines, nrows; + int max_tool_bar_height = MAX_FRAME_TOOL_BAR_HEIGHT (f); /* If we couldn't display everything, change the tool-bar's - height. */ - if (IT_STRING_CHARPOS (it) < it.end_charpos) + height if there is room for more. */ + if (IT_STRING_CHARPOS (it) < it.end_charpos + && it.current_y < max_tool_bar_height) change_height_p = 1; + row = it.glyph_row - 1; + /* If there are blank lines at the end, except for a partially visible blank line at the end that is smaller than FRAME_LINE_HEIGHT, change the tool-bar's height. */ - row = it.glyph_row - 1; if (!row->displays_text_p && row->height >= FRAME_LINE_HEIGHT (f)) change_height_p = 1; @@ -9859,13 +9877,14 @@ redisplay_tool_bar (f) /* If row displays tool-bar items, but is partially visible, change the tool-bar's height. */ if (row->displays_text_p - && MATRIX_ROW_BOTTOM_Y (row) > it.last_visible_y) + && MATRIX_ROW_BOTTOM_Y (row) > it.last_visible_y + && MATRIX_ROW_BOTTOM_Y (row) < max_tool_bar_height) change_height_p = 1; /* Resize windows as needed by changing the `tool-bar-lines' frame parameter. */ if (change_height_p - && (nlines = tool_bar_lines_needed (f, &f->n_tool_bar_rows), + && (nlines = tool_bar_lines_needed (f, &nrows), nlines != WINDOW_TOTAL_LINES (w))) { extern Lisp_Object Qtool_bar_lines; @@ -9873,13 +9892,16 @@ redisplay_tool_bar (f) int old_height = WINDOW_TOTAL_LINES (w); XSETFRAME (frame, f); - clear_glyph_matrix (w->desired_matrix); Fmodify_frame_parameters (frame, Fcons (Fcons (Qtool_bar_lines, make_number (nlines)), Qnil)); if (WINDOW_TOTAL_LINES (w) != old_height) - fonts_changed_p = 1; + { + clear_glyph_matrix (w->desired_matrix); + f->n_tool_bar_rows = nrows; + fonts_changed_p = 1; + } } } diff --git a/src/xfaces.c b/src/xfaces.c index 1b9a9c079f1..398b56f42b6 100644 --- a/src/xfaces.c +++ b/src/xfaces.c @@ -1174,14 +1174,11 @@ load_pixmap (f, name, w_ptr, h_ptr) unsigned int *w_ptr, *h_ptr; { int bitmap_id; - Lisp_Object tem; if (NILP (name)) return 0; - tem = Fbitmap_spec_p (name); - if (NILP (tem)) - wrong_type_argument (Qbitmap_spec_p, name); + CHECK_TYPE (!NILP (Fbitmap_spec_p (name)), Qbitmap_spec_p, name); BLOCK_INPUT; if (CONSP (name)) @@ -4816,7 +4813,14 @@ x_update_menu_appearance (f) DEFUN ("face-attribute-relative-p", Fface_attribute_relative_p, Sface_attribute_relative_p, 2, 2, 0, - doc: /* Return non-nil if face ATTRIBUTE VALUE is relative. */) + doc: /* Check whether a face attribute value is relative. +Specifically, this function returns t if the attribute ATTRIBUTE +with the value VALUE is relative. + +A relative value is one that doesn't entirely override whatever is +inherited from another face. For most possible attributes, +the only relative value that users see is `unspecified'. +However, for :height, floating point values are also relative. */) (attribute, value) Lisp_Object attribute, value; { diff --git a/src/xfns.c b/src/xfns.c index e0cc89c6ebe..0e4b8860464 100644 --- a/src/xfns.c +++ b/src/xfns.c @@ -3096,7 +3096,6 @@ This function is an internal primitive--use `make-frame' instead. */) f->output_data.x->scroll_bar_top_shadow_pixel = -1; f->output_data.x->scroll_bar_bottom_shadow_pixel = -1; #endif /* USE_TOOLKIT_SCROLL_BARS */ - record_unwind_protect (unwind_create_frame, frame); f->icon_name = x_get_arg (dpyinfo, parms, Qicon_name, "iconName", "Title", @@ -3105,6 +3104,9 @@ This function is an internal primitive--use `make-frame' instead. */) f->icon_name = Qnil; FRAME_X_DISPLAY_INFO (f) = dpyinfo; + + /* With FRAME_X_DISPLAY_INFO set up, this unwind-protect is safe. */ + record_unwind_protect (unwind_create_frame, frame); #if GLYPH_DEBUG image_cache_refcount = FRAME_X_IMAGE_CACHE (f)->refcount; dpyinfo_refcount = dpyinfo->reference_count; diff --git a/src/xterm.c b/src/xterm.c index 975c9c68f39..14e71fffa80 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -10841,13 +10841,16 @@ x_delete_display (dpyinfo) xfree (dpyinfo->font_table[i].name); } - if (dpyinfo->font_table && dpyinfo->font_table->font_encoder) - xfree (dpyinfo->font_table->font_encoder); - if (dpyinfo->font_table) - xfree (dpyinfo->font_table); - xfree (dpyinfo->x_id_name); - xfree (dpyinfo->color_cells); + { + if (dpyinfo->font_table->font_encoder) + xfree (dpyinfo->font_table->font_encoder); + xfree (dpyinfo->font_table); + } + if (dpyinfo->x_id_name) + xfree (dpyinfo->x_id_name); + if (dpyinfo->color_cells) + xfree (dpyinfo->color_cells); xfree (dpyinfo); } |