diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/Makefile.in | 33 | ||||
| -rw-r--r-- | src/emacs.c | 35 | ||||
| -rw-r--r-- | src/font.c | 27 | ||||
| -rw-r--r-- | src/font.h | 6 | ||||
| -rw-r--r-- | src/fontset.c | 82 | ||||
| -rw-r--r-- | src/ftfont.c | 30 | ||||
| -rw-r--r-- | src/inotify.c | 9 | ||||
| -rw-r--r-- | src/keyboard.c | 30 | ||||
| -rw-r--r-- | src/kqueue.c | 520 | ||||
| -rw-r--r-- | src/lisp.h | 16 | ||||
| -rw-r--r-- | src/sysdep.c | 3 |
11 files changed, 715 insertions, 76 deletions
diff --git a/src/Makefile.in b/src/Makefile.in index 8357655af3b..97505b98687 100644 --- a/src/Makefile.in +++ b/src/Makefile.in @@ -160,12 +160,13 @@ SETTINGS_LIBS = @SETTINGS_LIBS@ ## gtkutil.o if USE_GTK, else empty. GTK_OBJ=@GTK_OBJ@ -## gfilenotify.o if HAVE_GFILENOTIFY. ## inotify.o if HAVE_INOTIFY. +## kqueue.o if HAVE_KQUEUE. +## gfilenotify.o if HAVE_GFILENOTIFY. ## w32notify.o if HAVE_W32NOTIFY. NOTIFY_OBJ = @NOTIFY_OBJ@ -GFILENOTIFY_CFLAGS = @GFILENOTIFY_CFLAGS@ -GFILENOTIFY_LIBS = @GFILENOTIFY_LIBS@ +NOTIFY_CFLAGS = @NOTIFY_CFLAGS@ +NOTIFY_LIBS = @NOTIFY_LIBS@ ## -ltermcap, or -lncurses, or -lcurses, or "". LIBS_TERMCAP=@LIBS_TERMCAP@ @@ -360,7 +361,7 @@ ALL_CFLAGS=-Demacs $(MYCPPFLAGS) -I. -I$(srcdir) \ $(XRANDR_CFLAGS) $(XINERAMA_CFLAGS) $(XFIXES_CFLAGS) \ $(SETTINGS_CFLAGS) $(FREETYPE_CFLAGS) $(FONTCONFIG_CFLAGS) \ $(LIBOTF_CFLAGS) $(M17N_FLT_CFLAGS) $(DEPFLAGS) \ - $(LIBGNUTLS_CFLAGS) $(GFILENOTIFY_CFLAGS) $(CAIRO_CFLAGS) \ + $(LIBGNUTLS_CFLAGS) $(NOTIFY_CFLAGS) $(CAIRO_CFLAGS) \ $(WARN_CFLAGS) $(WERROR_CFLAGS) $(CFLAGS) ALL_OBJC_CFLAGS=$(ALL_CFLAGS) $(GNU_OBJC_CFLAGS) @@ -473,7 +474,7 @@ LIBES = $(LIBS) $(W32_LIBS) $(LIBS_GNUSTEP) $(LIBX_BASE) $(LIBIMAGE) \ $(LIBS_TERMCAP) $(GETLOADAVG_LIBS) $(SETTINGS_LIBS) $(LIBSELINUX_LIBS) \ $(FREETYPE_LIBS) $(FONTCONFIG_LIBS) $(LIBOTF_LIBS) $(M17N_FLT_LIBS) \ $(LIBGNUTLS_LIBS) $(LIB_PTHREAD) \ - $(GFILENOTIFY_LIBS) $(LIB_MATH) $(LIBZ) $(LIBMODULES) + $(NOTIFY_LIBS) $(LIB_MATH) $(LIBZ) $(LIBMODULES) $(leimdir)/leim-list.el: bootstrap-emacs$(EXEEXT) $(MAKE) -C ../leim leim-list.el EMACS="$(bootstrap_exe)" @@ -648,32 +649,34 @@ extraclean: distclean -rm -f *~ \#* -ETAGS = ../lib-src/etags +ETAGS = ../lib-src/etags${EXEEXT} + +${ETAGS}: FORCE + ${MAKE} -C ../lib-src $(notdir $@) -ctagsfiles1 = [xyzXYZ]*.[hc] -ctagsfiles2 = [a-wA-W]*.[hc] -ctagsfiles3 = [a-zA-Z]*.m +ctagsfiles1 = $(wildcard ${srcdir}/*.[hc]) +ctagsfiles2 = $(wildcard ${srcdir}/*.m) ## FIXME? In out-of-tree builds, should TAGS be generated in srcdir? ## This does not need to depend on ../lisp and ../lwlib TAGS files, ## because etags "--include" only includes a pointer to the file, ## rather than the file contents. -TAGS: $(srcdir)/$(ctagsfiles1) $(srcdir)/$(ctagsfiles2) $(srcdir)/$(ctagsfiles3) - "$(ETAGS)" --include=../lisp/TAGS --include=$(lwlibdir)/TAGS \ +TAGS: ${ETAGS} $(ctagsfiles1) $(ctagsfiles2) + ${ETAGS} --include=../lisp/TAGS --include=$(lwlibdir)/TAGS \ --regex='{c}/[ ]*DEFVAR_[A-Z_ (]+"\([^"]+\)"/\1/' \ --regex='{c}/[ ]*DEFVAR_[A-Z_ (]+"[^"]+",[ ]\([A-Za-z0-9_]+\)/\1/' \ - $(srcdir)/$(ctagsfiles1) $(srcdir)/$(ctagsfiles2) \ + $(ctagsfiles1) \ --regex='{objc}/[ ]*DEFVAR_[A-Z_ (]+"\([^"]+\)"/\1/' \ --regex='{objc}/[ ]*DEFVAR_[A-Z_ (]+"[^"]+",[ ]\([A-Za-z0-9_]+\)/\1/' \ - $(srcdir)/$(ctagsfiles3) + $(ctagsfiles2) ## Arrange to make tags tables for ../lisp and ../lwlib, ## which the above TAGS file for the C files includes by reference. -../lisp/TAGS: +../lisp/TAGS: FORCE $(MAKE) -C ../lisp TAGS ETAGS="$(ETAGS)" -$(lwlibdir)/TAGS: +$(lwlibdir)/TAGS: FORCE $(MAKE) -C $(lwlibdir) TAGS ETAGS="$(ETAGS)" tags: TAGS ../lisp/TAGS $(lwlibdir)/TAGS diff --git a/src/emacs.c b/src/emacs.c index 48ff20a11ce..d13413d880b 100644 --- a/src/emacs.c +++ b/src/emacs.c @@ -370,17 +370,20 @@ terminate_due_to_signal (int sig, int backtrace_limit) { signal (sig, SIG_DFL); - /* If fatal error occurs in code below, avoid infinite recursion. */ - if (! fatal_error_in_progress) + if (attempt_orderly_shutdown_on_fatal_signal) { - fatal_error_in_progress = 1; + /* If fatal error occurs in code below, avoid infinite recursion. */ + if (! fatal_error_in_progress) + { + fatal_error_in_progress = 1; - totally_unblock_input (); - if (sig == SIGTERM || sig == SIGHUP || sig == SIGINT) - Fkill_emacs (make_number (sig)); + totally_unblock_input (); + if (sig == SIGTERM || sig == SIGHUP || sig == SIGINT) + Fkill_emacs (make_number (sig)); - shut_down_emacs (sig, Qnil); - emacs_backtrace (backtrace_limit); + shut_down_emacs (sig, Qnil); + emacs_backtrace (backtrace_limit); + } } /* Signal the same code; this time it will really be fatal. @@ -1357,6 +1360,10 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem tzset (); #endif /* MSDOS */ +#ifdef HAVE_KQUEUE + globals_of_kqueue (); +#endif + #ifdef HAVE_GFILENOTIFY globals_of_gfilenotify (); #endif @@ -1532,14 +1539,18 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem syms_of_gnutls (); -#ifdef HAVE_GFILENOTIFY - syms_of_gfilenotify (); -#endif /* HAVE_GFILENOTIFY */ - #ifdef HAVE_INOTIFY syms_of_inotify (); #endif /* HAVE_INOTIFY */ +#ifdef HAVE_KQUEUE + syms_of_kqueue (); +#endif /* HAVE_KQUEUE */ + +#ifdef HAVE_GFILENOTIFY + syms_of_gfilenotify (); +#endif /* HAVE_GFILENOTIFY */ + #ifdef HAVE_DBUS syms_of_dbusbind (); #endif /* HAVE_DBUS */ diff --git a/src/font.c b/src/font.c index 016b7e0a88e..6fa599524c9 100644 --- a/src/font.c +++ b/src/font.c @@ -4036,7 +4036,13 @@ The value of :otf is a cons (GSUB . GPOS) where GSUB and GPOS are lists representing the OpenType features supported by the font by this form: ((SCRIPT (LANGSYS FEATURE ...) ...) ...) SCRIPT, LANGSYS, and FEATURE are all symbols representing OpenType -Layout tags. */) +Layout tags. + +In addition to the keys listed abobe, the following keys are reserved +for the specific meanings as below: + +The value of :combining-capability is non-nil if the font-backend of +FONT supports rendering of combining characters for non-OTF fonts. */) (Lisp_Object font, Lisp_Object key) { int idx; @@ -4051,14 +4057,22 @@ Layout tags. */) if (idx >= 0 && idx < FONT_EXTRA_INDEX) return AREF (font, idx); val = Fassq (key, AREF (font, FONT_EXTRA_INDEX)); - if (NILP (val) && EQ (key, QCotf) && FONT_OBJECT_P (font)) + if (NILP (val) && FONT_OBJECT_P (font)) { struct font *fontp = XFONT_OBJECT (font); - if (fontp->driver->otf_capability) - val = fontp->driver->otf_capability (fontp); - else - val = Fcons (Qnil, Qnil); + if (EQ (key, QCotf)) + { + if (fontp->driver->otf_capability) + val = fontp->driver->otf_capability (fontp); + else + val = Fcons (Qnil, Qnil); + } + else if (EQ (key, QCcombining_capability)) + { + if (fontp->driver->combining_capability) + val = fontp->driver->combining_capability (fontp); + } } else val = Fcdr (val); @@ -5290,6 +5304,7 @@ syms_of_font (void) DEFSYM (QCscalable, ":scalable"); DEFSYM (QCavgwidth, ":avgwidth"); DEFSYM (QCfont_entity, ":font-entity"); + DEFSYM (QCcombining_capability, ":combining-capability"); /* Symbols representing values of font spacing property. */ DEFSYM (Qc, "c"); diff --git a/src/font.h b/src/font.h index 24c058dd88b..3f4ccb106c2 100644 --- a/src/font.h +++ b/src/font.h @@ -757,6 +757,12 @@ struct font_driver bool (*cached_font_ok) (struct frame *f, Lisp_Object font_object, Lisp_Object entity); + + /* Optional + + Return non-nil if the driver support rendering of combining + characters for FONT according to Unicode combining class. */ + Lisp_Object (*combining_capability) (struct font *font); }; diff --git a/src/fontset.c b/src/fontset.c index 9429d79b6b9..0f89b71ff68 100644 --- a/src/fontset.c +++ b/src/fontset.c @@ -63,17 +63,26 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ An element of a base fontset is a vector of FONT-DEFs which themselves are vectors of the form [ FONT-SPEC ENCODING REPERTORY ]. - An element of a realized fontset is nil, t, 0, or a vector of this - form: + An element of a realized fontset is nil, t, 0, or a cons that has + this from: - [ PREFERRED-RFONT-DEF RFONT-DEF0 RFONT-DEF1 ... ] + (CHARSET-ORDERED-LIST-TICK . FONT-GROUP) + + CHARSET_ORDERED_LIST_TICK is the same as charset_ordered_list_tick or -1. + + FONT-GROUP is a vector of elements that have this form: + + [ RFONT-DEF0 RFONT-DEF1 ... ] Each RFONT-DEFn (i.e. Realized FONT-DEF) has this form: [ FACE-ID FONT-DEF FONT-OBJECT SORTING-SCORE ] - RFONT-DEFn are automatically reordered by the current charset - priority list. + RFONT-DEFn are automatically reordered considering the current + charset priority list, the current language environment, and + priorities determined by font-backends. + + RFONT-DEFn may not be a vector in the following cases. The value nil means that we have not yet generated the above vector from the base of the fontset. @@ -83,7 +92,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ The value 0 means that no font is available for the corresponding range of characters in this fontset, but may be available in the - default fontset. + fallback font-group or in the default fontset. A fontset has 8 extra slots. @@ -407,6 +416,9 @@ reorder_font_vector (Lisp_Object font_group, struct font *font) if (! NILP (encoding)) { + /* This spec specifies an encoding by a charset set + name. Reflect the preference order of that charset + in the upper bits of SCORE. */ Lisp_Object tail; for (tail = Vcharset_ordered_list; @@ -419,6 +431,10 @@ reorder_font_vector (Lisp_Object font_group, struct font *font) } else { + /* This spec does not specify an encoding. If the spec + specifies a language, and the language is not for the + current language environment, make the score + larger. */ Lisp_Object lang = Ffont_get (font_spec, QClang); if (! NILP (lang) @@ -442,11 +458,11 @@ reorder_font_vector (Lisp_Object font_group, struct font *font) XSETCAR (font_group, make_number (low_tick_bits)); } -/* Return a font-group (actually a cons (-1 . FONT-GROUP-VECTOR)) for - character C in FONTSET. If C is -1, return a fallback font-group. - If C is not -1, the value may be Qt (FONTSET doesn't have a font - for C even in the fallback group), or 0 (a font for C may be found - only in the fallback group). */ +/* Return a font-group (actually a cons (CHARSET_ORDERED_LIST_TICK + . FONT-GROUP)) for character C or a fallback font-group in the + realized fontset FONTSET. The elements of FONT-GROUP are + RFONT-DEFs. The value may not be a cons. See the comment at the + head of this file for the detail of the return value. */ static Lisp_Object fontset_get_font_group (Lisp_Object fontset, int c) @@ -461,23 +477,37 @@ fontset_get_font_group (Lisp_Object fontset, int c) else font_group = FONTSET_FALLBACK (fontset); if (! NILP (font_group)) + /* We have already realized FONT-DEFs of this font group for C or + for fallback (FONT_GROUP is a cons), or we have already found + that no appropriate font was found (FONT_GROUP is t or 0). */ return font_group; base_fontset = FONTSET_BASE (fontset); if (NILP (base_fontset)) + /* Actually we never come here because FONTSET is a realized one, + and thus it should have a base. */ font_group = Qnil; else if (c >= 0) font_group = char_table_ref_and_range (base_fontset, c, &from, &to); else font_group = FONTSET_FALLBACK (base_fontset); + + /* FONT_GROUP not being a vector means that no fonts are specified + for C, or the fontset does not have fallback fonts. */ if (NILP (font_group)) { font_group = make_number (0); if (c >= 0) + /* Record that FONTSET does not specify fonts for C. As + there's a possiblity that a font is found in a fallback + font group, we set 0 at the moment. */ char_table_set_range (fontset, from, to, font_group); return font_group; } if (!VECTORP (font_group)) return font_group; + + /* Now realize FONT-DEFs of this font group, and update the realized + fontset FONTSET. */ font_group = Fcopy_sequence (font_group); for (i = 0; i < ASIZE (font_group); i++) if (! NILP (AREF (font_group, i))) @@ -498,21 +528,21 @@ fontset_get_font_group (Lisp_Object fontset, int c) } /* Return RFONT-DEF (vector) in the realized fontset FONTSET for the - character C. If no font is found, return Qnil if there's a + character C. If no font is found, return Qnil or 0 if there's a possibility that the default fontset or the fallback font groups have a proper font, and return Qt if not. If a font is found but is not yet opened, open it (if FACE is not NULL) or return Qnil (if FACE is NULL). - ID is a charset-id that must be preferred, or -1 meaning no + CHARSET_ID is a charset-id that must be preferred, or -1 meaning no preference. If FALLBACK, search only fallback fonts. */ static Lisp_Object -fontset_find_font (Lisp_Object fontset, int c, struct face *face, int id, - bool fallback) +fontset_find_font (Lisp_Object fontset, int c, struct face *face, + int charset_id, bool fallback) { Lisp_Object vec, font_group; int i, charset_matched = 0, found_index; @@ -534,8 +564,8 @@ fontset_find_font (Lisp_Object fontset, int c, struct face *face, int id, /* We have just created the font-group, or the charset priorities were changed. */ reorder_font_vector (font_group, face->ascii_face->font); - if (id >= 0) - /* Find a spec matching with the charset ID to try at + if (charset_id >= 0) + /* Find a spec matching with CHARSET_ID to try it at first. */ for (i = 0; i < ASIZE (vec); i++) { @@ -546,7 +576,7 @@ fontset_find_font (Lisp_Object fontset, int c, struct face *face, int id, break; repertory = FONT_DEF_REPERTORY (RFONT_DEF_FONT_DEF (rfont_def)); - if (XINT (repertory) == id) + if (XINT (repertory) == charset_id) { charset_matched = i; break; @@ -554,7 +584,9 @@ fontset_find_font (Lisp_Object fontset, int c, struct face *face, int id, } } - /* Find the first available font in the vector of RFONT-DEF. */ + /* Find the first available font in the vector of RFONT-DEF. If + CHARSET_MATCHED > 0, try the correspoing RFONT-DEF first, then + try the rest. */ for (i = 0; i < ASIZE (vec); i++) { Lisp_Object font_def; @@ -565,13 +597,13 @@ fontset_find_font (Lisp_Object fontset, int c, struct face *face, int id, { if (charset_matched > 0) { - /* Try the element matching with the charset ID at first. */ + /* Try the element matching with CHARSET_ID at first. */ found_index = charset_matched; /* Make this negative so that we don't come here in the next loop. */ charset_matched = - charset_matched; /* We must try the first element in the next loop. */ - i--; + i = -1; } } else if (i == - charset_matched) @@ -630,10 +662,10 @@ fontset_find_font (Lisp_Object fontset, int c, struct face *face, int id, if (NILP (font_object)) { /* Something strange happened, perhaps because of a - Font-backend problem. Too avoid crashing, record + Font-backend problem. To avoid crashing, record that this spec is unusable. It may be better to find another font of the same spec, but currently we don't - have such an API. */ + have such an API in font-backend. */ RFONT_DEF_SET_FACE (rfont_def, -1); continue; } @@ -693,6 +725,7 @@ fontset_find_font (Lisp_Object fontset, int c, struct face *face, int id, i = found_index; } + /* Record that no font in this font group supports C. */ FONTSET_SET (fontset, make_number (c), make_number (0)); return Qnil; @@ -711,6 +744,9 @@ fontset_find_font (Lisp_Object fontset, int c, struct face *face, int id, } +/* Return RFONT-DEF (vector) corresponding to the font for character + C. The value is not a vector if no font is found for C. */ + static Lisp_Object fontset_font (Lisp_Object fontset, int c, struct face *face, int id) { diff --git a/src/ftfont.c b/src/ftfont.c index 17e41a9339e..575bf53701c 100644 --- a/src/ftfont.c +++ b/src/ftfont.c @@ -30,6 +30,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ #include "dispextern.h" #include "character.h" #include "charset.h" +#include "category.h" #include "composite.h" #include "font.h" #include "ftfont.h" @@ -81,6 +82,8 @@ static Lisp_Object ftfont_lookup_cache (Lisp_Object, static void ftfont_filter_properties (Lisp_Object font, Lisp_Object alist); +static Lisp_Object ftfont_combining_capability (struct font *); + #define SYMBOL_FcChar8(SYM) (FcChar8 *) SDATA (SYMBOL_NAME (SYM)) static struct @@ -547,6 +550,10 @@ struct font_driver ftfont_driver = #endif ftfont_filter_properties, /* filter_properties */ + + NULL, /* cached_font_ok */ + + ftfont_combining_capability, }; static Lisp_Object @@ -2533,7 +2540,7 @@ ftfont_shape_by_flt (Lisp_Object lgstring, struct font *font, len = i; - if (with_variation_selector) + if (otf && with_variation_selector) { setup_otf_gstring (len); for (i = 0; i < len; i++) @@ -2583,14 +2590,19 @@ ftfont_shape_by_flt (Lisp_Object lgstring, struct font *font, flt_font_ft.otf = otf; flt_font_ft.matrix = matrix->xx != 0 ? matrix : 0; - if (1 < len) + if (1 < len || ! otf) { /* A little bit ad hoc. Perhaps, shaper must get script and language information, and select a proper flt for them here. */ int c1 = LGLYPH_CHAR (LGSTRING_GLYPH (lgstring, 1)); - if (0x300 <= c1 && c1 <= 0x36F) + if (CHAR_HAS_CATEGORY (c1, '^')) flt = mflt_get (msymbol ("combining")); + else if (! otf) + flt = mflt_find (LGLYPH_CHAR (LGSTRING_GLYPH (lgstring, 0)), + &flt_font_ft.flt_font); + if (! flt) + return make_number (0); } MFLTGlyphFT *glyphs = (MFLTGlyphFT *) gstring.glyphs; @@ -2675,8 +2687,6 @@ ftfont_shape (Lisp_Object lgstring) struct ftfont_info *ftfont_info = (struct ftfont_info *) font; OTF *otf = ftfont_get_otf (ftfont_info); - if (! otf) - return make_number (0); return ftfont_shape_by_flt (lgstring, font, ftfont_info->ft_size->face, otf, &ftfont_info->matrix); } @@ -2750,6 +2760,16 @@ ftfont_filter_properties (Lisp_Object font, Lisp_Object alist) } +static Lisp_Object +ftfont_combining_capability (struct font *font) +{ +#ifdef HAVE_M17N_FLT + return Qt; +#else + return Qnil; +#endif +} + void syms_of_ftfont (void) { diff --git a/src/inotify.c b/src/inotify.c index d1a80bbad1b..6577ee28cd1 100644 --- a/src/inotify.c +++ b/src/inotify.c @@ -46,8 +46,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ static int inotifyfd = -1; /* Assoc list of files being watched. - Format: - (watch-descriptor . callback) + Format: (watch-descriptor name callback) */ static Lisp_Object watch_list; @@ -106,12 +105,14 @@ inotifyevent_to_event (Lisp_Object watch_object, struct inotify_event const *ev) name = make_unibyte_string (ev->name, min (len, ev->len)); name = DECODE_FILE (name); } + else + name = XCAR (XCDR (watch_object)); return list2 (list4 (make_watch_descriptor (ev->wd), mask_to_aspects (ev->mask), name, make_number (ev->cookie)), - XCDR (watch_object)); + Fnth (make_number (2), watch_object)); } /* This callback is called when the FD is available for read. The inotify @@ -325,7 +326,7 @@ is managed internally and there is no corresponding inotify_init. Use watch_list = Fdelete (watch_object, watch_list); /* Store watch object in watch list. */ - watch_object = Fcons (watch_descriptor, callback); + watch_object = list3 (watch_descriptor, encoded_file_name, callback); watch_list = Fcons (watch_object, watch_list); return watch_descriptor; diff --git a/src/keyboard.c b/src/keyboard.c index 2438e69364f..8be1cd5c0fb 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -1234,6 +1234,9 @@ static void adjust_point_for_property (ptrdiff_t, bool); Lisp_Object command_loop_1 (void) { + Lisp_Object cmd; + Lisp_Object keybuf[30]; + int i; EMACS_INT prev_modiff = 0; struct buffer *prev_buffer = NULL; bool already_adjusted = 0; @@ -1277,10 +1280,6 @@ command_loop_1 (void) while (1) { - Lisp_Object cmd; - Lisp_Object keybuf[30]; - int i; - if (! FRAME_LIVE_P (XFRAME (selected_frame))) Fkill_emacs (Qnil); @@ -5948,12 +5947,12 @@ make_lispy_event (struct input_event *event) } #endif /* HAVE_DBUS */ -#if defined HAVE_GFILENOTIFY || defined HAVE_INOTIFY +#if defined HAVE_INOTIFY || defined HAVE_KQUEUE || defined HAVE_GFILENOTIFY case FILE_NOTIFY_EVENT: { return Fcons (Qfile_notify, event->arg); } -#endif /* defined HAVE_GFILENOTIFY || defined HAVE_INOTIFY */ +#endif /* HAVE_INOTIFY || HAVE_KQUEUE || HAVE_GFILENOTIFY */ case CONFIG_CHANGED_EVENT: return list3 (Qconfig_changed_event, @@ -11665,6 +11664,25 @@ Currently, the only supported values for this variable are `sigusr1' and `sigusr2'. */); Vdebug_on_event = intern_c_string ("sigusr2"); + DEFVAR_BOOL ("attempt-stack-overflow-recovery", + attempt_stack_overflow_recovery, + doc: /* If non-nil, attempt to recover from C stack +overflow. This recovery is unsafe and may lead to deadlocks or data +corruption, but it usually works and may preserve modified buffers +that would otherwise be lost. If nil, treat stack overflow like any +other kind of crash. */); + attempt_stack_overflow_recovery = true; + + DEFVAR_BOOL ("attempt-orderly-shutdown-on-fatal-signal", + attempt_orderly_shutdown_on_fatal_signal, + doc: /* If non-nil, attempt to perform an orderly +shutdown when Emacs receives a fatal signal (e.g., a crash). +This cleanup is unsafe and may lead to deadlocks or data corruption, +but it usually works and may preserve modified buffers that would +otherwise be lost. If nil, crash immediately in response to fatal +signals. */); + attempt_orderly_shutdown_on_fatal_signal = true; + /* Create the initial keyboard. Qt means 'unset'. */ initial_kboard = allocate_kboard (Qt); } diff --git a/src/kqueue.c b/src/kqueue.c new file mode 100644 index 00000000000..e0ee5fb9d7b --- /dev/null +++ b/src/kqueue.c @@ -0,0 +1,520 @@ +/* Filesystem notifications support with kqueue API. + Copyright (C) 2015 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/>. */ + +#include <config.h> + +#ifdef HAVE_KQUEUE +#include <stdio.h> +#include <sys/types.h> +#include <sys/event.h> +#include <sys/time.h> +#include <sys/file.h> +#include "lisp.h" +#include "keyboard.h" +#include "process.h" + + +/* File handle for kqueue. */ +static int kqueuefd = -1; + +/* This is a list, elements are (DESCRIPTOR FILE FLAGS CALLBACK [DIRLIST]). */ +static Lisp_Object watch_list; + +/* Generate a list from the directory_files_internal output. + Items are (INODE FILE-NAME LAST-MOD LAST-STATUS-MOD SIZE). */ +Lisp_Object +kqueue_directory_listing (Lisp_Object directory_files) +{ + Lisp_Object dl, result = Qnil; + + for (dl = directory_files; ! NILP (dl); dl = XCDR (dl)) { + /* We ignore "." and "..". */ + if ((strcmp (".", SSDATA (XCAR (XCAR (dl)))) == 0) || + (strcmp ("..", SSDATA (XCAR (XCAR (dl)))) == 0)) + continue; + + result = Fcons + (list5 (/* inode. */ + Fnth (make_number (11), XCAR (dl)), + /* filename. */ + XCAR (XCAR (dl)), + /* last modification time. */ + Fnth (make_number (6), XCAR (dl)), + /* last status change time. */ + Fnth (make_number (7), XCAR (dl)), + /* size. */ + Fnth (make_number (8), XCAR (dl))), + result); + } + return result; +} + +/* Generate a file notification event. */ +static void +kqueue_generate_event +(Lisp_Object watch_object, Lisp_Object actions, + Lisp_Object file, Lisp_Object file1) +{ + Lisp_Object flags, action, entry; + struct input_event event; + + /* Check, whether all actions shall be monitored. */ + flags = Fnth (make_number (2), watch_object); + action = actions; + do { + if (NILP (action)) + break; + entry = XCAR (action); + if (NILP (Fmember (entry, flags))) { + action = XCDR (action); + actions = Fdelq (entry, actions); + } else + action = XCDR (action); + } while (1); + + /* Store it into the input event queue. */ + if (! NILP (actions)) { + EVENT_INIT (event); + event.kind = FILE_NOTIFY_EVENT; + event.frame_or_window = Qnil; + event.arg = list2 (Fcons (XCAR (watch_object), + Fcons (actions, + NILP (file1) + ? Fcons (file, Qnil) + : list2 (file, file1))), + Fnth (make_number (3), watch_object)); + kbd_buffer_store_event (&event); + } +} + +/* This compares two directory listings in case of a `write' event for + a directory. Generate resulting file notification events. The old + directory listing is retrieved from watch_object, it will be + replaced by the new directory listing at the end of this + function. */ +static void +kqueue_compare_dir_list +(Lisp_Object watch_object) +{ + Lisp_Object dir, pending_dl, deleted_dl; + Lisp_Object old_directory_files, old_dl, new_directory_files, new_dl, dl; + + dir = XCAR (XCDR (watch_object)); + pending_dl = Qnil; + deleted_dl = Qnil; + + old_directory_files = Fnth (make_number (4), watch_object); + old_dl = kqueue_directory_listing (old_directory_files); + + /* When the directory is not accessible anymore, it has been deleted. */ + if (NILP (Ffile_directory_p (dir))) { + kqueue_generate_event (watch_object, Fcons (Qdelete, Qnil), dir, Qnil); + return; + } + new_directory_files = + directory_files_internal (dir, Qnil, Qnil, Qnil, 1, Qnil); + new_dl = kqueue_directory_listing (new_directory_files); + + /* Parse through the old list. */ + dl = old_dl; + while (1) { + Lisp_Object old_entry, new_entry, dl1; + if (NILP (dl)) + break; + + /* Search for an entry with the same inode. */ + old_entry = XCAR (dl); + new_entry = assq_no_quit (XCAR (old_entry), new_dl); + if (! NILP (Fequal (old_entry, new_entry))) { + /* Both entries are identical. Nothing to do. */ + new_dl = Fdelq (new_entry, new_dl); + goto the_end; + } + + /* Both entries have the same inode. */ + if (! NILP (new_entry)) { + /* Both entries have the same file name. */ + if (strcmp (SSDATA (XCAR (XCDR (old_entry))), + SSDATA (XCAR (XCDR (new_entry)))) == 0) { + /* Modification time has been changed, the file has been written. */ + if (NILP (Fequal (Fnth (make_number (2), old_entry), + Fnth (make_number (2), new_entry)))) + kqueue_generate_event + (watch_object, Fcons (Qwrite, Qnil), XCAR (XCDR (old_entry)), Qnil); + /* Status change time has been changed, the file attributes + have changed. */ + if (NILP (Fequal (Fnth (make_number (3), old_entry), + Fnth (make_number (3), new_entry)))) + kqueue_generate_event + (watch_object, Fcons (Qattrib, Qnil), + XCAR (XCDR (old_entry)), Qnil); + + } else { + /* The file has been renamed. */ + kqueue_generate_event + (watch_object, Fcons (Qrename, Qnil), + XCAR (XCDR (old_entry)), XCAR (XCDR (new_entry))); + deleted_dl = Fcons (new_entry, deleted_dl); + } + new_dl = Fdelq (new_entry, new_dl); + goto the_end; + } + + /* Search, whether there is a file with the same name but another + inode. */ + for (dl1 = new_dl; ! NILP (dl1); dl1 = XCDR (dl1)) { + new_entry = XCAR (dl1); + if (strcmp (SSDATA (XCAR (XCDR (old_entry))), + SSDATA (XCAR (XCDR (new_entry)))) == 0) { + pending_dl = Fcons (new_entry, pending_dl); + new_dl = Fdelq (new_entry, new_dl); + goto the_end; + } + } + + /* Check, whether this a pending file. */ + new_entry = assq_no_quit (XCAR (old_entry), pending_dl); + + if (NILP (new_entry)) { + /* Check, whether this is an already deleted file (by rename). */ + for (dl1 = deleted_dl; ! NILP (dl1); dl1 = XCDR (dl1)) { + new_entry = XCAR (dl1); + if (strcmp (SSDATA (XCAR (XCDR (old_entry))), + SSDATA (XCAR (XCDR (new_entry)))) == 0) { + deleted_dl = Fdelq (new_entry, deleted_dl); + goto the_end; + } + } + /* The file has been deleted. */ + kqueue_generate_event + (watch_object, Fcons (Qdelete, Qnil), XCAR (XCDR (old_entry)), Qnil); + + } else { + /* The file has been renamed. */ + kqueue_generate_event + (watch_object, Fcons (Qrename, Qnil), + XCAR (XCDR (old_entry)), XCAR (XCDR (new_entry))); + pending_dl = Fdelq (new_entry, pending_dl); + } + + the_end: + dl = XCDR (dl); + old_dl = Fdelq (old_entry, old_dl); + } + + /* Parse through the resulting new list. */ + dl = new_dl; + while (1) { + Lisp_Object entry; + if (NILP (dl)) + break; + + /* A new file has appeared. */ + entry = XCAR (dl); + kqueue_generate_event + (watch_object, Fcons (Qcreate, Qnil), XCAR (XCDR (entry)), Qnil); + + /* Check size of that file. */ + Lisp_Object size = Fnth (make_number (4), entry); + if (FLOATP (size) || (XINT (size) > 0)) + kqueue_generate_event + (watch_object, Fcons (Qwrite, Qnil), XCAR (XCDR (entry)), Qnil); + + dl = XCDR (dl); + new_dl = Fdelq (entry, new_dl); + } + + /* Parse through the resulting pending_dl list. */ + dl = pending_dl; + while (1) { + Lisp_Object entry; + if (NILP (dl)) + break; + + /* A file is still pending. Assume it was a write. */ + entry = XCAR (dl); + kqueue_generate_event + (watch_object, Fcons (Qwrite, Qnil), XCAR (XCDR (entry)), Qnil); + + dl = XCDR (dl); + pending_dl = Fdelq (entry, pending_dl); + } + + /* At this point, old_dl, new_dl and pending_dl shall be empty. + deleted_dl might not be empty when there was a rename to a + nonexistent file. Let's make a check for this (might be removed + once the code is stable). */ + if (! NILP (old_dl)) + report_file_error ("Old list not empty", old_dl); + if (! NILP (new_dl)) + report_file_error ("New list not empty", new_dl); + if (! NILP (pending_dl)) + report_file_error ("Pending events list not empty", pending_dl); + // if (! NILP (deleted_dl)) + // report_file_error ("Deleted events list not empty", deleted_dl); + + /* Replace old directory listing with the new one. */ + XSETCDR (Fnthcdr (make_number (3), watch_object), + Fcons (new_directory_files, Qnil)); + return; +} + +/* This is the callback function for arriving input on kqueuefd. It + shall create a Lisp event, and put it into the Emacs input queue. */ +static void +kqueue_callback (int fd, void *data) +{ + for (;;) { + struct kevent kev; + static const struct timespec nullts = { 0, 0 }; + Lisp_Object descriptor, watch_object, file, actions; + + /* Read one event. */ + int ret = kevent (kqueuefd, NULL, 0, &kev, 1, &nullts); + if (ret < 1) { + /* All events read. */ + return; + } + + /* Determine descriptor and file name. */ + descriptor = make_number (kev.ident); + watch_object = assq_no_quit (descriptor, watch_list); + if (CONSP (watch_object)) + file = XCAR (XCDR (watch_object)); + else + continue; + + /* Determine event actions. */ + actions = Qnil; + if (kev.fflags & NOTE_DELETE) + actions = Fcons (Qdelete, actions); + if (kev.fflags & NOTE_WRITE) { + /* Check, whether this is a directory event. */ + if (NILP (Fnth (make_number (4), watch_object))) + actions = Fcons (Qwrite, actions); + else + kqueue_compare_dir_list (watch_object); + } + if (kev.fflags & NOTE_EXTEND) + actions = Fcons (Qextend, actions); + if (kev.fflags & NOTE_ATTRIB) + actions = Fcons (Qattrib, actions); + if (kev.fflags & NOTE_LINK) + actions = Fcons (Qlink, actions); + /* It would be useful to know the target of the rename operation. + At this point, it is not possible. Happens only when the upper + directory is monitored. */ + if (kev.fflags & NOTE_RENAME) + actions = Fcons (Qrename, actions); + + /* Create the event. */ + if (! NILP (actions)) + kqueue_generate_event (watch_object, actions, file, Qnil); + + /* Cancel monitor if file or directory is deleted or renamed. */ + if (kev.fflags & (NOTE_DELETE | NOTE_RENAME)) + Fkqueue_rm_watch (descriptor); + } + return; +} + +DEFUN ("kqueue-add-watch", Fkqueue_add_watch, Skqueue_add_watch, 3, 3, 0, + doc: /* Add a watch for filesystem events pertaining to FILE. + +This arranges for filesystem events pertaining to FILE to be reported +to Emacs. Use `kqueue-rm-watch' to cancel the watch. + +Returned value is a descriptor for the added watch. If the file cannot be +watched for some reason, this function signals a `file-notify-error' error. + +FLAGS is a list of events to be watched for. It can include the +following symbols: + + `create' -- FILE was created + `delete' -- FILE was deleted + `write' -- FILE has changed + `extend' -- FILE was extended + `attrib' -- a FILE attribute was changed + `link' -- a FILE's link count was changed + `rename' -- FILE was moved to FILE1 + +When any event happens, Emacs will call the CALLBACK function passing +it a single argument EVENT, which is of the form + + (DESCRIPTOR ACTIONS FILE [FILE1]) + +DESCRIPTOR is the same object as the one returned by this function. +ACTIONS is a list of events. + +FILE is the name of the file whose event is being reported. FILE1 +will be reported only in case of the `rename' event. This is possible +only when the upper directory of the renamed file is watched. */) + (Lisp_Object file, Lisp_Object flags, Lisp_Object callback) +{ + Lisp_Object watch_object, dir_list; + int fd, oflags; + u_short fflags = 0; + struct kevent kev; + + /* Check parameters. */ + CHECK_STRING (file); + file = Fdirectory_file_name (Fexpand_file_name (file, Qnil)); + if (NILP (Ffile_exists_p (file))) + report_file_error ("File does not exist", file); + + CHECK_LIST (flags); + + if (! FUNCTIONP (callback)) + wrong_type_argument (Qinvalid_function, callback); + + if (kqueuefd < 0) + { + /* Create kqueue descriptor. */ + kqueuefd = kqueue (); + if (kqueuefd < 0) + report_file_notify_error ("File watching is not available", Qnil); + + /* Start monitoring for possible I/O. */ + add_read_fd (kqueuefd, kqueue_callback, NULL); + + watch_list = Qnil; + } + + /* Open file. */ + file = ENCODE_FILE (file); + oflags = O_NONBLOCK; +#if O_EVTONLY + oflags |= O_EVTONLY; +#else + oflags |= O_RDONLY; +#endif +#if O_SYMLINK + oflags |= O_SYMLINK; +#else + oflags |= O_NOFOLLOW; +#endif + fd = emacs_open (SSDATA (file), oflags, 0); + if (fd == -1) + report_file_error ("File cannot be opened", file); + + /* Assemble filter flags */ + if (! NILP (Fmember (Qdelete, flags))) fflags |= NOTE_DELETE; + if (! NILP (Fmember (Qwrite, flags))) fflags |= NOTE_WRITE; + if (! NILP (Fmember (Qextend, flags))) fflags |= NOTE_EXTEND; + if (! NILP (Fmember (Qattrib, flags))) fflags |= NOTE_ATTRIB; + if (! NILP (Fmember (Qlink, flags))) fflags |= NOTE_LINK; + if (! NILP (Fmember (Qrename, flags))) fflags |= NOTE_RENAME; + + /* Register event. */ + EV_SET (&kev, fd, EVFILT_VNODE, EV_ADD | EV_ENABLE | EV_CLEAR, + fflags, 0, NULL); + + if (kevent (kqueuefd, &kev, 1, NULL, 0, NULL) < 0) { + emacs_close (fd); + report_file_error ("Cannot watch file", file); + } + + /* Store watch object in watch list. */ + Lisp_Object watch_descriptor = make_number (fd); + if (NILP (Ffile_directory_p (file))) + watch_object = list4 (watch_descriptor, file, flags, callback); + else { + dir_list = directory_files_internal (file, Qnil, Qnil, Qnil, 1, Qnil); + watch_object = list5 (watch_descriptor, file, flags, callback, dir_list); + } + watch_list = Fcons (watch_object, watch_list); + + return watch_descriptor; +} + +DEFUN ("kqueue-rm-watch", Fkqueue_rm_watch, Skqueue_rm_watch, 1, 1, 0, + doc: /* Remove an existing WATCH-DESCRIPTOR. + +WATCH-DESCRIPTOR should be an object returned by `kqueue-add-watch'. */) + (Lisp_Object watch_descriptor) +{ + Lisp_Object watch_object = assq_no_quit (watch_descriptor, watch_list); + + if (! CONSP (watch_object)) + xsignal2 (Qfile_notify_error, build_string ("Not a watch descriptor"), + watch_descriptor); + + eassert (INTEGERP (watch_descriptor)); + int fd = XINT (watch_descriptor); + if ( fd >= 0) + emacs_close (fd); + + /* Remove watch descriptor from watch list. */ + watch_list = Fdelq (watch_object, watch_list); + + if (NILP (watch_list) && (kqueuefd >= 0)) { + delete_read_fd (kqueuefd); + emacs_close (kqueuefd); + kqueuefd = -1; + } + + return Qt; +} + +DEFUN ("kqueue-valid-p", Fkqueue_valid_p, Skqueue_valid_p, 1, 1, 0, + doc: /* "Check a watch specified by its WATCH-DESCRIPTOR. + +WATCH-DESCRIPTOR should be an object returned by `kqueue-add-watch'. + +A watch can become invalid if the file or directory it watches is +deleted, or if the watcher thread exits abnormally for any other +reason. Removing the watch by calling `kqueue-rm-watch' also makes it +invalid. */) + (Lisp_Object watch_descriptor) +{ + return NILP (assq_no_quit (watch_descriptor, watch_list)) ? Qnil : Qt; +} + + +void +globals_of_kqueue (void) +{ + watch_list = Qnil; +} + +void +syms_of_kqueue (void) +{ + defsubr (&Skqueue_add_watch); + defsubr (&Skqueue_rm_watch); + defsubr (&Skqueue_valid_p); + + /* Event types. */ + DEFSYM (Qcreate, "create"); + DEFSYM (Qdelete, "delete"); /* NOTE_DELETE */ + DEFSYM (Qwrite, "write"); /* NOTE_WRITE */ + DEFSYM (Qextend, "extend"); /* NOTE_EXTEND */ + DEFSYM (Qattrib, "attrib"); /* NOTE_ATTRIB */ + DEFSYM (Qlink, "link"); /* NOTE_LINK */ + DEFSYM (Qrename, "rename"); /* NOTE_RENAME */ + + staticpro (&watch_list); + + Fprovide (intern_c_string ("kqueue"), Qnil); +} + +#endif /* HAVE_KQUEUE */ + +/* PROBLEMS + * https://bugs.launchpad.net/ubuntu/+source/libkqueue/+bug/1514837 + prevents tests on Ubuntu. */ diff --git a/src/lisp.h b/src/lisp.h index 477521bbf4e..ce05b4dee49 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -4313,17 +4313,23 @@ extern void init_font (void); extern void syms_of_fontset (void); #endif +/* Defined in inotify.c */ +#ifdef HAVE_INOTIFY +extern void syms_of_inotify (void); +#endif + +/* Defined in kqueue.c */ +#ifdef HAVE_KQUEUE +extern void globals_of_kqueue (void); +extern void syms_of_kqueue (void); +#endif + /* Defined in gfilenotify.c */ #ifdef HAVE_GFILENOTIFY extern void globals_of_gfilenotify (void); extern void syms_of_gfilenotify (void); #endif -/* Defined in inotify.c */ -#ifdef HAVE_INOTIFY -extern void syms_of_inotify (void); -#endif - #ifdef HAVE_W32NOTIFY /* Defined on w32notify.c. */ extern void syms_of_w32notify (void); diff --git a/src/sysdep.c b/src/sysdep.c index 1af323eb8d6..a29155c144a 100644 --- a/src/sysdep.c +++ b/src/sysdep.c @@ -1622,6 +1622,9 @@ static unsigned char sigsegv_stack[SIGSTKSZ]; static bool stack_overflow (siginfo_t *siginfo) { + if (!attempt_stack_overflow_recovery) + return false; + /* In theory, a more-accurate heuristic can be obtained by using GNU/Linux pthread_getattr_np along with POSIX pthread_attr_getstack and pthread_attr_getguardsize to find the location and size of the |