summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorTom Tromey <tromey@redhat.com>2013-07-26 14:02:53 -0600
committerTom Tromey <tromey@redhat.com>2013-07-26 14:02:53 -0600
commitcc231cbe45d27a1906d268fb72d3b4105a2e9c65 (patch)
treec011828e2a3a18e77eaa8849e3cccb805d798f42 /src
parentb34a529f177a6ea32da5cb1254f91bf9d71838db (diff)
parentfec9206062b420aca84f53d05a72c3ee43244022 (diff)
downloademacs-cc231cbe45d27a1906d268fb72d3b4105a2e9c65.tar.gz
emacs-cc231cbe45d27a1906d268fb72d3b4105a2e9c65.tar.bz2
emacs-cc231cbe45d27a1906d268fb72d3b4105a2e9c65.zip
merge from trunk
Diffstat (limited to 'src')
-rw-r--r--src/ChangeLog567
-rw-r--r--src/ChangeLog.126
-rw-r--r--src/Makefile.in8
-rw-r--r--src/alloc.c128
-rw-r--r--src/atimer.c12
-rw-r--r--src/atimer.h2
-rw-r--r--src/buffer.c13
-rw-r--r--src/buffer.h2
-rw-r--r--src/bytecode.c19
-rw-r--r--src/callint.c4
-rw-r--r--src/callproc.c211
-rw-r--r--src/charset.c43
-rw-r--r--src/coding.c94
-rw-r--r--src/composite.c13
-rw-r--r--src/conf_post.h6
-rw-r--r--src/cygw32.c11
-rw-r--r--src/data.c13
-rw-r--r--src/deps.mk2
-rw-r--r--src/dired.c22
-rw-r--r--src/dispnew.c19
-rw-r--r--src/doc.c41
-rw-r--r--src/editfns.c28
-rw-r--r--src/emacs.c9
-rw-r--r--src/emacsgtkfixed.c2
-rw-r--r--src/eval.c420
-rw-r--r--src/fileio.c228
-rw-r--r--src/filelock.c24
-rw-r--r--src/fns.c13
-rw-r--r--src/font.c15
-rw-r--r--src/fontset.c18
-rw-r--r--src/frame.c57
-rw-r--r--src/ftfont.c11
-rw-r--r--src/gfilenotify.c2
-rw-r--r--src/gtkutil.c10
-rw-r--r--src/image.c40
-rw-r--r--src/insdel.c36
-rw-r--r--src/keyboard.c297
-rw-r--r--src/keyboard.h2
-rw-r--r--src/keymap.c35
-rw-r--r--src/lisp.h114
-rw-r--r--src/lread.c176
-rw-r--r--src/macros.c3
-rw-r--r--src/menu.c24
-rw-r--r--src/minibuf.c40
-rw-r--r--src/nsfns.m11
-rw-r--r--src/nsfont.m2
-rw-r--r--src/nsmenu.m12
-rw-r--r--src/nsselect.m16
-rw-r--r--src/nsterm.m31
-rw-r--r--src/print.c8
-rw-r--r--src/process.c233
-rw-r--r--src/search.c4
-rw-r--r--src/sound.c12
-rw-r--r--src/sysdep.c335
-rw-r--r--src/systty.h2
-rw-r--r--src/term.c43
-rw-r--r--src/termhooks.h2
-rw-r--r--src/textprop.c42
-rw-r--r--src/unexaix.c2
-rw-r--r--src/unexcoff.c2
-rw-r--r--src/unexsol.c2
-rw-r--r--src/w32.c3
-rw-r--r--src/w32fns.c16
-rw-r--r--src/w32term.c31
-rw-r--r--src/window.c20
-rw-r--r--src/window.h1
-rw-r--r--src/xdisp.c80
-rw-r--r--src/xfaces.c49
-rw-r--r--src/xfns.c47
-rw-r--r--src/xfont.c4
-rw-r--r--src/xmenu.c55
-rw-r--r--src/xml.c2
-rw-r--r--src/xselect.c53
-rw-r--r--src/xterm.c22
74 files changed, 2378 insertions, 1604 deletions
diff --git a/src/ChangeLog b/src/ChangeLog
index 60e7e376729..38fa72b0506 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,5 +1,566 @@
+2013-07-26 Eli Zaretskii <eliz@gnu.org>
+
+ * process.c (Fprocess_list): Doc fix.
+
+ * w32term.c (w32_read_socket) <WM_EMACS_PAINT>: Warn about frame
+ being re-exposed only if it didn't ask to become visible.
+ <WM_SIZE>: Under SIZE_RESTORED, only set the frame visible if it
+ was previously iconified. (Bug#14841)
+ (x_iconify_frame): Mark the frame iconified.
+
+2013-07-26 Paul Eggert <eggert@cs.ucla.edu>
+
+ Fix minor problems found by static checking.
+ * eval.c (get_backtrace_frame, backtrace_eval_unrewind): Now static.
+ (backtrace_eval_unrewind): ';' -> '{}' to pacify GCC.
+
+2013-07-26 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * eval.c (set_specpdl_old_value): New function.
+ (unbind_to): Minor simplification.
+ (get_backtrace_frame): New function.
+ (Fbacktrace_frame): Use it. Add `base' argument.
+ (backtrace_eval_unrewind, Fbacktrace_eval): New functions.
+ (syms_of_eval): Export backtrace-eval.
+ * xterm.c (x_focus_changed): Simplify.
+
+2013-07-25 Paul Eggert <eggert@cs.ucla.edu>
+
+ * fileio.c (Finsert_file_contents): Avoid double-close (Bug#14936).
+
+2013-07-24 Eli Zaretskii <eliz@gnu.org>
+
+ * xdisp.c (redisplay_window): Instead of moving point out of
+ scroll margin, reject the force_start method, and try scrolling
+ instead. (Bug#14780)
+
+2013-07-24 Ken Brown <kbrown@cornell.edu>
+
+ * alloc.c (make_save_ptr): Define if HAVE_NTGUI is defined
+ (Bug#14944).
+
+2013-07-24 Paul Eggert <eggert@cs.ucla.edu>
+
+ * eval.c (Fprogn): Do not check that BODY is a proper list.
+ This undoes the previous change. The check slows down the
+ interpreter, and is not needed to prevent a crash. See
+ <http://lists.gnu.org/archive/html/emacs-devel/2013-07/msg00693.html>.
+
+2013-07-23 Glenn Morris <rgm@gnu.org>
+
+ * Makefile.in ($(etc)/DOC, temacs$(EXEEXT)): Ensure etc/ exists.
+
+2013-07-23 Paul Eggert <eggert@cs.ucla.edu>
+
+ Port to GNU/Linux systems with tinfo but not ncurses.
+ * dispnew.c (init_display): Depend on USE_NCURSES, not GNU_LINUX,
+ to decide whether ncurses is being used. Without this change,
+ GCC complains about tgetent not being declared, on a system
+ that has tinfo installed but ncurses not installed.
+
+ * eval.c (Fprogn): Check that BODY is a proper list.
+
+ Tune UNEVALLED functions by using XCAR instead of Fcar, etc.
+ * data.c (Fsetq_default):
+ * eval.c (Fif, Fcond, Fprog1, Fsetq, Fquote, Ffunction, Fdefvar)
+ (Fdefconst, FletX, Flet, Fwhile, Fcatch, Funwind_protect)
+ (Fcondition_case):
+ Tune by taking advantage of the fact that ARGS is always a list
+ when a function is declared to have UNEVALLED args.
+
+ * emacsgtkfixed.c: Port to GCC 4.6.
+ GCC 4.6 complains about -Wunused-local-typedefs, introduced in 4.7.
+
+2013-07-23 Juanma Barranquero <lekktu@gmail.com>
+
+ * callproc.c (child_setup)[!WINDOWSNT]: Move exec_errno and pid
+ here to silence compiler warnings.
+
+2013-07-22 Paul Eggert <eggert@cs.ucla.edu>
+
+ * sysdep.c (frame) [__FreeBSD__]: #define to freebsd_frame
+ when including <sys/user.h>, to prevent Sparc/ARM machine/frame.h
+ from messing up Emacs's 'struct frame' (Bug#14923).
+
+2013-07-21 Paul Eggert <eggert@cs.ucla.edu>
+
+ * alloc.c (make_save_ptr_ptr): Define this function.
+ It was inadvertently omitted. It's needed only if
+ HAVE_MENUS && ! (USE_X_TOOLKIT || USE_GTK).
+
+2013-07-21 Jan Djärv <jan.h.d@swipnet.se>
+
+ * nsterm.m (sendEvent:): Skip mouse moved if no dialog and no Emacs
+ frame have focus (Bug#14895).
+
+2013-07-21 Paul Eggert <eggert@cs.ucla.edu>
+
+ Avoid vfork-related deadlock more cleanly.
+ * callproc.c (child_setup): When the child's exec fails, output
+ the program name, as that's more useful. Use O_NONBLOCK to avoid
+ deadlock.
+ * process.c (create_process_1): Remove; no longer needed.
+ (create_process): Remove timer hack; no longer needed, now that
+ the child avoids deadlock.
+
+2013-07-20 Glenn Morris <rgm@gnu.org>
+
+ * image.c (Fimage_flush): Fix doc typo.
+
+2013-07-20 Paul Eggert <eggert@cs.ucla.edu>
+
+ Fix array bounds violation when pty allocation fails.
+ * process.c (PTY_NAME_SIZE): New constant.
+ (pty_name): Remove static variable; it's now auto.
+ (allocate_pty): Define even if !HAVE_PTYS; that's simpler.
+ Take pty_name as an arg rather than using a static variable.
+ All callers changed.
+ (create_process): Recover pty_flag from process, not from volatile local.
+ (create_pty): Stay inside array even when pty allocation fails.
+ (Fmake_serial_process): Omit unnecessary initializaiton of pty_flag.
+
+ * lread.c (Fload): Avoid initialization only when lint checking.
+ Mention that it's needed only for older GCCs.
+
+2013-07-20 Kenichi Handa <handa@gnu.org>
+
+ * coding.c (CODING_ISO_FLAG_LEVEL_4): New macro.
+ (decode_coding_iso_2022): Check the single-shift area. (Bug#8522)
+
+2013-07-20 Andreas Schwab <schwab@linux-m68k.org>
+
+ * lread.c (Fload): Avoid uninitialized warning.
+
+2013-07-19 Paul Eggert <eggert@cs.ucla.edu>
+
+ Fix some minor file descriptor leaks and related glitches.
+ * filelock.c (create_lock_file) [!O_CLOEXEC]: Use fcntl with FD_CLOEXEC.
+ (create_lock_file): Use write, not emacs_write.
+ * image.c (slurp_file, png_load_body):
+ * process.c (Fnetwork_interface_list, Fnetwork_interface_info)
+ (server_accept_connection):
+ Don't leak an fd on memory allocation failure.
+ * image.c (slurp_file): Add a cheap heuristic for growing files.
+ * xfaces.c (Fx_load_color_file): Block input around the fopen too,
+ as that's what the other routines do. Maybe input need not be
+ blocked at all, but it's better to be consistent.
+ Avoid undefined behavior when strlen is zero.
+
+ * alloc.c (staticpro): Avoid buffer overrun on repeated calls.
+ (NSTATICS): Now a constant; doesn't need to be a macro.
+
+2013-07-19 Richard Stallman <rms@gnu.org>
+
+ * coding.c (decode_coding_utf_8): Add simple loop for fast
+ processing of ASCII characters.
+
+2013-07-19 Paul Eggert <eggert@cs.ucla.edu>
+
+ * conf_post.h (RE_TRANSLATE_P) [emacs]: Remove obsolete optimization.
+
+2013-07-19 Eli Zaretskii <eliz@gnu.org>
+
+ * keyboard.c (kbd_buffer_get_event): Use Display_Info instead of
+ unportable 'struct x_display_info'.
+ (DISPLAY_LIST_INFO): Delete macro: not needed, since Display_Info
+ is a portable type.
+
+2013-07-19 Paul Eggert <eggert@cs.ucla.edu>
+
+ * sysdep.c [GNU_LINUX]: Fix fd and memory leaks and similar issues.
+ (procfs_ttyname): Don't use uninitialized storage if emacs_fopen
+ or fscanf fails.
+ (system_process_attributes): Prefer plain char to unsigned char
+ when either will do. Clean up properly if interrupted or if
+ memory allocations fail. Don't assume sscanf succeeds. Remove
+ no-longer-needed workaround to stop GCC from whining. Read
+ command-line once, instead of multiple times. Check read status a
+ bit more carefully.
+
+ Fix obscure porting bug with varargs functions.
+ The code assumed that int is treated like ptrdiff_t in a vararg
+ function, which is not a portable assumption. There was a similar
+ -- though these days less likely -- porting problem with various
+ assumptions that pointers of different types all smell the same as
+ far as vararg functions is conserved. To make this problem less
+ likely in the future, redo the API to use varargs functions.
+ * alloc.c (make_save_value): Remove this vararg function.
+ All uses changed to ...
+ (make_save_int_int_int, make_save_obj_obj_obj_obj)
+ (make_save_ptr_int, make_save_funcptr_ptr_obj, make_save_memory):
+ New functions.
+ (make_save_ptr): Rename from make_save_pointer, for consistency with
+ the above. Define only on platforms that need it. All uses changed.
+
+2013-07-18 Paul Eggert <eggert@cs.ucla.edu>
+
+ * keyboard.c: Try to fix typos in previous change.
+ (DISPLAY_LIST_INFO): New macro.
+ (kbd_buffer_get_event): Do not access members that are not present
+ in X11. Revert inadvertent change of "!=" to "=".
+
+2013-07-18 Juanma Barranquero <lekktu@gmail.com>
+
+ * keyboard.c (kbd_buffer_get_event):
+ * w32term.c (x_focus_changed): Port FOCUS_(IN|OUT)_EVENT changes to W32.
+ Followup to 2013-07-16T11:41:06Z!jan.h.d@swipnet.se.
+
+2013-07-18 Paul Eggert <eggert@cs.ucla.edu>
+
+ * filelock.c: Fix unlikely file descriptor leaks.
+ (get_boot_time_1): Rework to avoid using emacs_open.
+ This doesn't actually fix a leak, but is better anyway.
+ (read_lock_data): Use read, not emacs_read.
+
+ * doc.c: Fix minor memory and file descriptor leaks.
+ * doc.c (get_doc_string): Fix memory leak when doc file absent.
+ (get_doc_string, Fsnarf_documentation):
+ Fix file descriptor leak on error.
+
+ * term.c: Fix minor fdopen-related file descriptor leaks.
+ * term.c (Fresume_tty) [!MSDOS]: Close fd if fdopen (fd) fails.
+ (init_tty) [!DOS_NT]: Likewise. Also close fd if isatty (fd) fails.
+
+ * charset.c: Fix file descriptor leaks and errno issues.
+ Include <errno.h>.
+ (load_charset_map_from_file): Don't leak file descriptor on error.
+ Use plain record_xmalloc since the allocation is larger than
+ MAX_ALLOCA; that's simpler here. Simplify test for exhaustion
+ of entries.
+ * eval.c (record_unwind_protect_nothing):
+ * fileio.c (fclose_unwind):
+ New functions.
+ * lread.c (load_unwind): Remove. All uses replaced by fclose_unwind.
+ The replacement doesn't block input, but that no longer seems
+ necessary.
+
+2013-07-17 Paul Eggert <eggert@cs.ucla.edu>
+
+ * lread.c: Fix file descriptor leaks and errno issues.
+ (Fload): Close some races that leaked fds or streams when 'load'
+ was interrupted.
+ (Fload, openp): Report error number of last nontrivial failure to open.
+ ENOENT counts as trivial.
+ * eval.c (do_nothing, clear_unwind_protect, set_unwind_protect_ptr):
+ New functions.
+ * fileio.c (close_file_unwind): No need to test whether FD is nonnegative,
+ now that the function is always called with a nonnegative arg.
+ * lisp.h (set_unwind_protect_ptr, set_unwind_protect_int): Remove.
+ All uses replaced with ...
+ (clear_unwind_protect, set_unwind_protect_ptr): New decls.
+
+ A few more minor file errno-reporting bugs.
+ * callproc.c (Fcall_process):
+ * doc.c (Fsnarf_documentation):
+ * fileio.c (Frename_file, Fadd_name_to_file, Fmake_symbolic_link):
+ * process.c (set_socket_option):
+ Don't let a constructor trash errno.
+ * doc.c: Include <errno.h>.
+
+2013-07-16 Juanma Barranquero <lekktu@gmail.com>
+
+ * w32fns.c (unwind_create_tip_frame): Fix declaration.
+
+2013-07-16 Paul Eggert <eggert@cs.ucla.edu>
+
+ Fix w32 bug with call-process-region (Bug#14885).
+ * callproc.c (Fcall_process_region): Pass nil, not "/dev/null",
+ to Fcall_process when the input is empty. This simplifies the
+ code a bit. It makes no difference on POSIXish platforms but
+ apparently it fixes a bug on w32.
+
+ Fix bug where insert-file-contents closes a file twice. (Bug#14839).
+ * fileio.c (close_file_unwind): Don't close if FD is negative;
+ this can happen when unwinding a zapped file descriptor.
+ (Finsert_file_contents): Unwind-protect the fd before the point marker,
+ in case Emacs runs out of memory between the two unwind-protects.
+ Don't trash errno when closing FD.
+ Zap the FD in the specpdl when closing it, instead of deferring
+ the removal of the unwind-protect; this fixes a bug where a child
+ function unwinds the stack past us.
+
+ New unwind-protect flavors to better type-check C callbacks.
+ This also lessens the need to write wrappers for callbacks,
+ and the need for make_save_pointer.
+ * alloca.c (free_save_value):
+ * atimer.c (run_all_atimers):
+ Now extern.
+ * alloc.c (safe_alloca_unwind):
+ * atimer.c (unwind_stop_other_atimers):
+ * keyboard.c (cancel_hourglass_unwind) [HAVE_WINDOW_SYSTEM]:
+ * menu.c (cleanup_popup_menu) [HAVE_NS]:
+ * minibuf.c (choose_minibuf_frame_1):
+ * process.c (make_serial_process_unwind):
+ * xdisp.h (pop_message_unwind):
+ * xselect.c (queue_selection_requests_unwind):
+ Remove no-longer-needed wrapper. All uses replaced by the wrappee.
+ * alloca.c (record_xmalloc):
+ Prefer record_unwind_protect_ptr to record_unwind_protect with
+ make_save_pointer.
+ * alloca.c (Fgarbage_collect):
+ Prefer record_unwind_protect_void to passing a dummy.
+ * buffer.c (restore_buffer):
+ * window.c (restore_window_configuration):
+ * xfns.c, w32fns.c (do_unwind_create_frame)
+ New wrapper. All record-unwind uses of wrappee changed.
+ * buffer.c (set_buffer_if_live):
+ * callproc.c (call_process_cleanup, delete_temp_file):
+ * coding.c (code_conversion_restore):
+ * dired.c (directory_files_internal_w32_unwind) [WINDOWSNT]:
+ * editfns.c (save_excursion_restore)
+ (subst_char_in_region_unwind, subst_char_in_region_unwind_1)
+ (save_restriction_restore):
+ * eval.c (restore_stack_limits, un_autoload):
+ * fns.c (require_unwind):
+ * keyboard.c (recursive_edit_unwind, tracking_off):
+ * lread.c (record_load_unwind, load_warn_old_style_backquotes):
+ * macros.c (pop_kbd_macro, restore_menu_items):
+ * nsfns.m (unwind_create_frame):
+ * print.c (print_unwind):
+ * process.c (start_process_unwind):
+ * search.c (unwind_set_match_data):
+ * window.c (select_window_norecord, select_frame_norecord):
+ * xdisp.c (unwind_with_echo_area_buffer, unwind_format_mode_line)
+ (fast_set_selected_frame):
+ * xfns.c, w32fns.c (unwind_create_tip_frame):
+ Return void, not a dummy Lisp_Object. All uses changed.
+ * buffer.h (set_buffer_if_live): Move decl here from lisp.h.
+ * callproc.c (call_process_kill):
+ * fileio.c (restore_point_unwind, decide_coding_unwind)
+ (build_annotations_unwind):
+ * insdel.c (Fcombine_after_change_execute_1):
+ * keyboard.c (read_char_help_form_unwind):
+ * menu.c (unuse_menu_items):
+ * minibuf.c (run_exit_minibuf_hook, read_minibuf_unwind):
+ * sound.c (sound_cleanup):
+ * xdisp.c (unwind_redisplay):
+ * xfns.c (clean_up_dialog):
+ * xselect.c (x_selection_request_lisp_error, x_catch_errors_unwind):
+ Accept no args and return void, instead of accepting and returning
+ a dummy Lisp_Object. All uses changed.
+ * cygw32.c (fchdir_unwind):
+ * fileio.c (close_file_unwind):
+ * keyboard.c (restore_kboard_configuration):
+ * lread.c (readevalllop_1):
+ * process.c (wait_reading_process_output_unwind):
+ Accept int and return void, rather than accepting an Emacs integer
+ and returning a dummy object. In some cases this fixes an
+ unlikely bug when the corresponding int is outside Emacs integer
+ range. All uses changed.
+ * dired.c (directory_files_internal_unwind):
+ * fileio.c (do_auto_save_unwind):
+ * gtkutil.c (pop_down_dialog):
+ * insdel.c (reset_var_on_error):
+ * lread.c (load_unwind):
+ * xfns.c (clean_up_file_dialog):
+ * xmenu.c, nsmenu.m (pop_down_menu):
+ * xmenu.c (cleanup_widget_value_tree):
+ * xselect.c (wait_for_property_change_unwind):
+ Accept pointer and return void, rather than accepting an Emacs
+ save value encapsulating the pointer and returning a dummy object.
+ All uses changed.
+ * editfns.c (Fformat): Update the saved pointer directly via
+ set_unwind_protect_ptr rather than indirectly via make_save_pointer.
+ * eval.c (specpdl_func): Remove. All uses replaced by definiens.
+ (unwind_body): New function.
+ (record_unwind_protect): First arg is now a function returning void,
+ not a dummy Lisp_Object.
+ (record_unwind_protect_ptr, record_unwind_protect_int)
+ (record_unwind_protect_void): New functions.
+ (unbind_to): Support SPECPDL_UNWIND_PTR etc.
+ * fileio.c (struct auto_save_unwind): New type.
+ (do_auto_save_unwind): Use it.
+ (do_auto_save_unwind_1): Remove; subsumed by new do_auto_save_unwind.
+ * insdel.c (struct rvoe_arg): New type.
+ (reset_var_on_error): Use it.
+ * lisp.h (SPECPDL_UNWIND_PTR, SPECPDL_UNWIND_INT, SPECPDL_UNWIND_VOID):
+ New constants.
+ (specbinding_func): Remove; there are now several such functions.
+ (union specbinding): New members unwind_ptr, unwind_int, unwind_void.
+ (set_unwind_protect_ptr): New function.
+ * xselect.c: Remove unnecessary forward decls, to simplify maintenance.
+
+ Be simpler and more consistent about reporting I/O errors.
+ * fileio.c (Fcopy_file, Finsert_file_contents, Fwrite_region):
+ Say "Read error" and "Write error", rather than "I/O error", or
+ "IO error reading", or "IO error writing", when a read or write
+ error occurs.
+ * process.c (Fmake_network_process, wait_reading_process_output)
+ (send_process, Fprocess_send_eof, wait_reading_process_output):
+ Capitalize diagnostics consistently. Put "failed foo" at the
+ start of the diagnostic, so that we don't capitalize the
+ function name "foo". Consistently say "failed" for such
+ diagnostics.
+ * sysdep.c, w32.c (serial_open): Now accepts Lisp string, not C string.
+ All callers changed. This is so it can use report_file_error.
+ * sysdep.c (serial_open, serial_configure): Capitalize I/O
+ diagnostics consistently as above.
+
+ * fileio.c (report_file_errno): Fix errno reporting bug.
+ If the file name is neither null nor a pair, package it up as a
+ singleton list. All callers changed, both to this function and to
+ report_file_error. This fixes a bug where the memory allocator
+ invoked by list1 set errno so that the immediately following
+ report_file_error reported the wrong errno value.
+
+ Fix minor problems found by --enable-gcc-warnings.
+ * frame.c (Fhandle_focus_in, Fhandle_focus_out): Return a value.
+ * keyboard.c (kbd_buffer_get_event): Remove unused local.
+
+2013-07-16 Jan Djärv <jan.h.d@swipnet.se>
+
+ * xterm.c (x_focus_changed): Always generate FOCUS_IN_EVENT.
+ Set event->arg to Qt if switch-event shall be generated.
+ Generate FOCUS_OUT_EVENT for FocusOut if this is the focused frame.
+
+ * termhooks.h (enum event_kind): Add FOCUS_OUT_EVENT.
+
+ * nsterm.m (windowDidResignKey): If this is the focused frame, generate
+ FOCUS_OUT_EVENT.
+
+ * keyboard.c (Qfocus_in, Qfocus_out): New static objects.
+ (make_lispy_focus_in, make_lispy_focus_out): Declare and define.
+ (kbd_buffer_get_event): For FOCUS_IN, make a focus_in event if no
+ switch frame event is made. Check ! NILP (event->arg) if X11 (moved
+ from xterm.c). Make focus_out event for FOCUS_OUT_EVENT if NS or X11
+ and there is a focused frame.
+ (head_table): Add focus-in and focus-out.
+ (keys_of_keyboard): Add focus-in and focus-out to Vspecial_event_map,
+ bind to handle-focus-in/out.
+
+ * frame.c (Fhandle_focus_in, Fhandle_focus_out): New functions.
+ (Fhandle_switch_frame): Call Fhandle_focus_in.
+ (syms_of_frame): defsubr handle-focus-in/out.
+
+2013-07-16 Paul Eggert <eggert@cs.ucla.edu>
+
+ Fix porting bug to older POSIXish platforms (Bug#14862).
+ * sysdep.c (emacs_pipe): New function, that implements
+ pipe2 (fd, O_CLOEXEC) even on hosts that lack O_CLOEXEC.
+ This should port better to CentOS 5 and to Mac OS X 10.6.
+ All calls to pipe2 changed.
+
+ Prefer list1 (X) to Fcons (X, Qnil) when building lists.
+ This makes the code easier to read and the executable a bit smaller.
+ Do not replace all calls to Fcons that happen to create lists,
+ just calls that are intended to create lists. For example, when
+ creating an alist that maps FOO to nil, use list1 (Fcons (FOO, Qnil))
+ rather than list1 (list1 (FOO)) or Fcons (Fcons (FOO, Qnil), Qnil).
+ Similarly for list2 through list5.
+ * buffer.c (Fget_buffer_create, Fmake_indirect_buffer):
+ * bytecode.c (exec_byte_code):
+ * callint.c (quotify_arg, Fcall_interactively):
+ * callproc.c (Fcall_process, create_temp_file):
+ * charset.c (load_charset_map_from_file)
+ (Fdefine_charset_internal, init_charset):
+ * coding.c (get_translation_table, detect_coding_system)
+ (Fcheck_coding_systems_region)
+ (Fset_terminal_coding_system_internal)
+ (Fdefine_coding_system_internal, Fdefine_coding_system_alias):
+ * composite.c (update_compositions, Ffind_composition_internal):
+ * dired.c (directory_files_internal, file_name_completion)
+ (Fsystem_users):
+ * dispnew.c (Fopen_termscript, bitch_at_user, init_display):
+ * doc.c (Fsnarf_documentation):
+ * editfns.c (Fmessage_box):
+ * emacs.c (main):
+ * eval.c (do_debug_on_call, signal_error, maybe_call_debugger)
+ (Feval, eval_sub, Ffuncall, apply_lambda):
+ * fileio.c (make_temp_name, Fcopy_file, Faccess_file)
+ (Fset_file_selinux_context, Fset_file_acl, Fset_file_modes)
+ (Fset_file_times, Finsert_file_contents)
+ (Fchoose_write_coding_system, Fwrite_region):
+ * fns.c (Flax_plist_put, Fyes_or_no_p, syms_of_fns):
+ * font.c (font_registry_charsets, font_parse_fcname)
+ (font_prepare_cache, font_update_drivers, Flist_fonts):
+ * fontset.c (Fset_fontset_font, Ffontset_info, syms_of_fontset):
+ * frame.c (make_frame, Fmake_terminal_frame)
+ (x_set_frame_parameters, x_report_frame_params)
+ (x_default_parameter, Fx_parse_geometry):
+ * ftfont.c (syms_of_ftfont):
+ * image.c (gif_load):
+ * keyboard.c (command_loop_1):
+ * keymap.c (Fmake_keymap, Fmake_sparse_keymap, access_keymap_1)
+ (Fcopy_keymap, append_key, Fcurrent_active_maps)
+ (Fminor_mode_key_binding, accessible_keymaps_1)
+ (Faccessible_keymaps, Fwhere_is_internal):
+ * lread.c (read_emacs_mule_char):
+ * menu.c (find_and_return_menu_selection):
+ * minibuf.c (get_minibuffer):
+ * nsfns.m (Fns_perform_service):
+ * nsfont.m (ns_script_to_charset):
+ * nsmenu.m (ns_popup_dialog):
+ * nsselect.m (ns_get_local_selection, ns_string_from_pasteboard)
+ (Fx_own_selection_internal):
+ * nsterm.m (append2):
+ * print.c (Fredirect_debugging_output)
+ (print_prune_string_charset):
+ * process.c (Fdelete_process, Fprocess_contact)
+ (Fformat_network_address, set_socket_option)
+ (read_and_dispose_of_process_output, write_queue_push)
+ (send_process, exec_sentinel):
+ * sound.c (Fplay_sound_internal):
+ * textprop.c (validate_plist, add_properties)
+ (Fput_text_property, Fadd_face_text_property)
+ (copy_text_properties, text_property_list, syms_of_textprop):
+ * unexaix.c (report_error):
+ * unexcoff.c (report_error):
+ * unexsol.c (unexec):
+ * xdisp.c (redisplay_tool_bar, store_mode_line_string)
+ (Fformat_mode_line, syms_of_xdisp):
+ * xfaces.c (set_font_frame_param)
+ (Finternal_lisp_face_attribute_values)
+ (Finternal_merge_in_global_face, syms_of_xfaces):
+ * xfns.c (x_default_scroll_bar_color_parameter)
+ (x_default_font_parameter, x_create_tip_frame):
+ * xfont.c (xfont_supported_scripts):
+ * xmenu.c (Fx_popup_dialog, xmenu_show, xdialog_show)
+ (menu_help_callback, xmenu_show):
+ * xml.c (make_dom):
+ * xterm.c (set_wm_state):
+ Prefer list1 (FOO) to Fcons (FOO, Qnil) when creating a list,
+ and similarly for list2 through list5.
+
+2013-07-15 Paul Eggert <eggert@cs.ucla.edu>
+
+ * callproc.c (Fcall_process_region): Fix minor race and tune.
+ (create_temp_file): New function, with the temp-file-creation part
+ of the old Fcall_process_region. Use Fcopy_sequence to create the
+ temp file name, rather than alloca + build_string, for simplicity.
+ Don't bother to block input around the temp file creation;
+ shouldn't be needed. Simplify use of mktemp. Use
+ record_unwind_protect immediately after creating the temp file;
+ this closes an unlikely race where the temp file was not removed.
+ Use memcpy rather than an open-coded loop.
+ (Fcall_process_region): Use the new function. If the input is
+ empty, redirect from /dev/null rather than from a newly created
+ empty temp file; this avoids unnecessary file system traffic.
+
+2013-07-14 Paul Eggert <eggert@cs.ucla.edu>
+
+ * filelock.c (create_lock_file) [!HAVE_MKOSTEMP && !HAVE_MKSTEMP]:
+ Simplify by making this case like the other two. This is a bit
+ slower on obsolete hosts, but the extra complexity isn't worth it.
+
+ * callproc.c (child_setup, relocate_fd) [!DOS_NT]:
+ * process.c (create_process) [!DOS_NT]:
+ Remove now-unnecessary calls to emacs_close.
+
+2013-07-13 Eli Zaretskii <eliz@gnu.org>
+
+ * w32term.c (x_draw_hollow_cursor): Delete the brush object when
+ returning early. (Bug#14850)
+
+ * coding.c (syms_of_coding): Set up inhibit-null-byte-detection
+ and inhibit-iso-escape-detection attributes of 'undecided'.
+ (Bug#14822)
+
2013-07-13 Paul Eggert <eggert@cs.ucla.edu>
+ * deps.mk (sysdep.o): Remove dependency on ../lib/ignore-value.h.
+ Reported by Herbert J. Skuhra in
+ <http://lists.gnu.org/archive/html/emacs-devel/2013-07/msg00455.html>.
+
Don't lose top specpdl entry when memory is exhausted.
* eval.c (grow_specpdl): Increment specpdl top by 1 and check for
specpdl overflow here, to simplify callers; all callers changed.
@@ -136,7 +697,7 @@
initializers.
Syntax cleanup, mostly replacing macros with functions.
-` This removes the need for the syntax_temp hack.
+ This removes the need for the syntax_temp hack.
* search.c: Include syntax.h after buffer.h, since syntax.h uses BVAR.
* syntax.c (SYNTAX_INLINE): New macro.
(SYNTAX_FLAGS_COMSTART_FIRST, SYNTAX_FLAGS_COMSTART_SECOND)
@@ -234,7 +795,7 @@
(emacswrite_sig, emacs_perror): New functions.
* xrdb.c (fatal): Don't invoke perror, since errno might be garbage.
-2013-07-08 Magnus Henoch <magnus.henoch@gmail.com> (tiny change).
+2013-07-08 Magnus Henoch <magnus.henoch@gmail.com> (tiny change).
* image.c (imagemagick_load_image): Do not use MagickExportImagePixels
on NS even if it is present. Pixmap on NS is a void*.
@@ -789,7 +1350,7 @@
* floatfns.c (Flog10): Move to Lisp (marked obsolete there).
-2013-06-20 Rüdiger Sonderfeld <ruediger@c-plusplus.de>
+2013-06-20 Rüdiger Sonderfeld <ruediger@c-plusplus.de>
* floatfns.c (Flog) [HAVE_LOG2]: Use log2 if available and if the
base is 2; this is more accurate.
diff --git a/src/ChangeLog.12 b/src/ChangeLog.12
index 2b22690bb87..053baa3d487 100644
--- a/src/ChangeLog.12
+++ b/src/ChangeLog.12
@@ -69,7 +69,7 @@
* dispnew.c (update_window): Use MATRIX_ROW and MATRIX_MODE_LINE_ROW.
-2013-03-10 handa <handa@gnu.org>
+2013-03-10 Kenichi Handa <handa@gnu.org>
* lisp.h (adjust_after_replace): Extern it.
@@ -11043,7 +11043,7 @@
* nsterm.m (x_free_frame_resources): Move xfree so freed memory isn't
referenced (Bug#11583).
-2012-06-16 Aurelien Aptel <aurelien.aptel@gmail.com>
+2012-06-16 Aurélien Aptel <aurelien.aptel@gmail.com>
Implement wave-style variant of underlining.
* dispextern.h (face_underline_type): New enum.
@@ -21400,7 +21400,7 @@
* process.c (Fformat_network_address): Doc fix.
-2011-04-08 T.V. Raman <tv.raman.tv@gmail.com> (tiny change)
+2011-04-08 T. V. Raman <tv.raman.tv@gmail.com> (tiny change)
* xml.c (parse_region): Avoid creating spurious whitespace nodes.
diff --git a/src/Makefile.in b/src/Makefile.in
index 2bd1fc43239..ce709a6bc44 100644
--- a/src/Makefile.in
+++ b/src/Makefile.in
@@ -1,4 +1,4 @@
-# src/Makefile for GNU Emacs.
+### @configure_input@
# Copyright (C) 1985, 1987-1988, 1993-1995, 1999-2013 Free Software
# Foundation, Inc.
@@ -470,6 +470,7 @@ emacs$(EXEEXT): temacs$(EXEEXT) $(ADDSECTION) \
## in the contents of the DOC file.
##
$(etc)/DOC: $(libsrc)/make-docfile$(EXEEXT) $(obj) $(lisp)
+ $(MKDIR_P) $(etc)
-rm -f $(etc)/DOC
$(libsrc)/make-docfile -d $(srcdir) $(SOME_MACHINE_OBJECTS) $(obj) > $(etc)/DOC
$(libsrc)/make-docfile -a $(etc)/DOC -d $(lispsource) `sed -n -e 's| \\\\||' -e 's|^[ ]*$$(lispsource)/||p' $(srcdir)/lisp.mk`
@@ -498,10 +499,15 @@ $(ALLOBJS): globals.h
$(lib)/libgnu.a: $(config_h)
cd $(lib) && $(MAKE) libgnu.a
+## We have to create $(etc) here because init_cmdargs tests its
+## existence when setting Vinstallation_directory (FIXME?).
+## This goes on to affect various things, and the emacs binary fails
+## to start if Vinstallation_directory has the wrong value.
temacs$(EXEEXT): stamp-oldxmenu $(ALLOBJS) \
$(lib)/libgnu.a $(EMACSRES)
$(CC) $(ALL_CFLAGS) $(TEMACS_LDFLAGS) $(LDFLAGS) \
-o temacs $(ALLOBJS) $(lib)/libgnu.a $(W32_RES_LINK) $(LIBES)
+ $(MKDIR_P) $(etc)
$(TEMACS_POST_LINK)
test "$(CANNOT_DUMP)" = "yes" || \
test "X$(PAXCTL)" = X || $(PAXCTL) -r temacs$(EXEEXT)
diff --git a/src/alloc.c b/src/alloc.c
index 6ef6af1e3a1..0eb54f8b271 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -209,7 +209,6 @@ Lisp_Object Qchar_table_extra_slots;
static Lisp_Object Qpost_gc_hook;
-static void free_save_value (Lisp_Object);
static void mark_terminals (void);
static void gc_sweep (void);
static Lisp_Object make_pure_vector (ptrdiff_t);
@@ -334,7 +333,7 @@ static struct mem_node *mem_find (void *);
/* Addresses of staticpro'd variables. Initialize it to a nonzero
value; otherwise some compilers put it into BSS. */
-#define NSTATICS 0x800
+enum { NSTATICS = 2048 };
static Lisp_Object *staticvec[NSTATICS] = {&Vpurify_flag};
/* Index of next unused slot in staticvec. */
@@ -805,22 +804,13 @@ xputenv (char const *string)
memory_full (0);
}
-/* Unwind for SAFE_ALLOCA */
-
-Lisp_Object
-safe_alloca_unwind (Lisp_Object arg)
-{
- free_save_value (arg);
- return Qnil;
-}
-
/* Return a newly allocated memory block of SIZE bytes, remembering
to free it when unwinding. */
void *
record_xmalloc (size_t size)
{
void *p = xmalloc (size);
- record_unwind_protect (safe_alloca_unwind, make_save_pointer (p));
+ record_unwind_protect_ptr (xfree, p);
return p;
}
@@ -3351,67 +3341,101 @@ verify (((SAVE_INTEGER | SAVE_POINTER | SAVE_FUNCPOINTER | SAVE_OBJECT)
>> SAVE_SLOT_BITS)
== 0);
-/* Return a Lisp_Save_Value object with the data saved according to
- DATA_TYPE. DATA_TYPE should be one of SAVE_TYPE_INT_INT, etc. */
+/* Return Lisp_Save_Value objects for the various combinations
+ that callers need. */
Lisp_Object
-make_save_value (enum Lisp_Save_Type save_type, ...)
+make_save_int_int_int (ptrdiff_t a, ptrdiff_t b, ptrdiff_t c)
{
- va_list ap;
- int i;
Lisp_Object val = allocate_misc (Lisp_Misc_Save_Value);
struct Lisp_Save_Value *p = XSAVE_VALUE (val);
+ p->save_type = SAVE_TYPE_INT_INT_INT;
+ p->data[0].integer = a;
+ p->data[1].integer = b;
+ p->data[2].integer = c;
+ return val;
+}
- eassert (0 < save_type
- && (save_type < 1 << (SAVE_TYPE_BITS - 1)
- || save_type == SAVE_TYPE_MEMORY));
- p->save_type = save_type;
- va_start (ap, save_type);
- save_type &= ~ (1 << (SAVE_TYPE_BITS - 1));
-
- for (i = 0; save_type; i++, save_type >>= SAVE_SLOT_BITS)
- switch (save_type & ((1 << SAVE_SLOT_BITS) - 1))
- {
- case SAVE_POINTER:
- p->data[i].pointer = va_arg (ap, void *);
- break;
-
- case SAVE_FUNCPOINTER:
- p->data[i].funcpointer = va_arg (ap, voidfuncptr);
- break;
+Lisp_Object
+make_save_obj_obj_obj_obj (Lisp_Object a, Lisp_Object b, Lisp_Object c,
+ Lisp_Object d)
+{
+ Lisp_Object val = allocate_misc (Lisp_Misc_Save_Value);
+ struct Lisp_Save_Value *p = XSAVE_VALUE (val);
+ p->save_type = SAVE_TYPE_OBJ_OBJ_OBJ_OBJ;
+ p->data[0].object = a;
+ p->data[1].object = b;
+ p->data[2].object = c;
+ p->data[3].object = d;
+ return val;
+}
- case SAVE_INTEGER:
- p->data[i].integer = va_arg (ap, ptrdiff_t);
- break;
+#if defined HAVE_NS || defined HAVE_NTGUI
+Lisp_Object
+make_save_ptr (void *a)
+{
+ Lisp_Object val = allocate_misc (Lisp_Misc_Save_Value);
+ struct Lisp_Save_Value *p = XSAVE_VALUE (val);
+ p->save_type = SAVE_POINTER;
+ p->data[0].pointer = a;
+ return val;
+}
+#endif
- case SAVE_OBJECT:
- p->data[i].object = va_arg (ap, Lisp_Object);
- break;
+Lisp_Object
+make_save_ptr_int (void *a, ptrdiff_t b)
+{
+ Lisp_Object val = allocate_misc (Lisp_Misc_Save_Value);
+ struct Lisp_Save_Value *p = XSAVE_VALUE (val);
+ p->save_type = SAVE_TYPE_PTR_INT;
+ p->data[0].pointer = a;
+ p->data[1].integer = b;
+ return val;
+}
- default:
- emacs_abort ();
- }
+#if defined HAVE_MENUS && ! (defined USE_X_TOOLKIT || defined USE_GTK)
+Lisp_Object
+make_save_ptr_ptr (void *a, void *b)
+{
+ Lisp_Object val = allocate_misc (Lisp_Misc_Save_Value);
+ struct Lisp_Save_Value *p = XSAVE_VALUE (val);
+ p->save_type = SAVE_TYPE_PTR_PTR;
+ p->data[0].pointer = a;
+ p->data[1].pointer = b;
+ return val;
+}
+#endif
- va_end (ap);
+Lisp_Object
+make_save_funcptr_ptr_obj (void (*a) (void), void *b, Lisp_Object c)
+{
+ Lisp_Object val = allocate_misc (Lisp_Misc_Save_Value);
+ struct Lisp_Save_Value *p = XSAVE_VALUE (val);
+ p->save_type = SAVE_TYPE_FUNCPTR_PTR_OBJ;
+ p->data[0].funcpointer = a;
+ p->data[1].pointer = b;
+ p->data[2].object = c;
return val;
}
-/* The most common task it to save just one C pointer. */
+/* Return a Lisp_Save_Value object that represents an array A
+ of N Lisp objects. */
Lisp_Object
-make_save_pointer (void *pointer)
+make_save_memory (Lisp_Object *a, ptrdiff_t n)
{
Lisp_Object val = allocate_misc (Lisp_Misc_Save_Value);
struct Lisp_Save_Value *p = XSAVE_VALUE (val);
- p->save_type = SAVE_POINTER;
- p->data[0].pointer = pointer;
+ p->save_type = SAVE_TYPE_MEMORY;
+ p->data[0].pointer = a;
+ p->data[1].integer = n;
return val;
}
/* Free a Lisp_Save_Value object. Do not use this function
if SAVE contains pointer other than returned by xmalloc. */
-static void
+void
free_save_value (Lisp_Object save)
{
xfree (XSAVE_POINTER (save, 0));
@@ -4750,7 +4774,7 @@ valid_pointer_p (void *p)
Unfortunately, we cannot use NULL_DEVICE here, as emacs_write may
not validate p in that case. */
- if (pipe2 (fd, O_CLOEXEC) == 0)
+ if (emacs_pipe (fd) == 0)
{
bool valid = emacs_write (fd[1], (char *) p, 16) == 16;
emacs_close (fd[1]);
@@ -5134,9 +5158,9 @@ Does not copy symbols. Copies strings without text properties. */)
void
staticpro (Lisp_Object *varaddress)
{
- staticvec[staticidx++] = varaddress;
if (staticidx >= NSTATICS)
fatal ("NSTATICS too small; try increasing and recompiling Emacs.");
+ staticvec[staticidx++] = varaddress;
}
@@ -5236,7 +5260,7 @@ See Info node `(elisp)Garbage Collection'. */)
/* Save what's currently displayed in the echo area. */
message_p = push_message ();
- record_unwind_protect (pop_message_unwind, Qnil);
+ record_unwind_protect_void (pop_message_unwind);
/* Save a copy of the contents of the stack, for debugging. */
#if MAX_SAVE_STACK > 0
diff --git a/src/atimer.c b/src/atimer.c
index bb5294670d3..219b3502acc 100644
--- a/src/atimer.c
+++ b/src/atimer.c
@@ -250,7 +250,7 @@ stop_other_atimers (struct atimer *t)
/* Run all timers again, if some have been stopped with a call to
stop_other_atimers. */
-static void
+void
run_all_atimers (void)
{
if (stopped_atimers)
@@ -274,16 +274,6 @@ run_all_atimers (void)
}
-/* A version of run_all_atimers suitable for a record_unwind_protect. */
-
-Lisp_Object
-unwind_stop_other_atimers (Lisp_Object dummy)
-{
- run_all_atimers ();
- return Qnil;
-}
-
-
/* Arrange for a SIGALRM to arrive when the next timer is ripe. */
static void
diff --git a/src/atimer.h b/src/atimer.h
index 2a92f1bebea..a1825fc0933 100644
--- a/src/atimer.h
+++ b/src/atimer.h
@@ -77,6 +77,6 @@ void do_pending_atimers (void);
void init_atimer (void);
void turn_on_atimers (bool);
void stop_other_atimers (struct atimer *);
-Lisp_Object unwind_stop_other_atimers (Lisp_Object);
+void run_all_atimers (void);
#endif /* EMACS_ATIMER_H */
diff --git a/src/buffer.c b/src/buffer.c
index 19e3982a8a4..3ca1bd98b29 100644
--- a/src/buffer.c
+++ b/src/buffer.c
@@ -611,7 +611,7 @@ even if it is dead. The return value is never nil. */)
/* Put this in the alist of all live buffers. */
XSETBUFFER (buffer, b);
- Vbuffer_alist = nconc2 (Vbuffer_alist, Fcons (Fcons (name, buffer), Qnil));
+ Vbuffer_alist = nconc2 (Vbuffer_alist, list1 (Fcons (name, buffer)));
/* And run buffer-list-update-hook. */
if (!NILP (Vrun_hooks))
call1 (Vrun_hooks, Qbuffer_list_update_hook);
@@ -822,7 +822,7 @@ CLONE nil means the indirect buffer's state is reset to default values. */)
/* Put this in the alist of all live buffers. */
XSETBUFFER (buf, b);
- Vbuffer_alist = nconc2 (Vbuffer_alist, Fcons (Fcons (name, buf), Qnil));
+ Vbuffer_alist = nconc2 (Vbuffer_alist, list1 (Fcons (name, buf)));
bset_mark (b, Fmake_marker ());
@@ -2207,14 +2207,19 @@ ends when the current command terminates. Use `switch-to-buffer' or
return buffer;
}
+void
+restore_buffer (Lisp_Object buffer_or_name)
+{
+ Fset_buffer (buffer_or_name);
+}
+
/* Set the current buffer to BUFFER provided if it is alive. */
-Lisp_Object
+void
set_buffer_if_live (Lisp_Object buffer)
{
if (BUFFER_LIVE_P (XBUFFER (buffer)))
set_buffer_internal (XBUFFER (buffer));
- return Qnil;
}
DEFUN ("barf-if-buffer-read-only", Fbarf_if_buffer_read_only,
diff --git a/src/buffer.h b/src/buffer.h
index 2b0b49dddad..6c0058ee8f3 100644
--- a/src/buffer.h
+++ b/src/buffer.h
@@ -1069,6 +1069,8 @@ extern Lisp_Object buffer_local_value_1 (Lisp_Object, Lisp_Object);
extern void record_buffer (Lisp_Object);
extern void fix_overlays_before (struct buffer *, ptrdiff_t, ptrdiff_t);
extern void mmap_set_vars (bool);
+extern void restore_buffer (Lisp_Object);
+extern void set_buffer_if_live (Lisp_Object);
/* Set the current buffer to B.
diff --git a/src/bytecode.c b/src/bytecode.c
index f186f7d1bc3..1be3e5c6188 100644
--- a/src/bytecode.c
+++ b/src/bytecode.c
@@ -569,9 +569,9 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
if (nargs < mandatory)
/* Too few arguments. */
Fsignal (Qwrong_number_of_arguments,
- Fcons (Fcons (make_number (mandatory),
+ list2 (Fcons (make_number (mandatory),
rest ? Qand_rest : make_number (nonrest)),
- Fcons (make_number (nargs), Qnil)));
+ make_number (nargs)));
else
{
for (; i < nonrest; i++)
@@ -590,9 +590,8 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
else
/* Too many arguments. */
Fsignal (Qwrong_number_of_arguments,
- Fcons (Fcons (make_number (mandatory),
- make_number (nonrest)),
- Fcons (make_number (nargs), Qnil)));
+ list2 (Fcons (make_number (mandatory), make_number (nonrest)),
+ make_number (nargs)));
}
else if (! NILP (args_template))
/* We should push some arguments on the stack. */
@@ -1061,8 +1060,8 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
CASE (Bsave_window_excursion): /* Obsolete since 24.1. */
{
- register ptrdiff_t count1 = SPECPDL_INDEX ();
- record_unwind_protect (Fset_window_configuration,
+ ptrdiff_t count1 = SPECPDL_INDEX ();
+ record_unwind_protect (restore_window_configuration,
Fcurrent_window_configuration (Qnil));
BEFORE_POTENTIAL_GC ();
TOP = Fprogn (TOP);
@@ -1087,7 +1086,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
}
CASE (Bunwind_protect): /* FIXME: avoid closure for lexbind. */
- record_unwind_protect (Fprogn, POP);
+ record_unwind_protect (unwind_body, POP);
NEXT;
CASE (Bcondition_case): /* FIXME: ill-suited for lexbind. */
@@ -1169,14 +1168,14 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
}
CASE (Blist1):
- TOP = Fcons (TOP, Qnil);
+ TOP = list1 (TOP);
NEXT;
CASE (Blist2):
{
Lisp_Object v1;
v1 = POP;
- TOP = Fcons (TOP, Fcons (v1, Qnil));
+ TOP = list2 (TOP, v1);
NEXT;
}
diff --git a/src/callint.c b/src/callint.c
index 0651b68dc05..38431226508 100644
--- a/src/callint.c
+++ b/src/callint.c
@@ -127,7 +127,7 @@ quotify_arg (register Lisp_Object exp)
if (CONSP (exp)
|| (SYMBOLP (exp)
&& !NILP (exp) && !EQ (exp, Qt)))
- return Fcons (Qquote, Fcons (exp, Qnil));
+ return list2 (Qquote, exp);
return exp;
}
@@ -802,7 +802,7 @@ invoke it. If KEYS is omitted or nil, the return value of
for (i = 1; i < nargs; i++)
{
if (varies[i] > 0)
- visargs[i] = Fcons (intern (callint_argfuns[varies[i]]), Qnil);
+ visargs[i] = list1 (intern (callint_argfuns[varies[i]]));
else
visargs[i] = quotify_arg (args[i]);
}
diff --git a/src/callproc.c b/src/callproc.c
index 30f9dc58d46..91f29bd589b 100644
--- a/src/callproc.c
+++ b/src/callproc.c
@@ -123,8 +123,8 @@ record_kill_process (struct Lisp_Process *p)
/* Clean up when exiting call_process_cleanup. */
-static Lisp_Object
-call_process_kill (Lisp_Object ignored)
+static void
+call_process_kill (void)
{
if (synch_process_fd >= 0)
emacs_close (synch_process_fd);
@@ -136,15 +136,13 @@ call_process_kill (Lisp_Object ignored)
proc.pid = synch_process_pid;
record_kill_process (&proc);
}
-
- return Qnil;
}
/* Clean up when exiting Fcall_process.
On MSDOS, delete the temporary file on any kind of termination.
On Unix, kill the process and any children on termination by signal. */
-static Lisp_Object
+static void
call_process_cleanup (Lisp_Object arg)
{
#ifdef MSDOS
@@ -162,7 +160,7 @@ call_process_cleanup (Lisp_Object arg)
{
ptrdiff_t count = SPECPDL_INDEX ();
kill (-synch_process_pid, SIGINT);
- record_unwind_protect (call_process_kill, make_number (0));
+ record_unwind_protect_void (call_process_kill);
message1 ("Waiting for process to die...(type C-g again to kill it instantly)");
immediate_quit = 1;
QUIT;
@@ -183,8 +181,6 @@ call_process_cleanup (Lisp_Object arg)
if (!(strcmp (SDATA (file), NULL_DEVICE) == 0 || SREF (file, 0) == '\0'))
unlink (SDATA (file));
#endif
-
- return Qnil;
}
#ifdef DOS_NT
@@ -392,7 +388,7 @@ usage: (call-process PROGRAM &optional INFILE DESTINATION DISPLAY &rest ARGS) *
if (NILP (Ffile_accessible_directory_p (current_dir)))
report_file_error ("Setting current directory",
- Fcons (BVAR (current_buffer, directory), Qnil));
+ BVAR (current_buffer, directory));
if (STRING_MULTIBYTE (infile))
infile = ENCODE_FILE (infile);
@@ -409,8 +405,11 @@ usage: (call-process PROGRAM &optional INFILE DESTINATION DISPLAY &rest ARGS) *
filefd = emacs_open (SSDATA (infile), O_RDONLY, 0);
if (filefd < 0)
- report_file_error ("Opening process input file",
- Fcons (DECODE_FILE (infile), Qnil));
+ {
+ int open_errno = errno;
+ report_file_errno ("Opening process input file", DECODE_FILE (infile),
+ open_errno);
+ }
if (STRINGP (output_file))
{
@@ -422,7 +421,7 @@ usage: (call-process PROGRAM &optional INFILE DESTINATION DISPLAY &rest ARGS) *
int open_errno = errno;
output_file = DECODE_FILE (output_file);
report_file_errno ("Opening process output file",
- Fcons (output_file, Qnil), open_errno);
+ output_file, open_errno);
}
if (STRINGP (error_file) || NILP (error_file))
output_to_buffer = 0;
@@ -440,8 +439,7 @@ usage: (call-process PROGRAM &optional INFILE DESTINATION DISPLAY &rest ARGS) *
{
int openp_errno = errno;
emacs_close (filefd);
- report_file_errno ("Searching for program",
- Fcons (args[0], Qnil), openp_errno);
+ report_file_errno ("Searching for program", args[0], openp_errno);
}
}
@@ -506,7 +504,7 @@ usage: (call-process PROGRAM &optional INFILE DESTINATION DISPLAY &rest ARGS) *
int open_errno = errno;
emacs_close (filefd);
report_file_errno ("Opening process output file",
- Fcons (build_string (tempfile), Qnil), open_errno);
+ build_string (tempfile), open_errno);
}
}
else
@@ -524,7 +522,7 @@ usage: (call-process PROGRAM &optional INFILE DESTINATION DISPLAY &rest ARGS) *
{
#ifndef MSDOS
int fd[2];
- if (pipe2 (fd, O_CLOEXEC) != 0)
+ if (emacs_pipe (fd) != 0)
{
int pipe_errno = errno;
emacs_close (filefd);
@@ -563,8 +561,7 @@ usage: (call-process PROGRAM &optional INFILE DESTINATION DISPLAY &rest ARGS) *
error_file = build_string (NULL_DEVICE);
else if (STRINGP (error_file))
error_file = DECODE_FILE (error_file);
- report_file_errno ("Cannot redirect stderr",
- Fcons (error_file, Qnil), open_errno);
+ report_file_errno ("Cannot redirect stderr", error_file, open_errno);
}
#ifdef MSDOS /* MW, July 1993 */
@@ -596,8 +593,7 @@ usage: (call-process PROGRAM &optional INFILE DESTINATION DISPLAY &rest ARGS) *
unlink (tempfile);
emacs_close (filefd);
report_file_errno ("Cannot re-open temporary file",
- Fcons (build_string (tempfile), Qnil),
- open_errno);
+ build_string (tempfile), open_errno);
}
}
else
@@ -935,7 +931,7 @@ usage: (call-process PROGRAM &optional INFILE DESTINATION DISPLAY &rest ARGS) *
return make_number (WEXITSTATUS (status));
}
-static Lisp_Object
+static void
delete_temp_file (Lisp_Object name)
{
/* Suppress jka-compr handling, etc. */
@@ -957,44 +953,18 @@ delete_temp_file (Lisp_Object name)
internal_delete_file (name);
#endif
unbind_to (count, Qnil);
- return Qnil;
}
-DEFUN ("call-process-region", Fcall_process_region, Scall_process_region,
- 3, MANY, 0,
- doc: /* Send text from START to END to a synchronous process running PROGRAM.
-The remaining arguments are optional.
-Delete the text if fourth arg DELETE is non-nil.
-
-Insert output in BUFFER before point; t means current buffer; nil for
- BUFFER means discard it; 0 means discard and don't wait; and `(:file
- FILE)', where FILE is a file name string, means that it should be
- written to that file (if the file already exists it is overwritten).
-BUFFER can also have the form (REAL-BUFFER STDERR-FILE); in that case,
-REAL-BUFFER says what to do with standard output, as above,
-while STDERR-FILE says what to do with standard error in the child.
-STDERR-FILE may be nil (discard standard error output),
-t (mix it with ordinary output), or a file name string.
-
-Sixth arg DISPLAY non-nil means redisplay buffer as output is inserted.
-Remaining args are passed to PROGRAM at startup as command args.
+/* Create a temporary file suitable for storing the input data of
+ call-process-region. NARGS and ARGS are the same as for
+ call-process-region. */
-If BUFFER is 0, `call-process-region' returns immediately with value nil.
-Otherwise it waits for PROGRAM to terminate
-and returns a numeric exit status or a signal description string.
-If you quit, the process is killed with SIGINT, or SIGKILL if you quit again.
-
-usage: (call-process-region START END PROGRAM &optional DELETE BUFFER DISPLAY &rest ARGS) */)
- (ptrdiff_t nargs, Lisp_Object *args)
+static Lisp_Object
+create_temp_file (ptrdiff_t nargs, Lisp_Object *args)
{
struct gcpro gcpro1;
Lisp_Object filename_string;
- register Lisp_Object start, end;
- ptrdiff_t count = SPECPDL_INDEX ();
- /* Qt denotes we have not yet called Ffind_operation_coding_system. */
- Lisp_Object coding_systems;
- Lisp_Object val, *args2;
- ptrdiff_t i;
+ Lisp_Object val, start, end;
Lisp_Object tmpdir;
if (STRINGP (Vtemporary_file_directory))
@@ -1016,9 +986,7 @@ usage: (call-process-region START END PROGRAM &optional DELETE BUFFER DISPLAY &r
}
{
- USE_SAFE_ALLOCA;
Lisp_Object pattern = Fexpand_file_name (Vtemp_file_name_pattern, tmpdir);
- Lisp_Object encoded_tem;
char *tempfile;
#ifdef WINDOWSNT
@@ -1036,39 +1004,30 @@ usage: (call-process-region START END PROGRAM &optional DELETE BUFFER DISPLAY &r
}
#endif
- encoded_tem = ENCODE_FILE (pattern);
- tempfile = SAFE_ALLOCA (SBYTES (encoded_tem) + 1);
- memcpy (tempfile, SDATA (encoded_tem), SBYTES (encoded_tem) + 1);
- coding_systems = Qt;
+ filename_string = Fcopy_sequence (ENCODE_FILE (pattern));
+ GCPRO1 (filename_string);
+ tempfile = SSDATA (filename_string);
-#if defined HAVE_MKOSTEMP || defined HAVE_MKSTEMP
{
- int fd, open_errno;
+ int fd;
- block_input ();
-# ifdef HAVE_MKOSTEMP
+#ifdef HAVE_MKOSTEMP
fd = mkostemp (tempfile, O_CLOEXEC);
-# else
+#elif defined HAVE_MKSTEMP
fd = mkstemp (tempfile);
-# endif
- open_errno = errno;
- unblock_input ();
+#else
+ errno = EEXIST;
+ mktemp (tempfile);
+ /* INT_MAX denotes success, because close (INT_MAX) does nothing. */
+ fd = *tempfile ? INT_MAX : -1;
+#endif
if (fd < 0)
- report_file_errno ("Failed to open temporary file",
- Fcons (build_string (tempfile), Qnil), open_errno);
+ report_file_error ("Failed to open temporary file using pattern",
+ pattern);
emacs_close (fd);
}
-#else
- errno = EEXIST;
- mktemp (tempfile);
- if (!*tempfile)
- report_file_error ("Failed to open temporary file using pattern",
- Fcons (pattern, Qnil));
-#endif
- filename_string = build_string (tempfile);
- GCPRO1 (filename_string);
- SAFE_FREE ();
+ record_unwind_protect (delete_temp_file, filename_string);
}
start = args[0];
@@ -1080,10 +1039,12 @@ usage: (call-process-region START END PROGRAM &optional DELETE BUFFER DISPLAY &r
val = Qraw_text;
else
{
+ Lisp_Object coding_systems;
+ Lisp_Object *args2;
USE_SAFE_ALLOCA;
SAFE_NALLOCA (args2, 1, nargs + 1);
args2[0] = Qcall_process_region;
- for (i = 0; i < nargs; i++) args2[i + 1] = args[i];
+ memcpy (args2 + 1, args, nargs * sizeof *args);
coding_systems = Ffind_operation_coding_system (nargs + 1, args2);
val = CONSP (coding_systems) ? XCDR (coding_systems) : Qnil;
SAFE_FREE ();
@@ -1105,7 +1066,57 @@ usage: (call-process-region START END PROGRAM &optional DELETE BUFFER DISPLAY &r
/* Note that Fcall_process takes care of binding
coding-system-for-read. */
- record_unwind_protect (delete_temp_file, filename_string);
+ RETURN_UNGCPRO (filename_string);
+}
+
+DEFUN ("call-process-region", Fcall_process_region, Scall_process_region,
+ 3, MANY, 0,
+ doc: /* Send text from START to END to a synchronous process running PROGRAM.
+The remaining arguments are optional.
+Delete the text if fourth arg DELETE is non-nil.
+
+Insert output in BUFFER before point; t means current buffer; nil for
+ BUFFER means discard it; 0 means discard and don't wait; and `(:file
+ FILE)', where FILE is a file name string, means that it should be
+ written to that file (if the file already exists it is overwritten).
+BUFFER can also have the form (REAL-BUFFER STDERR-FILE); in that case,
+REAL-BUFFER says what to do with standard output, as above,
+while STDERR-FILE says what to do with standard error in the child.
+STDERR-FILE may be nil (discard standard error output),
+t (mix it with ordinary output), or a file name string.
+
+Sixth arg DISPLAY non-nil means redisplay buffer as output is inserted.
+Remaining args are passed to PROGRAM at startup as command args.
+
+If BUFFER is 0, `call-process-region' returns immediately with value nil.
+Otherwise it waits for PROGRAM to terminate
+and returns a numeric exit status or a signal description string.
+If you quit, the process is killed with SIGINT, or SIGKILL if you quit again.
+
+usage: (call-process-region START END PROGRAM &optional DELETE BUFFER DISPLAY &rest ARGS) */)
+ (ptrdiff_t nargs, Lisp_Object *args)
+{
+ struct gcpro gcpro1;
+ Lisp_Object infile;
+ ptrdiff_t count = SPECPDL_INDEX ();
+ Lisp_Object start = args[0];
+ Lisp_Object end = args[1];
+ bool empty_input;
+
+ if (STRINGP (start))
+ empty_input = SCHARS (start) == 0;
+ else if (NILP (start))
+ empty_input = BEG == Z;
+ else
+ {
+ validate_region (&args[0], &args[1]);
+ start = args[0];
+ end = args[1];
+ empty_input = XINT (start) == XINT (end);
+ }
+
+ infile = empty_input ? Qnil : create_temp_file (nargs, args);
+ GCPRO1 (infile);
if (nargs > 3 && !NILP (args[3]))
Fdelete_region (start, end);
@@ -1120,7 +1131,7 @@ usage: (call-process-region START END PROGRAM &optional DELETE BUFFER DISPLAY &r
args[0] = args[2];
nargs = 2;
}
- args[1] = filename_string;
+ args[1] = infile;
RETURN_UNGCPRO (unbind_to (count, Fcall_process (nargs, args)));
}
@@ -1185,9 +1196,11 @@ child_setup (int in, int out, int err, char **new_argv, bool set_pgrp,
#ifdef WINDOWSNT
int cpid;
HANDLE handles[3];
-#endif /* WINDOWSNT */
+#else
+ int exec_errno;
pid_t pid = getpid ();
+#endif /* WINDOWSNT */
/* Note that use of alloca is always safe here. It's obvious for systems
that do not have true vfork or that have true (stack) alloca.
@@ -1346,32 +1359,27 @@ child_setup (int in, int out, int err, char **new_argv, bool set_pgrp,
}
#ifndef MSDOS
- emacs_close (0);
- emacs_close (1);
- emacs_close (2);
-
- /* Redirect file descriptors and clear FD_CLOEXEC on the redirected ones. */
+ /* Redirect file descriptors and clear the close-on-exec flag on the
+ redirected ones. IN, OUT, and ERR are close-on-exec so they
+ need not be closed explicitly. */
dup2 (in, 0);
dup2 (out, 1);
dup2 (err, 2);
- emacs_close (in);
- if (out != in)
- emacs_close (out);
- if (err != in && err != out)
- emacs_close (err);
-
setpgid (0, 0);
tcsetpgrp (0, pid);
execve (new_argv[0], new_argv, env);
+ exec_errno = errno;
- /* Don't output the program name here, as it can be arbitrarily long,
- and a long write from a vforked child to its parent can cause a
- deadlock. */
- emacs_perror ("child process");
+ /* Avoid deadlock if the child's perror writes to a full pipe; the
+ pipe's reader is the parent, but with vfork the parent can't
+ run until the child exits. Truncate the diagnostic instead. */
+ fcntl (STDERR_FILENO, F_SETFL, O_NONBLOCK);
- _exit (errno == ENOENT ? EXIT_ENOENT : EXIT_CANNOT_INVOKE);
+ errno = exec_errno;
+ emacs_perror (new_argv[0]);
+ _exit (exec_errno == ENOENT ? EXIT_ENOENT : EXIT_CANNOT_INVOKE);
#else /* MSDOS */
pid = run_msdos_command (new_argv, pwd_var + 4, in, out, err, env);
@@ -1386,7 +1394,8 @@ child_setup (int in, int out, int err, char **new_argv, bool set_pgrp,
#ifndef WINDOWSNT
/* Move the file descriptor FD so that its number is not less than MINFD.
- If the file descriptor is moved at all, the original is freed. */
+ If the file descriptor is moved at all, the original is closed on MSDOS,
+ but not elsewhere as the caller will close it anyway. */
static int
relocate_fd (int fd, int minfd)
{
@@ -1400,7 +1409,9 @@ relocate_fd (int fd, int minfd)
emacs_perror ("while setting up child");
_exit (EXIT_CANCELED);
}
+#ifdef MSDOS
emacs_close (fd);
+#endif
return new;
}
}
diff --git a/src/charset.c b/src/charset.c
index fdb8eebde8b..eedf65faa6c 100644
--- a/src/charset.c
+++ b/src/charset.c
@@ -28,6 +28,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#define CHARSET_INLINE EXTERN_INLINE
+#include <errno.h>
#include <stdio.h>
#include <unistd.h>
#include <limits.h>
@@ -477,7 +478,8 @@ read_hex (FILE *fp, bool *eof, bool *overflow)
`file-name-handler-alist' to avoid running any Lisp code. */
static void
-load_charset_map_from_file (struct charset *charset, Lisp_Object mapfile, int control_flag)
+load_charset_map_from_file (struct charset *charset, Lisp_Object mapfile,
+ int control_flag)
{
unsigned min_code = CHARSET_MIN_CODE (charset);
unsigned max_code = CHARSET_MAX_CODE (charset);
@@ -487,22 +489,26 @@ load_charset_map_from_file (struct charset *charset, Lisp_Object mapfile, int co
struct charset_map_entries *head, *entries;
int n_entries;
ptrdiff_t count;
- USE_SAFE_ALLOCA;
- suffixes = Fcons (build_string (".map"),
- Fcons (build_string (".TXT"), Qnil));
+ suffixes = list2 (build_string (".map"), build_string (".TXT"));
count = SPECPDL_INDEX ();
+ record_unwind_protect_nothing ();
specbind (Qfile_name_handler_alist, Qnil);
fd = openp (Vcharset_map_path, mapfile, suffixes, NULL, Qnil);
- unbind_to (count, Qnil);
- if (fd < 0
- || ! (fp = fdopen (fd, "r")))
- error ("Failure in loading charset map: %s", SDATA (mapfile));
+ fp = fd < 0 ? 0 : fdopen (fd, "r");
+ if (!fp)
+ {
+ int open_errno = errno;
+ emacs_close (fd);
+ report_file_errno ("Loading charset map", mapfile, open_errno);
+ }
+ set_unwind_protect_ptr (count, fclose_unwind, fp);
+ unbind_to (count + 1, Qnil);
- /* Use SAFE_ALLOCA instead of alloca, as `charset_map_entries' is
+ /* Use record_xmalloc, as `charset_map_entries' is
large (larger than MAX_ALLOCA). */
- head = SAFE_ALLOCA (sizeof *head);
+ head = record_xmalloc (sizeof *head);
entries = head;
memset (entries, 0, sizeof (struct charset_map_entries));
@@ -531,9 +537,9 @@ load_charset_map_from_file (struct charset *charset, Lisp_Object mapfile, int co
if (from < min_code || to > max_code || from > to || c > MAX_CHAR)
continue;
- if (n_entries > 0 && (n_entries % 0x10000) == 0)
+ if (n_entries == 0x10000)
{
- entries->next = SAFE_ALLOCA (sizeof *entries->next);
+ entries->next = record_xmalloc (sizeof *entries->next);
entries = entries->next;
memset (entries, 0, sizeof (struct charset_map_entries));
n_entries = 0;
@@ -545,9 +551,10 @@ load_charset_map_from_file (struct charset *charset, Lisp_Object mapfile, int co
n_entries++;
}
fclose (fp);
+ clear_unwind_protect (count);
load_charset_map (charset, head, n_entries, control_flag);
- SAFE_FREE ();
+ unbind_to (count, Qnil);
}
static void
@@ -1178,7 +1185,7 @@ usage: (define-charset-internal ...) */)
charset.iso_final) = id;
if (new_definition_p)
Viso_2022_charset_list = nconc2 (Viso_2022_charset_list,
- Fcons (make_number (id), Qnil));
+ list1 (make_number (id)));
if (ISO_CHARSET_TABLE (1, 0, 'J') == id)
charset_jisx0201_roman = id;
else if (ISO_CHARSET_TABLE (2, 0, '@') == id)
@@ -1198,7 +1205,7 @@ usage: (define-charset-internal ...) */)
emacs_mule_bytes[charset.emacs_mule_id] = charset.dimension + 2;
if (new_definition_p)
Vemacs_mule_charset_list = nconc2 (Vemacs_mule_charset_list,
- Fcons (make_number (id), Qnil));
+ list1 (make_number (id)));
}
if (new_definition_p)
@@ -1206,7 +1213,7 @@ usage: (define-charset-internal ...) */)
Vcharset_list = Fcons (args[charset_arg_name], Vcharset_list);
if (charset.supplementary_p)
Vcharset_ordered_list = nconc2 (Vcharset_ordered_list,
- Fcons (make_number (id), Qnil));
+ list1 (make_number (id)));
else
{
Lisp_Object tail;
@@ -1223,7 +1230,7 @@ usage: (define-charset-internal ...) */)
Vcharset_ordered_list);
else if (NILP (tail))
Vcharset_ordered_list = nconc2 (Vcharset_ordered_list,
- Fcons (make_number (id), Qnil));
+ list1 (make_number (id)));
else
{
val = Fcons (XCAR (tail), XCDR (tail));
@@ -2308,7 +2315,7 @@ Please check your installation!\n",
exit (1);
}
- Vcharset_map_path = Fcons (tempdir, Qnil);
+ Vcharset_map_path = list1 (tempdir);
}
diff --git a/src/coding.c b/src/coding.c
index 1ab59294b98..0cdd8f9cd9e 100644
--- a/src/coding.c
+++ b/src/coding.c
@@ -493,6 +493,8 @@ enum iso_code_class_type
#define CODING_ISO_FLAG_USE_OLDJIS 0x10000
+#define CODING_ISO_FLAG_LEVEL_4 0x20000
+
#define CODING_ISO_FLAG_FULL_SUPPORT 0x100000
/* A character to be produced on output if encoding of the original
@@ -1363,6 +1365,45 @@ decode_coding_utf_8 (struct coding_system *coding)
break;
}
+ /* In the simple case, rapidly handle ordinary characters */
+ if (multibytep && ! eol_dos
+ && charbuf < charbuf_end - 6 && src < src_end - 6)
+ {
+ while (charbuf < charbuf_end - 6 && src < src_end - 6)
+ {
+ c1 = *src;
+ if (c1 & 0x80)
+ break;
+ src++;
+ consumed_chars++;
+ *charbuf++ = c1;
+
+ c1 = *src;
+ if (c1 & 0x80)
+ break;
+ src++;
+ consumed_chars++;
+ *charbuf++ = c1;
+
+ c1 = *src;
+ if (c1 & 0x80)
+ break;
+ src++;
+ consumed_chars++;
+ *charbuf++ = c1;
+
+ c1 = *src;
+ if (c1 & 0x80)
+ break;
+ src++;
+ consumed_chars++;
+ *charbuf++ = c1;
+ }
+ /* If we handled at least one character, restart the main loop. */
+ if (src != src_base)
+ continue;
+ }
+
if (byte_after_cr >= 0)
c1 = byte_after_cr, byte_after_cr = -1;
else
@@ -3733,7 +3774,10 @@ decode_coding_iso_2022 (struct coding_system *coding)
else
charset = CHARSET_FROM_ID (charset_id_2);
ONE_MORE_BYTE (c1);
- if (c1 < 0x20 || (c1 >= 0x80 && c1 < 0xA0))
+ if (c1 < 0x20 || (c1 >= 0x80 && c1 < 0xA0)
+ || (! (CODING_ISO_FLAGS (coding) & CODING_ISO_FLAG_SEVEN_BITS)
+ && ((CODING_ISO_FLAGS (coding) & CODING_ISO_FLAG_LEVEL_4)
+ ? c1 >= 0x80 : c1 < 0x80)))
goto invalid_code;
break;
@@ -3747,7 +3791,10 @@ decode_coding_iso_2022 (struct coding_system *coding)
else
charset = CHARSET_FROM_ID (charset_id_3);
ONE_MORE_BYTE (c1);
- if (c1 < 0x20 || (c1 >= 0x80 && c1 < 0xA0))
+ if (c1 < 0x20 || (c1 >= 0x80 && c1 < 0xA0)
+ || (! (CODING_ISO_FLAGS (coding) & CODING_ISO_FLAG_SEVEN_BITS)
+ && ((CODING_ISO_FLAGS (coding) & CODING_ISO_FLAG_LEVEL_4)
+ ? c1 >= 0x80 : c1 < 0x80)))
goto invalid_code;
break;
@@ -6864,11 +6911,9 @@ get_translation_table (Lisp_Object attrs, bool encodep, int *max_lookup)
if (CHAR_TABLE_P (standard))
{
if (CONSP (translation_table))
- translation_table = nconc2 (translation_table,
- Fcons (standard, Qnil));
+ translation_table = nconc2 (translation_table, list1 (standard));
else
- translation_table = Fcons (translation_table,
- Fcons (standard, Qnil));
+ translation_table = list2 (translation_table, standard);
}
}
@@ -7793,7 +7838,7 @@ make_conversion_work_buffer (bool multibyte)
}
-static Lisp_Object
+static void
code_conversion_restore (Lisp_Object arg)
{
Lisp_Object current, workbuf;
@@ -7811,7 +7856,6 @@ code_conversion_restore (Lisp_Object arg)
}
set_buffer_internal (XBUFFER (current));
UNGCPRO;
- return Qnil;
}
Lisp_Object
@@ -8667,20 +8711,20 @@ detect_coding_system (const unsigned char *src,
{
detect_info.found = CATEGORY_MASK_RAW_TEXT;
id = CODING_SYSTEM_ID (Qno_conversion);
- val = Fcons (make_number (id), Qnil);
+ val = list1 (make_number (id));
}
else if (! detect_info.rejected && ! detect_info.found)
{
detect_info.found = CATEGORY_MASK_ANY;
id = coding_categories[coding_category_undecided].id;
- val = Fcons (make_number (id), Qnil);
+ val = list1 (make_number (id));
}
else if (highest)
{
if (detect_info.found)
{
detect_info.found = 1 << category;
- val = Fcons (make_number (this->id), Qnil);
+ val = list1 (make_number (this->id));
}
else
for (i = 0; i < coding_category_raw_text; i++)
@@ -8688,7 +8732,7 @@ detect_coding_system (const unsigned char *src,
{
detect_info.found = 1 << coding_priorities[i];
id = coding_categories[coding_priorities[i]].id;
- val = Fcons (make_number (id), Qnil);
+ val = list1 (make_number (id));
break;
}
}
@@ -8705,7 +8749,7 @@ detect_coding_system (const unsigned char *src,
found |= 1 << category;
id = coding_categories[category].id;
if (id >= 0)
- val = Fcons (make_number (id), val);
+ val = list1 (make_number (id));
}
}
for (i = coding_category_raw_text - 1; i >= 0; i--)
@@ -8730,7 +8774,7 @@ detect_coding_system (const unsigned char *src,
this = coding_categories + coding_category_utf_8_sig;
else
this = coding_categories + coding_category_utf_8_nosig;
- val = Fcons (make_number (this->id), Qnil);
+ val = list1 (make_number (this->id));
}
}
else if (base_category == coding_category_utf_16_auto)
@@ -8747,13 +8791,13 @@ detect_coding_system (const unsigned char *src,
this = coding_categories + coding_category_utf_16_be_nosig;
else
this = coding_categories + coding_category_utf_16_le_nosig;
- val = Fcons (make_number (this->id), Qnil);
+ val = list1 (make_number (this->id));
}
}
else
{
detect_info.found = 1 << XINT (CODING_ATTR_CATEGORY (attrs));
- val = Fcons (make_number (coding.id), Qnil);
+ val = list1 (make_number (coding.id));
}
/* Then, detect eol-format if necessary. */
@@ -9224,7 +9268,7 @@ is nil. */)
attrs = AREF (CODING_SYSTEM_SPEC (elt), 0);
ASET (attrs, coding_attr_trans_tbl,
get_translation_table (attrs, 1, NULL));
- list = Fcons (Fcons (elt, Fcons (attrs, Qnil)), list);
+ list = Fcons (list2 (elt, attrs), list);
}
if (STRINGP (start))
@@ -9635,7 +9679,7 @@ DEFUN ("set-terminal-coding-system-internal", Fset_terminal_coding_system_intern
tset_charset_list
(term, (terminal_coding->common_flags & CODING_REQUIRE_ENCODING_MASK
? coding_charset_list (terminal_coding)
- : Fcons (make_number (charset_ascii), Qnil)));
+ : list1 (make_number (charset_ascii))));
return Qnil;
}
@@ -10080,9 +10124,9 @@ usage: (define-coding-system-internal ...) */)
{
dim2 = CHARSET_DIMENSION (CHARSET_FROM_ID (XFASTINT (tmp)));
if (dim < dim2)
- tmp = Fcons (XCAR (tail), Fcons (tmp, Qnil));
+ tmp = list2 (XCAR (tail), tmp);
else
- tmp = Fcons (tmp, Fcons (XCAR (tail), Qnil));
+ tmp = list2 (tmp, XCAR (tail));
}
else
{
@@ -10093,7 +10137,7 @@ usage: (define-coding-system-internal ...) */)
break;
}
if (NILP (tmp2))
- tmp = nconc2 (tmp, Fcons (XCAR (tail), Qnil));
+ tmp = nconc2 (tmp, list1 (XCAR (tail)));
else
{
XSETCDR (tmp2, Fcons (XCAR (tmp2), XCDR (tmp2)));
@@ -10411,7 +10455,7 @@ usage: (define-coding-system-internal ...) */)
&& ! EQ (eol_type, Qmac))
error ("Invalid eol-type");
- aliases = Fcons (name, Qnil);
+ aliases = list1 (name);
if (NILP (eol_type))
{
@@ -10421,7 +10465,7 @@ usage: (define-coding-system-internal ...) */)
Lisp_Object this_spec, this_name, this_aliases, this_eol_type;
this_name = AREF (eol_type, i);
- this_aliases = Fcons (this_name, Qnil);
+ this_aliases = list1 (this_name);
this_eol_type = (i == 0 ? Qunix : i == 1 ? Qdos : Qmac);
this_spec = make_uninit_vector (3);
ASET (this_spec, 0, attrs);
@@ -10536,7 +10580,7 @@ DEFUN ("define-coding-system-alias", Fdefine_coding_system_alias,
list. */
while (!NILP (XCDR (aliases)))
aliases = XCDR (aliases);
- XSETCDR (aliases, Fcons (alias, Qnil));
+ XSETCDR (aliases, list1 (alias));
eol_type = AREF (spec, 2);
if (VECTORP (eol_type))
@@ -11218,6 +11262,8 @@ character.");
plist[13] = build_pure_c_string ("No conversion on encoding, automatic conversion on decoding.");
plist[15] = args[coding_arg_eol_type] = Qnil;
args[coding_arg_plist] = Flist (16, plist);
+ args[coding_arg_undecided_inhibit_null_byte_detection] = make_number (0);
+ args[coding_arg_undecided_inhibit_iso_escape_detection] = make_number (0);
Fdefine_coding_system_internal (coding_arg_undecided_max, args);
}
diff --git a/src/composite.c b/src/composite.c
index 8b1f0171a60..99b5da22af5 100644
--- a/src/composite.c
+++ b/src/composite.c
@@ -595,7 +595,7 @@ update_compositions (ptrdiff_t from, ptrdiff_t to, int check_mask)
specbind (Qinhibit_point_motion_hooks, Qt);
Fremove_list_of_text_properties (make_number (min_pos),
make_number (max_pos),
- Fcons (Qauto_composed, Qnil), Qnil);
+ list1 (Qauto_composed), Qnil);
unbind_to (count, Qnil);
}
}
@@ -1873,11 +1873,9 @@ See `find-composition' for more details. */)
return list3 (make_number (s), make_number (e), gstring);
}
if (!COMPOSITION_VALID_P (start, end, prop))
- return Fcons (make_number (start), Fcons (make_number (end),
- Fcons (Qnil, Qnil)));
+ return list3 (make_number (start), make_number (end), Qnil);
if (NILP (detail_p))
- return Fcons (make_number (start), Fcons (make_number (end),
- Fcons (Qt, Qnil)));
+ return list3 (make_number (start), make_number (end), Qt);
if (COMPOSITION_REGISTERD_P (prop))
id = COMPOSITION_ID (prop);
@@ -1899,10 +1897,7 @@ See `find-composition' for more details. */)
relative_p = (method == COMPOSITION_WITH_RULE_ALTCHARS
? Qnil : Qt);
mod_func = COMPOSITION_MODIFICATION_FUNC (prop);
- tail = Fcons (components,
- Fcons (relative_p,
- Fcons (mod_func,
- Fcons (make_number (width), Qnil))));
+ tail = list4 (components, relative_p, mod_func, make_number (width));
}
else
tail = Qnil;
diff --git a/src/conf_post.h b/src/conf_post.h
index b19456749a2..16714076f6f 100644
--- a/src/conf_post.h
+++ b/src/conf_post.h
@@ -160,13 +160,7 @@ extern void _DebPrint (const char *fmt, ...);
/* Tell regex.c to use a type compatible with Emacs. */
#define RE_TRANSLATE_TYPE Lisp_Object
#define RE_TRANSLATE(TBL, C) char_table_translate (TBL, C)
-#ifdef make_number
-/* If make_number is a macro, use it. */
#define RE_TRANSLATE_P(TBL) (!EQ (TBL, make_number (0)))
-#else
-/* If make_number is a function, avoid it. */
-#define RE_TRANSLATE_P(TBL) (!(INTEGERP (TBL) && XINT (TBL) == 0))
-#endif
#endif
#include <string.h>
diff --git a/src/cygw32.c b/src/cygw32.c
index bbc3a49fd88..3e0f4ae1803 100644
--- a/src/cygw32.c
+++ b/src/cygw32.c
@@ -23,12 +23,11 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <unistd.h>
#include <fcntl.h>
-static Lisp_Object
-fchdir_unwind (Lisp_Object dir_fd)
+static void
+fchdir_unwind (int dir_fd)
{
- (void) fchdir (XFASTINT (dir_fd));
- (void) close (XFASTINT (dir_fd));
- return Qnil;
+ (void) fchdir (dir_fd);
+ (void) close (dir_fd);
}
static void
@@ -40,7 +39,7 @@ chdir_to_default_directory ()
if (old_cwd_fd == -1)
error ("could not open current directory: %s", strerror (errno));
- record_unwind_protect (fchdir_unwind, make_number (old_cwd_fd));
+ record_unwind_protect_int (fchdir_unwind, old_cwd_fd);
new_cwd = Funhandled_file_name_directory (
Fexpand_file_name (build_string ("."), Qnil));
diff --git a/src/data.c b/src/data.c
index ea72a3fc181..25a9e698481 100644
--- a/src/data.c
+++ b/src/data.c
@@ -1515,24 +1515,19 @@ of previous VARs.
usage: (setq-default [VAR VALUE]...) */)
(Lisp_Object args)
{
- register Lisp_Object args_left;
- register Lisp_Object val, symbol;
+ Lisp_Object args_left, symbol, val;
struct gcpro gcpro1;
- if (NILP (args))
- return Qnil;
-
- args_left = args;
+ args_left = val = args;
GCPRO1 (args);
- do
+ while (CONSP (args_left))
{
- val = eval_sub (Fcar (Fcdr (args_left)));
+ val = eval_sub (Fcar (XCDR (args_left)));
symbol = XCAR (args_left);
Fset_default (symbol, val);
args_left = Fcdr (XCDR (args_left));
}
- while (!NILP (args_left));
UNGCPRO;
return val;
diff --git a/src/deps.mk b/src/deps.mk
index 83444474c59..39666dca515 100644
--- a/src/deps.mk
+++ b/src/deps.mk
@@ -190,7 +190,7 @@ sysdep.o: sysdep.c syssignal.h systty.h systime.h syswait.h blockinput.h \
frame.h atimer.h window.h msdos.h dosfns.h keyboard.h cm.h lisp.h \
globals.h $(config_h) composite.h sysselect.h gnutls.h \
../lib/allocator.h ../lib/careadlinkat.h \
- ../lib/unistd.h ../lib/ignore-value.h
+ ../lib/unistd.h
term.o: term.c termchar.h termhooks.h termopts.h lisp.h globals.h $(config_h) \
cm.h frame.h disptab.h keyboard.h character.h charset.h coding.h ccl.h \
xterm.h msdos.h window.h keymap.h blockinput.h atimer.h systime.h \
diff --git a/src/dired.c b/src/dired.c
index b3348b0aff0..2b79b54f2a4 100644
--- a/src/dired.c
+++ b/src/dired.c
@@ -107,22 +107,20 @@ open_directory (char const *name, int *fdp)
}
#ifdef WINDOWSNT
-Lisp_Object
+void
directory_files_internal_w32_unwind (Lisp_Object arg)
{
Vw32_get_true_file_attributes = arg;
- return Qnil;
}
#endif
-static Lisp_Object
-directory_files_internal_unwind (Lisp_Object dh)
+static void
+directory_files_internal_unwind (void *dh)
{
- DIR *d = XSAVE_POINTER (dh, 0);
+ DIR *d = dh;
block_input ();
closedir (d);
unblock_input ();
- return Qnil;
}
/* Function shared by Fdirectory_files and Fdirectory_files_and_attributes.
@@ -185,13 +183,12 @@ directory_files_internal (Lisp_Object directory, Lisp_Object full,
d = open_directory (SSDATA (dirfilename), &fd);
if (d == NULL)
- report_file_error ("Opening directory", Fcons (directory, Qnil));
+ report_file_error ("Opening directory", directory);
/* Unfortunately, we can now invoke expand-file-name and
file-attributes on filenames, both of which can throw, so we must
do a proper unwind-protect. */
- record_unwind_protect (directory_files_internal_unwind,
- make_save_pointer (d));
+ record_unwind_protect_ptr (directory_files_internal_unwind, d);
#ifdef WINDOWSNT
if (attrs)
@@ -488,10 +485,9 @@ file_name_completion (Lisp_Object file, Lisp_Object dirname, bool all_flag,
d = open_directory (SSDATA (encoded_dir), &fd);
if (!d)
- report_file_error ("Opening directory", Fcons (dirname, Qnil));
+ report_file_error ("Opening directory", dirname);
- record_unwind_protect (directory_files_internal_unwind,
- make_save_pointer (d));
+ record_unwind_protect_ptr (directory_files_internal_unwind, d);
/* Loop reading blocks */
/* (att3b compiler bug requires do a null comparison this way) */
@@ -1017,7 +1013,7 @@ return a list with one element, taken from `user-real-login-name'. */)
#endif
if (EQ (users, Qnil))
/* At least current user is always known. */
- users = Fcons (Vuser_real_login_name, Qnil);
+ users = list1 (Vuser_real_login_name);
return users;
}
diff --git a/src/dispnew.c b/src/dispnew.c
index 1eb097f05ab..522a0e6a30d 100644
--- a/src/dispnew.c
+++ b/src/dispnew.c
@@ -5619,7 +5619,7 @@ FILE = nil means just close any termscript file currently open. */)
file = Fexpand_file_name (file, Qnil);
tty->termscript = emacs_fopen (SSDATA (file), "w");
if (tty->termscript == 0)
- report_file_error ("Opening termscript", Fcons (file, Qnil));
+ report_file_error ("Opening termscript", file);
}
return Qnil;
}
@@ -5699,7 +5699,7 @@ bitch_at_user (void)
{
const char *msg
= "Keyboard macro terminated by a command ringing the bell";
- Fsignal (Quser_error, Fcons (build_string (msg), Qnil));
+ Fsignal (Quser_error, list1 (build_string (msg)));
}
else
ring_bell (XFRAME (selected_frame));
@@ -6041,7 +6041,7 @@ init_display (void)
#ifdef HAVE_X11
Vwindow_system_version = make_number (11);
#endif
-#ifdef GNU_LINUX
+#ifdef USE_NCURSES
/* In some versions of ncurses,
tputs crashes if we have not called tgetent.
So call tgetent. */
@@ -6127,15 +6127,14 @@ init_display (void)
/* Update frame parameters to reflect the new type. */
Fmodify_frame_parameters
- (selected_frame, Fcons (Fcons (Qtty_type,
- Ftty_type (selected_frame)), Qnil));
+ (selected_frame, list1 (Fcons (Qtty_type,
+ Ftty_type (selected_frame))));
if (t->display_info.tty->name)
- Fmodify_frame_parameters (selected_frame,
- Fcons (Fcons (Qtty, build_string (t->display_info.tty->name)),
- Qnil));
+ Fmodify_frame_parameters
+ (selected_frame,
+ list1 (Fcons (Qtty, build_string (t->display_info.tty->name))));
else
- Fmodify_frame_parameters (selected_frame, Fcons (Fcons (Qtty, Qnil),
- Qnil));
+ Fmodify_frame_parameters (selected_frame, list1 (Fcons (Qtty, Qnil)));
}
{
diff --git a/src/doc.c b/src/doc.c
index 3c5a682c001..009616f4f87 100644
--- a/src/doc.c
+++ b/src/doc.c
@@ -21,6 +21,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <config.h>
+#include <errno.h>
#include <sys/types.h>
#include <sys/file.h> /* Must be after sys/types.h for USG. */
#include <fcntl.h>
@@ -84,6 +85,7 @@ get_doc_string (Lisp_Object filepos, bool unibyte, bool definition)
int offset;
EMACS_INT position;
Lisp_Object file, tem, pos;
+ ptrdiff_t count;
USE_SAFE_ALLOCA;
if (INTEGERP (filepos))
@@ -143,9 +145,14 @@ get_doc_string (Lisp_Object filepos, bool unibyte, bool definition)
}
#endif
if (fd < 0)
- return concat3 (build_string ("Cannot open doc string file \""),
- file, build_string ("\"\n"));
+ {
+ SAFE_FREE ();
+ return concat3 (build_string ("Cannot open doc string file \""),
+ file, build_string ("\"\n"));
+ }
}
+ count = SPECPDL_INDEX ();
+ record_unwind_protect_int (close_file_unwind, fd);
/* Seek only to beginning of disk block. */
/* Make sure we read at least 1024 bytes before `position'
@@ -153,13 +160,8 @@ get_doc_string (Lisp_Object filepos, bool unibyte, bool definition)
offset = min (position, max (1024, position % (8 * 1024)));
if (TYPE_MAXIMUM (off_t) < position
|| lseek (fd, position - offset, 0) < 0)
- {
- emacs_close (fd);
- error ("Position %"pI"d out of range in doc string file \"%s\"",
- position, name);
- }
-
- SAFE_FREE ();
+ error ("Position %"pI"d out of range in doc string file \"%s\"",
+ position, name);
/* Read the doc string into get_doc_string_buffer.
P points beyond the data just read. */
@@ -189,10 +191,7 @@ get_doc_string (Lisp_Object filepos, bool unibyte, bool definition)
space_left = 1024 * 8;
nread = emacs_read (fd, p, space_left);
if (nread < 0)
- {
- emacs_close (fd);
- error ("Read error on documentation file");
- }
+ report_file_error ("Read error on documentation file", file);
p[nread] = 0;
if (!nread)
break;
@@ -208,7 +207,8 @@ get_doc_string (Lisp_Object filepos, bool unibyte, bool definition)
}
p += nread;
}
- emacs_close (fd);
+ unbind_to (count, Qnil);
+ SAFE_FREE ();
/* Sanity checking. */
if (CONSP (filepos))
@@ -573,6 +573,7 @@ the same file name is found in the `doc-directory'. */)
Lisp_Object sym;
char *p, *name;
bool skip_file = 0;
+ ptrdiff_t count;
CHECK_STRING (filename);
@@ -609,8 +610,13 @@ the same file name is found in the `doc-directory'. */)
fd = emacs_open (name, O_RDONLY, 0);
if (fd < 0)
- report_file_error ("Opening doc string file",
- Fcons (build_string (name), Qnil));
+ {
+ int open_errno = errno;
+ report_file_errno ("Opening doc string file", build_string (name),
+ open_errno);
+ }
+ count = SPECPDL_INDEX ();
+ record_unwind_protect_int (close_file_unwind, fd);
Vdoc_file_name = filename;
filled = 0;
pos = 0;
@@ -688,8 +694,7 @@ the same file name is found in the `doc-directory'. */)
filled -= end - buf;
memmove (buf, end, filled);
}
- emacs_close (fd);
- return Qnil;
+ return unbind_to (count, Qnil);
}
DEFUN ("substitute-command-keys", Fsubstitute_command_keys,
diff --git a/src/editfns.c b/src/editfns.c
index cc6b4cff895..50bde90788d 100644
--- a/src/editfns.c
+++ b/src/editfns.c
@@ -838,9 +838,8 @@ This function does not move point. */)
Lisp_Object
save_excursion_save (void)
{
- return make_save_value
- (SAVE_TYPE_OBJ_OBJ_OBJ_OBJ,
- Fpoint_marker (),
+ return make_save_obj_obj_obj_obj
+ (Fpoint_marker (),
/* Do not copy the mark if it points to nowhere. */
(XMARKER (BVAR (current_buffer, mark))->buffer
? Fcopy_marker (BVAR (current_buffer, mark), Qnil)
@@ -853,7 +852,7 @@ save_excursion_save (void)
/* Restore saved buffer before leaving `save-excursion' special form. */
-Lisp_Object
+void
save_excursion_restore (Lisp_Object info)
{
Lisp_Object tem, tem1, omark, nmark;
@@ -927,7 +926,6 @@ save_excursion_restore (Lisp_Object info)
out:
free_misc (info);
- return Qnil;
}
DEFUN ("save-excursion", Fsave_excursion, Ssave_excursion, 0, UNEVALLED, 0,
@@ -2809,18 +2807,16 @@ determines whether case is significant or ignored. */)
return make_number (0);
}
-static Lisp_Object
+static void
subst_char_in_region_unwind (Lisp_Object arg)
{
bset_undo_list (current_buffer, arg);
- return arg;
}
-static Lisp_Object
+static void
subst_char_in_region_unwind_1 (Lisp_Object arg)
{
bset_filename (current_buffer, arg);
- return arg;
}
DEFUN ("subst-char-in-region", Fsubst_char_in_region,
@@ -3331,7 +3327,7 @@ save_restriction_save (void)
}
}
-Lisp_Object
+void
save_restriction_restore (Lisp_Object data)
{
struct buffer *cur = NULL;
@@ -3398,8 +3394,6 @@ save_restriction_restore (Lisp_Object data)
if (cur)
set_buffer_internal (cur);
-
- return Qnil;
}
DEFUN ("save-restriction", Fsave_restriction, Ssave_restriction, 0, UNEVALLED, 0,
@@ -3492,7 +3486,7 @@ usage: (message-box FORMAT-STRING &rest ARGS) */)
{
Lisp_Object pane, menu;
struct gcpro gcpro1;
- pane = Fcons (Fcons (build_string ("OK"), Qt), Qnil);
+ pane = list1 (Fcons (build_string ("OK"), Qt));
GCPRO1 (pane);
menu = Fcons (val, pane);
Fx_popup_dialog (Qt, menu, Qt);
@@ -3627,7 +3621,7 @@ usage: (format STRING &rest OBJECTS) */)
ptrdiff_t bufsize = sizeof initial_buffer;
ptrdiff_t max_bufsize = STRING_BYTES_BOUND + 1;
char *p;
- Lisp_Object buf_save_value IF_LINT (= {0});
+ ptrdiff_t buf_save_value_index IF_LINT (= 0);
char *format, *end, *format_start;
ptrdiff_t formatlen, nchars;
/* True if the format is multibyte. */
@@ -4236,14 +4230,14 @@ usage: (format STRING &rest OBJECTS) */)
{
buf = xmalloc (bufsize);
sa_must_free = 1;
- buf_save_value = make_save_pointer (buf);
- record_unwind_protect (safe_alloca_unwind, buf_save_value);
+ buf_save_value_index = SPECPDL_INDEX ();
+ record_unwind_protect_ptr (xfree, buf);
memcpy (buf, initial_buffer, used);
}
else
{
buf = xrealloc (buf, bufsize);
- set_save_pointer (buf_save_value, 0, buf);
+ set_unwind_protect_ptr (buf_save_value_index, xfree, buf);
}
p = buf + used;
diff --git a/src/emacs.c b/src/emacs.c
index 274321482e1..6d406407a9d 100644
--- a/src/emacs.c
+++ b/src/emacs.c
@@ -974,7 +974,7 @@ main (int argc, char **argv)
use a pipe for synchronization. The parent waits for the child
to close its end of the pipe (using `daemon-initialized')
before exiting. */
- if (pipe2 (daemon_pipe, O_CLOEXEC) != 0)
+ if (emacs_pipe (daemon_pipe) != 0)
{
fprintf (stderr, "Cannot pipe!\n");
exit (1);
@@ -1494,12 +1494,11 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem
char *file;
/* Handle -l loadup, args passed by Makefile. */
if (argmatch (argv, argc, "-l", "--load", 3, &file, &skip_args))
- Vtop_level = Fcons (intern_c_string ("load"),
- Fcons (build_string (file), Qnil));
+ Vtop_level = list2 (intern_c_string ("load"), build_string (file));
/* Unless next switch is -nl, load "loadup.el" first thing. */
if (! no_loadup)
- Vtop_level = Fcons (intern_c_string ("load"),
- Fcons (build_string ("loadup.el"), Qnil));
+ Vtop_level = list2 (intern_c_string ("load"),
+ build_string ("loadup.el"));
}
if (initialized)
diff --git a/src/emacsgtkfixed.c b/src/emacsgtkfixed.c
index 970683da9c4..8b19d89f3a0 100644
--- a/src/emacsgtkfixed.c
+++ b/src/emacsgtkfixed.c
@@ -28,7 +28,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include "xterm.h"
/* Silence a bogus diagnostic; see GNOME bug 683906. */
-#if __GNUC__ > 4 || (__GNUC__ == 4 && __GNUC_MINOR__ >= 6)
+#if 4 < __GNUC__ + (7 <= __GNUC_MINOR__)
# pragma GCC diagnostic push
# pragma GCC diagnostic ignored "-Wunused-local-typedefs"
#endif
diff --git a/src/eval.c b/src/eval.c
index 97e812dd890..e93c3473ae8 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -138,6 +138,13 @@ specpdl_old_value (union specbinding *pdl)
return pdl->let.old_value;
}
+static void
+set_specpdl_old_value (union specbinding *pdl, Lisp_Object val)
+{
+ eassert (pdl->kind >= SPECPDL_LET);
+ pdl->let.old_value = val;
+}
+
static Lisp_Object
specpdl_where (union specbinding *pdl)
{
@@ -159,13 +166,6 @@ specpdl_arg (union specbinding *pdl)
return pdl->unwind.arg;
}
-static specbinding_func
-specpdl_func (union specbinding *pdl)
-{
- eassert (pdl->kind == SPECPDL_UNWIND);
- return pdl->unwind.func;
-}
-
Lisp_Object
backtrace_function (union specbinding *pdl)
{
@@ -287,12 +287,11 @@ mark_catchlist (struct catchtag *catch)
/* Unwind-protect function used by call_debugger. */
-static Lisp_Object
+static void
restore_stack_limits (Lisp_Object data)
{
max_specpdl_size = XINT (XCAR (data));
max_lisp_eval_depth = XINT (XCDR (data));
- return Qnil;
}
/* Call the Lisp debugger, giving it argument ARG. */
@@ -358,7 +357,7 @@ do_debug_on_call (Lisp_Object code)
{
debug_on_next_call = 0;
set_backtrace_debug_on_exit (specpdl_ptr - 1, true);
- call_debugger (Fcons (code, Qnil));
+ call_debugger (list1 (code));
}
/* NOTE!!! Every function that can call EVAL must protect its args
@@ -421,16 +420,16 @@ If COND yields nil, and there are no ELSE's, the value is nil.
usage: (if COND THEN ELSE...) */)
(Lisp_Object args)
{
- register Lisp_Object cond;
+ Lisp_Object cond;
struct gcpro gcpro1;
GCPRO1 (args);
- cond = eval_sub (Fcar (args));
+ cond = eval_sub (XCAR (args));
UNGCPRO;
if (!NILP (cond))
- return eval_sub (Fcar (Fcdr (args)));
- return Fprogn (Fcdr (Fcdr (args)));
+ return eval_sub (Fcar (XCDR (args)));
+ return Fprogn (XCDR (XCDR (args)));
}
DEFUN ("cond", Fcond, Scond, 0, UNEVALLED, 0,
@@ -445,18 +444,17 @@ CONDITION's value if non-nil is returned from the cond-form.
usage: (cond CLAUSES...) */)
(Lisp_Object args)
{
- register Lisp_Object clause, val;
+ Lisp_Object val = args;
struct gcpro gcpro1;
- val = Qnil;
GCPRO1 (args);
- while (!NILP (args))
+ while (CONSP (args))
{
- clause = Fcar (args);
+ Lisp_Object clause = XCAR (args);
val = eval_sub (Fcar (clause));
if (!NILP (val))
{
- if (!EQ (XCDR (clause), Qnil))
+ if (!NILP (XCDR (clause)))
val = Fprogn (XCDR (clause));
break;
}
@@ -470,23 +468,32 @@ usage: (cond CLAUSES...) */)
DEFUN ("progn", Fprogn, Sprogn, 0, UNEVALLED, 0,
doc: /* Eval BODY forms sequentially and return value of last one.
usage: (progn BODY...) */)
- (Lisp_Object args)
+ (Lisp_Object body)
{
- register Lisp_Object val = Qnil;
+ Lisp_Object val = Qnil;
struct gcpro gcpro1;
- GCPRO1 (args);
+ GCPRO1 (body);
- while (CONSP (args))
+ while (CONSP (body))
{
- val = eval_sub (XCAR (args));
- args = XCDR (args);
+ val = eval_sub (XCAR (body));
+ body = XCDR (body);
}
UNGCPRO;
return val;
}
+/* Evaluate BODY sequentially, discarding its value. Suitable for
+ record_unwind_protect. */
+
+void
+unwind_body (Lisp_Object body)
+{
+ Fprogn (body);
+}
+
DEFUN ("prog1", Fprog1, Sprog1, 1, UNEVALLED, 0,
doc: /* Eval FIRST and BODY sequentially; return value from FIRST.
The value of FIRST is saved during the evaluation of the remaining args,
@@ -495,11 +502,11 @@ usage: (prog1 FIRST BODY...) */)
(Lisp_Object args)
{
Lisp_Object val;
- register Lisp_Object args_left;
+ Lisp_Object args_left;
struct gcpro gcpro1, gcpro2;
args_left = args;
- val = Qnil;
+ val = args;
GCPRO2 (args, val);
val = eval_sub (XCAR (args_left));
@@ -536,36 +543,37 @@ The return value of the `setq' form is the value of the last VAL.
usage: (setq [SYM VAL]...) */)
(Lisp_Object args)
{
- register Lisp_Object args_left;
- register Lisp_Object val, sym, lex_binding;
- struct gcpro gcpro1;
-
- if (NILP (args))
- return Qnil;
+ Lisp_Object val, sym, lex_binding;
- args_left = args;
- GCPRO1 (args);
-
- do
+ val = args;
+ if (CONSP (args))
{
- val = eval_sub (Fcar (Fcdr (args_left)));
- sym = Fcar (args_left);
+ Lisp_Object args_left = args;
+ struct gcpro gcpro1;
+ GCPRO1 (args);
- /* Like for eval_sub, we do not check declared_special here since
- it's been done when let-binding. */
- if (!NILP (Vinternal_interpreter_environment) /* Mere optimization! */
- && SYMBOLP (sym)
- && !NILP (lex_binding
- = Fassq (sym, Vinternal_interpreter_environment)))
- XSETCDR (lex_binding, val); /* SYM is lexically bound. */
- else
- Fset (sym, val); /* SYM is dynamically bound. */
+ do
+ {
+ val = eval_sub (Fcar (XCDR (args_left)));
+ sym = XCAR (args_left);
+
+ /* Like for eval_sub, we do not check declared_special here since
+ it's been done when let-binding. */
+ if (!NILP (Vinternal_interpreter_environment) /* Mere optimization! */
+ && SYMBOLP (sym)
+ && !NILP (lex_binding
+ = Fassq (sym, Vinternal_interpreter_environment)))
+ XSETCDR (lex_binding, val); /* SYM is lexically bound. */
+ else
+ Fset (sym, val); /* SYM is dynamically bound. */
+
+ args_left = Fcdr (XCDR (args_left));
+ }
+ while (CONSP (args_left));
- args_left = Fcdr (Fcdr (args_left));
+ UNGCPRO;
}
- while (!NILP (args_left));
- UNGCPRO;
return val;
}
@@ -582,9 +590,9 @@ of unexpected results when a quoted object is modified.
usage: (quote ARG) */)
(Lisp_Object args)
{
- if (!NILP (Fcdr (args)))
+ if (CONSP (XCDR (args)))
xsignal2 (Qwrong_number_of_arguments, Qquote, Flength (args));
- return Fcar (args);
+ return XCAR (args);
}
DEFUN ("function", Ffunction, Sfunction, 1, UNEVALLED, 0,
@@ -596,7 +604,7 @@ usage: (function ARG) */)
{
Lisp_Object quoted = XCAR (args);
- if (!NILP (Fcdr (args)))
+ if (CONSP (XCDR (args)))
xsignal2 (Qwrong_number_of_arguments, Qfunction, Flength (args));
if (!NILP (Vinternal_interpreter_environment)
@@ -698,21 +706,23 @@ To define a user option, use `defcustom' instead of `defvar'.
usage: (defvar SYMBOL &optional INITVALUE DOCSTRING) */)
(Lisp_Object args)
{
- register Lisp_Object sym, tem, tail;
+ Lisp_Object sym, tem, tail;
- sym = Fcar (args);
- tail = Fcdr (args);
- if (!NILP (Fcdr (Fcdr (tail))))
- error ("Too many arguments");
+ sym = XCAR (args);
+ tail = XCDR (args);
- tem = Fdefault_boundp (sym);
- if (!NILP (tail))
+ if (CONSP (tail))
{
+ if (CONSP (XCDR (tail)) && CONSP (XCDR (XCDR (tail))))
+ error ("Too many arguments");
+
+ tem = Fdefault_boundp (sym);
+
/* Do it before evaluating the initial value, for self-references. */
XSYMBOL (sym)->declared_special = 1;
if (NILP (tem))
- Fset_default (sym, eval_sub (Fcar (tail)));
+ Fset_default (sym, eval_sub (XCAR (tail)));
else
{ /* Check if there is really a global binding rather than just a let
binding that shadows the global unboundness of the var. */
@@ -730,7 +740,7 @@ usage: (defvar SYMBOL &optional INITVALUE DOCSTRING) */)
}
}
}
- tail = Fcdr (tail);
+ tail = XCDR (tail);
tem = Fcar (tail);
if (!NILP (tem))
{
@@ -775,18 +785,18 @@ The optional DOCSTRING specifies the variable's documentation string.
usage: (defconst SYMBOL INITVALUE [DOCSTRING]) */)
(Lisp_Object args)
{
- register Lisp_Object sym, tem;
+ Lisp_Object sym, tem;
- sym = Fcar (args);
- if (!NILP (Fcdr (Fcdr (Fcdr (args)))))
+ sym = XCAR (args);
+ if (CONSP (Fcdr (XCDR (XCDR (args)))))
error ("Too many arguments");
- tem = eval_sub (Fcar (Fcdr (args)));
+ tem = eval_sub (Fcar (XCDR (args)));
if (!NILP (Vpurify_flag))
tem = Fpurecopy (tem);
Fset_default (sym, tem);
XSYMBOL (sym)->declared_special = 1;
- tem = Fcar (Fcdr (Fcdr (args)));
+ tem = Fcar (XCDR (XCDR (args)));
if (!NILP (tem))
{
if (!NILP (Vpurify_flag))
@@ -827,7 +837,7 @@ usage: (let* VARLIST BODY...) */)
lexenv = Vinternal_interpreter_environment;
- varlist = Fcar (args);
+ varlist = XCAR (args);
while (CONSP (varlist))
{
QUIT;
@@ -868,7 +878,7 @@ usage: (let* VARLIST BODY...) */)
varlist = XCDR (varlist);
}
UNGCPRO;
- val = Fprogn (Fcdr (args));
+ val = Fprogn (XCDR (args));
return unbind_to (count, val);
}
@@ -888,7 +898,7 @@ usage: (let VARLIST BODY...) */)
struct gcpro gcpro1, gcpro2;
USE_SAFE_ALLOCA;
- varlist = Fcar (args);
+ varlist = XCAR (args);
/* Make space to hold the values to give the bound variables. */
elt = Flength (varlist);
@@ -915,7 +925,7 @@ usage: (let VARLIST BODY...) */)
lexenv = Vinternal_interpreter_environment;
- varlist = Fcar (args);
+ varlist = XCAR (args);
for (argnum = 0; CONSP (varlist); varlist = XCDR (varlist))
{
Lisp_Object var;
@@ -938,7 +948,7 @@ usage: (let VARLIST BODY...) */)
/* Instantiate a new lexical environment. */
specbind (Qinternal_interpreter_environment, lexenv);
- elt = Fprogn (Fcdr (args));
+ elt = Fprogn (XCDR (args));
SAFE_FREE ();
return unbind_to (count, elt);
}
@@ -955,8 +965,8 @@ usage: (while TEST BODY...) */)
GCPRO2 (test, body);
- test = Fcar (args);
- body = Fcdr (args);
+ test = XCAR (args);
+ body = XCDR (args);
while (!NILP (eval_sub (test)))
{
QUIT;
@@ -1053,9 +1063,9 @@ usage: (catch TAG BODY...) */)
struct gcpro gcpro1;
GCPRO1 (args);
- tag = eval_sub (Fcar (args));
+ tag = eval_sub (XCAR (args));
UNGCPRO;
- return internal_catch (tag, Fprogn, Fcdr (args));
+ return internal_catch (tag, Fprogn, XCDR (args));
}
/* Set up a catch, then call C function FUNC on argument ARG.
@@ -1169,8 +1179,8 @@ usage: (unwind-protect BODYFORM UNWINDFORMS...) */)
Lisp_Object val;
ptrdiff_t count = SPECPDL_INDEX ();
- record_unwind_protect (Fprogn, Fcdr (args));
- val = eval_sub (Fcar (args));
+ record_unwind_protect (unwind_body, XCDR (args));
+ val = eval_sub (XCAR (args));
return unbind_to (count, val);
}
@@ -1202,9 +1212,9 @@ See also the function `signal' for more info.
usage: (condition-case VAR BODYFORM &rest HANDLERS) */)
(Lisp_Object args)
{
- Lisp_Object var = Fcar (args);
- Lisp_Object bodyform = Fcar (Fcdr (args));
- Lisp_Object handlers = Fcdr (Fcdr (args));
+ Lisp_Object var = XCAR (args);
+ Lisp_Object bodyform = XCAR (XCDR (args));
+ Lisp_Object handlers = XCDR (XCDR (args));
return internal_lisp_condition_case (var, bodyform, handlers);
}
@@ -1631,7 +1641,7 @@ signal_error (const char *s, Lisp_Object arg)
}
if (!NILP (hare))
- arg = Fcons (arg, Qnil); /* Make it a list. */
+ arg = list1 (arg);
xsignal (Qerror, Fcons (build_string (s), arg));
}
@@ -1723,7 +1733,7 @@ maybe_call_debugger (Lisp_Object conditions, Lisp_Object sig, Lisp_Object data)
/* RMS: What's this for? */
&& when_entered_debugger < num_nonmacro_input_events)
{
- call_debugger (Fcons (Qerror, Fcons (combined_data, Qnil)));
+ call_debugger (list2 (Qerror, combined_data));
return 1;
}
@@ -1910,10 +1920,10 @@ this does nothing and returns nil. */)
Qnil);
}
-Lisp_Object
+void
un_autoload (Lisp_Object oldqueue)
{
- register Lisp_Object queue, first, second;
+ Lisp_Object queue, first, second;
/* Queue to unwind is current value of Vautoload_queue.
oldqueue is the shadowed value to leave in Vautoload_queue. */
@@ -1930,7 +1940,6 @@ un_autoload (Lisp_Object oldqueue)
Ffset (first, second);
queue = XCDR (queue);
}
- return Qnil;
}
/* Load an autoloaded function.
@@ -2012,7 +2021,7 @@ If LEXICAL is t, evaluate using lexical scoping. */)
{
ptrdiff_t count = SPECPDL_INDEX ();
specbind (Qinternal_interpreter_environment,
- CONSP (lexical) || NILP (lexical) ? lexical : Fcons (Qt, Qnil));
+ CONSP (lexical) || NILP (lexical) ? lexical : list1 (Qt));
return unbind_to (count, eval_sub (form));
}
@@ -2277,7 +2286,7 @@ eval_sub (Lisp_Object form)
lisp_eval_depth--;
if (backtrace_debug_on_exit (specpdl_ptr - 1))
- val = call_debugger (Fcons (Qexit, Fcons (val, Qnil)));
+ val = call_debugger (list2 (Qexit, val));
specpdl_ptr--;
return val;
@@ -2898,7 +2907,7 @@ usage: (funcall FUNCTION &rest ARGUMENTS) */)
check_cons_list ();
lisp_eval_depth--;
if (backtrace_debug_on_exit (specpdl_ptr - 1))
- val = call_debugger (Fcons (Qexit, Fcons (val, Qnil)));
+ val = call_debugger (list2 (Qexit, val));
specpdl_ptr--;
return val;
}
@@ -2940,7 +2949,7 @@ apply_lambda (Lisp_Object fun, Lisp_Object args)
{
/* Don't do it again when we return to eval. */
set_backtrace_debug_on_exit (specpdl_ptr - 1, false);
- tem = call_debugger (Fcons (Qexit, Fcons (tem, Qnil)));
+ tem = call_debugger (list2 (Qexit, tem));
}
SAFE_FREE ();
return tem;
@@ -3255,8 +3264,10 @@ specbind (Lisp_Object symbol, Lisp_Object value)
}
}
+/* Push unwind-protect entries of various types. */
+
void
-record_unwind_protect (Lisp_Object (*function) (Lisp_Object), Lisp_Object arg)
+record_unwind_protect (void (*function) (Lisp_Object), Lisp_Object arg)
{
specpdl_ptr->unwind.kind = SPECPDL_UNWIND;
specpdl_ptr->unwind.func = function;
@@ -3265,6 +3276,32 @@ record_unwind_protect (Lisp_Object (*function) (Lisp_Object), Lisp_Object arg)
}
void
+record_unwind_protect_ptr (void (*function) (void *), void *arg)
+{
+ specpdl_ptr->unwind_ptr.kind = SPECPDL_UNWIND_PTR;
+ specpdl_ptr->unwind_ptr.func = function;
+ specpdl_ptr->unwind_ptr.arg = arg;
+ grow_specpdl ();
+}
+
+void
+record_unwind_protect_int (void (*function) (int), int arg)
+{
+ specpdl_ptr->unwind_int.kind = SPECPDL_UNWIND_INT;
+ specpdl_ptr->unwind_int.func = function;
+ specpdl_ptr->unwind_int.arg = arg;
+ grow_specpdl ();
+}
+
+void
+record_unwind_protect_void (void (*function) (void))
+{
+ specpdl_ptr->unwind_void.kind = SPECPDL_UNWIND_VOID;
+ specpdl_ptr->unwind_void.func = function;
+ grow_specpdl ();
+}
+
+void
rebind_for_thread_switch (void)
{
union specbinding *bind;
@@ -3288,7 +3325,18 @@ do_one_unbind (union specbinding *this_binding, int unwinding)
switch (this_binding->kind)
{
case SPECPDL_UNWIND:
- specpdl_func (this_binding) (specpdl_arg (this_binding));
+ specpdl_ptr->unwind.func (specpdl_ptr->unwind.arg);
+ break;
+ case SPECPDL_UNWIND_PTR:
+ specpdl_ptr->unwind_ptr.func (specpdl_ptr->unwind_ptr.arg);
+ break;
+ case SPECPDL_UNWIND_INT:
+ specpdl_ptr->unwind_int.func (specpdl_ptr->unwind_int.arg);
+ break;
+ case SPECPDL_UNWIND_VOID:
+ specpdl_ptr->unwind_void.func ();
+ break;
+ case SPECPDL_BACKTRACE:
break;
case SPECPDL_LET:
/* If variable has a trivial value (no forwarding), we can
@@ -3304,8 +3352,6 @@ do_one_unbind (union specbinding *this_binding, int unwinding)
Fset_default (specpdl_symbol (this_binding),
specpdl_old_value (this_binding));
break;
- case SPECPDL_BACKTRACE:
- break;
case SPECPDL_LET_LOCAL:
case SPECPDL_LET_DEFAULT:
{ /* If the symbol is a list, it is really (SYMBOL WHERE
@@ -3331,6 +3377,46 @@ do_one_unbind (union specbinding *this_binding, int unwinding)
}
}
+void
+do_nothing (void)
+{}
+
+/* Push an unwind-protect entry that does nothing, so that
+ set_unwind_protect_ptr can overwrite it later. */
+
+void
+record_unwind_protect_nothing (void)
+{
+ record_unwind_protect_void (do_nothing);
+}
+
+/* Clear the unwind-protect entry COUNT, so that it does nothing.
+ It need not be at the top of the stack. */
+
+void
+clear_unwind_protect (ptrdiff_t count)
+{
+ union specbinding *p = specpdl + count;
+ p->unwind_void.kind = SPECPDL_UNWIND_VOID;
+ p->unwind_void.func = do_nothing;
+}
+
+/* Set the unwind-protect entry COUNT so that it invokes FUNC (ARG).
+ It need not be at the top of the stack. Discard the entry's
+ previous value without invoking it. */
+
+void
+set_unwind_protect_ptr (ptrdiff_t count, void (*func) (void *), void *arg)
+{
+ union specbinding *p = specpdl + count;
+ p->unwind_ptr.kind = SPECPDL_UNWIND_PTR;
+ p->unwind_ptr.func = func;
+ p->unwind_ptr.arg = arg;
+}
+
+/* Pop and execute entries from the unwind-protect stack until the
+ depth COUNT is reached. Return VALUE. */
+
Lisp_Object
unbind_to (ptrdiff_t count, Lisp_Object value)
{
@@ -3449,7 +3535,30 @@ Output stream used is value of `standard-output'. */)
return Qnil;
}
-DEFUN ("backtrace-frame", Fbacktrace_frame, Sbacktrace_frame, 1, 1, NULL,
+static union specbinding *
+get_backtrace_frame (Lisp_Object nframes, Lisp_Object base)
+{
+ union specbinding *pdl = backtrace_top ();
+ register EMACS_INT i;
+
+ CHECK_NATNUM (nframes);
+
+ if (!NILP (base))
+ { /* Skip up to `base'. */
+ base = Findirect_function (base, Qt);
+ while (backtrace_p (pdl)
+ && !EQ (base, Findirect_function (backtrace_function (pdl), Qt)))
+ pdl = backtrace_next (pdl);
+ }
+
+ /* Find the frame requested. */
+ for (i = XFASTINT (nframes); i > 0 && backtrace_p (pdl); i--)
+ pdl = backtrace_next (pdl);
+
+ return pdl;
+}
+
+DEFUN ("backtrace-frame", Fbacktrace_frame, Sbacktrace_frame, 1, 2, NULL,
doc: /* Return the function and arguments NFRAMES up from current execution point.
If that frame has not evaluated the arguments yet (or is a special form),
the value is (nil FUNCTION ARG-FORMS...).
@@ -3458,17 +3567,12 @@ the value is (t FUNCTION ARG-VALUES...).
A &rest arg is represented as the tail of the list ARG-VALUES.
FUNCTION is whatever was supplied as car of evaluated list,
or a lambda expression for macro calls.
-If NFRAMES is more than the number of frames, the value is nil. */)
- (Lisp_Object nframes)
+If NFRAMES is more than the number of frames, the value is nil.
+If BASE is non-nil, it should be a function and NFRAMES counts from its
+nearest activation frame. */)
+ (Lisp_Object nframes, Lisp_Object base)
{
- union specbinding *pdl = backtrace_top ();
- register EMACS_INT i;
-
- CHECK_NATNUM (nframes);
-
- /* Find the frame requested. */
- for (i = 0; backtrace_p (pdl) && i < XFASTINT (nframes); i++)
- pdl = backtrace_next (pdl);
+ union specbinding *pdl = get_backtrace_frame (nframes, base);
if (!backtrace_p (pdl))
return Qnil;
@@ -3483,6 +3587,109 @@ If NFRAMES is more than the number of frames, the value is nil. */)
}
}
+/* For backtrace-eval, we want to temporarily unwind the last few elements of
+ the specpdl stack, and then rewind them. We store the pre-unwind values
+ directly in the pre-existing specpdl elements (i.e. we swap the current
+ value and the old value stored in the specpdl), kind of like the inplace
+ pointer-reversal trick. As it turns out, the rewind does the same as the
+ unwind, except it starts from the other end of the spepdl stack, so we use
+ the same function for both unwind and rewind. */
+static void
+backtrace_eval_unrewind (int distance)
+{
+ union specbinding *tmp = specpdl_ptr;
+ int step = -1;
+ if (distance < 0)
+ { /* It's a rewind rather than unwind. */
+ tmp += distance - 1;
+ step = 1;
+ distance = -distance;
+ }
+
+ for (; distance > 0; distance--)
+ {
+ tmp += step;
+ /* */
+ switch (tmp->kind)
+ {
+ /* FIXME: Ideally we'd like to "temporarily unwind" (some of) those
+ unwind_protect, but the problem is that we don't know how to
+ rewind them afterwards. */
+ case SPECPDL_UNWIND:
+ case SPECPDL_UNWIND_PTR:
+ case SPECPDL_UNWIND_INT:
+ case SPECPDL_UNWIND_VOID:
+ case SPECPDL_BACKTRACE:
+ break;
+ case SPECPDL_LET:
+ /* If variable has a trivial value (no forwarding), we can
+ just set it. No need to check for constant symbols here,
+ since that was already done by specbind. */
+ if (XSYMBOL (specpdl_symbol (tmp))->redirect
+ == SYMBOL_PLAINVAL)
+ {
+ struct Lisp_Symbol *sym = XSYMBOL (specpdl_symbol (tmp));
+ Lisp_Object old_value = specpdl_old_value (tmp);
+ set_specpdl_old_value (tmp, SYMBOL_VAL (sym));
+ SET_SYMBOL_VAL (sym, old_value);
+ break;
+ }
+ else
+ {
+ /* FALLTHROUGH!
+ NOTE: we only ever come here if make_local_foo was used for
+ the first time on this var within this let. */
+ }
+ case SPECPDL_LET_DEFAULT:
+ {
+ Lisp_Object sym = specpdl_symbol (tmp);
+ Lisp_Object old_value = specpdl_old_value (tmp);
+ set_specpdl_old_value (tmp, Fdefault_value (sym));
+ Fset_default (sym, old_value);
+ }
+ break;
+ case SPECPDL_LET_LOCAL:
+ {
+ Lisp_Object symbol = specpdl_symbol (tmp);
+ Lisp_Object where = specpdl_where (tmp);
+ Lisp_Object old_value = specpdl_old_value (tmp);
+ eassert (BUFFERP (where));
+
+ /* If this was a local binding, reset the value in the appropriate
+ buffer, but only if that buffer's binding still exists. */
+ if (!NILP (Flocal_variable_p (symbol, where)))
+ {
+ set_specpdl_old_value
+ (tmp, Fbuffer_local_value (symbol, where));
+ set_internal (symbol, old_value, where, 1);
+ }
+ }
+ break;
+ }
+ }
+}
+
+DEFUN ("backtrace-eval", Fbacktrace_eval, Sbacktrace_eval, 2, 3, NULL,
+ doc: /* Evaluate EXP in the context of some activation frame.
+NFRAMES and BASE specify the activation frame to use, as in `backtrace-frame'. */)
+ (Lisp_Object exp, Lisp_Object nframes, Lisp_Object base)
+{
+ union specbinding *pdl = get_backtrace_frame (nframes, base);
+ ptrdiff_t count = SPECPDL_INDEX ();
+ ptrdiff_t distance = specpdl_ptr - pdl;
+ eassert (distance >= 0);
+
+ if (!backtrace_p (pdl))
+ error ("Activation frame not found!");
+
+ backtrace_eval_unrewind (distance);
+ record_unwind_protect_int (backtrace_eval_unrewind, -distance);
+
+ /* Use eval_sub rather than Feval since the main motivation behind
+ backtrace-eval is to be able to get/set the value of lexical variables
+ from the debugger. */
+ return unbind_to (count, eval_sub (exp));
+}
void
mark_specpdl (union specbinding *first, union specbinding *ptr)
@@ -3729,6 +3936,7 @@ alist of active lexical bindings. */);
defsubr (&Sbacktrace_debug);
defsubr (&Sbacktrace);
defsubr (&Sbacktrace_frame);
+ defsubr (&Sbacktrace_eval);
defsubr (&Sspecial_variable_p);
defsubr (&Sfunctionp);
}
diff --git a/src/fileio.c b/src/fileio.c
index c3566390130..c47b3533145 100644
--- a/src/fileio.c
+++ b/src/fileio.c
@@ -160,11 +160,16 @@ static bool e_write (int, Lisp_Object, ptrdiff_t, ptrdiff_t,
/* Signal a file-access failure. STRING describes the failure,
- DATA the file that was involved, and ERRORNO the errno value. */
+ NAME the file involved, and ERRORNO the errno value.
+
+ If NAME is neither null nor a pair, package it up as a singleton
+ list before reporting it; this saves report_file_errno's caller the
+ trouble of preserving errno before calling list1. */
void
-report_file_errno (char const *string, Lisp_Object data, int errorno)
+report_file_errno (char const *string, Lisp_Object name, int errorno)
{
+ Lisp_Object data = CONSP (name) || NILP (name) ? name : list1 (name);
Lisp_Object errstring;
char *str;
@@ -198,27 +203,37 @@ report_file_errno (char const *string, Lisp_Object data, int errorno)
}
}
+/* Signal a file-access failure that set errno. STRING describes the
+ failure, NAME the file involved. When invoking this function, take
+ care to not use arguments such as build_string ("foo") that involve
+ side effects that may set errno. */
+
void
-report_file_error (char const *string, Lisp_Object data)
+report_file_error (char const *string, Lisp_Object name)
{
- report_file_errno (string, data, errno);
+ report_file_errno (string, name, errno);
}
-Lisp_Object
-close_file_unwind (Lisp_Object fd)
+void
+close_file_unwind (int fd)
{
- emacs_close (XFASTINT (fd));
- return Qnil;
+ emacs_close (fd);
+}
+
+void
+fclose_unwind (void *arg)
+{
+ FILE *stream = arg;
+ fclose (stream);
}
/* Restore point, having saved it as a marker. */
-Lisp_Object
+void
restore_point_unwind (Lisp_Object location)
{
Fgoto_char (location);
Fset_marker (location, Qnil, Qnil);
- return Qnil;
}
@@ -749,7 +764,7 @@ make_temp_name (Lisp_Object prefix, bool base64_p)
dog-slow, but also useless since eventually nil would
have to be returned anyway. */
report_file_error ("Cannot create temporary name for prefix",
- Fcons (prefix, Qnil));
+ prefix);
/* not reached */
}
}
@@ -2019,7 +2034,7 @@ entries (depending on how Emacs was built). */)
{
acl = acl_get_file (SDATA (encoded_file), ACL_TYPE_ACCESS);
if (acl == NULL && acl_errno_valid (errno))
- report_file_error ("Getting ACL", Fcons (file, Qnil));
+ report_file_error ("Getting ACL", file);
}
if (!CopyFile (SDATA (encoded_file),
SDATA (encoded_newname),
@@ -2027,7 +2042,7 @@ entries (depending on how Emacs was built). */)
{
/* CopyFile doesn't set errno when it fails. By far the most
"popular" reason is that the target is read-only. */
- report_file_errno ("Copying file", Fcons (file, Fcons (newname, Qnil)),
+ report_file_errno ("Copying file", list2 (file, newname),
GetLastError () == 5 ? EACCES : EPERM);
}
/* CopyFile retains the timestamp by default. */
@@ -2058,7 +2073,7 @@ entries (depending on how Emacs was built). */)
bool fail =
acl_set_file (SDATA (encoded_newname), ACL_TYPE_ACCESS, acl) != 0;
if (fail && acl_errno_valid (errno))
- report_file_error ("Setting ACL", Fcons (newname, Qnil));
+ report_file_error ("Setting ACL", newname);
acl_free (acl);
}
@@ -2068,12 +2083,12 @@ entries (depending on how Emacs was built). */)
immediate_quit = 0;
if (ifd < 0)
- report_file_error ("Opening input file", Fcons (file, Qnil));
+ report_file_error ("Opening input file", file);
- record_unwind_protect (close_file_unwind, make_number (ifd));
+ record_unwind_protect_int (close_file_unwind, ifd);
if (fstat (ifd, &st) != 0)
- report_file_error ("Input file status", Fcons (file, Qnil));
+ report_file_error ("Input file status", file);
if (!NILP (preserve_extended_attributes))
{
@@ -2082,7 +2097,7 @@ entries (depending on how Emacs was built). */)
{
conlength = fgetfilecon (ifd, &con);
if (conlength == -1)
- report_file_error ("Doing fgetfilecon", Fcons (file, Qnil));
+ report_file_error ("Doing fgetfilecon", file);
}
#endif
}
@@ -2090,11 +2105,11 @@ entries (depending on how Emacs was built). */)
if (out_st.st_mode != 0
&& st.st_dev == out_st.st_dev && st.st_ino == out_st.st_ino)
report_file_errno ("Input and output files are the same",
- Fcons (file, Fcons (newname, Qnil)), 0);
+ list2 (file, newname), 0);
/* We can copy only regular files. */
if (!S_ISREG (st.st_mode))
- report_file_errno ("Non-regular file", Fcons (file, Qnil),
+ report_file_errno ("Non-regular file", file,
S_ISDIR (st.st_mode) ? EISDIR : EINVAL);
{
@@ -2109,15 +2124,15 @@ entries (depending on how Emacs was built). */)
new_mask);
}
if (ofd < 0)
- report_file_error ("Opening output file", Fcons (newname, Qnil));
+ report_file_error ("Opening output file", newname);
- record_unwind_protect (close_file_unwind, make_number (ofd));
+ record_unwind_protect_int (close_file_unwind, ofd);
immediate_quit = 1;
QUIT;
while ((n = emacs_read (ifd, buf, sizeof buf)) > 0)
if (emacs_write_sig (ofd, buf, n) != n)
- report_file_error ("I/O error", Fcons (newname, Qnil));
+ report_file_error ("Write error", newname);
immediate_quit = 0;
#ifndef MSDOS
@@ -2145,8 +2160,8 @@ entries (depending on how Emacs was built). */)
st.st_mode & mode_mask)
: fchmod (ofd, st.st_mode & mode_mask))
{
- case -2: report_file_error ("Copying permissions from", list1 (file));
- case -1: report_file_error ("Copying permissions to", list1 (newname));
+ case -2: report_file_error ("Copying permissions from", file);
+ case -1: report_file_error ("Copying permissions to", newname);
}
}
#endif /* not MSDOS */
@@ -2158,7 +2173,7 @@ entries (depending on how Emacs was built). */)
bool fail = fsetfilecon (ofd, con) != 0;
/* See http://debbugs.gnu.org/11245 for ENOTSUP. */
if (fail && errno != ENOTSUP)
- report_file_error ("Doing fsetfilecon", Fcons (newname, Qnil));
+ report_file_error ("Doing fsetfilecon", newname);
freecon (con);
}
@@ -2174,7 +2189,7 @@ entries (depending on how Emacs was built). */)
}
if (emacs_close (ofd) < 0)
- report_file_error ("I/O error", Fcons (newname, Qnil));
+ report_file_error ("Write error", newname);
emacs_close (ifd);
@@ -2220,7 +2235,7 @@ DEFUN ("make-directory-internal", Fmake_directory_internal,
#else
if (mkdir (dir, 0777 & ~auto_saving_dir_umask) != 0)
#endif
- report_file_error ("Creating directory", list1 (directory));
+ report_file_error ("Creating directory", directory);
return Qnil;
}
@@ -2239,7 +2254,7 @@ DEFUN ("delete-directory-internal", Fdelete_directory_internal,
dir = SSDATA (encoded_dir);
if (rmdir (dir) != 0)
- report_file_error ("Removing directory", list1 (directory));
+ report_file_error ("Removing directory", directory);
return Qnil;
}
@@ -2282,7 +2297,7 @@ With a prefix argument, TRASH is nil. */)
encoded_file = ENCODE_FILE (filename);
if (unlink (SSDATA (encoded_file)) < 0)
- report_file_error ("Removing old name", list1 (filename));
+ report_file_error ("Removing old name", filename);
return Qnil;
}
@@ -2364,7 +2379,8 @@ This is what happens in interactive use with M-x. */)
INTEGERP (ok_if_already_exists), 0, 0);
if (rename (SSDATA (encoded_file), SSDATA (encoded_newname)) < 0)
{
- if (errno == EXDEV)
+ int rename_errno = errno;
+ if (rename_errno == EXDEV)
{
ptrdiff_t count;
symlink_target = Ffile_symlink_p (file);
@@ -2390,7 +2406,7 @@ This is what happens in interactive use with M-x. */)
unbind_to (count, Qnil);
}
else
- report_file_error ("Renaming", list2 (file, newname));
+ report_file_errno ("Renaming", list2 (file, newname), rename_errno);
}
UNGCPRO;
return Qnil;
@@ -2444,7 +2460,10 @@ This is what happens in interactive use with M-x. */)
unlink (SSDATA (newname));
if (link (SSDATA (encoded_file), SSDATA (encoded_newname)) < 0)
- report_file_error ("Adding new name", list2 (file, newname));
+ {
+ int link_errno = errno;
+ report_file_errno ("Adding new name", list2 (file, newname), link_errno);
+ }
UNGCPRO;
return Qnil;
@@ -2503,6 +2522,7 @@ This happens for interactive use with M-x. */)
if (symlink (SSDATA (encoded_filename), SSDATA (encoded_linkname)) < 0)
{
/* If we didn't complain already, silently delete existing file. */
+ int symlink_errno;
if (errno == EEXIST)
{
unlink (SSDATA (encoded_linkname));
@@ -2520,7 +2540,9 @@ This happens for interactive use with M-x. */)
build_string ("Symbolic links are not supported"));
}
- report_file_error ("Making symbolic link", list2 (filename, linkname));
+ symlink_errno = errno;
+ report_file_errno ("Making symbolic link", list2 (filename, linkname),
+ symlink_errno);
}
UNGCPRO;
return Qnil;
@@ -2719,7 +2741,7 @@ If there is no error, returns nil. */)
encoded_filename = ENCODE_FILE (absname);
if (faccessat (AT_FDCWD, SSDATA (encoded_filename), R_OK, AT_EACCESS) != 0)
- report_file_error (SSDATA (string), Fcons (filename, Qnil));
+ report_file_error (SSDATA (string), filename);
return Qnil;
}
@@ -3054,14 +3076,14 @@ or if Emacs was not compiled with SELinux support. */)
!= 0);
/* See http://debbugs.gnu.org/11245 for ENOTSUP. */
if (fail && errno != ENOTSUP)
- report_file_error ("Doing lsetfilecon", Fcons (absname, Qnil));
+ report_file_error ("Doing lsetfilecon", absname);
context_free (parsed_con);
freecon (con);
return fail ? Qnil : Qt;
}
else
- report_file_error ("Doing lgetfilecon", Fcons (absname, Qnil));
+ report_file_error ("Doing lgetfilecon", absname);
}
#endif
@@ -3151,7 +3173,7 @@ support. */)
acl = acl_from_text (SSDATA (acl_string));
if (acl == NULL)
{
- report_file_error ("Converting ACL", Fcons (absname, Qnil));
+ report_file_error ("Converting ACL", absname);
return Qnil;
}
@@ -3161,7 +3183,7 @@ support. */)
acl)
!= 0);
if (fail && acl_errno_valid (errno))
- report_file_error ("Setting ACL", Fcons (absname, Qnil));
+ report_file_error ("Setting ACL", absname);
acl_free (acl);
return fail ? Qnil : Qt;
@@ -3221,7 +3243,7 @@ symbolic notation, like the `chmod' command from GNU Coreutils. */)
encoded_absname = ENCODE_FILE (absname);
if (chmod (SSDATA (encoded_absname), XINT (mode) & 07777) < 0)
- report_file_error ("Doing chmod", Fcons (absname, Qnil));
+ report_file_error ("Doing chmod", absname);
return Qnil;
}
@@ -3287,7 +3309,7 @@ Use the current time if TIMESTAMP is nil. TIMESTAMP is in the format of
if (file_directory_p (SSDATA (encoded_absname)))
return Qnil;
#endif
- report_file_error ("Setting file times", Fcons (absname, Qnil));
+ report_file_error ("Setting file times", absname);
}
}
@@ -3369,7 +3391,7 @@ verify (READ_BUF_SIZE <= INT_MAX);
o remove all text properties.
o set back the buffer multibyteness. */
-static Lisp_Object
+static void
decide_coding_unwind (Lisp_Object unwind_data)
{
Lisp_Object multibyte, undo_list, buffer;
@@ -3388,8 +3410,6 @@ decide_coding_unwind (Lisp_Object unwind_data)
/* Now we are safe to change the buffer's multibyteness directly. */
bset_enable_multibyte_characters (current_buffer, multibyte);
bset_undo_list (current_buffer, undo_list);
-
- return Qnil;
}
/* Read from a non-regular file. STATE is a Lisp_Save_Value
@@ -3510,7 +3530,7 @@ by calling `format-decode', which see. */)
&& BEG == Z);
Lisp_Object old_Vdeactivate_mark = Vdeactivate_mark;
bool we_locked_file = 0;
- bool deferred_remove_unwind_protect = 0;
+ ptrdiff_t fd_index;
if (current_buffer->base_buffer && ! NILP (visit))
error ("Cannot do file visiting in an indirect buffer");
@@ -3553,7 +3573,7 @@ by calling `format-decode', which see. */)
{
save_errno = errno;
if (NILP (visit))
- report_file_error ("Opening input file", Fcons (orig_filename, Qnil));
+ report_file_error ("Opening input file", orig_filename);
mtime = time_error_value (save_errno);
st.st_size = -1;
if (!NILP (Vcoding_system_for_read))
@@ -3561,14 +3581,15 @@ by calling `format-decode', which see. */)
goto notfound;
}
+ fd_index = SPECPDL_INDEX ();
+ record_unwind_protect_int (close_file_unwind, fd);
+
/* Replacement should preserve point as it preserves markers. */
if (!NILP (replace))
record_unwind_protect (restore_point_unwind, Fpoint_marker ());
- record_unwind_protect (close_file_unwind, make_number (fd));
-
if (fstat (fd, &st) != 0)
- report_file_error ("Input file status", Fcons (orig_filename, Qnil));
+ report_file_error ("Input file status", orig_filename);
mtime = get_stat_mtime (&st);
/* This code will need to be changed in order to work on named
@@ -3682,15 +3703,14 @@ by calling `format-decode', which see. */)
int ntail;
if (lseek (fd, - (1024 * 3), SEEK_END) < 0)
report_file_error ("Setting file position",
- Fcons (orig_filename, Qnil));
+ orig_filename);
ntail = emacs_read (fd, read_buf + nread, 1024 * 3);
nread = ntail < 0 ? ntail : nread + ntail;
}
}
if (nread < 0)
- error ("IO error reading %s: %s",
- SDATA (orig_filename), emacs_strerror (errno));
+ report_file_error ("Read error", orig_filename);
else if (nread > 0)
{
struct buffer *prev = current_buffer;
@@ -3726,8 +3746,7 @@ by calling `format-decode', which see. */)
/* Rewind the file for the actual read done later. */
if (lseek (fd, 0, SEEK_SET) < 0)
- report_file_error ("Setting file position",
- Fcons (orig_filename, Qnil));
+ report_file_error ("Setting file position", orig_filename);
}
}
@@ -3793,8 +3812,7 @@ by calling `format-decode', which see. */)
if (beg_offset != 0)
{
if (lseek (fd, beg_offset, SEEK_SET) < 0)
- report_file_error ("Setting file position",
- Fcons (orig_filename, Qnil));
+ report_file_error ("Setting file position", orig_filename);
}
immediate_quit = 1;
@@ -3807,8 +3825,7 @@ by calling `format-decode', which see. */)
nread = emacs_read (fd, read_buf, sizeof read_buf);
if (nread < 0)
- error ("IO error reading %s: %s",
- SSDATA (orig_filename), emacs_strerror (errno));
+ report_file_error ("Read error", orig_filename);
else if (nread == 0)
break;
@@ -3843,7 +3860,8 @@ by calling `format-decode', which see. */)
if (same_at_start - BEGV_BYTE == end_offset - beg_offset)
{
emacs_close (fd);
- specpdl_ptr--;
+ clear_unwind_protect (fd_index);
+
/* Truncate the buffer to the size of the file. */
del_range_1 (same_at_start, same_at_end, 0, 0);
goto handled;
@@ -3866,16 +3884,14 @@ by calling `format-decode', which see. */)
/* How much can we scan in the next step? */
trial = min (curpos, sizeof read_buf);
if (lseek (fd, curpos - trial, SEEK_SET) < 0)
- report_file_error ("Setting file position",
- Fcons (orig_filename, Qnil));
+ report_file_error ("Setting file position", orig_filename);
total_read = nread = 0;
while (total_read < trial)
{
nread = emacs_read (fd, read_buf + total_read, trial - total_read);
if (nread < 0)
- error ("IO error reading %s: %s",
- SDATA (orig_filename), emacs_strerror (errno));
+ report_file_error ("Read error", orig_filename);
else if (nread == 0)
break;
total_read += nread;
@@ -3987,8 +4003,7 @@ by calling `format-decode', which see. */)
CONVERSION_BUFFER. */
if (lseek (fd, beg_offset, SEEK_SET) < 0)
- report_file_error ("Setting file position",
- Fcons (orig_filename, Qnil));
+ report_file_error ("Setting file position", orig_filename);
inserted = 0; /* Bytes put into CONVERSION_BUFFER so far. */
unprocessed = 0; /* Bytes not processed in previous loop. */
@@ -4018,16 +4033,10 @@ by calling `format-decode', which see. */)
memcpy (read_buf, coding.carryover, unprocessed);
}
UNGCPRO;
- emacs_close (fd);
-
- /* We should remove the unwind_protect calling
- close_file_unwind, but other stuff has been added the stack,
- so defer the removal till we reach the `handled' label. */
- deferred_remove_unwind_protect = 1;
-
if (this < 0)
- error ("IO error reading %s: %s",
- SDATA (orig_filename), emacs_strerror (errno));
+ report_file_error ("Read error", orig_filename);
+ emacs_close (fd);
+ clear_unwind_protect (fd_index);
if (unprocessed > 0)
{
@@ -4168,8 +4177,7 @@ by calling `format-decode', which see. */)
if (beg_offset != 0 || !NILP (replace))
{
if (lseek (fd, beg_offset, SEEK_SET) < 0)
- report_file_error ("Setting file position",
- Fcons (orig_filename, Qnil));
+ report_file_error ("Setting file position", orig_filename);
}
/* In the following loop, HOW_MUCH contains the total bytes read so
@@ -4208,8 +4216,7 @@ by calling `format-decode', which see. */)
to be signaled after decoding the text we read. */
nbytes = internal_condition_case_1
(read_non_regular,
- make_save_value (SAVE_TYPE_INT_INT_INT, (ptrdiff_t) fd,
- inserted, trytry),
+ make_save_int_int_int (fd, inserted, trytry),
Qerror, read_non_regular_quit);
if (NILP (nbytes))
@@ -4269,13 +4276,10 @@ by calling `format-decode', which see. */)
Vdeactivate_mark = Qt;
emacs_close (fd);
-
- /* Discard the unwind protect for closing the file. */
- specpdl_ptr--;
+ clear_unwind_protect (fd_index);
if (how_much < 0)
- error ("IO error reading %s: %s",
- SDATA (orig_filename), emacs_strerror (errno));
+ report_file_error ("Read error", orig_filename);
/* Make the text read part of the buffer. */
GAP_SIZE -= inserted;
@@ -4399,11 +4403,6 @@ by calling `format-decode', which see. */)
handled:
- if (deferred_remove_unwind_protect)
- /* If requested above, discard the unwind protect for closing the
- file. */
- specpdl_ptr--;
-
if (!NILP (visit))
{
if (empty_undo_list_p)
@@ -4574,8 +4573,7 @@ by calling `format-decode', which see. */)
&& EMACS_NSECS (current_buffer->modtime) == NONEXISTENT_MODTIME_NSECS)
{
/* If visiting nonexistent file, return nil. */
- report_file_errno ("Opening input file", Fcons (orig_filename, Qnil),
- save_errno);
+ report_file_errno ("Opening input file", orig_filename, save_errno);
}
if (read_quit)
@@ -4590,11 +4588,10 @@ by calling `format-decode', which see. */)
static Lisp_Object build_annotations (Lisp_Object, Lisp_Object);
-static Lisp_Object
+static void
build_annotations_unwind (Lisp_Object arg)
{
Vwrite_region_annotation_buffers = arg;
- return Qnil;
}
/* Decide the coding-system to encode the data with. */
@@ -4631,7 +4628,7 @@ This function is for internal use only. It may prompt the user. */ )
&& !NILP (Ffboundp (Vselect_safe_coding_system_function)))
/* Confirm that VAL can surely encode the current region. */
val = call5 (Vselect_safe_coding_system_function,
- start, end, Fcons (Qt, Fcons (val, Qnil)),
+ start, end, list2 (Qt, val),
Qnil, filename);
}
else
@@ -4834,7 +4831,7 @@ This calls `write-region-annotate-functions' at the start, and
record_unwind_protect (build_annotations_unwind,
Vwrite_region_annotation_buffers);
- Vwrite_region_annotation_buffers = Fcons (Fcurrent_buffer (), Qnil);
+ Vwrite_region_annotation_buffers = list1 (Fcurrent_buffer ());
count1 = SPECPDL_INDEX ();
given_buffer = current_buffer;
@@ -4901,11 +4898,10 @@ This calls `write-region-annotate-functions' at the start, and
if (!auto_saving) unlock_file (lockname);
#endif /* CLASH_DETECTION */
UNGCPRO;
- report_file_errno ("Opening output file", Fcons (filename, Qnil),
- open_errno);
+ report_file_errno ("Opening output file", filename, open_errno);
}
- record_unwind_protect (close_file_unwind, make_number (desc));
+ record_unwind_protect_int (close_file_unwind, desc);
if (NUMBERP (append))
{
@@ -4917,8 +4913,7 @@ This calls `write-region-annotate-functions' at the start, and
if (!auto_saving) unlock_file (lockname);
#endif /* CLASH_DETECTION */
UNGCPRO;
- report_file_errno ("Lseek error", Fcons (filename, Qnil),
- lseek_errno);
+ report_file_errno ("Lseek error", filename, lseek_errno);
}
}
@@ -5071,8 +5066,7 @@ This calls `write-region-annotate-functions' at the start, and
}
if (! ok)
- error ("IO error writing %s: %s", SDATA (filename),
- emacs_strerror (save_errno));
+ report_file_errno ("Write error", filename, save_errno);
if (visiting)
{
@@ -5498,11 +5492,18 @@ auto_save_1 (void)
Qnil, Qnil);
}
-static Lisp_Object
-do_auto_save_unwind (Lisp_Object arg) /* used as unwind-protect function */
+struct auto_save_unwind
+{
+ FILE *stream;
+ bool auto_raise;
+};
+static void
+do_auto_save_unwind (void *arg)
{
- FILE *stream = XSAVE_POINTER (arg, 0);
+ struct auto_save_unwind *p = arg;
+ FILE *stream = p->stream;
+ minibuffer_auto_raise = p->auto_raise;
auto_saving = 0;
if (stream != NULL)
{
@@ -5510,15 +5511,6 @@ do_auto_save_unwind (Lisp_Object arg) /* used as unwind-protect function */
fclose (stream);
unblock_input ();
}
- return Qnil;
-}
-
-static Lisp_Object
-do_auto_save_unwind_1 (Lisp_Object value) /* used as unwind-protect function */
-
-{
- minibuffer_auto_raise = XINT (value);
- return Qnil;
}
static Lisp_Object
@@ -5561,6 +5553,7 @@ A non-nil CURRENT-ONLY argument means save only current buffer. */)
ptrdiff_t count = SPECPDL_INDEX ();
bool orig_minibuffer_auto_raise = minibuffer_auto_raise;
bool old_message_p = 0;
+ struct auto_save_unwind auto_save_unwind;
struct gcpro gcpro1, gcpro2;
if (max_specpdl_size < specpdl_size + 40)
@@ -5572,7 +5565,7 @@ A non-nil CURRENT-ONLY argument means save only current buffer. */)
if (NILP (no_message))
{
old_message_p = push_message ();
- record_unwind_protect (pop_message_unwind, Qnil);
+ record_unwind_protect_void (pop_message_unwind);
}
/* Ordinarily don't quit within this function,
@@ -5611,10 +5604,9 @@ A non-nil CURRENT-ONLY argument means save only current buffer. */)
stream = emacs_fopen (SSDATA (listfile), "w");
}
- record_unwind_protect (do_auto_save_unwind,
- make_save_pointer (stream));
- record_unwind_protect (do_auto_save_unwind_1,
- make_number (minibuffer_auto_raise));
+ auto_save_unwind.stream = stream;
+ auto_save_unwind.auto_raise = minibuffer_auto_raise;
+ record_unwind_protect_ptr (do_auto_save_unwind, &auto_save_unwind);
minibuffer_auto_raise = 0;
auto_saving = 1;
auto_save_error_occurred = 0;
diff --git a/src/filelock.c b/src/filelock.c
index 244663ad20a..b9c991e4baf 100644
--- a/src/filelock.c
+++ b/src/filelock.c
@@ -257,18 +257,14 @@ void
get_boot_time_1 (const char *filename, bool newest)
{
struct utmp ut, *utp;
- int desc;
if (filename)
{
/* On some versions of IRIX, opening a nonexistent file name
is likely to crash in the utmp routines. */
- desc = emacs_open (filename, O_RDONLY, 0);
- if (desc < 0)
+ if (faccessat (AT_FDCWD, filename, R_OK, AT_EACCESS) != 0)
return;
- emacs_close (desc);
-
utmpname (filename);
}
@@ -412,8 +408,6 @@ create_lock_file (char *lfname, char *lock_info_str, bool force)
USE_SAFE_ALLOCA;
char *nonce = SAFE_ALLOCA (lfdirlen + sizeof nonce_base);
int fd;
- bool need_fchmod;
- mode_t world_readable = S_IRUSR | S_IRGRP | S_IROTH;
memcpy (nonce, lfname, lfdirlen);
strcpy (nonce + lfdirlen, nonce_base);
@@ -421,17 +415,14 @@ create_lock_file (char *lfname, char *lock_info_str, bool force)
/* Prefer mkostemp to mkstemp, as it avoids a window where FD is
temporarily open without close-on-exec. */
fd = mkostemp (nonce, O_BINARY | O_CLOEXEC);
- need_fchmod = 1;
#elif HAVE_MKSTEMP
/* Prefer mkstemp to mktemp, as it avoids a race between
mktemp and emacs_open. */
fd = mkstemp (nonce);
- need_fchmod = 1;
#else
mktemp (nonce);
fd = emacs_open (nonce, O_WRONLY | O_CREAT | O_EXCL | O_BINARY,
- world_readable);
- need_fchmod = 0;
+ S_IRUSR | S_IWUSR);
#endif
if (fd < 0)
@@ -439,13 +430,15 @@ create_lock_file (char *lfname, char *lock_info_str, bool force)
else
{
ptrdiff_t lock_info_len;
-#if ! HAVE_MKOSTEMP
+#if ! (HAVE_MKOSTEMP && O_CLOEXEC)
fcntl (fd, F_SETFD, FD_CLOEXEC);
#endif
lock_info_len = strlen (lock_info_str);
err = 0;
- if (emacs_write (fd, lock_info_str, lock_info_len) != lock_info_len
- || (need_fchmod && fchmod (fd, world_readable) != 0))
+ /* Use 'write', not 'emacs_write', as garbage collection
+ might signal an error, which would leak FD. */
+ if (write (fd, lock_info_str, lock_info_len) != lock_info_len
+ || fchmod (fd, S_IRUSR | S_IRGRP | S_IROTH) != 0)
err = errno;
/* There is no need to call fsync here, as the contents of
the lock file need not survive system crashes. */
@@ -517,7 +510,8 @@ read_lock_data (char *lfname, char lfinfo[MAX_LFINFO + 1])
int fd = emacs_open (lfname, O_RDONLY | O_BINARY | O_NOFOLLOW, 0);
if (0 <= fd)
{
- ptrdiff_t read_bytes = emacs_read (fd, lfinfo, MAX_LFINFO + 1);
+ /* Use read, not emacs_read, since FD isn't unwind-protected. */
+ ptrdiff_t read_bytes = read (fd, lfinfo, MAX_LFINFO + 1);
int read_errno = errno;
if (emacs_close (fd) != 0)
return -1;
diff --git a/src/fns.c b/src/fns.c
index 49bd8470f7f..9fd0ad2a9d1 100644
--- a/src/fns.c
+++ b/src/fns.c
@@ -1962,7 +1962,7 @@ The PLIST is modified by side effects. */)
prev = tail;
QUIT;
}
- newcell = Fcons (prop, Fcons (val, Qnil));
+ newcell = list2 (prop, val);
if (NILP (prev))
return newcell;
else
@@ -2455,9 +2455,8 @@ is nil, and `use-dialog-box' is non-nil. */)
{
Lisp_Object pane, menu, obj;
redisplay_preserve_echo_area (4);
- pane = Fcons (Fcons (build_string ("Yes"), Qt),
- Fcons (Fcons (build_string ("No"), Qnil),
- Qnil));
+ pane = list2 (Fcons (build_string ("Yes"), Qt),
+ Fcons (build_string ("No"), Qnil));
GCPRO1 (pane);
menu = Fcons (prompt, pane);
obj = Fx_popup_dialog (Qt, menu, Qnil);
@@ -2586,10 +2585,10 @@ particular subfeatures supported in this version of FEATURE. */)
static Lisp_Object require_nesting_list;
-static Lisp_Object
+static void
require_unwind (Lisp_Object old_value)
{
- return require_nesting_list = old_value;
+ require_nesting_list = old_value;
}
DEFUN ("require", Frequire, Srequire, 1, 3, 0,
@@ -4915,7 +4914,7 @@ syms_of_fns (void)
DEFVAR_LISP ("features", Vfeatures,
doc: /* A list of symbols which are the features of the executing Emacs.
Used by `featurep' and `require', and altered by `provide'. */);
- Vfeatures = Fcons (intern_c_string ("emacs"), Qnil);
+ Vfeatures = list1 (intern_c_string ("emacs"));
DEFSYM (Qsubfeatures, "subfeatures");
DEFSYM (Qfuncall, "funcall");
diff --git a/src/font.c b/src/font.c
index 231df2ef71a..124d5f9bd9e 100644
--- a/src/font.c
+++ b/src/font.c
@@ -472,7 +472,7 @@ font_registry_charsets (Lisp_Object registry, struct charset **encoding, struct
goto invalid_entry;
val = Fcons (make_number (encoding_id), make_number (repertory_id));
font_charset_alist
- = nconc2 (font_charset_alist, Fcons (Fcons (registry, val), Qnil));
+ = nconc2 (font_charset_alist, list1 (Fcons (registry, val)));
}
if (encoding)
@@ -483,7 +483,7 @@ font_registry_charsets (Lisp_Object registry, struct charset **encoding, struct
invalid_entry:
font_charset_alist
- = nconc2 (font_charset_alist, Fcons (Fcons (registry, Qnil), Qnil));
+ = nconc2 (font_charset_alist, list1 (Fcons (registry, Qnil)));
return -1;
}
@@ -1453,7 +1453,7 @@ font_parse_fcname (char *name, ptrdiff_t len, Lisp_Object font)
else
{
extra_props = nconc2 (extra_props,
- Fcons (Fcons (key, val), Qnil));
+ list1 (Fcons (key, val)));
}
}
p = q;
@@ -1861,7 +1861,7 @@ otf_open (Lisp_Object file)
else
{
otf = STRINGP (file) ? OTF_open (SSDATA (file)) : NULL;
- val = make_save_pointer (otf);
+ val = make_save_ptr (otf);
otf_list = Fcons (Fcons (file, val), otf_list);
}
return otf;
@@ -2519,7 +2519,7 @@ font_prepare_cache (FRAME_PTR f, struct font_driver *driver)
val = XCDR (val);
if (NILP (val))
{
- val = Fcons (driver->type, Fcons (make_number (1), Qnil));
+ val = list2 (driver->type, make_number (1));
XSETCDR (cache, Fcons (val, XCDR (cache)));
}
else
@@ -3517,8 +3517,7 @@ font_update_drivers (FRAME_PTR f, Lisp_Object new_drivers)
for (list = f->font_driver_list; list; list = list->next)
if (list->on)
- active_drivers = nconc2 (active_drivers,
- Fcons (list->driver->type, Qnil));
+ active_drivers = nconc2 (active_drivers, list1 (list->driver->type));
return active_drivers;
}
@@ -4133,7 +4132,7 @@ how close they are to PREFER. */)
return Qnil;
if (NILP (XCDR (list))
&& ASIZE (XCAR (list)) == 1)
- return Fcons (AREF (XCAR (list), 0), Qnil);
+ return list1 (AREF (XCAR (list), 0));
if (! NILP (prefer))
vec = font_sort_entities (list, prefer, frame, 0);
diff --git a/src/fontset.c b/src/fontset.c
index 2f6313c4214..6a6a434add0 100644
--- a/src/fontset.c
+++ b/src/fontset.c
@@ -1523,7 +1523,7 @@ appended. By default, FONT-SPEC overrides the previous settings. */)
{
if (XFASTINT (target) < 0x80)
error ("Can't set a font for partial ASCII range");
- range_list = Fcons (Fcons (target, target), Qnil);
+ range_list = list1 (Fcons (target, target));
}
else if (CONSP (target))
{
@@ -1539,7 +1539,7 @@ appended. By default, FONT-SPEC overrides the previous settings. */)
error ("Can't set a font for partial ASCII range");
ascii_changed = 1;
}
- range_list = Fcons (target, Qnil);
+ range_list = list1 (target);
}
else if (SYMBOLP (target) && !NILP (target))
{
@@ -1552,7 +1552,7 @@ appended. By default, FONT-SPEC overrides the previous settings. */)
{
if (EQ (target, Qlatin))
ascii_changed = 1;
- val = Fcons (target, Qnil);
+ val = list1 (target);
map_char_table (accumulate_script_ranges, Qnil, Vchar_script_table,
val);
range_list = Fnreverse (XCDR (val));
@@ -1568,7 +1568,7 @@ appended. By default, FONT-SPEC overrides the previous settings. */)
SDATA (SYMBOL_NAME (target)));
}
else if (NILP (target))
- range_list = Fcons (Qnil, Qnil);
+ range_list = list1 (Qnil);
else
error ("Invalid target for setting a font");
@@ -1628,7 +1628,7 @@ appended. By default, FONT-SPEC overrides the previous settings. */)
if (! NILP (font_object))
{
update_auto_fontset_alist (font_object, fontset);
- alist = Fcons (Fcons (Qfont, Fcons (name, font_object)), Qnil);
+ alist = list1 (Fcons (Qfont, Fcons (name, font_object)));
Fmodify_frame_parameters (fr, alist);
}
}
@@ -1999,7 +1999,7 @@ format is the same as above. */)
slot = Fassq (RFONT_DEF_SPEC (elt), alist);
name = AREF (font_object, FONT_NAME_INDEX);
if (NILP (Fmember (name, XCDR (slot))))
- nconc2 (slot, Fcons (name, Qnil));
+ nconc2 (slot, list1 (name));
}
}
}
@@ -2238,9 +2238,9 @@ alternate fontnames (if any) are tried instead. */);
DEFVAR_LISP ("fontset-alias-alist", Vfontset_alias_alist,
doc: /* Alist of fontset names vs the aliases. */);
- Vfontset_alias_alist = Fcons (Fcons (FONTSET_NAME (Vdefault_fontset),
- build_pure_c_string ("fontset-default")),
- Qnil);
+ Vfontset_alias_alist
+ = list1 (Fcons (FONTSET_NAME (Vdefault_fontset),
+ build_pure_c_string ("fontset-default")));
DEFVAR_LISP ("vertical-centering-font-regexp",
Vvertical_centering_font_regexp,
diff --git a/src/frame.c b/src/frame.c
index 648687a7cb4..5fa54052cd2 100644
--- a/src/frame.c
+++ b/src/frame.c
@@ -389,7 +389,7 @@ make_frame (int mini_p)
etc. Running Lisp functions at this point surely ends in a
SEGV. */
set_window_buffer (root_window, buf, 0, 0);
- fset_buffer_list (f, Fcons (buf, Qnil));
+ fset_buffer_list (f, list1 (buf));
}
if (mini_p)
@@ -726,15 +726,15 @@ affects all frames on the same terminal device. */)
calculate_costs (f);
XSETFRAME (frame, f);
Fmodify_frame_parameters (frame, parms);
- Fmodify_frame_parameters (frame, Fcons (Fcons (Qtty_type,
- build_string (t->display_info.tty->type)),
- Qnil));
+ Fmodify_frame_parameters
+ (frame, list1 (Fcons (Qtty_type,
+ build_string (t->display_info.tty->type))));
if (t->display_info.tty->name != NULL)
- Fmodify_frame_parameters (frame, Fcons (Fcons (Qtty,
- build_string (t->display_info.tty->name)),
- Qnil));
+ Fmodify_frame_parameters
+ (frame, list1 (Fcons (Qtty,
+ build_string (t->display_info.tty->name))));
else
- Fmodify_frame_parameters (frame, Fcons (Fcons (Qtty, Qnil), Qnil));
+ Fmodify_frame_parameters (frame, list1 (Fcons (Qtty, Qnil)));
/* Make the frame face alist be frame-specific, so that each
frame could change its face definitions independently. */
@@ -887,6 +887,26 @@ This function returns FRAME, or nil if FRAME has been deleted. */)
return do_switch_frame (frame, 1, 0, norecord);
}
+DEFUN ("handle-focus-in", Fhandle_focus_in, Shandle_focus_in, 1, 1, "e",
+ doc: /* Handle a focus-in event.
+Focus in events are usually bound to this function.
+Focus in events occur when a frame has focus, but a switch-frame event
+is not generated.
+This function checks if blink-cursor timers should be turned on again. */)
+ (Lisp_Object event)
+{
+ return call0 (intern ("blink-cursor-check"));
+}
+
+DEFUN ("handle-focus-out", Fhandle_focus_out, Shandle_focus_out, 1, 1, "e",
+ doc: /* Handle a focus-out event.
+Focus out events are usually bound to this function.
+Focus out events occur when no frame has focus.
+This function checks if blink-cursor timers should be turned off. */)
+ (Lisp_Object event)
+{
+ return call0 (intern ("blink-cursor-suspend"));
+}
DEFUN ("handle-switch-frame", Fhandle_switch_frame, Shandle_switch_frame, 1, 1, "e",
doc: /* Handle a switch-frame event EVENT.
@@ -902,6 +922,7 @@ to that frame. */)
/* Preserve prefix arg that the command loop just cleared. */
kset_prefix_arg (current_kboard, Vcurrent_prefix_arg);
Frun_hooks (1, &Qmouse_leave_buffer_hook);
+ Fhandle_focus_in (event); // switch-frame implies a focus in.
return do_switch_frame (event, 0, 0, Qnil);
}
@@ -2731,7 +2752,7 @@ x_set_frame_parameters (FRAME_PTR f, Lisp_Object alist)
{
left_no_change = 1;
if (f->left_pos < 0)
- left = Fcons (Qplus, Fcons (make_number (f->left_pos), Qnil));
+ left = list2 (Qplus, make_number (f->left_pos));
else
XSETINT (left, f->left_pos);
}
@@ -2739,7 +2760,7 @@ x_set_frame_parameters (FRAME_PTR f, Lisp_Object alist)
{
top_no_change = 1;
if (f->top_pos < 0)
- top = Fcons (Qplus, Fcons (make_number (f->top_pos), Qnil));
+ top = list2 (Qplus, make_number (f->top_pos));
else
XSETINT (top, f->top_pos);
}
@@ -2874,13 +2895,13 @@ x_report_frame_params (struct frame *f, Lisp_Object *alistptr)
if (f->left_pos >= 0)
store_in_alist (alistptr, Qleft, tem);
else
- store_in_alist (alistptr, Qleft, Fcons (Qplus, Fcons (tem, Qnil)));
+ store_in_alist (alistptr, Qleft, list2 (Qplus, tem));
XSETINT (tem, f->top_pos);
if (f->top_pos >= 0)
store_in_alist (alistptr, Qtop, tem);
else
- store_in_alist (alistptr, Qtop, Fcons (Qplus, Fcons (tem, Qnil)));
+ store_in_alist (alistptr, Qtop, list2 (Qplus, tem));
store_in_alist (alistptr, Qborder_width,
make_number (f->border_width));
@@ -3739,7 +3760,7 @@ x_default_parameter (struct frame *f, Lisp_Object alist, Lisp_Object prop,
tem = x_frame_get_arg (f, alist, prop, xprop, xclass, type);
if (EQ (tem, Qunbound))
tem = deflt;
- x_set_frame_parameters (f, Fcons (Fcons (prop, tem), Qnil));
+ x_set_frame_parameters (f, list1 (Fcons (prop, tem)));
return tem;
}
@@ -3871,9 +3892,9 @@ On Nextstep, this just calls `ns-parse-geometry'. */)
Lisp_Object element;
if (x >= 0 && (geometry & XNegative))
- element = Fcons (Qleft, Fcons (Qminus, Fcons (make_number (-x), Qnil)));
+ element = list3 (Qleft, Qminus, make_number (-x));
else if (x < 0 && ! (geometry & XNegative))
- element = Fcons (Qleft, Fcons (Qplus, Fcons (make_number (x), Qnil)));
+ element = list3 (Qleft, Qplus, make_number (x));
else
element = Fcons (Qleft, make_number (x));
result = Fcons (element, result);
@@ -3884,9 +3905,9 @@ On Nextstep, this just calls `ns-parse-geometry'. */)
Lisp_Object element;
if (y >= 0 && (geometry & YNegative))
- element = Fcons (Qtop, Fcons (Qminus, Fcons (make_number (-y), Qnil)));
+ element = list3 (Qtop, Qminus, make_number (-y));
else if (y < 0 && ! (geometry & YNegative))
- element = Fcons (Qtop, Fcons (Qplus, Fcons (make_number (y), Qnil)));
+ element = list3 (Qtop, Qplus, make_number (y));
else
element = Fcons (Qtop, make_number (y));
result = Fcons (element, result);
@@ -4449,6 +4470,8 @@ automatically. See also `mouse-autoselect-window'. */);
defsubr (&Swindow_system);
defsubr (&Smake_terminal_frame);
defsubr (&Shandle_switch_frame);
+ defsubr (&Shandle_focus_in);
+ defsubr (&Shandle_focus_out);
defsubr (&Sselect_frame);
defsubr (&Sselected_frame);
defsubr (&Sframe_list);
diff --git a/src/ftfont.c b/src/ftfont.c
index 0ad173af98a..10090cb3bda 100644
--- a/src/ftfont.c
+++ b/src/ftfont.c
@@ -393,7 +393,7 @@ ftfont_lookup_cache (Lisp_Object key, enum ftfont_cache_for cache_for)
cache_data = xmalloc (sizeof *cache_data);
cache_data->ft_face = NULL;
cache_data->fc_charset = NULL;
- val = make_save_value (SAVE_TYPE_PTR_INT, cache_data, 0);
+ val = make_save_ptr_int (cache_data, 0);
cache = Fcons (Qnil, val);
Fputhash (key, cache, ft_face_cache);
}
@@ -2703,13 +2703,12 @@ syms_of_ftfont (void)
DEFSYM (Qsans__serif, "sans serif");
staticpro (&freetype_font_cache);
- freetype_font_cache = Fcons (Qt, Qnil);
+ freetype_font_cache = list1 (Qt);
staticpro (&ftfont_generic_family_list);
- ftfont_generic_family_list
- = Fcons (Fcons (Qmonospace, Qt),
- Fcons (Fcons (Qsans_serif, Qt),
- Fcons (Fcons (Qsans, Qt), Qnil)));
+ ftfont_generic_family_list = list3 (Fcons (Qmonospace, Qt),
+ Fcons (Qsans_serif, Qt),
+ Fcons (Qsans, Qt));
staticpro (&ft_face_cache);
ft_face_cache = Qnil;
diff --git a/src/gfilenotify.c b/src/gfilenotify.c
index 4e684d1fb54..8f13c72df81 100644
--- a/src/gfilenotify.c
+++ b/src/gfilenotify.c
@@ -173,7 +173,7 @@ will be reported only in case of the 'moved' event. */)
CHECK_STRING (file);
file = Fdirectory_file_name (Fexpand_file_name (file, Qnil));
if (NILP (Ffile_exists_p (file)))
- report_file_error ("File does not exists", Fcons (file, Qnil));
+ report_file_error ("File does not exist", file);
CHECK_LIST (flags);
diff --git a/src/gtkutil.c b/src/gtkutil.c
index 8ac58f18158..f8ddf6a90f6 100644
--- a/src/gtkutil.c
+++ b/src/gtkutil.c
@@ -1650,10 +1650,10 @@ xg_dialog_response_cb (GtkDialog *w,
/* Destroy the dialog. This makes it pop down. */
-static Lisp_Object
-pop_down_dialog (Lisp_Object arg)
+static void
+pop_down_dialog (void *arg)
{
- struct xg_dialog_data *dd = XSAVE_POINTER (arg, 0);
+ struct xg_dialog_data *dd = arg;
block_input ();
if (dd->w) gtk_widget_destroy (dd->w);
@@ -1663,8 +1663,6 @@ pop_down_dialog (Lisp_Object arg)
g_main_loop_unref (dd->loop);
unblock_input ();
-
- return Qnil;
}
/* If there are any emacs timers pending, add a timeout to main loop in DATA.
@@ -1719,7 +1717,7 @@ xg_dialog_run (FRAME_PTR f, GtkWidget *w)
g_signal_connect (G_OBJECT (w), "delete-event", G_CALLBACK (gtk_true), NULL);
gtk_widget_show (w);
- record_unwind_protect (pop_down_dialog, make_save_pointer (&dd));
+ record_unwind_protect_ptr (pop_down_dialog, &dd);
(void) xg_maybe_add_timer (&dd);
g_main_loop_run (dd.loop);
diff --git a/src/image.c b/src/image.c
index c085e6e63eb..1f8cb520dca 100644
--- a/src/image.c
+++ b/src/image.c
@@ -1569,7 +1569,7 @@ which is then usually a filename. */)
DEFUN ("image-flush", Fimage_flush, Simage_flush,
1, 2, 0,
- doc: /* Fush the image with specification SPEC on frame FRAME.
+ doc: /* Flush the image with specification SPEC on frame FRAME.
This removes the image from the Emacs image cache. If SPEC specifies
an image file, the next redisplay of this image will read from the
current contents of that file.
@@ -2276,23 +2276,28 @@ slurp_file (char *file, ptrdiff_t *size)
unsigned char *buf = NULL;
struct stat st;
- if (fp && fstat (fileno (fp), &st) == 0
- && 0 <= st.st_size && st.st_size <= min (PTRDIFF_MAX, SIZE_MAX)
- && (buf = xmalloc (st.st_size),
- fread (buf, 1, st.st_size, fp) == st.st_size))
- {
- *size = st.st_size;
- fclose (fp);
- }
- else
+ if (fp)
{
- if (fp)
- fclose (fp);
- if (buf)
+ ptrdiff_t count = SPECPDL_INDEX ();
+ record_unwind_protect_ptr (fclose_unwind, fp);
+
+ if (fstat (fileno (fp), &st) == 0
+ && 0 <= st.st_size && st.st_size < min (PTRDIFF_MAX, SIZE_MAX))
{
- xfree (buf);
- buf = NULL;
+ /* Report an error if we read past the purported EOF.
+ This can happen if the file grows as we read it. */
+ ptrdiff_t buflen = st.st_size;
+ buf = xmalloc (buflen + 1);
+ if (fread (buf, 1, buflen + 1, fp) == buflen)
+ *size = buflen;
+ else
+ {
+ xfree (buf);
+ buf = NULL;
+ }
}
+
+ unbind_to (count, Qnil);
}
return buf;
@@ -5732,8 +5737,8 @@ png_load_body (struct frame *f, struct image *img, struct png_load_context *c)
if (fread (sig, 1, sizeof sig, fp) != sizeof sig
|| fn_png_sig_cmp (sig, 0, sizeof sig))
{
- image_error ("Not a PNG file: `%s'", file, Qnil);
fclose (fp);
+ image_error ("Not a PNG file: `%s'", file, Qnil);
return 0;
}
}
@@ -7581,8 +7586,7 @@ gif_load (struct frame *f, struct image *img)
delay |= ext->Bytes[1];
}
}
- img->lisp_data = Fcons (Qextension_data,
- Fcons (img->lisp_data, Qnil));
+ img->lisp_data = list2 (Qextension_data, img->lisp_data);
if (delay)
img->lisp_data
= Fcons (Qdelay,
diff --git a/src/insdel.c b/src/insdel.c
index ed684264249..15d585568a0 100644
--- a/src/insdel.c
+++ b/src/insdel.c
@@ -1913,12 +1913,18 @@ prepare_to_modify_buffer (ptrdiff_t start, ptrdiff_t end,
VARIABLE is the variable to maybe set to nil.
NO-ERROR-FLAG is nil if there was an error,
anything else meaning no error (so this function does nothing). */
-static Lisp_Object
-reset_var_on_error (Lisp_Object val)
+struct rvoe_arg
{
- if (NILP (XCDR (val)))
- Fset (XCAR (val), Qnil);
- return Qnil;
+ Lisp_Object *location;
+ bool errorp;
+};
+
+static void
+reset_var_on_error (void *ptr)
+{
+ struct rvoe_arg *p = ptr;
+ if (p->errorp)
+ *p->location = Qnil;
}
/* Signal a change to the buffer immediately before it happens.
@@ -1936,6 +1942,7 @@ signal_before_change (ptrdiff_t start_int, ptrdiff_t end_int,
Lisp_Object preserve_marker;
struct gcpro gcpro1, gcpro2, gcpro3;
ptrdiff_t count = SPECPDL_INDEX ();
+ struct rvoe_arg rvoe_arg;
if (inhibit_modification_hooks)
return;
@@ -1963,13 +1970,14 @@ signal_before_change (ptrdiff_t start_int, ptrdiff_t end_int,
if (!NILP (Vbefore_change_functions))
{
Lisp_Object args[3];
- Lisp_Object rvoe_arg = Fcons (Qbefore_change_functions, Qnil);
+ rvoe_arg.location = &Vbefore_change_functions;
+ rvoe_arg.errorp = 1;
PRESERVE_VALUE;
PRESERVE_START_END;
/* Mark before-change-functions to be reset to nil in case of error. */
- record_unwind_protect (reset_var_on_error, rvoe_arg);
+ record_unwind_protect_ptr (reset_var_on_error, &rvoe_arg);
/* Actually run the hook functions. */
args[0] = Qbefore_change_functions;
@@ -1978,7 +1986,7 @@ signal_before_change (ptrdiff_t start_int, ptrdiff_t end_int,
Frun_hook_with_args (3, args);
/* There was no error: unarm the reset_on_error. */
- XSETCDR (rvoe_arg, Qt);
+ rvoe_arg.errorp = 0;
}
if (buffer_has_overlays ())
@@ -2009,6 +2017,8 @@ void
signal_after_change (ptrdiff_t charpos, ptrdiff_t lendel, ptrdiff_t lenins)
{
ptrdiff_t count = SPECPDL_INDEX ();
+ struct rvoe_arg rvoe_arg;
+
if (inhibit_modification_hooks)
return;
@@ -2042,10 +2052,11 @@ signal_after_change (ptrdiff_t charpos, ptrdiff_t lendel, ptrdiff_t lenins)
if (!NILP (Vafter_change_functions))
{
Lisp_Object args[4];
- Lisp_Object rvoe_arg = Fcons (Qafter_change_functions, Qnil);
+ rvoe_arg.location = &Vafter_change_functions;
+ rvoe_arg.errorp = 1;
/* Mark after-change-functions to be reset to nil in case of error. */
- record_unwind_protect (reset_var_on_error, rvoe_arg);
+ record_unwind_protect_ptr (reset_var_on_error, &rvoe_arg);
/* Actually run the hook functions. */
args[0] = Qafter_change_functions;
@@ -2055,7 +2066,7 @@ signal_after_change (ptrdiff_t charpos, ptrdiff_t lendel, ptrdiff_t lenins)
Frun_hook_with_args (4, args);
/* There was no error: unarm the reset_on_error. */
- XSETCDR (rvoe_arg, Qt);
+ rvoe_arg.errorp = 0;
}
if (buffer_has_overlays ())
@@ -2075,11 +2086,10 @@ signal_after_change (ptrdiff_t charpos, ptrdiff_t lendel, ptrdiff_t lenins)
unbind_to (count, Qnil);
}
-static Lisp_Object
+static void
Fcombine_after_change_execute_1 (Lisp_Object val)
{
Vcombine_after_change_calls = val;
- return val;
}
DEFUN ("combine-after-change-execute", Fcombine_after_change_execute,
diff --git a/src/keyboard.c b/src/keyboard.c
index b6eb9e6ad15..830f70bc1f5 100644
--- a/src/keyboard.c
+++ b/src/keyboard.c
@@ -295,6 +295,7 @@ static struct input_event * volatile kbd_store_ptr;
static Lisp_Object Qmouse_movement;
static Lisp_Object Qscroll_bar_movement;
Lisp_Object Qswitch_frame;
+static Lisp_Object Qfocus_in, Qfocus_out;
static Lisp_Object Qdelete_frame;
static Lisp_Object Qiconify_frame;
static Lisp_Object Qmake_frame_visible;
@@ -356,7 +357,7 @@ Lisp_Object Qvertical_line;
static Lisp_Object Qvertical_scroll_bar;
Lisp_Object Qmenu_bar;
-static Lisp_Object recursive_edit_unwind (Lisp_Object buffer);
+static void recursive_edit_unwind (Lisp_Object buffer);
static Lisp_Object command_loop (void);
static Lisp_Object Qcommand_execute;
EMACS_TIME timer_check (void);
@@ -420,12 +421,14 @@ static Lisp_Object modify_event_symbol (ptrdiff_t, int, Lisp_Object,
Lisp_Object, const char *const *,
Lisp_Object *, ptrdiff_t);
static Lisp_Object make_lispy_switch_frame (Lisp_Object);
+static Lisp_Object make_lispy_focus_in (Lisp_Object);
+static Lisp_Object make_lispy_focus_out (Lisp_Object);
static bool help_char_p (Lisp_Object);
static void save_getcjmp (sys_jmp_buf);
static void restore_getcjmp (sys_jmp_buf);
static Lisp_Object apply_modifiers (int, Lisp_Object);
static void clear_event (struct input_event *);
-static Lisp_Object restore_kboard_configuration (Lisp_Object);
+static void restore_kboard_configuration (int);
#ifdef USABLE_SIGIO
static void deliver_input_available_signal (int signo);
#endif
@@ -841,7 +844,7 @@ This function is called by the editor initialization to begin editing. */)
return unbind_to (count, Qnil);
}
-Lisp_Object
+void
recursive_edit_unwind (Lisp_Object buffer)
{
if (BUFFERP (buffer))
@@ -849,7 +852,6 @@ recursive_edit_unwind (Lisp_Object buffer)
command_loop_level--;
update_mode_lines = 1;
- return Qnil;
}
@@ -946,7 +948,7 @@ pop_kboard (void)
from which further input is accepted. If F is non-nil, set its
KBOARD as the current keyboard.
- This function uses record_unwind_protect to return to the previous
+ This function uses record_unwind_protect_int to return to the previous
state later.
If Emacs is already in single_kboard mode, and F's keyboard is
@@ -977,8 +979,7 @@ temporarily_switch_to_single_kboard (struct frame *f)
else if (f != NULL)
current_kboard = FRAME_KBOARD (f);
single_kboard = 1;
- record_unwind_protect (restore_kboard_configuration,
- (was_locked ? Qt : Qnil));
+ record_unwind_protect_int (restore_kboard_configuration, was_locked);
}
#if 0 /* This function is not needed anymore. */
@@ -987,26 +988,22 @@ record_single_kboard_state ()
{
if (single_kboard)
push_kboard (current_kboard);
- record_unwind_protect (restore_kboard_configuration,
- (single_kboard ? Qt : Qnil));
+ record_unwind_protect_int (restore_kboard_configuration, single_kboard);
}
#endif
-static Lisp_Object
-restore_kboard_configuration (Lisp_Object was_locked)
+static void
+restore_kboard_configuration (int was_locked)
{
- if (NILP (was_locked))
- single_kboard = 0;
- else
+ single_kboard = was_locked;
+ if (was_locked)
{
struct kboard *prev = current_kboard;
- single_kboard = 1;
pop_kboard ();
/* The pop should not change the kboard. */
if (single_kboard && current_kboard != prev)
emacs_abort ();
}
- return Qnil;
}
@@ -1234,7 +1231,7 @@ DEFUN ("abort-recursive-edit", Fabort_recursive_edit, Sabort_recursive_edit, 0,
/* Restore mouse tracking enablement. See Ftrack_mouse for the only use
of this function. */
-static Lisp_Object
+static void
tracking_off (Lisp_Object old_value)
{
do_mouse_tracking = old_value;
@@ -1251,7 +1248,6 @@ tracking_off (Lisp_Object old_value)
get_input_pending (READABLE_EVENTS_DO_TIMERS_NOW);
}
}
- return Qnil;
}
DEFUN ("track-mouse", Ftrack_mouse, Strack_mouse, 0, UNEVALLED, 0,
@@ -1314,17 +1310,6 @@ static int read_key_sequence (Lisp_Object *, int, Lisp_Object,
void safe_run_hooks (Lisp_Object);
static void adjust_point_for_property (ptrdiff_t, bool);
-/* Cancel hourglass from protect_unwind.
- ARG is not used. */
-#ifdef HAVE_WINDOW_SYSTEM
-static Lisp_Object
-cancel_hourglass_unwind (Lisp_Object arg)
-{
- cancel_hourglass ();
- return Qnil;
-}
-#endif
-
/* The last boundary auto-added to buffer-undo-list. */
Lisp_Object last_undo_boundary;
@@ -1427,7 +1412,7 @@ command_loop_1 (void)
if (!NILP (Vquit_flag))
{
Vquit_flag = Qnil;
- Vunread_command_events = Fcons (make_number (quit_char), Qnil);
+ Vunread_command_events = list1 (make_number (quit_char));
}
}
@@ -1559,7 +1544,7 @@ command_loop_1 (void)
if (display_hourglass_p
&& NILP (Vexecuting_kbd_macro))
{
- record_unwind_protect (cancel_hourglass_unwind, Qnil);
+ record_unwind_protect_void (cancel_hourglass);
start_hourglass ();
}
#endif
@@ -2201,14 +2186,13 @@ static Lisp_Object kbd_buffer_get_event (KBOARD **kbp, bool *used_mouse_menu,
static void record_char (Lisp_Object c);
static Lisp_Object help_form_saved_window_configs;
-static Lisp_Object
-read_char_help_form_unwind (Lisp_Object arg)
+static void
+read_char_help_form_unwind (void)
{
Lisp_Object window_config = XCAR (help_form_saved_window_configs);
help_form_saved_window_configs = XCDR (help_form_saved_window_configs);
if (!NILP (window_config))
Fset_window_configuration (window_config);
- return Qnil;
}
#define STOP_POLLING \
@@ -2255,9 +2239,9 @@ read_event_from_main_queue (EMACS_TIME *end_time,
emacs_abort ();
}
if (!CONSP (last))
- kset_kbd_queue (kb, Fcons (c, Qnil));
+ kset_kbd_queue (kb, list1 (c));
else
- XSETCDR (last, Fcons (c, Qnil));
+ XSETCDR (last, list1 (c));
kb->kbd_queue_has_data = 1;
c = Qnil;
if (single_kboard)
@@ -2679,9 +2663,9 @@ read_char (int commandflag, Lisp_Object map,
emacs_abort ();
}
if (!CONSP (last))
- kset_kbd_queue (kb, Fcons (c, Qnil));
+ kset_kbd_queue (kb, list1 (c));
else
- XSETCDR (last, Fcons (c, Qnil));
+ XSETCDR (last, list1 (c));
kb->kbd_queue_has_data = 1;
current_kboard = kb;
/* This is going to exit from read_char
@@ -2999,7 +2983,7 @@ read_char (int commandflag, Lisp_Object map,
if (EQ (posn, Qmenu_bar) || EQ (posn, Qtool_bar))
{
/* Change menu-bar to (menu-bar) as the event "position". */
- POSN_SET_POSN (EVENT_START (c), Fcons (posn, Qnil));
+ POSN_SET_POSN (EVENT_START (c), list1 (posn));
also_record = c;
Vunread_command_events = Fcons (c, Vunread_command_events);
@@ -3196,7 +3180,7 @@ read_char (int commandflag, Lisp_Object map,
help_form_saved_window_configs
= Fcons (Fcurrent_window_configuration (Qnil),
help_form_saved_window_configs);
- record_unwind_protect (read_char_help_form_unwind, Qnil);
+ record_unwind_protect_void (read_char_help_form_unwind);
call0 (Qhelp_form_show);
cancel_echoing ();
@@ -3582,8 +3566,8 @@ kbd_buffer_store_event_hold (register struct input_event *event,
if (single_kboard && kb != current_kboard)
{
kset_kbd_queue
- (kb, Fcons (make_lispy_switch_frame (event->frame_or_window),
- Fcons (make_number (c), Qnil)));
+ (kb, list2 (make_lispy_switch_frame (event->frame_or_window),
+ make_number (c)));
kb->kbd_queue_has_data = 1;
for (sp = kbd_fetch_ptr; sp != kbd_store_ptr; sp++)
{
@@ -3946,9 +3930,9 @@ kbd_buffer_get_event (KBOARD **kbp,
else if (event->kind == NS_TEXT_EVENT)
{
if (event->code == KEY_NS_PUT_WORKING_TEXT)
- obj = Fcons (intern ("ns-put-working-text"), Qnil);
+ obj = list1 (intern ("ns-put-working-text"));
else
- obj = Fcons (intern ("ns-unput-working-text"), Qnil);
+ obj = list1 (intern ("ns-unput-working-text"));
kbd_fetch_ptr = event + 1;
if (used_mouse_menu)
*used_mouse_menu = 1;
@@ -3960,8 +3944,7 @@ kbd_buffer_get_event (KBOARD **kbp,
else if (event->kind == DELETE_WINDOW_EVENT)
{
/* Make an event (delete-frame (FRAME)). */
- obj = Fcons (event->frame_or_window, Qnil);
- obj = Fcons (Qdelete_frame, Fcons (obj, Qnil));
+ obj = list2 (Qdelete_frame, list1 (event->frame_or_window));
kbd_fetch_ptr = event + 1;
}
#endif
@@ -3970,15 +3953,13 @@ kbd_buffer_get_event (KBOARD **kbp,
else if (event->kind == ICONIFY_EVENT)
{
/* Make an event (iconify-frame (FRAME)). */
- obj = Fcons (event->frame_or_window, Qnil);
- obj = Fcons (Qiconify_frame, Fcons (obj, Qnil));
+ obj = list2 (Qiconify_frame, list1 (event->frame_or_window));
kbd_fetch_ptr = event + 1;
}
else if (event->kind == DEICONIFY_EVENT)
{
/* Make an event (make-frame-visible (FRAME)). */
- obj = Fcons (event->frame_or_window, Qnil);
- obj = Fcons (Qmake_frame_visible, Fcons (obj, Qnil));
+ obj = list2 (Qmake_frame_visible, list1 (event->frame_or_window));
kbd_fetch_ptr = event + 1;
}
#endif
@@ -4001,11 +3982,11 @@ kbd_buffer_get_event (KBOARD **kbp,
#ifdef HAVE_NTGUI
else if (event->kind == LANGUAGE_CHANGE_EVENT)
{
- /* Make an event (language-change (FRAME CODEPAGE LANGUAGE-ID)). */
- obj = Fcons (Qlanguage_change,
- list3 (event->frame_or_window,
- make_number (event->code),
- make_number (event->modifiers)));
+ /* Make an event (language-change FRAME CODEPAGE LANGUAGE-ID). */
+ obj = list4 (Qlanguage_change,
+ event->frame_or_window,
+ make_number (event->code),
+ make_number (event->modifiers));
kbd_fetch_ptr = event + 1;
}
#endif
@@ -4014,11 +3995,11 @@ kbd_buffer_get_event (KBOARD **kbp,
{
#ifdef HAVE_W32NOTIFY
/* Make an event (file-notify (DESCRIPTOR ACTION FILE) CALLBACK). */
- obj = Fcons (Qfile_notify,
- list2 (list3 (make_number (event->code),
- XCAR (event->arg),
- XCDR (event->arg)),
- event->frame_or_window));
+ obj = list3 (Qfile_notify,
+ list3 (make_number (event->code),
+ XCAR (event->arg),
+ XCDR (event->arg)),
+ event->frame_or_window);
#else
obj = make_lispy_event (event);
#endif
@@ -4027,7 +4008,7 @@ kbd_buffer_get_event (KBOARD **kbp,
#endif /* USE_FILE_NOTIFY */
else if (event->kind == SAVE_SESSION_EVENT)
{
- obj = Fcons (Qsave_session, Fcons (event->arg, Qnil));
+ obj = list2 (Qsave_session, event->arg);
kbd_fetch_ptr = event + 1;
}
/* Just discard these, by returning nil.
@@ -4064,17 +4045,43 @@ kbd_buffer_get_event (KBOARD **kbp,
switch-frame event if necessary. */
Lisp_Object frame, focus;
- frame = event->frame_or_window;
- focus = FRAME_FOCUS_FRAME (XFRAME (frame));
- if (FRAMEP (focus))
- frame = focus;
+ frame = event->frame_or_window;
+ focus = FRAME_FOCUS_FRAME (XFRAME (frame));
+ if (FRAMEP (focus))
+ frame = focus;
- if (!EQ (frame, internal_last_event_frame)
- && !EQ (frame, selected_frame))
- obj = make_lispy_switch_frame (frame);
- internal_last_event_frame = frame;
- kbd_fetch_ptr = event + 1;
- }
+ if (
+#ifdef HAVE_X11
+ ! NILP (event->arg)
+ &&
+#endif
+ !EQ (frame, internal_last_event_frame)
+ && !EQ (frame, selected_frame))
+ obj = make_lispy_switch_frame (frame);
+ else
+ obj = make_lispy_focus_in (frame);
+
+ internal_last_event_frame = frame;
+ kbd_fetch_ptr = event + 1;
+ }
+ else if (event->kind == FOCUS_OUT_EVENT)
+ {
+#ifdef HAVE_WINDOW_SYSTEM
+
+ Display_Info *di;
+ Lisp_Object frame = event->frame_or_window;
+ bool focused = false;
+
+ for (di = x_display_list; di && ! focused; di = di->next)
+ focused = di->x_highlight_frame != 0;
+
+ if (!focused)
+ obj = make_lispy_focus_out (frame);
+
+#endif /* HAVE_WINDOW_SYSTEM */
+
+ kbd_fetch_ptr = event + 1;
+ }
#ifdef HAVE_DBUS
else if (event->kind == DBUS_EVENT)
{
@@ -5555,14 +5562,12 @@ make_lispy_event (struct input_event *event)
/* ELisp manual 2.4b says (x y) are window relative but
code says they are frame-relative. */
- position
- = Fcons (event->frame_or_window,
- Fcons (Qmenu_bar,
- Fcons (Fcons (event->x, event->y),
- Fcons (make_number (event->timestamp),
- Qnil))));
-
- return Fcons (item, Fcons (position, Qnil));
+ position = list4 (event->frame_or_window,
+ Qmenu_bar,
+ Fcons (event->x, event->y),
+ make_number (event->timestamp));
+
+ return list2 (item, position);
}
#endif /* not USE_X_TOOLKIT && not USE_GTK && not HAVE_NS */
@@ -5581,12 +5586,9 @@ make_lispy_event (struct input_event *event)
portion_whole = Fcons (event->x, event->y);
part = *scroll_bar_parts[(int) event->part];
- position
- = Fcons (window,
- Fcons (Qvertical_scroll_bar,
- Fcons (portion_whole,
- Fcons (make_number (event->timestamp),
- Fcons (part, Qnil)))));
+ position = list5 (window, Qvertical_scroll_bar,
+ portion_whole, make_number (event->timestamp),
+ part);
}
#endif /* not USE_TOOLKIT_SCROLL_BARS */
@@ -5734,19 +5736,11 @@ make_lispy_event (struct input_event *event)
&mouse_syms,
ASIZE (mouse_syms));
if (event->modifiers & drag_modifier)
- return Fcons (head,
- Fcons (start_pos,
- Fcons (position,
- Qnil)));
+ return list3 (head, start_pos, position);
else if (event->modifiers & (double_modifier | triple_modifier))
- return Fcons (head,
- Fcons (position,
- Fcons (make_number (double_click_count),
- Qnil)));
+ return list3 (head, position, make_number (double_click_count));
else
- return Fcons (head,
- Fcons (position,
- Qnil));
+ return list2 (head, position);
}
}
@@ -5845,14 +5839,9 @@ make_lispy_event (struct input_event *event)
}
if (event->modifiers & (double_modifier | triple_modifier))
- return Fcons (head,
- Fcons (position,
- Fcons (make_number (double_click_count),
- Qnil)));
+ return list3 (head, position, make_number (double_click_count));
else
- return Fcons (head,
- Fcons (position,
- Qnil));
+ return list2 (head, position);
}
@@ -5883,12 +5872,8 @@ make_lispy_event (struct input_event *event)
portion_whole = Fcons (event->x, event->y);
part = *scroll_bar_parts[(int) event->part];
- position
- = Fcons (window,
- Fcons (Qvertical_scroll_bar,
- Fcons (portion_whole,
- Fcons (make_number (event->timestamp),
- Fcons (part, Qnil)))));
+ position = list5 (window, Qvertical_scroll_bar, portion_whole,
+ make_number (event->timestamp), part);
/* Always treat scroll bar events as clicks. */
event->modifiers |= click_modifier;
@@ -5906,7 +5891,7 @@ make_lispy_event (struct input_event *event)
Vlispy_mouse_stem,
NULL, &mouse_syms,
ASIZE (mouse_syms));
- return Fcons (head, Fcons (position, Qnil));
+ return list2 (head, position);
}
#endif /* USE_TOOLKIT_SCROLL_BARS */
@@ -5932,10 +5917,7 @@ make_lispy_event (struct input_event *event)
Qdrag_n_drop, Qnil,
lispy_drag_n_drop_names,
&drag_n_drop_syms, 1);
- return Fcons (head,
- Fcons (position,
- Fcons (files,
- Qnil)));
+ return list3 (head, position, files);
}
#if defined (USE_X_TOOLKIT) || defined (HAVE_NTGUI) \
@@ -5945,22 +5927,20 @@ make_lispy_event (struct input_event *event)
/* This is the prefix key. We translate this to
`(menu_bar)' because the code in keyboard.c for menu
events, which we use, relies on this. */
- return Fcons (Qmenu_bar, Qnil);
+ return list1 (Qmenu_bar);
return event->arg;
#endif
case SELECT_WINDOW_EVENT:
/* Make an event (select-window (WINDOW)). */
- return Fcons (Qselect_window,
- Fcons (Fcons (event->frame_or_window, Qnil),
- Qnil));
+ return list2 (Qselect_window, list1 (event->frame_or_window));
case TOOL_BAR_EVENT:
if (EQ (event->arg, event->frame_or_window))
/* This is the prefix key. We translate this to
`(tool_bar)' because the code in keyboard.c for tool bar
events, which we use, relies on this. */
- return Fcons (Qtool_bar, Qnil);
+ return list1 (Qtool_bar);
else if (SYMBOLP (event->arg))
return apply_modifiers (event->modifiers, event->arg);
return event->arg;
@@ -5992,9 +5972,8 @@ make_lispy_event (struct input_event *event)
#endif /* defined HAVE_GFILENOTIFY || defined HAVE_INOTIFY */
case CONFIG_CHANGED_EVENT:
- return Fcons (Qconfig_changed_event,
- Fcons (event->arg,
- Fcons (event->frame_or_window, Qnil)));
+ return list3 (Qconfig_changed_event,
+ event->arg, event->frame_or_window);
#ifdef HAVE_GPM
case GPM_CLICK_EVENT:
{
@@ -6035,24 +6014,13 @@ make_lispy_event (struct input_event *event)
ASIZE (mouse_syms));
if (event->modifiers & drag_modifier)
- return Fcons (head,
- Fcons (start_pos,
- Fcons (position,
- Qnil)));
+ return list3 (head, start_pos, position);
else if (event->modifiers & double_modifier)
- return Fcons (head,
- Fcons (position,
- Fcons (make_number (2),
- Qnil)));
+ return list3 (head, position, make_number (2));
else if (event->modifiers & triple_modifier)
- return Fcons (head,
- Fcons (position,
- Fcons (make_number (3),
- Qnil)));
+ return list3 (head, position, make_number (3));
else
- return Fcons (head,
- Fcons (position,
- Qnil));
+ return list2 (head, position);
}
#endif /* HAVE_GPM */
@@ -6072,13 +6040,12 @@ make_lispy_movement (FRAME_PTR frame, Lisp_Object bar_window, enum scroll_bar_pa
Lisp_Object part_sym;
part_sym = *scroll_bar_parts[(int) part];
- return Fcons (Qscroll_bar_movement,
- Fcons (list5 (bar_window,
- Qvertical_scroll_bar,
- Fcons (x, y),
- make_number (t),
- part_sym),
- Qnil));
+ return list2 (Qscroll_bar_movement,
+ list5 (bar_window,
+ Qvertical_scroll_bar,
+ Fcons (x, y),
+ make_number (t),
+ part_sym));
}
/* Or is it an ordinary mouse movement? */
else
@@ -6093,7 +6060,18 @@ make_lispy_movement (FRAME_PTR frame, Lisp_Object bar_window, enum scroll_bar_pa
static Lisp_Object
make_lispy_switch_frame (Lisp_Object frame)
{
- return Fcons (Qswitch_frame, Fcons (frame, Qnil));
+ return list2 (Qswitch_frame, frame);
+}
+
+static Lisp_Object
+make_lispy_focus_in (Lisp_Object frame)
+{
+ return list2 (Qfocus_in, frame);
+}
+static Lisp_Object
+make_lispy_focus_out (Lisp_Object frame)
+{
+ return list2 (Qfocus_out, frame);
}
/* Manipulating modifiers. */
@@ -6326,7 +6304,7 @@ parse_modifiers (Lisp_Object symbol)
if (modifiers & ~INTMASK)
emacs_abort ();
XSETFASTINT (mask, modifiers);
- elements = Fcons (unmodified, Fcons (mask, Qnil));
+ elements = list2 (unmodified, mask);
/* Cache the parsing results on SYMBOL. */
Fput (symbol, Qevent_symbol_element_mask,
@@ -6399,7 +6377,7 @@ apply_modifiers (int modifiers, Lisp_Object base)
the caches:
XSETFASTINT (idx, modifiers);
Fput (new_symbol, Qevent_symbol_element_mask,
- Fcons (base, Fcons (idx, Qnil)));
+ list2 (base, idx));
Fput (new_symbol, Qevent_symbol_elements,
Fcons (base, lispy_modifier_list (modifiers)));
Sadly, this is only correct if `base' is indeed a base event,
@@ -7551,7 +7529,7 @@ menu_bar_item (Lisp_Object key, Lisp_Object item, Lisp_Object dummy1, void *dumm
ASET (menu_bar_items_vector, i, key); i++;
ASET (menu_bar_items_vector, i,
AREF (item_properties, ITEM_PROPERTY_NAME)); i++;
- ASET (menu_bar_items_vector, i, Fcons (item, Qnil)); i++;
+ ASET (menu_bar_items_vector, i, list1 (item)); i++;
ASET (menu_bar_items_vector, i, make_number (0)); i++;
menu_bar_items_index = i;
}
@@ -8106,7 +8084,7 @@ parse_tool_bar_item (Lisp_Object key, Lisp_Object item)
/* As an exception, allow old-style menu separators. */
if (STRINGP (XCAR (item)))
- item = Fcons (XCAR (item), Qnil);
+ item = list1 (XCAR (item));
else if (!EQ (XCAR (item), Qmenu_item)
|| (item = XCDR (item), !CONSP (item)))
return 0;
@@ -9338,8 +9316,7 @@ read_key_sequence (Lisp_Object *keybuf, int bufsize, Lisp_Object prompt,
/* Zap the position in key, so we know that we've
expanded it, and don't try to do so again. */
- POSN_SET_POSN (EVENT_START (key),
- Fcons (posn, Qnil));
+ POSN_SET_POSN (EVENT_START (key), list1 (posn));
mock_input = t + 2;
goto replay_sequence;
@@ -9494,8 +9471,7 @@ read_key_sequence (Lisp_Object *keybuf, int bufsize, Lisp_Object prompt,
new_head
= apply_modifiers (modifiers, XCAR (breakdown));
- new_click
- = Fcons (new_head, Fcons (EVENT_START (key), Qnil));
+ new_click = list2 (new_head, EVENT_START (key));
/* Look for a binding for this new key. */
new_binding = follow_key (current_binding, new_click);
@@ -10131,7 +10107,7 @@ The file will be closed when Emacs exits. */)
file = Fexpand_file_name (file, Qnil);
dribble = emacs_fopen (SSDATA (file), "w");
if (dribble == 0)
- report_file_error ("Opening dribble", Fcons (file, Qnil));
+ report_file_error ("Opening dribble", file);
}
return Qnil;
}
@@ -10196,8 +10172,7 @@ On such systems, Emacs starts a subshell instead of suspending. */)
reset_all_sys_modes ();
/* sys_suspend can get an error if it tries to fork a subshell
and the system resources aren't available for that. */
- record_unwind_protect ((Lisp_Object (*) (Lisp_Object)) init_all_sys_modes,
- Qnil);
+ record_unwind_protect_void (init_all_sys_modes);
stuff_buffered_input (stuffstring);
if (cannot_suspend)
sys_subshell ();
@@ -10956,6 +10931,8 @@ static const struct event_head head_table[] = {
{&Qmouse_movement, "mouse-movement", &Qmouse_movement},
{&Qscroll_bar_movement, "scroll-bar-movement", &Qmouse_movement},
{&Qswitch_frame, "switch-frame", &Qswitch_frame},
+ {&Qfocus_in, "focus-in", &Qfocus_in},
+ {&Qfocus_out, "focus-out", &Qfocus_out},
{&Qdelete_frame, "delete-frame", &Qdelete_frame},
{&Qiconify_frame, "iconify-frame", &Qiconify_frame},
{&Qmake_frame_visible, "make-frame-visible", &Qmake_frame_visible},
@@ -11079,7 +11056,7 @@ syms_of_keyboard (void)
*p->var = intern_c_string (p->name);
staticpro (p->var);
Fput (*p->var, Qevent_kind, *p->kind);
- Fput (*p->var, Qevent_symbol_elements, Fcons (*p->var, Qnil));
+ Fput (*p->var, Qevent_symbol_elements, list1 (*p->var));
}
}
@@ -11474,7 +11451,7 @@ and the minor mode maps regardless of `overriding-local-map'. */);
DEFVAR_LISP ("special-event-map", Vspecial_event_map,
doc: /* Keymap defining bindings for special events to execute at low level. */);
- Vspecial_event_map = Fcons (intern_c_string ("keymap"), Qnil);
+ Vspecial_event_map = list1 (intern_c_string ("keymap"));
DEFVAR_LISP ("track-mouse", do_mouse_tracking,
doc: /* Non-nil means generate motion events for mouse motion. */);
@@ -11770,6 +11747,10 @@ keys_of_keyboard (void)
initial_define_lispy_key (Vspecial_event_map, "language-change",
"ignore");
#endif
+ initial_define_lispy_key (Vspecial_event_map, "focus-in",
+ "handle-focus-in");
+ initial_define_lispy_key (Vspecial_event_map, "focus-out",
+ "handle-focus-out");
}
/* Mark the pointers in the kboard objects.
diff --git a/src/keyboard.h b/src/keyboard.h
index 8bb1c409efc..daba94898d8 100644
--- a/src/keyboard.h
+++ b/src/keyboard.h
@@ -341,7 +341,7 @@ enum menu_item_idx
MENU_ITEMS_ITEM_LENGTH
};
-extern Lisp_Object unuse_menu_items (Lisp_Object dummy);
+extern void unuse_menu_items (void);
/* This is how to deal with multibyte text if HAVE_MULTILINGUAL_MENU
isn't defined. The use of HAVE_MULTILINGUAL_MENU could probably be
diff --git a/src/keymap.c b/src/keymap.c
index d29d5636e1c..d13a6274347 100644
--- a/src/keymap.c
+++ b/src/keymap.c
@@ -129,7 +129,7 @@ in case you use it as a menu with `x-popup-menu'. */)
{
Lisp_Object tail;
if (!NILP (string))
- tail = Fcons (string, Qnil);
+ tail = list1 (string);
else
tail = Qnil;
return Fcons (Qkeymap,
@@ -151,9 +151,9 @@ in case you use it as a menu with `x-popup-menu'. */)
{
if (!NILP (Vpurify_flag))
string = Fpurecopy (string);
- return Fcons (Qkeymap, Fcons (string, Qnil));
+ return list2 (Qkeymap, string);
}
- return Fcons (Qkeymap, Qnil);
+ return list1 (Qkeymap);
}
/* This function is used for installing the standard key bindings
@@ -534,12 +534,12 @@ access_keymap_1 (Lisp_Object map, Lisp_Object idx,
retval = val;
else if (CONSP (retval_tail))
{
- XSETCDR (retval_tail, Fcons (val, Qnil));
+ XSETCDR (retval_tail, list1 (val));
retval_tail = XCDR (retval_tail);
}
else
{
- retval_tail = Fcons (val, Qnil);
+ retval_tail = list1 (val);
retval = Fcons (Qkeymap, Fcons (retval, retval_tail));
}
}
@@ -617,8 +617,8 @@ map_keymap_internal (Lisp_Object map,
}
else if (CHAR_TABLE_P (binding))
map_char_table (map_keymap_char_table_item, Qnil, binding,
- make_save_value (SAVE_TYPE_FUNCPTR_PTR_OBJ,
- (voidfuncptr) fun, data, args));
+ make_save_funcptr_ptr_obj ((voidfuncptr) fun, data,
+ args));
}
UNGCPRO;
return tail;
@@ -1045,9 +1045,9 @@ However, a key definition which is a symbol whose definition is a keymap
is not copied. */)
(Lisp_Object keymap)
{
- register Lisp_Object copy, tail;
+ Lisp_Object copy, tail;
keymap = get_keymap (keymap, 1, 0);
- copy = tail = Fcons (Qkeymap, Qnil);
+ copy = tail = list1 (Qkeymap);
keymap = XCDR (keymap); /* Skip the `keymap' symbol. */
while (CONSP (keymap) && !EQ (XCAR (keymap), Qkeymap))
@@ -1073,7 +1073,7 @@ is not copied. */)
else
elt = Fcons (XCAR (elt), copy_keymap_item (XCDR (elt)));
}
- XSETCDR (tail, Fcons (elt, Qnil));
+ XSETCDR (tail, list1 (elt));
tail = XCDR (tail);
keymap = XCDR (keymap);
}
@@ -1341,8 +1341,7 @@ append_key (Lisp_Object key_sequence, Lisp_Object key)
Lisp_Object args[2];
args[0] = key_sequence;
-
- args[1] = Fcons (key, Qnil);
+ args[1] = list1 (key);
return Fvconcat (2, args);
}
@@ -1549,7 +1548,7 @@ like in the respective argument of `key-binding'. */)
{
ptrdiff_t count = SPECPDL_INDEX ();
- Lisp_Object keymaps = Fcons (current_global_map, Qnil);
+ Lisp_Object keymaps = list1 (current_global_map);
/* If a mouse click position is given, our variables are based on
the buffer clicked on, not the current buffer. So we may have to
@@ -1809,7 +1808,7 @@ bindings; see the description of `lookup-key' for more details about this. */)
if (KEYMAPP (binding))
maps[j++] = Fcons (modes[i], binding);
else if (j == 0)
- RETURN_UNGCPRO (Fcons (Fcons (modes[i], binding), Qnil));
+ RETURN_UNGCPRO (list1 (Fcons (modes[i], binding)));
}
UNGCPRO;
@@ -1951,7 +1950,7 @@ accessible_keymaps_1 (Lisp_Object key, Lisp_Object cmd, Lisp_Object args, void *
else
{
tem = append_key (thisseq, key);
- nconc2 (tail, Fcons (Fcons (tem, cmd), Qnil));
+ nconc2 (tail, list1 (Fcons (tem, cmd)));
}
}
@@ -2005,13 +2004,13 @@ then the value includes only maps for prefixes that start with PREFIX. */)
}
prefix = copy;
}
- maps = Fcons (Fcons (prefix, tem), Qnil);
+ maps = list1 (Fcons (prefix, tem));
}
else
return Qnil;
}
else
- maps = Fcons (Fcons (zero_vector, get_keymap (keymap, 1, 0)), Qnil);
+ maps = list1 (Fcons (zero_vector, get_keymap (keymap, 1, 0)));
/* For each map in the list maps,
look at any other maps it points to,
@@ -2619,7 +2618,7 @@ The optional 5th arg NO-REMAP alters how command remapping is handled:
if (CONSP (keymap) && KEYMAPP (XCAR (keymap)))
keymaps = keymap;
else if (!NILP (keymap))
- keymaps = Fcons (keymap, Fcons (current_global_map, Qnil));
+ keymaps = list2 (keymap, current_global_map);
else
keymaps = Fcurrent_active_maps (Qnil, Qnil);
diff --git a/src/lisp.h b/src/lisp.h
index acd21089655..952991a32d9 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -443,8 +443,7 @@ enum Lisp_Fwd_Type
displayed to users. These are Lisp_Save_Value, a Lisp_Misc
subtype; and PVEC_OTHER, a kind of vectorlike object. The former
is suitable for temporarily stashing away pointers and integers in
- a Lisp object (see the existing uses of make_save_value and
- XSAVE_VALUE). The latter is useful for vector-like Lisp objects
+ a Lisp object. The latter is useful for vector-like Lisp objects
that need to be used as part of other objects, but which are never
shown to users or Lisp code (search for PVEC_OTHER in xterm.c for
an example).
@@ -1851,46 +1850,27 @@ enum Lisp_Save_Type
/* Special object used to hold a different values for later use.
This is mostly used to package C integers and pointers to call
- record_unwind_protect. A typical task is to pass just one C object
- pointer to the unwind function. You should pack an object pointer with
- make_save_pointer and then get it back with XSAVE_POINTER, e.g.:
+ record_unwind_protect when two or more values need to be saved.
+ For example:
...
struct my_data *md = get_my_data ();
- record_unwind_protect (my_unwind, make_save_pointer (md));
+ ptrdiff_t mi = get_my_integer ();
+ record_unwind_protect (my_unwind, make_save_ptr_int (md, mi));
...
Lisp_Object my_unwind (Lisp_Object arg)
{
struct my_data *md = XSAVE_POINTER (arg, 0);
- ...
- }
-
- If you need to pass something else you can use make_save_value,
- which allows you to pack up to SAVE_VALUE_SLOTS integers, pointers,
- function pointers or Lisp_Objects and conveniently get them back
- with XSAVE_INTEGER, XSAVE_POINTER, XSAVE_FUNCPOINTER, and
- XSAVE_OBJECT macros:
-
- ...
- struct my_data *md = get_my_data ();
- Lisp_Object my_object = get_my_object ();
- record_unwind_protect
- (my_unwind, make_save_value (SAVE_TYPE_PTR_OBJ, md, my_object));
- ...
-
- Lisp_Object my_unwind (Lisp_Object arg)
- {
- struct my_data *md = XSAVE_POINTER (arg, 0);
- Lisp_Object my_object = XSAVE_OBJECT (arg, 1);
+ ptrdiff_t mi = XSAVE_INTEGER (arg, 1);
...
}
If ENABLE_CHECKING is in effect, XSAVE_xxx macros do type checking of the
saved objects and raise eassert if type of the saved object doesn't match
the type which is extracted. In the example above, XSAVE_INTEGER (arg, 2)
- or XSAVE_OBJECT (arg, 0) are wrong because nothing was saved in slot 2 and
- Lisp_Object was saved in slot 1 of ARG. */
+ and XSAVE_OBJECT (arg, 0) are wrong because nothing was saved in slot 2 and
+ slot 0 is a pointer. */
typedef void (*voidfuncptr) (void);
@@ -1900,12 +1880,13 @@ struct Lisp_Save_Value
unsigned gcmarkbit : 1;
int spacer : 32 - (16 + 1 + SAVE_TYPE_BITS);
- /* DATA[N] may hold up to SAVE_VALUE_SLOTS entries. The type of
- V's Ith entry is given by save_type (V, I). E.g., if save_type
- (V, 3) == SAVE_INTEGER, V->data[3].integer is in use.
+ /* V->data may hold up to SAVE_VALUE_SLOTS entries. The type of
+ V's data entries are determined by V->save_type. E.g., if
+ V->save_type == SAVE_TYPE_PTR_OBJ, V->data[0] is a pointer,
+ V->data[1] is an integer, and V's other data entries are unused.
- If SAVE_TYPE == SAVE_TYPE_MEMORY, DATA[0].pointer is the address of
- a memory area containing DATA[1].integer potential Lisp_Objects. */
+ If V->save_type == SAVE_TYPE_MEMORY, V->data[0].pointer is the address of
+ a memory area containing V->data[1].integer potential Lisp_Objects. */
ENUM_BF (Lisp_Save_Type) save_type : SAVE_TYPE_BITS;
union {
void *pointer;
@@ -2775,10 +2756,11 @@ typedef jmp_buf sys_jmp_buf;
used all over the place, needs to be fast, and needs to know the size of
union specbinding. But only eval.c should access it. */
-typedef Lisp_Object (*specbinding_func) (Lisp_Object);
-
enum specbind_tag {
- SPECPDL_UNWIND, /* An unwind_protect function. */
+ SPECPDL_UNWIND, /* An unwind_protect function on Lisp_Object. */
+ SPECPDL_UNWIND_PTR, /* Likewise, on void *. */
+ SPECPDL_UNWIND_INT, /* Likewise, on int. */
+ SPECPDL_UNWIND_VOID, /* Likewise, with no arg. */
SPECPDL_BACKTRACE, /* An element of the backtrace. */
SPECPDL_LET, /* A plain and simple dynamic let-binding. */
/* Tags greater than SPECPDL_LET must be "subkinds" of LET. */
@@ -2791,11 +2773,25 @@ union specbinding
ENUM_BF (specbind_tag) kind : CHAR_BIT;
struct {
ENUM_BF (specbind_tag) kind : CHAR_BIT;
+ void (*func) (Lisp_Object);
Lisp_Object arg;
- specbinding_func func;
} unwind;
struct {
ENUM_BF (specbind_tag) kind : CHAR_BIT;
+ void (*func) (void *);
+ void *arg;
+ } unwind_ptr;
+ struct {
+ ENUM_BF (specbind_tag) kind : CHAR_BIT;
+ void (*func) (int);
+ int arg;
+ } unwind_int;
+ struct {
+ ENUM_BF (specbind_tag) kind : CHAR_BIT;
+ void (*func) (void);
+ } unwind_void;
+ struct {
+ ENUM_BF (specbind_tag) kind : CHAR_BIT;
/* `where' is not used in the case of SPECPDL_LET. */
Lisp_Object symbol, old_value, where;
/* Normally this is unused; but it is set to the symbol's
@@ -3487,7 +3483,7 @@ extern void add_to_log (const char *, Lisp_Object, Lisp_Object);
extern void check_message_stack (void);
extern void setup_echo_area_for_printing (int);
extern bool push_message (void);
-extern Lisp_Object pop_message_unwind (Lisp_Object);
+extern void pop_message_unwind (void);
extern Lisp_Object restore_message_unwind (Lisp_Object);
extern void restore_message (void);
extern Lisp_Object current_message (void);
@@ -3652,8 +3648,16 @@ extern bool abort_on_gc;
extern Lisp_Object make_float (double);
extern void display_malloc_warning (void);
extern ptrdiff_t inhibit_garbage_collection (void);
-extern Lisp_Object make_save_value (enum Lisp_Save_Type, ...);
-extern Lisp_Object make_save_pointer (void *);
+extern Lisp_Object make_save_int_int_int (ptrdiff_t, ptrdiff_t, ptrdiff_t);
+extern Lisp_Object make_save_obj_obj_obj_obj (Lisp_Object, Lisp_Object,
+ Lisp_Object, Lisp_Object);
+extern Lisp_Object make_save_ptr (void *);
+extern Lisp_Object make_save_ptr_int (void *, ptrdiff_t);
+extern Lisp_Object make_save_ptr_ptr (void *, void *);
+extern Lisp_Object make_save_funcptr_ptr_obj (void (*) (void), void *,
+ Lisp_Object);
+extern Lisp_Object make_save_memory (Lisp_Object *, ptrdiff_t);
+extern void free_save_value (Lisp_Object);
extern Lisp_Object build_overlay (Lisp_Object, Lisp_Object, Lisp_Object);
extern void free_marker (Lisp_Object);
extern void free_cons (struct Lisp_Cons *);
@@ -3811,14 +3815,20 @@ extern Lisp_Object internal_condition_case_n
(Lisp_Object (*) (ptrdiff_t, Lisp_Object *), ptrdiff_t, Lisp_Object *,
Lisp_Object, Lisp_Object (*) (Lisp_Object, ptrdiff_t, Lisp_Object *));
extern void specbind (Lisp_Object, Lisp_Object);
-extern void record_unwind_protect (Lisp_Object (*) (Lisp_Object), Lisp_Object);
+extern void record_unwind_protect (void (*) (Lisp_Object), Lisp_Object);
+extern void record_unwind_protect_int (void (*) (int), int);
+extern void record_unwind_protect_ptr (void (*) (void *), void *);
+extern void record_unwind_protect_void (void (*) (void));
+extern void record_unwind_protect_nothing (void);
+extern void clear_unwind_protect (ptrdiff_t);
+extern void set_unwind_protect_ptr (ptrdiff_t, void (*) (void *), void *);
extern Lisp_Object unbind_to (ptrdiff_t, Lisp_Object);
extern void rebind_for_thread_switch (void);
extern void unbind_for_thread_switch (void);
extern _Noreturn void error (const char *, ...) ATTRIBUTE_FORMAT_PRINTF (1, 2);
extern _Noreturn void verror (const char *, va_list)
ATTRIBUTE_FORMAT_PRINTF (1, 0);
-extern Lisp_Object un_autoload (Lisp_Object);
+extern void un_autoload (Lisp_Object);
extern Lisp_Object call_debugger (Lisp_Object arg);
extern void init_eval_once (void);
extern Lisp_Object safe_call (ptrdiff_t, Lisp_Object, ...);
@@ -3826,6 +3836,7 @@ extern Lisp_Object safe_call1 (Lisp_Object, Lisp_Object);
extern Lisp_Object safe_call2 (Lisp_Object, Lisp_Object, Lisp_Object);
extern void init_eval (void);
extern void syms_of_eval (void);
+extern void unwind_body (Lisp_Object);
extern void record_in_backtrace (Lisp_Object function,
Lisp_Object *args, ptrdiff_t nargs);
extern void mark_specpdl (union specbinding *first, union specbinding *ptr);
@@ -3844,8 +3855,8 @@ extern void insert1 (Lisp_Object);
extern Lisp_Object format2 (const char *, Lisp_Object, Lisp_Object);
extern Lisp_Object save_excursion_save (void);
extern Lisp_Object save_restriction_save (void);
-extern Lisp_Object save_excursion_restore (Lisp_Object);
-extern Lisp_Object save_restriction_restore (Lisp_Object);
+extern void save_excursion_restore (Lisp_Object);
+extern void save_restriction_restore (Lisp_Object);
extern _Noreturn void time_overflow (void);
extern Lisp_Object make_buffer_string (ptrdiff_t, ptrdiff_t, bool);
extern Lisp_Object make_buffer_string_both (ptrdiff_t, ptrdiff_t, ptrdiff_t,
@@ -3864,7 +3875,6 @@ extern void report_overlay_modification (Lisp_Object, Lisp_Object, bool,
Lisp_Object, Lisp_Object, Lisp_Object);
extern bool overlay_touches_p (ptrdiff_t);
extern Lisp_Object Vbuffer_alist;
-extern Lisp_Object set_buffer_if_live (Lisp_Object);
extern Lisp_Object other_buffer_safely (Lisp_Object);
extern Lisp_Object Qpriority, Qwindow, Qbefore_string, Qafter_string;
extern Lisp_Object get_truename_buffer (Lisp_Object);
@@ -3898,8 +3908,9 @@ extern Lisp_Object Qinsert_file_contents;
extern Lisp_Object Qfile_name_history;
extern Lisp_Object expand_and_dir_to_file (Lisp_Object, Lisp_Object);
EXFUN (Fread_file_name, 6); /* Not a normal DEFUN. */
-extern Lisp_Object close_file_unwind (Lisp_Object);
-extern Lisp_Object restore_point_unwind (Lisp_Object);
+extern void close_file_unwind (int);
+extern void fclose_unwind (void *);
+extern void restore_point_unwind (Lisp_Object);
extern _Noreturn void report_file_errno (const char *, Lisp_Object, int);
extern _Noreturn void report_file_error (const char *, Lisp_Object);
extern bool internal_delete_file (Lisp_Object);
@@ -4171,6 +4182,7 @@ extern void init_random (void);
extern void emacs_backtrace (int);
extern _Noreturn void emacs_abort (void) NO_INLINE;
extern int emacs_open (const char *, int, int);
+extern int emacs_pipe (int[2]);
extern int emacs_close (int);
extern ptrdiff_t emacs_read (int, char *, ptrdiff_t);
extern ptrdiff_t emacs_write (int, const char *, ptrdiff_t);
@@ -4334,7 +4346,6 @@ extern void init_system_name (void);
enum MAX_ALLOCA { MAX_ALLOCA = 16 * 1024 };
-extern Lisp_Object safe_alloca_unwind (Lisp_Object);
extern void *record_xmalloc (size_t);
#define USE_SAFE_ALLOCA \
@@ -4358,8 +4369,7 @@ extern void *record_xmalloc (size_t);
{ \
(buf) = xnmalloc (nitems, sizeof *(buf) * (multiplier)); \
sa_must_free = 1; \
- record_unwind_protect (safe_alloca_unwind, \
- make_save_pointer (buf)); \
+ record_unwind_protect_ptr (xfree, buf); \
} \
} while (0)
@@ -4384,9 +4394,9 @@ extern void *record_xmalloc (size_t);
{ \
Lisp_Object arg_; \
buf = xmalloc ((nelt) * word_size); \
- arg_ = make_save_value (SAVE_TYPE_MEMORY, buf, nelt); \
+ arg_ = make_save_memory (buf, nelt); \
sa_must_free = 1; \
- record_unwind_protect (safe_alloca_unwind, arg_); \
+ record_unwind_protect (free_save_value, arg_); \
} \
else \
memory_full (SIZE_MAX); \
diff --git a/src/lread.c b/src/lread.c
index f0423f166dd..57c7df74127 100644
--- a/src/lread.c
+++ b/src/lread.c
@@ -145,7 +145,6 @@ static int read_emacs_mule_char (int, int (*) (int, Lisp_Object),
static void readevalloop (Lisp_Object, FILE *, Lisp_Object, bool,
Lisp_Object, Lisp_Object,
Lisp_Object, Lisp_Object);
-static Lisp_Object load_unwind (Lisp_Object);
/* Functions that read one byte from the current source READCHARFUN
or unreads one byte. If the integer argument C is -1, it returns
@@ -562,7 +561,7 @@ read_emacs_mule_char (int c, int (*readbyte) (int, Lisp_Object), Lisp_Object rea
c = DECODE_CHAR (charset, code);
if (c < 0)
Fsignal (Qinvalid_read_syntax,
- Fcons (build_string ("invalid multibyte form"), Qnil));
+ list1 (build_string ("invalid multibyte form")));
return c;
}
@@ -672,7 +671,7 @@ read_filtered_event (bool no_switch_frame, bool ascii_required,
{
if (error_nonascii)
{
- Vunread_command_events = Fcons (val, Qnil);
+ Vunread_command_events = list1 (val);
error ("Non-character input-event");
}
else
@@ -952,10 +951,10 @@ safe_to_load_version (int fd)
/* Callback for record_unwind_protect. Restore the old load list OLD,
after loading a file successfully. */
-static Lisp_Object
+static void
record_load_unwind (Lisp_Object old)
{
- return Vloads_in_progress = old;
+ Vloads_in_progress = old;
}
/* This handler function is used via internal_condition_case_1. */
@@ -966,7 +965,7 @@ load_error_handler (Lisp_Object data)
return Qnil;
}
-static Lisp_Object
+static void
load_warn_old_style_backquotes (Lisp_Object file)
{
if (!NILP (Vold_style_backquotes))
@@ -976,7 +975,6 @@ load_warn_old_style_backquotes (Lisp_Object file)
args[1] = file;
Fmessage (2, args);
}
- return Qnil;
}
DEFUN ("get-load-suffixes", Fget_load_suffixes, Sget_load_suffixes, 0, 0, 0,
@@ -1041,10 +1039,12 @@ While the file is in the process of being loaded, the variable
is bound to the file's name.
Return t if the file exists and loads successfully. */)
- (Lisp_Object file, Lisp_Object noerror, Lisp_Object nomessage, Lisp_Object nosuffix, Lisp_Object must_suffix)
+ (Lisp_Object file, Lisp_Object noerror, Lisp_Object nomessage,
+ Lisp_Object nosuffix, Lisp_Object must_suffix)
{
- register FILE *stream;
- register int fd = -1;
+ FILE *stream;
+ int fd;
+ int fd_index;
ptrdiff_t count = SPECPDL_INDEX ();
struct gcpro gcpro1, gcpro2, gcpro3;
Lisp_Object found, efound, hist_file_name;
@@ -1055,7 +1055,6 @@ Return t if the file exists and loads successfully. */)
Lisp_Object handler;
bool safe_p = 1;
const char *fmode = "r";
- Lisp_Object tmp[2];
int version;
#ifdef DOS_NT
@@ -1088,19 +1087,23 @@ Return t if the file exists and loads successfully. */)
else
file = Fsubstitute_in_file_name (file);
-
/* Avoid weird lossage with null string as arg,
since it would try to load a directory as a Lisp file. */
- if (SBYTES (file) > 0)
+ if (SCHARS (file) == 0)
{
- ptrdiff_t size = SBYTES (file);
-
+ fd = -1;
+ errno = ENOENT;
+ }
+ else
+ {
+ Lisp_Object suffixes;
found = Qnil;
GCPRO2 (file, found);
if (! NILP (must_suffix))
{
/* Don't insist on adding a suffix if FILE already ends with one. */
+ ptrdiff_t size = SBYTES (file);
if (size > 3
&& !strcmp (SSDATA (file) + size - 3, ".el"))
must_suffix = Qnil;
@@ -1113,20 +1116,28 @@ Return t if the file exists and loads successfully. */)
must_suffix = Qnil;
}
- fd = openp (Vload_path, file,
- (!NILP (nosuffix) ? Qnil
- : !NILP (must_suffix) ? Fget_load_suffixes ()
- : Fappend (2, (tmp[0] = Fget_load_suffixes (),
- tmp[1] = Vload_file_rep_suffixes,
- tmp))),
- &found, Qnil);
+ if (!NILP (nosuffix))
+ suffixes = Qnil;
+ else
+ {
+ suffixes = Fget_load_suffixes ();
+ if (NILP (must_suffix))
+ {
+ Lisp_Object arg[2];
+ arg[0] = suffixes;
+ arg[1] = Vload_file_rep_suffixes;
+ suffixes = Fappend (2, arg);
+ }
+ }
+
+ fd = openp (Vload_path, file, suffixes, &found, Qnil);
UNGCPRO;
}
if (fd == -1)
{
if (NILP (noerror))
- xsignal2 (Qfile_error, build_string ("Cannot open load file"), file);
+ report_file_error ("Cannot open load file", file);
return Qnil;
}
@@ -1164,6 +1175,17 @@ Return t if the file exists and loads successfully. */)
#endif
}
+ if (fd < 0)
+ {
+ /* Pacify older GCC with --enable-gcc-warnings. */
+ IF_LINT (fd_index = 0);
+ }
+ else
+ {
+ fd_index = SPECPDL_INDEX ();
+ record_unwind_protect_int (close_file_unwind, fd);
+ }
+
/* Check if we're stuck in a recursive load cycle.
2000-09-21: It's not possible to just check for the file loaded
@@ -1179,11 +1201,7 @@ Return t if the file exists and loads successfully. */)
Lisp_Object tem;
for (tem = Vloads_in_progress; CONSP (tem); tem = XCDR (tem))
if (!NILP (Fequal (found, XCAR (tem))) && (++load_count > 3))
- {
- if (fd >= 0)
- emacs_close (fd);
- signal_error ("Recursive load", Fcons (found, Vloads_in_progress));
- }
+ signal_error ("Recursive load", Fcons (found, Vloads_in_progress));
record_unwind_protect (record_load_unwind, Vloads_in_progress);
Vloads_in_progress = Fcons (found, Vloads_in_progress);
}
@@ -1196,9 +1214,8 @@ Return t if the file exists and loads successfully. */)
/* Get the name for load-history. */
hist_file_name = (! NILP (Vpurify_flag)
- ? Fconcat (2, (tmp[0] = Ffile_name_directory (file),
- tmp[1] = Ffile_name_nondirectory (found),
- tmp))
+ ? concat2 (Ffile_name_directory (file),
+ Ffile_name_nondirectory (found))
: found) ;
version = -1;
@@ -1224,12 +1241,7 @@ Return t if the file exists and loads successfully. */)
{
safe_p = 0;
if (!load_dangerous_libraries)
- {
- if (fd >= 0)
- emacs_close (fd);
- error ("File `%s' was not compiled in Emacs",
- SDATA (found));
- }
+ error ("File `%s' was not compiled in Emacs", SDATA (found));
else if (!NILP (nomessage) && !force_load_messages)
message_with_string ("File `%s' not compiled in Emacs", found, 1);
}
@@ -1275,7 +1287,10 @@ Return t if the file exists and loads successfully. */)
Lisp_Object val;
if (fd >= 0)
- emacs_close (fd);
+ {
+ emacs_close (fd);
+ clear_unwind_protect (fd_index);
+ }
val = call4 (Vload_source_file_function, found, hist_file_name,
NILP (noerror) ? Qnil : Qt,
(NILP (nomessage) || force_load_messages) ? Qnil : Qt);
@@ -1285,26 +1300,28 @@ Return t if the file exists and loads successfully. */)
GCPRO3 (file, found, hist_file_name);
-#ifdef WINDOWSNT
- efound = ENCODE_FILE (found);
- /* If we somehow got here with fd == -2, meaning the file is deemed
- to be remote, don't even try to reopen the file locally; just
- force a failure instead. */
- if (fd >= 0)
+ if (fd < 0)
{
- emacs_close (fd);
- stream = emacs_fopen (SSDATA (efound), fmode);
+ /* We somehow got here with fd == -2, meaning the file is deemed
+ to be remote. Don't even try to reopen the file locally;
+ just force a failure. */
+ stream = NULL;
+ errno = EINVAL;
}
else
- stream = NULL;
-#else /* not WINDOWSNT */
- stream = fdopen (fd, fmode);
-#endif /* not WINDOWSNT */
- if (stream == 0)
{
+#ifdef WINDOWSNT
emacs_close (fd);
- error ("Failure to create stdio stream for %s", SDATA (file));
+ clear_unwind_protect (fd_index);
+ efound = ENCODE_FILE (found);
+ stream = emacs_fopen (SSDATA (efound), fmode);
+#else
+ stream = fdopen (fd, fmode);
+#endif
}
+ if (! stream)
+ report_file_error ("Opening stdio stream", file);
+ set_unwind_protect_ptr (fd_index, fclose_unwind, stream);
if (! NILP (Vpurify_flag))
Vpreloaded_file_list = Fcons (Fpurecopy (file), Vpreloaded_file_list);
@@ -1323,7 +1340,6 @@ Return t if the file exists and loads successfully. */)
message_with_string ("Loading %s...", file, 1);
}
- record_unwind_protect (load_unwind, make_save_pointer (stream));
specbind (Qload_file_name, found);
specbind (Qinhibit_file_name_operation, Qnil);
specbind (Qload_in_progress, Qt);
@@ -1375,19 +1391,6 @@ Return t if the file exists and loads successfully. */)
return Qt;
}
-
-static Lisp_Object
-load_unwind (Lisp_Object arg) /* Used as unwind-protect function in load. */
-{
- FILE *stream = XSAVE_POINTER (arg, 0);
- if (stream != NULL)
- {
- block_input ();
- fclose (stream);
- unblock_input ();
- }
- return Qnil;
-}
static bool
complete_filename_p (Lisp_Object pathname)
@@ -1494,7 +1497,7 @@ openp (Lisp_Object path, Lisp_Object str, Lisp_Object suffixes,
fn = alloca (fn_size = 100 + want_length);
/* Loop over suffixes. */
- for (tail = NILP (suffixes) ? Fcons (empty_unibyte_string, Qnil) : suffixes;
+ for (tail = NILP (suffixes) ? list1 (empty_unibyte_string) : suffixes;
CONSP (tail); tail = XCDR (tail))
{
ptrdiff_t fnlen, lsuffix = SBYTES (XCAR (tail));
@@ -1523,7 +1526,6 @@ openp (Lisp_Object path, Lisp_Object str, Lisp_Object suffixes,
if ((!NILP (handler) || !NILP (predicate)) && !NATNUMP (predicate))
{
bool exists;
- last_errno = ENOENT;
if (NILP (predicate))
exists = !NILP (Ffile_readable_p (string));
else
@@ -1578,7 +1580,10 @@ openp (Lisp_Object path, Lisp_Object str, Lisp_Object suffixes,
{
fd = emacs_open (pfn, O_RDONLY, 0);
if (fd < 0)
- last_errno = errno;
+ {
+ if (errno != ENOENT)
+ last_errno = errno;
+ }
else
{
struct stat st;
@@ -1682,11 +1687,10 @@ build_load_history (Lisp_Object filename, bool entire)
Vload_history);
}
-static Lisp_Object
-readevalloop_1 (Lisp_Object old)
+static void
+readevalloop_1 (int old)
{
- load_convert_to_unibyte = ! NILP (old);
- return Qnil;
+ load_convert_to_unibyte = old;
}
/* Signal an `end-of-file' error, if possible with file name
@@ -1756,7 +1760,7 @@ readevalloop (Lisp_Object readcharfun,
specbind (Qstandard_input, readcharfun); /* GCPROs readcharfun. */
specbind (Qcurrent_load_list, Qnil);
- record_unwind_protect (readevalloop_1, load_convert_to_unibyte ? Qt : Qnil);
+ record_unwind_protect_int (readevalloop_1, load_convert_to_unibyte);
load_convert_to_unibyte = !NILP (unibyte);
/* If lexical binding is active (either because it was specified in
@@ -1764,8 +1768,8 @@ readevalloop (Lisp_Object readcharfun,
lexical environment, otherwise, turn off lexical binding. */
lex_bound = find_symbol_value (Qlexical_binding);
specbind (Qinternal_interpreter_environment,
- NILP (lex_bound) || EQ (lex_bound, Qunbound)
- ? Qnil : Fcons (Qt, Qnil));
+ (NILP (lex_bound) || EQ (lex_bound, Qunbound)
+ ? Qnil : list1 (Qt)));
GCPRO4 (sourcename, readfun, start, end);
@@ -2724,7 +2728,7 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list)
if (c == '$')
return Vload_file_name;
if (c == '\'')
- return Fcons (Qfunction, Fcons (read0 (readcharfun), Qnil));
+ return list2 (Qfunction, read0 (readcharfun));
/* #:foo is the uninterned symbol named foo. */
if (c == ':')
{
@@ -2819,9 +2823,7 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list)
goto retry;
case '\'':
- {
- return Fcons (Qquote, Fcons (read0 (readcharfun), Qnil));
- }
+ return list2 (Qquote, read0 (readcharfun));
case '`':
{
@@ -2851,7 +2853,7 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list)
value = read0 (readcharfun);
new_backquote_flag = saved_new_backquote_flag;
- return Fcons (Qbackquote, Fcons (value, Qnil));
+ return list2 (Qbackquote, value);
}
}
case ',':
@@ -2889,7 +2891,7 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list)
}
value = read0 (readcharfun);
- return Fcons (comma_type, Fcons (value, Qnil));
+ return list2 (comma_type, value);
}
else
{
@@ -3665,7 +3667,7 @@ read_list (bool flag, Lisp_Object readcharfun)
}
invalid_syntax ("] in a list");
}
- tem = Fcons (elt, Qnil);
+ tem = list1 (elt);
if (!NILP (tail))
XSETCDR (tail, tem);
else
@@ -4232,7 +4234,7 @@ init_lread (void)
points to the eventual installed lisp, leim
directories. We should not use those now, even
if they exist, so start over from a clean slate. */
- Vload_path = Fcons (tem, Qnil);
+ Vload_path = list1 (tem);
}
}
else
@@ -4459,8 +4461,8 @@ otherwise to default specified by file `epaths.h' when Emacs was built. */);
This list should not include the empty string.
`load' and related functions try to append these suffixes, in order,
to the specified file name if a Lisp suffix is allowed or required. */);
- Vload_suffixes = Fcons (build_pure_c_string (".elc"),
- Fcons (build_pure_c_string (".el"), Qnil));
+ Vload_suffixes = list2 (build_pure_c_string (".elc"),
+ build_pure_c_string (".el"));
DEFVAR_LISP ("load-file-rep-suffixes", Vload_file_rep_suffixes,
doc: /* List of suffixes that indicate representations of \
the same file.
@@ -4474,7 +4476,7 @@ and, if so, which suffixes they should try to append to the file name
in order to do so. However, if you want to customize which suffixes
the loading functions recognize as compression suffixes, you should
customize `jka-compr-load-suffixes' rather than the present variable. */);
- Vload_file_rep_suffixes = Fcons (empty_unibyte_string, Qnil);
+ Vload_file_rep_suffixes = list1 (empty_unibyte_string);
DEFVAR_BOOL ("load-in-progress", load_in_progress,
doc: /* Non-nil if inside of `load'. */);
diff --git a/src/macros.c b/src/macros.c
index 48d23a977b1..0c11efcdc9a 100644
--- a/src/macros.c
+++ b/src/macros.c
@@ -279,7 +279,7 @@ each iteration of the macro. Iteration stops if LOOPFUNC returns nil. */)
/* Restore Vexecuting_kbd_macro and executing_kbd_macro_index.
Called when the unwind-protect in Fexecute_kbd_macro gets invoked. */
-static Lisp_Object
+static void
pop_kbd_macro (Lisp_Object info)
{
Lisp_Object tem;
@@ -288,7 +288,6 @@ pop_kbd_macro (Lisp_Object info)
executing_kbd_macro_index = XINT (XCAR (tem));
Vreal_this_command = XCDR (tem);
Frun_hooks (1, &Qkbd_macro_termination_hook);
- return Qnil;
}
DEFUN ("execute-kbd-macro", Fexecute_kbd_macro, Sexecute_kbd_macro, 1, 3, 0,
diff --git a/src/menu.c b/src/menu.c
index 58558d5aedd..6b4a22d3052 100644
--- a/src/menu.c
+++ b/src/menu.c
@@ -102,10 +102,10 @@ finish_menu_items (void)
{
}
-Lisp_Object
-unuse_menu_items (Lisp_Object dummy)
+void
+unuse_menu_items (void)
{
- return menu_items_inuse = Qnil;
+ menu_items_inuse = Qnil;
}
/* Call when finished using the data for the current menu
@@ -124,19 +124,10 @@ discard_menu_items (void)
eassert (NILP (menu_items_inuse));
}
-#ifdef HAVE_NS
-static Lisp_Object
-cleanup_popup_menu (Lisp_Object arg)
-{
- discard_menu_items ();
- return Qnil;
-}
-#endif
-
/* This undoes save_menu_items, and it is called by the specpdl unwind
mechanism. */
-static Lisp_Object
+static void
restore_menu_items (Lisp_Object saved)
{
menu_items = XCAR (saved);
@@ -148,7 +139,6 @@ restore_menu_items (Lisp_Object saved)
menu_items_n_panes = XINT (XCAR (saved));
saved = XCDR (saved);
menu_items_submenu_depth = XINT (XCAR (saved));
- return Qnil;
}
/* Push the whole state of menu_items processing onto the specpdl.
@@ -1004,7 +994,7 @@ find_and_return_menu_selection (FRAME_PTR f, bool keymaps, void *client_data)
{
int j;
- entry = Fcons (entry, Qnil);
+ entry = list1 (entry);
if (!NILP (prefix))
entry = Fcons (prefix, entry);
for (j = submenu_depth - 1; j >= 0; j--)
@@ -1213,7 +1203,7 @@ no quit occurs and `x-popup-menu' returns nil. */)
#endif /* HAVE_MENUS */
/* Now parse the lisp menus. */
- record_unwind_protect (unuse_menu_items, Qnil);
+ record_unwind_protect_void (unuse_menu_items);
title = Qnil;
GCPRO1 (title);
@@ -1315,7 +1305,7 @@ no quit occurs and `x-popup-menu' returns nil. */)
#endif
#ifdef HAVE_NS /* FIXME: ns-specific, why? --Stef */
- record_unwind_protect (cleanup_popup_menu, Qnil);
+ record_unwind_protect_void (discard_menu_items);
#endif
/* Display them in a menu. */
diff --git a/src/minibuf.c b/src/minibuf.c
index b69a16eff42..2c33b83c11b 100644
--- a/src/minibuf.c
+++ b/src/minibuf.c
@@ -137,13 +137,6 @@ choose_minibuf_frame (void)
}
}
-static Lisp_Object
-choose_minibuf_frame_1 (Lisp_Object ignore)
-{
- choose_minibuf_frame ();
- return Qnil;
-}
-
DEFUN ("active-minibuffer-window", Factive_minibuffer_window,
Sactive_minibuffer_window, 0, 0, 0,
doc: /* Return the currently active minibuffer window, or nil if none. */)
@@ -171,8 +164,8 @@ without invoking the usual minibuffer commands. */)
/* Actual minibuffer invocation. */
-static Lisp_Object read_minibuf_unwind (Lisp_Object);
-static Lisp_Object run_exit_minibuf_hook (Lisp_Object);
+static void read_minibuf_unwind (void);
+static void run_exit_minibuf_hook (void);
/* Read a Lisp object from VAL and return it. If VAL is an empty
@@ -474,20 +467,20 @@ read_minibuf (Lisp_Object map, Lisp_Object initial, Lisp_Object prompt,
/* Prepare for restoring the current buffer since choose_minibuf_frame
calling Fset_frame_selected_window may change it (Bug#12766). */
- record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
+ record_unwind_protect (restore_buffer, Fcurrent_buffer ());
choose_minibuf_frame ();
- record_unwind_protect (choose_minibuf_frame_1, Qnil);
+ record_unwind_protect_void (choose_minibuf_frame);
- record_unwind_protect (Fset_window_configuration,
+ record_unwind_protect (restore_window_configuration,
Fcurrent_window_configuration (Qnil));
/* If the minibuffer window is on a different frame, save that
frame's configuration too. */
mini_frame = WINDOW_FRAME (XWINDOW (minibuf_window));
if (!EQ (mini_frame, selected_frame))
- record_unwind_protect (Fset_window_configuration,
+ record_unwind_protect (restore_window_configuration,
Fcurrent_window_configuration (mini_frame));
/* If the minibuffer is on an iconified or invisible frame,
@@ -518,14 +511,14 @@ read_minibuf (Lisp_Object map, Lisp_Object initial, Lisp_Object prompt,
Fcons (Vminibuffer_history_variable,
minibuf_save_list))))));
- record_unwind_protect (read_minibuf_unwind, Qnil);
+ record_unwind_protect_void (read_minibuf_unwind);
minibuf_level++;
/* We are exiting the minibuffer one way or the other, so run the hook.
It should be run before unwinding the minibuf settings. Do it
separately from read_minibuf_unwind because we need to make sure that
read_minibuf_unwind is fully executed even if exit-minibuffer-hook
signals an error. --Stef */
- record_unwind_protect (run_exit_minibuf_hook, Qnil);
+ record_unwind_protect_void (run_exit_minibuf_hook);
/* Now that we can restore all those variables, start changing them. */
@@ -786,7 +779,7 @@ get_minibuffer (EMACS_INT depth)
tail = Fnthcdr (num, Vminibuffer_list);
if (NILP (tail))
{
- tail = Fcons (Qnil, Qnil);
+ tail = list1 (Qnil);
Vminibuffer_list = nconc2 (Vminibuffer_list, tail);
}
buf = Fcar (tail);
@@ -821,18 +814,17 @@ get_minibuffer (EMACS_INT depth)
return buf;
}
-static Lisp_Object
-run_exit_minibuf_hook (Lisp_Object data)
+static void
+run_exit_minibuf_hook (void)
{
safe_run_hooks (Qminibuffer_exit_hook);
- return Qnil;
}
/* This function is called on exiting minibuffer, whether normally or
not, and it restores the current window, buffer, etc. */
-static Lisp_Object
-read_minibuf_unwind (Lisp_Object data)
+static void
+read_minibuf_unwind (void)
{
Lisp_Object old_deactivate_mark;
Lisp_Object window;
@@ -895,7 +887,6 @@ read_minibuf_unwind (Lisp_Object data)
to make sure we don't leave around bindings and stuff which only
made sense during the read_minibuf invocation. */
call0 (intern ("minibuffer-inactive-mode"));
- return Qnil;
}
@@ -1862,7 +1853,7 @@ If FLAG is nil, invoke `try-completion'; if it is t, invoke
else if (EQ (flag, Qlambda))
return Ftest_completion (string, Vbuffer_alist, predicate);
else if (EQ (flag, Qmetadata))
- return Fcons (Qmetadata, Fcons (Fcons (Qcategory, Qbuffer), Qnil));
+ return list2 (Qmetadata, Fcons (Qcategory, Qbuffer));
else
return Qnil;
}
@@ -2106,8 +2097,7 @@ These are in addition to the basic `field' property, and stickiness
properties. */);
/* We use `intern' here instead of Qread_only to avoid
initialization-order problems. */
- Vminibuffer_prompt_properties
- = Fcons (intern_c_string ("read-only"), Fcons (Qt, Qnil));
+ Vminibuffer_prompt_properties = list2 (intern_c_string ("read-only"), Qt);
defsubr (&Sactive_minibuffer_window);
defsubr (&Sset_minibuffer_window);
diff --git a/src/nsfns.m b/src/nsfns.m
index 6eebb4d2567..121ac539646 100644
--- a/src/nsfns.m
+++ b/src/nsfns.m
@@ -981,7 +981,7 @@ frame_parm_handler ns_frame_parm_handlers[] =
/* Handler for signals raised during x_create_frame.
FRAME is the frame which is partially constructed. */
-static Lisp_Object
+static void
unwind_create_frame (Lisp_Object frame)
{
struct frame *f = XFRAME (frame);
@@ -990,7 +990,7 @@ unwind_create_frame (Lisp_Object frame)
display is disconnected after the frame has become official, but
before x_create_frame removes the unwind protect. */
if (!FRAME_LIVE_P (f))
- return Qnil;
+ return;
/* If frame is ``official'', nothing to do. */
if (NILP (Fmemq (frame, Vframe_list)))
@@ -1006,10 +1006,7 @@ unwind_create_frame (Lisp_Object frame)
/* Check that reference counts are indeed correct. */
eassert (dpyinfo->terminal->image_cache->refcount == image_cache_refcount);
#endif
- return Qt;
}
-
- return Qnil;
}
/*
@@ -2022,7 +2019,7 @@ there was no result. */)
ns_string_to_pasteboard (pb, send);
if (NSPerformService (svcName, pb) == NO)
- Fsignal (Qquit, Fcons (build_string ("service not available"), Qnil));
+ Fsignal (Qquit, list1 (build_string ("service not available")));
if ([[pb types] count] == 0)
return build_string ("");
@@ -2878,7 +2875,7 @@ Example: Install an icon Gnus.tiff and execute the following code
When you miniaturize a Group, Summary or Article frame, Gnus.tiff will
be used as the image of the icon representing the frame. */);
- Vns_icon_type_alist = Fcons (Qt, Qnil);
+ Vns_icon_type_alist = list1 (Qt);
DEFVAR_LISP ("ns-version-string", Vns_version_string,
doc: /* Toolkit version for NS Windowing. */);
diff --git a/src/nsfont.m b/src/nsfont.m
index a657d01dbe4..df7ef0bb0bc 100644
--- a/src/nsfont.m
+++ b/src/nsfont.m
@@ -446,7 +446,7 @@ static NSCharacterSet
{
Lisp_Object ranges, range_list;
- ranges = Fcons (script, Qnil);
+ ranges = list1 (script);
map_char_table (accumulate_script_ranges, Qnil, Vchar_script_table,
ranges);
range_list = Fnreverse (XCDR (ranges));
diff --git a/src/nsmenu.m b/src/nsmenu.m
index 22635dca0a2..02fe0b04ca0 100644
--- a/src/nsmenu.m
+++ b/src/nsmenu.m
@@ -1410,10 +1410,10 @@ struct Popdown_data
EmacsDialogPanel *dialog;
};
-static Lisp_Object
-pop_down_menu (Lisp_Object arg)
+static void
+pop_down_menu (void *arg)
{
- struct Popdown_data *unwind_data = XSAVE_POINTER (arg, 0);
+ struct Popdown_data *unwind_data = arg;
block_input ();
if (popup_activated_flag)
@@ -1427,8 +1427,6 @@ pop_down_menu (Lisp_Object arg)
xfree (unwind_data);
unblock_input ();
-
- return Qnil;
}
@@ -1492,7 +1490,7 @@ ns_popup_dialog (Lisp_Object position, Lisp_Object contents, Lisp_Object header)
if (NILP (Fcar (Fcdr (contents))))
/* No buttons specified, add an "Ok" button so users can pop down
the dialog. */
- contents = Fcons (title, Fcons (Fcons (build_string ("Ok"), Qt), Qnil));
+ contents = list2 (title, Fcons (build_string ("Ok"), Qt));
block_input ();
pool = [[NSAutoreleasePool alloc] init];
@@ -1506,7 +1504,7 @@ ns_popup_dialog (Lisp_Object position, Lisp_Object contents, Lisp_Object header)
unwind_data->pool = pool;
unwind_data->dialog = dialog;
- record_unwind_protect (pop_down_menu, make_save_pointer (unwind_data));
+ record_unwind_protect_ptr (pop_down_menu, unwind_data);
popup_activated_flag = 1;
tem = [dialog runDialogAt: p];
unbind_to (specpdl_count, Qnil); /* calls pop_down_menu */
diff --git a/src/nsselect.m b/src/nsselect.m
index 6053ee9ceb2..d95ff799877 100644
--- a/src/nsselect.m
+++ b/src/nsselect.m
@@ -219,9 +219,10 @@ ns_get_local_selection (Lisp_Object selection_name,
return value;
// FIXME: Why `quit' rather than `error'?
- Fsignal (Qquit, Fcons (build_string (
- "invalid data returned by selection-conversion function"),
- Fcons (handler_fn, Fcons (value, Qnil))));
+ Fsignal (Qquit,
+ list3 (build_string ("invalid data returned by"
+ " selection-conversion function"),
+ handler_fn, value));
// FIXME: Beware, `quit' can return!!
return Qnil;
}
@@ -256,8 +257,7 @@ ns_string_from_pasteboard (id pb)
if (type == nil)
{
Fsignal (Qquit,
- Fcons (build_string ("empty or unsupported pasteboard type"),
- Qnil));
+ list1 (build_string ("empty or unsupported pasteboard type")));
return Qnil;
}
@@ -275,8 +275,8 @@ ns_string_from_pasteboard (id pb)
else
{
Fsignal (Qquit,
- Fcons (build_string ("pasteboard doesn't contain valid data"),
- Qnil));
+ list1 (build_string ("pasteboard doesn't contain"
+ " valid data")));
return Qnil;
}
}
@@ -362,7 +362,7 @@ On Nextstep, FRAME is unused. */)
ns_declare_pasteboard (pb);
old_value = assq_no_quit (selection, Vselection_alist);
- new_value = Fcons (selection, Fcons (value, Qnil));
+ new_value = list2 (selection, value);
if (NILP (old_value))
Vselection_alist = Fcons (new_value, Vselection_alist);
diff --git a/src/nsterm.m b/src/nsterm.m
index d7cea5c189a..61538798337 100644
--- a/src/nsterm.m
+++ b/src/nsterm.m
@@ -362,7 +362,7 @@ append2 (Lisp_Object list, Lisp_Object item)
{
Lisp_Object array[2];
array[0] = list;
- array[1] = Fcons (item, Qnil);
+ array[1] = list1 (item);
return Fnconc (2, &array[0]);
}
@@ -3777,7 +3777,7 @@ ns_set_vertical_scroll_bar (struct window *window,
}
bar = [[EmacsScroller alloc] initFrame: r window: win];
- wset_vertical_scroll_bar (window, make_save_pointer (bar));
+ wset_vertical_scroll_bar (window, make_save_ptr (bar));
}
else
{
@@ -4142,7 +4142,7 @@ ns_term_init (Lisp_Object display_name)
if (selfds[0] == -1)
{
- if (pipe2 (selfds, O_CLOEXEC) != 0)
+ if (emacs_pipe (selfds) != 0)
{
fprintf (stderr, "Failed to create pipe: %s\n",
emacs_strerror (errno));
@@ -4416,6 +4416,7 @@ ns_term_shutdown (int sig)
{
int type = [theEvent type];
NSWindow *window = [theEvent window];
+
/* NSTRACE (sendEvent); */
/*fprintf (stderr, "received event of type %d\t%d\n", type);*/
@@ -4469,6 +4470,23 @@ ns_term_shutdown (int sig)
}
}
+
+#ifdef NS_IMPL_COCOA
+ /* If no dialog and none of our frames have focus and it is a move, skip it.
+ It is a mouse move in an auxillary menu, i.e. on the top right on OSX,
+ such as Wifi, sound, date or similar.
+ This prevents "spooky" highlightning in the frame under the menu. */
+ if (type == NSMouseMoved && [NSApp modalWindow] == nil)
+ {
+ struct ns_display_info *di;
+ BOOL has_focus = NO;
+ for (di = x_display_list; ! has_focus && di; di = di->next)
+ has_focus = di->x_focus_frame != 0;
+ if (! has_focus)
+ return;
+ }
+#endif
+
[super sendEvent: theEvent];
}
@@ -5746,9 +5764,10 @@ not_in_argv (NSString *arg)
/* cf. x_detect_focus_change(), x_focus_changed(), x_new_focus_frame() */
{
struct ns_display_info *dpyinfo = FRAME_NS_DISPLAY_INFO (emacsframe);
+ BOOL is_focus_frame = dpyinfo->x_focus_frame == emacsframe;
NSTRACE (windowDidResignKey);
- if (dpyinfo->x_focus_frame == emacsframe)
+ if (is_focus_frame)
dpyinfo->x_focus_frame = 0;
ns_frame_rehighlight (emacsframe);
@@ -5761,10 +5780,10 @@ not_in_argv (NSString *arg)
x_set_frame_alpha (emacsframe);
}
- if (emacs_event)
+ if (emacs_event && is_focus_frame)
{
[self deleteWorkingText];
- emacs_event->kind = FOCUS_IN_EVENT;
+ emacs_event->kind = FOCUS_OUT_EVENT;
EV_TRAILER ((id)nil);
}
}
diff --git a/src/print.c b/src/print.c
index 01e490dcbad..ec14b7be93c 100644
--- a/src/print.c
+++ b/src/print.c
@@ -199,11 +199,10 @@ bool print_output_debug_flag EXTERNALLY_VISIBLE = 1;
/* This is used to restore the saved contents of print_buffer
when there is a recursive call to print. */
-static Lisp_Object
+static void
print_unwind (Lisp_Object saved_text)
{
memcpy (print_buffer, SDATA (saved_text), SCHARS (saved_text));
- return Qnil;
}
@@ -770,8 +769,7 @@ append to existing target file. */)
{
stderr = initial_stderr_stream;
initial_stderr_stream = NULL;
- report_file_error ("Cannot open debugging output stream",
- Fcons (file, Qnil));
+ report_file_error ("Cannot open debugging output stream", file);
}
}
return Qnil;
@@ -1301,7 +1299,7 @@ print_prune_string_charset (Lisp_Object string)
if (print_check_string_result & PRINT_STRING_NON_CHARSET_FOUND)
{
if (NILP (print_prune_charset_plist))
- print_prune_charset_plist = Fcons (Qcharset, Qnil);
+ print_prune_charset_plist = list1 (Qcharset);
Fremove_text_properties (make_number (0),
make_number (SCHARS (string)),
print_prune_charset_plist, string);
diff --git a/src/process.c b/src/process.c
index dc37bfe7067..33d8ccbbc35 100644
--- a/src/process.c
+++ b/src/process.c
@@ -785,19 +785,16 @@ status_message (struct Lisp_Process *p)
return Fcopy_sequence (Fsymbol_name (symbol));
}
-#ifdef HAVE_PTYS
-
-/* The file name of the pty opened by allocate_pty. */
-static char pty_name[24];
+enum { PTY_NAME_SIZE = 24 };
/* Open an available pty, returning a file descriptor.
- Return -1 on failure.
- The file name of the terminal corresponding to the pty
- is left in the variable pty_name. */
+ Store into PTY_NAME the file name of the terminal corresponding to the pty.
+ Return -1 on failure. */
static int
-allocate_pty (void)
+allocate_pty (char pty_name[PTY_NAME_SIZE])
{
+#ifdef HAVE_PTYS
int fd;
#ifdef PTY_ITERATION
@@ -842,9 +839,9 @@ allocate_pty (void)
return fd;
}
}
+#endif /* HAVE_PTYS */
return -1;
}
-#endif /* HAVE_PTYS */
static Lisp_Object
make_process (Lisp_Object name)
@@ -1008,7 +1005,7 @@ nil, indicating the current buffer's process. */)
p->raw_status_new = 0;
if (NETCONN1_P (p) || SERIALCONN1_P (p))
{
- pset_status (p, Fcons (Qexit, Fcons (make_number (0), Qnil)));
+ pset_status (p, list2 (Qexit, make_number (0)));
p->tick = ++process_tick;
status_notify (p);
redisplay_preserve_echo_area (13);
@@ -1403,11 +1400,11 @@ list of keywords. */)
if ((!NETCONN_P (process) && !SERIALCONN_P (process)) || EQ (key, Qt))
return contact;
if (NILP (key) && NETCONN_P (process))
- return Fcons (Fplist_get (contact, QChost),
- Fcons (Fplist_get (contact, QCservice), Qnil));
+ return list2 (Fplist_get (contact, QChost),
+ Fplist_get (contact, QCservice));
if (NILP (key) && SERIALCONN_P (process))
- return Fcons (Fplist_get (contact, QCport),
- Fcons (Fplist_get (contact, QCspeed), Qnil));
+ return list2 (Fplist_get (contact, QCport),
+ Fplist_get (contact, QCspeed));
return Fplist_get (contact, key);
}
@@ -1530,7 +1527,7 @@ Returns nil if format of ADDRESS is invalid. */)
}
DEFUN ("process-list", Fprocess_list, Sprocess_list, 0, 0, 0,
- doc: /* Return a list of all processes. */)
+ doc: /* Return a list of all processes that are Emacs sub-processes. */)
(void)
{
return Fmapcar (Qcdr, Vprocess_alist);
@@ -1538,7 +1535,7 @@ DEFUN ("process-list", Fprocess_list, Sprocess_list, 0, 0, 0,
/* Starting asynchronous inferior processes. */
-static Lisp_Object start_process_unwind (Lisp_Object proc);
+static void start_process_unwind (Lisp_Object proc);
DEFUN ("start-process", Fstart_process, Sstart_process, 3, MANY, 0,
doc: /* Start a program in a subprocess. Return the process object for it.
@@ -1594,7 +1591,7 @@ usage: (start-process NAME BUFFER PROGRAM &rest PROGRAM-ARGS) */)
current_dir = expand_and_dir_to_file (current_dir, Qnil);
if (NILP (Ffile_accessible_directory_p (current_dir)))
report_file_error ("Setting current directory",
- Fcons (BVAR (current_buffer, directory), Qnil));
+ BVAR (current_buffer, directory));
UNGCPRO;
}
@@ -1716,7 +1713,7 @@ usage: (start-process NAME BUFFER PROGRAM &rest PROGRAM-ARGS) */)
openp (Vexec_path, program, Vexec_suffixes, &tem, make_number (X_OK));
UNGCPRO;
if (NILP (tem))
- report_file_error ("Searching for program", Fcons (program, Qnil));
+ report_file_error ("Searching for program", program);
tem = Fexpand_file_name (tem, Qnil);
}
else
@@ -1739,7 +1736,7 @@ usage: (start-process NAME BUFFER PROGRAM &rest PROGRAM-ARGS) */)
/* Encode the file name and put it in NEW_ARGV.
That's where the child will use it to execute the program. */
- tem = Fcons (ENCODE_FILE (tem), Qnil);
+ tem = list1 (ENCODE_FILE (tem));
/* Here we encode arguments by the coding system used for sending
data to the process. We don't support using different coding
@@ -1787,7 +1784,7 @@ usage: (start-process NAME BUFFER PROGRAM &rest PROGRAM-ARGS) */)
PROC doesn't have its pid set, then we know someone has signaled
an error and the process wasn't started successfully, so we should
remove it from the process list. */
-static Lisp_Object
+static void
start_process_unwind (Lisp_Object proc)
{
if (!PROCESSP (proc))
@@ -1797,14 +1794,6 @@ start_process_unwind (Lisp_Object proc)
-2 is used for a pty with no process, eg for gdb. */
if (XPROCESS (proc)->pid <= 0 && XPROCESS (proc)->pid != -2)
remove_process (proc);
-
- return Qnil;
-}
-
-static void
-create_process_1 (struct atimer *timer)
-{
- /* Nothing to do. */
}
@@ -1820,14 +1809,14 @@ create_process (Lisp_Object process, char **new_argv, Lisp_Object current_dir)
#endif
int forkin, forkout;
bool pty_flag = 0;
+ char pty_name[PTY_NAME_SIZE];
Lisp_Object lisp_pty_name = Qnil;
Lisp_Object encoded_current_dir;
inchannel = outchannel = -1;
-#ifdef HAVE_PTYS
if (!NILP (Vprocess_connection_type))
- outchannel = inchannel = allocate_pty ();
+ outchannel = inchannel = allocate_pty (pty_name);
if (inchannel >= 0)
{
@@ -1846,13 +1835,12 @@ create_process (Lisp_Object process, char **new_argv, Lisp_Object current_dir)
lisp_pty_name = build_string (pty_name);
}
else
-#endif /* HAVE_PTYS */
{
- if (pipe2 (sv, O_CLOEXEC) != 0)
+ if (emacs_pipe (sv) != 0)
report_file_error ("Creating pipe", Qnil);
inchannel = sv[0];
forkout = sv[1];
- if (pipe2 (sv, O_CLOEXEC) != 0)
+ if (emacs_pipe (sv) != 0)
{
int pipe_errno = errno;
emacs_close (inchannel);
@@ -1864,7 +1852,7 @@ create_process (Lisp_Object process, char **new_argv, Lisp_Object current_dir)
}
#ifndef WINDOWSNT
- if (pipe2 (wait_child_setup, O_CLOEXEC) != 0)
+ if (emacs_pipe (wait_child_setup) != 0)
report_file_error ("Creating pipe", Qnil);
#endif
@@ -1900,7 +1888,6 @@ create_process (Lisp_Object process, char **new_argv, Lisp_Object current_dir)
Lisp_Object volatile encoded_current_dir_volatile = encoded_current_dir;
Lisp_Object volatile lisp_pty_name_volatile = lisp_pty_name;
Lisp_Object volatile process_volatile = process;
- bool volatile pty_flag_volatile = pty_flag;
char **volatile new_argv_volatile = new_argv;
int volatile forkin_volatile = forkin;
int volatile forkout_volatile = forkout;
@@ -1912,12 +1899,13 @@ create_process (Lisp_Object process, char **new_argv, Lisp_Object current_dir)
encoded_current_dir = encoded_current_dir_volatile;
lisp_pty_name = lisp_pty_name_volatile;
process = process_volatile;
- pty_flag = pty_flag_volatile;
new_argv = new_argv_volatile;
forkin = forkin_volatile;
forkout = forkout_volatile;
wait_child_setup[0] = wait_child_setup_0_volatile;
wait_child_setup[1] = wait_child_setup_1_volatile;
+
+ pty_flag = XPROCESS (process)->pty_flag;
}
if (pid == 0)
@@ -1987,15 +1975,15 @@ create_process (Lisp_Object process, char **new_argv, Lisp_Object current_dir)
if (pty_flag)
{
- /* I wonder if emacs_close (emacs_open (pty_name, ...))
+ /* I wonder if emacs_close (emacs_open (SSDATA (lisp_pty_name), ...))
would work? */
if (xforkin >= 0)
emacs_close (xforkin);
- xforkout = xforkin = emacs_open (pty_name, O_RDWR, 0);
+ xforkout = xforkin = emacs_open (SSDATA (lisp_pty_name), O_RDWR, 0);
if (xforkin < 0)
{
- emacs_perror (pty_name);
+ emacs_perror (SSDATA (lisp_pty_name));
_exit (EXIT_CANCELED);
}
@@ -2025,7 +2013,6 @@ create_process (Lisp_Object process, char **new_argv, Lisp_Object current_dir)
pid = child_setup (xforkin, xforkout, xforkout,
new_argv, 1, encoded_current_dir);
#else /* not WINDOWSNT */
- emacs_close (wait_child_setup[0]);
child_setup (xforkin, xforkout, xforkout,
new_argv, 1, encoded_current_dir);
#endif /* not WINDOWSNT */
@@ -2042,14 +2029,13 @@ create_process (Lisp_Object process, char **new_argv, Lisp_Object current_dir)
unblock_child_signal ();
unblock_input ();
+ if (forkin >= 0)
+ emacs_close (forkin);
+ if (forkin != forkout && forkout >= 0)
+ emacs_close (forkout);
+
if (pid < 0)
- {
- if (forkin >= 0)
- emacs_close (forkin);
- if (forkin != forkout && forkout >= 0)
- emacs_close (forkout);
- report_file_errno ("Doing vfork", Qnil, vfork_errno);
- }
+ report_file_errno ("Doing vfork", Qnil, vfork_errno);
else
{
/* vfork succeeded. */
@@ -2058,26 +2044,6 @@ create_process (Lisp_Object process, char **new_argv, Lisp_Object current_dir)
register_child (pid, inchannel);
#endif /* WINDOWSNT */
- /* If the subfork execv fails, and it exits,
- this close hangs. I don't know why.
- So have an interrupt jar it loose. */
- {
- struct atimer *timer;
- EMACS_TIME offset = make_emacs_time (1, 0);
-
- stop_polling ();
- timer = start_atimer (ATIMER_RELATIVE, offset, create_process_1, 0);
-
- if (forkin >= 0)
- emacs_close (forkin);
-
- cancel_atimer (timer);
- start_polling ();
- }
-
- if (forkin != forkout && forkout >= 0)
- emacs_close (forkout);
-
pset_tty_name (XPROCESS (process), lisp_pty_name);
#ifndef WINDOWSNT
@@ -2096,17 +2062,16 @@ create_process (Lisp_Object process, char **new_argv, Lisp_Object current_dir)
}
}
-void
+static void
create_pty (Lisp_Object process)
{
+ char pty_name[PTY_NAME_SIZE];
int inchannel, outchannel;
- bool pty_flag = 0;
inchannel = outchannel = -1;
-#ifdef HAVE_PTYS
if (!NILP (Vprocess_connection_type))
- outchannel = inchannel = allocate_pty ();
+ outchannel = inchannel = allocate_pty (pty_name);
if (inchannel >= 0)
{
@@ -2125,37 +2090,29 @@ create_pty (Lisp_Object process)
child_setup_tty (forkout);
#endif /* DONT_REOPEN_PTY */
#endif /* not USG, or USG_SUBTTY_WORKS */
- pty_flag = 1;
- }
-#endif /* HAVE_PTYS */
- fcntl (inchannel, F_SETFL, O_NONBLOCK);
- fcntl (outchannel, F_SETFL, O_NONBLOCK);
+ fcntl (inchannel, F_SETFL, O_NONBLOCK);
+ fcntl (outchannel, F_SETFL, O_NONBLOCK);
- /* Record this as an active process, with its channels.
- As a result, child_setup will close Emacs's side of the pipes. */
- chan_process[inchannel] = process;
- XPROCESS (process)->infd = inchannel;
- XPROCESS (process)->outfd = outchannel;
+ /* Record this as an active process, with its channels.
+ As a result, child_setup will close Emacs's side of the pipes. */
+ chan_process[inchannel] = process;
+ XPROCESS (process)->infd = inchannel;
+ XPROCESS (process)->outfd = outchannel;
- /* Previously we recorded the tty descriptor used in the subprocess.
- It was only used for getting the foreground tty process, so now
- we just reopen the device (see emacs_get_tty_pgrp) as this is
- more portable (see USG_SUBTTY_WORKS above). */
+ /* Previously we recorded the tty descriptor used in the subprocess.
+ It was only used for getting the foreground tty process, so now
+ we just reopen the device (see emacs_get_tty_pgrp) as this is
+ more portable (see USG_SUBTTY_WORKS above). */
- XPROCESS (process)->pty_flag = pty_flag;
- pset_status (XPROCESS (process), Qrun);
- setup_process_coding_systems (process);
+ XPROCESS (process)->pty_flag = 1;
+ pset_status (XPROCESS (process), Qrun);
+ setup_process_coding_systems (process);
- add_process_read_fd (inchannel);
+ pset_tty_name (XPROCESS (process), build_string (pty_name));
+ }
XPROCESS (process)->pid = -2;
-#ifdef HAVE_PTYS
- if (pty_flag)
- pset_tty_name (XPROCESS (process), build_string (pty_name));
- else
-#endif
- pset_tty_name (XPROCESS (process), Qnil);
}
@@ -2515,8 +2472,12 @@ set_socket_option (int s, Lisp_Object opt, Lisp_Object val)
}
if (ret < 0)
- report_file_error ("Cannot set network option",
- Fcons (opt, Fcons (val, Qnil)));
+ {
+ int setsockopt_errno = errno;
+ report_file_errno ("Cannot set network option", list2 (opt, val),
+ setsockopt_errno);
+ }
+
return (1 << sopt->optbit);
}
@@ -2648,16 +2609,6 @@ usage: (serial-process-configure &rest ARGS) */)
return Qnil;
}
-/* Used by make-serial-process to recover from errors. */
-static Lisp_Object
-make_serial_process_unwind (Lisp_Object proc)
-{
- if (!PROCESSP (proc))
- emacs_abort ();
- remove_process (proc);
- return Qnil;
-}
-
DEFUN ("make-serial-process", Fmake_serial_process, Smake_serial_process,
0, MANY, 0,
doc: /* Create and return a serial port process.
@@ -2763,10 +2714,10 @@ usage: (make-serial-process &rest ARGS) */)
CHECK_STRING (name);
proc = make_process (name);
specpdl_count = SPECPDL_INDEX ();
- record_unwind_protect (make_serial_process_unwind, proc);
+ record_unwind_protect (remove_process, proc);
p = XPROCESS (proc);
- fd = serial_open (SSDATA (port));
+ fd = serial_open (port);
p->infd = fd;
p->outfd = fd;
if (fd > max_desc)
@@ -2789,7 +2740,7 @@ usage: (make-serial-process &rest ARGS) */)
p->kill_without_query = 1;
if (tem = Fplist_get (contact, QCstop), !NILP (tem))
pset_command (p, Qt);
- p->pty_flag = 0;
+ eassert (! p->pty_flag);
if (!EQ (p->command, Qt))
add_non_keyboard_read_fd (fd);
@@ -3196,7 +3147,7 @@ usage: (make-network-process &rest ARGS) */)
#ifdef POLL_FOR_INPUT
if (socktype != SOCK_DGRAM)
{
- record_unwind_protect (unwind_stop_other_atimers, Qnil);
+ record_unwind_protect_void (run_all_atimers);
bind_polling_period (10);
}
#endif
@@ -3356,7 +3307,7 @@ usage: (make-network-process &rest ARGS) */)
#endif
/* Make us close S if quit. */
- record_unwind_protect (close_file_unwind, make_number (s));
+ record_unwind_protect_int (close_file_unwind, s);
/* Parse network options in the arg list.
We simply ignore anything which isn't a known option (including other keywords).
@@ -3447,16 +3398,16 @@ usage: (make-network-process &rest ARGS) */)
if (errno == EINTR)
goto retry_select;
else
- report_file_error ("select failed", Qnil);
+ report_file_error ("Failed select", Qnil);
}
eassert (sc > 0);
len = sizeof xerrno;
eassert (FD_ISSET (s, &fdset));
if (getsockopt (s, SOL_SOCKET, SO_ERROR, &xerrno, &len) < 0)
- report_file_error ("getsockopt failed", Qnil);
+ report_file_error ("Failed getsockopt", Qnil);
if (xerrno)
- report_file_errno ("error during connect", Qnil, xerrno);
+ report_file_errno ("Failed connect", Qnil, xerrno);
break;
}
#endif /* !WINDOWSNT */
@@ -3716,10 +3667,13 @@ format; see the description of ADDRESS in `make-network-process'. */)
ptrdiff_t buf_size = 512;
int s;
Lisp_Object res;
+ ptrdiff_t count;
s = socket (AF_INET, SOCK_STREAM | SOCK_CLOEXEC, 0);
if (s < 0)
return Qnil;
+ count = SPECPDL_INDEX ();
+ record_unwind_protect_int (close_file_unwind, s);
do
{
@@ -3735,9 +3689,7 @@ format; see the description of ADDRESS in `make-network-process'. */)
}
while (ifconf.ifc_len == buf_size);
- emacs_close (s);
-
- res = Qnil;
+ res = unbind_to (count, Qnil);
ifreq = ifconf.ifc_req;
while ((char *) ifreq < (char *) ifconf.ifc_req + ifconf.ifc_len)
{
@@ -3862,6 +3814,7 @@ FLAGS is the current flags of the interface. */)
Lisp_Object elt;
int s;
bool any = 0;
+ ptrdiff_t count;
#if (! (defined SIOCGIFHWADDR && defined HAVE_STRUCT_IFREQ_IFR_HWADDR) \
&& defined HAVE_GETIFADDRS && defined LLADDR)
struct ifaddrs *ifap;
@@ -3876,6 +3829,8 @@ FLAGS is the current flags of the interface. */)
s = socket (AF_INET, SOCK_STREAM | SOCK_CLOEXEC, 0);
if (s < 0)
return Qnil;
+ count = SPECPDL_INDEX ();
+ record_unwind_protect_int (close_file_unwind, s);
elt = Qnil;
#if defined (SIOCGIFFLAGS) && defined (HAVE_STRUCT_IFREQ_IFR_FLAGS)
@@ -3992,9 +3947,7 @@ FLAGS is the current flags of the interface. */)
#endif
res = Fcons (elt, res);
- emacs_close (s);
-
- return any ? res : Qnil;
+ return unbind_to (count, any ? res : Qnil);
}
#endif
#endif /* defined (HAVE_NET_IF_H) */
@@ -4164,6 +4117,7 @@ server_accept_connection (Lisp_Object server, int channel)
#endif
} saddr;
socklen_t len = sizeof saddr;
+ ptrdiff_t count;
s = accept4 (channel, &saddr.sa, &len, SOCK_CLOEXEC);
@@ -4186,6 +4140,9 @@ server_accept_connection (Lisp_Object server, int channel)
return;
}
+ count = SPECPDL_INDEX ();
+ record_unwind_protect_int (close_file_unwind, s);
+
connect_counter++;
/* Setup a new process to handle the connection. */
@@ -4302,6 +4259,10 @@ server_accept_connection (Lisp_Object server, int channel)
pset_filter (p, ps->filter);
pset_command (p, Qnil);
p->pid = 0;
+
+ /* Discard the unwind protect for closing S. */
+ specpdl_ptr = specpdl + count;
+
p->infd = s;
p->outfd = s;
pset_status (p, Qrun);
@@ -4338,12 +4299,11 @@ server_accept_connection (Lisp_Object server, int channel)
build_string ("\n")));
}
-static Lisp_Object
-wait_reading_process_output_unwind (Lisp_Object data)
+static void
+wait_reading_process_output_unwind (int data)
{
clear_waiting_thread_info ();
- waiting_for_user_input_p = XINT (data);
- return Qnil;
+ waiting_for_user_input_p = data;
}
/* This is here so breakpoints can be put on it. */
@@ -4425,8 +4385,8 @@ wait_reading_process_output (intmax_t time_limit, int nsecs, int read_kbd,
if (wait_proc != NULL)
wait_channel = wait_proc->infd;
- record_unwind_protect (wait_reading_process_output_unwind,
- make_number (waiting_for_user_input_p));
+ record_unwind_protect_int (wait_reading_process_output_unwind,
+ waiting_for_user_input_p);
waiting_for_user_input_p = read_kbd;
if (time_limit < 0)
@@ -4791,7 +4751,7 @@ wait_reading_process_output (intmax_t time_limit, int nsecs, int read_kbd,
else if (xerrno == EBADF)
emacs_abort ();
else
- error ("select error: %s", emacs_strerror (xerrno));
+ report_file_errno ("Failed select", Qnil, xerrno);
}
if (no_avail)
@@ -5284,9 +5244,7 @@ read_and_dispose_of_process_output (struct Lisp_Process *p, char *chars,
sometimes it's simply wrong to wrap (e.g. when called from
accept-process-output). */
internal_condition_case_1 (read_process_output_call,
- Fcons (outstream,
- Fcons (make_lisp_proc (p),
- Fcons (text, Qnil))),
+ list3 (outstream, make_lisp_proc (p), text),
!NILP (Vdebug_on_error) ? Qnil : Qerror,
read_process_output_error_handler);
@@ -5456,7 +5414,7 @@ write_queue_push (struct Lisp_Process *p, Lisp_Object input_obj,
if (front)
pset_write_queue (p, Fcons (entry, p->write_queue));
else
- pset_write_queue (p, nconc2 (p->write_queue, Fcons (entry, Qnil)));
+ pset_write_queue (p, nconc2 (p->write_queue, list1 (entry)));
}
/* Remove the first element in the write_queue of process P, put its
@@ -5629,7 +5587,7 @@ send_process (Lisp_Object proc, const char *buf, ptrdiff_t len,
if (rv >= 0)
written = rv;
else if (errno == EMSGSIZE)
- report_file_error ("sending datagram", Fcons (proc, Qnil));
+ report_file_error ("Sending datagram", proc);
}
else
#endif
@@ -5706,7 +5664,7 @@ send_process (Lisp_Object proc, const char *buf, ptrdiff_t len,
}
else
/* This is a real error. */
- report_file_error ("writing to process", Fcons (proc, Qnil));
+ report_file_error ("Writing to process", proc);
}
cur_buf += written;
cur_len -= written;
@@ -6196,7 +6154,7 @@ process has been transmitted to the serial port. */)
{
#ifndef WINDOWSNT
if (tcdrain (XPROCESS (proc)->outfd) != 0)
- error ("tcdrain() failed: %s", emacs_strerror (errno));
+ report_file_error ("Failed tcdrain", Qnil);
#endif /* not WINDOWSNT */
/* Do nothing on Windows because writes are blocking. */
}
@@ -6425,8 +6383,7 @@ exec_sentinel (Lisp_Object proc, Lisp_Object reason)
running_asynch_code = 1;
internal_condition_case_1 (read_process_output_call,
- Fcons (sentinel,
- Fcons (proc, Fcons (reason, Qnil))),
+ list3 (sentinel, proc, reason),
!NILP (Vdebug_on_error) ? Qnil : Qerror,
exec_sentinel_error_handler);
@@ -6890,7 +6847,7 @@ wait_reading_process_output (intmax_t time_limit, int nsecs, int read_kbd,
if (xerrno == EINTR)
FD_ZERO (&waitchannels);
else
- error ("select error: %s", emacs_strerror (xerrno));
+ report_file_errno ("Failed select", Qnil, xerrno);
}
/* Check for keyboard input */
diff --git a/src/search.c b/src/search.c
index ff47bb2fecf..e1147aca858 100644
--- a/src/search.c
+++ b/src/search.c
@@ -3016,11 +3016,11 @@ restore_search_regs (void)
}
}
-static Lisp_Object
+static void
unwind_set_match_data (Lisp_Object list)
{
/* It is NOT ALWAYS safe to free (evaporate) the markers immediately. */
- return Fset_match_data (list, Qt);
+ Fset_match_data (list, Qt);
}
/* Called to unwind protect the match data. */
diff --git a/src/sound.c b/src/sound.c
index 5ce185ea60e..27e06b8abab 100644
--- a/src/sound.c
+++ b/src/sound.c
@@ -437,10 +437,10 @@ find_sound_type (struct sound *s)
}
-/* Function installed by play-sound-internal with record_unwind_protect. */
+/* Function installed by play-sound-internal with record_unwind_protect_void. */
-static Lisp_Object
-sound_cleanup (Lisp_Object arg)
+static void
+sound_cleanup (void)
{
if (current_sound_device->close)
current_sound_device->close (current_sound_device);
@@ -448,8 +448,6 @@ sound_cleanup (Lisp_Object arg)
emacs_close (current_sound->fd);
xfree (current_sound_device);
xfree (current_sound);
-
- return Qnil;
}
/***********************************************************************
@@ -1346,13 +1344,13 @@ Internal use only, use `play-sound' instead. */)
GCPRO2 (sound, file);
current_sound_device = xzalloc (sizeof *current_sound_device);
current_sound = xzalloc (sizeof *current_sound);
- record_unwind_protect (sound_cleanup, Qnil);
+ record_unwind_protect_void (sound_cleanup);
current_sound->header = alloca (MAX_SOUND_HEADER_BYTES);
if (STRINGP (attrs[SOUND_FILE]))
{
/* Open the sound file. */
- current_sound->fd = openp (Fcons (Vdata_directory, Qnil),
+ current_sound->fd = openp (list1 (Vdata_directory),
attrs[SOUND_FILE], Qnil, &file, Qnil);
if (current_sound->fd < 0)
sound_perror ("Could not open sound file");
diff --git a/src/sysdep.c b/src/sysdep.c
index f614d8bc557..11a6f4a76ce 100644
--- a/src/sysdep.c
+++ b/src/sysdep.c
@@ -42,9 +42,14 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#endif
#ifdef __FreeBSD__
-#include <sys/user.h>
-#include <sys/resource.h>
-#include <math.h>
+/* Sparc/ARM machine/frame.h has 'struct frame' which conflicts with Emacs's
+ 'struct frame', so rename it. */
+# define frame freebsd_frame
+# include <sys/user.h>
+# undef frame
+
+# include <sys/resource.h>
+# include <math.h>
#endif
#ifdef WINDOWSNT
@@ -2201,6 +2206,20 @@ emacs_fopen (char const *file, char const *mode)
return fd < 0 ? 0 : fdopen (fd, mode);
}
+/* Create a pipe for Emacs use. */
+
+int
+emacs_pipe (int fd[2])
+{
+ int result = pipe2 (fd, O_CLOEXEC);
+ if (! O_CLOEXEC && result == 0)
+ {
+ fcntl (fd[0], F_SETFD, FD_CLOEXEC);
+ fcntl (fd[1], F_SETFD, FD_CLOEXEC);
+ }
+ return result;
+}
+
/* Approximate posix_close and POSIX_CLOSE_RESTART well enough for Emacs.
For the background behind this mess, please see Austin Group defect 529
<http://austingroupbugs.net/view.php?id=529>. */
@@ -2422,14 +2441,11 @@ safe_strsignal (int code)
#ifndef DOS_NT
/* For make-serial-process */
int
-serial_open (char *port)
+serial_open (Lisp_Object port)
{
- int fd = emacs_open (port, O_RDWR | O_NOCTTY | O_NONBLOCK, 0);
+ int fd = emacs_open (SSDATA (port), O_RDWR | O_NOCTTY | O_NONBLOCK, 0);
if (fd < 0)
- {
- error ("Could not open %s: %s",
- port, emacs_strerror (errno));
- }
+ report_file_error ("Opening serial port", port);
#ifdef TIOCEXCL
ioctl (fd, TIOCEXCL, (char *) 0);
#endif
@@ -2477,7 +2493,7 @@ serial_configure (struct Lisp_Process *p,
/* Read port attributes and prepare default configuration. */
err = tcgetattr (p->outfd, &attr);
if (err != 0)
- error ("tcgetattr() failed: %s", emacs_strerror (errno));
+ report_file_error ("Failed tcgetattr", Qnil);
cfmakeraw (&attr);
#if defined (CLOCAL)
attr.c_cflag |= CLOCAL;
@@ -2494,8 +2510,7 @@ serial_configure (struct Lisp_Process *p,
CHECK_NUMBER (tem);
err = cfsetspeed (&attr, XINT (tem));
if (err != 0)
- error ("cfsetspeed(%"pI"d) failed: %s", XINT (tem),
- emacs_strerror (errno));
+ report_file_error ("Failed cfsetspeed", tem);
childp2 = Fplist_put (childp2, QCspeed, tem);
/* Configure bytesize. */
@@ -2617,7 +2632,7 @@ serial_configure (struct Lisp_Process *p,
/* Activate configuration. */
err = tcsetattr (p->outfd, TCSANOW, &attr);
if (err != 0)
- error ("tcsetattr() failed: %s", emacs_strerror (errno));
+ report_file_error ("Failed tcsetattr", Qnil);
childp2 = Fplist_put (childp2, QCsummary, build_string (summary));
pset_childp (p, childp2);
@@ -2797,11 +2812,12 @@ get_up_time (void)
static Lisp_Object
procfs_ttyname (int rdev)
{
- FILE *fdev = NULL;
+ FILE *fdev;
char name[PATH_MAX];
block_input ();
fdev = emacs_fopen ("/proc/tty/drivers", "r");
+ name[0] = 0;
if (fdev)
{
@@ -2810,7 +2826,7 @@ procfs_ttyname (int rdev)
char minor[25]; /* 2 32-bit numbers + dash */
char *endp;
- while (!feof (fdev) && !ferror (fdev))
+ for (; !feof (fdev) && !ferror (fdev); name[0] = 0)
{
if (fscanf (fdev, "%*s %s %u %s %*s\n", name, &major, minor) >= 3
&& major == MAJOR (rdev))
@@ -2839,7 +2855,7 @@ procfs_ttyname (int rdev)
static unsigned long
procfs_get_total_memory (void)
{
- FILE *fmem = NULL;
+ FILE *fmem;
unsigned long retval = 2 * 1024 * 1024; /* default: 2GB */
block_input ();
@@ -2882,7 +2898,7 @@ system_process_attributes (Lisp_Object pid)
int cmdsize = sizeof default_cmd - 1;
char *cmdline = NULL;
ptrdiff_t cmdline_size;
- unsigned char c;
+ char c;
printmax_t proc_id;
int ppid, pgrp, sess, tty, tpgid, thcount;
uid_t uid;
@@ -2893,7 +2909,8 @@ system_process_attributes (Lisp_Object pid)
EMACS_TIME tnow, tstart, tboot, telapsed, us_time;
double pcpu, pmem;
Lisp_Object attrs = Qnil;
- Lisp_Object cmd_str, decoded_cmd, tem;
+ Lisp_Object cmd_str, decoded_cmd;
+ ptrdiff_t count;
struct gcpro gcpro1, gcpro2;
CHECK_NUMBER_OR_FLOAT (pid);
@@ -2921,11 +2938,19 @@ system_process_attributes (Lisp_Object pid)
if (gr)
attrs = Fcons (Fcons (Qgroup, build_string (gr->gr_name)), attrs);
+ count = SPECPDL_INDEX ();
strcpy (fn, procfn);
procfn_end = fn + strlen (fn);
strcpy (procfn_end, "/stat");
fd = emacs_open (fn, O_RDONLY, 0);
- if (fd >= 0 && (nread = emacs_read (fd, procbuf, sizeof (procbuf) - 1)) > 0)
+ if (fd < 0)
+ nread = 0;
+ else
+ {
+ record_unwind_protect_int (close_file_unwind, fd);
+ nread = emacs_read (fd, procbuf, sizeof procbuf - 1);
+ }
+ if (0 < nread)
{
procbuf[nread] = '\0';
p = procbuf;
@@ -2949,39 +2974,32 @@ system_process_attributes (Lisp_Object pid)
Vlocale_coding_system, 0);
attrs = Fcons (Fcons (Qcomm, decoded_cmd), attrs);
- if (q)
+ /* state ppid pgrp sess tty tpgid . minflt cminflt majflt cmajflt
+ utime stime cutime cstime priority nice thcount . start vsize rss */
+ if (q
+ && (sscanf (q + 2, ("%c %d %d %d %d %d %*u %lu %lu %lu %lu "
+ "%Lu %Lu %Lu %Lu %ld %ld %d %*d %Lu %lu %ld"),
+ &c, &ppid, &pgrp, &sess, &tty, &tpgid,
+ &minflt, &cminflt, &majflt, &cmajflt,
+ &u_time, &s_time, &cutime, &cstime,
+ &priority, &niceness, &thcount, &start, &vsize, &rss)
+ == 20))
{
- EMACS_INT ppid_eint, pgrp_eint, sess_eint, tpgid_eint, thcount_eint;
- p = q + 2;
- /* state ppid pgrp sess tty tpgid . minflt cminflt majflt cmajflt utime stime cutime cstime priority nice thcount . start vsize rss */
- sscanf (p, "%c %d %d %d %d %d %*u %lu %lu %lu %lu %Lu %Lu %Lu %Lu %ld %ld %d %*d %Lu %lu %ld",
- &c, &ppid, &pgrp, &sess, &tty, &tpgid,
- &minflt, &cminflt, &majflt, &cmajflt,
- &u_time, &s_time, &cutime, &cstime,
- &priority, &niceness, &thcount, &start, &vsize, &rss);
- {
- char state_str[2];
-
- state_str[0] = c;
- state_str[1] = '\0';
- tem = build_string (state_str);
- attrs = Fcons (Fcons (Qstate, tem), attrs);
- }
- /* Stops GCC whining about limited range of data type. */
- ppid_eint = ppid;
- pgrp_eint = pgrp;
- sess_eint = sess;
- tpgid_eint = tpgid;
- thcount_eint = thcount;
- attrs = Fcons (Fcons (Qppid, make_fixnum_or_float (ppid_eint)), attrs);
- attrs = Fcons (Fcons (Qpgrp, make_fixnum_or_float (pgrp_eint)), attrs);
- attrs = Fcons (Fcons (Qsess, make_fixnum_or_float (sess_eint)), attrs);
+ char state_str[2];
+ state_str[0] = c;
+ state_str[1] = '\0';
+ attrs = Fcons (Fcons (Qstate, build_string (state_str)), attrs);
+ attrs = Fcons (Fcons (Qppid, make_fixnum_or_float (ppid)), attrs);
+ attrs = Fcons (Fcons (Qpgrp, make_fixnum_or_float (pgrp)), attrs);
+ attrs = Fcons (Fcons (Qsess, make_fixnum_or_float (sess)), attrs);
attrs = Fcons (Fcons (Qttname, procfs_ttyname (tty)), attrs);
- attrs = Fcons (Fcons (Qtpgid, make_fixnum_or_float (tpgid_eint)), attrs);
+ attrs = Fcons (Fcons (Qtpgid, make_fixnum_or_float (tpgid)), attrs);
attrs = Fcons (Fcons (Qminflt, make_fixnum_or_float (minflt)), attrs);
attrs = Fcons (Fcons (Qmajflt, make_fixnum_or_float (majflt)), attrs);
- attrs = Fcons (Fcons (Qcminflt, make_fixnum_or_float (cminflt)), attrs);
- attrs = Fcons (Fcons (Qcmajflt, make_fixnum_or_float (cmajflt)), attrs);
+ attrs = Fcons (Fcons (Qcminflt, make_fixnum_or_float (cminflt)),
+ attrs);
+ attrs = Fcons (Fcons (Qcmajflt, make_fixnum_or_float (cmajflt)),
+ attrs);
clocks_per_sec = sysconf (_SC_CLK_TCK);
if (clocks_per_sec < 0)
clocks_per_sec = 100;
@@ -3002,19 +3020,22 @@ system_process_attributes (Lisp_Object pid)
ltime_from_jiffies (cstime, clocks_per_sec)),
attrs);
attrs = Fcons (Fcons (Qctime,
- ltime_from_jiffies (cstime+cutime, clocks_per_sec)),
+ ltime_from_jiffies (cstime + cutime,
+ clocks_per_sec)),
attrs);
attrs = Fcons (Fcons (Qpri, make_number (priority)), attrs);
attrs = Fcons (Fcons (Qnice, make_number (niceness)), attrs);
- attrs = Fcons (Fcons (Qthcount, make_fixnum_or_float (thcount_eint)), attrs);
+ attrs = Fcons (Fcons (Qthcount, make_fixnum_or_float (thcount)),
+ attrs);
tnow = current_emacs_time ();
telapsed = get_up_time ();
tboot = sub_emacs_time (tnow, telapsed);
tstart = time_from_jiffies (start, clocks_per_sec);
tstart = add_emacs_time (tboot, tstart);
attrs = Fcons (Fcons (Qstart, make_lisp_time (tstart)), attrs);
- attrs = Fcons (Fcons (Qvsize, make_fixnum_or_float (vsize/1024)), attrs);
- attrs = Fcons (Fcons (Qrss, make_fixnum_or_float (4*rss)), attrs);
+ attrs = Fcons (Fcons (Qvsize, make_fixnum_or_float (vsize / 1024)),
+ attrs);
+ attrs = Fcons (Fcons (Qrss, make_fixnum_or_float (4 * rss)), attrs);
telapsed = sub_emacs_time (tnow, tstart);
attrs = Fcons (Fcons (Qetime, make_lisp_time (telapsed)), attrs);
us_time = time_from_jiffies (u_time + s_time, clocks_per_sec);
@@ -3029,67 +3050,63 @@ system_process_attributes (Lisp_Object pid)
attrs = Fcons (Fcons (Qpmem, make_float (pmem)), attrs);
}
}
- if (fd >= 0)
- emacs_close (fd);
+ unbind_to (count, Qnil);
/* args */
strcpy (procfn_end, "/cmdline");
fd = emacs_open (fn, O_RDONLY, 0);
if (fd >= 0)
{
- char ch;
- for (cmdline_size = 0; cmdline_size < STRING_BYTES_BOUND; cmdline_size++)
+ ptrdiff_t readsize, nread_incr;
+ record_unwind_protect_int (close_file_unwind, fd);
+ record_unwind_protect_nothing ();
+ nread = cmdline_size = 0;
+
+ do
{
- if (emacs_read (fd, &ch, 1) != 1)
- break;
- c = ch;
- if (c_isspace (c) || c == '\\')
- cmdline_size++; /* for later quoting, see below */
+ cmdline = xpalloc (cmdline, &cmdline_size, 2, STRING_BYTES_BOUND, 1);
+ set_unwind_protect_ptr (count + 1, xfree, cmdline);
+
+ /* Leave room even if every byte needs escaping below. */
+ readsize = (cmdline_size >> 1) - nread;
+
+ nread_incr = emacs_read (fd, cmdline + nread, readsize);
+ nread += max (0, nread_incr);
}
- if (cmdline_size)
+ while (nread_incr == readsize);
+
+ if (nread)
{
- cmdline = xmalloc (cmdline_size + 1);
- lseek (fd, 0L, SEEK_SET);
- cmdline[0] = '\0';
- if ((nread = read (fd, cmdline, cmdline_size)) >= 0)
- cmdline[nread++] = '\0';
- else
- {
- /* Assigning zero to `nread' makes us skip the following
- two loops, assign zero to cmdline_size, and enter the
- following `if' clause that handles unknown command
- lines. */
- nread = 0;
- }
/* We don't want trailing null characters. */
- for (p = cmdline + nread; p > cmdline + 1 && !p[-1]; p--)
- nread--;
- for (p = cmdline; p < cmdline + nread; p++)
+ for (p = cmdline + nread; cmdline < p && !p[-1]; p--)
+ continue;
+
+ /* Escape-quote whitespace and backslashes. */
+ q = cmdline + cmdline_size;
+ while (cmdline < p)
{
- /* Escape-quote whitespace and backslashes. */
- if (c_isspace (*p) || *p == '\\')
- {
- memmove (p + 1, p, nread - (p - cmdline));
- nread++;
- *p++ = '\\';
- }
- else if (*p == '\0')
- *p = ' ';
+ char c = *--p;
+ *--q = c ? c : ' ';
+ if (c_isspace (c) || c == '\\')
+ *--q = '\\';
}
- cmdline_size = nread;
+
+ nread = cmdline + cmdline_size - q;
}
- if (!cmdline_size)
+
+ if (!nread)
{
- cmdline_size = cmdsize + 2;
- cmdline = xmalloc (cmdline_size + 1);
+ nread = cmdsize + 2;
+ cmdline_size = nread + 1;
+ q = cmdline = xrealloc (cmdline, cmdline_size);
+ set_unwind_protect_ptr (count + 1, xfree, cmdline);
sprintf (cmdline, "[%.*s]", cmdsize, cmd);
}
- emacs_close (fd);
/* Command line is encoded in locale-coding-system; decode it. */
- cmd_str = make_unibyte_string (cmdline, cmdline_size);
+ cmd_str = make_unibyte_string (q, nread);
decoded_cmd = code_convert_string_norecord (cmd_str,
Vlocale_coding_system, 0);
- xfree (cmdline);
+ unbind_to (count, Qnil);
attrs = Fcons (Fcons (Qargs, decoded_cmd), attrs);
}
@@ -3131,8 +3148,9 @@ system_process_attributes (Lisp_Object pid)
uid_t uid;
gid_t gid;
Lisp_Object attrs = Qnil;
- Lisp_Object decoded_cmd, tem;
+ Lisp_Object decoded_cmd;
struct gcpro gcpro1, gcpro2;
+ ptrdiff_t count;
CHECK_NUMBER_OR_FLOAT (pid);
CONS_TO_INTEGER (pid, pid_t, proc_id);
@@ -3159,72 +3177,83 @@ system_process_attributes (Lisp_Object pid)
if (gr)
attrs = Fcons (Fcons (Qgroup, build_string (gr->gr_name)), attrs);
+ count = SPECPDL_INDEX ();
strcpy (fn, procfn);
procfn_end = fn + strlen (fn);
strcpy (procfn_end, "/psinfo");
fd = emacs_open (fn, O_RDONLY, 0);
- if (fd >= 0
- && (nread = read (fd, (char*)&pinfo, sizeof (struct psinfo)) > 0))
+ if (fd < 0)
+ nread = 0;
+ else
{
- attrs = Fcons (Fcons (Qppid, make_fixnum_or_float (pinfo.pr_ppid)), attrs);
- attrs = Fcons (Fcons (Qpgrp, make_fixnum_or_float (pinfo.pr_pgid)), attrs);
- attrs = Fcons (Fcons (Qsess, make_fixnum_or_float (pinfo.pr_sid)), attrs);
-
- {
- char state_str[2];
- state_str[0] = pinfo.pr_lwp.pr_sname;
- state_str[1] = '\0';
- tem = build_string (state_str);
- attrs = Fcons (Fcons (Qstate, tem), attrs);
- }
-
- /* FIXME: missing Qttyname. psinfo.pr_ttydev is a dev_t,
- need to get a string from it. */
-
- /* FIXME: missing: Qtpgid */
-
- /* FIXME: missing:
- Qminflt
- Qmajflt
- Qcminflt
- Qcmajflt
-
- Qutime
- Qcutime
- Qstime
- Qcstime
- Are they available? */
-
- attrs = Fcons (Fcons (Qtime, make_lisp_time (pinfo.pr_time)), attrs);
- attrs = Fcons (Fcons (Qctime, make_lisp_time (pinfo.pr_ctime)), attrs);
- attrs = Fcons (Fcons (Qpri, make_number (pinfo.pr_lwp.pr_pri)), attrs);
- attrs = Fcons (Fcons (Qnice, make_number (pinfo.pr_lwp.pr_nice)), attrs);
- attrs = Fcons (Fcons (Qthcount, make_fixnum_or_float (pinfo.pr_nlwp)), attrs);
-
- attrs = Fcons (Fcons (Qstart, make_lisp_time (pinfo.pr_start)), attrs);
- attrs = Fcons (Fcons (Qvsize, make_fixnum_or_float (pinfo.pr_size)), attrs);
- attrs = Fcons (Fcons (Qrss, make_fixnum_or_float (pinfo.pr_rssize)), attrs);
-
- /* pr_pctcpu and pr_pctmem are unsigned integers in the
- range 0 .. 2**15, representing 0.0 .. 1.0. */
- attrs = Fcons (Fcons (Qpcpu, make_float (100.0 / 0x8000 * pinfo.pr_pctcpu)), attrs);
- attrs = Fcons (Fcons (Qpmem, make_float (100.0 / 0x8000 * pinfo.pr_pctmem)), attrs);
-
- decoded_cmd
- = code_convert_string_norecord (make_unibyte_string (pinfo.pr_fname,
- strlen (pinfo.pr_fname)),
- Vlocale_coding_system, 0);
- attrs = Fcons (Fcons (Qcomm, decoded_cmd), attrs);
- decoded_cmd
- = code_convert_string_norecord (make_unibyte_string (pinfo.pr_psargs,
- strlen (pinfo.pr_psargs)),
- Vlocale_coding_system, 0);
- attrs = Fcons (Fcons (Qargs, decoded_cmd), attrs);
+ record_unwind_protect (close_file_unwind, fd);
+ nread = emacs_read (fd, &pinfo, sizeof pinfo);
}
- if (fd >= 0)
- emacs_close (fd);
+ if (nread == sizeof pinfo)
+ {
+ attrs = Fcons (Fcons (Qppid, make_fixnum_or_float (pinfo.pr_ppid)), attrs);
+ attrs = Fcons (Fcons (Qpgrp, make_fixnum_or_float (pinfo.pr_pgid)), attrs);
+ attrs = Fcons (Fcons (Qsess, make_fixnum_or_float (pinfo.pr_sid)), attrs);
+ {
+ char state_str[2];
+ state_str[0] = pinfo.pr_lwp.pr_sname;
+ state_str[1] = '\0';
+ attrs = Fcons (Fcons (Qstate, build_string (state_str)), attrs);
+ }
+
+ /* FIXME: missing Qttyname. psinfo.pr_ttydev is a dev_t,
+ need to get a string from it. */
+
+ /* FIXME: missing: Qtpgid */
+
+ /* FIXME: missing:
+ Qminflt
+ Qmajflt
+ Qcminflt
+ Qcmajflt
+
+ Qutime
+ Qcutime
+ Qstime
+ Qcstime
+ Are they available? */
+
+ attrs = Fcons (Fcons (Qtime, make_lisp_time (pinfo.pr_time)), attrs);
+ attrs = Fcons (Fcons (Qctime, make_lisp_time (pinfo.pr_ctime)), attrs);
+ attrs = Fcons (Fcons (Qpri, make_number (pinfo.pr_lwp.pr_pri)), attrs);
+ attrs = Fcons (Fcons (Qnice, make_number (pinfo.pr_lwp.pr_nice)), attrs);
+ attrs = Fcons (Fcons (Qthcount, make_fixnum_or_float (pinfo.pr_nlwp)),
+ attrs);
+
+ attrs = Fcons (Fcons (Qstart, make_lisp_time (pinfo.pr_start)), attrs);
+ attrs = Fcons (Fcons (Qvsize, make_fixnum_or_float (pinfo.pr_size)),
+ attrs);
+ attrs = Fcons (Fcons (Qrss, make_fixnum_or_float (pinfo.pr_rssize)),
+ attrs);
+
+ /* pr_pctcpu and pr_pctmem are unsigned integers in the
+ range 0 .. 2**15, representing 0.0 .. 1.0. */
+ attrs = Fcons (Fcons (Qpcpu,
+ make_float (100.0 / 0x8000 * pinfo.pr_pctcpu)),
+ attrs);
+ attrs = Fcons (Fcons (Qpmem,
+ make_float (100.0 / 0x8000 * pinfo.pr_pctmem)),
+ attrs);
+
+ decoded_cmd = (code_convert_string_norecord
+ (make_unibyte_string (pinfo.pr_fname,
+ strlen (pinfo.pr_fname)),
+ Vlocale_coding_system, 0));
+ attrs = Fcons (Fcons (Qcomm, decoded_cmd), attrs);
+ decoded_cmd = (code_convert_string_norecord
+ (make_unibyte_string (pinfo.pr_psargs,
+ strlen (pinfo.pr_psargs)),
+ Vlocale_coding_system, 0));
+ attrs = Fcons (Fcons (Qargs, decoded_cmd), attrs);
+ }
+ unbind_to (count, Qnil);
UNGCPRO;
return attrs;
}
diff --git a/src/systty.h b/src/systty.h
index 6d38c980725..b735971c66f 100644
--- a/src/systty.h
+++ b/src/systty.h
@@ -79,5 +79,5 @@ struct emacs_tty {
};
/* From sysdep.c or w32.c */
-extern int serial_open (char *);
+extern int serial_open (Lisp_Object);
extern void serial_configure (struct Lisp_Process *, Lisp_Object);
diff --git a/src/term.c b/src/term.c
index b6878a0abd1..376d6e7831a 100644
--- a/src/term.c
+++ b/src/term.c
@@ -2416,15 +2416,20 @@ frame's terminal). */)
t->display_info.tty->input = stdin;
#else /* !MSDOS */
fd = emacs_open (t->display_info.tty->name, O_RDWR | O_NOCTTY, 0);
+ t->display_info.tty->input = t->display_info.tty->output
+ = fd < 0 ? 0 : fdopen (fd, "w+");
- if (fd == -1)
- error ("Can not reopen tty device %s: %s", t->display_info.tty->name, strerror (errno));
+ if (! t->display_info.tty->input)
+ {
+ int open_errno = errno;
+ emacs_close (fd);
+ report_file_errno ("Cannot reopen tty device",
+ build_string (t->display_info.tty->name),
+ open_errno);
+ }
if (!O_IGNORE_CTTY && strcmp (t->display_info.tty->name, DEV_TTY) != 0)
dissociate_if_controlling_tty (fd);
-
- t->display_info.tty->output = fdopen (fd, "w+");
- t->display_info.tty->input = t->display_info.tty->output;
#endif
add_keyboard_wait_descriptor (fd);
@@ -2990,7 +2995,6 @@ init_tty (const char *name, const char *terminal_type, bool must_succeed)
{
/* Open the terminal device. */
- FILE *file;
/* If !ctty, don't recognize it as our controlling terminal, and
don't make it the controlling tty if we don't have one now.
@@ -3001,30 +3005,21 @@ init_tty (const char *name, const char *terminal_type, bool must_succeed)
open a frame on the same terminal. */
int flags = O_RDWR | O_NOCTTY | (ctty ? 0 : O_IGNORE_CTTY);
int fd = emacs_open (name, flags, 0);
+ tty->input = tty->output = fd < 0 || ! isatty (fd) ? 0 : fdopen (fd, "w+");
- tty->name = xstrdup (name);
- terminal->name = xstrdup (name);
-
- if (fd < 0)
- maybe_fatal (must_succeed, terminal,
- "Could not open file: %s",
- "Could not open file: %s",
- name);
- if (!isatty (fd))
+ if (! tty->input)
{
- emacs_close (fd);
- maybe_fatal (must_succeed, terminal,
- "Not a tty device: %s",
- "Not a tty device: %s",
- name);
+ char const *diagnostic
+ = tty->input ? "Not a tty device: %s" : "Could not open file: %s";
+ emacs_close (fd);
+ maybe_fatal (must_succeed, terminal, diagnostic, diagnostic, name);
}
+ tty->name = xstrdup (name);
+ terminal->name = xstrdup (name);
+
if (!O_IGNORE_CTTY && !ctty)
dissociate_if_controlling_tty (fd);
-
- file = fdopen (fd, "w+");
- tty->input = file;
- tty->output = file;
}
tty->type = xstrdup (terminal_type);
diff --git a/src/termhooks.h b/src/termhooks.h
index 0190478c254..b49a7bc706b 100644
--- a/src/termhooks.h
+++ b/src/termhooks.h
@@ -172,6 +172,8 @@ enum event_kind
`switch-frame' events in kbd_buffer_get_event, if necessary. */
FOCUS_IN_EVENT,
+ FOCUS_OUT_EVENT,
+
/* Generated when mouse moves over window not currently selected. */
SELECT_WINDOW_EVENT,
diff --git a/src/textprop.c b/src/textprop.c
index e5d4fe06c60..282ae11d4ac 100644
--- a/src/textprop.c
+++ b/src/textprop.c
@@ -226,7 +226,7 @@ validate_plist (Lisp_Object list)
return list;
}
- return Fcons (list, Fcons (Qnil, Qnil));
+ return list2 (list, Qnil);
}
/* Return true if interval I has all the properties,
@@ -436,16 +436,14 @@ add_properties (Lisp_Object plist, INTERVAL i, Lisp_Object object,
if (set_type == TEXT_PROPERTY_PREPEND)
Fsetcar (this_cdr, Fcons (val1, Fcar (this_cdr)));
else
- nconc2 (Fcar (this_cdr), Fcons (val1, Qnil));
+ nconc2 (Fcar (this_cdr), list1 (val1));
else {
/* The previous value is a single value, so make it
into a list. */
if (set_type == TEXT_PROPERTY_PREPEND)
- Fsetcar (this_cdr,
- Fcons (val1, Fcons (Fcar (this_cdr), Qnil)));
+ Fsetcar (this_cdr, list2 (val1, Fcar (this_cdr)));
else
- Fsetcar (this_cdr,
- Fcons (Fcar (this_cdr), Fcons (val1, Qnil)));
+ Fsetcar (this_cdr, list2 (Fcar (this_cdr), val1));
}
}
changed = 1;
@@ -1308,9 +1306,7 @@ the current buffer), START and END are buffer positions (integers or
markers). If OBJECT is a string, START and END are 0-based indices into it. */)
(Lisp_Object start, Lisp_Object end, Lisp_Object property, Lisp_Object value, Lisp_Object object)
{
- Fadd_text_properties (start, end,
- Fcons (property, Fcons (value, Qnil)),
- object);
+ Fadd_text_properties (start, end, list2 (property, value), object);
return Qnil;
}
@@ -1344,11 +1340,10 @@ into it. */)
(Lisp_Object start, Lisp_Object end, Lisp_Object face,
Lisp_Object appendp, Lisp_Object object)
{
- add_text_properties_1 (start, end,
- Fcons (Qface, Fcons (face, Qnil)),
- object,
- NILP (appendp)? TEXT_PROPERTY_PREPEND:
- TEXT_PROPERTY_APPEND);
+ add_text_properties_1 (start, end, list2 (Qface, face), object,
+ (NILP (appendp)
+ ? TEXT_PROPERTY_PREPEND
+ : TEXT_PROPERTY_APPEND));
return Qnil;
}
@@ -1929,7 +1924,7 @@ copy_text_properties (Lisp_Object start, Lisp_Object end, Lisp_Object src, Lisp_
{
if (EQ (Fcar (plist), prop))
{
- plist = Fcons (prop, Fcons (Fcar (Fcdr (plist)), Qnil));
+ plist = list2 (prop, Fcar (Fcdr (plist)));
break;
}
plist = Fcdr (Fcdr (plist));
@@ -1938,10 +1933,8 @@ copy_text_properties (Lisp_Object start, Lisp_Object end, Lisp_Object src, Lisp_
{
/* Must defer modifications to the interval tree in case src
and dest refer to the same string or buffer. */
- stuff = Fcons (Fcons (make_number (p),
- Fcons (make_number (p + len),
- Fcons (plist, Qnil))),
- stuff);
+ stuff = Fcons (list3 (make_number (p), make_number (p + len), plist),
+ stuff);
}
i = next_interval (i);
@@ -2007,14 +2000,13 @@ text_property_list (Lisp_Object object, Lisp_Object start, Lisp_Object end, Lisp
for (; CONSP (plist); plist = Fcdr (XCDR (plist)))
if (EQ (XCAR (plist), prop))
{
- plist = Fcons (prop, Fcons (Fcar (XCDR (plist)), Qnil));
+ plist = list2 (prop, Fcar (XCDR (plist)));
break;
}
if (!NILP (plist))
- result = Fcons (Fcons (make_number (s),
- Fcons (make_number (s + len),
- Fcons (plist, Qnil))),
+ result = Fcons (list3 (make_number (s), make_number (s + len),
+ plist),
result);
i = next_interval (i);
@@ -2343,8 +2335,8 @@ inherits it if NONSTICKINESS is nil. The `front-sticky' and
/* Text properties `syntax-table'and `display' should be nonsticky
by default. */
Vtext_property_default_nonsticky
- = Fcons (Fcons (intern_c_string ("syntax-table"), Qt),
- Fcons (Fcons (intern_c_string ("display"), Qt), Qnil));
+ = list2 (Fcons (intern_c_string ("syntax-table"), Qt),
+ Fcons (intern_c_string ("display"), Qt));
staticpro (&interval_insert_behind_hooks);
staticpro (&interval_insert_in_front_hooks);
diff --git a/src/unexaix.c b/src/unexaix.c
index 757ba6f51b3..fc1acc9ab4f 100644
--- a/src/unexaix.c
+++ b/src/unexaix.c
@@ -97,7 +97,7 @@ report_error (const char *file, int fd)
int err = errno;
if (fd)
emacs_close (fd);
- report_file_errno ("Cannot unexec", Fcons (build_string (file), Qnil), err);
+ report_file_errno ("Cannot unexec", build_string (file), err);
}
#define ERROR0(msg) report_error_1 (new, msg)
diff --git a/src/unexcoff.c b/src/unexcoff.c
index c467e59a665..5ac8ea8c9b0 100644
--- a/src/unexcoff.c
+++ b/src/unexcoff.c
@@ -130,7 +130,7 @@ report_error (const char *file, int fd)
int err = errno;
if (fd)
emacs_close (fd);
- report_file_errno ("Cannot unexec", Fcons (build_string (file), Qnil), err);
+ report_file_errno ("Cannot unexec", build_string (file), err);
}
#define ERROR0(msg) report_error_1 (new, msg, 0, 0); return -1
diff --git a/src/unexsol.c b/src/unexsol.c
index 470206d5838..cfd515ff504 100644
--- a/src/unexsol.c
+++ b/src/unexsol.c
@@ -20,7 +20,7 @@ unexec (const char *new_name, const char *old_name)
if (! dldump (0, new_name, RTLD_MEMORY))
return;
- data = Fcons (build_string (new_name), Qnil);
+ data = list1 (build_string (new_name));
synchronize_system_messages_locale ();
errstring = code_convert_string_norecord (build_string (dlerror ()),
Vlocale_coding_system, 0);
diff --git a/src/w32.c b/src/w32.c
index 1a3d81bbffc..fb2d7c75972 100644
--- a/src/w32.c
+++ b/src/w32.c
@@ -7707,8 +7707,9 @@ globals_of_w32 (void)
/* For make-serial-process */
int
-serial_open (char *port)
+serial_open (Lisp_Object port_obj)
{
+ char *port = SSDATA (port_obj);
HANDLE hnd;
child_process *cp;
int fd = -1;
diff --git a/src/w32fns.c b/src/w32fns.c
index 3fa23c166e2..675b716f3b0 100644
--- a/src/w32fns.c
+++ b/src/w32fns.c
@@ -318,7 +318,7 @@ x_window_to_frame (struct w32_display_info *dpyinfo, HWND wdesc)
static Lisp_Object unwind_create_frame (Lisp_Object);
-static Lisp_Object unwind_create_tip_frame (Lisp_Object);
+static void unwind_create_tip_frame (Lisp_Object);
static void my_create_window (struct frame *);
static void my_create_tip_window (struct frame *);
@@ -4259,6 +4259,12 @@ unwind_create_frame (Lisp_Object frame)
}
static void
+do_unwind_create_frame (Lisp_Object frame)
+{
+ unwind_create_frame (frame);
+}
+
+static void
x_default_font_parameter (struct frame *f, Lisp_Object parms)
{
struct w32_display_info *dpyinfo = FRAME_W32_DISPLAY_INFO (f);
@@ -4398,7 +4404,7 @@ This function is an internal primitive--use `make-frame' instead. */)
/* FRAME_W32_DISPLAY_INFO (f) = dpyinfo; */
/* With FRAME_X_DISPLAY_INFO set up, this unwind-protect is safe. */
- record_unwind_protect (unwind_create_frame, frame);
+ record_unwind_protect (do_unwind_create_frame, frame);
#ifdef GLYPH_DEBUG
image_cache_refcount =
FRAME_IMAGE_CACHE (f) ? FRAME_IMAGE_CACHE (f)->refcount : 0;
@@ -4910,7 +4916,7 @@ w32_monitor_enum (HMONITOR monitor, HDC hdc, RECT *rcMonitor, LPARAM dwData)
{
Lisp_Object *monitor_list = (Lisp_Object *) dwData;
- *monitor_list = Fcons (make_save_pointer (monitor), *monitor_list);
+ *monitor_list = Fcons (make_save_ptr (monitor), *monitor_list);
return TRUE;
}
@@ -5585,7 +5591,7 @@ Window tip_window;
Lisp_Object last_show_tip_args;
-static Lisp_Object
+static void
unwind_create_tip_frame (Lisp_Object frame)
{
Lisp_Object deleted;
@@ -5596,8 +5602,6 @@ unwind_create_tip_frame (Lisp_Object frame)
tip_window = NULL;
tip_frame = Qnil;
}
-
- return deleted;
}
diff --git a/src/w32term.c b/src/w32term.c
index c9951ca1d52..0b22fd178e4 100644
--- a/src/w32term.c
+++ b/src/w32term.c
@@ -2912,9 +2912,15 @@ x_focus_changed (int type, int state, struct w32_display_info *dpyinfo,
&& CONSP (Vframe_list)
&& !NILP (XCDR (Vframe_list)))
{
- bufp->kind = FOCUS_IN_EVENT;
- XSETFRAME (bufp->frame_or_window, frame);
+ bufp->arg = Qt;
}
+ else
+ {
+ bufp->arg = Qnil;
+ }
+
+ bufp->kind = FOCUS_IN_EVENT;
+ XSETFRAME (bufp->frame_or_window, frame);
}
frame->output_data.x->focus_state |= state;
@@ -2929,7 +2935,10 @@ x_focus_changed (int type, int state, struct w32_display_info *dpyinfo,
{
dpyinfo->w32_focus_event_frame = 0;
x_new_focus_frame (dpyinfo, 0);
- }
+
+ bufp->kind = FOCUS_OUT_EVENT;
+ XSETFRAME (bufp->frame_or_window, frame);
+ }
/* TODO: IME focus? */
}
@@ -4351,8 +4360,9 @@ w32_read_socket (struct terminal *terminal,
SET_FRAME_VISIBLE (f, 1);
SET_FRAME_ICONIFIED (f, 0);
SET_FRAME_GARBAGED (f);
- DebPrint (("frame %p (%s) reexposed by WM_PAINT\n", f,
- SDATA (f->name)));
+ if (!f->output_data.w32->asked_for_visible)
+ DebPrint (("frame %p (%s) reexposed by WM_PAINT\n", f,
+ SDATA (f->name)));
/* WM_PAINT serves as MapNotify as well, so report
visibility changes properly. */
@@ -4810,7 +4820,8 @@ w32_read_socket (struct terminal *terminal,
{
bool iconified = FRAME_ICONIFIED_P (f);
- SET_FRAME_VISIBLE (f, 1);
+ if (iconified)
+ SET_FRAME_VISIBLE (f, 1);
SET_FRAME_ICONIFIED (f, 0);
/* wait_reading_process_output will notice this
@@ -5174,7 +5185,10 @@ x_draw_hollow_cursor (struct window *w, struct glyph_row *row)
the current matrix is invalid or such, give up. */
cursor_glyph = get_phys_cursor_glyph (w);
if (cursor_glyph == NULL)
- return;
+ {
+ DeleteObject (hb);
+ return;
+ }
/* Compute frame-relative coordinates for phys cursor. */
get_phys_cursor_geometry (w, row, cursor_glyph, &left, &top, &h);
@@ -6117,6 +6131,9 @@ x_iconify_frame (struct frame *f)
/* Simulate the user minimizing the frame. */
SendMessage (FRAME_W32_WINDOW (f), WM_SYSCOMMAND, SC_MINIMIZE, 0);
+ SET_FRAME_VISIBLE (f, 0);
+ SET_FRAME_ICONIFIED (f, 1);
+
unblock_input ();
}
diff --git a/src/window.c b/src/window.c
index ba9728f09af..bf4ce1dbe39 100644
--- a/src/window.c
+++ b/src/window.c
@@ -3086,18 +3086,18 @@ run_funs (Lisp_Object funs)
call0 (XCAR (funs));
}
-static Lisp_Object
+static void
select_window_norecord (Lisp_Object window)
{
- return WINDOW_LIVE_P (window)
- ? Fselect_window (window, Qt) : selected_window;
+ if (WINDOW_LIVE_P (window))
+ Fselect_window (window, Qt);
}
-static Lisp_Object
+static void
select_frame_norecord (Lisp_Object frame)
{
- return FRAME_LIVE_P (XFRAME (frame))
- ? Fselect_frame (frame, Qt) : selected_frame;
+ if (FRAME_LIVE_P (XFRAME (frame)))
+ Fselect_frame (frame, Qt);
}
void
@@ -3410,7 +3410,7 @@ temp_output_buffer_show (register Lisp_Object buf)
Note: Both Fselect_window and select_window_norecord may
set-buffer to the buffer displayed in the window,
so we need to save the current buffer. --stef */
- record_unwind_protect (Fset_buffer, prev_buffer);
+ record_unwind_protect (restore_buffer, prev_buffer);
record_unwind_protect (select_window_norecord, prev_window);
Fselect_window (window, Qt);
Fset_buffer (w->contents);
@@ -5873,6 +5873,12 @@ the return value is nil. Otherwise the value is t. */)
return (FRAME_LIVE_P (f) ? Qt : Qnil);
}
+void
+restore_window_configuration (Lisp_Object configuration)
+{
+ Fset_window_configuration (configuration);
+}
+
/* If WINDOW is an internal window, recursively delete all child windows
reachable via the next and contents slots of WINDOW. Otherwise setup
diff --git a/src/window.h b/src/window.h
index 846831e43d5..5da6165c48d 100644
--- a/src/window.h
+++ b/src/window.h
@@ -886,6 +886,7 @@ extern Lisp_Object make_window (void);
extern Lisp_Object window_from_coordinates (struct frame *, int, int,
enum window_part *, bool);
extern void resize_frame_windows (struct frame *, int, bool);
+extern void restore_window_configuration (Lisp_Object);
extern void delete_all_child_windows (Lisp_Object);
extern void freeze_window_starts (struct frame *, bool);
extern void grow_mini_window (struct window *, int);
diff --git a/src/xdisp.c b/src/xdisp.c
index 12b294e6800..1da7de5759c 100644
--- a/src/xdisp.c
+++ b/src/xdisp.c
@@ -813,21 +813,20 @@ static void handle_stop (struct it *);
static void handle_stop_backwards (struct it *, ptrdiff_t);
static void vmessage (const char *, va_list) ATTRIBUTE_FORMAT_PRINTF (1, 0);
static void ensure_echo_area_buffers (void);
-static Lisp_Object unwind_with_echo_area_buffer (Lisp_Object);
+static void unwind_with_echo_area_buffer (Lisp_Object);
static Lisp_Object with_echo_area_buffer_unwind_data (struct window *);
static int with_echo_area_buffer (struct window *, int,
int (*) (ptrdiff_t, Lisp_Object),
ptrdiff_t, Lisp_Object);
static void clear_garbaged_frames (void);
static int current_message_1 (ptrdiff_t, Lisp_Object);
-static void pop_message (void);
static int truncate_message_1 (ptrdiff_t, Lisp_Object);
static void set_message (Lisp_Object);
static int set_message_1 (ptrdiff_t, Lisp_Object);
static int display_echo_area (struct window *);
static int display_echo_area_1 (ptrdiff_t, Lisp_Object);
static int resize_mini_window_1 (ptrdiff_t, Lisp_Object);
-static Lisp_Object unwind_redisplay (Lisp_Object);
+static void unwind_redisplay (void);
static int string_char_and_length (const unsigned char *, int *);
static struct text_pos display_prop_end (struct it *, Lisp_Object,
struct text_pos);
@@ -10146,7 +10145,7 @@ with_echo_area_buffer_unwind_data (struct window *w)
/* Restore global state from VECTOR which was created by
with_echo_area_buffer_unwind_data. */
-static Lisp_Object
+static void
unwind_with_echo_area_buffer (Lisp_Object vector)
{
set_buffer_internal_1 (XBUFFER (AREF (vector, 0)));
@@ -10171,7 +10170,6 @@ unwind_with_echo_area_buffer (Lisp_Object vector)
}
Vwith_echo_area_save_vector = vector;
- return Qnil;
}
@@ -10570,20 +10568,12 @@ restore_message (void)
}
-/* Handler for record_unwind_protect calling pop_message. */
-
-Lisp_Object
-pop_message_unwind (Lisp_Object dummy)
-{
- pop_message ();
- return Qnil;
-}
-
-/* Pop the top-most entry off Vmessage_stack. */
+/* Handler for unwind-protect calling pop_message. */
-static void
-pop_message (void)
+void
+pop_message_unwind (void)
{
+ /* Pop the top-most entry off Vmessage_stack. */
eassert (CONSP (Vmessage_stack));
Vmessage_stack = XCDR (Vmessage_stack);
}
@@ -10979,7 +10969,7 @@ format_mode_line_unwind_data (struct frame *target_frame,
return vector;
}
-static Lisp_Object
+static void
unwind_format_mode_line (Lisp_Object vector)
{
Lisp_Object old_window = AREF (vector, 7);
@@ -11022,7 +11012,6 @@ unwind_format_mode_line (Lisp_Object vector)
}
Vmode_line_unwind_vector = vector;
- return Qnil;
}
@@ -11471,7 +11460,7 @@ int last_tool_bar_item;
do_switch_frame.
FIXME: Maybe do_switch_frame should be trimmed down similarly
when `norecord' is set. */
-static Lisp_Object
+static void
fast_set_selected_frame (Lisp_Object frame)
{
if (!EQ (selected_frame, frame))
@@ -11479,7 +11468,6 @@ fast_set_selected_frame (Lisp_Object frame)
selected_frame = frame;
selected_window = XFRAME (frame)->selected_window;
}
- return Qnil;
}
/* Update the tool-bar item list for frame F. This has to be done
@@ -11999,9 +11987,8 @@ redisplay_tool_bar (struct frame *f)
XSETFRAME (frame, f);
Fmodify_frame_parameters (frame,
- Fcons (Fcons (Qtool_bar_lines,
- make_number (nlines)),
- Qnil));
+ list1 (Fcons (Qtool_bar_lines,
+ make_number (nlines))));
if (WINDOW_TOTAL_LINES (w) != old_height)
{
clear_glyph_matrix (w->desired_matrix);
@@ -12100,9 +12087,8 @@ redisplay_tool_bar (struct frame *f)
{
XSETFRAME (frame, f);
Fmodify_frame_parameters (frame,
- Fcons (Fcons (Qtool_bar_lines,
- make_number (nlines)),
- Qnil));
+ list1 (Fcons (Qtool_bar_lines,
+ make_number (nlines))));
if (WINDOW_TOTAL_LINES (w) != old_height)
{
clear_glyph_matrix (w->desired_matrix);
@@ -12982,7 +12968,7 @@ redisplay_internal (void)
/* Record a function that clears redisplaying_p
when we leave this function. */
count = SPECPDL_INDEX ();
- record_unwind_protect (unwind_redisplay, selected_frame);
+ record_unwind_protect_void (unwind_redisplay);
redisplaying_p = 1;
specbind (Qinhibit_free_realized_faces, Qnil);
@@ -13662,14 +13648,12 @@ redisplay_preserve_echo_area (int from_where)
}
-/* Function registered with record_unwind_protect in redisplay_internal.
- Clear redisplaying_p. Also select the previously selected frame. */
+/* Function registered with record_unwind_protect in redisplay_internal. */
-static Lisp_Object
-unwind_redisplay (Lisp_Object old_frame)
+static void
+unwind_redisplay (void)
{
redisplaying_p = 0;
- return Qnil;
}
@@ -15624,10 +15608,11 @@ redisplay_window (Lisp_Object window, int just_this_one_p)
the Y coordinate of the _next_ row, see the definition of
MATRIX_ROW_BOTTOM_Y. */
if (w->cursor.vpos < margin + header_line)
- new_vpos
- = pixel_margin + (header_line
- ? CURRENT_HEADER_LINE_HEIGHT (w)
- : 0) + frame_line_height;
+ {
+ w->cursor.vpos = -1;
+ clear_glyph_matrix (w->desired_matrix);
+ goto try_to_scroll;
+ }
else
{
int window_height = window_box_height (w);
@@ -15635,7 +15620,11 @@ redisplay_window (Lisp_Object window, int just_this_one_p)
if (header_line)
window_height += CURRENT_HEADER_LINE_HEIGHT (w);
if (w->cursor.y >= window_height - pixel_margin)
- new_vpos = window_height - pixel_margin;
+ {
+ w->cursor.vpos = -1;
+ clear_glyph_matrix (w->desired_matrix);
+ goto try_to_scroll;
+ }
}
}
@@ -21345,7 +21334,7 @@ store_mode_line_string (const char *string, Lisp_Object lisp_string, int copy_st
if (NILP (face))
face = mode_line_string_face;
else
- face = Fcons (face, Fcons (mode_line_string_face, Qnil));
+ face = list2 (face, mode_line_string_face);
props = Fplist_put (props, Qface, face);
}
Fadd_text_properties (make_number (0), make_number (len),
@@ -21369,8 +21358,8 @@ store_mode_line_string (const char *string, Lisp_Object lisp_string, int copy_st
if (NILP (face))
face = mode_line_string_face;
else
- face = Fcons (face, Fcons (mode_line_string_face, Qnil));
- props = Fcons (Qface, Fcons (face, Qnil));
+ face = list2 (face, mode_line_string_face);
+ props = list2 (Qface, face);
if (copy_string)
lisp_string = Fcopy_sequence (lisp_string);
}
@@ -21484,7 +21473,7 @@ are the selected window and the WINDOW's buffer). */)
mode_line_string_list = Qnil;
mode_line_string_face = face;
mode_line_string_face_prop
- = (NILP (face) ? Qnil : Fcons (Qface, Fcons (face, Qnil)));
+ = NILP (face) ? Qnil : list2 (Qface, face);
}
push_kboard (FRAME_KBOARD (it.f));
@@ -29234,9 +29223,8 @@ syms_of_xdisp (void)
DEFSYM (Qarrow, "arrow");
DEFSYM (Qinhibit_free_realized_faces, "inhibit-free-realized-faces");
- list_of_error = Fcons (Fcons (intern_c_string ("error"),
- Fcons (intern_c_string ("void-variable"), Qnil)),
- Qnil);
+ list_of_error = list1 (list2 (intern_c_string ("error"),
+ intern_c_string ("void-variable")));
staticpro (&list_of_error);
DEFSYM (Qlast_arrow_position, "last-arrow-position");
@@ -29340,7 +29328,7 @@ See also `overlay-arrow-position'. */);
The symbols on this list are examined during redisplay to determine
where to display overlay arrows. */);
Voverlay_arrow_variable_list
- = Fcons (intern_c_string ("overlay-arrow-position"), Qnil);
+ = list1 (intern_c_string ("overlay-arrow-position"));
DEFVAR_INT ("scroll-step", emacs_scroll_step,
doc: /* The number of lines to try scrolling a window by when point moves out.
diff --git a/src/xfaces.c b/src/xfaces.c
index 4b42cb7dc40..f647ff2e209 100644
--- a/src/xfaces.c
+++ b/src/xfaces.c
@@ -3388,7 +3388,7 @@ set_font_frame_param (Lisp_Object frame, Lisp_Object lface)
ASET (lface, LFACE_FONT_INDEX, font);
}
f->default_face_done_p = 0;
- Fmodify_frame_parameters (frame, Fcons (Fcons (Qfont, font), Qnil));
+ Fmodify_frame_parameters (frame, list1 (Fcons (Qfont, font)));
}
}
@@ -3709,14 +3709,10 @@ Value is nil if ATTR doesn't have a discrete set of valid values. */)
CHECK_SYMBOL (attr);
- if (EQ (attr, QCunderline))
- result = Fcons (Qt, Fcons (Qnil, Qnil));
- else if (EQ (attr, QCoverline))
- result = Fcons (Qt, Fcons (Qnil, Qnil));
- else if (EQ (attr, QCstrike_through))
- result = Fcons (Qt, Fcons (Qnil, Qnil));
- else if (EQ (attr, QCinverse_video) || EQ (attr, QCreverse_video))
- result = Fcons (Qt, Fcons (Qnil, Qnil));
+ if (EQ (attr, QCunderline) || EQ (attr, QCoverline)
+ || EQ (attr, QCstrike_through)
+ || EQ (attr, QCinverse_video) || EQ (attr, QCreverse_video))
+ result = list2 (Qt, Qnil);
return result;
}
@@ -3779,21 +3775,18 @@ Default face attributes override any local face attributes. */)
&& newface->font)
{
Lisp_Object name = newface->font->props[FONT_NAME_INDEX];
- Fmodify_frame_parameters (frame, Fcons (Fcons (Qfont, name),
- Qnil));
+ Fmodify_frame_parameters (frame, list1 (Fcons (Qfont, name)));
}
if (STRINGP (gvec[LFACE_FOREGROUND_INDEX]))
Fmodify_frame_parameters (frame,
- Fcons (Fcons (Qforeground_color,
- gvec[LFACE_FOREGROUND_INDEX]),
- Qnil));
+ list1 (Fcons (Qforeground_color,
+ gvec[LFACE_FOREGROUND_INDEX])));
if (STRINGP (gvec[LFACE_BACKGROUND_INDEX]))
Fmodify_frame_parameters (frame,
- Fcons (Fcons (Qbackground_color,
- gvec[LFACE_BACKGROUND_INDEX]),
- Qnil));
+ list1 (Fcons (Qbackground_color,
+ gvec[LFACE_BACKGROUND_INDEX])));
}
}
@@ -6290,6 +6283,7 @@ where R,G,B are numbers between 0 and 255 and name is an arbitrary string. */)
CHECK_STRING (filename);
abspath = Fexpand_file_name (filename, Qnil);
+ block_input ();
fp = emacs_fopen (SSDATA (abspath), "rt");
if (fp)
{
@@ -6297,29 +6291,24 @@ where R,G,B are numbers between 0 and 255 and name is an arbitrary string. */)
int red, green, blue;
int num;
- block_input ();
-
while (fgets (buf, sizeof (buf), fp) != NULL) {
if (sscanf (buf, "%u %u %u %n", &red, &green, &blue, &num) == 3)
{
- char *name = buf + num;
- num = strlen (name) - 1;
- if (num >= 0 && name[num] == '\n')
- name[num] = 0;
- cmap = Fcons (Fcons (build_string (name),
#ifdef HAVE_NTGUI
- make_number (RGB (red, green, blue))),
+ int color = RGB (red, green, blue);
#else
- make_number ((red << 16) | (green << 8) | blue)),
+ int color = (red << 16) | (green << 8) | blue;
#endif
+ char *name = buf + num;
+ ptrdiff_t len = strlen (name);
+ len -= 0 < len && name[len - 1] == '\n';
+ cmap = Fcons (Fcons (make_string (name, len), make_number (color)),
cmap);
}
}
fclose (fp);
-
- unblock_input ();
}
-
+ unblock_input ();
return cmap;
}
#endif
@@ -6483,7 +6472,7 @@ syms_of_xfaces (void)
DEFSYM (Qtty_color_alist, "tty-color-alist");
DEFSYM (Qscalable_fonts_allowed, "scalable-fonts-allowed");
- Vparam_value_alist = Fcons (Fcons (Qnil, Qnil), Qnil);
+ Vparam_value_alist = list1 (Fcons (Qnil, Qnil));
staticpro (&Vparam_value_alist);
Vface_alternative_font_family_alist = Qnil;
staticpro (&Vface_alternative_font_family_alist);
diff --git a/src/xfns.c b/src/xfns.c
index a1c709a6c26..a3eff1a5cce 100644
--- a/src/xfns.c
+++ b/src/xfns.c
@@ -1715,7 +1715,7 @@ x_default_scroll_bar_color_parameter (struct frame *f,
#endif /* not USE_TOOLKIT_SCROLL_BARS */
}
- x_set_frame_parameters (f, Fcons (Fcons (prop, tem), Qnil));
+ x_set_frame_parameters (f, list1 (Fcons (prop, tem)));
return tem;
}
@@ -2883,11 +2883,16 @@ unwind_create_frame (Lisp_Object frame)
return Qnil;
}
-static Lisp_Object
+static void
+do_unwind_create_frame (Lisp_Object frame)
+{
+ unwind_create_frame (frame);
+}
+
+static void
unwind_create_frame_1 (Lisp_Object val)
{
inhibit_lisp_code = val;
- return Qnil;
}
static void
@@ -2948,7 +2953,7 @@ x_default_font_parameter (struct frame *f, Lisp_Object parms)
{
/* Remember the explicit font parameter, so we can re-apply it after
we've applied the `default' face settings. */
- x_set_frame_parameters (f, Fcons (Fcons (Qfont_param, font_param), Qnil));
+ x_set_frame_parameters (f, list1 (Fcons (Qfont_param, font_param)));
}
/* This call will make X resources override any system font setting. */
@@ -3090,7 +3095,7 @@ This function is an internal primitive--use `make-frame' instead. */)
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);
+ record_unwind_protect (do_unwind_create_frame, frame);
/* These colors will be set anyway later, but it's important
to get the color reference counts right, so initialize them! */
@@ -4975,7 +4980,7 @@ Window tip_window;
static Lisp_Object last_show_tip_args;
-static Lisp_Object
+static void
unwind_create_tip_frame (Lisp_Object frame)
{
Lisp_Object deleted;
@@ -4986,8 +4991,6 @@ unwind_create_tip_frame (Lisp_Object frame)
tip_window = None;
tip_frame = Qnil;
}
-
- return deleted;
}
@@ -5238,7 +5241,7 @@ x_create_tip_frame (struct x_display_info *dpyinfo,
/* Add `tooltip' frame parameter's default value. */
if (NILP (Fframe_parameter (frame, Qtooltip)))
- Fmodify_frame_parameters (frame, Fcons (Fcons (Qtooltip, Qt), Qnil));
+ Fmodify_frame_parameters (frame, list1 (Fcons (Qtooltip, Qt)));
/* FIXME - can this be done in a similar way to normal frames?
http://lists.gnu.org/archive/html/emacs-devel/2007-10/msg00641.html */
@@ -5256,8 +5259,7 @@ x_create_tip_frame (struct x_display_info *dpyinfo,
disptype = intern ("color");
if (NILP (Fframe_parameter (frame, Qdisplay_type)))
- Fmodify_frame_parameters (frame, Fcons (Fcons (Qdisplay_type, disptype),
- Qnil));
+ Fmodify_frame_parameters (frame, list1 (Fcons (Qdisplay_type, disptype)));
}
/* Set up faces after all frame parameters are known. This call
@@ -5276,8 +5278,7 @@ x_create_tip_frame (struct x_display_info *dpyinfo,
call2 (Qface_set_after_frame_default, frame, Qnil);
if (!EQ (bg, Fframe_parameter (frame, Qbackground_color)))
- Fmodify_frame_parameters (frame, Fcons (Fcons (Qbackground_color, bg),
- Qnil));
+ Fmodify_frame_parameters (frame, list1 (Fcons (Qbackground_color, bg)));
}
f->no_split = 1;
@@ -5766,10 +5767,10 @@ file_dialog_unmap_cb (Widget widget, XtPointer client_data, XtPointer call_data)
*result = XmCR_CANCEL;
}
-static Lisp_Object
-clean_up_file_dialog (Lisp_Object arg)
+static void
+clean_up_file_dialog (void *arg)
{
- Widget dialog = XSAVE_POINTER (arg, 0);
+ Widget dialog = arg;
/* Clean up. */
block_input ();
@@ -5777,8 +5778,6 @@ clean_up_file_dialog (Lisp_Object arg)
XtDestroyWidget (dialog);
x_menu_set_in_use (0);
unblock_input ();
-
- return Qnil;
}
@@ -5893,7 +5892,7 @@ Otherwise, if ONLY-DIR-P is non-nil, the user can only select directories. */)
XmStringFree (default_xmstring);
}
- record_unwind_protect (clean_up_file_dialog, make_save_pointer (dialog));
+ record_unwind_protect_ptr (clean_up_file_dialog, dialog);
/* Process events until the user presses Cancel or OK. */
x_menu_set_in_use (1);
@@ -5947,12 +5946,10 @@ Otherwise, if ONLY-DIR-P is non-nil, the user can only select directories. */)
#ifdef USE_GTK
-static Lisp_Object
-clean_up_dialog (Lisp_Object arg)
+static void
+clean_up_dialog (void)
{
x_menu_set_in_use (0);
-
- return Qnil;
}
DEFUN ("x-file-dialog", Fx_file_dialog, Sx_file_dialog, 2, 5, 0,
@@ -5986,7 +5983,7 @@ Otherwise, if ONLY-DIR-P is non-nil, the user can only select directories. */)
/* Prevent redisplay. */
specbind (Qinhibit_redisplay, Qt);
- record_unwind_protect (clean_up_dialog, Qnil);
+ record_unwind_protect_void (clean_up_dialog);
block_input ();
@@ -6041,7 +6038,7 @@ nil, it defaults to the selected frame. */)
/* Prevent redisplay. */
specbind (Qinhibit_redisplay, Qt);
- record_unwind_protect (clean_up_dialog, Qnil);
+ record_unwind_protect_void (clean_up_dialog);
block_input ();
diff --git a/src/xfont.c b/src/xfont.c
index 9978aba76de..9647a51ac6e 100644
--- a/src/xfont.c
+++ b/src/xfont.c
@@ -295,9 +295,9 @@ xfont_supported_scripts (Display *display, char *fontname, Lisp_Object props,
/* Two special cases to avoid opening rather big fonts. */
if (EQ (AREF (props, 2), Qja))
- return Fcons (intern ("kana"), Fcons (intern ("han"), Qnil));
+ return list2 (intern ("kana"), intern ("han"));
if (EQ (AREF (props, 2), Qko))
- return Fcons (intern ("hangul"), Qnil);
+ return list1 (intern ("hangul"));
scripts = Fgethash (props, xfont_scripts_cache, Qt);
if (EQ (scripts, Qt))
{
diff --git a/src/xmenu.c b/src/xmenu.c
index 48ab3519723..6c0e3dd78a6 100644
--- a/src/xmenu.c
+++ b/src/xmenu.c
@@ -296,10 +296,10 @@ for instance using the window manager, then this produces a quit and
XSETFRAME (frame, f);
XSETINT (x, x_pixel_width (f) / 2);
XSETINT (y, x_pixel_height (f) / 2);
- newpos = Fcons (Fcons (x, Fcons (y, Qnil)), Fcons (frame, Qnil));
+ newpos = list2 (list2 (x, y), frame);
return Fx_popup_menu (newpos,
- Fcons (Fcar (contents), Fcons (contents, Qnil)));
+ list2 (Fcar (contents), contents));
}
#else
{
@@ -311,15 +311,15 @@ for instance using the window manager, then this produces a quit and
/* Decode the dialog items from what was specified. */
title = Fcar (contents);
CHECK_STRING (title);
- record_unwind_protect (unuse_menu_items, Qnil);
+ record_unwind_protect_void (unuse_menu_items);
if (NILP (Fcar (Fcdr (contents))))
/* No buttons specified, add an "Ok" button so users can pop down
the dialog. Also, the lesstif/motif version crashes if there are
no buttons. */
- contents = Fcons (title, Fcons (Fcons (build_string ("Ok"), Qt), Qnil));
+ contents = list2 (title, Fcons (build_string ("Ok"), Qt));
- list_of_panes (Fcons (contents, Qnil));
+ list_of_panes (list1 (contents));
/* Display them in a dialog box. */
block_input ();
@@ -1405,14 +1405,13 @@ popup_selection_callback (GtkWidget *widget, gpointer client_data)
if (cb_data) menu_item_selection = (Lisp_Object *) cb_data->call_data;
}
-static Lisp_Object
-pop_down_menu (Lisp_Object arg)
+static void
+pop_down_menu (void *arg)
{
popup_activated_flag = 0;
block_input ();
- gtk_widget_destroy (GTK_WIDGET (XSAVE_POINTER (arg, 0)));
+ gtk_widget_destroy (GTK_WIDGET (arg));
unblock_input ();
- return Qnil;
}
/* Pop up the menu for frame F defined by FIRST_WV at X/Y and loop until the
@@ -1474,7 +1473,7 @@ create_and_show_popup_menu (FRAME_PTR f, widget_value *first_wv, int x, int y,
gtk_menu_popup (GTK_MENU (menu), 0, 0, pos_func, &popup_x_y, i,
timestamp ? timestamp : gtk_get_current_event_time ());
- record_unwind_protect (pop_down_menu, make_save_pointer (menu));
+ record_unwind_protect_ptr (pop_down_menu, menu);
if (gtk_widget_get_mapped (menu))
{
@@ -1513,7 +1512,7 @@ popup_selection_callback (Widget widget, LWLIB_ID id, XtPointer client_data)
/* ARG is the LWLIB ID of the dialog box, represented
as a Lisp object as (HIGHPART . LOWPART). */
-static Lisp_Object
+static void
pop_down_menu (Lisp_Object arg)
{
LWLIB_ID id = (XINT (XCAR (arg)) << 4 * sizeof (LWLIB_ID)
@@ -1523,8 +1522,6 @@ pop_down_menu (Lisp_Object arg)
lw_destroy_all_widgets (id);
unblock_input ();
popup_activated_flag = 0;
-
- return Qnil;
}
/* Pop up the menu for frame F defined by FIRST_WV at X/Y and loop until the
@@ -1604,11 +1601,10 @@ create_and_show_popup_menu (FRAME_PTR f, widget_value *first_wv,
#endif /* not USE_GTK */
-static Lisp_Object
-cleanup_widget_value_tree (Lisp_Object arg)
+static void
+cleanup_widget_value_tree (void *arg)
{
- free_menubar_widget_value_tree (XSAVE_POINTER (arg, 0));
- return Qnil;
+ free_menubar_widget_value_tree (arg);
}
Lisp_Object
@@ -1822,8 +1818,7 @@ xmenu_show (FRAME_PTR f, int x, int y, bool for_click, bool keymaps,
/* Make sure to free the widget_value objects we used to specify the
contents even with longjmp. */
- record_unwind_protect (cleanup_widget_value_tree,
- make_save_pointer (first_wv));
+ record_unwind_protect_ptr (cleanup_widget_value_tree, first_wv);
/* Actually create and show the menu until popped down. */
create_and_show_popup_menu (f, first_wv, x, y, for_click, timestamp);
@@ -1871,7 +1866,7 @@ xmenu_show (FRAME_PTR f, int x, int y, bool for_click, bool keymaps,
{
int j;
- entry = Fcons (entry, Qnil);
+ entry = list1 (entry);
if (!NILP (prefix))
entry = Fcons (prefix, entry);
for (j = submenu_depth - 1; j >= 0; j--)
@@ -1922,7 +1917,7 @@ create_and_show_dialog (FRAME_PTR f, widget_value *first_wv)
if (menu)
{
ptrdiff_t specpdl_count = SPECPDL_INDEX ();
- record_unwind_protect (pop_down_menu, make_save_pointer (menu));
+ record_unwind_protect_ptr (pop_down_menu, menu);
/* Display the menu. */
gtk_widget_show_all (menu);
@@ -2132,8 +2127,7 @@ xdialog_show (FRAME_PTR f,
/* Make sure to free the widget_value objects we used to specify the
contents even with longjmp. */
- record_unwind_protect (cleanup_widget_value_tree,
- make_save_pointer (first_wv));
+ record_unwind_protect_ptr (cleanup_widget_value_tree, first_wv);
/* Actually create and show the dialog. */
create_and_show_dialog (f, first_wv);
@@ -2172,7 +2166,7 @@ xdialog_show (FRAME_PTR f,
{
if (keymaps != 0)
{
- entry = Fcons (entry, Qnil);
+ entry = list1 (entry);
if (!NILP (prefix))
entry = Fcons (prefix, entry);
}
@@ -2223,14 +2217,12 @@ menu_help_callback (char const *help_string, int pane, int item)
pane_name = first_item[MENU_ITEMS_ITEM_NAME];
/* (menu-item MENU-NAME PANE-NUMBER) */
- menu_object = Fcons (Qmenu_item,
- Fcons (pane_name,
- Fcons (make_number (pane), Qnil)));
+ menu_object = list3 (Qmenu_item, pane_name, make_number (pane));
show_help_echo (help_string ? build_string (help_string) : Qnil,
Qnil, menu_object, make_number (item));
}
-static Lisp_Object
+static void
pop_down_menu (Lisp_Object arg)
{
FRAME_PTR f = XSAVE_POINTER (arg, 0);
@@ -2257,8 +2249,6 @@ pop_down_menu (Lisp_Object arg)
#endif /* HAVE_X_WINDOWS */
unblock_input ();
-
- return Qnil;
}
@@ -2475,8 +2465,7 @@ xmenu_show (FRAME_PTR f, int x, int y, bool for_click, bool keymaps,
XMenuActivateSetWaitFunction (x_menu_wait_for_event, FRAME_X_DISPLAY (f));
#endif
- record_unwind_protect (pop_down_menu,
- make_save_value (SAVE_TYPE_PTR_PTR, f, menu));
+ record_unwind_protect (pop_down_menu, make_save_ptr_ptr (f, menu));
/* Help display under X won't work because XMenuActivate contains
a loop that doesn't give Emacs a chance to process it. */
@@ -2515,7 +2504,7 @@ xmenu_show (FRAME_PTR f, int x, int y, bool for_click, bool keymaps,
= AREF (menu_items, i + MENU_ITEMS_ITEM_VALUE);
if (keymaps)
{
- entry = Fcons (entry, Qnil);
+ entry = list1 (entry);
if (!NILP (pane_prefix))
entry = Fcons (pane_prefix, entry);
}
diff --git a/src/xml.c b/src/xml.c
index 4b466dc1bca..c330dce4a4a 100644
--- a/src/xml.c
+++ b/src/xml.c
@@ -124,7 +124,7 @@ make_dom (xmlNode *node)
{
if (node->type == XML_ELEMENT_NODE)
{
- Lisp_Object result = Fcons (intern ((char *) node->name), Qnil);
+ Lisp_Object result = list1 (intern ((char *) node->name));
xmlNode *child;
xmlAttr *property;
Lisp_Object plist = Qnil;
diff --git a/src/xselect.c b/src/xselect.c
index b422a22d68b..6a80eddc82c 100644
--- a/src/xselect.c
+++ b/src/xselect.c
@@ -45,26 +45,14 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
struct prop_location;
struct selection_data;
-static Lisp_Object x_atom_to_symbol (Display *dpy, Atom atom);
-static Atom symbol_to_x_atom (struct x_display_info *, Lisp_Object);
-static void x_own_selection (Lisp_Object, Lisp_Object, Lisp_Object);
-static Lisp_Object x_get_local_selection (Lisp_Object, Lisp_Object, int,
- struct x_display_info *);
static void x_decline_selection_request (struct input_event *);
-static Lisp_Object x_selection_request_lisp_error (Lisp_Object);
-static Lisp_Object queue_selection_requests_unwind (Lisp_Object);
-static Lisp_Object x_catch_errors_unwind (Lisp_Object);
-static void x_reply_selection_request (struct input_event *, struct x_display_info *);
static int x_convert_selection (struct input_event *, Lisp_Object, Lisp_Object,
Atom, int, struct x_display_info *);
static int waiting_for_other_props_on_window (Display *, Window);
static struct prop_location *expect_property_change (Display *, Window,
Atom, int);
static void unexpect_property_change (struct prop_location *);
-static Lisp_Object wait_for_property_change_unwind (Lisp_Object);
static void wait_for_property_change (struct prop_location *);
-static Lisp_Object x_get_foreign_selection (Lisp_Object, Lisp_Object,
- Lisp_Object, Lisp_Object);
static Lisp_Object x_get_window_property_as_lisp_data (Display *,
Window, Atom,
Lisp_Object, Atom);
@@ -74,7 +62,6 @@ static Lisp_Object selection_data_to_lisp_data (Display *,
static void lisp_data_to_selection_data (Display *, Lisp_Object,
unsigned char **, Atom *,
ptrdiff_t *, int *, int *);
-static Lisp_Object clean_local_selection_data (Lisp_Object);
/* Printing traces to stderr. */
@@ -513,8 +500,8 @@ static Atom conversion_fail_tag;
an error, we tell the requestor that we were unable to do what they wanted
before we throw to top-level or go into the debugger or whatever. */
-static Lisp_Object
-x_selection_request_lisp_error (Lisp_Object ignore)
+static void
+x_selection_request_lisp_error (void)
{
struct selection_data *cs, *next;
@@ -530,16 +517,14 @@ x_selection_request_lisp_error (Lisp_Object ignore)
if (x_selection_current_request != 0
&& selection_request_dpyinfo->display)
x_decline_selection_request (x_selection_current_request);
- return Qnil;
}
-static Lisp_Object
-x_catch_errors_unwind (Lisp_Object dummy)
+static void
+x_catch_errors_unwind (void)
{
block_input ();
x_uncatch_errors ();
unblock_input ();
- return Qnil;
}
@@ -560,11 +545,6 @@ struct prop_location
struct prop_location *next;
};
-static struct prop_location *expect_property_change (Display *display, Window window, Atom property, int state);
-static void wait_for_property_change (struct prop_location *location);
-static void unexpect_property_change (struct prop_location *location);
-static int waiting_for_other_props_on_window (Display *display, Window window);
-
static int prop_location_identifier;
static Lisp_Object property_change_reply;
@@ -573,13 +553,6 @@ static struct prop_location *property_change_reply_object;
static struct prop_location *property_change_wait_list;
-static Lisp_Object
-queue_selection_requests_unwind (Lisp_Object tem)
-{
- x_stop_queuing_selection_requests ();
- return Qnil;
-}
-
/* Send the reply to a selection request event EVENT. */
@@ -614,7 +587,7 @@ x_reply_selection_request (struct input_event *event,
/* The protected block contains wait_for_property_change, which can
run random lisp code (process handlers) or signal. Therefore, we
put the x_uncatch_errors call in an unwind. */
- record_unwind_protect (x_catch_errors_unwind, Qnil);
+ record_unwind_protect_void (x_catch_errors_unwind);
x_catch_errors (display);
/* Loop over converted selections, storing them in the requested
@@ -805,12 +778,12 @@ x_handle_selection_request (struct input_event *event)
x_selection_current_request = event;
selection_request_dpyinfo = dpyinfo;
- record_unwind_protect (x_selection_request_lisp_error, Qnil);
+ record_unwind_protect_void (x_selection_request_lisp_error);
/* We might be able to handle nested x_handle_selection_requests,
but this is difficult to test, and seems unimportant. */
x_start_queuing_selection_requests ();
- record_unwind_protect (queue_selection_requests_unwind, Qnil);
+ record_unwind_protect_void (x_stop_queuing_selection_requests);
TRACE2 ("x_handle_selection_request: selection=%s, target=%s",
SDATA (SYMBOL_NAME (selection_symbol)),
@@ -1117,15 +1090,14 @@ unexpect_property_change (struct prop_location *location)
/* Remove the property change expectation element for IDENTIFIER. */
-static Lisp_Object
-wait_for_property_change_unwind (Lisp_Object loc)
+static void
+wait_for_property_change_unwind (void *loc)
{
- struct prop_location *location = XSAVE_POINTER (loc, 0);
+ struct prop_location *location = loc;
unexpect_property_change (location);
if (location == property_change_reply_object)
property_change_reply_object = 0;
- return Qnil;
}
/* Actually wait for a property change.
@@ -1140,8 +1112,7 @@ wait_for_property_change (struct prop_location *location)
emacs_abort ();
/* Make sure to do unexpect_property_change if we quit or err. */
- record_unwind_protect (wait_for_property_change_unwind,
- make_save_pointer (location));
+ record_unwind_protect_ptr (wait_for_property_change_unwind, location);
XSETCAR (property_change_reply, Qnil);
property_change_reply_object = location;
@@ -1254,7 +1225,7 @@ x_get_foreign_selection (Lisp_Object selection_symbol, Lisp_Object target_type,
SelectionNotify. */
#if 0
x_start_queuing_selection_requests ();
- record_unwind_protect (queue_selection_requests_unwind, Qnil);
+ record_unwind_protect_void (x_stop_queuing_selection_requests);
#endif
unblock_input ();
diff --git a/src/xterm.c b/src/xterm.c
index 818b69cc41d..b3534871da9 100644
--- a/src/xterm.c
+++ b/src/xterm.c
@@ -3435,13 +3435,12 @@ x_focus_changed (int type, int state, struct x_display_info *dpyinfo, struct fra
/* Don't stop displaying the initial startup message
for a switch-frame event we don't need. */
/* When run as a daemon, Vterminal_frame is always NIL. */
- if ((NILP (Vterminal_frame) || EQ (Fdaemonp(), Qt))
- && CONSP (Vframe_list)
- && !NILP (XCDR (Vframe_list)))
- {
- bufp->kind = FOCUS_IN_EVENT;
- XSETFRAME (bufp->frame_or_window, frame);
- }
+ bufp->arg = (((NILP (Vterminal_frame) || EQ (Fdaemonp (), Qt))
+ && CONSP (Vframe_list)
+ && !NILP (XCDR (Vframe_list)))
+ ? Qt : Qnil);
+ bufp->kind = FOCUS_IN_EVENT;
+ XSETFRAME (bufp->frame_or_window, frame);
}
frame->output_data.x->focus_state |= state;
@@ -3459,6 +3458,9 @@ x_focus_changed (int type, int state, struct x_display_info *dpyinfo, struct fra
{
dpyinfo->x_focus_event_frame = 0;
x_new_focus_frame (dpyinfo, 0);
+
+ bufp->kind = FOCUS_OUT_EVENT;
+ XSETFRAME (bufp->frame_or_window, frame);
}
#ifdef HAVE_X_I18N
@@ -8372,9 +8374,9 @@ set_wm_state (Lisp_Object frame, int add, Atom atom, Atom value)
(make_number (add ? 1 : 0),
Fcons
(make_fixnum_or_float (atom),
- value != 0
- ? Fcons (make_fixnum_or_float (value), Qnil)
- : Qnil)));
+ (value != 0
+ ? list1 (make_fixnum_or_float (value))
+ : Qnil))));
}
void