commit 6f334b6bc0f0c343bbf34c3fee0848aadb5d1d84 (HEAD, refs/remotes/origin/master) Author: Stefan Monnier Date: Fri Apr 19 23:50:58 2019 -0400 * lisp/emacs-lisp/smie.el (smie-indent-comment-continue): Single-char case. Make it so the comment-continue is aligned with the comment-start when comment-start is a single-char. diff --git a/lisp/emacs-lisp/smie.el b/lisp/emacs-lisp/smie.el index e0293c3cbb..f2163b243e 100644 --- a/lisp/emacs-lisp/smie.el +++ b/lisp/emacs-lisp/smie.el @@ -1648,11 +1648,33 @@ should not be computed on the basis of the following token." (let ((ppss (syntax-ppss))) (save-excursion (forward-line -1) - (if (<= (point) (nth 8 ppss)) - (progn (goto-char (1+ (nth 8 ppss))) (current-column)) - (skip-chars-forward " \t") - (if (looking-at (regexp-quote continue)) - (current-column)))))))) + (let ((start (nth 8 ppss))) + (if (<= (point) start) + (progn + (goto-char start) + (if (not (and comment-start-skip + (looking-at comment-start-skip))) + (forward-char 1) + (goto-char (match-end 0)) + (skip-chars-backward " \t") + ;; Try to align the first char of the comment-continue + ;; with the second char of the comment-start or the + ;; first char if the comment-start is made of + ;; a single char. E.g. + ;; + ;; /* foo + ;; * bar */ + ;; + ;; but + ;; + ;; { foo + ;; | bar } + (goto-char (if (eq (point) (1+ start)) + start (1+ start)))) + (current-column)) + (skip-chars-forward " \t") + (if (looking-at (regexp-quote continue)) + (current-column))))))))) (defun smie-indent-comment-close () (and (boundp 'comment-end-skip) commit 4ff6c657a206a9c5ff6f3cda26996fda00e7598d Author: YAMAMOTO Mitsuharu Date: Sat Apr 20 12:50:32 2019 +0900 * src/ftcrfont.c (ftcrfont_shape): Fix last change. diff --git a/src/ftcrfont.c b/src/ftcrfont.c index e341c409b1..8a1c9a48e1 100644 --- a/src/ftcrfont.c +++ b/src/ftcrfont.c @@ -25,6 +25,7 @@ along with GNU Emacs. If not, see . */ #include "lisp.h" #include "xterm.h" #include "blockinput.h" +#include "composite.h" #include "font.h" #include "ftfont.h" #include "pdumper.h" @@ -291,6 +292,7 @@ static Lisp_Object ftcrfont_shape (Lisp_Object lgstring) { #if defined HAVE_M17N_FLT && defined HAVE_LIBOTF + struct font *font = CHECK_FONT_GET_OBJECT (LGSTRING_FONT (lgstring)); struct font_info *ftcrfont_info = (struct font_info *) font; if (ftcrfont_info->bitmap_strike_index < 0) commit d1dde7d04e5244179735592adc11d2a6f0af64ac Author: YAMAMOTO Mitsuharu Date: Sat Apr 20 12:43:45 2019 +0900 Use bitmap strikes as fallbacks for ftcr font backend * src/ftfont.h (struct font_info): New member bitmap_strike_index. * src/ftfont.c (ftfont_open2): Try bitmap strikes as fallbacks. (ftfont_open): Discard bitmap strikes. * src/ftcrfont.c (ftcrfont_open): Recalculate metrics for bitmap strikes. (ftcrfont_get_bitmap, ftcrfont_anchor_point, ftcrfont_shape): New functions. (struct font_driver): Use them. diff --git a/src/ftcrfont.c b/src/ftcrfont.c index 4845ee4cf3..e341c409b1 100644 --- a/src/ftcrfont.c +++ b/src/ftcrfont.c @@ -135,7 +135,10 @@ ftcrfont_open (struct frame *f, Lisp_Object entity, int pixel_size) font->driver = &ftcrfont_driver; FT_New_Size (ft_face, &ftcrfont_info->ft_size_draw); FT_Activate_Size (ftcrfont_info->ft_size_draw); - FT_Set_Pixel_Sizes (ft_face, 0, font->pixel_size); + if (ftcrfont_info->bitmap_strike_index < 0) + FT_Set_Pixel_Sizes (ft_face, 0, font->pixel_size); + else + FT_Select_Size (ft_face, ftcrfont_info->bitmap_strike_index); cairo_font_face_t *font_face = cairo_ft_font_face_create_for_ft_face (ft_face, 0); cairo_matrix_t font_matrix, ctm; @@ -148,6 +151,56 @@ ftcrfont_open (struct frame *f, Lisp_Object entity, int pixel_size) cairo_font_options_destroy (options); ftcrfont_info->metrics = NULL; ftcrfont_info->metrics_nrows = 0; + if (ftcrfont_info->bitmap_strike_index >= 0) + { + /* Several members of struct font/font_info set by + ftfont_open2 are bogus. Recalculate them with cairo + scaled font functions. */ + cairo_font_extents_t extents; + cairo_scaled_font_extents (ftcrfont_info->cr_scaled_font, &extents); + font->ascent = lround (extents.ascent); + font->descent = lround (extents.descent); + font->height = lround (extents.height); + + cairo_glyph_t stack_glyph; + int n = 0; + font->min_width = font->average_width = font->space_width = 0; + for (char c = 32; c < 127; c++) + { + cairo_glyph_t *glyphs = &stack_glyph; + int num_glyphs = 1; + cairo_status_t status = + cairo_scaled_font_text_to_glyphs (ftcrfont_info->cr_scaled_font, + 0, 0, &c, 1, + &glyphs, &num_glyphs, + NULL, NULL, NULL); + + if (status == CAIRO_STATUS_SUCCESS) + { + if (glyphs != &stack_glyph) + cairo_glyph_free (glyphs); + else + { + int this_width = + ftcrfont_glyph_extents (font, stack_glyph.index, NULL); + + if (this_width > 0 + && (! font->min_width + || font->min_width > this_width)) + font->min_width = this_width; + if (c == 32) + font->space_width = this_width; + font->average_width += this_width; + n++; + } + } + } + if (n > 0) + font->average_width /= n; + + font->underline_position = -1; + font->underline_thickness = 0; + } } unblock_input (); @@ -210,6 +263,43 @@ ftcrfont_text_extents (struct font *font, metrics->width = width; } +static int +ftcrfont_get_bitmap (struct font *font, unsigned int code, + struct font_bitmap *bitmap, int bits_per_pixel) +{ + struct font_info *ftcrfont_info = (struct font_info *) font; + + if (ftcrfont_info->bitmap_strike_index < 0) + return ftfont_get_bitmap (font, code, bitmap, bits_per_pixel); + + return -1; +} + +static int +ftcrfont_anchor_point (struct font *font, unsigned int code, int idx, + int *x, int *y) +{ + struct font_info *ftcrfont_info = (struct font_info *) font; + + if (ftcrfont_info->bitmap_strike_index < 0) + return ftfont_anchor_point (font, code, idx, x, y); + + return -1; +} + +static Lisp_Object +ftcrfont_shape (Lisp_Object lgstring) +{ +#if defined HAVE_M17N_FLT && defined HAVE_LIBOTF + struct font_info *ftcrfont_info = (struct font_info *) font; + + if (ftcrfont_info->bitmap_strike_index < 0) + return ftfont_shape (lgstring); +#endif + + return make_fixnum (0); +} + static int ftcrfont_draw (struct glyph_string *s, int from, int to, int x, int y, bool with_background) @@ -286,14 +376,12 @@ struct font_driver const ftcrfont_driver = .encode_char = ftfont_encode_char, .text_extents = ftcrfont_text_extents, .draw = ftcrfont_draw, - .get_bitmap = ftfont_get_bitmap, - .anchor_point = ftfont_anchor_point, + .get_bitmap = ftcrfont_get_bitmap, + .anchor_point = ftcrfont_anchor_point, #ifdef HAVE_LIBOTF .otf_capability = ftfont_otf_capability, #endif -#if defined HAVE_M17N_FLT && defined HAVE_LIBOTF - .shape = ftfont_shape, -#endif + .shape = ftcrfont_shape, #ifdef HAVE_OTF_GET_VARIATION_GLYPHS .get_variation_glyphs = ftfont_variation_glyphs, #endif diff --git a/src/ftfont.c b/src/ftfont.c index 3e820f583f..d0078a3770 100644 --- a/src/ftfont.c +++ b/src/ftfont.c @@ -1097,6 +1097,7 @@ ftfont_open2 (struct frame *f, int spacing; int i; double upEM; + FT_Int strike_index = -1; val = assq_no_quit (QCfont_entity, AREF (entity, FONT_EXTRA_INDEX)); if (! CONSP (val)) @@ -1126,12 +1127,32 @@ ftfont_open2 (struct frame *f, size = pixel_size; if (FT_Set_Pixel_Sizes (ft_face, size, size) != 0) { - if (cache_data->face_refcount == 0) + int min_distance = INT_MAX; + bool magnify = true; + + for (FT_Int i = 0; i < ft_face->num_fixed_sizes; i++) { - FT_Done_Face (ft_face); - cache_data->ft_face = NULL; + int distance = ft_face->available_sizes[i].height - (int) size; + + /* Prefer down-scaling to upscaling. */ + if (magnify == (distance < 0) ? abs (distance) <= min_distance + : magnify) + { + magnify = distance < 0; + min_distance = abs (distance); + strike_index = i; + } + } + + if (strike_index < 0 || FT_Select_Size (ft_face, strike_index) != 0) + { + if (cache_data->face_refcount == 0) + { + FT_Done_Face (ft_face); + cache_data->ft_face = NULL; + } + return Qnil; } - return Qnil; } cache_data->face_refcount++; @@ -1144,6 +1165,7 @@ ftfont_open2 (struct frame *f, ftfont_info->maybe_otf = (ft_face->face_flags & FT_FACE_FLAG_SFNT) != 0; ftfont_info->otf = NULL; #endif /* HAVE_LIBOTF */ + ftfont_info->bitmap_strike_index = strike_index; /* This means that there's no need of transformation. */ ftfont_info->matrix.xx = 0; font->pixel_size = size; @@ -1229,7 +1251,19 @@ ftfont_open (struct frame *f, Lisp_Object entity, int pixel_size) size = pixel_size; font_object = font_build_object (VECSIZE (struct font_info), Qfreetype, entity, size); - return ftfont_open2 (f, entity, pixel_size, font_object); + font_object = ftfont_open2 (f, entity, pixel_size, font_object); + if (FONT_OBJECT_P (font_object)) + { + struct font *font = XFONT_OBJECT (font_object); + struct font_info *ftfont_info = (struct font_info *) font; + + if (ftfont_info->bitmap_strike_index >= 0) + { + ftfont_close (font); + font_object = Qnil; + } + } + return font_object; } void diff --git a/src/ftfont.h b/src/ftfont.h index 327cd085ac..adbda49ff1 100644 --- a/src/ftfont.h +++ b/src/ftfont.h @@ -54,6 +54,10 @@ struct font_info #endif /* HAVE_LIBOTF */ FT_Size ft_size; int index; + /* Index of the bitmap strike used as a fallback for + FT_Set_Pixel_Sizes failure. If the value is non-negative, then + ft_size is not of the requested size. Otherwise it is -1. */ + FT_Int bitmap_strike_index; FT_Matrix matrix; #ifdef USE_CAIRO commit 69771b4e6acfe2998e4c3c30e07fb4600d42515d Author: Stefan Monnier Date: Fri Apr 19 23:31:59 2019 -0400 * lisp/emacs-lisp/radix-tree.el (pcase-defmacro): Improve docstring diff --git a/lisp/emacs-lisp/radix-tree.el b/lisp/emacs-lisp/radix-tree.el index 75d9874b43..dd65e1a0b4 100644 --- a/lisp/emacs-lisp/radix-tree.el +++ b/lisp/emacs-lisp/radix-tree.el @@ -196,8 +196,8 @@ If not found, return nil." (eval-and-compile (pcase-defmacro radix-tree-leaf (vpat) - "Build a `pcase' pattern that matches radix-tree leaf EXPVAL. -VPAT is a `pcase' pattern to extract the value." + "Pattern which matches a radix-tree leaf. +The pattern VPAT is matched against the leaf's carried value." ;; FIXME: We'd like to use a negative pattern (not consp), but pcase ;; doesn't support it. Using `atom' works but generates sub-optimal code. `(or `(t . ,,vpat) (and (pred atom) ,vpat)))) commit 4c85e3f7e97875f3bda67113a1e4195d0264a707 Author: Stefan Monnier Date: Fri Apr 19 23:29:33 2019 -0400 * lisp/emacs-lisp/byte-run.el (define-obsolete-variable-alias): Tweak doc diff --git a/lisp/emacs-lisp/byte-run.el b/lisp/emacs-lisp/byte-run.el index 7e256f8327..842d1d48b4 100644 --- a/lisp/emacs-lisp/byte-run.el +++ b/lisp/emacs-lisp/byte-run.el @@ -423,7 +423,7 @@ variable (this is due to the way `defvaralias' works). If provided, WHEN should be a string indicating when the variable was first made obsolete, for example a date or a release number. -For the benefit of `custom-set-variables', if OBSOLETE-NAME has +For the benefit of Customize, if OBSOLETE-NAME has any of the following properties, they are copied to CURRENT-NAME, if it does not already have them: `saved-value', `saved-variable-comment'." commit cb411c609d43d3c015c9550e1fc931f6f204e90d Author: Stefan Monnier Date: Fri Apr 19 23:28:07 2019 -0400 * lisp/calendar/time-date.el (date-to-time): 'signal' only takes 2 args diff --git a/lisp/calendar/time-date.el b/lisp/calendar/time-date.el index cc30bd1fda..decb21e9c2 100644 --- a/lisp/calendar/time-date.el +++ b/lisp/calendar/time-date.el @@ -155,13 +155,13 @@ If DATE lacks timezone information, GMT is assumed." (error (let ((overflow-error '(error "Specified time is not representable"))) (if (equal err overflow-error) - (apply 'signal err) - (condition-case err + (signal (car err) (cdr err)) + (condition-case-unless-debug err (encode-time (parse-time-string (timezone-make-date-arpa-standard date))) (error (if (equal err overflow-error) - (apply 'signal err) + (signal (car err) (cdr err)) (error "Invalid date: %s" date))))))))) ;;;###autoload commit 9ffbe127c13803e1a949a18f8e84ed3eeb440b74 Author: Stefan Monnier Date: Fri Apr 19 23:25:04 2019 -0400 * lisp/calendar/parse-time.el (parse-time-string): Use functionp and setf diff --git a/lisp/calendar/parse-time.el b/lisp/calendar/parse-time.el index 93e7e53b6a..68d6ce05d6 100644 --- a/lisp/calendar/parse-time.el +++ b/lisp/calendar/parse-time.el @@ -168,8 +168,7 @@ unknown DST value is returned as -1." (when (and (not (nth (car slots) time)) ;not already set (setq parse-time-val (cond ((and (consp predicate) - (not (eq (car predicate) - 'lambda))) + (not (functionp predicate))) (and (numberp parse-time-elt) (<= (car predicate) parse-time-elt) (or (not (cdr predicate)) @@ -191,7 +190,7 @@ unknown DST value is returned as -1." :end (aref this 1)) (funcall this))) parse-time-val))) - (rplaca (nthcdr (pop slots) time) new-val)))))))) + (setf (nth (pop slots) time) new-val)))))))) time)) (defconst parse-time-iso8601-regexp @@ -244,16 +243,17 @@ If DATE-STRING cannot be parsed, it falls back to re-start (match-end 0)) (when (string-match tz-re date-string re-start) (setq dst nil) - (if (string= "Z" (match-string 1 date-string)) - (setq tz 0) ;; UTC timezone indicated by Z - (setq tz (+ - (* 3600 - (string-to-number (match-string 3 date-string))) - (* 60 - (string-to-number - (or (match-string 4 date-string) "0"))))) - (when (string= "-" (match-string 2 date-string)) - (setq tz (- tz))))) + (setq tz (if (string= "Z" (match-string 1 date-string)) + 0 ;; UTC timezone indicated by Z + (let ((tz (+ + (* 3600 + (string-to-number + (match-string 3 date-string))) + (* 60 + (string-to-number + (or (match-string 4 date-string) "0")))))) + (if (string= "-" (match-string 2 date-string)) + (- tz) tz))))) (setq time (list seconds minute hour day month year day-of-week dst tz)))) ;; Fall back to having `parse-time-string' do fancy things for us. commit b793a881792271b939473cddfa95e7e7569107c7 Author: Paul Eggert Date: Fri Apr 19 17:35:39 2019 -0700 Fix GC_CHECK_STRING_BYTES false alarm with pdumper * src/alloc.c (string_bytes): Don’t abort on strings taken from the dumped file. diff --git a/src/alloc.c b/src/alloc.c index c5e4b6a642..b5b6dc2f05 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -1851,7 +1851,7 @@ string_bytes (struct Lisp_String *s) ptrdiff_t nbytes = (s->u.s.size_byte < 0 ? s->u.s.size & ~ARRAY_MARK_FLAG : s->u.s.size_byte); - if (!PURE_P (s) && s->u.s.data + if (!PURE_P (s) && !pdumper_object_p (s) && s->u.s.data && nbytes != SDATA_NBYTES (SDATA_OF_STRING (s))) emacs_abort (); return nbytes; commit e0d2ff25b08839159e8c8c72e181b325a6cc583c Author: Paul Eggert Date: Fri Apr 19 17:35:39 2019 -0700 Fix another hash false alarm * src/pdumper.c (dump_vectorlike): Fix hash. diff --git a/src/pdumper.c b/src/pdumper.c index cb36f7e4b4..5bc5bb47f4 100644 --- a/src/pdumper.c +++ b/src/pdumper.c @@ -2951,7 +2951,7 @@ dump_vectorlike (struct dump_context *ctx, Lisp_Object lv, dump_off offset) { -#if CHECK_STRUCTS && !defined (HASH_pvec_type_549C833A54) +#if CHECK_STRUCTS && !defined HASH_pvec_type_E55BD36F8E # error "pvec_type changed. See CHECK_STRUCTS comment." #endif const struct Lisp_Vector *v = XVECTOR (lv); commit ca02e8c00ced7aae0cb7fff1d2c372ac0cf6aa80 Author: Philipp Stephani Date: Sat Apr 20 01:49:41 2019 +0200 ; * src/alloc.c (xrealloc): Fix typo. diff --git a/src/alloc.c b/src/alloc.c index c5c3fec381..c5e4b6a642 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -919,7 +919,7 @@ xzalloc (size_t size) return val; } -/* Like realloc but check for no memory and block interrupt input.. */ +/* Like realloc but check for no memory and block interrupt input. */ void * xrealloc (void *block, size_t size) commit 1a4df31dddcf5a55e42f379b1b61fa21983faf32 Author: Paul Eggert Date: Fri Apr 19 14:41:37 2019 -0700 * src/emacs-module.c (value_storage_contains_p): Fix typo. diff --git a/src/emacs-module.c b/src/emacs-module.c index 5467704df7..2f60ef1f1f 100644 --- a/src/emacs-module.c +++ b/src/emacs-module.c @@ -1207,7 +1207,7 @@ value_storage_contains_p (const struct emacs_value_storage *storage, { if (&frame->objects[i] == value) return true; - ++count; + ++*count; } } return false; commit 992fd76ce9fcc849971efdee71f35985a1fa0247 Author: Philipp Stephani Date: Fri Apr 19 23:17:19 2019 +0200 Remove some ineffective #ifdefs. Since DEFSYM doesn't by itself do anything and make-docfile ignores preprocessor statements, conditional compilation of DEFSYMs is ineffective. * src/data.c (syms_of_data): Remove ineffective #ifdefs. diff --git a/src/data.c b/src/data.c index 596b778374..7928a1dc41 100644 --- a/src/data.c +++ b/src/data.c @@ -3836,9 +3836,7 @@ syms_of_data (void) DEFSYM (Qbool_vector_p, "bool-vector-p"); DEFSYM (Qchar_or_string_p, "char-or-string-p"); DEFSYM (Qmarkerp, "markerp"); -#ifdef HAVE_MODULES DEFSYM (Quser_ptrp, "user-ptrp"); -#endif DEFSYM (Qbuffer_or_string_p, "buffer-or-string-p"); DEFSYM (Qinteger_or_marker_p, "integer-or-marker-p"); DEFSYM (Qfboundp, "fboundp"); @@ -3933,9 +3931,7 @@ syms_of_data (void) DEFSYM (Qoverlay, "overlay"); DEFSYM (Qfinalizer, "finalizer"); DEFSYM (Qmodule_function, "module-function"); -#ifdef HAVE_MODULES DEFSYM (Quser_ptr, "user-ptr"); -#endif DEFSYM (Qfloat, "float"); DEFSYM (Qwindow_configuration, "window-configuration"); DEFSYM (Qprocess, "process"); commit f5776e0eac52133e66055a8436b0d02d5eaf0faf Author: Philipp Stephani Date: Fri Apr 19 23:11:14 2019 +0200 ; * src/alloc.c (HAVE_MODULES): remove unused constant diff --git a/src/alloc.c b/src/alloc.c index 7f0443dc2e..c5c3fec381 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -4845,10 +4845,6 @@ maybe_lisp_pointer (void *p) return (uintptr_t) p % LISP_ALIGNMENT == 0; } -#ifndef HAVE_MODULES -enum { HAVE_MODULES = false }; -#endif - /* If P points to Lisp data, mark that as live if it isn't already marked. */ commit e7cb6eea99a09335c8f5b935336ee6442468d853 Author: Philipp Stephani Date: Fri Apr 19 23:07:58 2019 +0200 Remove some #ifdefs for user pointers. Even if Emacs is compiled without module support, we don't have to comment out every bit of user pointer support. Defining the basic structures and functions and detecting user pointers in switch statements is harmless, and we're already doing the same for module functions. Removing these #ifdefs makes the code a bit easier to read. * src/lisp.h (PVEC_USER_PTR, struct Lisp_User_Ptr, USER_PTRP) (XUSER_PTR): Define unconditionally. * src/data.c (Ftype_of): * src/alloc.c (cleanup_vector): * src/print.c (print_vectorlike): * src/pdumper.c (dump_vectorlike): Remove #ifdef for user pointers. diff --git a/src/alloc.c b/src/alloc.c index 70701d75d4..7f0443dc2e 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -3270,14 +3270,12 @@ cleanup_vector (struct Lisp_Vector *vector) /* sweep_buffer should already have unchained this from its buffer. */ eassert (! PSEUDOVEC_STRUCT (vector, Lisp_Marker)->buffer); } -#ifdef HAVE_MODULES else if (PSEUDOVECTOR_TYPEP (&vector->header, PVEC_USER_PTR)) { struct Lisp_User_Ptr *uptr = PSEUDOVEC_STRUCT (vector, Lisp_User_Ptr); if (uptr->finalizer) uptr->finalizer (uptr->p); } -#endif } /* Reclaim space used by unmarked vectors. */ diff --git a/src/data.c b/src/data.c index 1b2431011e..596b778374 100644 --- a/src/data.c +++ b/src/data.c @@ -230,9 +230,7 @@ for example, (type-of 1) returns `integer'. */) case PVEC_MARKER: return Qmarker; case PVEC_OVERLAY: return Qoverlay; case PVEC_FINALIZER: return Qfinalizer; -#ifdef HAVE_MODULES case PVEC_USER_PTR: return Quser_ptr; -#endif case PVEC_WINDOW_CONFIGURATION: return Qwindow_configuration; case PVEC_PROCESS: return Qprocess; case PVEC_WINDOW: return Qwindow; diff --git a/src/lisp.h b/src/lisp.h index 2aa767b86c..c2cb89de9d 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -1097,9 +1097,7 @@ enum pvec_type PVEC_OVERLAY, PVEC_FINALIZER, PVEC_MISC_PTR, -#ifdef HAVE_MODULES PVEC_USER_PTR, -#endif PVEC_PROCESS, PVEC_FRAME, PVEC_WINDOW, @@ -2561,14 +2559,12 @@ xmint_pointer (Lisp_Object a) return XUNTAG (a, Lisp_Vectorlike, struct Lisp_Misc_Ptr)->pointer; } -#ifdef HAVE_MODULES struct Lisp_User_Ptr { union vectorlike_header header; void (*finalizer) (void *); void *p; } GCALIGNED_STRUCT; -#endif /* A finalizer sentinel. */ struct Lisp_Finalizer @@ -2627,7 +2623,6 @@ XOVERLAY (Lisp_Object a) return XUNTAG (a, Lisp_Vectorlike, struct Lisp_Overlay); } -#ifdef HAVE_MODULES INLINE bool USER_PTRP (Lisp_Object x) { @@ -2640,7 +2635,6 @@ XUSER_PTR (Lisp_Object a) eassert (USER_PTRP (a)); return XUNTAG (a, Lisp_Vectorlike, struct Lisp_User_Ptr); } -#endif INLINE bool BIGNUMP (Lisp_Object x) diff --git a/src/pdumper.c b/src/pdumper.c index 1bd94cb003..cb36f7e4b4 100644 --- a/src/pdumper.c +++ b/src/pdumper.c @@ -3013,9 +3013,7 @@ dump_vectorlike (struct dump_context *ctx, case PVEC_XWIDGET_VIEW: error_unsupported_dump_object (ctx, lv, "xwidget view"); case PVEC_MISC_PTR: -#ifdef HAVE_MODULES case PVEC_USER_PTR: -#endif error_unsupported_dump_object (ctx, lv, "smuggled pointers"); case PVEC_THREAD: if (main_thread_p (v)) diff --git a/src/print.c b/src/print.c index 67c4ed03ee..081e5574b7 100644 --- a/src/print.c +++ b/src/print.c @@ -1410,7 +1410,6 @@ print_vectorlike (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag, printchar ('>', printcharfun); break; -#ifdef HAVE_MODULES case PVEC_USER_PTR: { print_c_string ("#', printcharfun); } break; -#endif case PVEC_FINALIZER: print_c_string ("# Date: Fri Apr 19 22:51:16 2019 +0200 Remove special-casing of tagged pointers. This partially reverts commit 09b2b8a5ce5b542856f93b645db51eb11cf9855a. * src/alloc.c (mark_maybe_pointer): Remove special-casing of tagged pointers. After commit 09d746dad36e4780d379f975a84b1b076da78c50, modules no longer rely on tagged pointers. diff --git a/src/alloc.c b/src/alloc.c index dd783863be..70701d75d4 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -4863,17 +4863,8 @@ mark_maybe_pointer (void *p) VALGRIND_MAKE_MEM_DEFINED (&p, sizeof (p)); #endif - if (sizeof (Lisp_Object) == sizeof (void *) || !HAVE_MODULES) - { - if (!maybe_lisp_pointer (p)) - return; - } - else - { - /* For the wide-int case, also mark emacs_value tagged pointers, - which can be generated by emacs-module.c's value_to_lisp. */ - p = (void *) ((uintptr_t) p & ~((1 << GCTYPEBITS) - 1)); - } + if (!maybe_lisp_pointer (p)) + return; if (pdumper_object_p (p)) { commit ba2e3a8abb5657e350d7653dd7580e1ebe84c7ab Author: Philipp Stephani Date: Sat Jan 19 23:40:35 2019 +0100 Refactoring: Reduce code duplication * src/emacs-module.c (value_storage_contains_p): New function. (module_free_global_ref, value_to_lisp): Use it. diff --git a/src/emacs-module.c b/src/emacs-module.c index ad32d3a91f..5467704df7 100644 --- a/src/emacs-module.c +++ b/src/emacs-module.c @@ -209,6 +209,8 @@ static void module_non_local_exit_throw_1 (emacs_env *, Lisp_Object, Lisp_Object); static void module_out_of_memory (emacs_env *); static void module_reset_handlerlist (struct handler **); +static bool value_storage_contains_p (const struct emacs_value_storage *, + emacs_value, ptrdiff_t *); static bool module_assertions = false; @@ -403,16 +405,8 @@ module_free_global_ref (emacs_env *env, emacs_value ref) if (module_assertions) { ptrdiff_t count = 0; - for (struct emacs_value_frame *frame = &global_storage.initial; - frame != NULL; frame = frame->next) - { - for (int i = 0; i < frame->offset; ++i) - { - if (&frame->objects[i] == ref) - return; - ++count; - } - } + if (value_storage_contains_p (&global_storage, ref, &count)) + return; module_abort ("Global value was not found in list of %"pD"d globals", count); } @@ -978,29 +972,13 @@ value_to_lisp (emacs_value v) if (&priv->non_local_exit_symbol == v || &priv->non_local_exit_data == v) goto ok; - for (struct emacs_value_frame *frame = &priv->storage.initial; - frame != NULL; frame = frame->next) - { - for (int i = 0; i < frame->offset; ++i) - { - if (&frame->objects[i] == v) - goto ok; - ++num_values; - } - } + if (value_storage_contains_p (&priv->storage, v, &num_values)) + goto ok; ++num_environments; } /* Also check global values. */ - for (struct emacs_value_frame *frame = &global_storage.initial; - frame != NULL; frame = frame->next) - { - for (int i = 0; i < frame->offset; ++i) - { - if (&frame->objects[i] == v) - goto ok; - ++num_values; - } - } + if (value_storage_contains_p (&global_storage, v, &num_values)) + goto ok; module_abort (("Emacs value not found in %"pD"d values " "of %"pD"d environments"), num_values, num_environments); @@ -1215,6 +1193,26 @@ init_module_assertions (bool enable) initialize_storage (&global_storage); } +/* Return whether STORAGE contains VALUE. Used to check module + assertions. Increment *COUNT by the number of values searched. */ + +static bool +value_storage_contains_p (const struct emacs_value_storage *storage, + emacs_value value, ptrdiff_t *count) +{ + for (const struct emacs_value_frame *frame = &storage->initial; frame != NULL; + frame = frame->next) + { + for (int i = 0; i < frame->offset; ++i) + { + if (&frame->objects[i] == value) + return true; + ++count; + } + } + return false; +} + static AVOID ATTRIBUTE_FORMAT_PRINTF (1, 2) module_abort (const char *format, ...) { commit a59c41ee81568a5e56d7a6545be6d18b37ef2d60 Author: Mattias Engdegård Date: Fri Apr 19 22:24:35 2019 +0200 Remove subsumed regexp branches * lisp/progmodes/cc-mode.el (c-before-change-check-unbalanced-strings) (c-after-change-mark-abnormal-strings): Remove `\r' subsumed by `.'. diff --git a/lisp/progmodes/cc-mode.el b/lisp/progmodes/cc-mode.el index 49268c4482..fc4ba8f589 100644 --- a/lisp/progmodes/cc-mode.el +++ b/lisp/progmodes/cc-mode.el @@ -1244,7 +1244,7 @@ Note that the style variables are always made local to the buffer." (goto-char (1+ end)) ; might be a newline. ;; In the following regexp, the initial \n caters for a newline getting ;; joined to a preceding \ by the removal of what comes between. - (re-search-forward "[\n\r]?\\(\\\\\\(.\\|\n\\|\r\\)\\|[^\\\n\r]\\)*" + (re-search-forward "[\n\r]?\\(\\\\\\(.\\|\n\\)\\|[^\\\n\r]\\)*" nil t) ;; We're at an EOLL or point-max. (setq c-new-END (max c-new-END (min (1+ (point)) (point-max)))) @@ -1371,7 +1371,7 @@ Note that the style variables are always made local to the buffer." (unless (and (c-major-mode-is 'c++-mode) (c-maybe-re-mark-raw-string)) (if (c-unescaped-nls-in-string-p (1- (point))) - (looking-at "\\(\\\\\\(.\\|\n\\|\r\\)\\|[^\"]\\)*") + (looking-at "\\(\\\\\\(.\\|\n\\)\\|[^\"]\\)*") (looking-at (cdr (assq (char-before) c-string-innards-re-alist)))) (cond ((memq (char-after (match-end 0)) '(?\n ?\r)) commit 0f8628490e3e06f2bfe14451626f55b2165d711c Author: Paul Eggert Date: Fri Apr 19 12:55:18 2019 -0700 Fix Fload dangling pointer * src/lread.c (Fload): Expand decl’s lifetime to match its use. Bug found by gcc -fsanitize=address. diff --git a/src/lread.c b/src/lread.c index f83db2ac9f..6cd1029cd9 100644 --- a/src/lread.c +++ b/src/lread.c @@ -1439,6 +1439,10 @@ Return t if the file exists and loads successfully. */) specbind (Qinhibit_file_name_operation, Qnil); specbind (Qload_in_progress, Qt); + /* Declare here rather than inside the else-part because the storage + might be accessed by the unbind_to call below. */ + struct infile input; + if (is_module) { #ifdef HAVE_MODULES @@ -1453,7 +1457,6 @@ Return t if the file exists and loads successfully. */) } else { - struct infile input; input.stream = stream; input.lookahead = 0; infile = &input; commit bc4ed68314e51d784c03a06385f294db80f9a3bd Author: Paul Eggert Date: Fri Apr 19 12:52:57 2019 -0700 Fix comment and tweak eval_sub * src/eval.c (eval_sub): Check whether Fassq returns Qnil, not whether it returns a cons, as NILP is faster than CONSP nowadays. Remove incorrect comment “only original_fun and original_args have values that will be used below”; instead, move declarations around so that the set of variables with useful values is obvious. diff --git a/src/eval.c b/src/eval.c index a2b95172d8..a636f6c50a 100644 --- a/src/eval.c +++ b/src/eval.c @@ -2153,14 +2153,6 @@ record_in_backtrace (Lisp_Object function, Lisp_Object *args, ptrdiff_t nargs) Lisp_Object eval_sub (Lisp_Object form) { - Lisp_Object fun, val, original_fun, original_args; - Lisp_Object funcar; - ptrdiff_t count; - - /* Declare here, as this array may be accessed by call_debugger near - the end of this function. See Bug#21245. */ - Lisp_Object argvals[8]; - if (SYMBOLP (form)) { /* Look up its binding in the lexical environment. @@ -2170,10 +2162,7 @@ eval_sub (Lisp_Object form) = !NILP (Vinternal_interpreter_environment) /* Mere optimization! */ ? Fassq (form, Vinternal_interpreter_environment) : Qnil; - if (CONSP (lex_binding)) - return XCDR (lex_binding); - else - return Fsymbol_value (form); + return !NILP (lex_binding) ? XCDR (lex_binding) : Fsymbol_value (form); } if (!CONSP (form)) @@ -2191,18 +2180,22 @@ eval_sub (Lisp_Object form) error ("Lisp nesting exceeds `max-lisp-eval-depth'"); } - original_fun = XCAR (form); - original_args = XCDR (form); + Lisp_Object original_fun = XCAR (form); + Lisp_Object original_args = XCDR (form); CHECK_LIST (original_args); /* This also protects them from gc. */ - count = record_in_backtrace (original_fun, &original_args, UNEVALLED); + ptrdiff_t count + = record_in_backtrace (original_fun, &original_args, UNEVALLED); if (debug_on_next_call) do_debug_on_call (Qt, count); - /* At this point, only original_fun and original_args - have values that will be used below. */ + Lisp_Object fun, val, funcar; + /* Declare here, as this array may be accessed by call_debugger near + the end of this function. See Bug#21245. */ + Lisp_Object argvals[8]; + retry: /* Optimize for no indirection. */ commit 7d84056df4b228509b723b11d69bf39e3d1e548a Author: Paul Eggert Date: Fri Apr 19 12:38:45 2019 -0700 Fix dump_map_file on unusual platforms * src/pdumper.c (dump_map_file): Fix recently-introduced typo on platforms that support neither POSIX nor MS-Windows VM. diff --git a/src/pdumper.c b/src/pdumper.c index 2cc9af7f56..1bd94cb003 100644 --- a/src/pdumper.c +++ b/src/pdumper.c @@ -4550,7 +4550,7 @@ dump_map_file (void *base, int fd, off_t offset, size_t size, return dump_map_file_w32 (base, fd, offset, size, protection); #else errno = ENOSYS; - return ret; + return NULL; #endif } commit 5e3e14f6e96fd99ac763bedccb0539551dcb1d29 Author: Paul Eggert Date: Fri Apr 19 12:08:40 2019 -0700 Minor lread.c tweaks * src/lread.c (load_warn_unescaped_character_literals): Use AUTO_STRING to help the GC. (Fload): Use bool for boolean. diff --git a/src/lread.c b/src/lread.c index 8b38cacde0..f83db2ac9f 100644 --- a/src/lread.c +++ b/src/lread.c @@ -1034,12 +1034,12 @@ load_error_old_style_backquotes (void) static void load_warn_unescaped_character_literals (Lisp_Object file) { - Lisp_Object warning - = call0 (Qbyte_run_unescaped_character_literals_warning); - if (NILP (warning)) - return; - Lisp_Object format = build_string ("Loading `%s': %s"); - CALLN (Fmessage, format, file, warning); + Lisp_Object warning = call0 (Qbyte_run_unescaped_character_literals_warning); + if (!NILP (warning)) + { + AUTO_STRING (format, "Loading `%s': %s"); + CALLN (Fmessage, format, file, warning); + } } DEFUN ("get-load-suffixes", Fget_load_suffixes, Sget_load_suffixes, 0, 0, 0, @@ -1301,8 +1301,8 @@ Return t if the file exists and loads successfully. */) specbind (Qlread_unescaped_character_literals, Qnil); record_unwind_protect (load_warn_unescaped_character_literals, file); - int is_elc; - if ((is_elc = suffix_p (found, ".elc")) != 0 + bool is_elc = suffix_p (found, ".elc"); + if (is_elc /* version = 1 means the file is empty, in which case we can treat it as not byte-compiled. */ || (fd >= 0 && (version = safe_to_load_version (fd)) > 1)) commit a33308a297125e7e804ebafb7d942c10aaa2c3c1 Author: Eric Abrahamsen Date: Fri Apr 19 10:23:19 2019 -0700 Clear gnus-group-list when the newsrc-hashtb is recreated * lisp/gnus/gnus-start.el (gnus-make-hashtable-from-newsrc-alist): This routine also happens when re-sorting groups; make sure we're clearing the group list. diff --git a/lisp/gnus/gnus-start.el b/lisp/gnus/gnus-start.el index 606155d741..2f8a260bf1 100644 --- a/lisp/gnus/gnus-start.el +++ b/lisp/gnus/gnus-start.el @@ -1819,7 +1819,8 @@ The info element is shared with the same element of (let ((alist gnus-newsrc-alist) (ohashtb gnus-newsrc-hashtb) info method gname rest methods) - (setq gnus-newsrc-hashtb (gnus-make-hashtable (length alist))) + (setq gnus-newsrc-hashtb (gnus-make-hashtable (length alist)) + gnus-group-list nil) (setq alist (setq gnus-newsrc-alist (if (equal (caar gnus-newsrc-alist) commit 0b4b380ce4989afc59848d2b6a350bd1dd7dc7ca Author: Philipp Stephani Date: Sat Jun 2 11:59:02 2018 +0200 Make warning about unescaped character literals more helpful. See Bug#31676. * lisp/emacs-lisp/byte-run.el (byte-run--unescaped-character-literals-warning): New defun. * src/lread.c (load_warn_unescaped_character_literals): Use new defun. (syms_of_lread): Define symbol for new defun. * lisp/emacs-lisp/bytecomp.el (byte-compile-from-buffer): Use new defun. * test/src/lread-tests.el (lread-tests--unescaped-char-literals): test/lisp/emacs-lisp/bytecomp-tests.el (bytecomp-tests--unescaped-char-literals): Adapt unit tests. diff --git a/lisp/emacs-lisp/byte-run.el b/lisp/emacs-lisp/byte-run.el index b638b56be1..7e256f8327 100644 --- a/lisp/emacs-lisp/byte-run.el +++ b/lisp/emacs-lisp/byte-run.el @@ -495,6 +495,21 @@ is enabled." (car (last body))) +(defun byte-run--unescaped-character-literals-warning () + "Return a warning about unescaped character literals. +If there were any unescaped character literals in the last form +read, return an appropriate warning message as a string. +Otherwise, return nil. For internal use only." + ;; This is called from lread.c and therefore needs to be preloaded. + (if lread--unescaped-character-literals + (let ((sorted (sort lread--unescaped-character-literals #'<))) + (format-message "unescaped character literals %s detected, %s expected!" + (mapconcat (lambda (char) (format "`?%c'" char)) + sorted ", ") + (mapconcat (lambda (char) (format "`?\\%c'" char)) + sorted ", "))))) + + ;; I nuked this because it's not a good idea for users to think of using it. ;; These options are a matter of installation preference, and have nothing to ;; with particular source files; it's a mistake to suggest to users diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 8bbe6292d9..4c61e1a447 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -2082,14 +2082,9 @@ With argument ARG, insert value in current buffer after the form." (not (eobp))) (setq byte-compile-read-position (point) byte-compile-last-position byte-compile-read-position) - (let* ((lread--unescaped-character-literals nil) - (form (read inbuffer))) - (when lread--unescaped-character-literals - (byte-compile-warn - "unescaped character literals %s detected!" - (mapconcat (lambda (char) (format "`?%c'" char)) - (sort lread--unescaped-character-literals #'<) - ", "))) + (let ((form (read inbuffer)) + (warning (byte-run--unescaped-character-literals-warning))) + (when warning (byte-compile-warn "%s" warning)) (byte-compile-toplevel-file-form form))) ;; Compile pending forms at end of file. (byte-compile-flush-pending) diff --git a/src/lread.c b/src/lread.c index 8cb4b63cc3..8b38cacde0 100644 --- a/src/lread.c +++ b/src/lread.c @@ -1034,18 +1034,12 @@ load_error_old_style_backquotes (void) static void load_warn_unescaped_character_literals (Lisp_Object file) { - if (NILP (Vlread_unescaped_character_literals)) return; - CHECK_CONS (Vlread_unescaped_character_literals); - Lisp_Object format = - build_string ("Loading `%s': unescaped character literals %s detected!"); - Lisp_Object separator = build_string (", "); - Lisp_Object inner_format = build_string ("`?%c'"); - CALLN (Fmessage, - format, file, - Fmapconcat (list3 (Qlambda, list1 (Qchar), - list3 (Qformat, inner_format, Qchar)), - Fsort (Vlread_unescaped_character_literals, Qlss), - separator)); + Lisp_Object warning + = call0 (Qbyte_run_unescaped_character_literals_warning); + if (NILP (warning)) + return; + Lisp_Object format = build_string ("Loading `%s': %s"); + CALLN (Fmessage, format, file, warning); } DEFUN ("get-load-suffixes", Fget_load_suffixes, Sget_load_suffixes, 0, 0, 0, @@ -5014,9 +5008,9 @@ For internal use only. */); DEFSYM (Qlread_unescaped_character_literals, "lread--unescaped-character-literals"); - DEFSYM (Qlss, "<"); - DEFSYM (Qchar, "char"); - DEFSYM (Qformat, "format"); + /* Defined in lisp/emacs-lisp/byte-run.el. */ + DEFSYM (Qbyte_run_unescaped_character_literals_warning, + "byte-run--unescaped-character-literals-warning"); DEFVAR_BOOL ("load-prefer-newer", load_prefer_newer, doc: /* Non-nil means `load' prefers the newest version of a file. diff --git a/test/lisp/emacs-lisp/bytecomp-tests.el b/test/lisp/emacs-lisp/bytecomp-tests.el index f66a06bc1b..5fb64ff288 100644 --- a/test/lisp/emacs-lisp/bytecomp-tests.el +++ b/test/lisp/emacs-lisp/bytecomp-tests.el @@ -540,7 +540,9 @@ literals (Bug#20852)." (should (equal (cdr err) (list (concat "unescaped character literals " "`?\"', `?(', `?)', `?;', `?[', `?]' " - "detected!")))))))) + "detected, " + "`?\\\"', `?\\(', `?\\)', `?\\;', `?\\[', " + "`?\\]' expected!")))))))) (ert-deftest bytecomp-tests--old-style-backquotes () "Check that byte compiling warns about old-style backquotes." diff --git a/test/src/lread-tests.el b/test/src/lread-tests.el index ae918f0312..82b75b195c 100644 --- a/test/src/lread-tests.el +++ b/test/src/lread-tests.el @@ -140,7 +140,9 @@ literals (Bug#20852)." (should (equal (lread-tests--last-message) (concat (format-message "Loading `%s': " file-name) "unescaped character literals " - "`?\"', `?(', `?)', `?;', `?[', `?]' detected!"))))) + "`?\"', `?(', `?)', `?;', `?[', `?]' detected, " + "`?\\\"', `?\\(', `?\\)', `?\\;', `?\\[', `?\\]' " + "expected!"))))) (ert-deftest lread-tests--funny-quote-symbols () "Check that 'smart quotes' or similar trigger errors in symbol names." commit 8aadf6e415b7801cb9fa4c5670b1750da207cf87 Author: Philipp Stephani Date: Fri Apr 19 18:38:19 2019 +0200 Refactoring: simplify definition of some internal variables. In some cases, we never specbind internal objects, so they don't have to be symbols. Rather than using DEFSYM/DEFVAR and then uninterning the symbols, use plain static variables. Call staticpro for all of them, to protect them from the garbage collector. * src/eval.c (syms_of_eval): Use a static variable for Qcatch_all_memory_full. * src/emacs-module.c (syms_of_module): Use static variables for Vmodule_refs_hash, Vmodule_runtimes, and Vmodule_environments. diff --git a/src/emacs-module.c b/src/emacs-module.c index 393a4354b8..ad32d3a91f 100644 --- a/src/emacs-module.c +++ b/src/emacs-module.c @@ -349,6 +349,8 @@ module_get_environment (struct emacs_runtime *ert) /* To make global refs (GC-protected global values) keep a hash that maps global Lisp objects to reference counts. */ +static Lisp_Object Vmodule_refs_hash; + static emacs_value module_make_global_ref (emacs_env *env, emacs_value ref) { @@ -760,6 +762,10 @@ module_signal_or_throw (struct emacs_env_private *env) } } +/* Live runtime and environment objects, for assertions. */ +static Lisp_Object Vmodule_runtimes; +static Lisp_Object Vmodule_environments; + DEFUN ("module-load", Fmodule_load, Smodule_load, 1, 1, 0, doc: /* Load module FILE. */) (Lisp_Object file) @@ -1228,31 +1234,17 @@ module_abort (const char *format, ...) void syms_of_module (void) { - DEFSYM (Qmodule_refs_hash, "module-refs-hash"); - DEFVAR_LISP ("module-refs-hash", Vmodule_refs_hash, - doc: /* Module global reference table. */); - + staticpro (&Vmodule_refs_hash); Vmodule_refs_hash = make_hash_table (hashtest_eq, DEFAULT_HASH_SIZE, DEFAULT_REHASH_SIZE, DEFAULT_REHASH_THRESHOLD, Qnil, false); - Funintern (Qmodule_refs_hash, Qnil); - DEFSYM (Qmodule_runtimes, "module-runtimes"); - DEFVAR_LISP ("module-runtimes", Vmodule_runtimes, - doc: /* List of active module runtimes. */); + staticpro (&Vmodule_runtimes); Vmodule_runtimes = Qnil; - /* Unintern `module-runtimes' because it is only used - internally. */ - Funintern (Qmodule_runtimes, Qnil); - DEFSYM (Qmodule_environments, "module-environments"); - DEFVAR_LISP ("module-environments", Vmodule_environments, - doc: /* List of active module environments. */); + staticpro (&Vmodule_environments); Vmodule_environments = Qnil; - /* Unintern `module-environments' because it is only used - internally. */ - Funintern (Qmodule_environments, Qnil); DEFSYM (Qmodule_load_failed, "module-load-failed"); Fput (Qmodule_load_failed, Qerror_conditions, @@ -1291,10 +1283,6 @@ syms_of_module (void) Fput (Qinvalid_arity, Qerror_message, build_pure_c_string ("Invalid function arity")); - /* Unintern `module-refs-hash' because it is internal-only and Lisp - code or modules should not access it. */ - Funintern (Qmodule_refs_hash, Qnil); - DEFSYM (Qmodule_function_p, "module-function-p"); defsubr (&Smodule_load); diff --git a/src/eval.c b/src/eval.c index 23fd0efd54..a2b95172d8 100644 --- a/src/eval.c +++ b/src/eval.c @@ -1429,6 +1429,8 @@ internal_condition_case_n (Lisp_Object (*bfun) (ptrdiff_t, Lisp_Object *), } } +static Lisp_Object Qcatch_all_memory_full; + /* Like a combination of internal_condition_case_1 and internal_catch. Catches all signals and throws. Never exits nonlocally; returns Qcatch_all_memory_full if no handler could be allocated. */ @@ -4188,8 +4190,12 @@ alist of active lexical bindings. */); staticpro (&Vsignaling_function); Vsignaling_function = Qnil; - DEFSYM (Qcatch_all_memory_full, "catch-all-memory-full"); - Funintern (Qcatch_all_memory_full, Qnil); + staticpro (&Qcatch_all_memory_full); + /* Make sure Qcatch_all_memory_full is a unique object. We could + also use something like Fcons (Qnil, Qnil), but json.c treats any + cons cell as error data, so use an uninterned symbol instead. */ + Qcatch_all_memory_full + = Fmake_symbol (build_pure_c_string ("catch-all-memory-full")); defsubr (&Sor); defsubr (&Sand); commit bd93bcb078f29e9b5fa127d6cef0bdeeab5c2285 Author: Eric Abrahamsen Date: Fri Apr 19 09:07:59 2019 -0700 Don't check for group existence in gnus-group-goto-group * lisp/gnus/gnus-group.el (gnus-group-goto-group): Just look for the string. diff --git a/lisp/gnus/gnus-group.el b/lisp/gnus/gnus-group.el index b1e4091c97..c757c82fbc 100644 --- a/lisp/gnus/gnus-group.el +++ b/lisp/gnus/gnus-group.el @@ -2549,37 +2549,33 @@ If PROMPT (the prefix) is a number, use the prompt specified in (gnus-group-position-point))) (defun gnus-group-goto-group (group &optional far test-marked) - "Goto to newsgroup GROUP. + "Go to newsgroup GROUP. If FAR, it is likely that the group is not on the current line. -If TEST-MARKED, the line must be marked." +If TEST-MARKED, the line must be marked. + +Return nil if GROUP is not found." (when group - (let ((start (point)) - (active (and (or - ;; Some kind of group may be only there. - (gnus-active group) - ;; All groups (but with exception) are there. - (gnus-group-entry group)) - group))) + (let ((start (point))) (beginning-of-line) (cond ;; It's quite likely that we are on the right line, so ;; we check the current line first. ((and (not far) - (equal (get-text-property (point) 'gnus-group) active) + (equal (get-text-property (point) 'gnus-group) group) (or (not test-marked) (gnus-group-mark-line-p))) (point)) ;; Previous and next line are also likely, so we check them as well. ((and (not far) (save-excursion (forward-line -1) - (and (equal (get-text-property (point) 'gnus-group) active) + (and (equal (get-text-property (point) 'gnus-group) group) (or (not test-marked) (gnus-group-mark-line-p))))) (forward-line -1) (point)) ((and (not far) (save-excursion (forward-line 1) - (and (equal (get-text-property (point) 'gnus-group) active) + (and (equal (get-text-property (point) 'gnus-group) group) (or (not test-marked) (gnus-group-mark-line-p))))) (forward-line 1) (point)) @@ -2588,7 +2584,7 @@ If TEST-MARKED, the line must be marked." (let (found) (while (and (not found) (gnus-text-property-search - 'gnus-group active 'forward 'goto)) + 'gnus-group group 'forward 'goto)) (if (gnus-group-mark-line-p) (setq found t) (forward-line 1))) @@ -2596,7 +2592,7 @@ If TEST-MARKED, the line must be marked." (t ;; Search through the entire buffer. (if (gnus-text-property-search - 'gnus-group active nil 'goto) + 'gnus-group group nil 'goto) (point) (goto-char start) nil)))))) commit 9e4bb0d221bbd97f9318bacba0650d93708f0290 Author: Paul Eggert Date: Fri Apr 19 09:00:04 2019 -0700 Fix regexp branches that subsume other branches Problems reported by Mattias Engdegård in: https://lists.gnu.org/r/emacs-devel/2019-04/msg00803.html * lisp/arc-mode.el (archive-rar-summarize): * lisp/eshell/em-hist.el (eshell-hist-word-designator): * lisp/info.el (Info-dir-remove-duplicates): * lisp/international/ja-dic-cnv.el (skkdic-convert-postfix) (skkdic-convert-prefix, skkdic-collect-okuri-nasi): * lisp/progmodes/cc-awk.el (c-awk-esc-pair-re): * lisp/xml.el (xml-att-type-re): Omit regexp branches that subsume other branches. * lisp/progmodes/cperl-mode.el (cperl-beautify-regexp-piece): $ and ^ aren’t simple-codes. diff --git a/lisp/arc-mode.el b/lisp/arc-mode.el index 6a58d61a54..1c88f9a1a1 100644 --- a/lisp/arc-mode.el +++ b/lisp/arc-mode.el @@ -2019,7 +2019,7 @@ This doesn't recover lost files, it just undoes changes in the buffer itself." (re-search-forward "^\\(\s+=+\s*\\)+\n") (while (looking-at (concat "^\s+[0-9.]+\s+D?-+\s+" ; Flags "\\([0-9-]+\\)\s+" ; Size - "\\([-0-9.%]+\\|-+\\)\s+" ; Ratio + "\\([-0-9.%]+\\)\s+" ; Ratio "\\([0-9a-zA-Z]+\\)\s+" ; Mode "\\([0-9-]+\\)\s+" ; Date "\\([0-9:]+\\)\s+" ; Time diff --git a/lisp/eshell/em-hist.el b/lisp/eshell/em-hist.el index 614faaa131..adb028002b 100644 --- a/lisp/eshell/em-hist.el +++ b/lisp/eshell/em-hist.el @@ -153,7 +153,7 @@ element, regardless of any text on the command line. In that case, :group 'eshell-hist) (defcustom eshell-hist-word-designator - "^:?\\([0-9]+\\|[$^%*]\\)?\\(\\*\\|-[0-9]*\\|[$^%*]\\)?" + "^:?\\([0-9]+\\|[$^%*]\\)?\\(-[0-9]*\\|[$^%*]\\)?" "The regexp used to identify history word designators." :type 'regexp :group 'eshell-hist) diff --git a/lisp/info.el b/lisp/info.el index f3b413a2f9..2e5f433dc8 100644 --- a/lisp/info.el +++ b/lisp/info.el @@ -1531,7 +1531,7 @@ is non-nil)." (save-restriction (narrow-to-region start (point)) (goto-char (point-min)) - (while (re-search-forward "^\\* \\([^:\n]+:\\(:\\|[^.\n]+\\).\\)" nil 'move) + (while (re-search-forward "^\\* \\([^:\n]+:[^.\n]+.\\)" nil 'move) ;; Fold case straight away; `member-ignore-case' here wasteful. (let ((x (downcase (match-string 1)))) (if (member x seen) diff --git a/lisp/international/ja-dic-cnv.el b/lisp/international/ja-dic-cnv.el index 578cd63a59..e721083189 100644 --- a/lisp/international/ja-dic-cnv.el +++ b/lisp/international/ja-dic-cnv.el @@ -124,7 +124,7 @@ (setq l (cdr l))))) ;; Search postfix entries. - (while (re-search-forward "^[#<>?]\\(\\(\\cH\\|ー\\)+\\) " nil t) + (while (re-search-forward "^[#<>?]\\(\\cH+\\) " nil t) (let ((kana (match-string-no-properties 1)) str candidates) (while (looking-at "/[#0-9 ]*\\([^/\n]*\\)/") @@ -157,7 +157,7 @@ (insert ";; Setting prefix entries.\n" "(skkdic-set-prefix\n")) (save-excursion - (while (re-search-forward "^\\(\\(\\cH\\|ー\\)+\\)[<>?] " nil t) + (while (re-search-forward "^\\(\\cH+\\)[<>?] " nil t) (let ((kana (match-string-no-properties 1)) str candidates) (while (looking-at "/\\([^/\n]+\\)/") @@ -275,11 +275,11 @@ (let ((progress (make-progress-reporter "Collecting OKURI-NASI entries" (point) (point-max) nil 10))) - (while (re-search-forward "^\\(\\(\\cH\\|ー\\)+\\) \\(/\\cj.*\\)/$" + (while (re-search-forward "^\\(\\cH+\\) \\(/\\cj.*\\)/$" nil t) (let ((kana (match-string-no-properties 1)) - (candidates (skkdic-get-candidate-list (match-beginning 3) - (match-end 3)))) + (candidates (skkdic-get-candidate-list (match-beginning 2) + (match-end 2)))) (setq skkdic-okuri-nasi-entries (cons (cons kana candidates) skkdic-okuri-nasi-entries)) (progress-reporter-update progress (point)) diff --git a/lisp/progmodes/cc-awk.el b/lisp/progmodes/cc-awk.el index 70aa3c4b1f..1a67a95927 100644 --- a/lisp/progmodes/cc-awk.el +++ b/lisp/progmodes/cc-awk.el @@ -95,7 +95,7 @@ ;; Emacs has in the past used \r to mark hidden lines in some fashion (and ;; maybe still does). -(defconst c-awk-esc-pair-re "\\\\\\(.\\|\n\\|\r\\|\\'\\)") +(defconst c-awk-esc-pair-re "\\\\\\(.\\|\n\\|\\'\\)") ;; Matches any escaped (with \) character-pair, including an escaped newline. (defconst c-awk-non-eol-esc-pair-re "\\\\\\(.\\|\\'\\)") ;; Matches any escaped (with \) character-pair, apart from an escaped newline. diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el index 73b55e29a5..ba007d67c0 100644 --- a/lisp/progmodes/cperl-mode.el +++ b/lisp/progmodes/cperl-mode.el @@ -7983,7 +7983,7 @@ prototype \\&SUB Returns prototype of the function given a reference. "\\|" ; $ ^ "[$^]" "\\|" ; simple-code simple-code*? - "\\(\\\\.\\|[^][()#|*+?\n]\\)\\([*+{?]\\??\\)?" ; 4 5 + "\\(\\\\.\\|[^][()#|*+?$^\n]\\)\\([*+{?]\\??\\)?" ; 4 5 "\\|" ; Class "\\(\\[\\)" ; 6 "\\|" ; Grouping diff --git a/lisp/xml.el b/lisp/xml.el index b5b923f863..1f3c05f4d9 100644 --- a/lisp/xml.el +++ b/lisp/xml.el @@ -245,7 +245,6 @@ See also `xml-get-attribute-or-nil'." ;; [54] AttType ::= StringType | TokenizedType | EnumeratedType ;; [55] StringType ::= 'CDATA' (defconst xml-att-type-re (concat "\\(?:CDATA\\|" xml-tokenized-type-re - "\\|" xml-notation-type-re "\\|" xml-enumerated-type-re "\\)")) ;; [60] DefaultDecl ::= '#REQUIRED' | '#IMPLIED' | (('#FIXED' S)? AttValue) commit e6a9785f8228130c339aad5ba0a514fee6539cab Author: Paul Eggert Date: Fri Apr 19 08:23:15 2019 -0700 Fix mail-extr regexp typo with ".". Problem reported by Mattias Engdegård in: https://lists.gnu.org/r/emacs-devel/2019-04/msg00543.html * lisp/mail/mail-extr.el (mail-extr-telephone-extension-pattern): Escape the trailing optional period after an abbreviation. diff --git a/lisp/mail/mail-extr.el b/lisp/mail/mail-extr.el index a0b9688650..c1e90c3dcb 100644 --- a/lisp/mail/mail-extr.el +++ b/lisp/mail/mail-extr.el @@ -383,7 +383,7 @@ by translating things like \"foo!bar!baz@host\" into \"baz@bar.UUCP\"." ;; Matches telephone extensions. (defconst mail-extr-telephone-extension-pattern (purecopy - "\\(\\([Ee]xt\\|[Tt]ph\\|[Tt]el\\|[Xx]\\).?\\)? *\\+?[0-9][- 0-9]+")) + "\\(\\([Ee]xt\\|[Tt]ph\\|[Tt]el\\|[Xx]\\)\\.?\\)? *\\+?[0-9][- 0-9]+")) ;; Matches ham radio call signs. ;; Help from: Mat Maessen N2NJZ , Mark Feit commit 85b4441472a443dd8fd053d7b088b1e3667347d3 Author: Michael Albinus Date: Fri Apr 19 16:29:44 2019 +0200 * lisp/net/tramp-adb.el (tramp-adb-prompt): Remove repetition of expression matching an empty string. diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el index 71d7f61b91..bd66ab4456 100644 --- a/lisp/net/tramp-adb.el +++ b/lisp/net/tramp-adb.el @@ -53,7 +53,7 @@ It is used for TCP/IP devices." "When this method name is used, forward all calls to Android Debug Bridge.") (defcustom tramp-adb-prompt - "^[[:digit:]]*|?\\(?:[[:alnum:]\e;[]*@?[[:alnum:]]*[^#\\$]*\\)?[#\\$][[:space:]]" + "^[[:digit:]]*|?[[:alnum:]\e;[]*@?[[:alnum:]]*[^#\\$]*[#\\$][[:space:]]" "Regexp used as prompt in almquist shell." :type 'string :version "24.4" commit d3385c911f793b1048c28c967d74e47a78950ecf Merge: 06bbd6dfd1 280dd6c49d Author: Michael Albinus Date: Fri Apr 19 16:29:11 2019 +0200 Merge branch 'master' of git.sv.gnu.org:/srv/git/emacs commit 280dd6c49d46887f5c554c926119e277f347ca06 Author: Eli Zaretskii Date: Fri Apr 19 15:59:49 2019 +0300 ; Minor improvement in documentation from recent commit * doc/lispref/processes.texi (Asynchronous Processes): Say explicitly that it's an error to pass non-nil value for :stopped when starting a process. (Bug#30460) diff --git a/doc/lispref/processes.texi b/doc/lispref/processes.texi index 43009b35b2..7eb136af5f 100644 --- a/doc/lispref/processes.texi +++ b/doc/lispref/processes.texi @@ -678,10 +678,11 @@ Initialize the process query flag to @var{query-flag}. @xref{Query Before Exit}. @item :stop @var{stopped} -@var{stopped} must be @code{nil}. The @code{:stop} key is ignored -otherwise and is retained for compatibility with other process types -such as pipe processes. Asynchronous subprocesses never start in the -stopped state. +If provided, @var{stopped} must be @code{nil}; it is an error to use +any non-@code{nil} value. The @code{:stop} key is ignored otherwise +and is retained for compatibility with other process types such as +pipe processes. Asynchronous subprocesses never start in the stopped +state. @item :filter @var{filter} Initialize the process filter to @var{filter}. If not specified, a commit 06bbd6dfd131315ead26439ce13f96a3c3f5645e Author: Michael Albinus Date: Fri Apr 19 14:28:20 2019 +0200 Do not handle :stop in tramp-*-handle-make-process * lisp/net/tramp-adb.el (tramp-adb-handle-make-process): * lisp/net/tramp-sh.el (tramp-sh-handle-make-process): Do not handle :stop anymore. diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el index f3aa55f16f..71d7f61b91 100644 --- a/lisp/net/tramp-adb.el +++ b/lisp/net/tramp-adb.el @@ -934,7 +934,6 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (command (plist-get args :command)) (coding (plist-get args :coding)) (noquery (plist-get args :noquery)) - (stop (plist-get args :stop)) (connection-type (plist-get args :connection-type)) (filter (plist-get args :filter)) (sentinel (plist-get args :sentinel)) @@ -1010,9 +1009,6 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." ;; Send the command. (let* ((p (tramp-get-connection-process v))) (tramp-adb-send-command v command nil t) ; nooutput - ;; Stop process if indicated. - (when stop - (stop-process p)) ;; Set sentinel and filter. (when sentinel (set-process-sentinel p sentinel)) diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index d9751a9f97..dc64726e21 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -2781,7 +2781,6 @@ the result will be a local, non-Tramp, file name." (command (plist-get args :command)) (coding (plist-get args :coding)) (noquery (plist-get args :noquery)) - (stop (plist-get args :stop)) (connection-type (plist-get args :connection-type)) (filter (plist-get args :filter)) (sentinel (plist-get args :sentinel)) @@ -2933,9 +2932,6 @@ the result will be a local, non-Tramp, file name." v 'file-error "pty association is not supported for `%s'" name)))) - ;; Stop process if indicated. - (when stop - (stop-process p)) ;; Set sentinel and filter. (when sentinel (set-process-sentinel p sentinel)) commit 0eb47c2537ad73f9582df6b8cd9021e13feb9a4f Author: Michael Albinus Date: Fri Apr 19 14:18:59 2019 +0200 ; Remove instrumentation in tramp-tests diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index cadb282aec..e2f806e827 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -4085,15 +4085,11 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (defun tramp--test-shell-command-to-string-asynchronously (command) "Like `shell-command-to-string', but for asynchronous processes." (with-temp-buffer - (unwind-protect - (async-shell-command command (current-buffer)) - (with-timeout - ((if (getenv "EMACS_EMBA_CI") 30 10) (tramp--test-timeout-handler)) - (while (accept-process-output - (get-buffer-process (current-buffer)) nil nil t))) - (tramp--test-message - "# %s\n%s" - command (buffer-substring-no-properties (point-min) (point-max)))) + (async-shell-command command (current-buffer)) + (with-timeout + ((if (getenv "EMACS_EMBA_CI") 30 10) (tramp--test-timeout-handler)) + (while (accept-process-output + (get-buffer-process (current-buffer)) nil nil t))) (buffer-substring-no-properties (point-min) (point-max)))) (ert-deftest tramp-test32-shell-command () commit 5c5e309527e6b582e2c04b83e7af45f3144863ac Author: Philipp Stephani Date: Fri Apr 19 13:03:40 2019 +0200 Remove :stop key from make-process. This has never worked and caused issues such as Bug#30460. * src/process.c (Fmake_process): Don't accept :stop key any more. (syms_of_process): Define needed symbol 'null'. * test/src/process-tests.el (make-process/stop): New unit test. * doc/lispref/processes.texi (Asynchronous Processes): Remove :stop key from manual. diff --git a/doc/lispref/processes.texi b/doc/lispref/processes.texi index 6be311b563..43009b35b2 100644 --- a/doc/lispref/processes.texi +++ b/doc/lispref/processes.texi @@ -678,7 +678,9 @@ Initialize the process query flag to @var{query-flag}. @xref{Query Before Exit}. @item :stop @var{stopped} -If @var{stopped} is non-@code{nil}, start the process in the +@var{stopped} must be @code{nil}. The @code{:stop} key is ignored +otherwise and is retained for compatibility with other process types +such as pipe processes. Asynchronous subprocesses never start in the stopped state. @item :filter @var{filter} diff --git a/etc/NEWS b/etc/NEWS index 3e3454bd93..4d76143b13 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1515,6 +1515,9 @@ The global value of 'indent-line-function', which defaults to To get back the old behavior, add a function to 'text-mode-hook' which performs (setq-local indent-line-function #'indent-relative). +** 'make-process' no longer accepts a non-nil ':stop' key. This has +never worked reliably, and now causes an error. + * Lisp Changes in Emacs 27.1 diff --git a/src/process.c b/src/process.c index 0c44037162..6717ccb418 100644 --- a/src/process.c +++ b/src/process.c @@ -1643,10 +1643,11 @@ ENCODING is used for writing. :noquery BOOL -- When exiting Emacs, query the user if BOOL is nil and the process is running. If BOOL is not given, query before exiting. -:stop BOOL -- Start process in the `stopped' state if BOOL non-nil. -In the stopped state, a process does not accept incoming data, but you -can send outgoing data. The stopped state is cleared by -`continue-process' and set by `stop-process'. +:stop BOOL -- BOOL must be nil. The `:stop' key is ignored otherwise +and is retained for compatibility with other process types such as +pipe processes. Asynchronous subprocesses never start in the +`stopped' state. Use `stop-process' and `continue-process' to send +signals to stop and continue a process. :connection-type TYPE -- TYPE is control type of device used to communicate with subprocesses. Values are `pipe' to use a pipe, `pty' @@ -1746,8 +1747,10 @@ usage: (make-process &rest ARGS) */) if (!query_on_exit) XPROCESS (proc)->kill_without_query = 1; - if (tem = Fplist_get (contact, QCstop), !NILP (tem)) - pset_command (XPROCESS (proc), Qt); + tem = Fplist_get (contact, QCstop); + /* Normal processes can't be started in a stopped state, see + Bug#30460. */ + CHECK_TYPE (NILP (tem), Qnull, tem); tem = Fplist_get (contact, QCconnection_type); if (EQ (tem, Qpty)) @@ -8300,6 +8303,8 @@ returns non-`nil'. */); "internal-default-interrupt-process"); DEFSYM (Qinterrupt_process_functions, "interrupt-process-functions"); + DEFSYM (Qnull, "null"); + defsubr (&Sprocessp); defsubr (&Sget_process); defsubr (&Sdelete_process); diff --git a/test/src/process-tests.el b/test/src/process-tests.el index 0bb7ebe50a..b853f77946 100644 --- a/test/src/process-tests.el +++ b/test/src/process-tests.el @@ -284,5 +284,14 @@ file name handler." (put #'process-tests--file-handler 'operations '(unhandled-file-name-directory make-process)) +(ert-deftest make-process/stop () + "Check that `make-process' doesn't accept a `:stop' key. +See Bug#30460." + (should-error + (make-process :name "test" + :command (list (expand-file-name invocation-name + invocation-directory)) + :stop t))) + (provide 'process-tests) ;; process-tests.el ends here. commit 3ff7d7321ac62b1eb896e8a032e7f75f5a6b8146 Author: Michael Albinus Date: Fri Apr 19 11:30:22 2019 +0200 Adapt tramp-test32-shell-command * test/lisp/net/tramp-tests.el (tramp-test32-shell-command): Check "tput" before running `shell-command-width' test. diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index f228c5c5a8..cadb282aec 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -4193,16 +4193,11 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (ignore-errors (delete-file tmp-name))) ;; Test `shell-command-width' of `async-shell-command'. - ;; `executable-find' has changed the number of parameters in - ;; Emacs 27.1, so we use `apply' for older Emacsen. - (when (and (executable-find "tput") - (apply #'executable-find '("tput" 'remote))) + (when (and (zerop (call-process "tput" nil nil nil "cols")) + (zerop (process-file "tput" nil nil nil "cols"))) (let (shell-command-width) (should (string-equal - ;; `frame-width' does not return a proper value. - ;; `process-lines' uses `call-process', it doesn't care - ;; about `shell-command-width'. (format "%s\n" (car (process-lines "tput" "cols"))) (tramp--test-shell-command-to-string-asynchronously "tput cols")))