commit 8255eb526f53d9e4532cfedb8de25f39365f99bc (HEAD, refs/remotes/origin/master) Author: Stefan Monnier Date: Sat Aug 15 22:44:16 2020 -0400 * lisp/net/eudc-bob.el (eudc-bob-pipe-object-to-external-program): Simplify Use `with-temp-buffer`. diff --git a/lisp/net/eudc-bob.el b/lisp/net/eudc-bob.el index 1d7005bb84..bb6682520a 100644 --- a/lisp/net/eudc-bob.el +++ b/lisp/net/eudc-bob.el @@ -230,26 +230,20 @@ display a button." (coding-system-for-write 'binary)) ;Inhibit EOL conversion. (write-region data nil filename))) -(defun eudc-bob-pipe-object-to-external-program () +(defun eudc-bob-pipe-object-to-external-program (program) "Pipe the object data of the button at point to an external program." - (interactive) + (interactive (list (completing-read "Viewer: " eudc-external-viewers))) (let ((data (eudc-bob-get-overlay-prop 'object-data)) - (buffer (generate-new-buffer "*eudc-tmp*")) - program - viewer) - (condition-case nil - (save-excursion - (set-buffer-file-coding-system 'binary) - (set-buffer buffer) - (insert data) - (setq program (completing-read "Viewer: " eudc-external-viewers)) - (if (setq viewer (assoc program eudc-external-viewers)) - (call-process-region (point-min) (point-max) - (car (cdr viewer)) - (cdr (cdr viewer))) - (call-process-region (point-min) (point-max) program))) - (error - (kill-buffer buffer))))) + (viewer (assoc program eudc-external-viewers))) + (with-temp-buffer + (set-buffer-multibyte nil) + (insert data) + (let ((coding-system-for-write 'binary)) ;Inhibit EOL conversion + (if viewer + (call-process-region (point-min) (point-max) + (car (cdr viewer)) + (cdr (cdr viewer))) + (call-process-region (point-min) (point-max) program)))))) (defun eudc-bob-menu () "Retrieve the menu attached to a binary object." commit 4bb2f395912e6b99aef79d3891b98ff71024ee2b Author: Stefan Monnier Date: Sat Aug 15 17:30:11 2020 -0400 * lisp/net/eudc-bob.el: Use lexical-binding; Misc simplifications (eudc-bob-generic-keymap, eudc-bob-image-keymap) (eudc-bob-sound-keymap, eudc-bob-url-keymap, eudc-bob-mail-keymap): Move initialization into declaration. Use RET rather than `return`. (eudc-jump-to-event): Delete; use `mouse-set-point` instead. (eudc-bob-save-object): Rewrite using `write-region`. (eudc-bob-popup-menu): Use `popup-menu`. diff --git a/lisp/net/eudc-bob.el b/lisp/net/eudc-bob.el index 56ea033a96..1d7005bb84 100644 --- a/lisp/net/eudc-bob.el +++ b/lisp/net/eudc-bob.el @@ -1,4 +1,4 @@ -;;; eudc-bob.el --- Binary Objects Support for EUDC +;;; eudc-bob.el --- Binary Objects Support for EUDC -*- lexical-binding: t; -*- ;; Copyright (C) 1999-2020 Free Software Foundation, Inc. @@ -39,19 +39,41 @@ (require 'eudc) -(defvar eudc-bob-generic-keymap nil +(defvar eudc-bob-generic-keymap + (let ((map (make-sparse-keymap))) + (define-key map "s" 'eudc-bob-save-object) + (define-key map "!" 'eudc-bob-pipe-object-to-external-program) + (define-key map [down-mouse-3] 'eudc-bob-popup-menu) + map) "Keymap for multimedia objects.") -(defvar eudc-bob-image-keymap nil +(defvar eudc-bob-image-keymap + (let ((map (make-sparse-keymap))) + (set-keymap-parent map eudc-bob-generic-keymap) + (define-key map "t" 'eudc-bob-toggle-inline-display) + map) "Keymap for inline images.") -(defvar eudc-bob-sound-keymap nil +(defvar eudc-bob-sound-keymap + (let ((map (make-sparse-keymap))) + (set-keymap-parent map eudc-bob-generic-keymap) + (define-key map (kbd "RET") 'eudc-bob-play-sound-at-point) + (define-key map [down-mouse-2] 'eudc-bob-play-sound-at-mouse) + map) "Keymap for inline sounds.") -(defvar eudc-bob-url-keymap nil +(defvar eudc-bob-url-keymap + (let ((map (make-sparse-keymap))) + (define-key map (kbd "RET") 'browse-url-at-point) + (define-key map [down-mouse-2] 'browse-url-at-mouse) + map) "Keymap for inline urls.") -(defvar eudc-bob-mail-keymap nil +(defvar eudc-bob-mail-keymap + (let ((map (make-sparse-keymap))) + (define-key map (kbd "RET") 'goto-address-at-point) + (define-key map [down-mouse-2] 'goto-address-at-point) + map) "Keymap for inline e-mail addresses.") (defvar eudc-bob-generic-menu @@ -74,13 +96,6 @@ (fboundp 'play-sound-internal)] ,@(cdr (cdr eudc-bob-generic-menu)))) -(defun eudc-jump-to-event (event) - "Jump to the window and point where EVENT occurred." - (if (fboundp 'event-closest-point) - (goto-char (event-closest-point event)) - (set-buffer (window-buffer (posn-window (event-start event)))) - (goto-char (posn-point (event-start event))))) - (defun eudc-bob-get-overlay-prop (prop) "Get property PROP from one of the overlays around." (let ((overlays (append (overlays-at (1- (point))) @@ -205,21 +220,15 @@ display a button." "Play the sound data contained in the button where EVENT occurred." (interactive "e") (save-excursion - (eudc-jump-to-event event) + (mouse-set-point event) (eudc-bob-play-sound-at-point))) -(defun eudc-bob-save-object () +(defun eudc-bob-save-object (filename) "Save the object data of the button at point." - (interactive) + (interactive "fWrite file: ") (let ((data (eudc-bob-get-overlay-prop 'object-data)) - (buffer (generate-new-buffer "*eudc-tmp*"))) - (save-excursion - (set-buffer-file-coding-system 'binary) - (set-buffer buffer) - (set-buffer-multibyte nil) - (insert data) - (save-buffer)) - (kill-buffer buffer))) + (coding-system-for-write 'binary)) ;Inhibit EOL conversion. + (write-region data nil filename))) (defun eudc-bob-pipe-object-to-external-program () "Pipe the object data of the button at point to an external program." @@ -250,47 +259,8 @@ display a button." "Pop-up a menu of EUDC multimedia commands." (interactive "@e") (run-hooks 'activate-menubar-hook) - (eudc-jump-to-event event) - (let ((result (x-popup-menu t (eudc-bob-menu))) - command) - (if result - (progn - (setq command (lookup-key (eudc-bob-menu) - (apply 'vector result))) - (command-execute command))))) - -(setq eudc-bob-generic-keymap - (let ((map (make-sparse-keymap))) - (define-key map "s" 'eudc-bob-save-object) - (define-key map "!" 'eudc-bob-pipe-object-to-external-program) - (define-key map [down-mouse-3] 'eudc-bob-popup-menu) - map)) - -(setq eudc-bob-image-keymap - (let ((map (make-sparse-keymap))) - (define-key map "t" 'eudc-bob-toggle-inline-display) - map)) - -(setq eudc-bob-sound-keymap - (let ((map (make-sparse-keymap))) - (define-key map [return] 'eudc-bob-play-sound-at-point) - (define-key map [down-mouse-2] 'eudc-bob-play-sound-at-mouse) - map)) - -(setq eudc-bob-url-keymap - (let ((map (make-sparse-keymap))) - (define-key map [return] 'browse-url-at-point) - (define-key map [down-mouse-2] 'browse-url-at-mouse) - map)) - -(setq eudc-bob-mail-keymap - (let ((map (make-sparse-keymap))) - (define-key map [return] 'goto-address-at-point) - (define-key map [down-mouse-2] 'goto-address-at-point) - map)) - -(set-keymap-parent eudc-bob-image-keymap eudc-bob-generic-keymap) -(set-keymap-parent eudc-bob-sound-keymap eudc-bob-generic-keymap) + (mouse-set-point event) + (popup-menu (eudc-bob-menu) event)) ;; If the first arguments can be nil here, then these 3 can be ;; defconsts once more. commit 748afc183c2c44b7b2a582d3078cf3d8b4d5270a Author: Paul Eggert Date: Sat Aug 15 12:32:56 2020 -0700 Fix recently-introduced Fdelete bug Problem reported by Pip Cet in: https://lists.gnu.org/r/emacs-devel/2020-08/msg00444.html * src/fns.c (Fdelete): Fix correctness bug via a simpler (though more memory-intensive) approach. It’s probably not worth optimizing the memory usage yere. * test/src/fns-tests.el (test-vector-delete): Add test for the bug. diff --git a/src/fns.c b/src/fns.c index 069edbe90e..a3b8d6ef57 100644 --- a/src/fns.c +++ b/src/fns.c @@ -1749,38 +1749,17 @@ changing the value of a sequence `foo'. */) { ptrdiff_t n = 0; ptrdiff_t size = ASIZE (seq); - ptrdiff_t neqbits_words = ((size + BITS_PER_BITS_WORD - 1) - / BITS_PER_BITS_WORD); USE_SAFE_ALLOCA; - bits_word *neqbits = SAFE_ALLOCA (neqbits_words * sizeof *neqbits); - bits_word neqword = 0; + Lisp_Object *kept = SAFE_ALLOCA (size * sizeof *kept); for (ptrdiff_t i = 0; i < size; i++) { - bool neq = NILP (Fequal (AREF (seq, i), elt)); - n += neq; - neqbits[i / BITS_PER_BITS_WORD] = neqword = (neqword << 1) + neq; + kept[n] = AREF (seq, i); + n += NILP (Fequal (AREF (seq, i), elt)); } if (n != size) - { - struct Lisp_Vector *p = allocate_vector (n); - - if (n != 0) - { - ptrdiff_t j = 0; - for (ptrdiff_t i = 0; ; i++) - if (neqbits[i / BITS_PER_BITS_WORD] - & ((bits_word) 1 << (i % BITS_PER_BITS_WORD))) - { - p->contents[j++] = AREF (seq, i); - if (j == n) - break; - } - } - - XSETVECTOR (seq, p); - } + seq = Fvector (n, kept); SAFE_FREE (); } diff --git a/test/src/fns-tests.el b/test/src/fns-tests.el index 141de1d226..400e912648 100644 --- a/test/src/fns-tests.el +++ b/test/src/fns-tests.el @@ -898,5 +898,6 @@ (ert-deftest test-vector-delete () (let ((v1 (make-vector 1000 1))) + (should (equal (delete t [nil t]) [nil])) (should (equal (delete 1 v1) (vector))) (should (equal (delete 2 v1) v1)))) commit b467bb531e1ab0eed57e1889004d2115e80e4292 Author: Paul Eggert Date: Sat Aug 15 10:48:37 2020 -0700 Minimize ‘equal’ calls in (delete x vector) * src/fns.c (Fdelete): When deleting from a vector, call Fequal only once per vector element. This is faster when Fequal is slow, and avoids the need to preinitialize the vector result. Finish when the result is exhausted, not when the input is exhausted; the two are equivalent but the former may be faster. * test/src/fns-tests.el (test-vector-delete): New test. diff --git a/src/fns.c b/src/fns.c index c89bd8144e..069edbe90e 100644 --- a/src/fns.c +++ b/src/fns.c @@ -1747,22 +1747,42 @@ changing the value of a sequence `foo'. */) { if (VECTORP (seq)) { - ptrdiff_t i, n; + ptrdiff_t n = 0; + ptrdiff_t size = ASIZE (seq); + ptrdiff_t neqbits_words = ((size + BITS_PER_BITS_WORD - 1) + / BITS_PER_BITS_WORD); + USE_SAFE_ALLOCA; + bits_word *neqbits = SAFE_ALLOCA (neqbits_words * sizeof *neqbits); + bits_word neqword = 0; - for (i = n = 0; i < ASIZE (seq); ++i) - if (NILP (Fequal (AREF (seq, i), elt))) - ++n; + for (ptrdiff_t i = 0; i < size; i++) + { + bool neq = NILP (Fequal (AREF (seq, i), elt)); + n += neq; + neqbits[i / BITS_PER_BITS_WORD] = neqword = (neqword << 1) + neq; + } - if (n != ASIZE (seq)) + if (n != size) { - struct Lisp_Vector *p = allocate_nil_vector (n); + struct Lisp_Vector *p = allocate_vector (n); - for (i = n = 0; i < ASIZE (seq); ++i) - if (NILP (Fequal (AREF (seq, i), elt))) - p->contents[n++] = AREF (seq, i); + if (n != 0) + { + ptrdiff_t j = 0; + for (ptrdiff_t i = 0; ; i++) + if (neqbits[i / BITS_PER_BITS_WORD] + & ((bits_word) 1 << (i % BITS_PER_BITS_WORD))) + { + p->contents[j++] = AREF (seq, i); + if (j == n) + break; + } + } XSETVECTOR (seq, p); } + + SAFE_FREE (); } else if (STRINGP (seq)) { diff --git a/test/src/fns-tests.el b/test/src/fns-tests.el index f1faf58659..141de1d226 100644 --- a/test/src/fns-tests.el +++ b/test/src/fns-tests.el @@ -895,3 +895,8 @@ ;; This does not test randomness; it's merely a format check. (should (string-match "\\`[0-9a-f]\\{128\\}\\'" (secure-hash 'sha512 'iv-auto 100)))) + +(ert-deftest test-vector-delete () + (let ((v1 (make-vector 1000 1))) + (should (equal (delete 1 v1) (vector))) + (should (equal (delete 2 v1) v1)))) commit e97def2bbce7777d3afc916a5aa4d951fab5f3f4 Author: Paul Eggert Date: Sat Aug 15 10:48:37 2020 -0700 Fdelete speed tweak for strings * src/fns.c (Fdelete): Hoist FIXNUMP out of a loop, and turn it into CHARACTERP. diff --git a/src/fns.c b/src/fns.c index ded6f344aa..c89bd8144e 100644 --- a/src/fns.c +++ b/src/fns.c @@ -1766,6 +1766,9 @@ changing the value of a sequence `foo'. */) } else if (STRINGP (seq)) { + if (!CHARACTERP (elt)) + return seq; + ptrdiff_t i, ibyte, nchars, nbytes, cbytes; int c; @@ -1784,7 +1787,7 @@ changing the value of a sequence `foo'. */) cbytes = 1; } - if (!FIXNUMP (elt) || c != XFIXNUM (elt)) + if (c != XFIXNUM (elt)) { ++nchars; nbytes += cbytes; @@ -1814,7 +1817,7 @@ changing the value of a sequence `foo'. */) cbytes = 1; } - if (!FIXNUMP (elt) || c != XFIXNUM (elt)) + if (c != XFIXNUM (elt)) { unsigned char *from = SDATA (seq) + ibyte; unsigned char *to = SDATA (tem) + nbytes; commit f1b06fd5fc66377f85b420d3d40c666da9dca2a5 Author: Paul Eggert Date: Sat Aug 15 10:48:36 2020 -0700 Prefer Fvector to make_uninit_vector Fvector is less error-prone than make_uninit_vector, as it avoids the possibility of a GC crash due to an uninitialized vector. So prefer Fvector to make_uninit_vector when this is easy (and when there's no significant performance difference). Inspired by a suggestion by Pip Cet in: https://lists.gnu.org/r/emacs-devel/2020-08/msg00313.html * src/ccl.c (Fregister_ccl_program): * src/ccl.c (Fregister_ccl_program): * src/charset.c (Fdefine_charset_internal): * src/font.c (Fquery_font, Ffont_info, syms_of_font): * src/fontset.c (font_def_new, Fset_fontset_font): * src/ftfont.c (ftfont_shape_by_flt): * src/hbfont.c (hbfont_shape): * src/macfont.m (macfont_shape): * src/search.c (Fnewline_cache_check): * src/xfaces.c (Fx_family_fonts): * src/xfns.c (Fx_window_property_attributes): Prefer Fvector to make_uninit_vector when either is easy. * src/fontset.c (font_def_new): Now a function with one less arg instead of a do-while macro, and renamed from FONT_DEF_NEW. All uses changed. diff --git a/src/ccl.c b/src/ccl.c index ef059ffff2..e85cfa6cdf 100644 --- a/src/ccl.c +++ b/src/ccl.c @@ -2219,15 +2219,8 @@ Return index number of the registered CCL program. */) /* Extend the table. */ Vccl_program_table = larger_vector (Vccl_program_table, 1, -1); - { - Lisp_Object elt = make_uninit_vector (4); - - ASET (elt, 0, name); - ASET (elt, 1, ccl_prog); - ASET (elt, 2, resolved); - ASET (elt, 3, Qt); - ASET (Vccl_program_table, idx, elt); - } + ASET (Vccl_program_table, idx, + CALLN (Fvector, name, ccl_prog, resolved, Qt)); Fput (name, Qccl_program_idx, make_fixnum (idx)); return make_fixnum (idx); diff --git a/src/charset.c b/src/charset.c index 8635aad3ed..520dd3a960 100644 --- a/src/charset.c +++ b/src/charset.c @@ -1035,12 +1035,9 @@ usage: (define-charset-internal ...) */) CHECK_FIXNAT (parent_max_code); parent_code_offset = Fnth (make_fixnum (3), val); CHECK_FIXNUM (parent_code_offset); - val = make_uninit_vector (4); - ASET (val, 0, make_fixnum (parent_charset->id)); - ASET (val, 1, parent_min_code); - ASET (val, 2, parent_max_code); - ASET (val, 3, parent_code_offset); - ASET (attrs, charset_subset, val); + ASET (attrs, charset_subset, + CALLN (Fvector, make_fixnum (parent_charset->id), + parent_min_code, parent_max_code, parent_code_offset)); charset.method = CHARSET_METHOD_SUBSET; /* Here, we just copy the parent's fast_map. It's not accurate, diff --git a/src/font.c b/src/font.c index ccbd3fc9ce..5c01c7ff79 100644 --- a/src/font.c +++ b/src/font.c @@ -4847,21 +4847,18 @@ If the font is not OpenType font, CAPABILITY is nil. */) (Lisp_Object font_object) { struct font *font = CHECK_FONT_GET_OBJECT (font_object); - Lisp_Object val = make_uninit_vector (9); - - ASET (val, 0, AREF (font_object, FONT_NAME_INDEX)); - ASET (val, 1, AREF (font_object, FONT_FILE_INDEX)); - ASET (val, 2, make_fixnum (font->pixel_size)); - ASET (val, 3, make_fixnum (font->max_width)); - ASET (val, 4, make_fixnum (font->ascent)); - ASET (val, 5, make_fixnum (font->descent)); - ASET (val, 6, make_fixnum (font->space_width)); - ASET (val, 7, make_fixnum (font->average_width)); - if (font->driver->otf_capability) - ASET (val, 8, Fcons (Qopentype, font->driver->otf_capability (font))); - else - ASET (val, 8, Qnil); - return val; + return CALLN (Fvector, + AREF (font_object, FONT_NAME_INDEX), + AREF (font_object, FONT_FILE_INDEX), + make_fixnum (font->pixel_size), + make_fixnum (font->max_width), + make_fixnum (font->ascent), + make_fixnum (font->descent), + make_fixnum (font->space_width), + make_fixnum (font->average_width), + (font->driver->otf_capability + ? Fcons (Qopentype, font->driver->otf_capability (font)) + : Qnil)); } DEFUN ("font-get-glyphs", Ffont_get_glyphs, Sfont_get_glyphs, 3, 4, 0, @@ -5168,24 +5165,23 @@ If the named font cannot be opened and loaded, return nil. */) return Qnil; font = XFONT_OBJECT (font_object); - info = make_uninit_vector (14); - ASET (info, 0, AREF (font_object, FONT_NAME_INDEX)); - ASET (info, 1, AREF (font_object, FONT_FULLNAME_INDEX)); - ASET (info, 2, make_fixnum (font->pixel_size)); - ASET (info, 3, make_fixnum (font->height)); - ASET (info, 4, make_fixnum (font->baseline_offset)); - ASET (info, 5, make_fixnum (font->relative_compose)); - ASET (info, 6, make_fixnum (font->default_ascent)); - ASET (info, 7, make_fixnum (font->max_width)); - ASET (info, 8, make_fixnum (font->ascent)); - ASET (info, 9, make_fixnum (font->descent)); - ASET (info, 10, make_fixnum (font->space_width)); - ASET (info, 11, make_fixnum (font->average_width)); - ASET (info, 12, AREF (font_object, FONT_FILE_INDEX)); - if (font->driver->otf_capability) - ASET (info, 13, Fcons (Qopentype, font->driver->otf_capability (font))); - else - ASET (info, 13, Qnil); + info = CALLN (Fvector, + AREF (font_object, FONT_NAME_INDEX), + AREF (font_object, FONT_FULLNAME_INDEX), + make_fixnum (font->pixel_size), + make_fixnum (font->height), + make_fixnum (font->baseline_offset), + make_fixnum (font->relative_compose), + make_fixnum (font->default_ascent), + make_fixnum (font->max_width), + make_fixnum (font->ascent), + make_fixnum (font->descent), + make_fixnum (font->space_width), + make_fixnum (font->average_width), + AREF (font_object, FONT_FILE_INDEX), + (font->driver->otf_capability + ? Fcons (Qopentype, font->driver->otf_capability (font)) + : Qnil)); #if 0 /* As font_object is still in FONT_OBJLIST of the entity, we can't @@ -5494,10 +5490,8 @@ This variable cannot be set; trying to do so will signal an error. */); make_symbol_constant (intern_c_string ("font-width-table")); staticpro (&font_style_table); - font_style_table = make_uninit_vector (3); - ASET (font_style_table, 0, Vfont_weight_table); - ASET (font_style_table, 1, Vfont_slant_table); - ASET (font_style_table, 2, Vfont_width_table); + font_style_table = CALLN (Fvector, Vfont_weight_table, Vfont_slant_table, + Vfont_width_table); DEFVAR_LISP ("font-log", Vfont_log, doc: /* A list that logs font-related actions and results, for debugging. diff --git a/src/fontset.c b/src/fontset.c index c2bb8b21f2..8c86075c07 100644 --- a/src/fontset.c +++ b/src/fontset.c @@ -252,14 +252,13 @@ set_fontset_fallback (Lisp_Object fontset, Lisp_Object fallback) #define BASE_FONTSET_P(fontset) (NILP (FONTSET_BASE (fontset))) -/* Macros for FONT-DEF and RFONT-DEF of fontset. */ -#define FONT_DEF_NEW(font_def, font_spec, encoding, repertory) \ - do { \ - (font_def) = make_uninit_vector (3); \ - ASET ((font_def), 0, font_spec); \ - ASET ((font_def), 1, encoding); \ - ASET ((font_def), 2, repertory); \ - } while (0) +/* Definitions for FONT-DEF and RFONT-DEF of fontset. */ +static Lisp_Object +font_def_new (Lisp_Object font_spec, Lisp_Object encoding, + Lisp_Object repertory) +{ + return CALLN (Fvector, font_spec, encoding, repertory); +} #define FONT_DEF_SPEC(font_def) AREF (font_def, 0) #define FONT_DEF_ENCODING(font_def) AREF (font_def, 1) @@ -1547,7 +1546,7 @@ appended. By default, FONT-SPEC overrides the previous settings. */) repertory = CHARSET_SYMBOL_ID (repertory); } } - FONT_DEF_NEW (font_def, font_spec, encoding, repertory); + font_def = font_def_new (font_spec, encoding, repertory); } else font_def = Qnil; @@ -1619,14 +1618,8 @@ appended. By default, FONT-SPEC overrides the previous settings. */) if (charset) { - Lisp_Object arg; - - arg = make_uninit_vector (5); - ASET (arg, 0, fontset); - ASET (arg, 1, font_def); - ASET (arg, 2, add); - ASET (arg, 3, ascii_changed ? Qt : Qnil); - ASET (arg, 4, range_list); + Lisp_Object arg = CALLN (Fvector, fontset, font_def, add, + ascii_changed ? Qt : Qnil, range_list); map_charset_chars (set_fontset_font, Qnil, arg, charset, CHARSET_MIN_CODE (charset), diff --git a/src/ftfont.c b/src/ftfont.c index 696f5e6534..a904007a32 100644 --- a/src/ftfont.c +++ b/src/ftfont.c @@ -2826,14 +2826,10 @@ ftfont_shape_by_flt (Lisp_Object lgstring, struct font *font, LGLYPH_SET_ASCENT (lglyph, g->g.ascent >> 6); LGLYPH_SET_DESCENT (lglyph, g->g.descent >> 6); if (g->g.adjusted) - { - Lisp_Object vec = make_uninit_vector (3); - - ASET (vec, 0, make_fixnum (g->g.xoff >> 6)); - ASET (vec, 1, make_fixnum (g->g.yoff >> 6)); - ASET (vec, 2, make_fixnum (g->g.xadv >> 6)); - LGLYPH_SET_ADJUSTMENT (lglyph, vec); - } + LGLYPH_SET_ADJUSTMENT (lglyph, CALLN (Fvector, + make_fixnum (g->g.xoff >> 6), + make_fixnum (g->g.yoff >> 6), + make_fixnum (g->g.xadv >> 6))); } return make_fixnum (i); } diff --git a/src/hbfont.c b/src/hbfont.c index 4b3f64ef50..82b115e686 100644 --- a/src/hbfont.c +++ b/src/hbfont.c @@ -594,13 +594,10 @@ hbfont_shape (Lisp_Object lgstring, Lisp_Object direction) yoff = - lround (pos[i].y_offset * position_unit); wadjust = lround (pos[i].x_advance * position_unit); if (xoff || yoff || wadjust != metrics.width) - { - Lisp_Object vec = make_uninit_vector (3); - ASET (vec, 0, make_fixnum (xoff)); - ASET (vec, 1, make_fixnum (yoff)); - ASET (vec, 2, make_fixnum (wadjust)); - LGLYPH_SET_ADJUSTMENT (lglyph, vec); - } + LGLYPH_SET_ADJUSTMENT (lglyph, CALLN (Fvector, + make_fixnum (xoff), + make_fixnum (yoff), + make_fixnum (wadjust))); } return make_fixnum (glyph_len); diff --git a/src/macfont.m b/src/macfont.m index c7430d3277..904814647f 100644 --- a/src/macfont.m +++ b/src/macfont.m @@ -3137,10 +3137,8 @@ So we use CTFontDescriptorCreateMatchingFontDescriptor (no wadjust = lround (gl->advance); if (xoff != 0 || yoff != 0 || wadjust != metrics.width) { - Lisp_Object vec = make_uninit_vector (3); - ASET (vec, 0, make_fixnum (xoff)); - ASET (vec, 1, make_fixnum (yoff)); - ASET (vec, 2, make_fixnum (wadjust)); + Lisp_Object vec = CALLN (Fvector, make_fixnum (xoff), + make_fixnum (yoff), make_fixnum (wadjust)); LGLYPH_SET_ADJUSTMENT (lglyph, vec); } } diff --git a/src/search.c b/src/search.c index 23b31d9281..6fb3716cd4 100644 --- a/src/search.c +++ b/src/search.c @@ -3306,9 +3306,7 @@ the buffer. If the buffer doesn't have a cache, the value is nil. */) } /* Construct the value and return it. */ - val = make_uninit_vector (2); - ASET (val, 0, cache_newlines); - ASET (val, 1, buf_newlines); + val = CALLN (Fvector, cache_newlines, buf_newlines); if (old != NULL) set_buffer_internal_1 (old); diff --git a/src/xfaces.c b/src/xfaces.c index 2c6e593f63..06d2f994de 100644 --- a/src/xfaces.c +++ b/src/xfaces.c @@ -1572,22 +1572,18 @@ the face font sort order. */) for (i = nfonts - 1; i >= 0; --i) { Lisp_Object font = AREF (vec, i); - Lisp_Object v = make_uninit_vector (8); - int point; - Lisp_Object spacing; - - ASET (v, 0, AREF (font, FONT_FAMILY_INDEX)); - ASET (v, 1, FONT_WIDTH_SYMBOLIC (font)); - point = PIXEL_TO_POINT (XFIXNUM (AREF (font, FONT_SIZE_INDEX)) * 10, - FRAME_RES_Y (f)); - ASET (v, 2, make_fixnum (point)); - ASET (v, 3, FONT_WEIGHT_SYMBOLIC (font)); - ASET (v, 4, FONT_SLANT_SYMBOLIC (font)); - spacing = Ffont_get (font, QCspacing); - ASET (v, 5, (NILP (spacing) || EQ (spacing, Qp)) ? Qnil : Qt); - ASET (v, 6, Ffont_xlfd_name (font, Qnil)); - ASET (v, 7, AREF (font, FONT_REGISTRY_INDEX)); - + int point = PIXEL_TO_POINT (XFIXNUM (AREF (font, FONT_SIZE_INDEX)) * 10, + FRAME_RES_Y (f)); + Lisp_Object spacing = Ffont_get (font, QCspacing); + Lisp_Object v = CALLN (Fvector, + AREF (font, FONT_FAMILY_INDEX), + FONT_WIDTH_SYMBOLIC (font), + make_fixnum (point), + FONT_WEIGHT_SYMBOLIC (font), + FONT_SLANT_SYMBOLIC (font), + NILP (spacing) || EQ (spacing, Qp) ? Qnil : Qt, + Ffont_xlfd_name (font, Qnil), + AREF (font, FONT_REGISTRY_INDEX)); result = Fcons (v, result); } diff --git a/src/xfns.c b/src/xfns.c index 09dcbbfb92..07bba90eaf 100644 --- a/src/xfns.c +++ b/src/xfns.c @@ -6196,10 +6196,10 @@ Otherwise, the return value is a vector with the following fields: { XFree (tmp_data); - prop_attr = make_uninit_vector (3); - ASET (prop_attr, 0, make_fixnum (actual_type)); - ASET (prop_attr, 1, make_fixnum (actual_format)); - ASET (prop_attr, 2, make_fixnum (bytes_remaining / (actual_format >> 3))); + prop_attr = CALLN (Fvector, + make_fixnum (actual_type), + make_fixnum (actual_format), + make_fixnum (bytes_remaining / (actual_format >> 3))); } unblock_input (); commit d0145537fa511a44e2a4af01da3947e92f0b8331 Author: Paul Eggert Date: Sat Aug 15 10:48:36 2020 -0700 Fix GC bugs related to uninitialized vectors Avoid problems if GC occurs while initializing a vector. Problem with Fdelete reported by Pip Cet in: https://lists.gnu.org/r/emacs-devel/2020-08/msg00313.html I looked for similar problems elsewhere and found quite a few. * src/coding.c (make_subsidiaries): * src/composite.c (syms_of_composite): * src/font.c (build_style_table, Ffont_get_glyphs): * src/nsselect.m (clean_local_selection_data): * src/nsxwidget.m (js_to_lisp): * src/syntax.c (init_syntax_once): * src/window.c (Fcurrent_window_configuration): * src/xselect.c (selection_data_to_lisp_data) (clean_local_selection_data): Use make_nil_vector instead of make_uninit_vector. * src/fns.c (Fdelete): * src/xwidget.c (webkit_js_to_lisp): Use allocate_nil_vector instead of allocate_vector. * src/search.c (Fnewline_cache_check): Use make_vector instead of make_uninit_vector. diff --git a/src/coding.c b/src/coding.c index 1d79c703a3..51bd441de9 100644 --- a/src/coding.c +++ b/src/coding.c @@ -10856,20 +10856,17 @@ HIGHESTP non-nil means just return the highest priority one. */) return Fnreverse (val); } -static const char *const suffixes[] = { "-unix", "-dos", "-mac" }; - static Lisp_Object make_subsidiaries (Lisp_Object base) { - Lisp_Object subsidiaries; + static char const suffixes[][8] = { "-unix", "-dos", "-mac" }; ptrdiff_t base_name_len = SBYTES (SYMBOL_NAME (base)); USE_SAFE_ALLOCA; char *buf = SAFE_ALLOCA (base_name_len + 6); - int i; memcpy (buf, SDATA (SYMBOL_NAME (base)), base_name_len); - subsidiaries = make_uninit_vector (3); - for (i = 0; i < 3; i++) + Lisp_Object subsidiaries = make_nil_vector (3); + for (int i = 0; i < 3; i++) { strcpy (buf + base_name_len, suffixes[i]); ASET (subsidiaries, i, intern (buf)); diff --git a/src/composite.c b/src/composite.c index ec2b8328f7..396d456f8c 100644 --- a/src/composite.c +++ b/src/composite.c @@ -1939,7 +1939,7 @@ syms_of_composite (void) staticpro (&gstring_hash_table); staticpro (&gstring_work_headers); - gstring_work_headers = make_uninit_vector (8); + gstring_work_headers = make_nil_vector (8); for (i = 0; i < 8; i++) ASET (gstring_work_headers, i, make_nil_vector (i + 2)); staticpro (&gstring_work); diff --git a/src/fns.c b/src/fns.c index 9199178212..ded6f344aa 100644 --- a/src/fns.c +++ b/src/fns.c @@ -1755,7 +1755,7 @@ changing the value of a sequence `foo'. */) if (n != ASIZE (seq)) { - struct Lisp_Vector *p = allocate_vector (n); + struct Lisp_Vector *p = allocate_nil_vector (n); for (i = n = 0; i < ASIZE (seq); ++i) if (NILP (Fequal (AREF (seq, i), elt))) diff --git a/src/font.c b/src/font.c index ab00402b40..ccbd3fc9ce 100644 --- a/src/font.c +++ b/src/font.c @@ -4889,7 +4889,7 @@ the corresponding element is nil. */) { struct font *font = CHECK_FONT_GET_OBJECT (font_object); ptrdiff_t len; - Lisp_Object *chars, vec; + Lisp_Object *chars; USE_SAFE_ALLOCA; if (NILP (object)) @@ -4957,7 +4957,7 @@ the corresponding element is nil. */) else wrong_type_argument (Qarrayp, object); - vec = make_uninit_vector (len); + Lisp_Object vec = make_nil_vector (len); for (ptrdiff_t i = 0; i < len; i++) { Lisp_Object g; @@ -5203,7 +5203,7 @@ If the named font cannot be opened and loaded, return nil. */) static Lisp_Object build_style_table (const struct table_entry *entry, int nelement) { - Lisp_Object table = make_uninit_vector (nelement); + Lisp_Object table = make_nil_vector (nelement); for (int i = 0; i < nelement; i++) { int j; diff --git a/src/lisp.h b/src/lisp.h index eaf1c6ce6d..7983339ac5 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -3916,7 +3916,6 @@ build_string (const char *str) extern Lisp_Object pure_cons (Lisp_Object, Lisp_Object); extern Lisp_Object make_vector (ptrdiff_t, Lisp_Object); -extern struct Lisp_Vector *allocate_vector (ptrdiff_t); extern struct Lisp_Vector *allocate_nil_vector (ptrdiff_t); /* Make an uninitialized vector for SIZE objects. NOTE: you must @@ -3926,7 +3925,11 @@ extern struct Lisp_Vector *allocate_nil_vector (ptrdiff_t); v = make_uninit_vector (3); ASET (v, 0, obj0); ASET (v, 1, Ffunction_can_gc ()); - ASET (v, 2, obj1); */ + ASET (v, 2, obj1); + + allocate_vector has a similar problem. */ + +extern struct Lisp_Vector *allocate_vector (ptrdiff_t); INLINE Lisp_Object make_uninit_vector (ptrdiff_t size) diff --git a/src/nsselect.m b/src/nsselect.m index 38ac66e9c7..7b1937f5d9 100644 --- a/src/nsselect.m +++ b/src/nsselect.m @@ -114,7 +114,7 @@ Updated by Christian Limpach (chris@nice.ch) if (size == 1) return clean_local_selection_data (AREF (obj, 0)); - copy = make_uninit_vector (size); + copy = make_nil_vector (size); for (i = 0; i < size; i++) ASET (copy, i, clean_local_selection_data (AREF (obj, i))); return copy; diff --git a/src/nsxwidget.m b/src/nsxwidget.m index 370abee395..e81ca7fc0c 100644 --- a/src/nsxwidget.m +++ b/src/nsxwidget.m @@ -388,7 +388,7 @@ - (void)userContentController:(WKUserContentController *)userContentController NSArray *nsarr = (NSArray *) value; EMACS_INT n = nsarr.count; Lisp_Object obj; - struct Lisp_Vector *p = allocate_vector (n); + struct Lisp_Vector *p = allocate_nil_vector (n); for (ptrdiff_t i = 0; i < n; ++i) p->contents[i] = js_to_lisp ([nsarr objectAtIndex:i]); @@ -401,7 +401,7 @@ - (void)userContentController:(WKUserContentController *)userContentController NSArray *keys = nsdict.allKeys; ptrdiff_t n = keys.count; Lisp_Object obj; - struct Lisp_Vector *p = allocate_vector (n); + struct Lisp_Vector *p = allocate_nil_vector (n); for (ptrdiff_t i = 0; i < n; ++i) { diff --git a/src/search.c b/src/search.c index 38c64caf7c..23b31d9281 100644 --- a/src/search.c +++ b/src/search.c @@ -3271,7 +3271,7 @@ the buffer. If the buffer doesn't have a cache, the value is nil. */) TYPE_MAXIMUM (ptrdiff_t), &nl_count_cache, NULL, true); /* Create vector and populate it. */ - cache_newlines = make_uninit_vector (nl_count_cache); + cache_newlines = make_vector (nl_count_cache, make_fixnum (-1)); if (nl_count_cache) { @@ -3285,15 +3285,12 @@ the buffer. If the buffer doesn't have a cache, the value is nil. */) break; ASET (cache_newlines, i, make_fixnum (found - 1)); } - /* Fill the rest of slots with an invalid position. */ - for ( ; i < nl_count_cache; i++) - ASET (cache_newlines, i, make_fixnum (-1)); } /* Now do the same, but without using the cache. */ find_newline1 (BEGV, BEGV_BYTE, ZV, ZV_BYTE, TYPE_MAXIMUM (ptrdiff_t), &nl_count_buf, NULL, true); - buf_newlines = make_uninit_vector (nl_count_buf); + buf_newlines = make_vector (nl_count_buf, make_fixnum (-1)); if (nl_count_buf) { for (from = BEGV, found = from, i = 0; from < ZV; from = found, i++) @@ -3306,8 +3303,6 @@ the buffer. If the buffer doesn't have a cache, the value is nil. */) break; ASET (buf_newlines, i, make_fixnum (found - 1)); } - for ( ; i < nl_count_buf; i++) - ASET (buf_newlines, i, make_fixnum (-1)); } /* Construct the value and return it. */ diff --git a/src/syntax.c b/src/syntax.c index a03202d386..9f77ea5f9b 100644 --- a/src/syntax.c +++ b/src/syntax.c @@ -3617,9 +3617,9 @@ init_syntax_once (void) DEFSYM (Qsyntax_table, "syntax-table"); /* Create objects which can be shared among syntax tables. */ - Vsyntax_code_object = make_uninit_vector (Smax); + Vsyntax_code_object = make_nil_vector (Smax); for (i = 0; i < Smax; i++) - ASET (Vsyntax_code_object, i, Fcons (make_fixnum (i), Qnil)); + ASET (Vsyntax_code_object, i, list1 (make_fixnum (i))); /* Now we are ready to set up this property, so we can create syntax tables. */ diff --git a/src/window.c b/src/window.c index e2dea8b70e..ef58f43a0b 100644 --- a/src/window.c +++ b/src/window.c @@ -7465,7 +7465,7 @@ saved by this function. */) data->minibuf_selected_window = minibuf_level > 0 ? minibuf_selected_window : Qnil; data->root_window = FRAME_ROOT_WINDOW (f); data->focus_frame = FRAME_FOCUS_FRAME (f); - Lisp_Object tem = make_uninit_vector (n_windows); + Lisp_Object tem = make_nil_vector (n_windows); data->saved_windows = tem; for (ptrdiff_t i = 0; i < n_windows; i++) ASET (tem, i, make_nil_vector (VECSIZE (struct saved_window))); diff --git a/src/xselect.c b/src/xselect.c index 48d6215a7b..bf50c598b2 100644 --- a/src/xselect.c +++ b/src/xselect.c @@ -1594,7 +1594,7 @@ selection_data_to_lisp_data (struct x_display_info *dpyinfo, return x_atom_to_symbol (dpyinfo, (Atom) idata[0]); else { - Lisp_Object v = make_uninit_vector (size / sizeof (int)); + Lisp_Object v = make_nil_vector (size / sizeof (int)); for (i = 0; i < size / sizeof (int); i++) ASET (v, i, x_atom_to_symbol (dpyinfo, (Atom) idata[i])); @@ -1653,7 +1653,7 @@ selection_data_to_lisp_data (struct x_display_info *dpyinfo, else { ptrdiff_t i; - Lisp_Object v = make_uninit_vector (size / X_LONG_SIZE); + Lisp_Object v = make_nil_vector (size / X_LONG_SIZE); if (type == XA_INTEGER) { @@ -1860,7 +1860,7 @@ clean_local_selection_data (Lisp_Object obj) Lisp_Object copy; if (size == 1) return clean_local_selection_data (AREF (obj, 0)); - copy = make_uninit_vector (size); + copy = make_nil_vector (size); for (i = 0; i < size; i++) ASET (copy, i, clean_local_selection_data (AREF (obj, i))); return copy; diff --git a/src/xwidget.c b/src/xwidget.c index c61f5bef88..154b3e9c82 100644 --- a/src/xwidget.c +++ b/src/xwidget.c @@ -343,7 +343,7 @@ webkit_js_to_lisp (JSCValue *value) memory_full (SIZE_MAX); ptrdiff_t n = dlen; - struct Lisp_Vector *p = allocate_vector (n); + struct Lisp_Vector *p = allocate_nil_vector (n); for (ptrdiff_t i = 0; i < n; ++i) { @@ -361,7 +361,7 @@ webkit_js_to_lisp (JSCValue *value) Lisp_Object obj; if (PTRDIFF_MAX < n) memory_full (n); - struct Lisp_Vector *p = allocate_vector (n); + struct Lisp_Vector *p = allocate_nil_vector (n); for (ptrdiff_t i = 0; i < n; ++i) { commit 4cba236749aafade7bd88cf2a10be48f44983faa Author: Roland Kaufmann Date: Thu Dec 27 15:51:49 2018 +0100 Allow build configuration on Apple ARM devices (bug#41994) * configure.ac: Add arm as a port target for Darwin. Copyright-paperwork-exempt: yes diff --git a/configure.ac b/configure.ac index 1b155bd39e..745ff22d35 100644 --- a/configure.ac +++ b/configure.ac @@ -723,7 +723,7 @@ case "${canonical}" in *-apple-darwin* ) case "${canonical}" in *-apple-darwin[0-9].*) unported=yes ;; - i[3456]86-* | x86_64-* ) ;; + i[3456]86-* | x86_64-* | arm-* ) ;; * ) unported=yes ;; esac opsys=darwin commit 1e7102640b8df5a5a94147c5a490c6cf69d605f9 Author: Lars Ingebrigtsen Date: Sat Aug 15 14:35:16 2020 +0200 Add new variable term-set-terminal-size (not setting LINES/COLUMNS) * lisp/term.el (term-set-terminal-size): New variable (bug#37564). (term-exec-1): Use it. Based on a patch from Matthew Leach . diff --git a/etc/NEWS b/etc/NEWS index b9063aac90..1a7f18d66e 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -797,6 +797,22 @@ work more traditionally, with 'C-d' deleting the next character. Likewise, point isn't moved to the end of the string before inserting digits. +** term-mode + +--- +*** New user option 'term-scroll-snap-to-bottom'. +By default, 'term' and 'ansi-term' will now recenter the buffer so +that the prompt is on the final line in the window. Setting this new +user option to nil inhibits this behavior. + +--- +*** New user option 'term-set-terminal-size' +If non-nil, the LINES and COLUMNS environment variables will be set +based on the current window size. In previous versions of Emacs, this +was always done (and that could lead to odd displays when resizing the +window after starting). This variable defaults to nil. + + ** Miscellaneous --- @@ -822,12 +838,6 @@ Previously, choosing a different completion with commands like 'C-.' and then hitting RET would choose the default completion. Doing this will now choose the completion under point instead. ---- -*** New user option 'term-scroll-snap-to-bottom'. -By default, 'term' and 'ansi-term' will now recenter the buffer so -that the prompt is on the final line in the window. Setting this new -user option to nil inhibits this behavior. - *** The new library hierarchy.el has been added. It's a library to create, query, navigate and display hierarchy structures. diff --git a/lisp/term.el b/lisp/term.el index 149405fa41..99f1bf4f54 100644 --- a/lisp/term.el +++ b/lisp/term.el @@ -467,6 +467,11 @@ Customize this option to nil if you want the previous behavior." :type 'boolean :group 'term) +(defcustom term-set-terminal-size nil + "If non-nil, set the LINES and COLUMNS environment variables." + :type 'boolean + :version "28.1") + (defcustom term-char-mode-point-at-process-mark t "If non-nil, keep point at the process mark in char mode. @@ -1551,9 +1556,12 @@ Nil if unknown.") (format term-termcap-format "TERMCAP=" term-term-name term-height term-width) - (format "INSIDE_EMACS=%s,term:%s" emacs-version term-protocol-version) - (format "LINES=%d" term-height) - (format "COLUMNS=%d" term-width)) + (format "INSIDE_EMACS=%s,term:%s" + emacs-version term-protocol-version)) + (when term-set-terminal-size + (list + (format "LINES=%d" term-height) + (format "COLUMNS=%d" term-width))) process-environment)) (process-connection-type t) ;; We should suppress conversion of end-of-line format. commit 37358dd43cf6bda238b1861cdbe55aedfcb1740e Author: Lars Ingebrigtsen Date: Sat Aug 15 14:20:02 2020 +0200 Make Gnus stop clobbering the M-s search prefix key binding * doc/emacs/misc.texi (Gnus Summary Buffer): Ditto. * doc/misc/gnus.texi (Searching for Articles): Document moved M-s (bug#39706). * lisp/gnus/gnus-sum.el (gnus-summary-mode-map): Move gnus-summary-search-article-forward to M-s M-s, and add M-s M-r for gnus-summary-search-article-backward. diff --git a/admin/release-process b/admin/release-process index 1ed7a2e29e..b8587e6204 100644 --- a/admin/release-process +++ b/admin/release-process @@ -192,16 +192,14 @@ sk Miroslav Vaško ** Check for modes which bind M-s that conflicts with a new global binding M-s and change key bindings where necessary. The current list of modes: -1. Gnus binds 'M-s' to 'gnus-summary-search-article-forward'. - -2. Minibuffer binds 'M-s' to 'next-matching-history-element' +1. Minibuffer binds 'M-s' to 'next-matching-history-element' (not useful any more since C-s can now search in the history). -3. PCL-CVS binds 'M-s' to 'cvs-status', and log-edit-mode binds it to +2. PCL-CVS binds 'M-s' to 'cvs-status', and log-edit-mode binds it to 'log-edit-comment-search-forward'. Perhaps search commands on the global key binding 'M-s' are useless in these modes. -4. Rmail binds '\es' to 'rmail-search'/'rmail-summary-search'. +3. Rmail binds '\es' to 'rmail-search'/'rmail-summary-search'. * DOCUMENTATION diff --git a/doc/emacs/misc.texi b/doc/emacs/misc.texi index f3c9d76981..317a1979e9 100644 --- a/doc/emacs/misc.texi +++ b/doc/emacs/misc.texi @@ -245,13 +245,13 @@ Do an incremental search on the selected article buffer (@code{gnus-summary-isearch-article}), as if you switched to the buffer and typed @kbd{C-s} (@pxref{Incremental Search}). -@kindex M-s @r{(Gnus Summary mode)} +@kindex M-s M-s @r{(Gnus Summary mode)} @findex gnus-summary-search-article-forward @item M-s @var{regexp} @key{RET} Search forward for articles containing a match for @var{regexp} (@code{gnus-summary-search-article-forward}). -@kindex M-r @r{(Gnus Summary mode)} +@kindex M-s M-r @r{(Gnus Summary mode)} @findex gnus-summary-search-article-backward @item M-r @var{regexp} @key{RET} Search back for articles containing a match for @var{regexp} diff --git a/doc/misc/gnus.texi b/doc/misc/gnus.texi index 584c54674d..332926a685 100644 --- a/doc/misc/gnus.texi +++ b/doc/misc/gnus.texi @@ -11029,14 +11029,14 @@ Go to the Gnus info node (@code{gnus-info-find-node}). @table @kbd -@item M-s -@kindex M-s @r{(Summary)} +@item M-s M-s +@kindex M-s M-s @r{(Summary)} @findex gnus-summary-search-article-forward Search through all subsequent (raw) articles for a regexp (@code{gnus-summary-search-article-forward}). -@item M-r -@kindex M-r @r{(Summary)} +@item M-s M-r +@kindex M-s M-r @r{(Summary)} @findex gnus-summary-search-article-backward Search through all previous (raw) articles for a regexp (@code{gnus-summary-search-article-backward}). diff --git a/etc/NEWS b/etc/NEWS index 66f4f71c55..b9063aac90 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -262,6 +262,13 @@ invoke 'C-u C-x v s' ('vc-create-tag'). ** Gnus ++++ +*** The key binding of 'gnus-summary-search-article-forward' has changed. +This command was previously on 'M-s' and shadowed the global 'M-s' +search prefix. The command has now been moved to 'M-s M-s'. (For +consistency, the 'M-s M-r' key binding has been added for the +'gnus-summary-search-article-backward' command.) + --- *** The value of "all" in the 'large-newsgroup-initial' group parameter changes. It was previously nil, which didn't work, because nil is diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el index 4363860eac..c53f81fe02 100644 --- a/lisp/gnus/gnus-sum.el +++ b/lisp/gnus/gnus-sum.el @@ -1913,7 +1913,8 @@ increase the score of each group you read." "," gnus-summary-best-unread-article "[" gnus-summary-prev-unseen-article "]" gnus-summary-next-unseen-article - "\M-s" gnus-summary-search-article-forward + "\M-s\M-s" gnus-summary-search-article-forward + "\M-s\M-r" gnus-summary-search-article-backward "\M-r" gnus-summary-search-article-backward "\M-S" gnus-summary-repeat-search-article-forward "\M-R" gnus-summary-repeat-search-article-backward commit f4e7f7695f4c0f372f606b543afee73f264d6191 Author: Steven Allen Date: Sat Aug 15 13:37:38 2020 +0200 Fix thinko in setting url-portspec * lisp/url/url-expand.el (url-default-expander): Set `url-portspec' (bug#42869). diff --git a/lisp/url/url-expand.el b/lisp/url/url-expand.el index f34ef810c4..be9b5426dc 100644 --- a/lisp/url/url-expand.el +++ b/lisp/url/url-expand.el @@ -120,7 +120,7 @@ path components followed by `..' are removed, along with the `..' itself." ;; Well, they told us the scheme, let's just go with it. nil (setf (url-type urlobj) (or (url-type urlobj) (url-type defobj))) - (setf (url-port urlobj) (or (url-portspec urlobj) + (setf (url-portspec urlobj) (or (url-portspec urlobj) (and (string= (url-type urlobj) (url-type defobj)) (url-port defobj)))) diff --git a/test/lisp/url/url-expand-tests.el b/test/lisp/url/url-expand-tests.el index 6e0ce86950..3b0b6fbd41 100644 --- a/test/lisp/url/url-expand-tests.el +++ b/test/lisp/url/url-expand-tests.el @@ -100,6 +100,13 @@ (should (equal (url-expand-file-name "foo#bar" "http://host/foobar") "http://host/foo#bar")) (should (equal (url-expand-file-name "foo#bar" "http://host/foobar/") "http://host/foobar/foo#bar"))) +(ert-deftest url-expand-file-name/relative-resolution-file-url () + "RFC 3986, Section 5.4 Reference Resolution Examples / Section 5.4.1. Normal Examples" + (should (equal (url-expand-file-name "bar.html" "file:///a/b/c/foo.html") "file:///a/b/c/bar.html")) + (should (equal (url-expand-file-name "bar.html" "file:///a/b/c/") "file:///a/b/c/bar.html")) + (should (equal (url-expand-file-name "../d/bar.html" "file:///a/b/c/") "file:///a/b/d/bar.html")) + (should (equal (url-expand-file-name "../d/bar.html" "file:///a/b/c/foo.html") "file:///a/b/d/bar.html"))) + (provide 'url-expand-tests) ;;; url-expand-tests.el ends here commit 5b463af8dda4d66bb63a7ce58177e83a42541bac Author: Dario Gjorgjevski Date: Sat Aug 15 12:33:37 2020 +0200 Tweak how ido handles killing virtual buffers * lisp/ido.el (ido-buffer-internal): Handle killing of virtual buffers as a special case. (ido-visit-buffer): Document the special case (bug#38294). diff --git a/etc/NEWS b/etc/NEWS index 9fcc89c866..66f4f71c55 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -792,6 +792,12 @@ digits. ** Miscellaneous +--- +*** Killing virtual ido buffers interactively will make them go away. +Previously, killing a virtual ido buffer with 'ido-kill-buffer' didn't +do anything. This has now been changed, and killing virtual buffers +with that command will remove the buffer from recentf. + --- *** New variable 'ffap-file-name-with-spaces'. If non-nil, 'find-file-at-point' and friends will try to guess more diff --git a/lisp/ido.el b/lisp/ido.el index e834916a6d..ad7500c0a1 100644 --- a/lisp/ido.el +++ b/lisp/ido.el @@ -2216,7 +2216,10 @@ If cursor is not at the end of the user input, move to end of input." ((and ido-enable-virtual-buffers ido-virtual-buffers (setq filename (assoc buf ido-virtual-buffers))) - (ido-visit-buffer (find-file-noselect (cdr filename)) method t)) + (if (eq method 'kill) + (setq recentf-list + (delete (cdr filename) recentf-list)) + (ido-visit-buffer (find-file-noselect (cdr filename)) method t))) ((and (eq ido-create-new-buffer 'prompt) (null require-match) @@ -4073,6 +4076,7 @@ Record command in `command-history' if optional RECORD is non-nil." (setq buffer (buffer-name buffer))) (let (win newframe) (cond + ;; "Killing" of virtual buffers is handled in `ido-buffer-internal'. ((eq method 'kill) (if record (ido-record-command 'kill-buffer buffer)) commit 83000ae6d7c6e3c615b16d2ea9274e1088d24178 Author: Eli Zaretskii Date: Sat Aug 15 13:23:58 2020 +0300 Don't wrap lines at NBSP when nobreak-char-display is t * src/xdisp.c (get_next_display_element): When nobreak-char-display is t, display NBSP and non-ASCII hyphens as themselves, not as their ASCII counterparts, just with the nobreak-space/nobreak-hyphen face. (Bug#42811) diff --git a/src/xdisp.c b/src/xdisp.c index 4fe1c4288a..f05319aa64 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -7555,7 +7555,7 @@ get_next_display_element (struct it *it) /* Merge `nobreak-space' into the current face. */ face_id = merge_faces (it->w, Qnobreak_space, 0, it->face_id); - XSETINT (it->ctl_chars[0], ' '); + XSETINT (it->ctl_chars[0], it->c); ctl_len = 1; goto display_control; } @@ -7568,7 +7568,7 @@ get_next_display_element (struct it *it) /* Merge `nobreak-space' into the current face. */ face_id = merge_faces (it->w, Qnobreak_hyphen, 0, it->face_id); - XSETINT (it->ctl_chars[0], '-'); + XSETINT (it->ctl_chars[0], it->c); ctl_len = 1; goto display_control; } commit f3afb23d26b948cfa095b221ca32090a2858e8f1 Author: Jari Aalto Date: Sat Aug 15 12:11:41 2020 +0200 Add support for ffap guessing at file names containing spaces * lisp/ffap.el (ffap-file-name-with-spaces): New variable (bug#8439). (ffap-search-backward-file-end, ffap-search-forward-file-end) (ffap-dir-separator-near-point): New functions. (ffap-string-at-point): Use the variable and the new functions to guess at files containing strings. diff --git a/etc/NEWS b/etc/NEWS index e51a3630b6..9fcc89c866 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -792,6 +792,11 @@ digits. ** Miscellaneous +--- +*** New variable 'ffap-file-name-with-spaces'. +If non-nil, 'find-file-at-point' and friends will try to guess more +expansively to identify a file name with spaces. + --- *** Two new commands for centering in 'doc-view-mode'. The new commands 'doc-view-center-page-horizontally' (bound to 'c h') diff --git a/lisp/ffap.el b/lisp/ffap.el index 4a506207d5..28f566dd93 100644 --- a/lisp/ffap.el +++ b/lisp/ffap.el @@ -1109,6 +1109,121 @@ The arguments CHARS, BEG and END are handled as described in ;; Added at suggestion of RHOGEE (for ff-paths), 7/24/95. "Last string returned by the function `ffap-string-at-point'.") +(defcustom ffap-file-name-with-spaces nil + "If non-nil, enable looking for paths with spaces in `ffap-string-at-point'. +Enabling this variable may lead to `find-file-at-point' guessing +wrong more often when trying to find a file name intermingled +with normal text, but can be useful when working on systems that +normally use spaces in file names (like Microsoft Windows and the +like)." + :type 'boolean + :version "28.1") + +(defun ffap-search-backward-file-end (&optional dir-separator end) + "Search backward position point where file would probably end. +Optional DIR-SEPARATOR defaults to \"/\". The search maximum is +`line-end-position' or optional END point. + +Suppose the cursor is somewhere that might be near end of file, +the guessing would position point before punctuation (like comma) +after the file extension: + + C:\temp\file.log, which contain .... + =============================== (before) + ---------------- (after) + + + C:\temp\file.log on Windows or /tmp/file.log on Unix + =============================== (before) + ---------------- (after) + +The strategy is to search backward until DIR-SEPARATOR which defaults to +\"/\" and then take educated guesses. + +Move point and return point if an adjustment was done." + (unless dir-separator + (setq dir-separator "/")) + (let ((opoint (point)) + point punct end whitespace-p) + (when (re-search-backward + (regexp-quote dir-separator) (line-beginning-position) t) + ;; Move to the beginning of the match.. + (forward-char 1) + ;; ... until typical punctuation. + (when (re-search-forward "\\([][<>()\"'`,.:;]\\)" + (or end + (line-end-position)) + t) + (setq end (match-end 0)) + (setq punct (match-string 1)) + (setq whitespace-p (looking-at "[ \t\r\n]\\|$")) + (goto-char end) + (cond + ((and (string-equal punct ".") + whitespace-p) ;end of sentence + (setq point (1- (point)))) + ((and (string-equal punct ".") + (looking-at "[a-zA-Z0-9.]+")) ;possibly file extension + (setq point (match-end 0))) + (t + (setq point (point))))) + (goto-char opoint) + (when point + (goto-char point) + point)))) + +(defun ffap-search-forward-file-end (&optional dir-separator) + "Search DIR-SEPARATOR and position point at file's maximum ending. +This includes spaces. +Optional DIR-SEPARATOR defaults to \"/\". +Call `ffap-search-backward-file-end' to refine the ending point." + (unless dir-separator + (setq dir-separator "/")) + (let* ((chars ;expected chars in file name + (concat "[^][^<>()\"'`;,#*|" + ;; exclude the opposite as we know the separator + (if (string-equal dir-separator "/") + "\\\\" + "/") + "\t\r\n]")) + (re (concat + chars "*" + (if dir-separator + (regexp-quote dir-separator) + "/") + chars "*"))) + (when (looking-at re) + (goto-char (match-end 0))))) + +(defun ffap-dir-separator-near-point () + "Search backward and forward for closest slash or backlash in line. +Return string slash or backslash. Point is moved to closest position." + (let ((point (point)) + str pos) + (when (looking-at ".*?/") + (setq str "/" + pos (match-end 0))) + (when (and (looking-at ".*?\\\\") + (or (null pos) + (< (match-end 0) pos))) + (setq str "\\" + pos (match-end 0))) + (goto-char point) + (when (and (re-search-backward "/" (line-beginning-position) t) + (or (null pos) + (< (- point (point)) (- pos point)))) + (setq str "/" + pos (1+ (point)))) ;1+ to keep cursor at the end of char + (goto-char point) + (when (and (re-search-backward "\\\\" (line-beginning-position) t) + (or (null pos) + (< (- point (point)) (- pos point)))) + (setq str "\\" + pos (1+ (point)))) + (when pos + (goto-char pos)) + str)) + (defun ffap-string-at-point (&optional mode) "Return a string of characters from around point. @@ -1128,7 +1243,8 @@ Set the variables `ffap-string-at-point' and When the region is active and larger than `ffap-max-region-length', return an empty string, and set `ffap-string-at-point-region' to '(1 1)." - (let* ((args + (let* (dir-separator + (args (cdr (or (assq (or mode major-mode) ffap-string-at-point-mode-alist) (assq 'file ffap-string-at-point-mode-alist)))) @@ -1137,14 +1253,25 @@ return an empty string, and set `ffap-string-at-point-region' to '(1 1)." (beg (if region-selected (region-beginning) (save-excursion - (skip-chars-backward (car args)) - (skip-chars-forward (nth 1 args) pt) + (if (and ffap-file-name-with-spaces + (memq mode '(nil file))) + (when (setq dir-separator (ffap-dir-separator-near-point)) + (while (re-search-backward + (regexp-quote dir-separator) + (line-beginning-position) t) + (goto-char (match-beginning 0)))) + (skip-chars-backward (car args)) + (skip-chars-forward (nth 1 args) pt)) (point)))) (end (if region-selected (region-end) (save-excursion (skip-chars-forward (car args)) (skip-chars-backward (nth 2 args) pt) + (when (and ffap-file-name-with-spaces + (memq mode '(nil file))) + (ffap-search-forward-file-end dir-separator) + (ffap-search-backward-file-end dir-separator)) (point)))) (region-len (- (max beg end) (min beg end)))) diff --git a/test/lisp/ffap-tests.el b/test/lisp/ffap-tests.el index 30c8f79457..e8c12669c1 100644 --- a/test/lisp/ffap-tests.el +++ b/test/lisp/ffap-tests.el @@ -77,6 +77,46 @@ left alone when opening a URL in an external browser." (should (compare-window-configurations (current-window-configuration) old)) (should (equal urls '("https://www.gnu.org"))))) +(defun ffap-test-string (space string) + (let ((ffap-file-name-with-spaces space)) + (with-temp-buffer + (insert string) + (goto-char (point-min)) + (forward-char 10) + (ffap-string-at-point)))) + +(ert-deftest ffap-test-with-spaces () + (should + (equal + (ffap-test-string + t "c:/Program Files/Open Text Evaluation Media/Open Text Exceed 14 x86/Program here.txt") + "/Program Files/Open Text Evaluation Media/Open Text Exceed 14 x86/Program here.txt")) + (should + (equal + (ffap-test-string + nil "c:/Program Files/Open Text Evaluation Media/Open Text Exceed 14 x86/Program here.txt") + "c:/Program")) + (should + (equal + (ffap-test-string + t "c:/Program Files/Open Text Evaluation Media/Open Text Exceed 14 x86/Program Files/Hummingbird/") + "/Program Files/Open Text Evaluation Media/Open Text Exceed 14 x86/Program Files/Hummingbird/")) + (should + (equal + (ffap-test-string + t "c:\\Program Files\\Open Text Evaluation Media\\Open Text Exceed 14 x86\\Program Files\\Hummingbird\\") + "\\Program Files\\Open Text Evaluation Media\\Open Text Exceed 14 x86\\Program Files\\Hummingbird\\")) + (should + (equal + (ffap-test-string + t "c:\\Program Files\\Freescale\\CW for MPC55xx and MPC56xx 2.10\\PowerPC_EABI_Tools\\Command_Line_Tools\\CLT_Usage_Notes.txt") + "\\Program Files\\Freescale\\CW for MPC55xx and MPC56xx 2.10\\PowerPC_EABI_Tools\\Command_Line_Tools\\CLT_Usage_Notes.txt")) + (should + (equal + (ffap-test-string + t "C:\\temp\\program.log on Windows or /var/log/program.log on Unix.") + "\\temp\\program.log"))) + (provide 'ffap-tests) ;;; ffap-tests.el ends here