summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/.gdbinit91
-rw-r--r--src/ChangeLog572
-rw-r--r--src/Makefile.in16
-rw-r--r--src/alloc.c30
-rw-r--r--src/buffer.c2
-rw-r--r--src/data.c164
-rw-r--r--src/dbusbind.c1793
-rw-r--r--src/dired.c41
-rw-r--r--src/dispextern.h1
-rw-r--r--src/dispnew.c19
-rw-r--r--src/editfns.c164
-rw-r--r--src/emacsgtkfixed.c31
-rw-r--r--src/emacsgtkfixed.h26
-rw-r--r--src/eval.c2
-rw-r--r--src/fileio.c22
-rw-r--r--src/filelock.c8
-rw-r--r--src/font.h7
-rw-r--r--src/frame.h3
-rw-r--r--src/gmalloc.c603
-rw-r--r--src/gnutls.c10
-rw-r--r--src/gtkutil.c2
-rw-r--r--src/intervals.c1
-rw-r--r--src/keyboard.c179
-rw-r--r--src/keymap.c17
-rw-r--r--src/lisp.h61
-rw-r--r--src/lisp.mk3
-rw-r--r--src/lread.c4
-rw-r--r--src/m/vax.h23
-rw-r--r--src/makefile.w32-in3
-rw-r--r--src/ns.mk12
-rw-r--r--src/nsterm.m11
-rw-r--r--src/print.c130
-rw-r--r--src/process.c50
-rw-r--r--src/ralloc.c60
-rw-r--r--src/regex.c17
-rw-r--r--src/s/ms-w32.h2
-rw-r--r--src/search.c181
-rw-r--r--src/sound.c7
-rw-r--r--src/sysdep.c228
-rw-r--r--src/syssignal.h15
-rw-r--r--src/term.c2
-rw-r--r--src/undo.c15
-rw-r--r--src/unexaix.c25
-rw-r--r--src/w32fns.c14
-rw-r--r--src/w32font.c7
-rw-r--r--src/w32menu.c9
-rw-r--r--src/w32proc.c20
-rw-r--r--src/w32term.c25
-rw-r--r--src/window.c5
-rw-r--r--src/xdisp.c184
-rw-r--r--src/xfns.c7
-rw-r--r--src/xgselect.c15
-rw-r--r--src/xselect.c1
-rw-r--r--src/xterm.c2
-rw-r--r--src/xterm.h1
55 files changed, 2420 insertions, 2523 deletions
diff --git a/src/.gdbinit b/src/.gdbinit
index 7cd828733b1..8f8508f291f 100644
--- a/src/.gdbinit
+++ b/src/.gdbinit
@@ -54,7 +54,7 @@ end
define xgetint
set $bugfix = $arg0
- set $int = gdb_use_union ? $bugfix.s.val : (gdb_use_lsb ? $bugfix : $bugfix << gdb_gctypebits) >> gdb_gctypebits
+ set $int = gdb_use_union ? $bugfix.s.val : (gdb_use_lsb ? $bugfix >> (gdb_gctypebits - 1) : $bugfix << gdb_gctypebits) >> gdb_gctypebits
end
define xgettype
@@ -703,60 +703,6 @@ Print $ as a misc free-cell pointer.
This command assumes that $ is an Emacs Lisp Misc value.
end
-define xintfwd
- xgetptr $
- print (struct Lisp_Intfwd *) $ptr
-end
-document xintfwd
-Print $ as an integer forwarding pointer.
-This command assumes that $ is an Emacs Lisp Misc value.
-end
-
-define xboolfwd
- xgetptr $
- print (struct Lisp_Boolfwd *) $ptr
-end
-document xboolfwd
-Print $ as a boolean forwarding pointer.
-This command assumes that $ is an Emacs Lisp Misc value.
-end
-
-define xobjfwd
- xgetptr $
- print (struct Lisp_Objfwd *) $ptr
-end
-document xobjfwd
-Print $ as an object forwarding pointer.
-This command assumes that $ is an Emacs Lisp Misc value.
-end
-
-define xbufobjfwd
- xgetptr $
- print (struct Lisp_Buffer_Objfwd *) $ptr
-end
-document xbufobjfwd
-Print $ as a buffer-local object forwarding pointer.
-This command assumes that $ is an Emacs Lisp Misc value.
-end
-
-define xkbobjfwd
- xgetptr $
- print (struct Lisp_Kboard_Objfwd *) $ptr
-end
-document xkbobjfwd
-Print $ as a kboard-local object forwarding pointer.
-This command assumes that $ is an Emacs Lisp Misc value.
-end
-
-define xbuflocal
- xgetptr $
- print (struct Lisp_Buffer_Local_Value *) $ptr
-end
-document xbuflocal
-Print $ as a buffer-local-value pointer.
-This command assumes that $ is an Emacs Lisp Misc value.
-end
-
define xsymbol
set $sym = $
xgetptr $sym
@@ -1003,8 +949,15 @@ end
define xpr
xtype
- if $type == Lisp_Int
- xint
+ if gdb_use_union
+ if $type == Lisp_Int
+ xint
+ end
+ end
+ if !gdb_use_union
+ if $type == Lisp_Int0 || $type == Lisp_Int1
+ xint
+ end
end
if $type == Lisp_Symbol
xsymbol
@@ -1023,36 +976,12 @@ define xpr
if $misc == Lisp_Misc_Free
xmiscfree
end
- if $misc == Lisp_Misc_Boolfwd
- xboolfwd
- end
if $misc == Lisp_Misc_Marker
xmarker
end
- if $misc == Lisp_Misc_Intfwd
- xintfwd
- end
- if $misc == Lisp_Misc_Boolfwd
- xboolfwd
- end
- if $misc == Lisp_Misc_Objfwd
- xobjfwd
- end
- if $misc == Lisp_Misc_Buffer_Objfwd
- xbufobjfwd
- end
- if $misc == Lisp_Misc_Buffer_Local_Value
- xbuflocal
- end
-# if $misc == Lisp_Misc_Some_Buffer_Local_Value
-# xvalue
-# end
if $misc == Lisp_Misc_Overlay
xoverlay
end
- if $misc == Lisp_Misc_Kboard_Objfwd
- xkbobjfwd
- end
# if $misc == Lisp_Misc_Save_Value
# xsavevalue
# end
diff --git a/src/ChangeLog b/src/ChangeLog
index 0fa21336900..ea898893073 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,5 +1,575 @@
+2012-05-20 Ken Brown <kbrown@cornell.edu>
+
+ * gmalloc.c (_free_internal_nolock, _realloc_internal_nolock)
+ [CYGWIN]: Cast ptr to (char *) before comparing to _heapbase.
+
+2012-05-19 Ken Brown <kbrown@cornell.edu>
+
+ * xfns.c (x_in_use): Remove `static' qualifier.
+ * xterm.h (x_in_use): Declare.
+ * xgselect.c: Include xterm.h.
+ (xg_select): Test `x_in_use' instead of `inhibit_window_system'
+ and `display_arg' (bug#9754).
+
+2012-05-19 Paul Eggert <eggert@cs.ucla.edu>
+
+ * s/ms-w32.h (HAVE_GETDOMAINNAME): Remove; not needed.
+
+ * m/vax.h: Remove; no longer needed since HAVE_FTIME is being removed.
+ * s/ms-w32.h (HAVE_FTIME): Remove; not needed.
+
+2012-05-18 Eli Zaretskii <eliz@gnu.org>
+
+ Fix compilation with -DGLYPH_DEBUG=1 on MS-Windows.
+
+ * w32term.c [GLYPH_DEBUG]: Add prototype for x_check_font.
+ (x_check_font) [GLYPH_DEBUG]: New function, copied from xterm.c
+
+ * w32fns.c (unwind_create_frame) [GLYPH_DEBUG]: Fix broken
+ reference to image_cache->refcount.
+ (x_create_tip_frame): Fix broken use of FRAME_IMAGE_CACHE.
+
+2012-05-17 Juri Linkov <juri@jurta.org>
+
+ * search.c (Fword_search_regexp, Fword_search_backward)
+ (Fword_search_forward, Fword_search_backward_lax)
+ (Fword_search_forward_lax): Move functions to isearch.el
+ (bug#10145, bug#11381).
+
+2012-05-16 Paul Eggert <eggert@cs.ucla.edu>
+
+ * xgselect.c (xg_select): Just invoke 'select' if -nw (Bug#9754).
+
+2012-05-15 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * lread.c (init_obarray): Declare Qt and Qnil as special.
+
+2012-05-14 Glenn Morris <rgm@gnu.org>
+
+ * nsterm.m (ns_init_paths): Fix typo ("libexec" not "lib-exec").
+ Put "libexec" before "bin", for the sake of init_callproc_1.
+
+2012-05-14 Paul Eggert <eggert@cs.ucla.edu>
+
+ * keyboard.c (kbd_buffer_get_event) [!HAVE_DBUS]: Omit unused local.
+
+ * unexaix.c: Port to more-recent AIX compilers.
+ (report_error, report_error_1, make_hdr, copy_sym)
+ (mark_x, adjust_lnnoptrs, unrelocate_symbols):
+ Make arguments const char *, not char *, to avoid violations of C
+ standard and to fix some AIX warnings reported by Gilles Pion.
+
+2012-05-14 Eli Zaretskii <eliz@gnu.org>
+
+ * xdisp.c (handle_stop): Don't call get_overlay_strings_1 if we
+ already have overlays loaded.
+ (handle_single_display_spec): Before returning without displaying
+ fringe bitmap, synchronize the bidi iterator with the main display
+ iterator, by calling iterate_out_of_display_property.
+ (iterate_out_of_display_property): Detect buffer iteration by
+ testing that it->string is a Lisp string.
+ (get_next_display_element): When the current object is exhausted,
+ and there's something on it->stack, call set_iterator_to_next to
+ proceed with what's on the stack, instead of returning zero.
+ (set_iterator_to_next): If called at the end of a Lisp string,
+ proceed to consider_string_end without incrementing string
+ position. Don't increment display vector index past the end of
+ the display vector. (Bug#11417)
+ (pos_visible_p): Don't report a position visible when move_it_to
+ stopped at the last line of window, which happens to be scanned
+ backwards by the bidi iteration. (Bug#11464)
+
+2012-05-14 Eli Zaretskii <eliz@gnu.org>
+
+ * xdisp.c (handle_single_display_spec): Return 1 for left-margin
+ and right-margin display specs even if the spec is invalid or we
+ are on a TTY, and thus unable to display on the fringes. That's
+ because the text with the property will not be displayed anyway,
+ so we need to signal to the caller that this is a "replacing"
+ display spec. This fixes display when the spec is invalid or we
+ are on a TTY.
+
+2012-05-14 Paul Eggert <eggert@cs.ucla.edu>
+
+ * unexaix.c (make_hdr): Fix typo in prototype.
+ This bug broke the build on AIX. Problem reported by Gilles Pion.
+
+2012-05-14 Michael Albinus <michael.albinus@gmx.de>
+
+ * keyboard.c (kbd_buffer_get_event): Read special events also in
+ batch mode. (Bug#11415)
+
+2012-05-12 Glenn Morris <rgm@gnu.org>
+
+ * ns.mk: Update for ns_appbindir no longer having trailing "/".
+
+2012-05-12 Eli Zaretskii <eliz@gnu.org>
+
+ * lisp.mk (lisp): Add newcomment.elc.
+
+2012-05-12 Glenn Morris <rgm@gnu.org>
+
+ * Makefile.in (MKDIR_P): New, set by configure.
+ * ns.mk (${ns_appdir}, ${ns_appbindir}Emacs): Use $MKDIR_P.
+
+2012-05-11 Paul Eggert <eggert@cs.ucla.edu>
+
+ Remove unused function hourglass_started.
+ * dispextern.h (hourglass_started):
+ * w32fns.c (hourglass_started):
+ * xdisp.c (hourglass_started): Remove.
+
+2012-05-10 Juanma Barranquero <lekktu@gmail.com>
+
+ * makefile.w32-in ($(BLD)/gmalloc.$(O), $(BLD)/w32menu.$(O)):
+ Update dependencies.
+
+2012-05-10 Paul Eggert <eggert@cs.ucla.edu>
+
+ * xgselect.c (xg_select): Put maxfds+1 into a var.
+ This is slightly clearer, and pacifies Ubuntu 12.04 gcc.
+
+ * sound.c (DEFAULT_ALSA_SOUND_DEVICE): Define only if HAVE_ALSA.
+
+2012-05-10 Dave Abrahams <dave@boostpro.com>
+
+ * filelock.c (syms_of_filelock): New boolean create-lockfiles.
+ (lock_file): If create_lockfiles is 0, do nothing. (Bug#11227)
+
+2012-05-09 Michael Albinus <michael.albinus@gmx.de>
+
+ * dbusbind.c (xd_registered_buses): New internal Lisp object.
+ Rename all occurences of Vdbus_registered_buses to xd_registered_buses.
+ (syms_of_dbusbind): Remove declaration of Vdbus_registered_buses.
+ Initialize xd_registered_buses.
+
+2012-05-09 Paul Eggert <eggert@cs.ucla.edu>
+
+ Untag more efficiently if USE_LSB_TAG.
+ This is based on a proposal by YAMAMOTO Mitsuharu in
+ <http://lists.gnu.org/archive/html/emacs-devel/2008-01/msg01876.html>.
+ For an admittedly artificial (nth 8000 longlist) benchmark on
+ Fedora 15 x86-64, this yields a 25% CPU speedup. Also, it shrinks
+ Emacs's overall text size by 1%.
+ * lisp.h (XUNTAG): New macro.
+ (XCONS, XVECTOR, XSTRING, XSYMBOL, XFLOAT, XMISC, XPROCESS, XWINDOW)
+ (XTERMINAL, XSUBR, XBUFFER, XCHAR_TABLE, XSUB_CHAR_TABLE, XBOOL_VECTOR)
+ (XSETTYPED_PSEUDOVECTOR, XHASH_TABLE, TYPED_PSEUDOVECTORP): Use it.
+ * eval.c (Fautoload):
+ * font.h (XFONT_SPEC, XFONT_ENTITY, XFONT_OBJECT):
+ * frame.h (XFRAME): Use XUNTAG.
+
+ Port recent dbusbind.c changes to 32-bit --with-wide-int.
+ * dbusbind.c (xd_append_arg, xd_retrieve_arg, Fdbus_message_internal):
+ Remove unportable assumptions about print widths of types like
+ dbus_uint32_t.
+ (xd_get_connection_address, Fdbus_init_bus): Cast Emacs integer to
+ intptr_t when converting between pointer and integer, to avoid GCC
+ warnings about wrong width.
+
+2012-05-09 Eli Zaretskii <eliz@gnu.org>
+
+ * w32proc.c (new_child): Force Windows to reserve only 64KB of
+ stack for each reader_thread, instead of defaulting to 8MB
+ determined by the linker. This avoids failures in creating
+ subprocesses on Windows 7, see the discussion in this thread:
+ http://lists.gnu.org/archive/html/emacs-devel/2012-03/msg00119.html.
+
+2012-05-07 Jérémy Compostella <jeremy.compostella@gmail.com>
+
+ Fix up display of the *Minibuf-0* buffer in the mini window.
+ * keyboard.c (read_char): Don't clear the echo area if there's no
+ message to clear.
+ * xdisp.c (redisplay_internal): Redisplay the mini window (with the
+ contents of *Minibuf-0*) if there's no message displayed in its stead.
+
+2012-05-07 Michael Albinus <michael.albinus@gmx.de>
+
+ * dbusbind.c (XD_DEBUG_MESSAGE): Don't print message twice in
+ batch mode.
+
+2012-05-06 Chong Yidong <cyd@gnu.org>
+
+ * lisp.mk (lisp): Update.
+
+2012-05-05 Jim Meyering <meyering@redhat.com>
+
+ * w32font.c (fill_in_logfont): NUL-terminate a string (Bug#11372).
+
+2012-05-04 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * data.c (PUT_ERROR): New macro.
+ (syms_of_data): Use it. Add new error type `user-error'.
+ * undo.c (user_error): New function.
+ (Fprimitive_undo): Use it.
+ * print.c (print_error_message): Adjust print style for `user-error'.
+ * keyboard.c (user_error): New function.
+ (Fexit_recursive_edit, Fabort_recursive_edit): Use it.
+
+2012-05-03 Paul Eggert <eggert@cs.ucla.edu>
+
+ Do not limit current-time-string to years 1000..9999.
+ * editfns.c (TM_YEAR_IN_ASCTIME_RANGE): Remove.
+ (Fcurrent_time_string): Support any year that is supported by the
+ underlying localtime representation. Don't use asctime, as it
+ has undefined behavior for years outside the range -999..9999.
+
+2012-05-02 Paul Eggert <eggert@cs.ucla.edu>
+
+ Fix race conditions involving setenv, gmtime, localtime, asctime.
+ Without this fix, interrupts could mess up code that uses these
+ nonreentrant functions, since setting TZ invalidates existing
+ tm_zone or tzname values, and since most of these functions return
+ pointers to static storage.
+ * editfns.c (format_time_string, Fdecode_time, Fencode_time)
+ (Fcurrent_time_string, Fcurrent_time_zone, Fset_time_zone_rule):
+ Grow the critical sections to include not just invoking
+ localtime/gmtime, but also accessing these functions' results
+ including their tm_zone values if any, and any related TZ setting.
+ (format_time_string): Last arg is now struct tm *, not struct tm **,
+ so that the struct tm is saved in the critical section.
+ All callers changed. Simplify allocation of initial buffer, partly
+ motivated by the fact that memory allocation needs to be outside
+ the critical section.
+
+2012-05-02 Dmitry Antipov <dmantipov@yandex.ru>
+
+ * intervals.c (adjust_intervals_for_insertion): Initialize `newi'
+ with RESET_INTERVAL.
+
+ * buffer.c (Fget_buffer_create, Fmake_indirect_buffer):
+ Remove duplicated buffer name initialization.
+
+2012-05-02 Jim Meyering <jim@meyering.net>
+
+ * xterm.c (x_term_init): Use memcpy instead of strncpy (Bug#11373).
+
+ * xfns.c (x_window): Use xstrdup (Bug#11375).
+
+2012-05-02 Eli Zaretskii <eliz@gnu.org>
+
+ * xdisp.c (pos_visible_p): If already at a newline from the
+ display string before the 'while' loop, don't walk back the glyphs
+ from it3.glyph_row. Solves assertion violation when the display
+ string begins with a newline (egg.el). (Bug#11367)
+
+2012-05-01 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * keyboard.c (Fexecute_extended_command, Vsuggest_key_bindings):
+ Move to simple.el.
+
+2012-05-01 Glenn Morris <rgm@gnu.org>
+
+ * syssignal.h: Remove reference to BROKEN_SIGINFO (last used in
+ s/ptx4.h), BROKEN_SIGTSTP (last used in m/ustation.h, m/dpx2.h),
+ and BROKEN_SIGURG (was in s/gnu-linux.h prior to 2008-02-10).
+ All were removed before 23.1.
+
+ * dispnew.c: Remove HAVE_LIBNCURSES test;
+ it is always true on relevant platforms.
+
+ * Makefile.in (LD_SWITCH_X_SITE_RPATH):
+ Rename from LD_SWITCH_X_SITE_AUX_RPATH.
+
+ * Makefile.in (LD_SWITCH_X_SITE_AUX): Remove; no longer used.
+
+2012-04-30 Andreas Schwab <schwab@linux-m68k.org>
+
+ * .gdbinit (xpr): Remove checks for no longer existing misc types.
+ (xintfwd, xboolfwd, xobjfwd, xbufobjfwd, xkbobjfwd, xbuflocal):
+ Remove.
+
+2012-04-28 Paul Eggert <eggert@cs.ucla.edu>
+
+ Do not avoid creating empty evaporating overlays (Bug#9642).
+ * buffer.c (Fmove_overlay): Revert the change of 2012-04-23.
+ That is, do not delete an evaporating overlay if it becomes
+ empty after its bounds are adjusted to fit within its buffer.
+ This fix caused other problems, and I'm reverting it until we get
+ to the bottom of them.
+
+2012-04-27 Chong Yidong <cyd@gnu.org>
+
+ * xselect.c (x_convert_selection): Initialize a pointer (Bug#11315).
+
+2012-04-27 Eli Zaretskii <eliz@gnu.org>
+
+ * xdisp.c (pos_visible_p): If the window start position is beyond
+ ZV, start the display from buffer beginning. Prevents assertion
+ violation in init_iterator when the minibuffer window is scrolled
+ via the scroll bar.
+
+ * window.c (window_scroll_pixel_based): Likewise.
+
+2012-04-27 Chong Yidong <cyd@gnu.org>
+
+ * keymap.c (where_is_internal): Doc fix (Bug#10872).
+
+2012-04-27 Glenn Morris <rgm@gnu.org>
+
+ * fileio.c (Fcopy_file, Fset_file_selinux_context):
+ Ignore ENOTSUP failures from setfilecon functions. (Bug#11245)
+
+2012-04-27 Eli Zaretskii <eliz@gnu.org>
+
+ * dispnew.c (swap_glyph_pointers, copy_row_except_pointers):
+ Don't overrun array limits of glyph row's used[] array. (Bug#11288)
+
+2012-04-26 Eli Zaretskii <eliz@gnu.org>
+
+ * xdisp.c (IT_DISPLAYING_WHITESPACE): In addition to the loaded
+ display element, check also the underlying string or buffer
+ character. (Bug#11341)
+
+ * w32menu.c: Include w32heap.h.
+ (add_menu_item): If the call to AppendMenuW (via
+ unicode_append_menu) fails, disable Unicode menus only if we are
+ running on Windows 9X/Me.
+
+2012-04-24 Andreas Schwab <schwab@linux-m68k.org>
+
+ * .gdbinit (xpr): Handle USE_2_TAGS_FOR_INTS.
+ (xgetint): Add missing shift for LSB tags.
+
+2012-04-24 Martin Rudalics <rudalics@gmx.at>
+
+ * keyboard.c (read_char): Don't wipe echo area for select window
+ events: These might get delayed via `mouse-autoselect-window'
+ (Bug#11304).
+
+2012-04-24 Juanma Barranquero <lekktu@gmail.com>
+
+ * gnutls.c (init_gnutls_functions): Protect against (unlikely)
+ manipulation of :loaded-from data.
+
+2012-04-23 Juanma Barranquero <lekktu@gmail.com>
+
+ * gnutls.c (init_gnutls_functions): The value of :loaded-from is
+ now a cons (bug#11311).
+
+2012-04-23 Paul Eggert <eggert@cs.ucla.edu>
+
+ Do not create empty overlays with the evaporate property (Bug#9642).
+ * buffer.c (Fmove_overlay): Delete an evaporating overlay
+ if it becomes empty after its bounds are adjusted to fit within
+ its buffer. Without this fix, in a nonempty buffer (let ((o
+ (make-overlay 1 2))) (overlay-put o 'evaporate t) (move-overlay o 0 1))
+ yields an empty overlay that has the evaporate property, which is
+ not supposed to happen.
+
+ Fix minor GTK3 problems found by static checking.
+ * emacsgtkfixed.c (EMACS_TYPE_FIXED, EMACS_FIXED, EmacsFixed)
+ (EmacsFixedPrivate, EmacsFixedClass, struct _EmacsFixed)
+ (struct _EmacsFixedClass, emacs_fixed_get_type):
+ Move decls here from emacsgtkfixed.h, since they needn't be public.
+ (emacs_fixed_get_type): Now static.
+ (emacs_fixed_class_init): Omit unused local.
+ (emacs_fixed_child_type): Remove; unused.
+ * emacsgtkfixed.h (EMACS_TYPE_FIXED, EMACS_FIXED, EmacsFixed)
+ (EmacsFixedPrivate, EmacsFixedClass, struct _EmacsFixed)
+ (struct _EmacsFixedClass): Move to emacsgtkfixed.c.
+ (EMACS_FIXED_CLASS, EMACS_IS_FIXED, EMACS_IS_FIXED_CLASS)
+ (EMACS_FIXED_GET_CLASS): Remove; unused.
+ * gtkutil.c (xg_create_frame_widgets) [!HAVE_GTK3]: Omit unused local.
+
+ * keyboard.c (handle_async_input): Define only if SYNC_INPUT || SIGIO.
+ Problem reported by Juanma Barranquero for Windows -Wunused-function.
+
+2012-04-22 Paul Eggert <eggert@cs.ucla.edu>
+
+ Modernize and clean up gmalloc.c to assume C89 (Bug#9119).
+ * gmalloc.c: (_MALLOC_INTERNAL, _MALLOC_H, _PP, __ptr_t)
+ (__malloc_size_t, __malloc_ptrdiff_t):
+ Remove. All uses removed, replaced by the definiens if needed,
+ since we can assume C89 or better now.
+ Include <stdint.h>, for PTRDIFF_MAX, uintptr_t.
+ (protect_malloc_state, align, get_contiguous_space)
+ (malloc_atfork_handler_prepare, malloc_atfork_handler_parent)
+ (malloc_atfork_handler_child, malloc_enable_thread)
+ (malloc_initialize_1, __malloc_initialize, morecore_nolock)
+ (_malloc_internal_nolock, _malloc_internal, malloc, _malloc)
+ (_free, _realloc, _free_internal_nolock, _free_internal, free, cfree)
+ (special_realloc, _realloc_internal_nolock, _realloc_internal)
+ (realloc, calloc, __default_morecore, memalign, valloc, checkhdr)
+ (freehook, mallochook, reallochook, mabort, mcheck, mprobe):
+ Define using prototypes, not old style.
+ (align, _malloc_internal_nolock, _free_internal_nolock, memalign):
+ Don't assume ptrdiff_t and uintptr_t are no wider than unsigned long.
+ (align): Don't assume that signed integer overflow wraps around.
+ Omit unused local var.
+ (malloc_initialize_1, morecore_nolock, _malloc_internal_nolock)
+ (_free_internal_nolock, memalign, mallochook, reallochook):
+ Omit no-longer-needed casts.
+ (valloc): Use getpagesize, not __getpagesize.
+ (MAGICWORD, MAGICFREE): Now randomish size_t values, not 32-bit.
+ (struct hdr): The 'magic' member is now size_t, not unsigned long.
+
+ * dbusbind.c (XD_DBUS_VALIDATE_OBJECT): Define only if needed.
+
+2012-04-22 Michael Albinus <michael.albinus@gmx.de>
+
+ Move functions from C to Lisp. Make non-blocking method calls
+ the default. Implement further D-Bus standard interfaces.
+
+ * dbusbind.c (DBUS_NUM_MESSAGE_TYPES): Declare.
+ (QCdbus_request_name_allow_replacement)
+ (QCdbus_request_name_replace_existing)
+ (QCdbus_request_name_do_not_queue)
+ (QCdbus_request_name_reply_primary_owner)
+ (QCdbus_request_name_reply_in_queue)
+ (QCdbus_request_name_reply_exists)
+ (QCdbus_request_name_reply_already_owner): Move to dbus.el.
+ (QCdbus_registered_serial, QCdbus_registered_method)
+ (QCdbus_registered_signal): New Lisp objects.
+ (XD_DEBUG_MESSAGE): Use sizeof.
+ (XD_MESSAGE_TYPE_TO_STRING, XD_OBJECT_TO_STRING)
+ (XD_DBUS_VALIDATE_BUS_ADDRESS, XD_DBUS_VALIDATE_OBJECT)
+ (XD_DBUS_VALIDATE_BUS_NAME, XD_DBUS_VALIDATE_PATH)
+ (XD_DBUS_VALIDATE_INTERFACE, XD_DBUS_VALIDATE_MEMBER): New macros.
+ (XD_CHECK_DBUS_SERIAL): Rename from CHECK_DBUS_SERIAL_GET_SERIAL.
+ (xd_signature, xd_append_arg): Allow float for integer types.
+ (xd_get_connection_references): New function.
+ (xd_get_connection_address): Rename from xd_initialize.
+ Return cached address.
+ (xd_remove_watch): Do not unset $DBUS_SESSION_BUS_ADDRESS.
+ (xd_close_bus): Rename from Fdbus_close_bus. Not needed on Lisp
+ level.
+ (Fdbus_init_bus): New optional arg PRIVATE. Cache address.
+ Return number of refcounts.
+ (Fdbus_get_unique_name): Make stronger parameter check.
+ (Fdbus_message_internal): New defun.
+ (Fdbus_call_method, Fdbus_call_method_asynchronously)
+ (Fdbus_method_return_internal, Fdbus_method_error_internal)
+ (Fdbus_send_signal, Fdbus_register_service)
+ (Fdbus_register_signal, Fdbus_register_method): Move to dbus.el.
+ (xd_read_message_1): Obey new structure of Vdbus_registered_objects.
+ (xd_read_queued_messages): Obey new structure of Vdbus_registered_buses.
+ (Vdbus_compiled_version, Vdbus_runtime_version)
+ (Vdbus_message_type_invalid, Vdbus_message_type_method_call)
+ (Vdbus_message_type_method_return, Vdbus_message_type_error)
+ (Vdbus_message_type_signal): New defvars.
+ (Vdbus_registered_buses, Vdbus_registered_objects_table):
+ Adapt docstring.
+
+2012-04-22 Paul Eggert <eggert@cs.ucla.edu>
+
+ Fix GC_MALLOC_CHECK debugging output on 64-bit hosts.
+ * alloc.c (emacs_blocked_malloc) [GC_MALLOC_CHECK]:
+ Do not assume ptrdiff_t is the same width as 'int'.
+
+ * alloc.c: Handle unusual debugging option combinations.
+ (GC_CHECK_MARKED_OBJECTS): Undef if ! GC_MARK_STACK,
+ since the two debugging options are incompatible.
+ (GC_MALLOC_CHECK): Similarly, undef if GC_CHECK_MARKED_OBJECTS
+ is defined.
+ (mem_init, mem_insert, mem_insert_fixup):
+ Define if GC_MARK_STACK || GC_MALLOC_CHECK.
+ (NEED_MEM_INSERT): Remove; no longer needed.
+
+2012-04-22 Leo Liu <sdl.web@gmail.com>
+
+ * sysdep.c (list_system_processes): Support Darwin (Bug#5725).
+
+2012-04-22 Paul Eggert <eggert@cs.ucla.edu>
+
+ * sysdep.c [__FreeBSD__]: Minor cleanups.
+ (list_system_processes, system_process_attributes) [__FreeBSD__]:
+ Use Emacs indenting style more consistently. Avoid some casts.
+ Use 'double' consistently rather than mixing 'float' and 'double'.
+
+2012-04-21 Eduard Wiebe <usenet@pusto.de>
+
+ * sysdep.c (list_system_processes, system_process_attributes):
+ Add implementation for FreeBSD (Bug#5243).
+
+2012-04-21 Andreas Schwab <schwab@linux-m68k.org>
+
+ * lisp.mk (lisp): Update.
+
+2012-04-20 Paul Eggert <eggert@cs.ucla.edu>
+
+ * keyboard.c (process_pending_signals): Define only if SYNC_INPUT.
+ It is never used otherwise.
+
+2012-04-20 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * print.c (print_preprocess): Only check print_depth if print-circle
+ is nil.
+ (print_object): Check for cycles even when print-circle is nil and
+ print-gensym is t, but only check print_depth if print-circle is nil.
+
+2012-04-20 Chong Yidong <cyd@gnu.org>
+
+ * process.c (wait_reading_process_output): If EIO occurs on a pty,
+ set the status to "failed" and ensure that sentinel is run.
+
+2012-04-20 Glenn Morris <rgm@gnu.org>
+
+ * process.c (Fset_process_inherit_coding_system_flag)
+ (Fset_process_query_on_exit_flag): Doc fix (mention return value).
+ (Fmake_network_process, Fmake_serial_process): Doc fix.
+
+2012-04-20 Eli Zaretskii <eliz@gnu.org>
+
+ * xdisp.c (string_buffer_position_lim): Limit starting position to
+ BEGV.
+ (set_cursor_from_row): If called for a mode-line or header-line
+ row, return zero immediately.
+ (try_cursor_movement): If inside continuation line, don't back up
+ farther than the first row after the header line, if any.
+ Don't consider the header-line row as "partially visible", even if
+ MATRIX_ROW_PARTIALLY_VISIBLE_P returns non-zero. (Bug#11261)
+
+2012-04-20 Atsuo Ohki <ohki@gssm.otsuka.tsukuba.ac.jp> (tiny change)
+
+ * lread.c (lisp_file_lexically_bound_p): Fix hang at ";-*-\n"
+ (bug#11238).
+
+2012-04-20 Teodor Zlatanov <tzz@lifelogs.com>
+2012-04-18 Paul Eggert <eggert@cs.ucla.edu>
+
+ configure: new option --enable-gcc-warnings (Bug#11207)
+ * Makefile.in (C_WARNINGS_SWITCH): Remove.
+ (WARN_CFLAGS, WERROR_CFLAGS): New macros.
+ (ALL_CFLAGS): Use new macros rather than old.
+ * process.c: Ignore -Wstrict-overflow to work around GCC bug 52904.
+ * regex.c: Ignore -Wstrict-overflow. If !emacs, also ignore
+ -Wunused-but-set-variable, -Wunused-function, -Wunused-macros,
+ -Wunused-result, -Wunused-variable. This should go away once
+ the Emacs and Gnulib regex code is merged.
+ (xmalloc, xrealloc): Now static.
+
+2012-04-17 Paul Eggert <eggert@cs.ucla.edu>
+
+ * dired.c (Fsystem_groups): Remove unused local.
+
+2012-04-17 Glenn Morris <rgm@gnu.org>
+
+ * dired.c (Fsystem_users): Doc fix.
+
+2012-04-17 Dmitry Antipov <dmantipov@yandex.ru>
+
+ * dired.c (Fsystem_users, Fsystem_groups): New functions. (Bug#7900)
+ (syms_of_dired): Add them.
+
2012-04-16 Paul Eggert <eggert@cs.ucla.edu>
+ Fix minor alloc.c problems found by static checking.
+ * alloc.c (_malloc_internal, _free_internal) [!DOUG_LEA_MALLOC]:
+ New extern decls, to avoid calling undeclared functions.
+ (dont_register_blocks): Define if ((!SYSTEM_MALLOC && !SYNC_INPUT)
+ && GC_MALLOC_CHECK), not if ((GC_MARK_STACK || defined
+ GC_MALLOC_CHECK) && GC_MALLOC_CHECK), to match when it's used.
+ (NEED_MEM_INSERT): New macro.
+ (mem_insert, mem_insert_fixup) [!NEED_MEM_INSERT]: Remove; unused.
+ Remove one incorrect comment and fix another.
+
+ Fix minor ralloc.c problems found by static checking.
+ See http://lists.gnu.org/archive/html/emacs-devel/2011-12/msg00720.html
+ * ralloc.c (ALIGNED, ROUND_TO_PAGE, HEAP_PTR_SIZE)
+ (r_alloc_size_in_use, r_alloc_freeze, r_alloc_thaw): Remove; unused.
+ (r_alloc_sbrk): Now static.
+
Improve ralloc.c interface checking.
See http://lists.gnu.org/archive/html/emacs-devel/2011-12/msg00720.html
* buffer.c (ralloc_reset_variable, r_alloc, r_re_alloc)
@@ -22,7 +592,7 @@
(union aligned_Lisp_Misc): Define.
(MARKER_BLOCK_SIZE, struct marker_block): Use union
aligned_Lisp_Misc instead of union Lisp_Misc.
- (Fmake_symbol, allocate_misc, gc_sweep): Adjust
+ (Fmake_symbol, allocate_misc, gc_sweep): Adjust.
2012-04-14 Paul Eggert <eggert@cs.ucla.edu>
diff --git a/src/Makefile.in b/src/Makefile.in
index e8b68040c44..8d4c5306782 100644
--- a/src/Makefile.in
+++ b/src/Makefile.in
@@ -40,6 +40,7 @@ version = @version@
# Substitute an assignment for the MAKE variable, because
# BSD doesn't have it as a default.
@SET_MAKE@
+MKDIR_P = @MKDIR_P@
# Don't use LIBS. configure puts stuff in it that either shouldn't be
# linked with Emacs or is duplicated by the other stuff below.
# LIBS = @LIBS@
@@ -68,7 +69,8 @@ OTHER_FILES = @OTHER_FILES@
PROFILING_CFLAGS = @PROFILING_CFLAGS@
## Flags to pass to the compiler to enable build warnings
-C_WARNINGS_SWITCH = @C_WARNINGS_SWITCH@
+WARN_CFLAGS = @WARN_CFLAGS@
+WERROR_CFLAGS = @WERROR_CFLAGS@
## Machine-specific CFLAGS.
C_SWITCH_MACHINE=@C_SWITCH_MACHINE@
@@ -93,11 +95,9 @@ C_SWITCH_X_SITE=@C_SWITCH_X_SITE@
## substituted in this or any other Makefile. Cf C_SWITCH_X_SITE.
LD_SWITCH_X_SITE=
-## Next two must come before LD_SWITCH_SYSTEM.
-## If needed, a -R option that says where to find X windows at run time.
-LD_SWITCH_X_SITE_AUX=@LD_SWITCH_X_SITE_AUX@
-## As above, but using -rpath instead.
-LD_SWITCH_X_SITE_AUX_RPATH=@LD_SWITCH_X_SITE_AUX_RPATH@
+## This must come before LD_SWITCH_SYSTEM.
+## If needed, a -rpath option that says where to find X windows at run time.
+LD_SWITCH_X_SITE_RPATH=@LD_SWITCH_X_SITE_RPATH@
## System-specific LDFLAGS.
LD_SWITCH_SYSTEM=@LD_SWITCH_SYSTEM@
@@ -291,7 +291,7 @@ CANNOT_DUMP=@CANNOT_DUMP@
DEPDIR=deps
## -MMD -MF $(DEPDIR)/$*.d if AUTO_DEPEND; else empty.
DEPFLAGS=@DEPFLAGS@
-## test -d $(DEPDIR) || mkdir $(DEPDIR) (if AUTO_DEPEND); else ':'.
+## ${MKDIR_P} ${DEPDIR} (if AUTO_DEPEND); else ':'.
MKDEPDIR=@MKDEPDIR@
## DO NOT use -R. There is a special hack described in lastfile.c
@@ -315,7 +315,7 @@ ALL_CFLAGS=-Demacs -DHAVE_CONFIG_H $(MYCPPFLAGS) -I. -I$(srcdir) \
$(SETTINGS_CFLAGS) $(FREETYPE_CFLAGS) $(FONTCONFIG_CFLAGS) \
$(LIBOTF_CFLAGS) $(M17N_FLT_CFLAGS) $(DEPFLAGS) $(PROFILING_CFLAGS) \
$(LIBGNUTLS_CFLAGS) \
- $(C_WARNINGS_SWITCH) $(CFLAGS)
+ $(WARN_CFLAGS) $(WERROR_CFLAGS) $(CFLAGS)
ALL_OBJC_CFLAGS=$(ALL_CFLAGS) $(GNU_OBJC_CFLAGS)
.SUFFIXES: .m
diff --git a/src/alloc.c b/src/alloc.c
index 0e68817629c..a120ce9b61f 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -49,10 +49,18 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <setjmp.h>
#include <verify.h>
+/* GC_CHECK_MARKED_OBJECTS means do sanity checks on allocated objects.
+ Doable only if GC_MARK_STACK. */
+#if ! GC_MARK_STACK
+# undef GC_CHECK_MARKED_OBJECTS
+#endif
+
/* GC_MALLOC_CHECK defined means perform validity checks of malloc'd
- memory. Can do this only if using gmalloc.c. */
+ memory. Can do this only if using gmalloc.c and if not checking
+ marked objects. */
-#if defined SYSTEM_MALLOC || defined DOUG_LEA_MALLOC
+#if (defined SYSTEM_MALLOC || defined DOUG_LEA_MALLOC \
+ || defined GC_CHECK_MARKED_OBJECTS)
#undef GC_MALLOC_CHECK
#endif
@@ -82,6 +90,8 @@ extern POINTER_TYPE *sbrk ();
extern size_t _bytes_used;
extern size_t __malloc_extra_blocks;
+extern void *_malloc_internal (size_t);
+extern void _free_internal (void *);
#endif /* not DOUG_LEA_MALLOC */
@@ -314,7 +324,6 @@ static Lisp_Object Vdead;
#ifdef GC_MALLOC_CHECK
enum mem_type allocated_mem_type;
-static int dont_register_blocks;
#endif /* GC_MALLOC_CHECK */
@@ -390,9 +399,11 @@ static int live_float_p (struct mem_node *, void *);
static int live_misc_p (struct mem_node *, void *);
static void mark_maybe_object (Lisp_Object);
static void mark_memory (void *, void *);
+#if GC_MARK_STACK || defined GC_MALLOC_CHECK
static void mem_init (void);
static struct mem_node *mem_insert (void *, void *, enum mem_type);
static void mem_insert_fixup (struct mem_node *);
+#endif
static void mem_rotate_left (struct mem_node *);
static void mem_rotate_right (struct mem_node *);
static void mem_delete (struct mem_node *);
@@ -942,9 +953,6 @@ lisp_free (POINTER_TYPE *block)
/* The entry point is lisp_align_malloc which returns blocks of at most
BLOCK_BYTES and guarantees they are aligned on a BLOCK_ALIGN boundary. */
-/* Use posix_memalloc if the system has it and we're using the system's
- malloc (because our gmalloc.c routines don't have posix_memalign although
- its memalloc could be used). */
#if defined (HAVE_POSIX_MEMALIGN) && defined (SYSTEM_MALLOC)
#define USE_POSIX_MEMALIGN 1
#endif
@@ -1001,7 +1009,7 @@ struct ablocks
struct ablock blocks[ABLOCKS_SIZE];
};
-/* Size of the block requested from malloc or memalign. */
+/* Size of the block requested from malloc or posix_memalign. */
#define ABLOCKS_BYTES (sizeof (struct ablocks) - BLOCK_PADDING)
#define ABLOCK_ABASE(block) \
@@ -1223,6 +1231,10 @@ static void (*old_free_hook) (void*, const void*);
# define BYTES_USED _bytes_used
#endif
+#ifdef GC_MALLOC_CHECK
+static int dont_register_blocks;
+#endif
+
static size_t bytes_used_when_reconsidered;
/* Value of _bytes_used, when spare_memory was freed. */
@@ -1302,7 +1314,7 @@ emacs_blocked_malloc (size_t size, const void *ptr)
{
fprintf (stderr, "Malloc returned %p which is already in use\n",
value);
- fprintf (stderr, "Region in use is %p...%p, %u bytes, type %d\n",
+ fprintf (stderr, "Region in use is %p...%p, %td bytes, type %d\n",
m->start, m->end, (char *) m->end - (char *) m->start,
m->type);
abort ();
@@ -5826,7 +5838,7 @@ mark_buffer (Lisp_Object buf)
}
/* Mark the Lisp pointers in the terminal objects.
- Called by the Fgarbage_collector. */
+ Called by Fgarbage_collect. */
static void
mark_terminals (void)
diff --git a/src/buffer.c b/src/buffer.c
index 9bac3ec742b..2ddbc699481 100644
--- a/src/buffer.c
+++ b/src/buffer.c
@@ -392,7 +392,6 @@ even if it is dead. The return value is never nil. */)
BVAR (b, mark) = Fmake_marker ();
BUF_MARKERS (b) = NULL;
- BVAR (b, name) = name;
/* Put this in the alist of all live buffers. */
XSETBUFFER (buffer, b);
@@ -612,7 +611,6 @@ CLONE nil means the indirect buffer's state is reset to default values. */)
Vbuffer_alist = nconc2 (Vbuffer_alist, Fcons (Fcons (name, buf), Qnil));
BVAR (b, mark) = Fmake_marker ();
- BVAR (b, name) = name;
/* The multibyte status belongs to the base buffer. */
BVAR (b, enable_multibyte_characters) = BVAR (b->base_buffer, enable_multibyte_characters);
diff --git a/src/data.c b/src/data.c
index bd1d89992cb..feacea2c08b 100644
--- a/src/data.c
+++ b/src/data.c
@@ -51,7 +51,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
Lisp_Object Qnil, Qt, Qquote, Qlambda, Qunbound;
static Lisp_Object Qsubr;
Lisp_Object Qerror_conditions, Qerror_message, Qtop_level;
-Lisp_Object Qerror, Qquit, Qargs_out_of_range;
+Lisp_Object Qerror, Quser_error, Qquit, Qargs_out_of_range;
static Lisp_Object Qwrong_type_argument;
Lisp_Object Qvoid_variable, Qvoid_function;
static Lisp_Object Qcyclic_function_indirection;
@@ -2937,6 +2937,7 @@ syms_of_data (void)
DEFSYM (Qtop_level, "top-level");
DEFSYM (Qerror, "error");
+ DEFSYM (Quser_error, "user-error");
DEFSYM (Qquit, "quit");
DEFSYM (Qwrong_type_argument, "wrong-type-argument");
DEFSYM (Qargs_out_of_range, "args-out-of-range");
@@ -3004,102 +3005,42 @@ syms_of_data (void)
Fput (Qerror, Qerror_message,
make_pure_c_string ("error"));
- Fput (Qquit, Qerror_conditions,
- pure_cons (Qquit, Qnil));
- Fput (Qquit, Qerror_message,
- make_pure_c_string ("Quit"));
-
- Fput (Qwrong_type_argument, Qerror_conditions,
- pure_cons (Qwrong_type_argument, error_tail));
- Fput (Qwrong_type_argument, Qerror_message,
- make_pure_c_string ("Wrong type argument"));
-
- Fput (Qargs_out_of_range, Qerror_conditions,
- pure_cons (Qargs_out_of_range, error_tail));
- Fput (Qargs_out_of_range, Qerror_message,
- make_pure_c_string ("Args out of range"));
-
- Fput (Qvoid_function, Qerror_conditions,
- pure_cons (Qvoid_function, error_tail));
- Fput (Qvoid_function, Qerror_message,
- make_pure_c_string ("Symbol's function definition is void"));
-
- Fput (Qcyclic_function_indirection, Qerror_conditions,
- pure_cons (Qcyclic_function_indirection, error_tail));
- Fput (Qcyclic_function_indirection, Qerror_message,
- make_pure_c_string ("Symbol's chain of function indirections contains a loop"));
-
- Fput (Qcyclic_variable_indirection, Qerror_conditions,
- pure_cons (Qcyclic_variable_indirection, error_tail));
- Fput (Qcyclic_variable_indirection, Qerror_message,
- make_pure_c_string ("Symbol's chain of variable indirections contains a loop"));
-
+#define PUT_ERROR(sym, tail, msg) \
+ Fput (sym, Qerror_conditions, pure_cons (sym, tail)); \
+ Fput (sym, Qerror_message, make_pure_c_string (msg))
+
+ PUT_ERROR (Qquit, Qnil, "Quit");
+
+ PUT_ERROR (Quser_error, error_tail, "");
+ PUT_ERROR (Qwrong_type_argument, error_tail, "Wrong type argument");
+ PUT_ERROR (Qargs_out_of_range, error_tail, "Args out of range");
+ PUT_ERROR (Qvoid_function, error_tail,
+ "Symbol's function definition is void");
+ PUT_ERROR (Qcyclic_function_indirection, error_tail,
+ "Symbol's chain of function indirections contains a loop");
+ PUT_ERROR (Qcyclic_variable_indirection, error_tail,
+ "Symbol's chain of variable indirections contains a loop");
DEFSYM (Qcircular_list, "circular-list");
- Fput (Qcircular_list, Qerror_conditions,
- pure_cons (Qcircular_list, error_tail));
- Fput (Qcircular_list, Qerror_message,
- make_pure_c_string ("List contains a loop"));
-
- Fput (Qvoid_variable, Qerror_conditions,
- pure_cons (Qvoid_variable, error_tail));
- Fput (Qvoid_variable, Qerror_message,
- make_pure_c_string ("Symbol's value as variable is void"));
-
- Fput (Qsetting_constant, Qerror_conditions,
- pure_cons (Qsetting_constant, error_tail));
- Fput (Qsetting_constant, Qerror_message,
- make_pure_c_string ("Attempt to set a constant symbol"));
-
- Fput (Qinvalid_read_syntax, Qerror_conditions,
- pure_cons (Qinvalid_read_syntax, error_tail));
- Fput (Qinvalid_read_syntax, Qerror_message,
- make_pure_c_string ("Invalid read syntax"));
-
- Fput (Qinvalid_function, Qerror_conditions,
- pure_cons (Qinvalid_function, error_tail));
- Fput (Qinvalid_function, Qerror_message,
- make_pure_c_string ("Invalid function"));
-
- Fput (Qwrong_number_of_arguments, Qerror_conditions,
- pure_cons (Qwrong_number_of_arguments, error_tail));
- Fput (Qwrong_number_of_arguments, Qerror_message,
- make_pure_c_string ("Wrong number of arguments"));
-
- Fput (Qno_catch, Qerror_conditions,
- pure_cons (Qno_catch, error_tail));
- Fput (Qno_catch, Qerror_message,
- make_pure_c_string ("No catch for tag"));
-
- Fput (Qend_of_file, Qerror_conditions,
- pure_cons (Qend_of_file, error_tail));
- Fput (Qend_of_file, Qerror_message,
- make_pure_c_string ("End of file during parsing"));
+ PUT_ERROR (Qcircular_list, error_tail, "List contains a loop");
+ PUT_ERROR (Qvoid_variable, error_tail, "Symbol's value as variable is void");
+ PUT_ERROR (Qsetting_constant, error_tail,
+ "Attempt to set a constant symbol");
+ PUT_ERROR (Qinvalid_read_syntax, error_tail, "Invalid read syntax");
+ PUT_ERROR (Qinvalid_function, error_tail, "Invalid function");
+ PUT_ERROR (Qwrong_number_of_arguments, error_tail,
+ "Wrong number of arguments");
+ PUT_ERROR (Qno_catch, error_tail, "No catch for tag");
+ PUT_ERROR (Qend_of_file, error_tail, "End of file during parsing");
arith_tail = pure_cons (Qarith_error, error_tail);
- Fput (Qarith_error, Qerror_conditions,
- arith_tail);
- Fput (Qarith_error, Qerror_message,
- make_pure_c_string ("Arithmetic error"));
-
- Fput (Qbeginning_of_buffer, Qerror_conditions,
- pure_cons (Qbeginning_of_buffer, error_tail));
- Fput (Qbeginning_of_buffer, Qerror_message,
- make_pure_c_string ("Beginning of buffer"));
-
- Fput (Qend_of_buffer, Qerror_conditions,
- pure_cons (Qend_of_buffer, error_tail));
- Fput (Qend_of_buffer, Qerror_message,
- make_pure_c_string ("End of buffer"));
-
- Fput (Qbuffer_read_only, Qerror_conditions,
- pure_cons (Qbuffer_read_only, error_tail));
- Fput (Qbuffer_read_only, Qerror_message,
- make_pure_c_string ("Buffer is read-only"));
-
- Fput (Qtext_read_only, Qerror_conditions,
- pure_cons (Qtext_read_only, error_tail));
- Fput (Qtext_read_only, Qerror_message,
- make_pure_c_string ("Text is read-only"));
+ Fput (Qarith_error, Qerror_conditions, arith_tail);
+ Fput (Qarith_error, Qerror_message, make_pure_c_string ("Arithmetic error"));
+
+ PUT_ERROR (Qbeginning_of_buffer, error_tail, "Beginning of buffer");
+ PUT_ERROR (Qend_of_buffer, error_tail, "End of buffer");
+ PUT_ERROR (Qbuffer_read_only, error_tail, "Buffer is read-only");
+ PUT_ERROR (Qtext_read_only, pure_cons (Qbuffer_read_only, error_tail),
+ "Text is read-only");
DEFSYM (Qrange_error, "range-error");
DEFSYM (Qdomain_error, "domain-error");
@@ -3107,30 +3048,17 @@ syms_of_data (void)
DEFSYM (Qoverflow_error, "overflow-error");
DEFSYM (Qunderflow_error, "underflow-error");
- Fput (Qdomain_error, Qerror_conditions,
- pure_cons (Qdomain_error, arith_tail));
- Fput (Qdomain_error, Qerror_message,
- make_pure_c_string ("Arithmetic domain error"));
-
- Fput (Qrange_error, Qerror_conditions,
- pure_cons (Qrange_error, arith_tail));
- Fput (Qrange_error, Qerror_message,
- make_pure_c_string ("Arithmetic range error"));
-
- Fput (Qsingularity_error, Qerror_conditions,
- pure_cons (Qsingularity_error, Fcons (Qdomain_error, arith_tail)));
- Fput (Qsingularity_error, Qerror_message,
- make_pure_c_string ("Arithmetic singularity error"));
-
- Fput (Qoverflow_error, Qerror_conditions,
- pure_cons (Qoverflow_error, Fcons (Qdomain_error, arith_tail)));
- Fput (Qoverflow_error, Qerror_message,
- make_pure_c_string ("Arithmetic overflow error"));
-
- Fput (Qunderflow_error, Qerror_conditions,
- pure_cons (Qunderflow_error, Fcons (Qdomain_error, arith_tail)));
- Fput (Qunderflow_error, Qerror_message,
- make_pure_c_string ("Arithmetic underflow error"));
+ PUT_ERROR (Qdomain_error, arith_tail, "Arithmetic domain error");
+
+ PUT_ERROR (Qrange_error, arith_tail, "Arithmetic range error");
+
+ PUT_ERROR (Qsingularity_error, Fcons (Qdomain_error, arith_tail),
+ "Arithmetic singularity error");
+
+ PUT_ERROR (Qoverflow_error, Fcons (Qdomain_error, arith_tail),
+ "Arithmetic overflow error");
+ PUT_ERROR (Qunderflow_error, Fcons (Qdomain_error, arith_tail),
+ "Arithmetic underflow error");
staticpro (&Qnil);
staticpro (&Qt);
diff --git a/src/dbusbind.c b/src/dbusbind.c
index ad1a3f3cbe8..62923b462b5 100644
--- a/src/dbusbind.c
+++ b/src/dbusbind.c
@@ -28,19 +28,15 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include "keyboard.h"
#include "process.h"
+#ifndef DBUS_NUM_MESSAGE_TYPES
+#define DBUS_NUM_MESSAGE_TYPES 5
+#endif
+
/* Subroutines. */
static Lisp_Object Qdbus_init_bus;
-static Lisp_Object Qdbus_close_bus;
static Lisp_Object Qdbus_get_unique_name;
-static Lisp_Object Qdbus_call_method;
-static Lisp_Object Qdbus_call_method_asynchronously;
-static Lisp_Object Qdbus_method_return_internal;
-static Lisp_Object Qdbus_method_error_internal;
-static Lisp_Object Qdbus_send_signal;
-static Lisp_Object Qdbus_register_service;
-static Lisp_Object Qdbus_register_signal;
-static Lisp_Object Qdbus_register_method;
+static Lisp_Object Qdbus_message_internal;
/* D-Bus error symbol. */
static Lisp_Object Qdbus_error;
@@ -51,17 +47,6 @@ static Lisp_Object QCdbus_system_bus, QCdbus_session_bus;
/* Lisp symbol for method call timeout. */
static Lisp_Object QCdbus_timeout;
-/* Lisp symbols for name request flags. */
-static Lisp_Object QCdbus_request_name_allow_replacement;
-static Lisp_Object QCdbus_request_name_replace_existing;
-static Lisp_Object QCdbus_request_name_do_not_queue;
-
-/* Lisp symbols for name request replies. */
-static Lisp_Object QCdbus_request_name_reply_primary_owner;
-static Lisp_Object QCdbus_request_name_reply_in_queue;
-static Lisp_Object QCdbus_request_name_reply_exists;
-static Lisp_Object QCdbus_request_name_reply_already_owner;
-
/* Lisp symbols of D-Bus types. */
static Lisp_Object QCdbus_type_byte, QCdbus_type_boolean;
static Lisp_Object QCdbus_type_int16, QCdbus_type_uint16;
@@ -75,6 +60,15 @@ static Lisp_Object QCdbus_type_unix_fd;
static Lisp_Object QCdbus_type_array, QCdbus_type_variant;
static Lisp_Object QCdbus_type_struct, QCdbus_type_dict_entry;
+/* Lisp symbols of objects in `dbus-registered-objects-table'. */
+static Lisp_Object QCdbus_registered_serial, QCdbus_registered_method;
+static Lisp_Object QCdbus_registered_signal;
+
+/* Alist of D-Bus buses we are polling for messages.
+ The key is the symbol or string of the bus, and the value is the
+ connection address. */
+static Lisp_Object xd_registered_buses;
+
/* Whether we are reading a D-Bus event. */
static int xd_in_read_queued_messages = 0;
@@ -120,14 +114,15 @@ static int xd_in_read_queued_messages = 0;
} while (0)
/* Macros for debugging. In order to enable them, build with
- "MYCPPFLAGS='-DDBUS_DEBUG -Wall' make". */
+ "env MYCPPFLAGS='-DDBUS_DEBUG -Wall' make". */
#ifdef DBUS_DEBUG
-#define XD_DEBUG_MESSAGE(...) \
- do { \
- char s[1024]; \
- snprintf (s, sizeof s, __VA_ARGS__); \
- printf ("%s: %s\n", __func__, s); \
- message ("%s: %s", __func__, s); \
+#define XD_DEBUG_MESSAGE(...) \
+ do { \
+ char s[1024]; \
+ snprintf (s, sizeof s, __VA_ARGS__); \
+ if (!noninteractive) \
+ printf ("%s: %s\n", __func__, s); \
+ message ("%s: %s", __func__, s); \
} while (0)
#define XD_DEBUG_VALID_LISP_OBJECT_P(object) \
do { \
@@ -144,7 +139,7 @@ static int xd_in_read_queued_messages = 0;
if (!NILP (Vdbus_debug)) \
{ \
char s[1024]; \
- snprintf (s, 1023, __VA_ARGS__); \
+ snprintf (s, sizeof s, __VA_ARGS__); \
message ("%s: %s", __func__, s); \
} \
} while (0)
@@ -241,23 +236,115 @@ xd_symbol_to_dbus_type (Lisp_Object object)
#define XD_NEXT_VALUE(object) \
((XD_DBUS_TYPE_P (CAR_SAFE (object))) ? CDR_SAFE (object) : object)
+/* Transform the message type to its string representation for debug
+ messages. */
+#define XD_MESSAGE_TYPE_TO_STRING(mtype) \
+ ((mtype == DBUS_MESSAGE_TYPE_INVALID) \
+ ? "DBUS_MESSAGE_TYPE_INVALID" \
+ : (mtype == DBUS_MESSAGE_TYPE_METHOD_CALL) \
+ ? "DBUS_MESSAGE_TYPE_METHOD_CALL" \
+ : (mtype == DBUS_MESSAGE_TYPE_METHOD_RETURN) \
+ ? "DBUS_MESSAGE_TYPE_METHOD_RETURN" \
+ : (mtype == DBUS_MESSAGE_TYPE_ERROR) \
+ ? "DBUS_MESSAGE_TYPE_ERROR" \
+ : "DBUS_MESSAGE_TYPE_SIGNAL")
+
+/* Transform the object to its string representation for debug
+ messages. */
+#define XD_OBJECT_TO_STRING(object) \
+ SDATA (format2 ("%s", object, Qnil))
+
/* Check whether X is a valid dbus serial number. If valid, set
SERIAL to its value. Otherwise, signal an error. */
-#define CHECK_DBUS_SERIAL_GET_SERIAL(x, serial) \
- do \
- { \
- dbus_uint32_t DBUS_SERIAL_MAX = -1; \
- if (NATNUMP (x) && XINT (x) <= DBUS_SERIAL_MAX) \
- serial = XINT (x); \
- else if (MOST_POSITIVE_FIXNUM < DBUS_SERIAL_MAX \
- && FLOATP (x) \
- && 0 <= XFLOAT_DATA (x) \
- && XFLOAT_DATA (x) <= DBUS_SERIAL_MAX) \
- serial = XFLOAT_DATA (x); \
- else \
- XD_SIGNAL2 (build_string ("Invalid dbus serial"), x); \
- } \
- while (0)
+#define XD_CHECK_DBUS_SERIAL(x, serial) \
+ do { \
+ dbus_uint32_t DBUS_SERIAL_MAX = -1; \
+ if (NATNUMP (x) && XINT (x) <= DBUS_SERIAL_MAX) \
+ serial = XINT (x); \
+ else if (MOST_POSITIVE_FIXNUM < DBUS_SERIAL_MAX \
+ && FLOATP (x) \
+ && 0 <= XFLOAT_DATA (x) \
+ && XFLOAT_DATA (x) <= DBUS_SERIAL_MAX) \
+ serial = XFLOAT_DATA (x); \
+ else \
+ XD_SIGNAL2 (build_string ("Invalid dbus serial"), x); \
+ } while (0)
+
+#define XD_DBUS_VALIDATE_BUS_ADDRESS(bus) \
+ do { \
+ if (STRINGP (bus)) \
+ { \
+ DBusAddressEntry **entries; \
+ int len; \
+ DBusError derror; \
+ dbus_error_init (&derror); \
+ if (!dbus_parse_address (SSDATA (bus), &entries, &len, &derror)) \
+ XD_ERROR (derror); \
+ /* Cleanup. */ \
+ dbus_error_free (&derror); \
+ dbus_address_entries_free (entries); \
+ } \
+ \
+ else \
+ { \
+ CHECK_SYMBOL (bus); \
+ if (!(EQ (bus, QCdbus_system_bus) || EQ (bus, QCdbus_session_bus))) \
+ XD_SIGNAL2 (build_string ("Wrong bus name"), bus); \
+ /* We do not want to have an autolaunch for the session bus. */ \
+ if (EQ (bus, QCdbus_session_bus) \
+ && getenv ("DBUS_SESSION_BUS_ADDRESS") == NULL) \
+ XD_SIGNAL2 (build_string ("No connection to bus"), bus); \
+ } \
+ } while (0)
+
+#if (HAVE_DBUS_VALIDATE_BUS_NAME || HAVE_DBUS_VALIDATE_PATH \
+ || XD_DBUS_VALIDATE_OBJECT || HAVE_DBUS_VALIDATE_MEMBER)
+#define XD_DBUS_VALIDATE_OBJECT(object, func) \
+ do { \
+ if (!NILP (object)) \
+ { \
+ DBusError derror; \
+ CHECK_STRING (object); \
+ dbus_error_init (&derror); \
+ if (!func (SSDATA (object), &derror)) \
+ XD_ERROR (derror); \
+ /* Cleanup. */ \
+ dbus_error_free (&derror); \
+ } \
+ } while (0)
+#endif
+
+#if HAVE_DBUS_VALIDATE_BUS_NAME
+#define XD_DBUS_VALIDATE_BUS_NAME(bus_name) \
+ XD_DBUS_VALIDATE_OBJECT(bus_name, dbus_validate_bus_name);
+#else
+#define XD_DBUS_VALIDATE_BUS_NAME(bus_name) \
+ if (!NILP (bus_name)) CHECK_STRING (bus_name);
+#endif
+
+#if HAVE_DBUS_VALIDATE_PATH
+#define XD_DBUS_VALIDATE_PATH(path) \
+ XD_DBUS_VALIDATE_OBJECT(path, dbus_validate_path);
+#else
+#define XD_DBUS_VALIDATE_PATH(path) \
+ if (!NILP (path)) CHECK_STRING (path);
+#endif
+
+#if HAVE_DBUS_VALIDATE_INTERFACE
+#define XD_DBUS_VALIDATE_INTERFACE(interface) \
+ XD_DBUS_VALIDATE_OBJECT(interface, dbus_validate_interface);
+#else
+#define XD_DBUS_VALIDATE_INTERFACE(interface) \
+ if (!NILP (interface)) CHECK_STRING (interface);
+#endif
+
+#if HAVE_DBUS_VALIDATE_MEMBER
+#define XD_DBUS_VALIDATE_MEMBER(member) \
+ XD_DBUS_VALIDATE_OBJECT(member, dbus_validate_member);
+#else
+#define XD_DBUS_VALIDATE_MEMBER(member) \
+ if (!NILP (member)) CHECK_STRING (member);
+#endif
/* Append to SIGNATURE a copy of X, making sure SIGNATURE does
not become too long. */
@@ -293,11 +380,6 @@ xd_signature (char *signature, unsigned int dtype, unsigned int parent_type, Lis
{
case DBUS_TYPE_BYTE:
case DBUS_TYPE_UINT16:
- case DBUS_TYPE_UINT32:
- case DBUS_TYPE_UINT64:
-#ifdef DBUS_TYPE_UNIX_FD
- case DBUS_TYPE_UNIX_FD:
-#endif
CHECK_NATNUM (object);
sprintf (signature, "%c", dtype);
break;
@@ -309,14 +391,19 @@ xd_signature (char *signature, unsigned int dtype, unsigned int parent_type, Lis
break;
case DBUS_TYPE_INT16:
- case DBUS_TYPE_INT32:
- case DBUS_TYPE_INT64:
CHECK_NUMBER (object);
sprintf (signature, "%c", dtype);
break;
+ case DBUS_TYPE_UINT32:
+ case DBUS_TYPE_UINT64:
+#ifdef DBUS_TYPE_UNIX_FD
+ case DBUS_TYPE_UNIX_FD:
+#endif
+ case DBUS_TYPE_INT32:
+ case DBUS_TYPE_INT64:
case DBUS_TYPE_DOUBLE:
- CHECK_FLOAT (object);
+ CHECK_NUMBER_OR_FLOAT (object);
sprintf (signature, "%c", dtype);
break;
@@ -352,8 +439,8 @@ xd_signature (char *signature, unsigned int dtype, unsigned int parent_type, Lis
}
/* If the element type is DBUS_TYPE_SIGNATURE, and this is the
- only element, the value of this element is used as he array's
- element signature. */
+ only element, the value of this element is used as the
+ array's element signature. */
if ((subtype == DBUS_TYPE_SIGNATURE)
&& STRINGP (CAR_SAFE (XD_NEXT_VALUE (elt)))
&& NILP (CDR_SAFE (XD_NEXT_VALUE (elt))))
@@ -469,7 +556,7 @@ xd_append_arg (unsigned int dtype, Lisp_Object object, DBusMessageIter *iter)
CHECK_NATNUM (object);
{
unsigned char val = XFASTINT (object) & 0xFF;
- XD_DEBUG_MESSAGE ("%c %d", dtype, val);
+ XD_DEBUG_MESSAGE ("%c %u", dtype, val);
if (!dbus_message_iter_append_basic (iter, dtype, &val))
XD_SIGNAL2 (build_string ("Unable to append argument"), object);
return;
@@ -488,7 +575,8 @@ xd_append_arg (unsigned int dtype, Lisp_Object object, DBusMessageIter *iter)
CHECK_NUMBER (object);
{
dbus_int16_t val = XINT (object);
- XD_DEBUG_MESSAGE ("%c %d", dtype, (int) val);
+ int pval = val;
+ XD_DEBUG_MESSAGE ("%c %d", dtype, pval);
if (!dbus_message_iter_append_basic (iter, dtype, &val))
XD_SIGNAL2 (build_string ("Unable to append argument"), object);
return;
@@ -498,17 +586,18 @@ xd_append_arg (unsigned int dtype, Lisp_Object object, DBusMessageIter *iter)
CHECK_NATNUM (object);
{
dbus_uint16_t val = XFASTINT (object);
- XD_DEBUG_MESSAGE ("%c %u", dtype, (unsigned int) val);
+ unsigned int pval = val;
+ XD_DEBUG_MESSAGE ("%c %u", dtype, pval);
if (!dbus_message_iter_append_basic (iter, dtype, &val))
XD_SIGNAL2 (build_string ("Unable to append argument"), object);
return;
}
case DBUS_TYPE_INT32:
- CHECK_NUMBER (object);
{
- dbus_int32_t val = XINT (object);
- XD_DEBUG_MESSAGE ("%c %d", dtype, val);
+ dbus_int32_t val = extract_float (object);
+ int pval = val;
+ XD_DEBUG_MESSAGE ("%c %d", dtype, pval);
if (!dbus_message_iter_append_basic (iter, dtype, &val))
XD_SIGNAL2 (build_string ("Unable to append argument"), object);
return;
@@ -518,39 +607,38 @@ xd_append_arg (unsigned int dtype, Lisp_Object object, DBusMessageIter *iter)
#ifdef DBUS_TYPE_UNIX_FD
case DBUS_TYPE_UNIX_FD:
#endif
- CHECK_NATNUM (object);
{
- dbus_uint32_t val = XFASTINT (object);
- XD_DEBUG_MESSAGE ("%c %u", dtype, val);
+ dbus_uint32_t val = extract_float (object);
+ unsigned int pval = val;
+ XD_DEBUG_MESSAGE ("%c %u", dtype, pval);
if (!dbus_message_iter_append_basic (iter, dtype, &val))
XD_SIGNAL2 (build_string ("Unable to append argument"), object);
return;
}
case DBUS_TYPE_INT64:
- CHECK_NUMBER (object);
{
- dbus_int64_t val = XINT (object);
- XD_DEBUG_MESSAGE ("%c %d", dtype, (int) val);
+ dbus_int64_t val = extract_float (object);
+ printmax_t pval = val;
+ XD_DEBUG_MESSAGE ("%c %"pMd, dtype, pval);
if (!dbus_message_iter_append_basic (iter, dtype, &val))
XD_SIGNAL2 (build_string ("Unable to append argument"), object);
return;
}
case DBUS_TYPE_UINT64:
- CHECK_NATNUM (object);
{
- dbus_uint64_t val = XFASTINT (object);
- XD_DEBUG_MESSAGE ("%c %"pI"d", dtype, XFASTINT (object));
+ dbus_uint64_t val = extract_float (object);
+ uprintmax_t pval = val;
+ XD_DEBUG_MESSAGE ("%c %"pMu, dtype, pval);
if (!dbus_message_iter_append_basic (iter, dtype, &val))
XD_SIGNAL2 (build_string ("Unable to append argument"), object);
return;
}
case DBUS_TYPE_DOUBLE:
- CHECK_FLOAT (object);
{
- double val = XFLOAT_DATA (object);
+ double val = extract_float (object);
XD_DEBUG_MESSAGE ("%c %f", dtype, val);
if (!dbus_message_iter_append_basic (iter, dtype, &val))
XD_SIGNAL2 (build_string ("Unable to append argument"), object);
@@ -614,7 +702,7 @@ xd_append_arg (unsigned int dtype, Lisp_Object object, DBusMessageIter *iter)
dtype, CAR_SAFE (XD_NEXT_VALUE (object)));
XD_DEBUG_MESSAGE ("%c %s %s", dtype, signature,
- SDATA (format2 ("%s", object, Qnil)));
+ XD_OBJECT_TO_STRING (object));
if (!dbus_message_iter_open_container (iter, dtype,
signature, &subiter))
XD_SIGNAL3 (build_string ("Cannot open container"),
@@ -627,7 +715,7 @@ xd_append_arg (unsigned int dtype, Lisp_Object object, DBusMessageIter *iter)
dtype, CAR_SAFE (XD_NEXT_VALUE (object)));
XD_DEBUG_MESSAGE ("%c %s %s", dtype, signature,
- SDATA (format2 ("%s", object, Qnil)));
+ XD_OBJECT_TO_STRING (object));
if (!dbus_message_iter_open_container (iter, dtype,
signature, &subiter))
XD_SIGNAL3 (build_string ("Cannot open container"),
@@ -637,8 +725,7 @@ xd_append_arg (unsigned int dtype, Lisp_Object object, DBusMessageIter *iter)
case DBUS_TYPE_STRUCT:
case DBUS_TYPE_DICT_ENTRY:
/* These containers do not require a signature. */
- XD_DEBUG_MESSAGE ("%c %s", dtype,
- SDATA (format2 ("%s", object, Qnil)));
+ XD_DEBUG_MESSAGE ("%c %s", dtype, XD_OBJECT_TO_STRING (object));
if (!dbus_message_iter_open_container (iter, dtype, NULL, &subiter))
XD_SIGNAL2 (build_string ("Cannot open container"),
make_number (dtype));
@@ -678,7 +765,7 @@ xd_retrieve_arg (unsigned int dtype, DBusMessageIter *iter)
unsigned int val;
dbus_message_iter_get_basic (iter, &val);
val = val & 0xFF;
- XD_DEBUG_MESSAGE ("%c %d", dtype, val);
+ XD_DEBUG_MESSAGE ("%c %u", dtype, val);
return make_number (val);
}
@@ -693,24 +780,30 @@ xd_retrieve_arg (unsigned int dtype, DBusMessageIter *iter)
case DBUS_TYPE_INT16:
{
dbus_int16_t val;
+ int pval;
dbus_message_iter_get_basic (iter, &val);
- XD_DEBUG_MESSAGE ("%c %d", dtype, val);
+ pval = val;
+ XD_DEBUG_MESSAGE ("%c %d", dtype, pval);
return make_number (val);
}
case DBUS_TYPE_UINT16:
{
dbus_uint16_t val;
+ int pval;
dbus_message_iter_get_basic (iter, &val);
- XD_DEBUG_MESSAGE ("%c %d", dtype, val);
+ pval = val;
+ XD_DEBUG_MESSAGE ("%c %d", dtype, pval);
return make_number (val);
}
case DBUS_TYPE_INT32:
{
dbus_int32_t val;
+ int pval;
dbus_message_iter_get_basic (iter, &val);
- XD_DEBUG_MESSAGE ("%c %d", dtype, val);
+ pval = val;
+ XD_DEBUG_MESSAGE ("%c %d", dtype, pval);
return make_fixnum_or_float (val);
}
@@ -720,24 +813,30 @@ xd_retrieve_arg (unsigned int dtype, DBusMessageIter *iter)
#endif
{
dbus_uint32_t val;
+ unsigned int pval = val;
dbus_message_iter_get_basic (iter, &val);
- XD_DEBUG_MESSAGE ("%c %d", dtype, val);
+ pval = val;
+ XD_DEBUG_MESSAGE ("%c %u", dtype, pval);
return make_fixnum_or_float (val);
}
case DBUS_TYPE_INT64:
{
dbus_int64_t val;
+ printmax_t pval;
dbus_message_iter_get_basic (iter, &val);
- XD_DEBUG_MESSAGE ("%c %d", dtype, (int) val);
+ pval = val;
+ XD_DEBUG_MESSAGE ("%c %"pMd, dtype, pval);
return make_fixnum_or_float (val);
}
case DBUS_TYPE_UINT64:
{
dbus_uint64_t val;
+ uprintmax_t pval;
dbus_message_iter_get_basic (iter, &val);
- XD_DEBUG_MESSAGE ("%c %d", dtype, (int) val);
+ pval = val;
+ XD_DEBUG_MESSAGE ("%c %"pMd, dtype, pval);
return make_fixnum_or_float (val);
}
@@ -777,7 +876,7 @@ xd_retrieve_arg (unsigned int dtype, DBusMessageIter *iter)
result = Fcons (xd_retrieve_arg (subtype, &subiter), result);
dbus_message_iter_next (&subiter);
}
- XD_DEBUG_MESSAGE ("%c %s", dtype, SDATA (format2 ("%s", result, Qnil)));
+ XD_DEBUG_MESSAGE ("%c %s", dtype, XD_OBJECT_TO_STRING (result));
RETURN_UNGCPRO (Fnreverse (result));
}
@@ -787,85 +886,37 @@ xd_retrieve_arg (unsigned int dtype, DBusMessageIter *iter)
}
}
-/* Initialize D-Bus connection. BUS is either a Lisp symbol, :system
- or :session, or a string denoting the bus address. It tells which
- D-Bus to initialize. If RAISE_ERROR is non-zero, signal an error
- when the connection cannot be initialized. */
+/* Return the number of references of the shared CONNECTION. */
+static int
+xd_get_connection_references (DBusConnection *connection)
+{
+ ptrdiff_t *refcount;
+
+ /* We cannot access the DBusConnection structure, it is not public.
+ But we know, that the reference counter is the first field in
+ that structure. */
+ refcount = (void *) &connection;
+ refcount = (void *) *refcount;
+ return *refcount;
+}
+
+/* Return D-Bus connection address. BUS is either a Lisp symbol,
+ :system or :session, or a string denoting the bus address. */
static DBusConnection *
-xd_initialize (Lisp_Object bus, int raise_error)
+xd_get_connection_address (Lisp_Object bus)
{
DBusConnection *connection;
- DBusError derror;
-
- /* Parameter check. */
- if (!STRINGP (bus))
- {
- CHECK_SYMBOL (bus);
- if (!(EQ (bus, QCdbus_system_bus) || EQ (bus, QCdbus_session_bus)))
- {
- if (raise_error)
- XD_SIGNAL2 (build_string ("Wrong bus name"), bus);
- else
- return NULL;
- }
-
- /* We do not want to have an autolaunch for the session bus. */
- if (EQ (bus, QCdbus_session_bus)
- && getenv ("DBUS_SESSION_BUS_ADDRESS") == NULL)
- {
- if (raise_error)
- XD_SIGNAL2 (build_string ("No connection to bus"), bus);
- else
- return NULL;
- }
- }
+ Lisp_Object val;
- /* Open a connection to the bus. */
- dbus_error_init (&derror);
-
- if (STRINGP (bus))
- connection = dbus_connection_open (SSDATA (bus), &derror);
+ val = CDR_SAFE (Fassoc (bus, xd_registered_buses));
+ if (NILP (val))
+ XD_SIGNAL2 (build_string ("No connection to bus"), bus);
else
- if (EQ (bus, QCdbus_system_bus))
- connection = dbus_bus_get (DBUS_BUS_SYSTEM, &derror);
- else
- connection = dbus_bus_get (DBUS_BUS_SESSION, &derror);
-
- if (dbus_error_is_set (&derror))
- {
- if (raise_error)
- XD_ERROR (derror);
- else
- connection = NULL;
- }
-
- /* If it is not the system or session bus, we must register
- ourselves. Otherwise, we have called dbus_bus_get, which has
- configured us to exit if the connection closes - we undo this
- setting. */
- if (connection != NULL)
- {
- if (STRINGP (bus))
- dbus_bus_register (connection, &derror);
- else
- dbus_connection_set_exit_on_disconnect (connection, FALSE);
- }
-
- if (dbus_error_is_set (&derror))
- {
- if (raise_error)
- XD_ERROR (derror);
- else
- connection = NULL;
- }
+ connection = (DBusConnection *) (intptr_t) XFASTINT (val);
- if (connection == NULL && raise_error)
+ if (!dbus_connection_get_is_connected (connection))
XD_SIGNAL2 (build_string ("No connection to bus"), bus);
- /* Cleanup. */
- dbus_error_free (&derror);
-
- /* Return the result. */
return connection;
}
@@ -896,8 +947,8 @@ xd_add_watch (DBusWatch *watch, void *data)
int fd = xd_find_watch_fd (watch);
XD_DEBUG_MESSAGE ("fd %d, write %d, enabled %d",
- fd, flags & DBUS_WATCH_WRITABLE,
- dbus_watch_get_enabled (watch));
+ fd, flags & DBUS_WATCH_WRITABLE,
+ dbus_watch_get_enabled (watch));
if (fd == -1)
return FALSE;
@@ -929,8 +980,8 @@ xd_remove_watch (DBusWatch *watch, void *data)
/* Unset session environment. */
if (XSYMBOL (QCdbus_session_bus) == data)
{
- XD_DEBUG_MESSAGE ("unsetenv DBUS_SESSION_BUS_ADDRESS");
- unsetenv ("DBUS_SESSION_BUS_ADDRESS");
+ // XD_DEBUG_MESSAGE ("unsetenv DBUS_SESSION_BUS_ADDRESS");
+ // unsetenv ("DBUS_SESSION_BUS_ADDRESS");
}
if (flags & DBUS_WATCH_WRITABLE)
@@ -949,23 +1000,111 @@ xd_toggle_watch (DBusWatch *watch, void *data)
xd_remove_watch (watch, data);
}
-DEFUN ("dbus-init-bus", Fdbus_init_bus, Sdbus_init_bus, 1, 1, 0,
- doc: /* Initialize connection to D-Bus BUS. */)
- (Lisp_Object bus)
+/* Close connection to D-Bus BUS. */
+static void
+xd_close_bus (Lisp_Object bus)
+{
+ DBusConnection *connection;
+ Lisp_Object val;
+
+ /* Check whether we are connected. */
+ val = Fassoc (bus, xd_registered_buses);
+ if (NILP (val))
+ return;
+
+ /* Retrieve bus address. */
+ connection = xd_get_connection_address (bus);
+
+ /* Close connection, if there isn't another shared application. */
+ if (xd_get_connection_references (connection) == 1)
+ {
+ XD_DEBUG_MESSAGE ("Close connection to bus %s",
+ XD_OBJECT_TO_STRING (bus));
+ dbus_connection_close (connection);
+ }
+
+ /* Decrement reference count. */
+ dbus_connection_unref (connection);
+
+ /* Remove bus from list of registered buses. */
+ xd_registered_buses = Fdelete (val, xd_registered_buses);
+
+ /* Return. */
+ return;
+}
+
+DEFUN ("dbus-init-bus", Fdbus_init_bus, Sdbus_init_bus, 1, 2, 0,
+ doc: /* Establish the connection to D-Bus BUS.
+
+BUS can be either the symbol `:system' or the symbol `:session', or it
+can be a string denoting the address of the corresponding bus. For
+the system and session buses, this function is called when loading
+`dbus.el', there is no need to call it again.
+
+The function returns a number, which counts the connections this Emacs
+session has established to the BUS under the same unique name (see
+`dbus-get-unique-name'). It depends on the libraries Emacs is linked
+with, and on the environment Emacs is running. For example, if Emacs
+is linked with the gtk toolkit, and it runs in a GTK-aware environment
+like Gnome, another connection might already be established.
+
+When PRIVATE is non-nil, a new connection is established instead of
+reusing an existing one. It results in a new unique name at the bus.
+This can be used, if it is necessary to distinguish from another
+connection used in the same Emacs process, like the one established by
+GTK+. It should be used with care for at least the `:system' and
+`:session' buses, because other Emacs Lisp packages might already use
+this connection to those buses. */)
+ (Lisp_Object bus, Lisp_Object private)
{
DBusConnection *connection;
- void *busp;
+ DBusError derror;
+ Lisp_Object val;
+ int refcount;
/* Check parameter. */
- if (SYMBOLP (bus))
- busp = XSYMBOL (bus);
- else if (STRINGP (bus))
- busp = XSTRING (bus);
+ XD_DBUS_VALIDATE_BUS_ADDRESS (bus);
+
+ /* Close bus if it is already open. */
+ xd_close_bus (bus);
+
+ /* Initialize. */
+ dbus_error_init (&derror);
+
+ /* Open the connection. */
+ if (STRINGP (bus))
+ if (NILP (private))
+ connection = dbus_connection_open (SSDATA (bus), &derror);
+ else
+ connection = dbus_connection_open_private (SSDATA (bus), &derror);
+
+ else
+ if (NILP (private))
+ connection = dbus_bus_get (EQ (bus, QCdbus_system_bus)
+ ? DBUS_BUS_SYSTEM : DBUS_BUS_SESSION,
+ &derror);
+ else
+ connection = dbus_bus_get_private (EQ (bus, QCdbus_system_bus)
+ ? DBUS_BUS_SYSTEM : DBUS_BUS_SESSION,
+ &derror);
+
+ if (dbus_error_is_set (&derror))
+ XD_ERROR (derror);
+
+ if (connection == NULL)
+ XD_SIGNAL2 (build_string ("No connection to bus"), bus);
+
+ /* If it is not the system or session bus, we must register
+ ourselves. Otherwise, we have called dbus_bus_get, which has
+ configured us to exit if the connection closes - we undo this
+ setting. */
+ if (STRINGP (bus))
+ dbus_bus_register (connection, &derror);
else
- wrong_type_argument (intern ("D-Bus"), bus);
+ dbus_connection_set_exit_on_disconnect (connection, FALSE);
- /* Open a connection to the bus. */
- connection = xd_initialize (bus, TRUE);
+ if (dbus_error_is_set (&derror))
+ XD_ERROR (derror);
/* Add the watch functions. We pass also the bus as data, in order
to distinguish between the buses in xd_remove_watch. */
@@ -973,36 +1112,27 @@ DEFUN ("dbus-init-bus", Fdbus_init_bus, Sdbus_init_bus, 1, 1, 0,
xd_add_watch,
xd_remove_watch,
xd_toggle_watch,
- busp, NULL))
+ SYMBOLP (bus)
+ ? (void *) XSYMBOL (bus)
+ : (void *) XSTRING (bus),
+ NULL))
XD_SIGNAL1 (build_string ("Cannot add watch functions"));
/* Add bus to list of registered buses. */
- Vdbus_registered_buses = Fcons (bus, Vdbus_registered_buses);
+ XSETFASTINT (val, (intptr_t) connection);
+ xd_registered_buses = Fcons (Fcons (bus, val), xd_registered_buses);
/* We do not want to abort. */
putenv ((char *) "DBUS_FATAL_WARNINGS=0");
- /* Return. */
- return Qnil;
-}
-
-DEFUN ("dbus-close-bus", Fdbus_close_bus, Sdbus_close_bus, 1, 1, 0,
- doc: /* Close connection to D-Bus BUS. */)
- (Lisp_Object bus)
-{
- DBusConnection *connection;
-
- /* Open a connection to the bus. */
- connection = xd_initialize (bus, TRUE);
-
- /* Decrement reference count to the bus. */
- dbus_connection_unref (connection);
-
- /* Remove bus from list of registered buses. */
- Vdbus_registered_buses = Fdelete (bus, Vdbus_registered_buses);
+ /* Cleanup. */
+ dbus_error_free (&derror);
- /* Return. */
- return Qnil;
+ /* Return reference counter. */
+ refcount = xd_get_connection_references (connection);
+ XD_DEBUG_MESSAGE ("Bus %s, Reference counter %d",
+ XD_OBJECT_TO_STRING (bus), refcount);
+ return make_number (refcount);
}
DEFUN ("dbus-get-unique-name", Fdbus_get_unique_name, Sdbus_get_unique_name,
@@ -1013,8 +1143,11 @@ DEFUN ("dbus-get-unique-name", Fdbus_get_unique_name, Sdbus_get_unique_name,
DBusConnection *connection;
const char *name;
- /* Open a connection to the bus. */
- connection = xd_initialize (bus, TRUE);
+ /* Check parameter. */
+ XD_DBUS_VALIDATE_BUS_ADDRESS (bus);
+
+ /* Retrieve bus address. */
+ connection = xd_get_connection_address (bus);
/* Request the name. */
name = dbus_bus_get_unique_name (connection);
@@ -1025,341 +1158,243 @@ DEFUN ("dbus-get-unique-name", Fdbus_get_unique_name, Sdbus_get_unique_name,
return build_string (name);
}
-DEFUN ("dbus-call-method", Fdbus_call_method, Sdbus_call_method, 5, MANY, 0,
- doc: /* Call METHOD on the D-Bus BUS.
-
-BUS is either a Lisp symbol, `:system' or `:session', or a string
-denoting the bus address.
-
-SERVICE is the D-Bus service name to be used. PATH is the D-Bus
-object path SERVICE is registered at. INTERFACE is an interface
-offered by SERVICE. It must provide METHOD.
-
-If the parameter `:timeout' is given, the following integer TIMEOUT
-specifies the maximum number of milliseconds the method call must
-return. The default value is 25,000. If the method call doesn't
-return in time, a D-Bus error is raised.
-
-All other arguments ARGS are passed to METHOD as arguments. They are
-converted into D-Bus types via the following rules:
-
- t and nil => DBUS_TYPE_BOOLEAN
- number => DBUS_TYPE_UINT32
- integer => DBUS_TYPE_INT32
- float => DBUS_TYPE_DOUBLE
- string => DBUS_TYPE_STRING
- list => DBUS_TYPE_ARRAY
-
-All arguments can be preceded by a type symbol. For details about
-type symbols, see Info node `(dbus)Type Conversion'.
-
-`dbus-call-method' returns the resulting values of METHOD as a list of
-Lisp objects. The type conversion happens the other direction as for
-input arguments. It follows the mapping rules:
-
- DBUS_TYPE_BOOLEAN => t or nil
- DBUS_TYPE_BYTE => number
- DBUS_TYPE_UINT16 => number
- DBUS_TYPE_INT16 => integer
- DBUS_TYPE_UINT32 => number or float
- DBUS_TYPE_UNIX_FD => number or float
- DBUS_TYPE_INT32 => integer or float
- DBUS_TYPE_UINT64 => number or float
- DBUS_TYPE_INT64 => integer or float
- DBUS_TYPE_DOUBLE => float
- DBUS_TYPE_STRING => string
- DBUS_TYPE_OBJECT_PATH => string
- DBUS_TYPE_SIGNATURE => string
- DBUS_TYPE_ARRAY => list
- DBUS_TYPE_VARIANT => list
- DBUS_TYPE_STRUCT => list
- DBUS_TYPE_DICT_ENTRY => list
-
-Example:
-
-\(dbus-call-method
- :session "org.gnome.seahorse" "/org/gnome/seahorse/keys/openpgp"
- "org.gnome.seahorse.Keys" "GetKeyField"
- "openpgp:657984B8C7A966DD" "simple-name")
-
- => (t ("Philip R. Zimmermann"))
-
-If the result of the METHOD call is just one value, the converted Lisp
-object is returned instead of a list containing this single Lisp object.
-
-\(dbus-call-method
- :system "org.freedesktop.Hal" "/org/freedesktop/Hal/devices/computer"
- "org.freedesktop.Hal.Device" "GetPropertyString"
- "system.kernel.machine")
-
- => "i686"
-
-usage: (dbus-call-method BUS SERVICE PATH INTERFACE METHOD &optional :timeout TIMEOUT &rest ARGS) */)
+DEFUN ("dbus-message-internal", Fdbus_message_internal, Sdbus_message_internal,
+ 4, MANY, 0,
+ doc: /* Send a D-Bus message.
+This is an internal function, it shall not be used outside dbus.el.
+
+The following usages are expected:
+
+`dbus-call-method', `dbus-call-method-asynchronously':
+ \(dbus-message-internal
+ dbus-message-type-method-call BUS SERVICE PATH INTERFACE METHOD HANDLER
+ &optional :timeout TIMEOUT &rest ARGS)
+
+`dbus-send-signal':
+ \(dbus-message-internal
+ dbus-message-type-signal BUS SERVICE PATH INTERFACE SIGNAL &rest ARGS)
+
+`dbus-method-return-internal':
+ \(dbus-message-internal
+ dbus-message-type-method-return BUS SERVICE SERIAL &rest ARGS)
+
+`dbus-method-error-internal':
+ \(dbus-message-internal
+ dbus-message-type-error BUS SERVICE SERIAL &rest ARGS)
+
+usage: (dbus-message-internal &rest REST) */)
(ptrdiff_t nargs, Lisp_Object *args)
{
- Lisp_Object bus, service, path, interface, method;
+ Lisp_Object message_type, bus, service, handler;
+ Lisp_Object path = Qnil;
+ Lisp_Object interface = Qnil;
+ Lisp_Object member = Qnil;
Lisp_Object result;
- struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
+ struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5, gcpro6;
DBusConnection *connection;
DBusMessage *dmessage;
- DBusMessage *reply;
DBusMessageIter iter;
- DBusError derror;
unsigned int dtype;
+ unsigned int mtype;
+ dbus_uint32_t serial = 0;
+ unsigned int ui_serial;
int timeout = -1;
- ptrdiff_t i = 5;
+ ptrdiff_t count;
char signature[DBUS_MAXIMUM_SIGNATURE_LENGTH];
+ /* Initialize parameters. */
+ message_type = args[0];
+ bus = args[1];
+ service = args[2];
+ handler = Qnil;
+
+ CHECK_NATNUM (message_type);
+ mtype = XFASTINT (message_type);
+ if ((mtype <= DBUS_MESSAGE_TYPE_INVALID) || (mtype >= DBUS_NUM_MESSAGE_TYPES))
+ XD_SIGNAL2 (build_string ("Invalid message type"), message_type);
+
+ if ((mtype == DBUS_MESSAGE_TYPE_METHOD_CALL)
+ || (mtype == DBUS_MESSAGE_TYPE_SIGNAL))
+ {
+ path = args[3];
+ interface = args[4];
+ member = args[5];
+ if (mtype == DBUS_MESSAGE_TYPE_METHOD_CALL)
+ handler = args[6];
+ count = (mtype == DBUS_MESSAGE_TYPE_METHOD_CALL) ? 7 : 6;
+ }
+ else /* DBUS_MESSAGE_TYPE_METHOD_RETURN, DBUS_MESSAGE_TYPE_ERROR */
+ {
+ XD_CHECK_DBUS_SERIAL (args[3], serial);
+ count = 4;
+ }
+
/* Check parameters. */
- bus = args[0];
- service = args[1];
- path = args[2];
- interface = args[3];
- method = args[4];
-
- CHECK_STRING (service);
- CHECK_STRING (path);
- CHECK_STRING (interface);
- CHECK_STRING (method);
- GCPRO5 (bus, service, path, interface, method);
-
- XD_DEBUG_MESSAGE ("%s %s %s %s",
- SDATA (service),
- SDATA (path),
- SDATA (interface),
- SDATA (method));
-
- /* Open a connection to the bus. */
- connection = xd_initialize (bus, TRUE);
-
- /* Create the message. */
- dmessage = dbus_message_new_method_call (SSDATA (service),
- SSDATA (path),
- SSDATA (interface),
- SSDATA (method));
- UNGCPRO;
- if (dmessage == NULL)
- XD_SIGNAL1 (build_string ("Unable to create a new message"));
+ XD_DBUS_VALIDATE_BUS_ADDRESS (bus);
+ XD_DBUS_VALIDATE_BUS_NAME (service);
+ if (nargs < count)
+ xsignal2 (Qwrong_number_of_arguments,
+ Qdbus_message_internal,
+ make_number (nargs));
+
+ if ((mtype == DBUS_MESSAGE_TYPE_METHOD_CALL)
+ || (mtype == DBUS_MESSAGE_TYPE_SIGNAL))
+ {
+ XD_DBUS_VALIDATE_PATH (path);
+ XD_DBUS_VALIDATE_INTERFACE (interface);
+ XD_DBUS_VALIDATE_MEMBER (member);
+ if (!NILP (handler) && (!FUNCTIONP (handler)))
+ wrong_type_argument (Qinvalid_function, handler);
+ }
- /* Check for timeout parameter. */
- if ((i+2 <= nargs) && (EQ ((args[i]), QCdbus_timeout)))
+ /* Protect Lisp variables. */
+ GCPRO6 (bus, service, path, interface, member, handler);
+
+ /* Trace parameters. */
+ switch (mtype)
{
- CHECK_NATNUM (args[i+1]);
- timeout = XFASTINT (args[i+1]);
- i = i+2;
+ case DBUS_MESSAGE_TYPE_METHOD_CALL:
+ XD_DEBUG_MESSAGE ("%s %s %s %s %s %s %s",
+ XD_MESSAGE_TYPE_TO_STRING (mtype),
+ XD_OBJECT_TO_STRING (bus),
+ XD_OBJECT_TO_STRING (service),
+ XD_OBJECT_TO_STRING (path),
+ XD_OBJECT_TO_STRING (interface),
+ XD_OBJECT_TO_STRING (member),
+ XD_OBJECT_TO_STRING (handler));
+ break;
+ case DBUS_MESSAGE_TYPE_SIGNAL:
+ XD_DEBUG_MESSAGE ("%s %s %s %s %s %s",
+ XD_MESSAGE_TYPE_TO_STRING (mtype),
+ XD_OBJECT_TO_STRING (bus),
+ XD_OBJECT_TO_STRING (service),
+ XD_OBJECT_TO_STRING (path),
+ XD_OBJECT_TO_STRING (interface),
+ XD_OBJECT_TO_STRING (member));
+ break;
+ default: /* DBUS_MESSAGE_TYPE_METHOD_RETURN, DBUS_MESSAGE_TYPE_ERROR */
+ ui_serial = serial;
+ XD_DEBUG_MESSAGE ("%s %s %s %u",
+ XD_MESSAGE_TYPE_TO_STRING (mtype),
+ XD_OBJECT_TO_STRING (bus),
+ XD_OBJECT_TO_STRING (service),
+ ui_serial);
}
- /* Initialize parameter list of message. */
- dbus_message_iter_init_append (dmessage, &iter);
+ /* Retrieve bus address. */
+ connection = xd_get_connection_address (bus);
- /* Append parameters to the message. */
- for (; i < nargs; ++i)
+ /* Create the D-Bus message. */
+ dmessage = dbus_message_new (mtype);
+ if (dmessage == NULL)
+ {
+ UNGCPRO;
+ XD_SIGNAL1 (build_string ("Unable to create a new message"));
+ }
+
+ if (STRINGP (service))
{
- dtype = XD_OBJECT_TO_DBUS_TYPE (args[i]);
- if (XD_DBUS_TYPE_P (args[i]))
+ if (mtype != DBUS_MESSAGE_TYPE_SIGNAL)
+ /* Set destination. */
{
- XD_DEBUG_VALID_LISP_OBJECT_P (args[i]);
- XD_DEBUG_VALID_LISP_OBJECT_P (args[i+1]);
- XD_DEBUG_MESSAGE ("Parameter%"pD"d %s %s", i - 4,
- SDATA (format2 ("%s", args[i], Qnil)),
- SDATA (format2 ("%s", args[i+1], Qnil)));
- ++i;
+ if (!dbus_message_set_destination (dmessage, SSDATA (service)))
+ {
+ UNGCPRO;
+ XD_SIGNAL2 (build_string ("Unable to set the destination"),
+ service);
+ }
}
+
else
+ /* Set destination for unicast signals. */
{
- XD_DEBUG_VALID_LISP_OBJECT_P (args[i]);
- XD_DEBUG_MESSAGE ("Parameter%"pD"d %s", i - 4,
- SDATA (format2 ("%s", args[i], Qnil)));
- }
+ Lisp_Object uname;
- /* Check for valid signature. We use DBUS_TYPE_INVALID as
- indication that there is no parent type. */
- xd_signature (signature, dtype, DBUS_TYPE_INVALID, args[i]);
+ /* If it is the same unique name as we are registered at the
+ bus or an unknown name, we regard it as broadcast message
+ due to backward compatibility. */
+ if (dbus_bus_name_has_owner (connection, SSDATA (service), NULL))
+ uname = call2 (intern ("dbus-get-name-owner"), bus, service);
+ else
+ uname = Qnil;
- xd_append_arg (dtype, args[i], &iter);
+ if (STRINGP (uname)
+ && (strcmp (dbus_bus_get_unique_name (connection), SSDATA (uname))
+ != 0)
+ && (!dbus_message_set_destination (dmessage, SSDATA (service))))
+ {
+ UNGCPRO;
+ XD_SIGNAL2 (build_string ("Unable to set signal destination"),
+ service);
+ }
+ }
}
- /* Send the message. */
- dbus_error_init (&derror);
- reply = dbus_connection_send_with_reply_and_block (connection,
- dmessage,
- timeout,
- &derror);
-
- if (dbus_error_is_set (&derror))
- XD_ERROR (derror);
-
- if (reply == NULL)
- XD_SIGNAL1 (build_string ("No reply"));
-
- XD_DEBUG_MESSAGE ("Message sent");
-
- /* Collect the results. */
- result = Qnil;
- GCPRO1 (result);
-
- if (dbus_message_iter_init (reply, &iter))
+ /* Set message parameters. */
+ if ((mtype == DBUS_MESSAGE_TYPE_METHOD_CALL)
+ || (mtype == DBUS_MESSAGE_TYPE_SIGNAL))
{
- /* Loop over the parameters of the D-Bus reply message. Construct a
- Lisp list, which is returned by `dbus-call-method'. */
- while ((dtype = dbus_message_iter_get_arg_type (&iter))
- != DBUS_TYPE_INVALID)
+ if ((!dbus_message_set_path (dmessage, SSDATA (path)))
+ || (!dbus_message_set_interface (dmessage, SSDATA (interface)))
+ || (!dbus_message_set_member (dmessage, SSDATA (member))))
{
- result = Fcons (xd_retrieve_arg (dtype, &iter), result);
- dbus_message_iter_next (&iter);
+ UNGCPRO;
+ XD_SIGNAL1 (build_string ("Unable to set the message parameter"));
}
}
- else
- {
- /* No arguments: just return nil. */
- }
-
- /* Cleanup. */
- dbus_error_free (&derror);
- dbus_message_unref (dmessage);
- dbus_message_unref (reply);
-
- /* Return the result. If there is only one single Lisp object,
- return it as-it-is, otherwise return the reversed list. */
- if (XFASTINT (Flength (result)) == 1)
- RETURN_UNGCPRO (CAR_SAFE (result));
- else
- RETURN_UNGCPRO (Fnreverse (result));
-}
-DEFUN ("dbus-call-method-asynchronously", Fdbus_call_method_asynchronously,
- Sdbus_call_method_asynchronously, 6, MANY, 0,
- doc: /* Call METHOD on the D-Bus BUS asynchronously.
-
-BUS is either a Lisp symbol, `:system' or `:session', or a string
-denoting the bus address.
-
-SERVICE is the D-Bus service name to be used. PATH is the D-Bus
-object path SERVICE is registered at. INTERFACE is an interface
-offered by SERVICE. It must provide METHOD.
-
-HANDLER is a Lisp function, which is called when the corresponding
-return message has arrived. If HANDLER is nil, no return message will
-be expected.
-
-If the parameter `:timeout' is given, the following integer TIMEOUT
-specifies the maximum number of milliseconds the method call must
-return. The default value is 25,000. If the method call doesn't
-return in time, a D-Bus error is raised.
-
-All other arguments ARGS are passed to METHOD as arguments. They are
-converted into D-Bus types via the following rules:
-
- t and nil => DBUS_TYPE_BOOLEAN
- number => DBUS_TYPE_UINT32
- integer => DBUS_TYPE_INT32
- float => DBUS_TYPE_DOUBLE
- string => DBUS_TYPE_STRING
- list => DBUS_TYPE_ARRAY
-
-All arguments can be preceded by a type symbol. For details about
-type symbols, see Info node `(dbus)Type Conversion'.
-
-Unless HANDLER is nil, the function returns a key into the hash table
-`dbus-registered-objects-table'. The corresponding entry in the hash
-table is removed, when the return message has been arrived, and
-HANDLER is called.
-
-Example:
-
-\(dbus-call-method-asynchronously
- :system "org.freedesktop.Hal" "/org/freedesktop/Hal/devices/computer"
- "org.freedesktop.Hal.Device" "GetPropertyString" 'message
- "system.kernel.machine")
-
- => (:system 2)
-
- -| i686
-
-usage: (dbus-call-method-asynchronously BUS SERVICE PATH INTERFACE METHOD HANDLER &optional :timeout TIMEOUT &rest ARGS) */)
- (ptrdiff_t nargs, Lisp_Object *args)
-{
- Lisp_Object bus, service, path, interface, method, handler;
- Lisp_Object result;
- struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5, gcpro6;
- DBusConnection *connection;
- DBusMessage *dmessage;
- DBusMessageIter iter;
- unsigned int dtype;
- dbus_uint32_t serial;
- int timeout = -1;
- ptrdiff_t i = 6;
- char signature[DBUS_MAXIMUM_SIGNATURE_LENGTH];
+ else /* DBUS_MESSAGE_TYPE_METHOD_RETURN, DBUS_MESSAGE_TYPE_ERROR */
+ {
+ if (!dbus_message_set_reply_serial (dmessage, serial))
+ {
+ UNGCPRO;
+ XD_SIGNAL1 (build_string ("Unable to create a return message"));
+ }
- /* Check parameters. */
- bus = args[0];
- service = args[1];
- path = args[2];
- interface = args[3];
- method = args[4];
- handler = args[5];
-
- CHECK_STRING (service);
- CHECK_STRING (path);
- CHECK_STRING (interface);
- CHECK_STRING (method);
- if (!NILP (handler) && !FUNCTIONP (handler))
- wrong_type_argument (Qinvalid_function, handler);
- GCPRO6 (bus, service, path, interface, method, handler);
-
- XD_DEBUG_MESSAGE ("%s %s %s %s",
- SDATA (service),
- SDATA (path),
- SDATA (interface),
- SDATA (method));
-
- /* Open a connection to the bus. */
- connection = xd_initialize (bus, TRUE);
-
- /* Create the message. */
- dmessage = dbus_message_new_method_call (SSDATA (service),
- SSDATA (path),
- SSDATA (interface),
- SSDATA (method));
- if (dmessage == NULL)
- XD_SIGNAL1 (build_string ("Unable to create a new message"));
+ if ((mtype == DBUS_MESSAGE_TYPE_ERROR)
+ && (!dbus_message_set_error_name (dmessage, DBUS_ERROR_FAILED)))
+ {
+ UNGCPRO;
+ XD_SIGNAL1 (build_string ("Unable to create a error message"));
+ }
+ }
/* Check for timeout parameter. */
- if ((i+2 <= nargs) && (EQ ((args[i]), QCdbus_timeout)))
+ if ((count+2 <= nargs) && (EQ ((args[count]), QCdbus_timeout)))
{
- CHECK_NATNUM (args[i+1]);
- timeout = XFASTINT (args[i+1]);
- i = i+2;
+ CHECK_NATNUM (args[count+1]);
+ timeout = XFASTINT (args[count+1]);
+ count = count+2;
}
/* Initialize parameter list of message. */
dbus_message_iter_init_append (dmessage, &iter);
/* Append parameters to the message. */
- for (; i < nargs; ++i)
+ for (; count < nargs; ++count)
{
- dtype = XD_OBJECT_TO_DBUS_TYPE (args[i]);
- if (XD_DBUS_TYPE_P (args[i]))
+ dtype = XD_OBJECT_TO_DBUS_TYPE (args[count]);
+ if (XD_DBUS_TYPE_P (args[count]))
{
- XD_DEBUG_VALID_LISP_OBJECT_P (args[i]);
- XD_DEBUG_VALID_LISP_OBJECT_P (args[i+1]);
- XD_DEBUG_MESSAGE ("Parameter%"pD"d %s %s", i - 4,
- SDATA (format2 ("%s", args[i], Qnil)),
- SDATA (format2 ("%s", args[i+1], Qnil)));
- ++i;
+ XD_DEBUG_VALID_LISP_OBJECT_P (args[count]);
+ XD_DEBUG_VALID_LISP_OBJECT_P (args[count+1]);
+ XD_DEBUG_MESSAGE ("Parameter%"pD"d %s %s", count - 4,
+ XD_OBJECT_TO_STRING (args[count]),
+ XD_OBJECT_TO_STRING (args[count+1]));
+ ++count;
}
else
{
- XD_DEBUG_VALID_LISP_OBJECT_P (args[i]);
- XD_DEBUG_MESSAGE ("Parameter%"pD"d %s", i - 4,
- SDATA (format2 ("%s", args[i], Qnil)));
+ XD_DEBUG_VALID_LISP_OBJECT_P (args[count]);
+ XD_DEBUG_MESSAGE ("Parameter%"pD"d %s", count - 4,
+ XD_OBJECT_TO_STRING (args[count]));
}
/* Check for valid signature. We use DBUS_TYPE_INVALID as
indication that there is no parent type. */
- xd_signature (signature, dtype, DBUS_TYPE_INVALID, args[i]);
+ xd_signature (signature, dtype, DBUS_TYPE_INVALID, args[count]);
- xd_append_arg (dtype, args[i], &iter);
+ xd_append_arg (dtype, args[count], &iter);
}
if (!NILP (handler))
@@ -1368,11 +1403,15 @@ usage: (dbus-call-method-asynchronously BUS SERVICE PATH INTERFACE METHOD HANDLE
message queue. */
if (!dbus_connection_send_with_reply (connection, dmessage,
NULL, timeout))
- XD_SIGNAL1 (build_string ("Cannot send message"));
+ {
+ UNGCPRO;
+ XD_SIGNAL1 (build_string ("Cannot send message"));
+ }
/* The result is the key in Vdbus_registered_objects_table. */
serial = dbus_message_get_serial (dmessage);
- result = list2 (bus, make_fixnum_or_float (serial));
+ result = list3 (QCdbus_registered_serial,
+ bus, make_fixnum_or_float (serial));
/* Create a hash table entry. */
Fputhash (result, handler, Vdbus_registered_objects_table);
@@ -1382,12 +1421,15 @@ usage: (dbus-call-method-asynchronously BUS SERVICE PATH INTERFACE METHOD HANDLE
/* Send the message. The message is just added to the outgoing
message queue. */
if (!dbus_connection_send (connection, dmessage, NULL))
- XD_SIGNAL1 (build_string ("Cannot send message"));
+ {
+ UNGCPRO;
+ XD_SIGNAL1 (build_string ("Cannot send message"));
+ }
result = Qnil;
}
- XD_DEBUG_MESSAGE ("Message sent");
+ XD_DEBUG_MESSAGE ("Message sent: %s", XD_OBJECT_TO_STRING (result));
/* Cleanup. */
dbus_message_unref (dmessage);
@@ -1396,300 +1438,6 @@ usage: (dbus-call-method-asynchronously BUS SERVICE PATH INTERFACE METHOD HANDLE
RETURN_UNGCPRO (result);
}
-DEFUN ("dbus-method-return-internal", Fdbus_method_return_internal,
- Sdbus_method_return_internal,
- 3, MANY, 0,
- doc: /* Return for message SERIAL on the D-Bus BUS.
-This is an internal function, it shall not be used outside dbus.el.
-
-usage: (dbus-method-return-internal BUS SERIAL SERVICE &rest ARGS) */)
- (ptrdiff_t nargs, Lisp_Object *args)
-{
- Lisp_Object bus, service;
- struct gcpro gcpro1, gcpro2;
- DBusConnection *connection;
- DBusMessage *dmessage;
- DBusMessageIter iter;
- dbus_uint32_t serial;
- unsigned int ui_serial, dtype;
- ptrdiff_t i;
- char signature[DBUS_MAXIMUM_SIGNATURE_LENGTH];
-
- /* Check parameters. */
- bus = args[0];
- service = args[2];
-
- CHECK_DBUS_SERIAL_GET_SERIAL (args[1], serial);
- CHECK_STRING (service);
- GCPRO2 (bus, service);
-
- ui_serial = serial;
- XD_DEBUG_MESSAGE ("%u %s ", ui_serial, SSDATA (service));
-
- /* Open a connection to the bus. */
- connection = xd_initialize (bus, TRUE);
-
- /* Create the message. */
- dmessage = dbus_message_new (DBUS_MESSAGE_TYPE_METHOD_RETURN);
- if ((dmessage == NULL)
- || (!dbus_message_set_reply_serial (dmessage, serial))
- || (!dbus_message_set_destination (dmessage, SSDATA (service))))
- {
- UNGCPRO;
- XD_SIGNAL1 (build_string ("Unable to create a return message"));
- }
-
- UNGCPRO;
-
- /* Initialize parameter list of message. */
- dbus_message_iter_init_append (dmessage, &iter);
-
- /* Append parameters to the message. */
- for (i = 3; i < nargs; ++i)
- {
- dtype = XD_OBJECT_TO_DBUS_TYPE (args[i]);
- if (XD_DBUS_TYPE_P (args[i]))
- {
- XD_DEBUG_VALID_LISP_OBJECT_P (args[i]);
- XD_DEBUG_VALID_LISP_OBJECT_P (args[i+1]);
- XD_DEBUG_MESSAGE ("Parameter%"pD"d %s %s", i - 2,
- SDATA (format2 ("%s", args[i], Qnil)),
- SDATA (format2 ("%s", args[i+1], Qnil)));
- ++i;
- }
- else
- {
- XD_DEBUG_VALID_LISP_OBJECT_P (args[i]);
- XD_DEBUG_MESSAGE ("Parameter%"pD"d %s", i - 2,
- SDATA (format2 ("%s", args[i], Qnil)));
- }
-
- /* Check for valid signature. We use DBUS_TYPE_INVALID as
- indication that there is no parent type. */
- xd_signature (signature, dtype, DBUS_TYPE_INVALID, args[i]);
-
- xd_append_arg (dtype, args[i], &iter);
- }
-
- /* Send the message. The message is just added to the outgoing
- message queue. */
- if (!dbus_connection_send (connection, dmessage, NULL))
- XD_SIGNAL1 (build_string ("Cannot send message"));
-
- XD_DEBUG_MESSAGE ("Message sent");
-
- /* Cleanup. */
- dbus_message_unref (dmessage);
-
- /* Return. */
- return Qt;
-}
-
-DEFUN ("dbus-method-error-internal", Fdbus_method_error_internal,
- Sdbus_method_error_internal,
- 3, MANY, 0,
- doc: /* Return error message for message SERIAL on the D-Bus BUS.
-This is an internal function, it shall not be used outside dbus.el.
-
-usage: (dbus-method-error-internal BUS SERIAL SERVICE &rest ARGS) */)
- (ptrdiff_t nargs, Lisp_Object *args)
-{
- Lisp_Object bus, service;
- struct gcpro gcpro1, gcpro2;
- DBusConnection *connection;
- DBusMessage *dmessage;
- DBusMessageIter iter;
- dbus_uint32_t serial;
- unsigned int ui_serial, dtype;
- ptrdiff_t i;
- char signature[DBUS_MAXIMUM_SIGNATURE_LENGTH];
-
- /* Check parameters. */
- bus = args[0];
- service = args[2];
-
- CHECK_DBUS_SERIAL_GET_SERIAL (args[1], serial);
- CHECK_STRING (service);
- GCPRO2 (bus, service);
-
- ui_serial = serial;
- XD_DEBUG_MESSAGE ("%u %s ", ui_serial, SSDATA (service));
-
- /* Open a connection to the bus. */
- connection = xd_initialize (bus, TRUE);
-
- /* Create the message. */
- dmessage = dbus_message_new (DBUS_MESSAGE_TYPE_ERROR);
- if ((dmessage == NULL)
- || (!dbus_message_set_error_name (dmessage, DBUS_ERROR_FAILED))
- || (!dbus_message_set_reply_serial (dmessage, serial))
- || (!dbus_message_set_destination (dmessage, SSDATA (service))))
- {
- UNGCPRO;
- XD_SIGNAL1 (build_string ("Unable to create a error message"));
- }
-
- UNGCPRO;
-
- /* Initialize parameter list of message. */
- dbus_message_iter_init_append (dmessage, &iter);
-
- /* Append parameters to the message. */
- for (i = 3; i < nargs; ++i)
- {
- dtype = XD_OBJECT_TO_DBUS_TYPE (args[i]);
- if (XD_DBUS_TYPE_P (args[i]))
- {
- XD_DEBUG_VALID_LISP_OBJECT_P (args[i]);
- XD_DEBUG_VALID_LISP_OBJECT_P (args[i+1]);
- XD_DEBUG_MESSAGE ("Parameter%"pD"d %s %s", i - 2,
- SDATA (format2 ("%s", args[i], Qnil)),
- SDATA (format2 ("%s", args[i+1], Qnil)));
- ++i;
- }
- else
- {
- XD_DEBUG_VALID_LISP_OBJECT_P (args[i]);
- XD_DEBUG_MESSAGE ("Parameter%"pD"d %s", i - 2,
- SDATA (format2 ("%s", args[i], Qnil)));
- }
-
- /* Check for valid signature. We use DBUS_TYPE_INVALID as
- indication that there is no parent type. */
- xd_signature (signature, dtype, DBUS_TYPE_INVALID, args[i]);
-
- xd_append_arg (dtype, args[i], &iter);
- }
-
- /* Send the message. The message is just added to the outgoing
- message queue. */
- if (!dbus_connection_send (connection, dmessage, NULL))
- XD_SIGNAL1 (build_string ("Cannot send message"));
-
- XD_DEBUG_MESSAGE ("Message sent");
-
- /* Cleanup. */
- dbus_message_unref (dmessage);
-
- /* Return. */
- return Qt;
-}
-
-DEFUN ("dbus-send-signal", Fdbus_send_signal, Sdbus_send_signal, 5, MANY, 0,
- doc: /* Send signal SIGNAL on the D-Bus BUS.
-
-BUS is either a Lisp symbol, `:system' or `:session', or a string
-denoting the bus address.
-
-SERVICE is the D-Bus service name SIGNAL is sent from. PATH is the
-D-Bus object path SERVICE is registered at. INTERFACE is an interface
-offered by SERVICE. It must provide signal SIGNAL.
-
-All other arguments ARGS are passed to SIGNAL as arguments. They are
-converted into D-Bus types via the following rules:
-
- t and nil => DBUS_TYPE_BOOLEAN
- number => DBUS_TYPE_UINT32
- integer => DBUS_TYPE_INT32
- float => DBUS_TYPE_DOUBLE
- string => DBUS_TYPE_STRING
- list => DBUS_TYPE_ARRAY
-
-All arguments can be preceded by a type symbol. For details about
-type symbols, see Info node `(dbus)Type Conversion'.
-
-Example:
-
-\(dbus-send-signal
- :session "org.gnu.Emacs" "/org/gnu/Emacs"
- "org.gnu.Emacs.FileManager" "FileModified" "/home/albinus/.emacs")
-
-usage: (dbus-send-signal BUS SERVICE PATH INTERFACE SIGNAL &rest ARGS) */)
- (ptrdiff_t nargs, Lisp_Object *args)
-{
- Lisp_Object bus, service, path, interface, signal;
- struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
- DBusConnection *connection;
- DBusMessage *dmessage;
- DBusMessageIter iter;
- unsigned int dtype;
- ptrdiff_t i;
- char signature[DBUS_MAXIMUM_SIGNATURE_LENGTH];
-
- /* Check parameters. */
- bus = args[0];
- service = args[1];
- path = args[2];
- interface = args[3];
- signal = args[4];
-
- CHECK_STRING (service);
- CHECK_STRING (path);
- CHECK_STRING (interface);
- CHECK_STRING (signal);
- GCPRO5 (bus, service, path, interface, signal);
-
- XD_DEBUG_MESSAGE ("%s %s %s %s",
- SDATA (service),
- SDATA (path),
- SDATA (interface),
- SDATA (signal));
-
- /* Open a connection to the bus. */
- connection = xd_initialize (bus, TRUE);
-
- /* Create the message. */
- dmessage = dbus_message_new_signal (SSDATA (path),
- SSDATA (interface),
- SSDATA (signal));
- UNGCPRO;
- if (dmessage == NULL)
- XD_SIGNAL1 (build_string ("Unable to create a new message"));
-
- /* Initialize parameter list of message. */
- dbus_message_iter_init_append (dmessage, &iter);
-
- /* Append parameters to the message. */
- for (i = 5; i < nargs; ++i)
- {
- dtype = XD_OBJECT_TO_DBUS_TYPE (args[i]);
- if (XD_DBUS_TYPE_P (args[i]))
- {
- XD_DEBUG_VALID_LISP_OBJECT_P (args[i]);
- XD_DEBUG_VALID_LISP_OBJECT_P (args[i+1]);
- XD_DEBUG_MESSAGE ("Parameter%"pD"d %s %s", i - 4,
- SDATA (format2 ("%s", args[i], Qnil)),
- SDATA (format2 ("%s", args[i+1], Qnil)));
- ++i;
- }
- else
- {
- XD_DEBUG_VALID_LISP_OBJECT_P (args[i]);
- XD_DEBUG_MESSAGE ("Parameter%"pD"d %s", i - 4,
- SDATA (format2 ("%s", args[i], Qnil)));
- }
-
- /* Check for valid signature. We use DBUS_TYPE_INVALID as
- indication that there is no parent type. */
- xd_signature (signature, dtype, DBUS_TYPE_INVALID, args[i]);
-
- xd_append_arg (dtype, args[i], &iter);
- }
-
- /* Send the message. The message is just added to the outgoing
- message queue. */
- if (!dbus_connection_send (connection, dmessage, NULL))
- XD_SIGNAL1 (build_string ("Cannot send message"));
-
- XD_DEBUG_MESSAGE ("Signal sent");
-
- /* Cleanup. */
- dbus_message_unref (dmessage);
-
- /* Return. */
- return Qt;
-}
-
/* Read one queued incoming message of the D-Bus BUS.
BUS is either a Lisp symbol, :system or :session, or a string denoting
the bus address. */
@@ -1702,7 +1450,7 @@ xd_read_message_1 (DBusConnection *connection, Lisp_Object bus)
DBusMessage *dmessage;
DBusMessageIter iter;
unsigned int dtype;
- int mtype;
+ unsigned int mtype;
dbus_uint32_t serial;
unsigned int ui_serial;
const char *uname, *path, *interface, *member;
@@ -1744,23 +1492,19 @@ xd_read_message_1 (DBusConnection *connection, Lisp_Object bus)
member = dbus_message_get_member (dmessage);
XD_DEBUG_MESSAGE ("Event received: %s %u %s %s %s %s %s",
- (mtype == DBUS_MESSAGE_TYPE_INVALID)
- ? "DBUS_MESSAGE_TYPE_INVALID"
- : (mtype == DBUS_MESSAGE_TYPE_METHOD_CALL)
- ? "DBUS_MESSAGE_TYPE_METHOD_CALL"
- : (mtype == DBUS_MESSAGE_TYPE_METHOD_RETURN)
- ? "DBUS_MESSAGE_TYPE_METHOD_RETURN"
- : (mtype == DBUS_MESSAGE_TYPE_ERROR)
- ? "DBUS_MESSAGE_TYPE_ERROR"
- : "DBUS_MESSAGE_TYPE_SIGNAL",
+ XD_MESSAGE_TYPE_TO_STRING (mtype),
ui_serial, uname, path, interface, member,
- SDATA (format2 ("%s", args, Qnil)));
+ XD_OBJECT_TO_STRING (args));
+
+ if (mtype == DBUS_MESSAGE_TYPE_INVALID)
+ goto cleanup;
- if ((mtype == DBUS_MESSAGE_TYPE_METHOD_RETURN)
- || (mtype == DBUS_MESSAGE_TYPE_ERROR))
+ else if ((mtype == DBUS_MESSAGE_TYPE_METHOD_RETURN)
+ || (mtype == DBUS_MESSAGE_TYPE_ERROR))
{
/* Search for a registered function of the message. */
- key = list2 (bus, make_fixnum_or_float (serial));
+ key = list3 (QCdbus_registered_serial, bus,
+ make_fixnum_or_float (serial));
value = Fgethash (key, Vdbus_registered_objects_table, Qnil);
/* There shall be exactly one entry. Construct an event. */
@@ -1777,7 +1521,7 @@ xd_read_message_1 (DBusConnection *connection, Lisp_Object bus)
event.arg = Fcons (value, args);
}
- else /* (mtype != DBUS_MESSAGE_TYPE_METHOD_RETURN) */
+ else /* DBUS_MESSAGE_TYPE_METHOD_CALL, DBUS_MESSAGE_TYPE_SIGNAL. */
{
/* Vdbus_registered_objects_table requires non-nil interface and
member. */
@@ -1785,7 +1529,10 @@ xd_read_message_1 (DBusConnection *connection, Lisp_Object bus)
goto cleanup;
/* Search for a registered function of the message. */
- key = list3 (bus, build_string (interface), build_string (member));
+ key = list4 ((mtype == DBUS_MESSAGE_TYPE_METHOD_CALL)
+ ? QCdbus_registered_method
+ : QCdbus_registered_signal,
+ bus, build_string (interface), build_string (member));
value = Fgethash (key, Vdbus_registered_objects_table, Qnil);
/* Loop over the registered functions. Construct an event. */
@@ -1835,8 +1582,7 @@ xd_read_message_1 (DBusConnection *connection, Lisp_Object bus)
/* Store it into the input event queue. */
kbd_buffer_store_event (&event);
- XD_DEBUG_MESSAGE ("Event stored: %s",
- SDATA (format2 ("%s", event.arg, Qnil)));
+ XD_DEBUG_MESSAGE ("Event stored: %s", XD_OBJECT_TO_STRING (event.arg));
/* Cleanup. */
cleanup:
@@ -1851,8 +1597,8 @@ xd_read_message_1 (DBusConnection *connection, Lisp_Object bus)
static Lisp_Object
xd_read_message (Lisp_Object bus)
{
- /* Open a connection to the bus. */
- DBusConnection *connection = xd_initialize (bus, TRUE);
+ /* Retrieve bus address. */
+ DBusConnection *connection = xd_get_connection_address (bus);
/* Non blocking read of the next available message. */
dbus_connection_read_write (connection, 0);
@@ -1867,16 +1613,18 @@ xd_read_message (Lisp_Object bus)
static void
xd_read_queued_messages (int fd, void *data, int for_read)
{
- Lisp_Object busp = Vdbus_registered_buses;
+ Lisp_Object busp = xd_registered_buses;
Lisp_Object bus = Qnil;
+ Lisp_Object key;
/* Find bus related to fd. */
if (data != NULL)
while (!NILP (busp))
{
- if ((SYMBOLP (CAR_SAFE (busp)) && XSYMBOL (CAR_SAFE (busp)) == data)
- || (STRINGP (CAR_SAFE (busp)) && XSTRING (CAR_SAFE (busp)) == data))
- bus = CAR_SAFE (busp);
+ key = CAR_SAFE (CAR_SAFE (busp));
+ if ((SYMBOLP (key) && XSYMBOL (key) == data)
+ || (STRINGP (key) && XSTRING (key) == data))
+ bus = key;
busp = CDR_SAFE (busp);
}
@@ -1889,327 +1637,6 @@ xd_read_queued_messages (int fd, void *data, int for_read)
xd_in_read_queued_messages = 0;
}
-DEFUN ("dbus-register-service", Fdbus_register_service, Sdbus_register_service,
- 2, MANY, 0,
- doc: /* Register known name SERVICE on the D-Bus BUS.
-
-BUS is either a Lisp symbol, `:system' or `:session', or a string
-denoting the bus address.
-
-SERVICE is the D-Bus service name that should be registered. It must
-be a known name.
-
-FLAGS are keywords, which control how the service name is registered.
-The following keywords are recognized:
-
-`:allow-replacement': Allow another service to become the primary
-owner if requested.
-
-`:replace-existing': Request to replace the current primary owner.
-
-`:do-not-queue': If we can not become the primary owner do not place
-us in the queue.
-
-The function returns a keyword, indicating the result of the
-operation. One of the following keywords is returned:
-
-`:primary-owner': Service has become the primary owner of the
-requested name.
-
-`:in-queue': Service could not become the primary owner and has been
-placed in the queue.
-
-`:exists': Service is already in the queue.
-
-`:already-owner': Service is already the primary owner.
-
-Example:
-
-\(dbus-register-service :session dbus-service-emacs)
-
- => :primary-owner.
-
-\(dbus-register-service
- :session "org.freedesktop.TextEditor"
- dbus-service-allow-replacement dbus-service-replace-existing)
-
- => :already-owner.
-
-usage: (dbus-register-service BUS SERVICE &rest FLAGS) */)
- (ptrdiff_t nargs, Lisp_Object *args)
-{
- Lisp_Object bus, service;
- DBusConnection *connection;
- ptrdiff_t i;
- unsigned int value;
- unsigned int flags = 0;
- int result;
- DBusError derror;
-
- bus = args[0];
- service = args[1];
-
- /* Check parameters. */
- CHECK_STRING (service);
-
- /* Process flags. */
- for (i = 2; i < nargs; ++i) {
- value = ((EQ (args[i], QCdbus_request_name_replace_existing))
- ? DBUS_NAME_FLAG_REPLACE_EXISTING
- : (EQ (args[i], QCdbus_request_name_allow_replacement))
- ? DBUS_NAME_FLAG_ALLOW_REPLACEMENT
- : (EQ (args[i], QCdbus_request_name_do_not_queue))
- ? DBUS_NAME_FLAG_DO_NOT_QUEUE
- : -1);
- if (value == -1)
- XD_SIGNAL2 (build_string ("Unrecognized name request flag"), args[i]);
- flags |= value;
- }
-
- /* Open a connection to the bus. */
- connection = xd_initialize (bus, TRUE);
-
- /* Request the known name from the bus. */
- dbus_error_init (&derror);
- result = dbus_bus_request_name (connection, SSDATA (service), flags,
- &derror);
- if (dbus_error_is_set (&derror))
- XD_ERROR (derror);
-
- /* Cleanup. */
- dbus_error_free (&derror);
-
- /* Return object. */
- switch (result)
- {
- case DBUS_REQUEST_NAME_REPLY_PRIMARY_OWNER:
- return QCdbus_request_name_reply_primary_owner;
- case DBUS_REQUEST_NAME_REPLY_IN_QUEUE:
- return QCdbus_request_name_reply_in_queue;
- case DBUS_REQUEST_NAME_REPLY_EXISTS:
- return QCdbus_request_name_reply_exists;
- case DBUS_REQUEST_NAME_REPLY_ALREADY_OWNER:
- return QCdbus_request_name_reply_already_owner;
- default:
- /* This should not happen. */
- XD_SIGNAL2 (build_string ("Could not register service"), service);
- }
-}
-
-DEFUN ("dbus-register-signal", Fdbus_register_signal, Sdbus_register_signal,
- 6, MANY, 0,
- doc: /* Register for signal SIGNAL on the D-Bus BUS.
-
-BUS is either a Lisp symbol, `:system' or `:session', or a string
-denoting the bus address.
-
-SERVICE is the D-Bus service name used by the sending D-Bus object.
-It can be either a known name or the unique name of the D-Bus object
-sending the signal. When SERVICE is nil, related signals from all
-D-Bus objects shall be accepted.
-
-PATH is the D-Bus object path SERVICE is registered. It can also be
-nil if the path name of incoming signals shall not be checked.
-
-INTERFACE is an interface offered by SERVICE. It must provide SIGNAL.
-HANDLER is a Lisp function to be called when the signal is received.
-It must accept as arguments the values SIGNAL is sending.
-
-All other arguments ARGS, if specified, must be strings. They stand
-for the respective arguments of the signal in their order, and are
-used for filtering as well. A nil argument might be used to preserve
-the order.
-
-INTERFACE, SIGNAL and HANDLER must not be nil. Example:
-
-\(defun my-signal-handler (device)
- (message "Device %s added" device))
-
-\(dbus-register-signal
- :system "org.freedesktop.Hal" "/org/freedesktop/Hal/Manager"
- "org.freedesktop.Hal.Manager" "DeviceAdded" 'my-signal-handler)
-
- => ((:system "org.freedesktop.Hal.Manager" "DeviceAdded")
- ("org.freedesktop.Hal" "/org/freedesktop/Hal/Manager" my-signal-handler))
-
-`dbus-register-signal' returns an object, which can be used in
-`dbus-unregister-object' for removing the registration.
-
-usage: (dbus-register-signal BUS SERVICE PATH INTERFACE SIGNAL HANDLER &rest ARGS) */)
- (ptrdiff_t nargs, Lisp_Object *args)
-{
- Lisp_Object bus, service, path, interface, signal, handler;
- struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5, gcpro6;
- Lisp_Object uname, key, key1, value;
- DBusConnection *connection;
- ptrdiff_t i;
- char rule[DBUS_MAXIMUM_MATCH_RULE_LENGTH];
- int rulelen;
- DBusError derror;
-
- /* Check parameters. */
- bus = args[0];
- service = args[1];
- path = args[2];
- interface = args[3];
- signal = args[4];
- handler = args[5];
-
- if (!NILP (service)) CHECK_STRING (service);
- if (!NILP (path)) CHECK_STRING (path);
- CHECK_STRING (interface);
- CHECK_STRING (signal);
- if (!FUNCTIONP (handler))
- wrong_type_argument (Qinvalid_function, handler);
- GCPRO6 (bus, service, path, interface, signal, handler);
-
- /* Retrieve unique name of service. If service is a known name, we
- will register for the corresponding unique name, if any. Signals
- are sent always with the unique name as sender. Note: the unique
- name of "org.freedesktop.DBus" is that string itself. */
- if ((STRINGP (service))
- && (SBYTES (service) > 0)
- && (strcmp (SSDATA (service), DBUS_SERVICE_DBUS) != 0)
- && (strncmp (SSDATA (service), ":", 1) != 0))
- uname = call2 (intern ("dbus-get-name-owner"), bus, service);
- else
- uname = service;
-
- /* Create a matching rule if the unique name exists (when no
- wildcard). */
- if (NILP (uname) || (SBYTES (uname) > 0))
- {
- /* Open a connection to the bus. */
- connection = xd_initialize (bus, TRUE);
-
- /* Create a rule to receive related signals. */
- rulelen = snprintf (rule, sizeof rule,
- "type='signal',interface='%s',member='%s'",
- SDATA (interface),
- SDATA (signal));
- if (! (0 <= rulelen && rulelen < sizeof rule))
- string_overflow ();
-
- /* Add unique name and path to the rule if they are non-nil. */
- if (!NILP (uname))
- {
- int len = snprintf (rule + rulelen, sizeof rule - rulelen,
- ",sender='%s'", SDATA (uname));
- if (! (0 <= len && len < sizeof rule - rulelen))
- string_overflow ();
- rulelen += len;
- }
-
- if (!NILP (path))
- {
- int len = snprintf (rule + rulelen, sizeof rule - rulelen,
- ",path='%s'", SDATA (path));
- if (! (0 <= len && len < sizeof rule - rulelen))
- string_overflow ();
- rulelen += len;
- }
-
- /* Add arguments to the rule if they are non-nil. */
- for (i = 6; i < nargs; ++i)
- if (!NILP (args[i]))
- {
- int len;
- CHECK_STRING (args[i]);
- len = snprintf (rule + rulelen, sizeof rule - rulelen,
- ",arg%"pD"d='%s'", i - 6, SDATA (args[i]));
- if (! (0 <= len && len < sizeof rule - rulelen))
- string_overflow ();
- rulelen += len;
- }
-
- /* Add the rule to the bus. */
- dbus_error_init (&derror);
- dbus_bus_add_match (connection, rule, &derror);
- if (dbus_error_is_set (&derror))
- {
- UNGCPRO;
- XD_ERROR (derror);
- }
-
- /* Cleanup. */
- dbus_error_free (&derror);
-
- XD_DEBUG_MESSAGE ("Matching rule \"%s\" created", rule);
- }
-
- /* Create a hash table entry. */
- key = list3 (bus, interface, signal);
- key1 = list5 (uname, service, path, handler, build_string (rule));
- value = Fgethash (key, Vdbus_registered_objects_table, Qnil);
-
- if (NILP (Fmember (key1, value)))
- Fputhash (key, Fcons (key1, value), Vdbus_registered_objects_table);
-
- /* Return object. */
- RETURN_UNGCPRO (list2 (key, list3 (service, path, handler)));
-}
-
-DEFUN ("dbus-register-method", Fdbus_register_method, Sdbus_register_method,
- 6, 7, 0,
- doc: /* Register for method METHOD on the D-Bus BUS.
-
-BUS is either a Lisp symbol, `:system' or `:session', or a string
-denoting the bus address.
-
-SERVICE is the D-Bus service name of the D-Bus object METHOD is
-registered for. It must be a known name (See discussion of
-DONT-REGISTER-SERVICE below).
-
-PATH is the D-Bus object path SERVICE is registered (See discussion of
-DONT-REGISTER-SERVICE below). INTERFACE is the interface offered by
-SERVICE. It must provide METHOD.
-
-HANDLER is a Lisp function to be called when a method call is
-received. It must accept the input arguments of METHOD. The return
-value of HANDLER is used for composing the returning D-Bus message.
-In case HANDLER shall return a reply message with an empty argument
-list, HANDLER must return the symbol `:ignore'.
-
-When DONT-REGISTER-SERVICE is non-nil, the known name SERVICE is not
-registered. This means that other D-Bus clients have no way of
-noticing the newly registered method. When interfaces are constructed
-incrementally by adding single methods or properties at a time,
-DONT-REGISTER-SERVICE can be used to prevent other clients from
-discovering the still incomplete interface.*/)
- (Lisp_Object bus, Lisp_Object service, Lisp_Object path,
- Lisp_Object interface, Lisp_Object method, Lisp_Object handler,
- Lisp_Object dont_register_service)
-{
- Lisp_Object key, key1, value;
- Lisp_Object args[2] = { bus, service };
-
- /* Check parameters. */
- CHECK_STRING (service);
- CHECK_STRING (path);
- CHECK_STRING (interface);
- CHECK_STRING (method);
- if (!FUNCTIONP (handler))
- wrong_type_argument (Qinvalid_function, handler);
- /* TODO: We must check for a valid service name, otherwise there is
- a segmentation fault. */
-
- /* Request the name. */
- if (NILP (dont_register_service))
- Fdbus_register_service (2, args);
-
- /* Create a hash table entry. We use nil for the unique name,
- because the method might be called from anybody. */
- key = list3 (bus, interface, method);
- key1 = list4 (Qnil, service, path, handler);
- value = Fgethash (key, Vdbus_registered_objects_table, Qnil);
-
- if (NILP (Fmember (key1, value)))
- Fputhash (key, Fcons (key1, value), Vdbus_registered_objects_table);
-
- /* Return object. */
- return list2 (key, list3 (service, path, handler));
-}
-
void
syms_of_dbusbind (void)
@@ -2218,35 +1645,11 @@ syms_of_dbusbind (void)
DEFSYM (Qdbus_init_bus, "dbus-init-bus");
defsubr (&Sdbus_init_bus);
- DEFSYM (Qdbus_close_bus, "dbus-close-bus");
- defsubr (&Sdbus_close_bus);
-
DEFSYM (Qdbus_get_unique_name, "dbus-get-unique-name");
defsubr (&Sdbus_get_unique_name);
- DEFSYM (Qdbus_call_method, "dbus-call-method");
- defsubr (&Sdbus_call_method);
-
- DEFSYM (Qdbus_call_method_asynchronously, "dbus-call-method-asynchronously");
- defsubr (&Sdbus_call_method_asynchronously);
-
- DEFSYM (Qdbus_method_return_internal, "dbus-method-return-internal");
- defsubr (&Sdbus_method_return_internal);
-
- DEFSYM (Qdbus_method_error_internal, "dbus-method-error-internal");
- defsubr (&Sdbus_method_error_internal);
-
- DEFSYM (Qdbus_send_signal, "dbus-send-signal");
- defsubr (&Sdbus_send_signal);
-
- DEFSYM (Qdbus_register_service, "dbus-register-service");
- defsubr (&Sdbus_register_service);
-
- DEFSYM (Qdbus_register_signal, "dbus-register-signal");
- defsubr (&Sdbus_register_signal);
-
- DEFSYM (Qdbus_register_method, "dbus-register-method");
- defsubr (&Sdbus_register_method);
+ DEFSYM (Qdbus_message_internal, "dbus-message-internal");
+ defsubr (&Sdbus_message_internal);
DEFSYM (Qdbus_error, "dbus-error");
Fput (Qdbus_error, Qerror_conditions,
@@ -2256,13 +1659,6 @@ syms_of_dbusbind (void)
DEFSYM (QCdbus_system_bus, ":system");
DEFSYM (QCdbus_session_bus, ":session");
- DEFSYM (QCdbus_request_name_allow_replacement, ":allow-replacement");
- DEFSYM (QCdbus_request_name_replace_existing, ":replace-existing");
- DEFSYM (QCdbus_request_name_do_not_queue, ":do-not-queue");
- DEFSYM (QCdbus_request_name_reply_primary_owner, ":primary-owner");
- DEFSYM (QCdbus_request_name_reply_exists, ":exists");
- DEFSYM (QCdbus_request_name_reply_in_queue, ":in-queue");
- DEFSYM (QCdbus_request_name_reply_already_owner, ":already-owner");
DEFSYM (QCdbus_timeout, ":timeout");
DEFSYM (QCdbus_type_byte, ":byte");
DEFSYM (QCdbus_type_boolean, ":boolean");
@@ -2276,20 +1672,66 @@ syms_of_dbusbind (void)
DEFSYM (QCdbus_type_string, ":string");
DEFSYM (QCdbus_type_object_path, ":object-path");
DEFSYM (QCdbus_type_signature, ":signature");
-
#ifdef DBUS_TYPE_UNIX_FD
DEFSYM (QCdbus_type_unix_fd, ":unix-fd");
#endif
-
DEFSYM (QCdbus_type_array, ":array");
DEFSYM (QCdbus_type_variant, ":variant");
DEFSYM (QCdbus_type_struct, ":struct");
DEFSYM (QCdbus_type_dict_entry, ":dict-entry");
+ DEFSYM (QCdbus_registered_serial, ":serial");
+ DEFSYM (QCdbus_registered_method, ":method");
+ DEFSYM (QCdbus_registered_signal, ":signal");
+
+ DEFVAR_LISP ("dbus-compiled-version",
+ Vdbus_compiled_version,
+ doc: /* The version of D-Bus Emacs is compiled against. */);
+#ifdef DBUS_VERSION_STRING
+ Vdbus_compiled_version = make_pure_c_string (DBUS_VERSION_STRING);
+#else
+ Vdbus_compiled_version = Qnil;
+#endif
+
+ DEFVAR_LISP ("dbus-runtime-version",
+ Vdbus_runtime_version,
+ doc: /* The version of D-Bus Emacs runs with. */);
+ {
+#ifdef DBUS_VERSION
+ int major, minor, micro;
+ char s[1024];
+ dbus_get_version (&major, &minor, &micro);
+ snprintf (s, sizeof s, "%d.%d.%d", major, minor, micro);
+ Vdbus_runtime_version = make_string (s, strlen (s));
+#else
+ Vdbus_runtime_version = Qnil;
+#endif
+ }
+
+ DEFVAR_LISP ("dbus-message-type-invalid",
+ Vdbus_message_type_invalid,
+ doc: /* This value is never a valid message type. */);
+ Vdbus_message_type_invalid = make_number (DBUS_MESSAGE_TYPE_INVALID);
- DEFVAR_LISP ("dbus-registered-buses",
- Vdbus_registered_buses,
- doc: /* List of D-Bus buses we are polling for messages. */);
- Vdbus_registered_buses = Qnil;
+ DEFVAR_LISP ("dbus-message-type-method-call",
+ Vdbus_message_type_method_call,
+ doc: /* Message type of a method call message. */);
+ Vdbus_message_type_method_call = make_number (DBUS_MESSAGE_TYPE_METHOD_CALL);
+
+ DEFVAR_LISP ("dbus-message-type-method-return",
+ Vdbus_message_type_method_return,
+ doc: /* Message type of a method return message. */);
+ Vdbus_message_type_method_return
+ = make_number (DBUS_MESSAGE_TYPE_METHOD_RETURN);
+
+ DEFVAR_LISP ("dbus-message-type-error",
+ Vdbus_message_type_error,
+ doc: /* Message type of an error reply message. */);
+ Vdbus_message_type_error = make_number (DBUS_MESSAGE_TYPE_ERROR);
+
+ DEFVAR_LISP ("dbus-message-type-signal",
+ Vdbus_message_type_signal,
+ doc: /* Message type of a signal message. */);
+ Vdbus_message_type_signal = make_number (DBUS_MESSAGE_TYPE_SIGNAL);
DEFVAR_LISP ("dbus-registered-objects-table",
Vdbus_registered_objects_table,
@@ -2299,27 +1741,28 @@ There are two different uses of the hash table: for accessing
registered interfaces properties, targeted by signals or method calls,
and for calling handlers in case of non-blocking method call returns.
-In the first case, the key in the hash table is the list (BUS
-INTERFACE MEMBER). BUS is either a Lisp symbol, `:system' or
+In the first case, the key in the hash table is the list (TYPE BUS
+INTERFACE MEMBER). TYPE is one of the Lisp symbols `:method',
+`:signal' or `:property'. BUS is either a Lisp symbol, `:system' or
`:session', or a string denoting the bus address. INTERFACE is a
string which denotes a D-Bus interface, and MEMBER, also a string, is
either a method, a signal or a property INTERFACE is offering. All
arguments but BUS must not be nil.
-The value in the hash table is a list of quadruple lists
-\((UNAME SERVICE PATH OBJECT) (UNAME SERVICE PATH OBJECT) ...).
-SERVICE is the service name as registered, UNAME is the corresponding
-unique name. In case of registered methods and properties, UNAME is
-nil. PATH is the object path of the sending object. All of them can
-be nil, which means a wildcard then. OBJECT is either the handler to
-be called when a D-Bus message, which matches the key criteria,
-arrives (methods and signals), or a cons cell containing the value of
-the property.
+The value in the hash table is a list of quadruple lists \((UNAME
+SERVICE PATH OBJECT [RULE]) ...). SERVICE is the service name as
+registered, UNAME is the corresponding unique name. In case of
+registered methods and properties, UNAME is nil. PATH is the object
+path of the sending object. All of them can be nil, which means a
+wildcard then. OBJECT is either the handler to be called when a D-Bus
+message, which matches the key criteria, arrives (TYPE `:method' and
+`:signal'), or a cons cell containing the value of the property (TYPE
+`:property').
-For signals, there is also a fifth element RULE, which keeps the match
-string the signal is registered with.
+For entries of type `:signal', there is also a fifth element RULE,
+which keeps the match string the signal is registered with.
-In the second case, the key in the hash table is the list (BUS
+In the second case, the key in the hash table is the list (:serial BUS
SERIAL). BUS is either a Lisp symbol, `:system' or `:session', or a
string denoting the bus address. SERIAL is the serial number of the
non-blocking method call, a reply is expected. Both arguments must
@@ -2343,6 +1786,10 @@ be called when the D-Bus reply message arrives. */);
Vdbus_debug = Qnil;
#endif
+ /* Initialize internal objects. */
+ xd_registered_buses = Qnil;
+ staticpro (&xd_registered_buses);
+
Fprovide (intern_c_string ("dbusbind"), Qnil);
}
diff --git a/src/dired.c b/src/dired.c
index 9b0f94a0760..367bcb4031d 100644
--- a/src/dired.c
+++ b/src/dired.c
@@ -1015,6 +1015,45 @@ Comparison is in lexicographic order and case is significant. */)
return Fstring_lessp (Fcar (f1), Fcar (f2));
}
+
+DEFUN ("system-users", Fsystem_users, Ssystem_users, 0, 0, 0,
+ doc: /* Return a list of user names currently registered in the system.
+If we don't know how to determine that on this platform, just
+return a list with one element, taken from `user-real-login-name'. */)
+ (void)
+{
+ Lisp_Object users = Qnil;
+#if defined HAVE_GETPWENT && defined HAVE_ENDPWENT
+ struct passwd *pw;
+
+ while ((pw = getpwent ()))
+ users = Fcons (DECODE_SYSTEM (build_string (pw->pw_name)), users);
+
+ endpwent ();
+#endif
+ if (EQ (users, Qnil))
+ /* At least current user is always known. */
+ users = Fcons (Vuser_real_login_name, Qnil);
+ return users;
+}
+
+DEFUN ("system-groups", Fsystem_groups, Ssystem_groups, 0, 0, 0,
+ doc: /* Return a list of user group names currently registered in the system.
+The value may be nil if not supported on this platform. */)
+ (void)
+{
+ Lisp_Object groups = Qnil;
+#if defined HAVE_GETGRENT && defined HAVE_ENDGRENT
+ struct group *gr;
+
+ while ((gr = getgrent ()))
+ groups = Fcons (DECODE_SYSTEM (build_string (gr->gr_name)), groups);
+
+ endgrent ();
+#endif
+ return groups;
+}
+
void
syms_of_dired (void)
{
@@ -1032,6 +1071,8 @@ syms_of_dired (void)
defsubr (&Sfile_name_all_completions);
defsubr (&Sfile_attributes);
defsubr (&Sfile_attributes_lessp);
+ defsubr (&Ssystem_users);
+ defsubr (&Ssystem_groups);
DEFVAR_LISP ("completion-ignored-extensions", Vcompletion_ignored_extensions,
doc: /* Completion ignores file names ending in any string in this list.
diff --git a/src/dispextern.h b/src/dispextern.h
index e45d4b1e558..b4aa0153846 100644
--- a/src/dispextern.h
+++ b/src/dispextern.h
@@ -3271,7 +3271,6 @@ extern Window tip_window;
EXFUN (Fx_hide_tip, 0);
extern void start_hourglass (void);
extern void cancel_hourglass (void);
-extern int hourglass_started (void);
extern int hourglass_shown_p;
struct atimer; /* Defined in atimer.h. */
/* If non-null, an asynchronous timer that, when it expires, displays
diff --git a/src/dispnew.c b/src/dispnew.c
index 1f494b5685b..73c58ceded8 100644
--- a/src/dispnew.c
+++ b/src/dispnew.c
@@ -1,5 +1,6 @@
/* Updating of data structures for redisplay.
- Copyright (C) 1985-1988, 1993-1995, 1997-2012 Free Software Foundation, Inc.
+
+Copyright (C) 1985-1988, 1993-1995, 1997-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -92,7 +93,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#endif
#endif /* not __GNU_LIBRARY__ */
-#if defined (HAVE_TERM_H) && defined (GNU_LINUX) && defined (HAVE_LIBNCURSES)
+#if defined (HAVE_TERM_H) && defined (GNU_LINUX)
#include <term.h> /* for tgetent */
#endif
@@ -1089,12 +1090,16 @@ swap_glyph_pointers (struct glyph_row *a, struct glyph_row *b)
for (i = 0; i < LAST_AREA + 1; ++i)
{
struct glyph *temp = a->glyphs[i];
- short used_tem = a->used[i];
a->glyphs[i] = b->glyphs[i];
b->glyphs[i] = temp;
- a->used[i] = b->used[i];
- b->used[i] = used_tem;
+ if (i < LAST_AREA)
+ {
+ short used_tem = a->used[i];
+
+ a->used[i] = b->used[i];
+ b->used[i] = used_tem;
+ }
}
a->hash = b->hash;
b->hash = hash_tem;
@@ -1109,7 +1114,7 @@ static inline void
copy_row_except_pointers (struct glyph_row *to, struct glyph_row *from)
{
struct glyph *pointers[1 + LAST_AREA];
- short used[1 + LAST_AREA];
+ short used[LAST_AREA];
unsigned hashval;
/* Save glyph pointers of TO. */
@@ -6312,7 +6317,7 @@ init_display (void)
#ifdef HAVE_X11
Vwindow_system_version = make_number (11);
#endif
-#if defined (GNU_LINUX) && defined (HAVE_LIBNCURSES)
+#ifdef GNU_LINUX
/* In some versions of ncurses,
tputs crashes if we have not called tgetent.
So call tgetent. */
diff --git a/src/editfns.c b/src/editfns.c
index a41565d8588..d266ca9951d 100644
--- a/src/editfns.c
+++ b/src/editfns.c
@@ -73,20 +73,13 @@ extern char **environ;
#define TM_YEAR_BASE 1900
-/* Nonzero if TM_YEAR is a struct tm's tm_year value that causes
- asctime to have well-defined behavior. */
-#ifndef TM_YEAR_IN_ASCTIME_RANGE
-# define TM_YEAR_IN_ASCTIME_RANGE(tm_year) \
- (1000 - TM_YEAR_BASE <= (tm_year) && (tm_year) <= 9999 - TM_YEAR_BASE)
-#endif
-
#ifdef WINDOWSNT
extern Lisp_Object w32_get_internal_run_time (void);
#endif
static void time_overflow (void) NO_RETURN;
static Lisp_Object format_time_string (char const *, ptrdiff_t, Lisp_Object,
- int, time_t *, struct tm **);
+ int, time_t *, struct tm *);
static int tm_diff (struct tm *, struct tm *);
static void update_buffer_properties (EMACS_INT, EMACS_INT);
@@ -1704,7 +1697,7 @@ usage: (format-time-string FORMAT-STRING &optional TIME UNIVERSAL) */)
(Lisp_Object format_string, Lisp_Object timeval, Lisp_Object universal)
{
time_t t;
- struct tm *tm;
+ struct tm tm;
CHECK_STRING (format_string);
format_string = code_convert_string_norecord (format_string,
@@ -1715,54 +1708,55 @@ usage: (format-time-string FORMAT-STRING &optional TIME UNIVERSAL) */)
static Lisp_Object
format_time_string (char const *format, ptrdiff_t formatlen,
- Lisp_Object timeval, int ut, time_t *tval, struct tm **tmp)
+ Lisp_Object timeval, int ut, time_t *tval, struct tm *tmp)
{
- ptrdiff_t size;
+ char buffer[4000];
+ char *buf = buffer;
+ size_t size = sizeof buffer;
+ size_t len;
+ Lisp_Object bufstring;
int usec;
int ns;
struct tm *tm;
+ USE_SAFE_ALLOCA;
if (! (lisp_time_argument (timeval, tval, &usec)
&& 0 <= usec && usec < 1000000))
error ("Invalid time specification");
ns = usec * 1000;
- /* This is probably enough. */
- size = formatlen;
- if (size <= (STRING_BYTES_BOUND - 50) / 6)
- size = size * 6 + 50;
-
- BLOCK_INPUT;
- tm = ut ? gmtime (tval) : localtime (tval);
- UNBLOCK_INPUT;
- if (! tm)
- time_overflow ();
- *tmp = tm;
-
- synchronize_system_time_locale ();
-
while (1)
{
- char *buf = (char *) alloca (size + 1);
- size_t result;
+ BLOCK_INPUT;
+
+ synchronize_system_time_locale ();
+
+ tm = ut ? gmtime (tval) : localtime (tval);
+ if (! tm)
+ {
+ UNBLOCK_INPUT;
+ time_overflow ();
+ }
+ *tmp = *tm;
buf[0] = '\1';
- BLOCK_INPUT;
- result = emacs_nmemftime (buf, size, format, formatlen, tm, ut, ns);
- UNBLOCK_INPUT;
- if ((result > 0 && result < size) || (result == 0 && buf[0] == '\0'))
- return code_convert_string_norecord (make_unibyte_string (buf, result),
- Vlocale_coding_system, 0);
+ len = emacs_nmemftime (buf, size, format, formatlen, tm, ut, ns);
+ if ((0 < len && len < size) || (len == 0 && buf[0] == '\0'))
+ break;
- /* If buffer was too small, make it bigger and try again. */
- BLOCK_INPUT;
- result = emacs_nmemftime (NULL, (size_t) -1, format, formatlen,
- tm, ut, ns);
+ /* Buffer was too small, so make it bigger and try again. */
+ len = emacs_nmemftime (NULL, SIZE_MAX, format, formatlen, tm, ut, ns);
UNBLOCK_INPUT;
- if (STRING_BYTES_BOUND <= result)
+ if (STRING_BYTES_BOUND <= len)
string_overflow ();
- size = result + 1;
+ size = len + 1;
+ SAFE_ALLOCA (buf, char *, size);
}
+
+ UNBLOCK_INPUT;
+ bufstring = make_unibyte_string (buf, len);
+ SAFE_FREE ();
+ return code_convert_string_norecord (bufstring, Vlocale_coding_system, 0);
}
DEFUN ("decode-time", Fdecode_time, Sdecode_time, 0, 1, 0,
@@ -1792,31 +1786,32 @@ DOW and ZONE.) */)
BLOCK_INPUT;
decoded_time = localtime (&time_spec);
+ /* Make a copy, in case a signal handler modifies TZ or the struct. */
+ if (decoded_time)
+ save_tm = *decoded_time;
UNBLOCK_INPUT;
if (! (decoded_time
- && MOST_NEGATIVE_FIXNUM - TM_YEAR_BASE <= decoded_time->tm_year
- && decoded_time->tm_year <= MOST_POSITIVE_FIXNUM - TM_YEAR_BASE))
+ && MOST_NEGATIVE_FIXNUM - TM_YEAR_BASE <= save_tm.tm_year
+ && save_tm.tm_year <= MOST_POSITIVE_FIXNUM - TM_YEAR_BASE))
time_overflow ();
- XSETFASTINT (list_args[0], decoded_time->tm_sec);
- XSETFASTINT (list_args[1], decoded_time->tm_min);
- XSETFASTINT (list_args[2], decoded_time->tm_hour);
- XSETFASTINT (list_args[3], decoded_time->tm_mday);
- XSETFASTINT (list_args[4], decoded_time->tm_mon + 1);
+ XSETFASTINT (list_args[0], save_tm.tm_sec);
+ XSETFASTINT (list_args[1], save_tm.tm_min);
+ XSETFASTINT (list_args[2], save_tm.tm_hour);
+ XSETFASTINT (list_args[3], save_tm.tm_mday);
+ XSETFASTINT (list_args[4], save_tm.tm_mon + 1);
/* On 64-bit machines an int is narrower than EMACS_INT, thus the
cast below avoids overflow in int arithmetics. */
- XSETINT (list_args[5], TM_YEAR_BASE + (EMACS_INT) decoded_time->tm_year);
- XSETFASTINT (list_args[6], decoded_time->tm_wday);
- list_args[7] = (decoded_time->tm_isdst)? Qt : Qnil;
+ XSETINT (list_args[5], TM_YEAR_BASE + (EMACS_INT) save_tm.tm_year);
+ XSETFASTINT (list_args[6], save_tm.tm_wday);
+ list_args[7] = save_tm.tm_isdst ? Qt : Qnil;
- /* Make a copy, in case gmtime modifies the struct. */
- save_tm = *decoded_time;
BLOCK_INPUT;
decoded_time = gmtime (&time_spec);
- UNBLOCK_INPUT;
if (decoded_time == 0)
list_args[8] = Qnil;
else
XSETINT (list_args[8], tm_diff (&save_tm, decoded_time));
+ UNBLOCK_INPUT;
return Flist (9, list_args);
}
@@ -1898,21 +1893,23 @@ usage: (encode-time SECOND MINUTE HOUR DAY MONTH YEAR &optional ZONE) */)
else
error ("Invalid time zone specification");
+ BLOCK_INPUT;
+
/* Set TZ before calling mktime; merely adjusting mktime's returned
value doesn't suffice, since that would mishandle leap seconds. */
set_time_zone_rule (tzstring);
- BLOCK_INPUT;
value = mktime (&tm);
- UNBLOCK_INPUT;
/* Restore TZ to previous value. */
newenv = environ;
environ = oldenv;
- xfree (newenv);
#ifdef LOCALTIME_CACHE
tzset ();
#endif
+ UNBLOCK_INPUT;
+
+ xfree (newenv);
}
if (value == (time_t) -1)
@@ -1939,24 +1936,37 @@ but this is considered obsolete. */)
{
time_t value;
struct tm *tm;
- register char *tem;
+ char buf[sizeof "Mon Apr 30 12:49:17 " + INT_STRLEN_BOUND (int) + 1];
+ int len IF_LINT (= 0);
if (! lisp_time_argument (specified_time, &value, NULL))
error ("Invalid time specification");
- /* Convert to a string, checking for out-of-range time stamps.
- Don't use 'ctime', as that might dump core if VALUE is out of
- range. */
+ /* Convert to a string in ctime format, except without the trailing
+ newline, and without the 4-digit year limit. Don't use asctime
+ or ctime, as they might dump core if the year is outside the
+ range -999 .. 9999. */
BLOCK_INPUT;
tm = localtime (&value);
+ if (tm)
+ {
+ static char const wday_name[][4] =
+ { "Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat" };
+ static char const mon_name[][4] =
+ { "Jan", "Feb", "Mar", "Apr", "May", "Jun",
+ "Jul", "Aug", "Sep", "Oct", "Nov", "Dec" };
+ printmax_t year_base = TM_YEAR_BASE;
+
+ len = sprintf (buf, "%s %s%3d %02d:%02d:%02d %"pMd,
+ wday_name[tm->tm_wday], mon_name[tm->tm_mon], tm->tm_mday,
+ tm->tm_hour, tm->tm_min, tm->tm_sec,
+ tm->tm_year + year_base);
+ }
UNBLOCK_INPUT;
- if (! (tm && TM_YEAR_IN_ASCTIME_RANGE (tm->tm_year) && (tem = asctime (tm))))
+ if (! tm)
time_overflow ();
- /* Remove the trailing newline. */
- tem[strlen (tem) - 1] = '\0';
-
- return build_string (tem);
+ return make_unibyte_string (buf, len);
}
/* Yield A - B, measured in seconds.
@@ -2000,22 +2010,22 @@ the data it can't find. */)
(Lisp_Object specified_time)
{
time_t value;
+ int offset;
struct tm *t;
struct tm localtm;
- struct tm *localt;
Lisp_Object zone_offset, zone_name;
zone_offset = Qnil;
zone_name = format_time_string ("%Z", sizeof "%Z" - 1, specified_time,
- 0, &value, &localt);
- localtm = *localt;
+ 0, &value, &localtm);
BLOCK_INPUT;
t = gmtime (&value);
+ if (t)
+ offset = tm_diff (&localtm, t);
UNBLOCK_INPUT;
if (t)
{
- int offset = tm_diff (&localtm, t);
zone_offset = make_number (offset);
if (SCHARS (zone_name) == 0)
{
@@ -2053,9 +2063,16 @@ only the former. */)
(Lisp_Object tz)
{
const char *tzstring;
+ char **old_environbuf;
+
+ if (! (NILP (tz) || EQ (tz, Qt)))
+ CHECK_STRING (tz);
+
+ BLOCK_INPUT;
/* When called for the first time, save the original TZ. */
- if (!environbuf)
+ old_environbuf = environbuf;
+ if (!old_environbuf)
initial_tz = (char *) getenv ("TZ");
if (NILP (tz))
@@ -2063,15 +2080,14 @@ only the former. */)
else if (EQ (tz, Qt))
tzstring = "UTC0";
else
- {
- CHECK_STRING (tz);
- tzstring = SSDATA (tz);
- }
+ tzstring = SSDATA (tz);
set_time_zone_rule (tzstring);
- xfree (environbuf);
environbuf = environ;
+ UNBLOCK_INPUT;
+
+ xfree (old_environbuf);
return Qnil;
}
diff --git a/src/emacsgtkfixed.c b/src/emacsgtkfixed.c
index e45cc716a31..194d3d3879f 100644
--- a/src/emacsgtkfixed.c
+++ b/src/emacsgtkfixed.c
@@ -30,6 +30,28 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#ifdef HAVE_XWIDGETS
#include "xwidget.h"
#endif
+
+#define EMACS_TYPE_FIXED emacs_fixed_get_type ()
+#define EMACS_FIXED(obj) \
+ G_TYPE_CHECK_INSTANCE_CAST (obj, EMACS_TYPE_FIXED, EmacsFixed)
+
+typedef struct _EmacsFixed EmacsFixed;
+typedef struct _EmacsFixedPrivate EmacsFixedPrivate;
+typedef struct _EmacsFixedClass EmacsFixedClass;
+
+struct _EmacsFixed
+{
+ GtkFixed container;
+
+ /*< private >*/
+ EmacsFixedPrivate *priv;
+};
+
+struct _EmacsFixedClass
+{
+ GtkFixedClass parent_class;
+};
+
struct _EmacsFixedPrivate
{
struct frame *f;
@@ -42,6 +64,7 @@ static void emacs_fixed_get_preferred_width (GtkWidget *widget,
static void emacs_fixed_get_preferred_height (GtkWidget *widget,
gint *minimum,
gint *natural);
+static GType emacs_fixed_get_type (void);
G_DEFINE_TYPE (EmacsFixed, emacs_fixed, GTK_TYPE_FIXED)
#ifdef HAVE_XWIDGETS
@@ -164,10 +187,8 @@ static void
emacs_fixed_class_init (EmacsFixedClass *klass)
{
GtkWidgetClass *widget_class;
- GtkFixedClass *fixed_class;
widget_class = (GtkWidgetClass*) klass;
- fixed_class = (GtkFixedClass*) klass;
widget_class->get_preferred_width = emacs_fixed_get_preferred_width;
widget_class->get_preferred_height = emacs_fixed_get_preferred_height;
@@ -177,12 +198,6 @@ emacs_fixed_class_init (EmacsFixedClass *klass)
g_type_class_add_private (klass, sizeof (EmacsFixedPrivate));
}
-static GType
-emacs_fixed_child_type (GtkFixed *container)
-{
- return GTK_TYPE_WIDGET;
-}
-
static void
emacs_fixed_init (EmacsFixed *fixed)
{
diff --git a/src/emacsgtkfixed.h b/src/emacsgtkfixed.h
index 90fb37e521b..3fa294aa41e 100644
--- a/src/emacsgtkfixed.h
+++ b/src/emacsgtkfixed.h
@@ -27,33 +27,7 @@ G_BEGIN_DECLS
struct frame;
-#define EMACS_TYPE_FIXED (emacs_fixed_get_type ())
-#define EMACS_FIXED(obj) (G_TYPE_CHECK_INSTANCE_CAST ((obj), EMACS_TYPE_FIXED, EmacsFixed))
-#define EMACS_FIXED_CLASS(klass) (G_TYPE_CHECK_CLASS_CAST ((klass), EMACS_TYPE_FIXED, EmacsFixedClass))
-#define EMACS_IS_FIXED(obj) (G_TYPE_CHECK_INSTANCE_TYPE ((obj), EMACS_TYPE_FIXED))
-#define EMACS_IS_FIXED_CLASS(klass) (G_TYPE_CHECK_CLASS_TYPE ((klass), EMACS_TYPE_FIXED))
-#define EMACS_FIXED_GET_CLASS(obj) (G_TYPE_INSTANCE_GET_CLASS ((obj), EMACS_TYPE_FIXED, EmacsFixedClass))
-
-typedef struct _EmacsFixed EmacsFixed;
-typedef struct _EmacsFixedPrivate EmacsFixedPrivate;
-typedef struct _EmacsFixedClass EmacsFixedClass;
-
-struct _EmacsFixed
-{
- GtkFixed container;
-
- /*< private >*/
- EmacsFixedPrivate *priv;
-};
-
-
-struct _EmacsFixedClass
-{
- GtkFixedClass parent_class;
-};
-
extern GtkWidget *emacs_fixed_new (struct frame *f);
-extern GType emacs_fixed_get_type (void);
G_END_DECLS
diff --git a/src/eval.c b/src/eval.c
index cb0518f34ec..3d0e82c2d9f 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -2048,7 +2048,7 @@ this does nothing and returns nil. */)
We used to use 0 here, but that leads to accidental sharing in
purecopy's hash-consing, so we use a (hopefully) unique integer
instead. */
- docstring = make_number (XPNTR (function));
+ docstring = make_number (XUNTAG (function, Lisp_Symbol));
return Ffset (function,
Fpurecopy (list5 (Qautoload, file, docstring,
interactive, type)));
diff --git a/src/fileio.c b/src/fileio.c
index 3a74672b9a6..f09ba2c394c 100644
--- a/src/fileio.c
+++ b/src/fileio.c
@@ -1,6 +1,6 @@
/* File IO for GNU Emacs.
-Copyright (C) 1985-1988, 1993-2012 Free Software Foundation, Inc.
+Copyright (C) 1985-1988, 1993-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -87,17 +87,17 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#define FILE_SYSTEM_CASE(filename) (filename)
#endif
-/* Nonzero during writing of auto-save files */
+/* Nonzero during writing of auto-save files. */
static int auto_saving;
-/* Nonzero umask during creation of auto-save directories */
+/* Nonzero umask during creation of auto-save directories. */
static int auto_saving_dir_umask;
/* Set by auto_save_1 to mode of original file so Fwrite_region will create
- a new file with the same mode as the original */
+ a new file with the same mode as the original. */
static int auto_save_mode_bits;
-/* Set by auto_save_1 if an error occurred during the last auto-save. */
+/* Set by auto_save_1 if an error occurred during the last auto-save. */
static int auto_save_error_occurred;
/* The symbol bound to coding-system-for-read when
@@ -111,7 +111,7 @@ static Lisp_Object Qauto_save_coding;
which gives a list of operations it handles.. */
static Lisp_Object Qoperations;
-/* Lisp functions for translating file formats */
+/* Lisp functions for translating file formats. */
static Lisp_Object Qformat_decode, Qformat_annotate_function;
/* Lisp function for setting buffer-file-coding-system and the
@@ -2044,9 +2044,10 @@ on the system, we copy the SELinux context of FILE to NEWNAME. */)
#if HAVE_LIBSELINUX
if (conlength > 0)
{
- /* Set the modified context back to the file. */
+ /* Set the modified context back to the file. */
fail = fsetfilecon (ofd, con);
- if (fail)
+ /* See http://debbugs.gnu.org/11245 for ENOTSUP. */
+ if (fail && errno != ENOTSUP)
report_file_error ("Doing fsetfilecon", Fcons (newname, Qnil));
freecon (con);
@@ -2917,10 +2918,11 @@ compiled with SELinux support. */)
error ("Doing context_range_set");
}
- /* Set the modified context back to the file. */
+ /* Set the modified context back to the file. */
fail = lsetfilecon (SSDATA (encoded_absname),
context_str (parsed_con));
- if (fail)
+ /* See http://debbugs.gnu.org/11245 for ENOTSUP. */
+ if (fail && errno != ENOTSUP)
report_file_error ("Doing lsetfilecon", Fcons (absname, Qnil));
context_free (parsed_con);
diff --git a/src/filelock.c b/src/filelock.c
index 2613eec4aca..d8914c73328 100644
--- a/src/filelock.c
+++ b/src/filelock.c
@@ -550,6 +550,10 @@ lock_file (Lisp_Object fn)
struct gcpro gcpro1;
USE_SAFE_ALLOCA;
+ /* Don't do locking if the user has opted out. */
+ if (! create_lockfiles)
+ return;
+
/* Don't do locking while dumping Emacs.
Uncompressing wtmp files uses call-process, which does not work
in an uninitialized Emacs. */
@@ -722,6 +726,10 @@ syms_of_filelock (void)
doc: /* The directory for writing temporary files. */);
Vtemporary_file_directory = Qnil;
+ DEFVAR_BOOL ("create-lockfiles", create_lockfiles,
+ doc: /* Non-nil means use lockfiles to avoid editing collisions. */);
+ create_lockfiles = 1;
+
#ifdef CLASH_DETECTION
defsubr (&Sunlock_buffer);
defsubr (&Slock_buffer);
diff --git a/src/font.h b/src/font.h
index 663cc675c05..ea392d2e3fa 100644
--- a/src/font.h
+++ b/src/font.h
@@ -469,11 +469,12 @@ struct font_bitmap
} while (0)
#define XFONT_SPEC(p) \
- (eassert (FONT_SPEC_P(p)), (struct font_spec *) XPNTR (p))
+ (eassert (FONT_SPEC_P (p)), (struct font_spec *) XUNTAG (p, Lisp_Vectorlike))
#define XFONT_ENTITY(p) \
- (eassert (FONT_ENTITY_P(p)), (struct font_entity *) XPNTR (p))
+ (eassert (FONT_ENTITY_P (p)), \
+ (struct font_entity *) XUNTAG (p, Lisp_Vectorlike))
#define XFONT_OBJECT(p) \
- (eassert (FONT_OBJECT_P(p)), (struct font *) XPNTR (p))
+ (eassert (FONT_OBJECT_P (p)), (struct font *) XUNTAG (p, Lisp_Vectorlike))
#define XSETFONT(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_FONT))
/* Number of pt per inch (from the TeXbook). */
diff --git a/src/frame.h b/src/frame.h
index 5c89fc69628..9779f4a0926 100644
--- a/src/frame.h
+++ b/src/frame.h
@@ -501,7 +501,8 @@ struct frame
typedef struct frame *FRAME_PTR;
-#define XFRAME(p) (eassert (FRAMEP(p)),(struct frame *) XPNTR (p))
+#define XFRAME(p) \
+ (eassert (FRAMEP (p)), (struct frame *) XUNTAG (p, Lisp_Vectorlike))
#define XSETFRAME(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_FRAME))
/* Given a window, return its frame as a Lisp_Object. */
diff --git a/src/gmalloc.c b/src/gmalloc.c
index 7b5e6df009b..b53199e7312 100644
--- a/src/gmalloc.c
+++ b/src/gmalloc.c
@@ -1,9 +1,3 @@
-/* This file is no longer automatically generated from libc. */
-
-#define _MALLOC_INTERNAL
-
-/* The malloc headers and source files from the C library follow here. */
-
/* Declarations for `malloc' and friends.
Copyright (C) 1990, 1991, 1992, 1993, 1995, 1996, 1999, 2002, 2003, 2004,
2005, 2006, 2007 Free Software Foundation, Inc.
@@ -27,12 +21,6 @@ Fifth Floor, Boston, MA 02110-1301, USA.
The author may be reached (Email) at the address mike@ai.mit.edu,
or (US mail) as Mike Haertel c/o Free Software Foundation. */
-#ifndef _MALLOC_H
-
-#define _MALLOC_H 1
-
-#ifdef _MALLOC_INTERNAL
-
#ifdef HAVE_CONFIG_H
#include <config.h>
#endif
@@ -41,62 +29,44 @@ Fifth Floor, Boston, MA 02110-1301, USA.
#define USE_PTHREAD
#endif
-#undef PP
-#define PP(args) args
-#undef __ptr_t
-#define __ptr_t void *
-
#include <string.h>
#include <limits.h>
+#include <stdint.h>
#include <unistd.h>
#ifdef USE_PTHREAD
#include <pthread.h>
#endif
-#endif /* _MALLOC_INTERNAL. */
-
-
#ifdef __cplusplus
extern "C"
{
#endif
#include <stddef.h>
-#define __malloc_size_t size_t
-#define __malloc_ptrdiff_t ptrdiff_t
/* Allocate SIZE bytes of memory. */
-extern __ptr_t malloc PP ((__malloc_size_t __size));
+extern void *malloc (size_t size);
/* Re-allocate the previously allocated block
- in __ptr_t, making the new block SIZE bytes long. */
-extern __ptr_t realloc PP ((__ptr_t __ptr, __malloc_size_t __size));
+ in ptr, making the new block SIZE bytes long. */
+extern void *realloc (void *ptr, size_t size);
/* Allocate NMEMB elements of SIZE bytes each, all initialized to 0. */
-extern __ptr_t calloc PP ((__malloc_size_t __nmemb, __malloc_size_t __size));
+extern void *calloc (size_t nmemb, size_t size);
/* Free a block allocated by `malloc', `realloc' or `calloc'. */
-extern void free PP ((__ptr_t __ptr));
+extern void free (void *ptr);
/* Allocate SIZE bytes allocated to ALIGNMENT bytes. */
-#if !defined (_MALLOC_INTERNAL) || defined (MSDOS) /* Avoid conflict. */
-extern __ptr_t memalign PP ((__malloc_size_t __alignment,
- __malloc_size_t __size));
-extern int posix_memalign PP ((__ptr_t *, __malloc_size_t,
- __malloc_size_t size));
-#endif
-
-/* Allocate SIZE bytes on a page boundary. */
-#if ! (defined (_MALLOC_INTERNAL) && defined (GMALLOC_INHIBIT_VALLOC))
-extern __ptr_t valloc PP ((__malloc_size_t __size));
+#ifdef MSDOS
+extern void *memalign (size_t, size_t);
+extern int posix_memalign (void **, size_t, size_t);
#endif
#ifdef USE_PTHREAD
/* Set up mutexes and make malloc etc. thread-safe. */
-extern void malloc_enable_thread PP ((void));
+extern void malloc_enable_thread (void);
#endif
-#ifdef _MALLOC_INTERNAL
-
/* The allocator divides the heap into blocks of fixed size; large
requests receive one or more whole blocks, and small requests
receive a fragment of a block. Fragment sizes are powers of two,
@@ -128,22 +98,22 @@ typedef union
{
struct
{
- __malloc_size_t nfree; /* Free frags in a fragmented block. */
- __malloc_size_t first; /* First free fragment of the block. */
+ size_t nfree; /* Free frags in a fragmented block. */
+ size_t first; /* First free fragment of the block. */
} frag;
/* For a large object, in its first block, this has the number
of blocks in the object. In the other blocks, this has a
negative number which says how far back the first block is. */
- __malloc_ptrdiff_t size;
+ ptrdiff_t size;
} info;
} busy;
/* Heap information for a free block
(that may be the first of a free cluster). */
struct
{
- __malloc_size_t size; /* Size (in blocks) of a free cluster. */
- __malloc_size_t next; /* Index of next free cluster. */
- __malloc_size_t prev; /* Index of previous free cluster. */
+ size_t size; /* Size (in blocks) of a free cluster. */
+ size_t next; /* Index of next free cluster. */
+ size_t prev; /* Index of previous free cluster. */
} free;
} malloc_info;
@@ -155,13 +125,13 @@ extern malloc_info *_heapinfo;
/* Address to block number and vice versa. */
#define BLOCK(A) (((char *) (A) - _heapbase) / BLOCKSIZE + 1)
-#define ADDRESS(B) ((__ptr_t) (((B) - 1) * BLOCKSIZE + _heapbase))
+#define ADDRESS(B) ((void *) (((B) - 1) * BLOCKSIZE + _heapbase))
/* Current search index for the heap table. */
-extern __malloc_size_t _heapindex;
+extern size_t _heapindex;
/* Limit of valid info table indices. */
-extern __malloc_size_t _heaplimit;
+extern size_t _heaplimit;
/* Doubly linked lists of free fragments. */
struct list
@@ -177,26 +147,26 @@ extern struct list _fraghead[];
struct alignlist
{
struct alignlist *next;
- __ptr_t aligned; /* The address that memaligned returned. */
- __ptr_t exact; /* The address that malloc returned. */
+ void *aligned; /* The address that memaligned returned. */
+ void *exact; /* The address that malloc returned. */
};
extern struct alignlist *_aligned_blocks;
/* Instrumentation. */
-extern __malloc_size_t _chunks_used;
-extern __malloc_size_t _bytes_used;
-extern __malloc_size_t _chunks_free;
-extern __malloc_size_t _bytes_free;
+extern size_t _chunks_used;
+extern size_t _bytes_used;
+extern size_t _chunks_free;
+extern size_t _bytes_free;
/* Internal versions of `malloc', `realloc', and `free'
used when these functions need to call each other.
They are the same but don't call the hooks. */
-extern __ptr_t _malloc_internal PP ((__malloc_size_t __size));
-extern __ptr_t _realloc_internal PP ((__ptr_t __ptr, __malloc_size_t __size));
-extern void _free_internal PP ((__ptr_t __ptr));
-extern __ptr_t _malloc_internal_nolock PP ((__malloc_size_t __size));
-extern __ptr_t _realloc_internal_nolock PP ((__ptr_t __ptr, __malloc_size_t __size));
-extern void _free_internal_nolock PP ((__ptr_t __ptr));
+extern void *_malloc_internal (size_t);
+extern void *_realloc_internal (void *, size_t);
+extern void _free_internal (void *);
+extern void *_malloc_internal_nolock (size_t);
+extern void *_realloc_internal_nolock (void *, size_t);
+extern void _free_internal_nolock (void *);
#ifdef USE_PTHREAD
extern pthread_mutex_t _malloc_mutex, _aligned_blocks_mutex;
@@ -228,39 +198,36 @@ extern int _malloc_thread_enabled_p;
#define UNLOCK_ALIGNED_BLOCKS()
#endif
-#endif /* _MALLOC_INTERNAL. */
-
/* Given an address in the middle of a malloc'd object,
return the address of the beginning of the object. */
-extern __ptr_t malloc_find_object_address PP ((__ptr_t __ptr));
+extern void *malloc_find_object_address (void *ptr);
/* Underlying allocation function; successive calls should
return contiguous pieces of memory. */
-extern __ptr_t (*__morecore) PP ((__malloc_ptrdiff_t __size));
+extern void *(*__morecore) (ptrdiff_t size);
/* Default value of `__morecore'. */
-extern __ptr_t __default_morecore PP ((__malloc_ptrdiff_t __size));
+extern void *__default_morecore (ptrdiff_t size);
/* If not NULL, this function is called after each time
`__morecore' is called to increase the data size. */
-extern void (*__after_morecore_hook) PP ((void));
+extern void (*__after_morecore_hook) (void);
/* Number of extra blocks to get each time we ask for more core.
This reduces the frequency of calling `(*__morecore)'. */
-extern __malloc_size_t __malloc_extra_blocks;
+extern size_t __malloc_extra_blocks;
/* Nonzero if `malloc' has been called and done its initialization. */
extern int __malloc_initialized;
/* Function called to initialize malloc data structures. */
-extern int __malloc_initialize PP ((void));
+extern int __malloc_initialize (void);
/* Hooks for debugging versions. */
-extern void (*__malloc_initialize_hook) PP ((void));
-extern void (*__free_hook) PP ((__ptr_t __ptr));
-extern __ptr_t (*__malloc_hook) PP ((__malloc_size_t __size));
-extern __ptr_t (*__realloc_hook) PP ((__ptr_t __ptr, __malloc_size_t __size));
-extern __ptr_t (*__memalign_hook) PP ((__malloc_size_t __size,
- __malloc_size_t __alignment));
+extern void (*__malloc_initialize_hook) (void);
+extern void (*__free_hook) (void *ptr);
+extern void *(*__malloc_hook) (size_t size);
+extern void *(*__realloc_hook) (void *ptr, size_t size);
+extern void *(*__memalign_hook) (size_t size, size_t alignment);
/* Return values for `mprobe': these are the kinds of inconsistencies that
`mcheck' enables detection of. */
@@ -277,52 +244,37 @@ enum mcheck_status
before `malloc' is ever called. ABORTFUNC is called with an error code
(see enum above) when an inconsistency is detected. If ABORTFUNC is
null, the standard function prints on stderr and then calls `abort'. */
-extern int mcheck PP ((void (*__abortfunc) PP ((enum mcheck_status))));
+extern int mcheck (void (*abortfunc) (enum mcheck_status));
/* Check for aberrations in a particular malloc'd block. You must have
called `mcheck' already. These are the same checks that `mcheck' does
when you free or reallocate a block. */
-extern enum mcheck_status mprobe PP ((__ptr_t __ptr));
+extern enum mcheck_status mprobe (void *ptr);
/* Activate a standard collection of tracing hooks. */
-extern void mtrace PP ((void));
-extern void muntrace PP ((void));
+extern void mtrace (void);
+extern void muntrace (void);
/* Statistics available to the user. */
struct mstats
{
- __malloc_size_t bytes_total; /* Total size of the heap. */
- __malloc_size_t chunks_used; /* Chunks allocated by the user. */
- __malloc_size_t bytes_used; /* Byte total of user-allocated chunks. */
- __malloc_size_t chunks_free; /* Chunks in the free list. */
- __malloc_size_t bytes_free; /* Byte total of chunks in the free list. */
+ size_t bytes_total; /* Total size of the heap. */
+ size_t chunks_used; /* Chunks allocated by the user. */
+ size_t bytes_used; /* Byte total of user-allocated chunks. */
+ size_t chunks_free; /* Chunks in the free list. */
+ size_t bytes_free; /* Byte total of chunks in the free list. */
};
/* Pick up the current statistics. */
-extern struct mstats mstats PP ((void));
+extern struct mstats mstats (void);
/* Call WARNFUN with a warning message when memory usage is high. */
-extern void memory_warnings PP ((__ptr_t __start,
- void (*__warnfun) PP ((const char *))));
-
-
-/* Relocating allocator. */
-
-/* Allocate SIZE bytes, and store the address in *HANDLEPTR. */
-extern __ptr_t r_alloc PP ((__ptr_t *__handleptr, __malloc_size_t __size));
-
-/* Free the storage allocated in HANDLEPTR. */
-extern void r_alloc_free PP ((__ptr_t *__handleptr));
-
-/* Adjust the block at HANDLEPTR to be SIZE bytes long. */
-extern __ptr_t r_re_alloc PP ((__ptr_t *__handleptr, __malloc_size_t __size));
-
+extern void memory_warnings (void *start, void (*warnfun) (const char *));
#ifdef __cplusplus
}
#endif
-#endif /* malloc.h */
/* Memory allocator `malloc'.
Copyright 1990, 1991, 1992, 1993, 1994, 1995 Free Software Foundation, Inc.
Written May 1989 by Mike Haertel.
@@ -345,10 +297,6 @@ Fifth Floor, Boston, MA 02110-1301, USA.
The author may be reached (Email) at the address mike@ai.mit.edu,
or (US mail) as Mike Haertel c/o Free Software Foundation. */
-#ifndef _MALLOC_INTERNAL
-#define _MALLOC_INTERNAL
-#include <malloc.h>
-#endif
#include <errno.h>
/* On Cygwin there are two heaps. temacs uses the static heap
@@ -362,15 +310,15 @@ Fifth Floor, Boston, MA 02110-1301, USA.
this is changed in the future, we'll have to similarly deal with
reinitializing ralloc. */
#ifdef CYGWIN
-extern __ptr_t bss_sbrk PP ((ptrdiff_t __size));
+extern void *bss_sbrk (ptrdiff_t size);
extern int bss_sbrk_did_unexec;
char *bss_sbrk_heapbase; /* _heapbase for static heap */
malloc_info *bss_sbrk_heapinfo; /* _heapinfo for static heap */
#endif
-__ptr_t (*__morecore) PP ((__malloc_ptrdiff_t __size)) = __default_morecore;
+void *(*__morecore) (ptrdiff_t size) = __default_morecore;
/* Debugging hook for `malloc'. */
-__ptr_t (*__malloc_hook) PP ((__malloc_size_t __size));
+void *(*__malloc_hook) (size_t size);
/* Pointer to the base of the first block. */
char *_heapbase;
@@ -379,30 +327,30 @@ char *_heapbase;
malloc_info *_heapinfo;
/* Number of info entries. */
-static __malloc_size_t heapsize;
+static size_t heapsize;
/* Search index in the info table. */
-__malloc_size_t _heapindex;
+size_t _heapindex;
/* Limit of valid info table indices. */
-__malloc_size_t _heaplimit;
+size_t _heaplimit;
/* Free lists for each fragment size. */
struct list _fraghead[BLOCKLOG];
/* Instrumentation. */
-__malloc_size_t _chunks_used;
-__malloc_size_t _bytes_used;
-__malloc_size_t _chunks_free;
-__malloc_size_t _bytes_free;
+size_t _chunks_used;
+size_t _bytes_used;
+size_t _chunks_free;
+size_t _bytes_free;
/* Are you experienced? */
int __malloc_initialized;
-__malloc_size_t __malloc_extra_blocks;
+size_t __malloc_extra_blocks;
-void (*__malloc_initialize_hook) PP ((void));
-void (*__after_morecore_hook) PP ((void));
+void (*__malloc_initialize_hook) (void);
+void (*__after_morecore_hook) (void);
#if defined GC_MALLOC_CHECK && defined GC_PROTECT_MALLOC_STATE
@@ -419,12 +367,11 @@ void (*__after_morecore_hook) PP ((void));
#include <sys/mman.h>
static int state_protected_p;
-static __malloc_size_t last_state_size;
+static size_t last_state_size;
static malloc_info *last_heapinfo;
void
-protect_malloc_state (protect_p)
- int protect_p;
+protect_malloc_state (int protect_p)
{
/* If _heapinfo has been relocated, make sure its old location
isn't left read-only; it will be reused by malloc. */
@@ -453,29 +400,25 @@ protect_malloc_state (protect_p)
/* Aligned allocation. */
-static __ptr_t align PP ((__malloc_size_t));
-static __ptr_t
-align (size)
- __malloc_size_t size;
+static void *
+align (size_t size)
{
- __ptr_t result;
- unsigned long int adj;
+ void *result;
+ ptrdiff_t adj;
/* align accepts an unsigned argument, but __morecore accepts a
- signed one. This could lead to trouble if SIZE overflows a
- signed int type accepted by __morecore. We just punt in that
+ signed one. This could lead to trouble if SIZE overflows the
+ ptrdiff_t type accepted by __morecore. We just punt in that
case, since they are requesting a ludicrous amount anyway. */
- if ((__malloc_ptrdiff_t)size < 0)
+ if (PTRDIFF_MAX < size)
result = 0;
else
result = (*__morecore) (size);
- adj = (unsigned long int) ((unsigned long int) ((char *) result -
- (char *) NULL)) % BLOCKSIZE;
+ adj = (uintptr_t) result % BLOCKSIZE;
if (adj != 0)
{
- __ptr_t new;
adj = BLOCKSIZE - adj;
- new = (*__morecore) (adj);
+ (*__morecore) (adj);
result = (char *) result + adj;
}
@@ -488,14 +431,11 @@ align (size)
/* Get SIZE bytes, if we can get them starting at END.
Return the address of the space we got.
If we cannot get space at END, fail and return 0. */
-static __ptr_t get_contiguous_space PP ((__malloc_ptrdiff_t, __ptr_t));
-static __ptr_t
-get_contiguous_space (size, position)
- __malloc_ptrdiff_t size;
- __ptr_t position;
+static void *
+get_contiguous_space (ptrdiff_t size, void *position)
{
- __ptr_t before;
- __ptr_t after;
+ void *before;
+ void *after;
before = (*__morecore) (0);
/* If we can tell in advance that the break is at the wrong place,
@@ -525,7 +465,7 @@ get_contiguous_space (size, position)
static inline void
register_heapinfo (void)
{
- __malloc_size_t block, blocks;
+ size_t block, blocks;
block = BLOCK (_heapinfo);
blocks = BLOCKIFY (heapsize * sizeof (malloc_info));
@@ -548,21 +488,21 @@ pthread_mutex_t _aligned_blocks_mutex = PTHREAD_MUTEX_INITIALIZER;
int _malloc_thread_enabled_p;
static void
-malloc_atfork_handler_prepare ()
+malloc_atfork_handler_prepare (void)
{
LOCK ();
LOCK_ALIGNED_BLOCKS ();
}
static void
-malloc_atfork_handler_parent ()
+malloc_atfork_handler_parent (void)
{
UNLOCK_ALIGNED_BLOCKS ();
UNLOCK ();
}
static void
-malloc_atfork_handler_child ()
+malloc_atfork_handler_child (void)
{
UNLOCK_ALIGNED_BLOCKS ();
UNLOCK ();
@@ -570,7 +510,7 @@ malloc_atfork_handler_child ()
/* Set up mutexes and make malloc etc. thread-safe. */
void
-malloc_enable_thread ()
+malloc_enable_thread (void)
{
if (_malloc_thread_enabled_p)
return;
@@ -589,7 +529,7 @@ malloc_enable_thread ()
#endif
static void
-malloc_initialize_1 ()
+malloc_initialize_1 (void)
{
#ifdef GC_MCHECK
mcheck (NULL);
@@ -609,7 +549,7 @@ malloc_initialize_1 ()
(*__malloc_initialize_hook) ();
heapsize = HEAP / BLOCKSIZE;
- _heapinfo = (malloc_info *) align (heapsize * sizeof (malloc_info));
+ _heapinfo = align (heapsize * sizeof (malloc_info));
if (_heapinfo == NULL)
return;
memset (_heapinfo, 0, heapsize * sizeof (malloc_info));
@@ -630,7 +570,7 @@ malloc_initialize_1 ()
main will call malloc which calls this function. That is before any threads
or signal handlers has been set up, so we don't need thread protection. */
int
-__malloc_initialize ()
+__malloc_initialize (void)
{
if (__malloc_initialized)
return 0;
@@ -644,14 +584,12 @@ static int morecore_recursing;
/* Get neatly aligned memory, initializing or
growing the heap info table as necessary. */
-static __ptr_t morecore_nolock PP ((__malloc_size_t));
-static __ptr_t
-morecore_nolock (size)
- __malloc_size_t size;
+static void *
+morecore_nolock (size_t size)
{
- __ptr_t result;
+ void *result;
malloc_info *newinfo, *oldinfo;
- __malloc_size_t newsize;
+ size_t newsize;
if (morecore_recursing)
/* Avoid recursion. The caller will know how to handle a null return. */
@@ -664,7 +602,7 @@ morecore_nolock (size)
PROTECT_MALLOC_STATE (0);
/* Check if we need to grow the info table. */
- if ((__malloc_size_t) BLOCK ((char *) result + size) > heapsize)
+ if ((size_t) BLOCK ((char *) result + size) > heapsize)
{
/* Calculate the new _heapinfo table size. We do not account for the
added blocks in the table itself, as we hope to place them in
@@ -673,7 +611,7 @@ morecore_nolock (size)
newsize = heapsize;
do
newsize *= 2;
- while ((__malloc_size_t) BLOCK ((char *) result + size) > newsize);
+ while ((size_t) BLOCK ((char *) result + size) > newsize);
/* We must not reuse existing core for the new info table when called
from realloc in the case of growing a large block, because the
@@ -689,8 +627,8 @@ morecore_nolock (size)
`morecore_recursing' flag and return null. */
int save = errno; /* Don't want to clobber errno with ENOMEM. */
morecore_recursing = 1;
- newinfo = (malloc_info *) _realloc_internal_nolock
- (_heapinfo, newsize * sizeof (malloc_info));
+ newinfo = _realloc_internal_nolock (_heapinfo,
+ newsize * sizeof (malloc_info));
morecore_recursing = 0;
if (newinfo == NULL)
errno = save;
@@ -710,7 +648,7 @@ morecore_nolock (size)
/* Allocate new space for the malloc info table. */
while (1)
{
- newinfo = (malloc_info *) align (newsize * sizeof (malloc_info));
+ newinfo = align (newsize * sizeof (malloc_info));
/* Did it fail? */
if (newinfo == NULL)
@@ -721,8 +659,8 @@ morecore_nolock (size)
/* Is it big enough to record status for its own space?
If so, we win. */
- if ((__malloc_size_t) BLOCK ((char *) newinfo
- + newsize * sizeof (malloc_info))
+ if ((size_t) BLOCK ((char *) newinfo
+ + newsize * sizeof (malloc_info))
< newsize)
break;
@@ -759,13 +697,12 @@ morecore_nolock (size)
}
/* Allocate memory from the heap. */
-__ptr_t
-_malloc_internal_nolock (size)
- __malloc_size_t size;
+void *
+_malloc_internal_nolock (size_t size)
{
- __ptr_t result;
- __malloc_size_t block, blocks, lastblocks, start;
- register __malloc_size_t i;
+ void *result;
+ size_t block, blocks, lastblocks, start;
+ register size_t i;
struct list *next;
/* ANSI C allows `malloc (0)' to either return NULL, or to return a
@@ -790,7 +727,7 @@ _malloc_internal_nolock (size)
{
/* Small allocation to receive a fragment of a block.
Determine the logarithm to base two of the fragment size. */
- register __malloc_size_t log = 1;
+ register size_t log = 1;
--size;
while ((size /= 2) != 0)
++log;
@@ -803,15 +740,14 @@ _malloc_internal_nolock (size)
/* There are free fragments of this size.
Pop a fragment out of the fragment list and return it.
Update the block's nfree and first counters. */
- result = (__ptr_t) next;
+ result = next;
next->prev->next = next->next;
if (next->next != NULL)
next->next->prev = next->prev;
block = BLOCK (result);
if (--_heapinfo[block].busy.info.frag.nfree != 0)
- _heapinfo[block].busy.info.frag.first = (unsigned long int)
- ((unsigned long int) ((char *) next->next - (char *) NULL)
- % BLOCKSIZE) >> log;
+ _heapinfo[block].busy.info.frag.first =
+ (uintptr_t) next->next % BLOCKSIZE >> log;
/* Update the statistics. */
++_chunks_used;
@@ -843,7 +779,7 @@ _malloc_internal_nolock (size)
next->prev = &_fraghead[log];
_fraghead[log].next = next;
- for (i = 2; i < (__malloc_size_t) (BLOCKSIZE >> log); ++i)
+ for (i = 2; i < (size_t) (BLOCKSIZE >> log); ++i)
{
next = (struct list *) ((char *) result + (i << log));
next->next = _fraghead[log].next;
@@ -877,7 +813,7 @@ _malloc_internal_nolock (size)
if (block == start)
{
/* Need to get more from the system. Get a little extra. */
- __malloc_size_t wantblocks = blocks + __malloc_extra_blocks;
+ size_t wantblocks = blocks + __malloc_extra_blocks;
block = _heapinfo[0].free.prev;
lastblocks = _heapinfo[block].free.size;
/* Check to see if the new core will be contiguous with the
@@ -959,11 +895,10 @@ _malloc_internal_nolock (size)
return result;
}
-__ptr_t
-_malloc_internal (size)
- __malloc_size_t size;
+void *
+_malloc_internal (size_t size)
{
- __ptr_t result;
+ void *result;
LOCK ();
result = _malloc_internal_nolock (size);
@@ -972,11 +907,10 @@ _malloc_internal (size)
return result;
}
-__ptr_t
-malloc (size)
- __malloc_size_t size;
+void *
+malloc (size_t size)
{
- __ptr_t (*hook) (__malloc_size_t);
+ void *(*hook) (size_t);
if (!__malloc_initialized && !__malloc_initialize ())
return NULL;
@@ -998,24 +932,24 @@ malloc (size)
/* On some ANSI C systems, some libc functions call _malloc, _free
and _realloc. Make them use the GNU functions. */
-__ptr_t
-_malloc (size)
- __malloc_size_t size;
+extern void *_malloc (size_t);
+extern void _free (void *);
+extern void *_realloc (void *, size_t);
+
+void *
+_malloc (size_t size)
{
return malloc (size);
}
void
-_free (ptr)
- __ptr_t ptr;
+_free (void *ptr)
{
free (ptr);
}
-__ptr_t
-_realloc (ptr, size)
- __ptr_t ptr;
- __malloc_size_t size;
+void *
+_realloc (void *ptr, size_t size)
{
return realloc (ptr, size);
}
@@ -1043,14 +977,9 @@ Fifth Floor, Boston, MA 02110-1301, USA.
The author may be reached (Email) at the address mike@ai.mit.edu,
or (US mail) as Mike Haertel c/o Free Software Foundation. */
-#ifndef _MALLOC_INTERNAL
-#define _MALLOC_INTERNAL
-#include <malloc.h>
-#endif
-
/* Debugging hook for free. */
-void (*__free_hook) PP ((__ptr_t __ptr));
+void (*__free_hook) (void *__ptr);
/* List of blocks allocated by memalign. */
struct alignlist *_aligned_blocks = NULL;
@@ -1058,15 +987,14 @@ struct alignlist *_aligned_blocks = NULL;
/* Return memory to the heap.
Like `_free_internal' but don't lock mutex. */
void
-_free_internal_nolock (ptr)
- __ptr_t ptr;
+_free_internal_nolock (void *ptr)
{
int type;
- __malloc_size_t block, blocks;
- register __malloc_size_t i;
+ size_t block, blocks;
+ register size_t i;
struct list *prev, *next;
- __ptr_t curbrk;
- const __malloc_size_t lesscore_threshold
+ void *curbrk;
+ const size_t lesscore_threshold
/* Threshold of free space at which we will return some to the system. */
= FINAL_FREE_BLOCKS + 2 * __malloc_extra_blocks;
@@ -1076,7 +1004,7 @@ _free_internal_nolock (ptr)
return;
#ifdef CYGWIN
- if (ptr < _heapbase)
+ if ((char *) ptr < _heapbase)
/* We're being asked to free something in the static heap. */
return;
#endif
@@ -1162,12 +1090,12 @@ _free_internal_nolock (ptr)
It's possible that moving _heapinfo will allow us to
return some space to the system. */
- __malloc_size_t info_block = BLOCK (_heapinfo);
- __malloc_size_t info_blocks = _heapinfo[info_block].busy.info.size;
- __malloc_size_t prev_block = _heapinfo[block].free.prev;
- __malloc_size_t prev_blocks = _heapinfo[prev_block].free.size;
- __malloc_size_t next_block = _heapinfo[block].free.next;
- __malloc_size_t next_blocks = _heapinfo[next_block].free.size;
+ size_t info_block = BLOCK (_heapinfo);
+ size_t info_blocks = _heapinfo[info_block].busy.info.size;
+ size_t prev_block = _heapinfo[block].free.prev;
+ size_t prev_blocks = _heapinfo[prev_block].free.size;
+ size_t next_block = _heapinfo[block].free.next;
+ size_t next_blocks = _heapinfo[next_block].free.size;
if (/* Win if this block being freed is last in core, the info table
is just before it, the previous free block is just before the
@@ -1190,7 +1118,7 @@ _free_internal_nolock (ptr)
)
{
malloc_info *newinfo;
- __malloc_size_t oldlimit = _heaplimit;
+ size_t oldlimit = _heaplimit;
/* Free the old info table, clearing _heaplimit to avoid
recursion into this code. We don't want to return the
@@ -1205,8 +1133,7 @@ _free_internal_nolock (ptr)
_heapindex = 0;
/* Allocate new space for the info table and move its data. */
- newinfo = (malloc_info *) _malloc_internal_nolock (info_blocks
- * BLOCKSIZE);
+ newinfo = _malloc_internal_nolock (info_blocks * BLOCKSIZE);
PROTECT_MALLOC_STATE (0);
memmove (newinfo, _heapinfo, info_blocks * BLOCKSIZE);
_heapinfo = newinfo;
@@ -1222,7 +1149,7 @@ _free_internal_nolock (ptr)
/* Now see if we can return stuff to the system. */
if (block + blocks == _heaplimit && blocks >= lesscore_threshold)
{
- register __malloc_size_t bytes = blocks * BLOCKSIZE;
+ register size_t bytes = blocks * BLOCKSIZE;
_heaplimit -= blocks;
(*__morecore) (-bytes);
_heapinfo[_heapinfo[block].free.prev].free.next
@@ -1255,7 +1182,7 @@ _free_internal_nolock (ptr)
/* If all fragments of this block are free, remove them
from the fragment list and free the whole block. */
next = prev;
- for (i = 1; i < (__malloc_size_t) (BLOCKSIZE >> type); ++i)
+ for (i = 1; i < (size_t) (BLOCKSIZE >> type); ++i)
next = next->next;
prev->prev->next = next;
if (next != NULL)
@@ -1280,7 +1207,7 @@ _free_internal_nolock (ptr)
/* If some fragments of this block are free, link this
fragment into the fragment list after the first free
fragment of this block. */
- next = (struct list *) ptr;
+ next = ptr;
next->next = prev->next;
next->prev = prev;
prev->next = next;
@@ -1293,11 +1220,10 @@ _free_internal_nolock (ptr)
/* No fragments of this block are free, so link this
fragment into the fragment list and announce that
it is the first free fragment of this block. */
- prev = (struct list *) ptr;
+ prev = ptr;
_heapinfo[block].busy.info.frag.nfree = 1;
- _heapinfo[block].busy.info.frag.first = (unsigned long int)
- ((unsigned long int) ((char *) ptr - (char *) NULL)
- % BLOCKSIZE >> type);
+ _heapinfo[block].busy.info.frag.first =
+ (uintptr_t) ptr % BLOCKSIZE >> type;
prev->next = _fraghead[type].next;
prev->prev = &_fraghead[type];
prev->prev->next = prev;
@@ -1313,8 +1239,7 @@ _free_internal_nolock (ptr)
/* Return memory to the heap.
Like `free' but don't call a __free_hook if there is one. */
void
-_free_internal (ptr)
- __ptr_t ptr;
+_free_internal (void *ptr)
{
LOCK ();
_free_internal_nolock (ptr);
@@ -1324,10 +1249,9 @@ _free_internal (ptr)
/* Return memory to the heap. */
void
-free (ptr)
- __ptr_t ptr;
+free (void *ptr)
{
- void (*hook) (__ptr_t) = __free_hook;
+ void (*hook) (void *) = __free_hook;
if (hook != NULL)
(*hook) (ptr);
@@ -1340,8 +1264,7 @@ free (ptr)
weak_alias (free, cfree)
#else
void
-cfree (ptr)
- __ptr_t ptr;
+cfree (void *ptr)
{
free (ptr);
}
@@ -1368,32 +1291,24 @@ Fifth Floor, Boston, MA 02110-1301, USA.
The author may be reached (Email) at the address mike@ai.mit.edu,
or (US mail) as Mike Haertel c/o Free Software Foundation. */
-#ifndef _MALLOC_INTERNAL
-#define _MALLOC_INTERNAL
-#include <malloc.h>
-#endif
-
-
#define min(A, B) ((A) < (B) ? (A) : (B))
/* On Cygwin the dumped emacs may try to realloc storage allocated in
the static heap. We just malloc space in the new heap and copy the
data. */
#ifdef CYGWIN
-__ptr_t
-special_realloc (ptr, size)
- __ptr_t ptr;
- __malloc_size_t size;
+void *
+special_realloc (void *ptr, size_t size)
{
- __ptr_t result;
+ void *result;
int type;
- __malloc_size_t block, oldsize;
+ size_t block, oldsize;
block = ((char *) ptr - bss_sbrk_heapbase) / BLOCKSIZE + 1;
type = bss_sbrk_heapinfo[block].busy.type;
oldsize =
type == 0 ? bss_sbrk_heapinfo[block].busy.info.size * BLOCKSIZE
- : (__malloc_size_t) 1 << type;
+ : (size_t) 1 << type;
result = _malloc_internal_nolock (size);
if (result != NULL)
memcpy (result, ptr, min (oldsize, size));
@@ -1402,7 +1317,7 @@ special_realloc (ptr, size)
#endif
/* Debugging hook for realloc. */
-__ptr_t (*__realloc_hook) PP ((__ptr_t __ptr, __malloc_size_t __size));
+void *(*__realloc_hook) (void *ptr, size_t size);
/* Resize the given region to the new size, returning a pointer
to the (possibly moved) region. This is optimized for speed;
@@ -1410,14 +1325,12 @@ __ptr_t (*__realloc_hook) PP ((__ptr_t __ptr, __malloc_size_t __size));
achieved by unconditionally allocating and copying to a
new region. This module has incestuous knowledge of the
internals of both free and malloc. */
-__ptr_t
-_realloc_internal_nolock (ptr, size)
- __ptr_t ptr;
- __malloc_size_t size;
+void *
+_realloc_internal_nolock (void *ptr, size_t size)
{
- __ptr_t result;
+ void *result;
int type;
- __malloc_size_t block, blocks, oldlimit;
+ size_t block, blocks, oldlimit;
if (size == 0)
{
@@ -1428,7 +1341,7 @@ _realloc_internal_nolock (ptr, size)
return _malloc_internal_nolock (size);
#ifdef CYGWIN
- if (ptr < _heapbase)
+ if ((char *) ptr < _heapbase)
/* ptr points into the static heap */
return special_realloc (ptr, size);
#endif
@@ -1497,7 +1410,7 @@ _realloc_internal_nolock (ptr, size)
(void) _malloc_internal_nolock (blocks * BLOCKSIZE);
else
{
- __ptr_t previous
+ void *previous
= _malloc_internal_nolock ((block - _heapindex) * BLOCKSIZE);
(void) _malloc_internal_nolock (blocks * BLOCKSIZE);
_free_internal_nolock (previous);
@@ -1512,8 +1425,8 @@ _realloc_internal_nolock (ptr, size)
default:
/* Old size is a fragment; type is logarithm
to base two of the fragment size. */
- if (size > (__malloc_size_t) (1 << (type - 1)) &&
- size <= (__malloc_size_t) (1 << type))
+ if (size > (size_t) (1 << (type - 1)) &&
+ size <= (size_t) (1 << type))
/* The new size is the same kind of fragment. */
result = ptr;
else
@@ -1523,7 +1436,7 @@ _realloc_internal_nolock (ptr, size)
result = _malloc_internal_nolock (size);
if (result == NULL)
goto out;
- memcpy (result, ptr, min (size, (__malloc_size_t) 1 << type));
+ memcpy (result, ptr, min (size, (size_t) 1 << type));
_free_internal_nolock (ptr);
}
break;
@@ -1534,12 +1447,10 @@ _realloc_internal_nolock (ptr, size)
return result;
}
-__ptr_t
-_realloc_internal (ptr, size)
- __ptr_t ptr;
- __malloc_size_t size;
+void *
+_realloc_internal (void *ptr, size_t size)
{
- __ptr_t result;
+ void *result;
LOCK ();
result = _realloc_internal_nolock (ptr, size);
@@ -1548,12 +1459,10 @@ _realloc_internal (ptr, size)
return result;
}
-__ptr_t
-realloc (ptr, size)
- __ptr_t ptr;
- __malloc_size_t size;
+void *
+realloc (void *ptr, size_t size)
{
- __ptr_t (*hook) (__ptr_t, __malloc_size_t);
+ void *(*hook) (void *, size_t);
if (!__malloc_initialized && !__malloc_initialize ())
return NULL;
@@ -1581,19 +1490,12 @@ Fifth Floor, Boston, MA 02110-1301, USA.
The author may be reached (Email) at the address mike@ai.mit.edu,
or (US mail) as Mike Haertel c/o Free Software Foundation. */
-#ifndef _MALLOC_INTERNAL
-#define _MALLOC_INTERNAL
-#include <malloc.h>
-#endif
-
/* Allocate an array of NMEMB elements each SIZE bytes long.
The entire array is initialized to zeros. */
-__ptr_t
-calloc (nmemb, size)
- register __malloc_size_t nmemb;
- register __malloc_size_t size;
+void *
+calloc (register size_t nmemb, register size_t size)
{
- register __ptr_t result = malloc (nmemb * size);
+ register void *result = malloc (nmemb * size);
if (result != NULL)
(void) memset (result, 0, nmemb * size);
@@ -1618,11 +1520,6 @@ along with the GNU C Library; see the file COPYING. If not, write to
the Free Software Foundation, 51 Franklin Street, Fifth Floor, Boston,
MA 02110-1301, USA. */
-#ifndef _MALLOC_INTERNAL
-#define _MALLOC_INTERNAL
-#include <malloc.h>
-#endif
-
/* uClibc defines __GNU_LIBRARY__, but it is not completely
compatible. */
#if !defined (__GNU_LIBRARY__) || defined (__UCLIBC__)
@@ -1631,8 +1528,7 @@ MA 02110-1301, USA. */
/* It is best not to declare this and cast its result on foreign operating
systems with potentially hostile include files. */
-#include <stddef.h>
-extern __ptr_t __sbrk PP ((ptrdiff_t increment));
+extern void *__sbrk (ptrdiff_t increment);
#endif /* __GNU_LIBRARY__ && ! defined (__UCLIBC__) */
#ifndef NULL
@@ -1642,19 +1538,18 @@ extern __ptr_t __sbrk PP ((ptrdiff_t increment));
/* Allocate INCREMENT more bytes of data space,
and return the start of data space, or NULL on errors.
If INCREMENT is negative, shrink data space. */
-__ptr_t
-__default_morecore (increment)
- __malloc_ptrdiff_t increment;
+void *
+__default_morecore (ptrdiff_t increment)
{
- __ptr_t result;
+ void *result;
#if defined (CYGWIN)
if (!bss_sbrk_did_unexec)
{
return bss_sbrk (increment);
}
#endif
- result = (__ptr_t) __sbrk (increment);
- if (result == (__ptr_t) -1)
+ result = (void *) __sbrk (increment);
+ if (result == (void *) -1)
return NULL;
return result;
}
@@ -1675,22 +1570,14 @@ License along with this library; see the file COPYING. If
not, write to the Free Software Foundation, Inc., 51 Franklin Street,
Fifth Floor, Boston, MA 02110-1301, USA. */
-#ifndef _MALLOC_INTERNAL
-#define _MALLOC_INTERNAL
-#include <malloc.h>
-#endif
-
-__ptr_t (*__memalign_hook) PP ((__malloc_size_t __size,
- __malloc_size_t __alignment));
+void *(*__memalign_hook) (size_t size, size_t alignment);
-__ptr_t
-memalign (alignment, size)
- __malloc_size_t alignment;
- __malloc_size_t size;
+void *
+memalign (size_t alignment, size_t size)
{
- __ptr_t result;
- unsigned long int adj, lastadj;
- __ptr_t (*hook) (__malloc_size_t, __malloc_size_t) = __memalign_hook;
+ void *result;
+ size_t adj, lastadj;
+ void *(*hook) (size_t, size_t) = __memalign_hook;
if (hook)
return (*hook) (alignment, size);
@@ -1703,7 +1590,7 @@ memalign (alignment, size)
/* Figure out how much we will need to pad this particular block
to achieve the required alignment. */
- adj = (unsigned long int) ((char *) result - (char *) NULL) % alignment;
+ adj = (uintptr_t) result % alignment;
do
{
@@ -1714,7 +1601,7 @@ memalign (alignment, size)
return NULL;
lastadj = adj;
- adj = (unsigned long int) ((char *) result - (char *) NULL) % alignment;
+ adj = (uintptr_t) result % alignment;
/* It's conceivable we might have been so unlucky as to get a
different block with weaker alignment. If so, this block is too
short to contain SIZE after alignment correction. So we must
@@ -1735,7 +1622,7 @@ memalign (alignment, size)
break;
if (l == NULL)
{
- l = (struct alignlist *) malloc (sizeof (struct alignlist));
+ l = malloc (sizeof (struct alignlist));
if (l != NULL)
{
l->next = _aligned_blocks;
@@ -1767,15 +1654,12 @@ memalign (alignment, size)
#endif
int
-posix_memalign (memptr, alignment, size)
- __ptr_t *memptr;
- __malloc_size_t alignment;
- __malloc_size_t size;
+posix_memalign (void **memptr, size_t alignment, size_t size)
{
- __ptr_t mem;
+ void *mem;
if (alignment == 0
- || alignment % sizeof (__ptr_t) != 0
+ || alignment % sizeof (void *) != 0
|| (alignment & (alignment - 1)) != 0)
return EINVAL;
@@ -1809,43 +1693,27 @@ Fifth Floor, Boston, MA 02110-1301, USA.
The author may be reached (Email) at the address mike@ai.mit.edu,
or (US mail) as Mike Haertel c/o Free Software Foundation. */
-#if defined (_MALLOC_INTERNAL) && defined (GMALLOC_INHIBIT_VALLOC)
-
/* Emacs defines GMALLOC_INHIBIT_VALLOC to avoid this definition
on MSDOS, where it conflicts with a system header file. */
-#define ELIDE_VALLOC
-
-#endif
-
-#ifndef ELIDE_VALLOC
+#ifndef GMALLOC_INHIBIT_VALLOC
-#if defined (__GNU_LIBRARY__) || defined (_LIBC)
-#include <stddef.h>
-#include <sys/cdefs.h>
-#if defined (__GLIBC__) && __GLIBC__ >= 2
-/* __getpagesize is already declared in <unistd.h> with return type int */
-#else
-extern size_t __getpagesize PP ((void));
-#endif
-#else
-#include "getpagesize.h"
-#define __getpagesize() getpagesize ()
-#endif
+/* Allocate SIZE bytes on a page boundary. */
+extern void *valloc (size_t);
-#ifndef _MALLOC_INTERNAL
-#define _MALLOC_INTERNAL
-#include <malloc.h>
+#if defined _SC_PAGESIZE || !defined HAVE_GETPAGESIZE
+# include "getpagesize.h"
+#elif !defined getpagesize
+extern int getpagesize (void);
#endif
-static __malloc_size_t pagesize;
+static size_t pagesize;
-__ptr_t
-valloc (size)
- __malloc_size_t size;
+void *
+valloc (size_t size)
{
if (pagesize == 0)
- pagesize = __getpagesize ();
+ pagesize = getpagesize ();
return memalign (pagesize, size);
}
@@ -1876,41 +1744,31 @@ Fifth Floor, Boston, MA 02110-1301, USA.
The author may be reached (Email) at the address mike@ai.mit.edu,
or (US mail) as Mike Haertel c/o Free Software Foundation. */
-#ifdef emacs
-#include <stdio.h>
-#else
-#ifndef _MALLOC_INTERNAL
-#define _MALLOC_INTERNAL
-#include <malloc.h>
#include <stdio.h>
-#endif
-#endif
/* Old hook values. */
-static void (*old_free_hook) (__ptr_t ptr);
-static __ptr_t (*old_malloc_hook) (__malloc_size_t size);
-static __ptr_t (*old_realloc_hook) (__ptr_t ptr, __malloc_size_t size);
+static void (*old_free_hook) (void *ptr);
+static void *(*old_malloc_hook) (size_t size);
+static void *(*old_realloc_hook) (void *ptr, size_t size);
/* Function to call when something awful happens. */
static void (*abortfunc) (enum mcheck_status);
/* Arbitrary magical numbers. */
-#define MAGICWORD 0xfedabeeb
-#define MAGICFREE 0xd8675309
+#define MAGICWORD (SIZE_MAX / 11 ^ SIZE_MAX / 13 << 3)
+#define MAGICFREE (SIZE_MAX / 17 ^ SIZE_MAX / 19 << 4)
#define MAGICBYTE ((char) 0xd7)
#define MALLOCFLOOD ((char) 0x93)
#define FREEFLOOD ((char) 0x95)
struct hdr
{
- __malloc_size_t size; /* Exact size requested by user. */
- unsigned long int magic; /* Magic number to check header integrity. */
+ size_t size; /* Exact size requested by user. */
+ size_t magic; /* Magic number to check header integrity. */
};
-static enum mcheck_status checkhdr (const struct hdr *);
static enum mcheck_status
-checkhdr (hdr)
- const struct hdr *hdr;
+checkhdr (const struct hdr *hdr)
{
enum mcheck_status status;
switch (hdr->magic)
@@ -1933,10 +1791,8 @@ checkhdr (hdr)
return status;
}
-static void freehook (__ptr_t);
static void
-freehook (ptr)
- __ptr_t ptr;
+freehook (void *ptr)
{
struct hdr *hdr;
@@ -1955,15 +1811,13 @@ freehook (ptr)
__free_hook = freehook;
}
-static __ptr_t mallochook (__malloc_size_t);
-static __ptr_t
-mallochook (size)
- __malloc_size_t size;
+static void *
+mallochook (size_t size)
{
struct hdr *hdr;
__malloc_hook = old_malloc_hook;
- hdr = (struct hdr *) malloc (sizeof (struct hdr) + size + 1);
+ hdr = malloc (sizeof (struct hdr) + size + 1);
__malloc_hook = mallochook;
if (hdr == NULL)
return NULL;
@@ -1971,18 +1825,15 @@ mallochook (size)
hdr->size = size;
hdr->magic = MAGICWORD;
((char *) &hdr[1])[size] = MAGICBYTE;
- memset ((__ptr_t) (hdr + 1), MALLOCFLOOD, size);
- return (__ptr_t) (hdr + 1);
+ memset (hdr + 1, MALLOCFLOOD, size);
+ return hdr + 1;
}
-static __ptr_t reallochook (__ptr_t, __malloc_size_t);
-static __ptr_t
-reallochook (ptr, size)
- __ptr_t ptr;
- __malloc_size_t size;
+static void *
+reallochook (void *ptr, size_t size)
{
struct hdr *hdr = NULL;
- __malloc_size_t osize = 0;
+ size_t osize = 0;
if (ptr)
{
@@ -1997,7 +1848,7 @@ reallochook (ptr, size)
__free_hook = old_free_hook;
__malloc_hook = old_malloc_hook;
__realloc_hook = old_realloc_hook;
- hdr = (struct hdr *) realloc ((__ptr_t) hdr, sizeof (struct hdr) + size + 1);
+ hdr = realloc (hdr, sizeof (struct hdr) + size + 1);
__free_hook = freehook;
__malloc_hook = mallochook;
__realloc_hook = reallochook;
@@ -2009,12 +1860,11 @@ reallochook (ptr, size)
((char *) &hdr[1])[size] = MAGICBYTE;
if (size > osize)
memset ((char *) (hdr + 1) + osize, MALLOCFLOOD, size - osize);
- return (__ptr_t) (hdr + 1);
+ return hdr + 1;
}
static void
-mabort (status)
- enum mcheck_status status;
+mabort (enum mcheck_status status)
{
const char *msg;
switch (status)
@@ -2047,8 +1897,7 @@ mabort (status)
static int mcheck_used = 0;
int
-mcheck (func)
- void (*func) (enum mcheck_status);
+mcheck (void (*func) (enum mcheck_status))
{
abortfunc = (func != NULL) ? func : &mabort;
@@ -2068,7 +1917,7 @@ mcheck (func)
}
enum mcheck_status
-mprobe (__ptr_t ptr)
+mprobe (void *ptr)
{
return mcheck_used ? checkhdr (ptr) : MCHECK_DISABLED;
}
diff --git a/src/gnutls.c b/src/gnutls.c
index 70eea3b0b89..cf471314849 100644
--- a/src/gnutls.c
+++ b/src/gnutls.c
@@ -200,8 +200,12 @@ init_gnutls_functions (Lisp_Object libraries)
max_log_level = global_gnutls_log_level;
- GNUTLS_LOG2 (1, max_log_level, "GnuTLS library loaded:",
- SDATA (Fget (Qgnutls_dll, QCloaded_from)));
+ {
+ Lisp_Object name = CAR_SAFE (Fget (Qgnutls_dll, QCloaded_from));
+ GNUTLS_LOG2 (1, max_log_level, "GnuTLS library loaded:",
+ STRINGP (name) ? (const char *) SDATA (name) : "unknown");
+ }
+
return 1;
}
@@ -419,7 +423,7 @@ emacs_gnutls_read (struct Lisp_Process *proc, char *buf, EMACS_INT nbyte)
{
proc->gnutls_handshakes_tried++;
emacs_gnutls_handshake (proc);
- GNUTLS_LOG2i (5, log_level, "Retried handshake",
+ GNUTLS_LOG2i (5, log_level, "Retried handshake",
proc->gnutls_handshakes_tried);
return -1;
}
diff --git a/src/gtkutil.c b/src/gtkutil.c
index 4dbef65dedf..c8a505273fe 100644
--- a/src/gtkutil.c
+++ b/src/gtkutil.c
@@ -1090,7 +1090,9 @@ xg_create_frame_widgets (FRAME_PTR f)
GtkWidget *wtop;
GtkWidget *wvbox, *whbox;
GtkWidget *wfixed;
+#ifndef HAVE_GTK3
GtkRcStyle *style;
+#endif
char *title = 0;
BLOCK_INPUT;
diff --git a/src/intervals.c b/src/intervals.c
index 88f47f58b52..a750ccd13f7 100644
--- a/src/intervals.c
+++ b/src/intervals.c
@@ -1000,6 +1000,7 @@ adjust_intervals_for_insertion (INTERVAL tree,
Lisp_Object pleft, pright;
struct interval newi;
+ RESET_INTERVAL (&newi);
pleft = NULL_INTERVAL_P (prev) ? Qnil : prev->plist;
pright = NULL_INTERVAL_P (i) ? Qnil : i->plist;
newi.plist = merge_properties_sticky (pleft, pright);
diff --git a/src/keyboard.c b/src/keyboard.c
index 133b28234a8..82609bb4cb2 100644
--- a/src/keyboard.c
+++ b/src/keyboard.c
@@ -1203,6 +1203,12 @@ This also exits all active minibuffers. */)
Fthrow (Qtop_level, Qnil);
}
+static void user_error (const char*) NO_RETURN;
+static void user_error (const char *msg)
+{
+ xsignal1 (Quser_error, build_string (msg));
+}
+
static Lisp_Object Fexit_recursive_edit (void) NO_RETURN;
DEFUN ("exit-recursive-edit", Fexit_recursive_edit, Sexit_recursive_edit, 0, 0, "",
doc: /* Exit from the innermost recursive edit or minibuffer. */)
@@ -1211,7 +1217,7 @@ DEFUN ("exit-recursive-edit", Fexit_recursive_edit, Sexit_recursive_edit, 0, 0,
if (command_loop_level > 0 || minibuf_level > 0)
Fthrow (Qexit, Qnil);
- error ("No recursive edit is in progress");
+ user_error ("No recursive edit is in progress");
}
static Lisp_Object Fabort_recursive_edit (void) NO_RETURN;
@@ -1222,7 +1228,7 @@ DEFUN ("abort-recursive-edit", Fabort_recursive_edit, Sabort_recursive_edit, 0,
if (command_loop_level > 0 || minibuf_level > 0)
Fthrow (Qexit, Qt);
- error ("No recursive edit is in progress");
+ user_error ("No recursive edit is in progress");
}
#if defined (HAVE_MOUSE) || defined (HAVE_GPM)
@@ -2987,11 +2993,16 @@ read_char (int commandflag, ptrdiff_t nmaps, Lisp_Object *maps,
own stuff with the echo area. */
if (!CONSP (c)
|| (!(EQ (Qhelp_echo, XCAR (c)))
- && !(EQ (Qswitch_frame, XCAR (c)))))
+ && !(EQ (Qswitch_frame, XCAR (c)))
+ /* Don't wipe echo area for select window events: These might
+ get delayed via `mouse-autoselect-window' (Bug#11304). */
+ && !(EQ (Qselect_window, XCAR (c)))))
{
if (!NILP (echo_area_buffer[0]))
- safe_run_hooks (Qecho_area_clear_hook);
- clear_message (1, 0);
+ {
+ safe_run_hooks (Qecho_area_clear_hook);
+ clear_message (1, 0);
+ }
}
reread_for_input_method:
@@ -3778,7 +3789,6 @@ kbd_buffer_get_event (KBOARD **kbp,
int *used_mouse_menu,
struct timeval *end_time)
{
- register int c;
Lisp_Object obj;
#ifdef subprocesses
@@ -3795,16 +3805,18 @@ kbd_buffer_get_event (KBOARD **kbp,
}
#endif /* subprocesses */
+#ifndef HAVE_DBUS /* We want to read D-Bus events in batch mode. */
if (noninteractive
/* In case we are running as a daemon, only do this before
detaching from the terminal. */
|| (IS_DAEMON && daemon_pipe[1] >= 0))
{
- c = getchar ();
+ int c = getchar ();
XSETINT (obj, c);
*kbp = current_kboard;
return obj;
}
+#endif /* ! HAVE_DBUS */
/* Wait until there is input available. */
for (;;)
@@ -7185,6 +7197,7 @@ tty_read_avail_input (struct terminal *terminal,
return nread;
}
+#if defined SYNC_INPUT || defined SIGIO
static void
handle_async_input (void)
{
@@ -7211,7 +7224,9 @@ handle_async_input (void)
--handling_signal;
#endif
}
+#endif /* SYNC_INPUT || SIGIO */
+#ifdef SYNC_INPUT
void
process_pending_signals (void)
{
@@ -7219,6 +7234,7 @@ process_pending_signals (void)
handle_async_input ();
do_pending_atimers ();
}
+#endif
#ifdef SIGIO /* for entire page */
/* Note SIGIO has been undef'd if FIONREAD is missing. */
@@ -10350,146 +10366,6 @@ a special event, so ignore the prefix argument and don't clear it. */)
-DEFUN ("execute-extended-command", Fexecute_extended_command, Sexecute_extended_command,
- 1, 1, "P",
- doc: /* Read function name, then read its arguments and call it.
-
-To pass a numeric argument to the command you are invoking with, specify
-the numeric argument to this command.
-
-Noninteractively, the argument PREFIXARG is the prefix argument to
-give to the command you invoke, if it asks for an argument. */)
- (Lisp_Object prefixarg)
-{
- Lisp_Object function;
- EMACS_INT saved_last_point_position;
- Lisp_Object saved_keys, saved_last_point_position_buffer;
- Lisp_Object bindings, value;
- struct gcpro gcpro1, gcpro2, gcpro3;
-#ifdef HAVE_WINDOW_SYSTEM
- /* The call to Fcompleting_read will start and cancel the hourglass,
- but if the hourglass was already scheduled, this means that no
- hourglass will be shown for the actual M-x command itself.
- So we restart it if it is already scheduled. Note that checking
- hourglass_shown_p is not enough, normally the hourglass is not shown,
- just scheduled to be shown. */
- int hstarted = hourglass_started ();
-#endif
-
- saved_keys = Fvector (this_command_key_count,
- XVECTOR (this_command_keys)->contents);
- saved_last_point_position_buffer = last_point_position_buffer;
- saved_last_point_position = last_point_position;
- GCPRO3 (saved_keys, prefixarg, saved_last_point_position_buffer);
-
- function = call0 (intern ("read-extended-command"));
-
-#ifdef HAVE_WINDOW_SYSTEM
- if (hstarted) start_hourglass ();
-#endif
-
- if (STRINGP (function) && SCHARS (function) == 0)
- error ("No command name given");
-
- /* Set this_command_keys to the concatenation of saved_keys and
- function, followed by a RET. */
- {
- Lisp_Object *keys;
- int i;
-
- this_command_key_count = 0;
- this_command_key_count_reset = 0;
- this_single_command_key_start = 0;
-
- keys = XVECTOR (saved_keys)->contents;
- for (i = 0; i < ASIZE (saved_keys); i++)
- add_command_key (keys[i]);
-
- for (i = 0; i < SCHARS (function); i++)
- add_command_key (Faref (function, make_number (i)));
-
- add_command_key (make_number ('\015'));
- }
-
- last_point_position = saved_last_point_position;
- last_point_position_buffer = saved_last_point_position_buffer;
-
- UNGCPRO;
-
- function = Fintern (function, Qnil);
- KVAR (current_kboard, Vprefix_arg) = prefixarg;
- Vthis_command = function;
- real_this_command = function;
-
- /* If enabled, show which key runs this command. */
- if (!NILP (Vsuggest_key_bindings)
- && NILP (Vexecuting_kbd_macro)
- && SYMBOLP (function))
- bindings = Fwhere_is_internal (function, Voverriding_local_map,
- Qt, Qnil, Qnil);
- else
- bindings = Qnil;
-
- value = Qnil;
- GCPRO3 (bindings, value, function);
- value = Fcommand_execute (function, Qt, Qnil, Qnil);
-
- /* If the command has a key binding, print it now. */
- if (!NILP (bindings)
- && ! (VECTORP (bindings) && EQ (Faref (bindings, make_number (0)),
- Qmouse_movement)))
- {
- /* But first wait, and skip the message if there is input. */
- Lisp_Object waited;
-
- /* If this command displayed something in the echo area;
- wait a few seconds, then display our suggestion message. */
- if (NILP (echo_area_buffer[0]))
- waited = sit_for (make_number (0), 0, 2);
- else if (NUMBERP (Vsuggest_key_bindings))
- waited = sit_for (Vsuggest_key_bindings, 0, 2);
- else
- waited = sit_for (make_number (2), 0, 2);
-
- if (!NILP (waited) && ! CONSP (Vunread_command_events))
- {
- Lisp_Object binding;
- char *newmessage;
- int message_p = push_message ();
- int count = SPECPDL_INDEX ();
- ptrdiff_t newmessage_len, newmessage_alloc;
- USE_SAFE_ALLOCA;
-
- record_unwind_protect (pop_message_unwind, Qnil);
- binding = Fkey_description (bindings, Qnil);
- newmessage_alloc =
- (sizeof "You can run the command `' with "
- + SBYTES (SYMBOL_NAME (function)) + SBYTES (binding));
- SAFE_ALLOCA (newmessage, char *, newmessage_alloc);
- newmessage_len =
- esprintf (newmessage, "You can run the command `%s' with %s",
- SDATA (SYMBOL_NAME (function)),
- SDATA (binding));
- message2 (newmessage,
- newmessage_len,
- STRING_MULTIBYTE (binding));
- if (NUMBERP (Vsuggest_key_bindings))
- waited = sit_for (Vsuggest_key_bindings, 0, 2);
- else
- waited = sit_for (make_number (2), 0, 2);
-
- if (!NILP (waited) && message_p)
- restore_message ();
-
- SAFE_FREE ();
- unbind_to (count, Qnil);
- }
- }
-
- RETURN_UNGCPRO (value);
-}
-
-
/* Return nonzero if input events are pending. */
int
@@ -11804,7 +11680,6 @@ syms_of_keyboard (void)
defsubr (&Sset_quit_char);
defsubr (&Sset_input_mode);
defsubr (&Scurrent_input_mode);
- defsubr (&Sexecute_extended_command);
defsubr (&Sposn_at_point);
defsubr (&Sposn_at_x_y);
@@ -12208,12 +12083,6 @@ If this variable is non-nil, `delayed-warnings-hook' will be run
immediately after running `post-command-hook'. */);
Vdelayed_warnings_list = Qnil;
- DEFVAR_LISP ("suggest-key-bindings", Vsuggest_key_bindings,
- doc: /* Non-nil means show the equivalent key-binding when M-x command has one.
-The value can be a length of time to show the message for.
-If the value is non-nil and not a number, we wait 2 seconds. */);
- Vsuggest_key_bindings = Qt;
-
DEFVAR_LISP ("timer-list", Vtimer_list,
doc: /* List of active absolute time timers in order of increasing time. */);
Vtimer_list = Qnil;
@@ -12409,7 +12278,7 @@ keys_of_keyboard (void)
}
/* Mark the pointers in the kboard objects.
- Called by the Fgarbage_collector. */
+ Called by Fgarbage_collect. */
void
mark_kboards (void)
{
diff --git a/src/keymap.c b/src/keymap.c
index ecaeb32896e..9f82175edc0 100644
--- a/src/keymap.c
+++ b/src/keymap.c
@@ -2553,7 +2553,8 @@ where_is_internal (Lisp_Object definition, Lisp_Object keymaps,
DEFUN ("where-is-internal", Fwhere_is_internal, Swhere_is_internal, 1, 5, 0,
doc: /* Return list of keys that invoke DEFINITION.
If KEYMAP is a keymap, search only KEYMAP and the global keymap.
-If KEYMAP is nil, search all the currently active keymaps.
+If KEYMAP is nil, search all the currently active keymaps, except
+ for `overriding-local-map' (which is ignored).
If KEYMAP is a list of keymaps, search only those keymaps.
If optional 3rd arg FIRSTONLY is non-nil, return the first key sequence found,
@@ -2568,9 +2569,17 @@ If optional 4th arg NOINDIRECT is non-nil, don't follow indirections
to other keymaps or slots. This makes it possible to search for an
indirect definition itself.
-If optional 5th arg NO-REMAP is non-nil, don't search for key sequences
-that invoke a command which is remapped to DEFINITION, but include the
-remapped command in the returned list. */)
+The optional 5th arg NO-REMAP alters how command remapping is handled:
+
+- If another command OTHER-COMMAND is remapped to DEFINITION, normally
+ search for the bindings of OTHER-COMMAND and include them in the
+ returned list. But if NO-REMAP is non-nil, include the vector
+ [remap OTHER-COMMAND] in the returned list instead, without
+ searching for those other bindings.
+
+- If DEFINITION is remapped to OTHER-COMMAND, normally return the
+ bindings for OTHER-COMMAND. But if NO-REMAP is non-nil, return the
+ bindings for DEFINITION instead, ignoring its remapping. */)
(Lisp_Object definition, Lisp_Object keymap, Lisp_Object firstonly, Lisp_Object noindirect, Lisp_Object no_remap)
{
/* The keymaps in which to search. */
diff --git a/src/lisp.h b/src/lisp.h
index 37fa81b63f6..068b221d8af 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -479,6 +479,7 @@ enum pvec_type
(var) = (type) | (intptr_t) (ptr))
#define XPNTR(a) ((intptr_t) ((a) & ~TYPEMASK))
+#define XUNTAG(a, type) ((intptr_t) ((a) - (type)))
#else /* not USE_LSB_TAG */
@@ -585,6 +586,13 @@ extern Lisp_Object make_number (EMACS_INT);
# define XSETFASTINT(a, b) (XSETINT (a, b))
#endif
+/* Extract the pointer value of the Lisp object A, under the
+ assumption that A's type is TYPE. This is a fallback
+ implementation if nothing faster is available. */
+#ifndef XUNTAG
+# define XUNTAG(a, type) XPNTR (a)
+#endif
+
#define EQ(x, y) (XHASH (x) == XHASH (y))
/* Number of bits in a fixnum, including the sign bit. */
@@ -611,15 +619,20 @@ extern Lisp_Object make_number (EMACS_INT);
/* Extract a value or address from a Lisp_Object. */
-#define XCONS(a) (eassert (CONSP (a)), (struct Lisp_Cons *) XPNTR (a))
-#define XVECTOR(a) (eassert (VECTORLIKEP (a)), (struct Lisp_Vector *) XPNTR (a))
-#define XSTRING(a) (eassert (STRINGP (a)), (struct Lisp_String *) XPNTR (a))
-#define XSYMBOL(a) (eassert (SYMBOLP (a)), (struct Lisp_Symbol *) XPNTR (a))
-#define XFLOAT(a) (eassert (FLOATP (a)), (struct Lisp_Float *) XPNTR (a))
+#define XCONS(a) (eassert (CONSP (a)), \
+ (struct Lisp_Cons *) XUNTAG (a, Lisp_Cons))
+#define XVECTOR(a) (eassert (VECTORLIKEP (a)), \
+ (struct Lisp_Vector *) XUNTAG (a, Lisp_Vectorlike))
+#define XSTRING(a) (eassert (STRINGP (a)), \
+ (struct Lisp_String *) XUNTAG (a, Lisp_String))
+#define XSYMBOL(a) (eassert (SYMBOLP (a)), \
+ (struct Lisp_Symbol *) XUNTAG (a, Lisp_Symbol))
+#define XFLOAT(a) (eassert (FLOATP (a)), \
+ (struct Lisp_Float *) XUNTAG (a, Lisp_Float))
/* Misc types. */
-#define XMISC(a) ((union Lisp_Misc *) XPNTR (a))
+#define XMISC(a) ((union Lisp_Misc *) XUNTAG (a, Lisp_Misc))
#define XMISCANY(a) (eassert (MISCP (a)), &(XMISC (a)->u_any))
#define XMISCTYPE(a) (XMISCANY (a)->type)
#define XMARKER(a) (eassert (MARKERP (a)), &(XMISC (a)->u_marker))
@@ -639,14 +652,24 @@ extern Lisp_Object make_number (EMACS_INT);
/* Pseudovector types. */
-#define XPROCESS(a) (eassert (PROCESSP (a)), (struct Lisp_Process *) XPNTR (a))
-#define XWINDOW(a) (eassert (WINDOWP (a)), (struct window *) XPNTR (a))
-#define XTERMINAL(a) (eassert (TERMINALP (a)), (struct terminal *) XPNTR (a))
-#define XSUBR(a) (eassert (SUBRP (a)), (struct Lisp_Subr *) XPNTR (a))
-#define XBUFFER(a) (eassert (BUFFERP (a)), (struct buffer *) XPNTR (a))
-#define XCHAR_TABLE(a) (eassert (CHAR_TABLE_P (a)), (struct Lisp_Char_Table *) XPNTR (a))
-#define XSUB_CHAR_TABLE(a) (eassert (SUB_CHAR_TABLE_P (a)), (struct Lisp_Sub_Char_Table *) XPNTR (a))
-#define XBOOL_VECTOR(a) (eassert (BOOL_VECTOR_P (a)), (struct Lisp_Bool_Vector *) XPNTR (a))
+#define XPROCESS(a) (eassert (PROCESSP (a)), \
+ (struct Lisp_Process *) XUNTAG (a, Lisp_Vectorlike))
+#define XWINDOW(a) (eassert (WINDOWP (a)), \
+ (struct window *) XUNTAG (a, Lisp_Vectorlike))
+#define XTERMINAL(a) (eassert (TERMINALP (a)), \
+ (struct terminal *) XUNTAG (a, Lisp_Vectorlike))
+#define XSUBR(a) (eassert (SUBRP (a)), \
+ (struct Lisp_Subr *) XUNTAG (a, Lisp_Vectorlike))
+#define XBUFFER(a) (eassert (BUFFERP (a)), \
+ (struct buffer *) XUNTAG (a, Lisp_Vectorlike))
+#define XCHAR_TABLE(a) (eassert (CHAR_TABLE_P (a)), \
+ (struct Lisp_Char_Table *) XUNTAG (a, Lisp_Vectorlike))
+#define XSUB_CHAR_TABLE(a) (eassert (SUB_CHAR_TABLE_P (a)), \
+ ((struct Lisp_Sub_Char_Table *) \
+ XUNTAG (a, Lisp_Vectorlike)))
+#define XBOOL_VECTOR(a) (eassert (BOOL_VECTOR_P (a)), \
+ ((struct Lisp_Bool_Vector *) \
+ XUNTAG (a, Lisp_Vectorlike)))
/* Construct a Lisp_Object from a value or address. */
@@ -673,7 +696,9 @@ extern Lisp_Object make_number (EMACS_INT);
/* The cast to struct vectorlike_header * avoids aliasing issues. */
#define XSETPSEUDOVECTOR(a, b, code) \
XSETTYPED_PSEUDOVECTOR(a, b, \
- ((struct vectorlike_header *) XPNTR (a))->size, \
+ (((struct vectorlike_header *) \
+ XUNTAG (a, Lisp_Vectorlike)) \
+ ->size), \
code)
#define XSETTYPED_PSEUDOVECTOR(a, b, size, code) \
(XSETVECTOR (a, b), \
@@ -1281,7 +1306,7 @@ struct Lisp_Hash_Table
#define XHASH_TABLE(OBJ) \
- ((struct Lisp_Hash_Table *) XPNTR (OBJ))
+ ((struct Lisp_Hash_Table *) XUNTAG (OBJ, Lisp_Vectorlike))
#define XSET_HASH_TABLE(VAR, PTR) \
(XSETPSEUDOVECTOR (VAR, PTR, PVEC_HASH_TABLE))
@@ -1739,7 +1764,7 @@ typedef struct {
code is CODE. */
#define TYPED_PSEUDOVECTORP(x, t, code) \
(VECTORLIKEP (x) \
- && (((((struct t *) XPNTR (x))->size \
+ && (((((struct t *) XUNTAG (x, Lisp_Vectorlike))->size \
& (PSEUDOVECTOR_FLAG | (code)))) \
== (PSEUDOVECTOR_FLAG | (code))))
@@ -2381,7 +2406,7 @@ extern Lisp_Object Qerror, Qquit, Qargs_out_of_range;
extern Lisp_Object Qvoid_variable, Qvoid_function;
extern Lisp_Object Qinvalid_read_syntax;
extern Lisp_Object Qinvalid_function, Qwrong_number_of_arguments, Qno_catch;
-extern Lisp_Object Qend_of_file, Qarith_error, Qmark_inactive;
+extern Lisp_Object Quser_error, Qend_of_file, Qarith_error, Qmark_inactive;
extern Lisp_Object Qbeginning_of_buffer, Qend_of_buffer, Qbuffer_read_only;
extern Lisp_Object Qtext_read_only;
extern Lisp_Object Qinteractive_form;
diff --git a/src/lisp.mk b/src/lisp.mk
index c082630f717..4608cc3f687 100644
--- a/src/lisp.mk
+++ b/src/lisp.mk
@@ -128,9 +128,12 @@ lisp = \
$(lispsource)/emacs-lisp/lisp-mode.elc \
$(lispsource)/textmodes/text-mode.elc \
$(lispsource)/textmodes/fill.elc \
+ $(lispsource)/newcomment.elc \
$(lispsource)/replace.elc \
+ $(lispsource)/emacs-lisp/tabulated-list.elc \
$(lispsource)/buff-menu.elc \
$(lispsource)/fringe.elc \
+ $(lispsource)/emacs-lisp/regexp-opt.elc \
$(lispsource)/image.elc \
$(lispsource)/international/fontset.elc \
$(lispsource)/dnd.elc \
diff --git a/src/lread.c b/src/lread.c
index 50465fd01e8..6b657f61ed0 100644
--- a/src/lread.c
+++ b/src/lread.c
@@ -24,7 +24,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <sys/stat.h>
#include <sys/file.h>
#include <errno.h>
-#include <limits.h> /* for CHAR_BIT */
+#include <limits.h> /* For CHAR_BIT. */
#include <setjmp.h>
#include "lisp.h"
#include "intervals.h"
@@ -3990,10 +3990,12 @@ init_obarray (void)
/* XSYMBOL (Qnil)->function = Qunbound; */
SET_SYMBOL_VAL (XSYMBOL (Qnil), Qnil);
XSYMBOL (Qnil)->constant = 1;
+ XSYMBOL (Qnil)->declared_special = 1;
XSYMBOL (Qnil)->plist = Qnil;
Qt = intern_c_string ("t");
SET_SYMBOL_VAL (XSYMBOL (Qt), Qt);
+ XSYMBOL (Qnil)->declared_special = 1;
XSYMBOL (Qt)->constant = 1;
/* Qt is correct even if CANNOT_DUMP. loadup.el will set to nil at end. */
diff --git a/src/m/vax.h b/src/m/vax.h
deleted file mode 100644
index e4bed4090b9..00000000000
--- a/src/m/vax.h
+++ /dev/null
@@ -1,23 +0,0 @@
-/* machine description file for vax.
-
-Copyright (C) 1985-1986, 2001-2012 Free Software Foundation, Inc.
-
-This file is part of GNU Emacs.
-
-GNU Emacs is free software: you can redistribute it and/or modify
-it under the terms of the GNU General Public License as published by
-the Free Software Foundation, either version 3 of the License, or
-(at your option) any later version.
-
-GNU Emacs is distributed in the hope that it will be useful,
-but WITHOUT ANY WARRANTY; without even the implied warranty of
-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-GNU General Public License for more details.
-
-You should have received a copy of the GNU General Public License
-along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
-
-
-/* #define vax -- appears to be done automatically */
-
-#define HAVE_FTIME
diff --git a/src/makefile.w32-in b/src/makefile.w32-in
index 303445bc2d6..f62c501e1fa 100644
--- a/src/makefile.w32-in
+++ b/src/makefile.w32-in
@@ -930,7 +930,7 @@ $(BLD)/fringe.$(O) : \
$(BLD)/gmalloc.$(O) : \
$(SRC)/gmalloc.c \
- $(SRC)/getpagesize.h \
+ $(NT_INC)/stdint.h \
$(NT_INC)/unistd.h \
$(CONFIG_H)
@@ -1514,6 +1514,7 @@ $(BLD)/w32menu.$(O) : \
$(SRC)/w32menu.c \
$(SRC)/buffer.h \
$(SRC)/keymap.h \
+ $(SRC)/w32heap.h \
$(BLOCKINPUT_H) \
$(CHARSET_H) \
$(CODING_H) \
diff --git a/src/ns.mk b/src/ns.mk
index d3b5afeb99e..77fbf5845d9 100644
--- a/src/ns.mk
+++ b/src/ns.mk
@@ -1,6 +1,6 @@
### autodeps.mk --- src/Makefile fragment for GNU Emacs
-## Copyright (C) 2008-2012 Free Software Foundation, Inc.
+## Copyright (C) 2008-2012 Free Software Foundation, Inc.
## This file is part of GNU Emacs.
@@ -27,13 +27,13 @@
${ns_appdir}: ${ns_appsrc}
rm -fr ${ns_appdir}
- mkdir -p ${ns_appdir}
+ ${MKDIR_P} ${ns_appdir}
( cd ${ns_appsrc} ; tar cfh - . ) | ( cd ${ns_appdir} ; umask 022; tar xf - )
-${ns_appbindir}Emacs: emacs${EXEEXT}
- mkdir -p ${ns_appbindir}
- cp -f emacs${EXEEXT} ${ns_appbindir}Emacs
+${ns_appbindir}/Emacs: emacs${EXEEXT}
+ ${MKDIR_P} ${ns_appbindir}
+ cp -f emacs${EXEEXT} ${ns_appbindir}/Emacs
-ns-app: ${ns_appdir} ${ns_appbindir}Emacs
+ns-app: ${ns_appdir} ${ns_appbindir}/Emacs
### ns.mk ends here
diff --git a/src/nsterm.m b/src/nsterm.m
index 7cbaf991311..4b8b2bb4820 100644
--- a/src/nsterm.m
+++ b/src/nsterm.m
@@ -338,11 +338,18 @@ ns_init_paths (void)
/*NSLog (@"loadPath: '%@'\n", resourcePaths); */
}
+ /* Normally, Emacs does not add its own bin/ directory to the PATH.
+ However, a self-contained NS build has a different layout, with
+ bin/ and libexec/ subdirectories in the directory that contains
+ Emacs.app itself.
+ We put libexec first, because init_callproc_1 uses the first
+ element to initialize exec-directory. An alternative would be
+ for init_callproc to check for invocation-directory/libexec. */
if (!getenv ("EMACSPATH"))
{
NSArray *paths = [binDir stringsByAppendingPaths:
- [NSArray arrayWithObjects: @"bin",
- @"lib-exec", nil]];
+ [NSArray arrayWithObjects: @"libexec",
+ @"bin", nil]];
NSEnumerator *pathEnum = [paths objectEnumerator];
resourcePaths = @"";
while (resourcePath = [pathEnum nextObject])
diff --git a/src/print.c b/src/print.c
index c5c03274f77..5b1ea748799 100644
--- a/src/print.c
+++ b/src/print.c
@@ -95,14 +95,14 @@ static void print_interval (INTERVAL interval, Lisp_Object printcharfun);
int print_output_debug_flag EXTERNALLY_VISIBLE = 1;
-/* Low level output routines for characters and strings */
+/* Low level output routines for characters and strings. */
/* Lisp functions to do output using a stream
must have the stream in a variable called printcharfun
and must start with PRINTPREPARE, end with PRINTFINISH,
and use PRINTDECLARE to declare common variables.
Use PRINTCHAR to output one character,
- or call strout to output a block of characters. */
+ or call strout to output a block of characters. */
#define PRINTDECLARE \
struct buffer *old = current_buffer; \
@@ -867,7 +867,6 @@ print_error_message (Lisp_Object data, Lisp_Object stream, const char *context,
{
Lisp_Object errname, errmsg, file_error, tail;
struct gcpro gcpro1;
- int i;
if (context != 0)
write_string_1 (context, -1, stream);
@@ -895,9 +894,8 @@ print_error_message (Lisp_Object data, Lisp_Object stream, const char *context,
}
else
{
- Lisp_Object error_conditions;
+ Lisp_Object error_conditions = Fget (errname, Qerror_conditions);
errmsg = Fget (errname, Qerror_message);
- error_conditions = Fget (errname, Qerror_conditions);
file_error = Fmemq (Qfile_error, error_conditions);
}
@@ -911,22 +909,30 @@ print_error_message (Lisp_Object data, Lisp_Object stream, const char *context,
if (!NILP (file_error) && CONSP (tail))
errmsg = XCAR (tail), tail = XCDR (tail);
- if (STRINGP (errmsg))
- Fprinc (errmsg, stream);
- else
- write_string_1 ("peculiar error", -1, stream);
+ {
+ const char *sep = ": ";
- for (i = 0; CONSP (tail); tail = XCDR (tail), i = 1)
- {
- Lisp_Object obj;
+ if (!STRINGP (errmsg))
+ write_string_1 ("peculiar error", -1, stream);
+ else if (SCHARS (errmsg))
+ Fprinc (errmsg, stream);
+ else
+ sep = NULL;
- write_string_1 (i ? ", " : ": ", 2, stream);
- obj = XCAR (tail);
- if (!NILP (file_error) || EQ (errname, Qend_of_file))
- Fprinc (obj, stream);
- else
- Fprin1 (obj, stream);
- }
+ for (; CONSP (tail); tail = XCDR (tail), sep = ", ")
+ {
+ Lisp_Object obj;
+
+ if (sep)
+ write_string_1 (sep, 2, stream);
+ obj = XCAR (tail);
+ if (!NILP (file_error)
+ || EQ (errname, Qend_of_file) || EQ (errname, Quser_error))
+ Fprinc (obj, stream);
+ else
+ Fprin1 (obj, stream);
+ }
+ }
UNGCPRO;
}
@@ -1132,15 +1138,15 @@ print_preprocess (Lisp_Object obj)
int loop_count = 0;
Lisp_Object halftail;
- /* Give up if we go so deep that print_object will get an error. */
- /* See similar code in print_object. */
- if (print_depth >= PRINT_CIRCLE)
- error ("Apparently circular structure being printed");
-
/* Avoid infinite recursion for circular nested structure
in the case where Vprint_circle is nil. */
if (NILP (Vprint_circle))
{
+ /* Give up if we go so deep that print_object will get an error. */
+ /* See similar code in print_object. */
+ if (print_depth >= PRINT_CIRCLE)
+ error ("Apparently circular structure being printed");
+
for (i = 0; i < print_depth; i++)
if (EQ (obj, being_printed[i]))
return;
@@ -1242,7 +1248,7 @@ static void print_check_string_charset_prop (INTERVAL interval, Lisp_Object stri
#define PRINT_STRING_NON_CHARSET_FOUND 1
#define PRINT_STRING_UNSAFE_CHARSET_FOUND 2
-/* Bitwise or of the above macros. */
+/* Bitwise or of the above macros. */
static int print_check_string_result;
static void
@@ -1325,48 +1331,46 @@ print_object (Lisp_Object obj, register Lisp_Object printcharfun, int escapeflag
QUIT;
- /* See similar code in print_preprocess. */
- if (print_depth >= PRINT_CIRCLE)
- error ("Apparently circular structure being printed");
-
/* Detect circularities and truncate them. */
- if (PRINT_CIRCLE_CANDIDATE_P (obj))
+ if (NILP (Vprint_circle))
{
- if (NILP (Vprint_circle) && NILP (Vprint_gensym))
- {
- /* Simple but incomplete way. */
- int i;
- for (i = 0; i < print_depth; i++)
- if (EQ (obj, being_printed[i]))
- {
- sprintf (buf, "#%d", i);
- strout (buf, -1, -1, printcharfun);
- return;
- }
- being_printed[print_depth] = obj;
- }
- else
+ /* Simple but incomplete way. */
+ int i;
+
+ /* See similar code in print_preprocess. */
+ if (print_depth >= PRINT_CIRCLE)
+ error ("Apparently circular structure being printed");
+
+ for (i = 0; i < print_depth; i++)
+ if (EQ (obj, being_printed[i]))
+ {
+ sprintf (buf, "#%d", i);
+ strout (buf, -1, -1, printcharfun);
+ return;
+ }
+ being_printed[print_depth] = obj;
+ }
+ else if (PRINT_CIRCLE_CANDIDATE_P (obj))
+ {
+ /* With the print-circle feature. */
+ Lisp_Object num = Fgethash (obj, Vprint_number_table, Qnil);
+ if (INTEGERP (num))
{
- /* With the print-circle feature. */
- Lisp_Object num = Fgethash (obj, Vprint_number_table, Qnil);
- if (INTEGERP (num))
+ EMACS_INT n = XINT (num);
+ if (n < 0)
+ { /* Add a prefix #n= if OBJ has not yet been printed;
+ that is, its status field is nil. */
+ sprintf (buf, "#%"pI"d=", -n);
+ strout (buf, -1, -1, printcharfun);
+ /* OBJ is going to be printed. Remember that fact. */
+ Fputhash (obj, make_number (- n), Vprint_number_table);
+ }
+ else
{
- EMACS_INT n = XINT (num);
- if (n < 0)
- { /* Add a prefix #n= if OBJ has not yet been printed;
- that is, its status field is nil. */
- sprintf (buf, "#%"pI"d=", -n);
- strout (buf, -1, -1, printcharfun);
- /* OBJ is going to be printed. Remember that fact. */
- Fputhash (obj, make_number (- n), Vprint_number_table);
- }
- else
- {
- /* Just print #n# if OBJ has already been printed. */
- sprintf (buf, "#%"pI"d#", n);
- strout (buf, -1, -1, printcharfun);
- return;
- }
+ /* Just print #n# if OBJ has already been printed. */
+ sprintf (buf, "#%"pI"d#", n);
+ strout (buf, -1, -1, printcharfun);
+ return;
}
}
}
diff --git a/src/process.c b/src/process.c
index 65020299e75..cf6d40052a7 100644
--- a/src/process.c
+++ b/src/process.c
@@ -120,6 +120,13 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include "nsterm.h"
#endif
+/* Work around GCC 4.7.0 bug with strict overflow checking; see
+ <http://gcc.gnu.org/bugzilla/show_bug.cgi?id=52904>.
+ These lines can be removed once the GCC bug is fixed. */
+#if (__GNUC__ == 4 && 3 <= __GNUC_MINOR__) || 4 < __GNUC__
+# pragma GCC diagnostic ignored "-Wstrict-overflow"
+#endif
+
Lisp_Object Qeuid, Qegid, Qcomm, Qstate, Qppid, Qpgrp, Qsess, Qttname, Qtpgid;
Lisp_Object Qminflt, Qmajflt, Qcminflt, Qcmajflt, Qutime, Qstime, Qcstime;
Lisp_Object Qcutime, Qpri, Qnice, Qthcount, Qstart, Qvsize, Qrss, Qargs;
@@ -1070,7 +1077,9 @@ is more appropriate for saving the process buffer.
Binding the variable `inherit-process-coding-system' to non-nil before
starting the process is an alternative way of setting the inherit flag
-for the process which will run. */)
+for the process which will run.
+
+This function returns FLAG. */)
(register Lisp_Object process, Lisp_Object flag)
{
CHECK_PROCESS (process);
@@ -1083,7 +1092,8 @@ DEFUN ("set-process-query-on-exit-flag",
2, 2, 0,
doc: /* Specify if query is needed for PROCESS when Emacs is exited.
If the second argument FLAG is non-nil, Emacs will query the user before
-exiting or killing a buffer if PROCESS is running. */)
+exiting or killing a buffer if PROCESS is running. This function
+returns FLAG. */)
(register Lisp_Object process, Lisp_Object flag)
{
CHECK_PROCESS (process);
@@ -2525,7 +2535,7 @@ could be "COM1", or "\\\\.\\COM10" for ports higher than COM9 (double
the backslashes in strings).
:speed SPEED -- (mandatory) is handled by `serial-process-configure',
-which is called by `make-serial-process'.
+which this function calls.
:name NAME -- NAME is the name of the process. If NAME is not given,
the value of PORT is used.
@@ -2554,13 +2564,12 @@ but you can send outgoing data. The stopped state is cleared by
:plist PLIST -- Install PLIST as the initial plist of the process.
-:speed
:bytesize
:parity
:stopbits
:flowcontrol
--- These arguments are handled by `serial-process-configure', which is
-called by `make-serial-process'.
+-- This function calls `serial-process-configure' to handle these
+arguments.
The original argument list, possibly modified by later configuration,
is available via the function `process-contact'.
@@ -2794,7 +2803,7 @@ The stopped state is cleared by `continue-process' and set by
:filter-multibyte BOOL -- If BOOL is non-nil, strings given to the
process filter are multibyte, otherwise they are unibyte.
If this keyword is not specified, the strings are multibyte if
-`default-enable-multibyte-characters' is non-nil.
+the default value of `enable-multibyte-characters' is non-nil.
:sentinel SENTINEL -- Install SENTINEL as the process sentinel.
@@ -4891,16 +4900,23 @@ wait_reading_process_output (int time_limit, int microsecs, int read_kbd,
It can't hurt. */
else if (nread == -1 && errno == EIO)
{
- /* Don't do anything if only a pty, with no associated
- process (bug#10933). */
- if (XPROCESS (proc)->pid != -2) {
- /* Clear the descriptor now, so we only raise the signal
- once. */
- FD_CLR (channel, &input_wait_mask);
- FD_CLR (channel, &non_keyboard_wait_mask);
-
- kill (getpid (), SIGCHLD);
- }
+ struct Lisp_Process *p = XPROCESS (proc);
+
+ /* Clear the descriptor now, so we only raise the
+ signal once. */
+ FD_CLR (channel, &input_wait_mask);
+ FD_CLR (channel, &non_keyboard_wait_mask);
+
+ if (p->pid == -2)
+ {
+ /* If the EIO occurs on a pty, sigchld_handler's
+ wait3() will not find the process object to
+ delete. Do it here. */
+ p->tick = ++process_tick;
+ p->status = Qfailed;
+ }
+ else
+ kill (getpid (), SIGCHLD);
}
#endif /* HAVE_PTYS */
/* If we can detect process termination, don't consider the
diff --git a/src/ralloc.c b/src/ralloc.c
index 896ad9f3155..4bb2f240438 100644
--- a/src/ralloc.c
+++ b/src/ralloc.c
@@ -95,10 +95,8 @@ static int extra_bytes;
/* Macros for rounding. Note that rounding to any value is possible
by changing the definition of PAGE. */
#define PAGE (getpagesize ())
-#define ALIGNED(addr) (((unsigned long int) (addr) & (page_size - 1)) == 0)
#define ROUNDUP(size) (((unsigned long int) (size) + page_size - 1) \
& ~(page_size - 1))
-#define ROUND_TO_PAGE(addr) (addr & (~(page_size - 1)))
#define MEM_ALIGN sizeof (double)
#define MEM_ROUNDUP(addr) (((unsigned long int)(addr) + MEM_ALIGN - 1) \
@@ -151,7 +149,6 @@ typedef struct heap
} *heap_ptr;
#define NIL_HEAP ((heap_ptr) 0)
-#define HEAP_PTR_SIZE (sizeof (struct heap))
/* This is the first heap object.
If we need additional heap objects, each one resides at the beginning of
@@ -366,15 +363,6 @@ relinquish (void)
}
}
}
-
-/* Return the total size in use by relocating allocator,
- above where malloc gets space. */
-
-long
-r_alloc_size_in_use (void)
-{
- return (char *) break_value - (char *) virtual_break_value;
-}
/* The meat - allocating, freeing, and relocating blocs. */
@@ -748,7 +736,7 @@ free_bloc (bloc_ptr bloc)
__morecore hook values - in particular, __default_morecore in the
GNU malloc package. */
-POINTER
+static POINTER
r_alloc_sbrk (long int size)
{
register bloc_ptr b;
@@ -1014,52 +1002,6 @@ r_re_alloc (POINTER *ptr, SIZE size)
return *ptr;
}
-/* Disable relocations, after making room for at least SIZE bytes
- of non-relocatable heap if possible. The relocatable blocs are
- guaranteed to hold still until thawed, even if this means that
- malloc must return a null pointer. */
-
-void
-r_alloc_freeze (long int size)
-{
- if (! r_alloc_initialized)
- r_alloc_init ();
-
- /* If already frozen, we can't make any more room, so don't try. */
- if (r_alloc_freeze_level > 0)
- size = 0;
- /* If we can't get the amount requested, half is better than nothing. */
- while (size > 0 && r_alloc_sbrk (size) == 0)
- size /= 2;
- ++r_alloc_freeze_level;
- if (size > 0)
- r_alloc_sbrk (-size);
-}
-
-void
-r_alloc_thaw (void)
-{
-
- if (! r_alloc_initialized)
- r_alloc_init ();
-
- if (--r_alloc_freeze_level < 0)
- abort ();
-
- /* This frees all unused blocs. It is not too inefficient, as the resize
- and memcpy is done only once. Afterwards, all unreferenced blocs are
- already shrunk to zero size. */
- if (!r_alloc_freeze_level)
- {
- bloc_ptr *b = &first_bloc;
- while (*b)
- if (!(*b)->variable)
- free_bloc (*b);
- else
- b = &(*b)->next;
- }
-}
-
#if defined (emacs) && defined (DOUG_LEA_MALLOC)
diff --git a/src/regex.c b/src/regex.c
index 0f9150193ec..d16a5148054 100644
--- a/src/regex.c
+++ b/src/regex.c
@@ -33,6 +33,19 @@
#pragma alloca
#endif
+/* Ignore some GCC warnings for now. This section should go away
+ once the Emacs and Gnulib regex code is merged. */
+#if (__GNUC__ == 4 && 3 <= __GNUC_MINOR__) || 4 < __GNUC__
+# pragma GCC diagnostic ignored "-Wstrict-overflow"
+# ifndef emacs
+# pragma GCC diagnostic ignored "-Wunused-but-set-variable"
+# pragma GCC diagnostic ignored "-Wunused-function"
+# pragma GCC diagnostic ignored "-Wunused-macros"
+# pragma GCC diagnostic ignored "-Wunused-result"
+# pragma GCC diagnostic ignored "-Wunused-variable"
+# endif
+#endif
+
#ifdef HAVE_CONFIG_H
# include <config.h>
#endif
@@ -198,7 +211,7 @@
/* When used in Emacs's lib-src, we need xmalloc and xrealloc. */
-void *
+static void *
xmalloc (size_t size)
{
register void *val;
@@ -211,7 +224,7 @@ xmalloc (size_t size)
return val;
}
-void *
+static void *
xrealloc (void *block, size_t size)
{
register void *val;
diff --git a/src/s/ms-w32.h b/src/s/ms-w32.h
index e89ecb05931..63fc2f1f62b 100644
--- a/src/s/ms-w32.h
+++ b/src/s/ms-w32.h
@@ -122,7 +122,6 @@ struct sigaction {
#define HAVE_GETTIMEOFDAY 1
#define HAVE_GETHOSTNAME 1
-#undef HAVE_GETDOMAINNAME
#define HAVE_DUP2 1
#define HAVE_RENAME 1
#define HAVE_CLOSEDIR 1
@@ -147,7 +146,6 @@ struct sigaction {
#define HAVE_FMOD 1
#undef HAVE_RINT
#undef HAVE_CBRT
-#define HAVE_FTIME 1
#undef HAVE_RES_INIT /* For -lresolv on Suns. */
#undef HAVE_SETSID
#undef HAVE_FPATHCONF
diff --git a/src/search.c b/src/search.c
index 1f3ccc25dc8..2bf5f78d93b 100644
--- a/src/search.c
+++ b/src/search.c
@@ -2078,102 +2078,6 @@ set_search_regs (EMACS_INT beg_byte, EMACS_INT nbytes)
XSETBUFFER (last_thing_searched, current_buffer);
}
-DEFUN ("word-search-regexp", Fword_search_regexp, Sword_search_regexp, 1, 2, 0,
- doc: /* Return a regexp which matches words, ignoring punctuation.
-Given STRING, a string of words separated by word delimiters,
-compute a regexp that matches those exact words separated by
-arbitrary punctuation. If LAX is non-nil, the end of the string
-need not match a word boundary unless it ends in whitespace.
-
-Used in `word-search-forward', `word-search-backward',
-`word-search-forward-lax', `word-search-backward-lax'. */)
- (Lisp_Object string, Lisp_Object lax)
-{
- register unsigned char *o;
- register EMACS_INT i, i_byte, len, punct_count = 0, word_count = 0;
- Lisp_Object val;
- int prev_c = 0;
- EMACS_INT adjust;
- int whitespace_at_end;
-
- CHECK_STRING (string);
- len = SCHARS (string);
-
- for (i = 0, i_byte = 0; i < len; )
- {
- int c;
-
- FETCH_STRING_CHAR_AS_MULTIBYTE_ADVANCE (c, string, i, i_byte);
-
- if (SYNTAX (c) != Sword)
- {
- punct_count++;
- if (SYNTAX (prev_c) == Sword)
- word_count++;
- }
-
- prev_c = c;
- }
-
- if (SYNTAX (prev_c) == Sword)
- {
- word_count++;
- whitespace_at_end = 0;
- }
- else
- {
- whitespace_at_end = 1;
- if (!word_count)
- return empty_unibyte_string;
- }
-
- adjust = - punct_count + 5 * (word_count - 1)
- + ((!NILP (lax) && !whitespace_at_end) ? 2 : 4);
- if (STRING_MULTIBYTE (string))
- val = make_uninit_multibyte_string (len + adjust,
- SBYTES (string)
- + adjust);
- else
- val = make_uninit_string (len + adjust);
-
- o = SDATA (val);
- *o++ = '\\';
- *o++ = 'b';
- prev_c = 0;
-
- for (i = 0, i_byte = 0; i < len; )
- {
- int c;
- EMACS_INT i_byte_orig = i_byte;
-
- FETCH_STRING_CHAR_AS_MULTIBYTE_ADVANCE (c, string, i, i_byte);
-
- if (SYNTAX (c) == Sword)
- {
- memcpy (o, SDATA (string) + i_byte_orig, i_byte - i_byte_orig);
- o += i_byte - i_byte_orig;
- }
- else if (SYNTAX (prev_c) == Sword && --word_count)
- {
- *o++ = '\\';
- *o++ = 'W';
- *o++ = '\\';
- *o++ = 'W';
- *o++ = '*';
- }
-
- prev_c = c;
- }
-
- if (NILP (lax) || whitespace_at_end)
- {
- *o++ = '\\';
- *o++ = 'b';
- }
-
- return val;
-}
-
DEFUN ("search-backward", Fsearch_backward, Ssearch_backward, 1, 4,
"MSearch backward: ",
doc: /* Search backward from point for STRING.
@@ -2216,86 +2120,6 @@ See also the functions `match-beginning', `match-end' and `replace-match'. */)
return search_command (string, bound, noerror, count, 1, 0, 0);
}
-DEFUN ("word-search-backward", Fword_search_backward, Sword_search_backward, 1, 4,
- "sWord search backward: ",
- doc: /* Search backward from point for STRING, ignoring differences in punctuation.
-Set point to the beginning of the occurrence found, and return point.
-An optional second argument bounds the search; it is a buffer position.
-The match found must not extend before that position.
-Optional third argument, if t, means if fail just return nil (no error).
- If not nil and not t, move to limit of search and return nil.
-Optional fourth argument is repeat count--search for successive occurrences.
-
-Relies on the function `word-search-regexp' to convert a sequence
-of words in STRING to a regexp used to search words without regard
-to punctuation. */)
- (Lisp_Object string, Lisp_Object bound, Lisp_Object noerror, Lisp_Object count)
-{
- return search_command (Fword_search_regexp (string, Qnil), bound, noerror, count, -1, 1, 0);
-}
-
-DEFUN ("word-search-forward", Fword_search_forward, Sword_search_forward, 1, 4,
- "sWord search: ",
- doc: /* Search forward from point for STRING, ignoring differences in punctuation.
-Set point to the end of the occurrence found, and return point.
-An optional second argument bounds the search; it is a buffer position.
-The match found must not extend after that position.
-Optional third argument, if t, means if fail just return nil (no error).
- If not nil and not t, move to limit of search and return nil.
-Optional fourth argument is repeat count--search for successive occurrences.
-
-Relies on the function `word-search-regexp' to convert a sequence
-of words in STRING to a regexp used to search words without regard
-to punctuation. */)
- (Lisp_Object string, Lisp_Object bound, Lisp_Object noerror, Lisp_Object count)
-{
- return search_command (Fword_search_regexp (string, Qnil), bound, noerror, count, 1, 1, 0);
-}
-
-DEFUN ("word-search-backward-lax", Fword_search_backward_lax, Sword_search_backward_lax, 1, 4,
- "sWord search backward: ",
- doc: /* Search backward from point for STRING, ignoring differences in punctuation.
-Set point to the beginning of the occurrence found, and return point.
-
-Unlike `word-search-backward', the end of STRING need not match a word
-boundary, unless STRING ends in whitespace.
-
-An optional second argument bounds the search; it is a buffer position.
-The match found must not extend before that position.
-Optional third argument, if t, means if fail just return nil (no error).
- If not nil and not t, move to limit of search and return nil.
-Optional fourth argument is repeat count--search for successive occurrences.
-
-Relies on the function `word-search-regexp' to convert a sequence
-of words in STRING to a regexp used to search words without regard
-to punctuation. */)
- (Lisp_Object string, Lisp_Object bound, Lisp_Object noerror, Lisp_Object count)
-{
- return search_command (Fword_search_regexp (string, Qt), bound, noerror, count, -1, 1, 0);
-}
-
-DEFUN ("word-search-forward-lax", Fword_search_forward_lax, Sword_search_forward_lax, 1, 4,
- "sWord search: ",
- doc: /* Search forward from point for STRING, ignoring differences in punctuation.
-Set point to the end of the occurrence found, and return point.
-
-Unlike `word-search-forward', the end of STRING need not match a word
-boundary, unless STRING ends in whitespace.
-
-An optional second argument bounds the search; it is a buffer position.
-The match found must not extend after that position.
-Optional third argument, if t, means if fail just return nil (no error).
- If not nil and not t, move to limit of search and return nil.
-Optional fourth argument is repeat count--search for successive occurrences.
-
-Relies on the function `word-search-regexp' to convert a sequence
-of words in STRING to a regexp used to search words without regard
-to punctuation. */)
- (Lisp_Object string, Lisp_Object bound, Lisp_Object noerror, Lisp_Object count)
-{
- return search_command (Fword_search_regexp (string, Qt), bound, noerror, count, 1, 1, 0);
-}
-
DEFUN ("re-search-backward", Fre_search_backward, Sre_search_backward, 1, 4,
"sRE search backward: ",
doc: /* Search backward from point for match for regular expression REGEXP.
@@ -3252,11 +3076,6 @@ is to bind it with `let' around a small expression. */);
defsubr (&Sposix_string_match);
defsubr (&Ssearch_forward);
defsubr (&Ssearch_backward);
- defsubr (&Sword_search_regexp);
- defsubr (&Sword_search_forward);
- defsubr (&Sword_search_backward);
- defsubr (&Sword_search_forward_lax);
- defsubr (&Sword_search_backward_lax);
defsubr (&Sre_search_forward);
defsubr (&Sre_search_backward);
defsubr (&Sposix_search_forward);
diff --git a/src/sound.c b/src/sound.c
index 5fd5bd5c0de..9b58c01453a 100644
--- a/src/sound.c
+++ b/src/sound.c
@@ -124,9 +124,6 @@ static int parse_sound (Lisp_Object, Lisp_Object *);
#ifndef DEFAULT_SOUND_DEVICE
#define DEFAULT_SOUND_DEVICE "/dev/dsp"
#endif
-#ifndef DEFAULT_ALSA_SOUND_DEVICE
-#define DEFAULT_ALSA_SOUND_DEVICE "default"
-#endif
/* Structure forward declarations. */
@@ -908,6 +905,10 @@ vox_write (struct sound_device *sd, const char *buffer, EMACS_INT nbytes)
/* This driver is available on GNU/Linux. */
+#ifndef DEFAULT_ALSA_SOUND_DEVICE
+#define DEFAULT_ALSA_SOUND_DEVICE "default"
+#endif
+
static void
alsa_sound_perror (const char *msg, int err)
{
diff --git a/src/sysdep.c b/src/sysdep.c
index edaaa4c93d7..81529fc7d9b 100644
--- a/src/sysdep.c
+++ b/src/sysdep.c
@@ -37,6 +37,17 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include "sysselect.h"
#include "blockinput.h"
+#ifdef __FreeBSD__
+#include <sys/sysctl.h>
+#include <sys/user.h>
+#include <sys/resource.h> */
+#include <math.h>
+#endif
+
+#ifdef DARWIN_OS
+#include <sys/sysctl.h>
+#endif
+
#ifdef WINDOWSNT
#define read sys_read
#define write sys_write
@@ -2529,6 +2540,50 @@ list_system_processes (void)
return proclist;
}
+#elif defined BSD_SYSTEM
+
+Lisp_Object
+list_system_processes (void)
+{
+#ifdef DARWIN_OS
+ int mib[] = {CTL_KERN, KERN_PROC, KERN_PROC_ALL};
+#else
+ int mib[] = {CTL_KERN, KERN_PROC, KERN_PROC_PROC};
+#endif
+ size_t len;
+ struct kinfo_proc *procs;
+ size_t i;
+
+ struct gcpro gcpro1;
+ Lisp_Object proclist = Qnil;
+
+ if (sysctl (mib, 3, NULL, &len, NULL, 0) != 0)
+ return proclist;
+
+ procs = xmalloc (len);
+ if (sysctl (mib, 3, procs, &len, NULL, 0) != 0)
+ {
+ xfree (procs);
+ return proclist;
+ }
+
+ GCPRO1 (proclist);
+ len /= sizeof (struct kinfo_proc);
+ for (i = 0; i < len; i++)
+ {
+#ifdef DARWIN_OS
+ proclist = Fcons (make_fixnum_or_float (procs[i].kp_proc.p_pid), proclist);
+#else
+ proclist = Fcons (make_fixnum_or_float (procs[i].ki_pid), proclist);
+#endif
+ }
+ UNGCPRO;
+
+ xfree (procs);
+
+ return proclist;
+}
+
/* The WINDOWSNT implementation is in w32.c.
The MSDOS implementation is in dosfns.c. */
#elif !defined (WINDOWSNT) && !defined (MSDOS)
@@ -3079,6 +3134,179 @@ system_process_attributes (Lisp_Object pid)
return attrs;
}
+#elif defined __FreeBSD__
+
+Lisp_Object
+system_process_attributes (Lisp_Object pid)
+{
+ int proc_id;
+ int pagesize = getpagesize ();
+ int npages;
+ int fscale;
+ struct passwd *pw;
+ struct group *gr;
+ char *ttyname;
+ size_t len;
+ char args[MAXPATHLEN];
+ EMACS_TIME t, now;
+
+ int mib[4] = {CTL_KERN, KERN_PROC, KERN_PROC_PID};
+ struct kinfo_proc proc;
+ size_t proclen = sizeof proc;
+
+ struct gcpro gcpro1, gcpro2;
+ Lisp_Object attrs = Qnil;
+ Lisp_Object decoded_comm;
+
+ CHECK_NUMBER_OR_FLOAT (pid);
+ proc_id = FLOATP (pid) ? XFLOAT_DATA (pid) : XINT (pid);
+ mib[3] = proc_id;
+
+ if (sysctl (mib, 4, &proc, &proclen, NULL, 0) != 0)
+ return attrs;
+
+ GCPRO2 (attrs, decoded_comm);
+
+ attrs = Fcons (Fcons (Qeuid, make_fixnum_or_float (proc.ki_uid)), attrs);
+
+ BLOCK_INPUT;
+ pw = getpwuid (proc.ki_uid);
+ UNBLOCK_INPUT;
+ if (pw)
+ attrs = Fcons (Fcons (Quser, build_string (pw->pw_name)), attrs);
+
+ attrs = Fcons (Fcons (Qegid, make_fixnum_or_float (proc.ki_svgid)), attrs);
+
+ BLOCK_INPUT;
+ gr = getgrgid (proc.ki_svgid);
+ UNBLOCK_INPUT;
+ if (gr)
+ attrs = Fcons (Fcons (Qgroup, build_string (gr->gr_name)), attrs);
+
+ decoded_comm = code_convert_string_norecord
+ (make_unibyte_string (proc.ki_comm, strlen (proc.ki_comm)),
+ Vlocale_coding_system, 0);
+
+ attrs = Fcons (Fcons (Qcomm, decoded_comm), attrs);
+ {
+ char state[2] = {'\0', '\0'};
+ switch (proc.ki_stat)
+ {
+ case SRUN:
+ state[0] = 'R';
+ break;
+
+ case SSLEEP:
+ state[0] = 'S';
+ break;
+
+ case SLOCK:
+ state[0] = 'D';
+ break;
+
+ case SZOMB:
+ state[0] = 'Z';
+ break;
+
+ case SSTOP:
+ state[0] = 'T';
+ break;
+ }
+ attrs = Fcons (Fcons (Qstate, build_string (state)), attrs);
+ }
+
+ attrs = Fcons (Fcons (Qppid, make_fixnum_or_float (proc.ki_ppid)), attrs);
+ attrs = Fcons (Fcons (Qpgrp, make_fixnum_or_float (proc.ki_pgid)), attrs);
+ attrs = Fcons (Fcons (Qsess, make_fixnum_or_float (proc.ki_sid)), attrs);
+
+ BLOCK_INPUT;
+ ttyname = proc.ki_tdev == NODEV ? NULL : devname (proc.ki_tdev, S_IFCHR);
+ UNBLOCK_INPUT;
+ if (ttyname)
+ attrs = Fcons (Fcons (Qtty, build_string (ttyname)), attrs);
+
+ attrs = Fcons (Fcons (Qtpgid, make_fixnum_or_float (proc.ki_tpgid)), attrs);
+ attrs = Fcons (Fcons (Qminflt, make_fixnum_or_float (proc.ki_rusage.ru_minflt)), attrs);
+ attrs = Fcons (Fcons (Qmajflt, make_fixnum_or_float (proc.ki_rusage.ru_majflt)), attrs);
+ attrs = Fcons (Fcons (Qcminflt, make_number (proc.ki_rusage_ch.ru_minflt)), attrs);
+ attrs = Fcons (Fcons (Qcmajflt, make_number (proc.ki_rusage_ch.ru_majflt)), attrs);
+
+#define TIMELIST(ts) \
+ list3 (make_number (EMACS_SECS (ts) >> 16 & 0xffff), \
+ make_number (EMACS_SECS (ts) & 0xffff), \
+ make_number (EMACS_USECS (ts)))
+
+ attrs = Fcons (Fcons (Qutime, TIMELIST (proc.ki_rusage.ru_utime)), attrs);
+ attrs = Fcons (Fcons (Qstime, TIMELIST (proc.ki_rusage.ru_stime)), attrs);
+ EMACS_ADD_TIME (t, proc.ki_rusage.ru_utime, proc.ki_rusage.ru_stime);
+ attrs = Fcons (Fcons (Qtime, TIMELIST (t)), attrs);
+
+ attrs = Fcons (Fcons (Qcutime, TIMELIST (proc.ki_rusage_ch.ru_utime)), attrs);
+ attrs = Fcons (Fcons (Qcstime, TIMELIST (proc.ki_rusage_ch.ru_utime)), attrs);
+ EMACS_ADD_TIME (t, proc.ki_rusage_ch.ru_utime, proc.ki_rusage_ch.ru_stime);
+ attrs = Fcons (Fcons (Qctime, TIMELIST (t)), attrs);
+
+ attrs = Fcons (Fcons (Qthcount, make_fixnum_or_float (proc.ki_numthreads)),
+ attrs);
+ attrs = Fcons (Fcons (Qpri, make_number (proc.ki_pri.pri_native)), attrs);
+ attrs = Fcons (Fcons (Qnice, make_number (proc.ki_nice)), attrs);
+ attrs = Fcons (Fcons (Qstart, TIMELIST (proc.ki_start)), attrs);
+ attrs = Fcons (Fcons (Qvsize, make_number (proc.ki_size >> 10)), attrs);
+ attrs = Fcons (Fcons (Qrss, make_number (proc.ki_rssize * pagesize >> 10)),
+ attrs);
+
+ EMACS_GET_TIME (now);
+ EMACS_SUB_TIME (t, now, proc.ki_start);
+ attrs = Fcons (Fcons (Qetime, TIMELIST (t)), attrs);
+
+#undef TIMELIST
+
+ len = sizeof fscale;
+ if (sysctlbyname ("kern.fscale", &fscale, &len, NULL, 0) == 0)
+ {
+ double pcpu;
+ fixpt_t ccpu;
+ len = sizeof ccpu;
+ if (sysctlbyname ("kern.ccpu", &ccpu, &len, NULL, 0) == 0)
+ {
+ pcpu = (100.0 * proc.ki_pctcpu / fscale
+ / (1 - exp (proc.ki_swtime * log ((double) ccpu / fscale))));
+ attrs = Fcons (Fcons (Qpcpu, make_fixnum_or_float (pcpu)), attrs);
+ }
+ }
+
+ len = sizeof npages;
+ if (sysctlbyname ("hw.availpages", &npages, &len, NULL, 0) == 0)
+ {
+ double pmem = (proc.ki_flag & P_INMEM
+ ? 100.0 * proc.ki_rssize / npages
+ : 0);
+ attrs = Fcons (Fcons (Qpmem, make_fixnum_or_float (pmem)), attrs);
+ }
+
+ mib[2] = KERN_PROC_ARGS;
+ len = MAXPATHLEN;
+ if (sysctl (mib, 4, args, &len, NULL, 0) == 0)
+ {
+ int i;
+ for (i = 0; i < len; i++)
+ {
+ if (! args[i] && i < len - 1)
+ args[i] = ' ';
+ }
+
+ decoded_comm =
+ (code_convert_string_norecord
+ (make_unibyte_string (args, strlen (args)),
+ Vlocale_coding_system, 0));
+
+ attrs = Fcons (Fcons (Qargs, decoded_comm), attrs);
+ }
+
+ UNGCPRO;
+ return attrs;
+}
+
/* The WINDOWSNT implementation is in w32.c.
The MSDOS implementation is in dosfns.c. */
#elif !defined (WINDOWSNT) && !defined (MSDOS)
diff --git a/src/syssignal.h b/src/syssignal.h
index 86135d71215..a2522f24429 100644
--- a/src/syssignal.h
+++ b/src/syssignal.h
@@ -1,5 +1,6 @@
/* syssignal.h - System-dependent definitions for signals.
- Copyright (C) 1993, 1999, 2001-2012 Free Software Foundation, Inc.
+
+Copyright (C) 1993, 1999, 2001-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -82,24 +83,18 @@ void croak (char *) NO_RETURN;
#define sigfree() sigsetmask (SIGEMPTYMASK)
-#if defined (SIGINFO) && defined (BROKEN_SIGINFO)
-#undef SIGINFO
-#endif
#if defined (SIGIO) && defined (BROKEN_SIGIO)
# undef SIGIO
#endif
+/* Last user: m/ibmrs6000.h */
#if defined (SIGPOLL) && defined (BROKEN_SIGPOLL)
#undef SIGPOLL
#endif
-#if defined (SIGTSTP) && defined (BROKEN_SIGTSTP)
-#undef SIGTSTP
-#endif
-#if defined (SIGURG) && defined (BROKEN_SIGURG)
-#undef SIGURG
-#endif
+/* Last user: m/ibmrs6000.h */
#if defined (SIGAIO) && defined (BROKEN_SIGAIO)
#undef SIGAIO
#endif
+/* Last user: m/ibmrs6000.h */
#if defined (SIGPTY) && defined (BROKEN_SIGPTY)
#undef SIGPTY
#endif
diff --git a/src/term.c b/src/term.c
index 53458c559dd..ce300f9442a 100644
--- a/src/term.c
+++ b/src/term.c
@@ -3601,7 +3601,7 @@ delete_tty (struct terminal *terminal)
/* Mark the pointers in the tty_display_info objects.
- Called by the Fgarbage_collector. */
+ Called by Fgarbage_collect. */
void
mark_ttys (void)
diff --git a/src/undo.c b/src/undo.c
index 4041a2adacc..b0acd0c216f 100644
--- a/src/undo.c
+++ b/src/undo.c
@@ -436,6 +436,13 @@ truncate_undo_list (struct buffer *b)
unbind_to (count, Qnil);
}
+
+static void user_error (const char*) NO_RETURN;
+static void user_error (const char *msg)
+{
+ xsignal1 (Quser_error, build_string (msg));
+}
+
DEFUN ("primitive-undo", Fprimitive_undo, Sprimitive_undo, 2, 2, 0,
doc: /* Undo N records from the front of the list LIST.
@@ -528,7 +535,7 @@ Return what remains of the list. */)
end = Fcdr (cdr);
if (XINT (beg) < BEGV || XINT (end) > ZV)
- error ("Changes to be undone are outside visible portion of buffer");
+ user_error ("Changes to be undone are outside visible portion of buffer");
Fput_text_property (beg, end, prop, val, Qnil);
}
else if (INTEGERP (car) && INTEGERP (cdr))
@@ -537,7 +544,7 @@ Return what remains of the list. */)
if (XINT (car) < BEGV
|| XINT (cdr) > ZV)
- error ("Changes to be undone are outside visible portion of buffer");
+ user_error ("Changes to be undone are outside visible portion of buffer");
/* Set point first thing, so that undoing this undo
does not send point back to where it is now. */
Fgoto_char (car);
@@ -588,14 +595,14 @@ Return what remains of the list. */)
if (pos < 0)
{
if (-pos < BEGV || -pos > ZV)
- error ("Changes to be undone are outside visible portion of buffer");
+ user_error ("Changes to be undone are outside visible portion of buffer");
SET_PT (-pos);
Finsert (1, &membuf);
}
else
{
if (pos < BEGV || pos > ZV)
- error ("Changes to be undone are outside visible portion of buffer");
+ user_error ("Changes to be undone are outside visible portion of buffer");
SET_PT (pos);
/* Now that we record marker adjustments
diff --git a/src/unexaix.c b/src/unexaix.c
index 1bf65b68518..29fa0fd6287 100644
--- a/src/unexaix.c
+++ b/src/unexaix.c
@@ -78,13 +78,13 @@ static long data_scnptr;
static long load_scnptr;
static long orig_load_scnptr;
static long orig_data_scnptr;
-static int unrelocate_symbols (int, int, char *, char *);
+static int unrelocate_symbols (int, int, const char *, const char *);
#ifndef MAX_SECTIONS
#define MAX_SECTIONS 10
#endif
-static int adjust_lnnoptrs (int, int, char *);
+static int adjust_lnnoptrs (int, int, const char *);
static int pagemask;
@@ -92,7 +92,7 @@ static int pagemask;
#include "lisp.h"
static void
-report_error (char *file, int fd)
+report_error (const char *file, int fd)
{
if (fd)
close (fd);
@@ -104,16 +104,16 @@ report_error (char *file, int fd)
#define ERROR2(msg,x,y) report_error_1 (new, msg, x, y); return -1
static void
-report_error_1 (int fd, char *msg, int a1, int a2)
+report_error_1 (int fd, const char *msg, int a1, int a2)
{
close (fd);
error (msg, a1, a2);
}
-static int make_hdr (int, int, unsigned, unsigned, unsigned, char *, char *);
-static void mark_x (char *);
+static int make_hdr (int, int, const char *, const char *);
+static void mark_x (const char *);
static int copy_text_and_data (int);
-static int copy_sym (int, int, char *, char *);
+static int copy_sym (int, int, const char *, const char *);
static void write_segment (int, char *, char *);
/* ****************************************************************
@@ -159,7 +159,7 @@ unexec (const char *new_name, const char *a_name)
*/
static int
make_hdr (int new, int a_out,
- char *a_name, char *new_name)
+ const char *a_name, const char *new_name)
{
int scns;
unsigned int bss_start;
@@ -429,7 +429,7 @@ write_segment (int new, char *ptr, char *end)
* Copy the relocation information and symbol table from the a.out to the new
*/
static int
-copy_sym (int new, int a_out, char *a_name, char *new_name)
+copy_sym (int new, int a_out, const char *a_name, const char *new_name)
{
char page[UnexBlockSz];
int n;
@@ -465,7 +465,7 @@ copy_sym (int new, int a_out, char *a_name, char *new_name)
* After successfully building the new a.out, mark it executable
*/
static void
-mark_x (char *name)
+mark_x (const char *name)
{
struct stat sbuf;
int um;
@@ -483,7 +483,7 @@ mark_x (char *name)
}
static int
-adjust_lnnoptrs (int writedesc, int readdesc, char *new_name)
+adjust_lnnoptrs (int writedesc, int readdesc, const char *new_name)
{
int nsyms;
int naux;
@@ -530,7 +530,8 @@ adjust_lnnoptrs (int writedesc, int readdesc, char *new_name)
}
static int
-unrelocate_symbols (int new, int a_out, char *a_name, char *new_name)
+unrelocate_symbols (int new, int a_out,
+ const char *a_name, const char *new_name)
{
int i;
LDHDR ldhdr;
diff --git a/src/w32fns.c b/src/w32fns.c
index 510d1e94f16..f5161117f9d 100644
--- a/src/w32fns.c
+++ b/src/w32fns.c
@@ -4003,7 +4003,7 @@ unwind_create_frame (Lisp_Object frame)
#if GLYPH_DEBUG
/* Check that reference counts are indeed correct. */
xassert (dpyinfo->reference_count == dpyinfo_refcount);
- xassert (dpyinfo->image_cache->refcount == image_cache_refcount);
+ xassert (dpyinfo->terminal->image_cache->refcount == image_cache_refcount);
#endif
return Qt;
}
@@ -5016,16 +5016,6 @@ no value of TYPE (always string in the MS Windows case). */)
cursor. Duplicated from xdisp.c, but cannot use the version there
due to lack of atimers on w32. */
#define DEFAULT_HOURGLASS_DELAY 1
-/* Return non-zero if hourglass timer has been started or hourglass is
- shown. */
-/* PENDING: if W32 can use atimers (atimer.[hc]) then the common impl in
- xdisp.c could be used. */
-
-int
-hourglass_started (void)
-{
- return hourglass_shown_p || hourglass_timer;
-}
/* Cancel a currently active hourglass timer, and start a new one. */
@@ -5246,7 +5236,7 @@ x_create_tip_frame (struct w32_display_info *dpyinfo,
#if GLYPH_DEBUG
image_cache_refcount =
- FRAME_IMAGE_CACHE ? FRAME_IMAGE_CACHE (f)->refcount : 0;
+ FRAME_IMAGE_CACHE (f) ? FRAME_IMAGE_CACHE (f)->refcount : 0;
dpyinfo_refcount = dpyinfo->reference_count;
#endif /* GLYPH_DEBUG */
FRAME_KBOARD (f) = kb;
diff --git a/src/w32font.c b/src/w32font.c
index dab9f4c61b4..8badace9635 100644
--- a/src/w32font.c
+++ b/src/w32font.c
@@ -2045,8 +2045,11 @@ fill_in_logfont (FRAME_PTR f, LOGFONT *logfont, Lisp_Object font_spec)
/* Font families are interned, but allow for strings also in case of
user input. */
else if (SYMBOLP (tmp))
- strncpy (logfont->lfFaceName,
- SDATA (ENCODE_SYSTEM (SYMBOL_NAME (tmp))), LF_FACESIZE);
+ {
+ strncpy (logfont->lfFaceName,
+ SDATA (ENCODE_SYSTEM (SYMBOL_NAME (tmp))), LF_FACESIZE);
+ logfont->lfFaceName[LF_FACESIZE-1] = '\0';
+ }
}
tmp = AREF (font_spec, FONT_ADSTYLE_INDEX);
diff --git a/src/w32menu.c b/src/w32menu.c
index 9091cb81627..5b95a083d90 100644
--- a/src/w32menu.c
+++ b/src/w32menu.c
@@ -48,6 +48,8 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include "dispextern.h"
+#include "w32heap.h" /* for osinfo_cache */
+
#undef HAVE_DIALOGS /* TODO: Implement native dialogs. */
#ifndef TRUE
@@ -1498,8 +1500,11 @@ add_menu_item (HMENU menu, widget_value *wv, HMENU item)
AppendMenu (menu, fuFlags,
item != NULL ? (UINT) item: (UINT) wv->call_data,
out_string);
- /* Don't use Unicode menus in future. */
- unicode_append_menu = NULL;
+ /* Don't use Unicode menus in future, unless this is Windows
+ NT or later, where a failure of AppendMenuW does NOT mean
+ Unicode menus are unsupported. */
+ if (osinfo_cache.dwPlatformId != VER_PLATFORM_WIN32_NT)
+ unicode_append_menu = NULL;
}
if (unicode_append_menu && (fuFlags & MF_OWNERDRAW))
diff --git a/src/w32proc.c b/src/w32proc.c
index 28591f90128..5bdeba25958 100644
--- a/src/w32proc.c
+++ b/src/w32proc.c
@@ -141,7 +141,25 @@ new_child (void)
cp->char_consumed = CreateEvent (NULL, FALSE, FALSE, NULL);
if (cp->char_consumed)
{
- cp->thrd = CreateThread (NULL, 1024, reader_thread, cp, 0, &id);
+ /* The 0x00010000 flag is STACK_SIZE_PARAM_IS_A_RESERVATION.
+ It means that the 64K stack we are requesting in the 2nd
+ argument is how much memory should be reserved for the
+ stack. If we don't use this flag, the memory requested
+ by the 2nd argument is the amount actually _committed_,
+ but Windows reserves 8MB of memory for each thread's
+ stack. (The 8MB figure comes from the -stack
+ command-line argument we pass to the linker when building
+ Emacs, but that's because we need a large stack for
+ Emacs's main thread.) Since we request 2GB of reserved
+ memory at startup (see w32heap.c), which is close to the
+ maximum memory available for a 32-bit process on Windows,
+ the 8MB reservation for each thread causes failures in
+ starting subprocesses, because we create a thread running
+ reader_thread for each subprocess. As 8MB of stack is
+ way too much for reader_thread, forcing Windows to
+ reserve less wins the day. */
+ cp->thrd = CreateThread (NULL, 64 * 1024, reader_thread, cp,
+ 0x00010000, &id);
if (cp->thrd)
return cp;
}
diff --git a/src/w32term.c b/src/w32term.c
index 18a3753f9e9..2ccd7574332 100644
--- a/src/w32term.c
+++ b/src/w32term.c
@@ -231,6 +231,10 @@ static void my_set_focus (struct frame *, HWND);
static void my_set_foreground_window (HWND);
static void my_destroy_window (struct frame *, HWND);
+#if GLYPH_DEBUG
+static void x_check_font (struct frame *, struct font *);
+#endif
+
static Lisp_Object Qvendor_specific_keysyms;
@@ -5906,6 +5910,27 @@ x_wm_set_icon_position (struct frame *f, int icon_x, int icon_y)
/***********************************************************************
+ Fonts
+ ***********************************************************************/
+
+#if GLYPH_DEBUG
+
+/* Check that FONT is valid on frame F. It is if it can be found in F's
+ font table. */
+
+static void
+x_check_font (struct frame *f, struct font *font)
+{
+ xassert (font != NULL && ! NILP (font->props[FONT_TYPE_INDEX]));
+ if (font->driver->check)
+ xassert (font->driver->check (f, font) == 0);
+}
+
+#endif /* GLYPH_DEBUG != 0 */
+
+
+
+/***********************************************************************
Initialization
***********************************************************************/
diff --git a/src/window.c b/src/window.c
index 710e496fe88..827d3646e49 100644
--- a/src/window.c
+++ b/src/window.c
@@ -4226,6 +4226,11 @@ window_scroll_pixel_based (Lisp_Object window, int n, int whole, int noerror)
void *itdata = NULL;
SET_TEXT_POS_FROM_MARKER (start, w->start);
+ /* Scrolling a minibuffer window via scroll bar when the echo area
+ shows long text sometimes resets the minibuffer contents behind
+ our backs. */
+ if (CHARPOS (start) > ZV)
+ SET_TEXT_POS (start, BEGV, BEGV_BYTE);
/* If PT is not visible in WINDOW, move back one half of
the screen. Allow PT to be partially visible, otherwise
diff --git a/src/xdisp.c b/src/xdisp.c
index 2025eda79a7..90cd3cd9e2c 100644
--- a/src/xdisp.c
+++ b/src/xdisp.c
@@ -385,11 +385,21 @@ static Lisp_Object Qline_height;
#define IT_OVERFLOW_NEWLINE_INTO_FRINGE(it) 0
#endif /* HAVE_WINDOW_SYSTEM */
-/* Test if the display element loaded in IT is a space or tab
- character. This is used to determine word wrapping. */
-
-#define IT_DISPLAYING_WHITESPACE(it) \
- (it->what == IT_CHARACTER && (it->c == ' ' || it->c == '\t'))
+/* Test if the display element loaded in IT, or the underlying buffer
+ or string character, is a space or a TAB character. This is used
+ to determine where word wrapping can occur. */
+
+#define IT_DISPLAYING_WHITESPACE(it) \
+ ((it->what == IT_CHARACTER && (it->c == ' ' || it->c == '\t')) \
+ || ((STRINGP (it->string) \
+ && (SREF (it->string, IT_STRING_BYTEPOS (*it)) == ' ' \
+ || SREF (it->string, IT_STRING_BYTEPOS (*it)) == '\t')) \
+ || (it->s \
+ && (it->s[IT_BYTEPOS (*it)] == ' ' \
+ || it->s[IT_BYTEPOS (*it)] == '\t')) \
+ || (IT_BYTEPOS (*it) < ZV_BYTE \
+ && (*BYTE_POS_ADDR (IT_BYTEPOS (*it)) == ' ' \
+ || *BYTE_POS_ADDR (IT_BYTEPOS (*it)) == '\t')))) \
/* Name of the face used to highlight trailing whitespace. */
@@ -841,6 +851,7 @@ static int try_cursor_movement (Lisp_Object, struct text_pos, int *);
static int trailing_whitespace_p (EMACS_INT);
static intmax_t message_log_check_duplicate (EMACS_INT, EMACS_INT);
static void push_it (struct it *, struct text_pos *);
+static void iterate_out_of_display_property (struct it *);
static void pop_it (struct it *);
static void sync_frame_with_window_matrix_rows (struct window *);
static void select_frame_for_redisplay (Lisp_Object);
@@ -1270,6 +1281,11 @@ pos_visible_p (struct window *w, EMACS_INT charpos, int *x, int *y,
}
SET_TEXT_POS_FROM_MARKER (top, w->start);
+ /* Scrolling a minibuffer window via scroll bar when the echo area
+ shows long text sometimes resets the minibuffer contents behind
+ our backs. */
+ if (CHARPOS (top) > ZV)
+ SET_TEXT_POS (top, BEGV, BEGV_BYTE);
/* Compute exact mode line heights. */
if (WINDOW_WANTS_MODELINE_P (w))
@@ -1303,8 +1319,8 @@ pos_visible_p (struct window *w, EMACS_INT charpos, int *x, int *y,
glyph. */
int top_x = it.current_x;
int top_y = it.current_y;
- enum it_method it_method = it.method;
/* Calling line_bottom_y may change it.method, it.position, etc. */
+ enum it_method it_method = it.method;
int bottom_y = (last_height = 0, line_bottom_y (&it));
int window_top_y = WINDOW_HEADER_LINE_HEIGHT (w);
@@ -1312,6 +1328,31 @@ pos_visible_p (struct window *w, EMACS_INT charpos, int *x, int *y,
visible_p = bottom_y > window_top_y;
else if (top_y < it.last_visible_y)
visible_p = 1;
+ if (bottom_y >= it.last_visible_y
+ && it.bidi_p && it.bidi_it.scan_dir == -1
+ && IT_CHARPOS (it) < charpos)
+ {
+ /* When the last line of the window is scanned backwards
+ under bidi iteration, we could be duped into thinking
+ that we have passed CHARPOS, when in fact move_it_to
+ simply stopped short of CHARPOS because it reached
+ last_visible_y. To see if that's what happened, we call
+ move_it_to again with a slightly larger vertical limit,
+ and see if it actually moved vertically; if it did, we
+ didn't really reach CHARPOS, which is beyond window end. */
+ struct it save_it = it;
+ /* Why 10? because we don't know how many canonical lines
+ will the height of the next line(s) be. So we guess. */
+ int ten_more_lines =
+ 10 * FRAME_LINE_HEIGHT (XFRAME (WINDOW_FRAME (w)));
+
+ move_it_to (&it, charpos, -1, bottom_y + ten_more_lines, -1,
+ MOVE_TO_POS | MOVE_TO_Y);
+ if (it.current_y > top_y)
+ visible_p = 0;
+
+ it = save_it;
+ }
if (visible_p)
{
if (it_method == GET_FROM_DISPLAY_VECTOR)
@@ -1375,6 +1416,7 @@ pos_visible_p (struct window *w, EMACS_INT charpos, int *x, int *y,
Lisp_Object startpos, endpos;
EMACS_INT start, end;
struct it it3;
+ int it3_moved;
/* Find the first and the last buffer positions
covered by the display string. */
@@ -1431,6 +1473,15 @@ pos_visible_p (struct window *w, EMACS_INT charpos, int *x, int *y,
begins. */
start_display (&it3, w, top);
move_it_to (&it3, -1, 0, top_y, -1, MOVE_TO_X | MOVE_TO_Y);
+ /* If it3_moved stays zero after the 'while' loop
+ below, that means we already were at a newline
+ before the loop (e.g., the display string begins
+ with a newline), so we don't need to (and cannot)
+ inspect the glyphs of it3.glyph_row, because
+ PRODUCE_GLYPHS will not produce anything for a
+ newline, and thus it3.glyph_row stays at its
+ stale content it got at top of the window. */
+ it3_moved = 0;
/* Finally, advance the iterator until we hit the
first display element whose character position is
CHARPOS, or until the first newline from the
@@ -1442,6 +1493,7 @@ pos_visible_p (struct window *w, EMACS_INT charpos, int *x, int *y,
if (IT_CHARPOS (it3) == charpos
|| ITERATOR_AT_END_OF_LINE_P (&it3))
break;
+ it3_moved = 1;
set_iterator_to_next (&it3, 0);
}
top_x = it3.current_x - it3.pixel_width;
@@ -1452,7 +1504,8 @@ pos_visible_p (struct window *w, EMACS_INT charpos, int *x, int *y,
display string, move back over the glyphs
produced from the string, until we find the
rightmost glyph not from the string. */
- if (IT_CHARPOS (it3) != charpos && EQ (it3.object, string))
+ if (it3_moved
+ && IT_CHARPOS (it3) != charpos && EQ (it3.object, string))
{
struct glyph *g = it3.glyph_row->glyphs[TEXT_AREA]
+ it3.glyph_row->used[TEXT_AREA];
@@ -3113,7 +3166,15 @@ handle_stop (struct it *it)
overlays even if the actual buffer text is replaced. */
if (!handle_overlay_change_p
|| it->sp > 1
- || !get_overlay_strings_1 (it, 0, 0))
+ /* Don't call get_overlay_strings_1 if we already
+ have overlay strings loaded, because doing so
+ will load them again and push the iterator state
+ onto the stack one more time, which is not
+ expected by the rest of the code that processes
+ overlay strings. */
+ || (it->n_overlay_strings <= 0
+ ? !get_overlay_strings_1 (it, 0, 0)
+ : 0))
{
if (it->ellipsis_p)
setup_for_ellipsis (it, 0);
@@ -4672,10 +4733,22 @@ handle_single_display_spec (struct it *it, Lisp_Object spec, Lisp_Object object,
if (!FRAME_WINDOW_P (it->f))
/* If we return here, POSITION has been advanced
across the text with this property. */
- return 0;
+ {
+ /* Synchronize the bidi iterator with POSITION. This is
+ needed because we are not going to push the iterator
+ on behalf of this display property, so there will be
+ no pop_it call to do this synchronization for us. */
+ if (it->bidi_p)
+ {
+ it->position = *position;
+ iterate_out_of_display_property (it);
+ *position = it->position;
+ }
+ return 1;
+ }
}
else if (!frame_window_p)
- return 0;
+ return 1;
#ifdef HAVE_WINDOW_SYSTEM
value = XCAR (XCDR (spec));
@@ -4683,7 +4756,15 @@ handle_single_display_spec (struct it *it, Lisp_Object spec, Lisp_Object object,
|| !(fringe_bitmap = lookup_fringe_bitmap (value)))
/* If we return here, POSITION has been advanced
across the text with this property. */
- return 0;
+ {
+ if (it && it->bidi_p)
+ {
+ it->position = *position;
+ iterate_out_of_display_property (it);
+ *position = it->position;
+ }
+ return 1;
+ }
if (it)
{
@@ -5004,7 +5085,7 @@ string_buffer_position_lim (Lisp_Object string,
Lisp_Object limit, prop, pos;
int found = 0;
- pos = make_number (from);
+ pos = make_number (max (from, BEGV));
if (!back_p) /* looking forward */
{
@@ -5624,7 +5705,7 @@ push_it (struct it *it, struct text_pos *position)
static void
iterate_out_of_display_property (struct it *it)
{
- int buffer_p = BUFFERP (it->object);
+ int buffer_p = !STRINGP (it->string);
EMACS_INT eob = (buffer_p ? ZV : it->end_charpos);
EMACS_INT bob = (buffer_p ? BEGV : 0);
@@ -6801,6 +6882,16 @@ get_next_display_element (struct it *it)
&& FACE_FROM_ID (it->f, face_id)->box == FACE_NO_BOX);
}
}
+ /* If we reached the end of the object we've been iterating (e.g., a
+ display string or an overlay string), and there's something on
+ IT->stack, proceed with what's on the stack. It doesn't make
+ sense to return zero if there's unprocessed stuff on the stack,
+ because otherwise that stuff will never be displayed. */
+ if (!success_p && it->sp > 0)
+ {
+ set_iterator_to_next (it, 0);
+ success_p = get_next_display_element (it);
+ }
/* Value is 0 if end of buffer or string reached. */
return success_p;
@@ -6982,7 +7073,7 @@ set_iterator_to_next (struct it *it, int reseat_p)
display vector entry (these entries may contain faces). */
it->face_id = it->saved_face_id;
- if (it->dpvec + it->current.dpvec_index == it->dpend)
+ if (it->dpvec + it->current.dpvec_index >= it->dpend)
{
int recheck_faces = it->ellipsis_p;
@@ -7020,6 +7111,26 @@ set_iterator_to_next (struct it *it, int reseat_p)
case GET_FROM_STRING:
/* Current display element is a character from a Lisp string. */
xassert (it->s == NULL && STRINGP (it->string));
+ /* Don't advance past string end. These conditions are true
+ when set_iterator_to_next is called at the end of
+ get_next_display_element, in which case the Lisp string is
+ already exhausted, and all we want is pop the iterator
+ stack. */
+ if (it->current.overlay_string_index >= 0)
+ {
+ /* This is an overlay string, so there's no padding with
+ spaces, and the number of characters in the string is
+ where the string ends. */
+ if (IT_STRING_CHARPOS (*it) >= SCHARS (it->string))
+ goto consider_string_end;
+ }
+ else
+ {
+ /* Not an overlay string. There could be padding, so test
+ against it->end_charpos . */
+ if (IT_STRING_CHARPOS (*it) >= it->end_charpos)
+ goto consider_string_end;
+ }
if (it->cmp_it.id >= 0)
{
int i;
@@ -12754,6 +12865,9 @@ redisplay_internal (void)
frames. Zero means, only selected_window is considered. */
int consider_all_windows_p;
+ /* Non-zero means redisplay has to redisplay the miniwindow */
+ int update_miniwindow_p = 0;
+
TRACE ((stderr, "redisplay_internal %d\n", redisplaying_p));
/* No redisplay if running in batch mode or frame is not yet fully
@@ -12940,6 +13054,10 @@ redisplay_internal (void)
&& !MINI_WINDOW_P (XWINDOW (selected_window))))
{
int window_height_changed_p = echo_area_display (0);
+
+ if (message_cleared_p)
+ update_miniwindow_p = 1;
+
must_finish = 1;
/* If we don't display the current message, don't clear the
@@ -12976,7 +13094,7 @@ redisplay_internal (void)
/* FIXME: this causes all frames to be updated, which seems unnecessary
since only the current frame needs to be considered. This function needs
to be rewritten with two variables, consider_all_windows and
- consider_all_frames. */
+ consider_all_frames. */
consider_all_windows_p = 1;
++windows_or_buffers_changed;
++update_mode_lines;
@@ -13169,7 +13287,8 @@ redisplay_internal (void)
then we can't just move the cursor. */
else if (! (!NILP (Vtransient_mark_mode)
&& !NILP (BVAR (current_buffer, mark_active)))
- && (EQ (selected_window, BVAR (current_buffer, last_selected_window))
+ && (EQ (selected_window,
+ BVAR (current_buffer, last_selected_window))
|| highlight_nonselected_windows)
&& NILP (w->region_showing)
&& NILP (Vshow_trailing_whitespace)
@@ -13322,7 +13441,7 @@ redisplay_internal (void)
}
else if (FRAME_VISIBLE_P (sf) && !FRAME_OBSCURED_P (sf))
{
- Lisp_Object mini_window;
+ Lisp_Object mini_window = FRAME_MINIBUF_WINDOW (sf);
struct frame *mini_frame;
displayed_buffer = XBUFFER (XWINDOW (selected_window)->buffer);
@@ -13331,6 +13450,10 @@ redisplay_internal (void)
internal_condition_case_1 (redisplay_window_1, selected_window,
list_of_error,
redisplay_window_error);
+ if (update_miniwindow_p)
+ internal_condition_case_1 (redisplay_window_1, mini_window,
+ list_of_error,
+ redisplay_window_error);
/* Compare desired and current matrices, perform output. */
@@ -13751,6 +13874,13 @@ set_cursor_from_row (struct window *w, struct glyph_row *row,
comes from a text property, not from an overlay. */
int string_from_text_prop = 0;
+ /* Don't even try doing anything if called for a mode-line or
+ header-line row, since the rest of the code isn't prepared to
+ deal with such calamities. */
+ xassert (!row->mode_line_p);
+ if (row->mode_line_p)
+ return 0;
+
/* Skip over glyphs not having an object at the start and the end of
the row. These are special glyphs like truncation marks on
terminal frames. */
@@ -14971,6 +15101,8 @@ try_cursor_movement (Lisp_Object window, struct text_pos startp, int *scroll_ste
else if (rc != CURSOR_MOVEMENT_SUCCESS
&& !NILP (BVAR (XBUFFER (w->buffer), bidi_display_reordering)))
{
+ struct glyph_row *row1;
+
/* If rows are bidi-reordered and point moved, back up
until we find a row that does not belong to a
continuation line. This is because we must consider
@@ -14981,24 +15113,28 @@ try_cursor_movement (Lisp_Object window, struct text_pos startp, int *scroll_ste
/* FIXME: Revisit this when glyph ``spilling'' in
continuation lines' rows is implemented for
bidi-reordered rows. */
- while (MATRIX_ROW_CONTINUATION_LINE_P (row))
+ for (row1 = MATRIX_FIRST_TEXT_ROW (w->current_matrix);
+ MATRIX_ROW_CONTINUATION_LINE_P (row);
+ --row)
{
/* If we hit the beginning of the displayed portion
without finding the first row of a continued
line, give up. */
- if (row <= w->current_matrix->rows)
+ if (row <= row1)
{
rc = CURSOR_MOVEMENT_MUST_SCROLL;
break;
}
xassert (row->enabled_p);
- --row;
}
}
if (must_scroll)
;
else if (rc != CURSOR_MOVEMENT_SUCCESS
&& MATRIX_ROW_PARTIALLY_VISIBLE_P (w, row)
+ /* Make sure this isn't a header line by any chance, since
+ then MATRIX_ROW_PARTIALLY_VISIBLE_P might yield non-zero. */
+ && !row->mode_line_p
&& make_cursor_line_fully_visible_p)
{
if (PT == MATRIX_ROW_END_CHARPOS (row)
@@ -29068,14 +29204,6 @@ init_xdisp (void)
/* Platform-independent portion of hourglass implementation. */
-/* Return non-zero if hourglass timer has been started or hourglass is
- shown. */
-int
-hourglass_started (void)
-{
- return hourglass_shown_p || hourglass_atimer != NULL;
-}
-
/* Cancel a currently active hourglass timer, and start a new one. */
void
start_hourglass (void)
diff --git a/src/xfns.c b/src/xfns.c
index df1b39b018f..717378f1cd1 100644
--- a/src/xfns.c
+++ b/src/xfns.c
@@ -136,7 +136,7 @@ char *gray_bitmap_bits = gray_bits;
/* Nonzero if using X. */
-static int x_in_use;
+int x_in_use;
static Lisp_Object Qnone;
static Lisp_Object Qsuppress_icon;
@@ -2439,7 +2439,6 @@ x_window (struct frame *f, long window_prompting, int minibuffer_only)
/* Do some needed geometry management. */
{
- ptrdiff_t len;
char *tem, shell_position[sizeof "=x++" + 4 * INT_STRLEN_BOUND (int)];
Arg gal[10];
int gac = 0;
@@ -2508,13 +2507,11 @@ x_window (struct frame *f, long window_prompting, int minibuffer_only)
}
}
- len = strlen (shell_position) + 1;
/* We don't free this because we don't know whether
it is safe to free it while the frame exists.
It isn't worth the trouble of arranging to free it
when the frame is deleted. */
- tem = (char *) xmalloc (len);
- strncpy (tem, shell_position, len);
+ tem = (char *) xstrdup (shell_position);
XtSetArg (gal[gac], XtNgeometry, tem); gac++;
XtSetValues (shell_widget, gal, gac);
}
diff --git a/src/xgselect.c b/src/xgselect.c
index 80dbfc32aee..69ad93b3127 100644
--- a/src/xgselect.c
+++ b/src/xgselect.c
@@ -27,6 +27,7 @@ along with GNU Emacs. If not, see <http§://www.gnu.org/licenses/>. */
#include <glib.h>
#include <errno.h>
#include <setjmp.h>
+#include "xterm.h"
static GPollFD *gfds;
static ptrdiff_t gfds_size;
@@ -38,10 +39,13 @@ xg_select (int max_fds, SELECT_TYPE *rfds, SELECT_TYPE *wfds, SELECT_TYPE *efds,
SELECT_TYPE all_rfds, all_wfds;
EMACS_TIME tmo, *tmop = timeout;
- GMainContext *context = g_main_context_default ();
+ GMainContext *context;
int have_wfds = wfds != NULL;
int n_gfds = 0, our_tmo = 0, retval = 0, our_fds = 0;
- int i, nfds, tmo_in_millisec;
+ int i, nfds, fds_lim, tmo_in_millisec;
+
+ if (!x_in_use)
+ return select (max_fds, rfds, wfds, efds, timeout);
if (rfds) memcpy (&all_rfds, rfds, sizeof (all_rfds));
else FD_ZERO (&all_rfds);
@@ -49,6 +53,7 @@ xg_select (int max_fds, SELECT_TYPE *rfds, SELECT_TYPE *wfds, SELECT_TYPE *efds,
else FD_ZERO (&all_wfds);
/* Update event sources in GLib. */
+ context = g_main_context_default ();
g_main_context_pending (context);
do {
@@ -97,14 +102,14 @@ xg_select (int max_fds, SELECT_TYPE *rfds, SELECT_TYPE *wfds, SELECT_TYPE *efds,
if (our_tmo) tmop = &tmo;
}
- nfds = select (max_fds+1, &all_rfds, have_wfds ? &all_wfds : NULL,
- efds, tmop);
+ fds_lim = max_fds + 1;
+ nfds = select (fds_lim, &all_rfds, have_wfds ? &all_wfds : NULL, efds, tmop);
if (nfds < 0)
retval = nfds;
else if (nfds > 0)
{
- for (i = 0; i < max_fds+1; ++i)
+ for (i = 0; i < fds_lim; ++i)
{
if (FD_ISSET (i, &all_rfds))
{
diff --git a/src/xselect.c b/src/xselect.c
index 173cf78bdaa..15ce8d487fa 100644
--- a/src/xselect.c
+++ b/src/xselect.c
@@ -931,6 +931,7 @@ x_convert_selection (struct input_event *event, Lisp_Object selection_symbol,
/* Otherwise, record the converted selection to binary. */
cs = xmalloc (sizeof (struct selection_data));
+ cs->data = NULL;
cs->nofree = 1;
cs->property = property;
cs->wait_object = NULL;
diff --git a/src/xterm.c b/src/xterm.c
index 289bd6a8b71..e8fd26c36dc 100644
--- a/src/xterm.c
+++ b/src/xterm.c
@@ -10164,7 +10164,7 @@ x_term_init (Lisp_Object display_name, char *xrm_option, char *resource_name)
/* Set the name of the terminal. */
terminal->name = (char *) xmalloc (SBYTES (display_name) + 1);
- strncpy (terminal->name, SSDATA (display_name), SBYTES (display_name));
+ memcpy (terminal->name, SSDATA (display_name), SBYTES (display_name));
terminal->name[SBYTES (display_name)] = 0;
#if 0
diff --git a/src/xterm.h b/src/xterm.h
index 86daa7bd27e..89eb493a43c 100644
--- a/src/xterm.h
+++ b/src/xterm.h
@@ -1038,6 +1038,7 @@ extern void x_clipboard_manager_save_all (void);
extern struct x_display_info * check_x_display_info (Lisp_Object);
extern Lisp_Object x_get_focus_frame (struct frame *);
+extern int x_in_use;
#ifdef USE_GTK
extern int xg_set_icon (struct frame *, Lisp_Object);