commit 5424436452bc0b3d8a62a8398f92d0c2db81e22b (HEAD, refs/remotes/origin/master) Author: Paul Eggert Date: Wed May 22 23:58:55 2019 -0700 Avoid backslash-newline-newline in source code * etc/refcards/Makefile (PDF_FRENCH): * lib-src/etags.c (LOOP_ON_INPUT_LINES): * lisp/dabbrev.el (dabbrev-check-other-buffers): * lisp/org/org-id.el (org-id-link-to-org-use-id): * lisp/org/org.el (org-support-shift-select, org-file-apps): * src/alloc.c (CHECK_ALLOCATED_AND_LIVE) (CHECK_ALLOCATED_AND_LIVE_SYMBOL): * src/frame.h (FRAME_PIXEL_WIDTH_TO_TEXT_COLS): * src/regex-emacs.c (PREFETCH_NOLIMIT): * src/window.h (WINDOW_BUFFER): Remove backslash-newline that immediately precedes another newline, as this is not the usual style and is confusing. diff --git a/etc/refcards/Makefile b/etc/refcards/Makefile index 469e8fa05c..0ba6db5aa2 100644 --- a/etc/refcards/Makefile +++ b/etc/refcards/Makefile @@ -40,7 +40,7 @@ PDF_CZECH = \ PDF_FRENCH = \ fr-dired-ref.pdf \ fr-refcard.pdf \ - fr-survival.pdf \ + fr-survival.pdf PDF_GERMAN = de-refcard.pdf diff --git a/lib-src/etags.c b/lib-src/etags.c index 949ab5a2c6..6bd04d1f1c 100644 --- a/lib-src/etags.c +++ b/lib-src/etags.c @@ -4282,7 +4282,7 @@ Yacc_entries (FILE *inf) while (perhaps_more_input (file_pointer) \ && (readline (&(line_buffer), file_pointer), \ (char_pointer) = (line_buffer).buffer, \ - true)) \ + true)) #define LOOKING_AT(cp, kw) /* kw is the keyword, a literal string */ \ ((assert ("" kw), true) /* syntax error if not a literal string */ \ diff --git a/lisp/dabbrev.el b/lisp/dabbrev.el index f1fae18e74..aa22d6c754 100644 --- a/lisp/dabbrev.el +++ b/lisp/dabbrev.el @@ -237,8 +237,7 @@ See also `dabbrev-ignored-buffer-names'." :version "21.1") (defcustom dabbrev-check-other-buffers t - "Should \\[dabbrev-expand] look in other buffers?\ - + "Should \\[dabbrev-expand] look in other buffers? nil: Don't look in other buffers. t: Also look for expansions in the buffers pointed out by `dabbrev-select-buffers-function'. diff --git a/lisp/org/org-id.el b/lisp/org/org-id.el index 6a9d729c0a..44cc7b2f14 100644 --- a/lisp/org/org-id.el +++ b/lisp/org/org-id.el @@ -83,8 +83,7 @@ (defcustom org-id-link-to-org-use-id nil "Non-nil means storing a link to an Org file will use entry IDs. -\\\ - +\\ The variable can have the following values: t Create an ID if needed to make a link to the current entry. diff --git a/lisp/org/org.el b/lisp/org/org.el index ce6dd24a83..119d0a2566 100644 --- a/lisp/org/org.el +++ b/lisp/org/org.el @@ -863,8 +863,7 @@ depends on, if any." (defcustom org-support-shift-select nil "Non-nil means make shift-cursor commands select text when possible. -\\\ - +\\ In Emacs 23, when `shift-select-mode' is on, shifted cursor keys start selecting a region, or enlarge regions started in this way. In Org mode, in special contexts, these same keys are used for @@ -2259,8 +2258,7 @@ See `org-file-apps'.") ("\\.x?html?\\'" . default) ("\\.pdf\\'" . default)) "External applications for opening `file:path' items in a document. -\\\ - +\\ Org mode uses system defaults for different file types, but you can use this variable to set the application for a given file extension. The entries in this list are cons cells where the car identifies diff --git a/src/alloc.c b/src/alloc.c index af4adb3856..5c5b56d02e 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -6384,7 +6384,7 @@ mark_object (Lisp_Object arg) do { \ CHECK_ALLOCATED (); \ CHECK_LIVE (LIVEP); \ - } while (0) \ + } while (false) /* Check both of the above conditions, for symbols. */ #define CHECK_ALLOCATED_AND_LIVE_SYMBOL() \ @@ -6394,7 +6394,7 @@ mark_object (Lisp_Object arg) CHECK_ALLOCATED (); \ CHECK_LIVE (live_symbol_p); \ } \ - } while (0) \ + } while (false) #else /* not GC_CHECK_MARKED_OBJECTS */ diff --git a/src/frame.h b/src/frame.h index 781063340d..fa45a32d6b 100644 --- a/src/frame.h +++ b/src/frame.h @@ -1480,7 +1480,7 @@ FRAME_BOTTOM_DIVIDER_WIDTH (struct frame *f) - FRAME_TOTAL_FRINGE_WIDTH (f) \ - FRAME_SCROLL_BAR_AREA_WIDTH (f) \ - 2 * FRAME_INTERNAL_BORDER_WIDTH (f)) \ - / FRAME_COLUMN_WIDTH (f)) \ + / FRAME_COLUMN_WIDTH (f)) #define FRAME_PIXEL_HEIGHT_TO_TEXT_LINES(f, height) \ (((height) \ diff --git a/src/regex-emacs.c b/src/regex-emacs.c index 8dc6980502..4cb17037c2 100644 --- a/src/regex-emacs.c +++ b/src/regex-emacs.c @@ -3432,7 +3432,7 @@ static bool bcmp_translate (re_char *, re_char *, ptrdiff_t, { \ d = string2; \ dend = end_match_2; \ - } \ + } /* Test if at very beginning or at very end of the virtual concatenation of STRING1 and STRING2. If only one string, it's STRING2. */ diff --git a/src/window.h b/src/window.h index fdef407041..6b0f0e5d07 100644 --- a/src/window.h +++ b/src/window.h @@ -595,7 +595,7 @@ wset_next_buffers (struct window *w, Lisp_Object val) #define WINDOW_BUFFER(W) \ (WINDOW_LEAF_P(W) \ ? (W)->contents \ - : Qnil) \ + : Qnil) /* Return the canonical column width of the frame of window W. */ #define WINDOW_FRAME_COLUMN_WIDTH(W) \ @@ -649,7 +649,7 @@ wset_next_buffers (struct window *w, Lisp_Object val) #define WINDOW_RIGHTMOST_P(W) \ (WINDOW_RIGHT_PIXEL_EDGE (W) \ == (WINDOW_RIGHT_PIXEL_EDGE \ - (XWINDOW (FRAME_ROOT_WINDOW (WINDOW_XFRAME (W)))))) \ + (XWINDOW (FRAME_ROOT_WINDOW (WINDOW_XFRAME (W)))))) /* True if window W has no other windows below it on its frame (the minibuffer window is not counted in this respect unless W itself is a @@ -657,13 +657,13 @@ wset_next_buffers (struct window *w, Lisp_Object val) #define WINDOW_BOTTOMMOST_P(W) \ (WINDOW_BOTTOM_PIXEL_EDGE (W) \ == (WINDOW_BOTTOM_PIXEL_EDGE \ - (XWINDOW (FRAME_ROOT_WINDOW (WINDOW_XFRAME (W)))))) \ + (XWINDOW (FRAME_ROOT_WINDOW (WINDOW_XFRAME (W)))))) /* True if window W takes up the full width of its frame. */ #define WINDOW_FULL_WIDTH_P(W) \ (WINDOW_PIXEL_WIDTH (W) \ == (WINDOW_PIXEL_WIDTH \ - (XWINDOW (FRAME_ROOT_WINDOW (WINDOW_XFRAME (W)))))) \ + (XWINDOW (FRAME_ROOT_WINDOW (WINDOW_XFRAME (W)))))) /* Width of right divider of window W. */ #define WINDOW_RIGHT_DIVIDER_WIDTH(W) \ @@ -1122,7 +1122,7 @@ struct glyph *get_phys_cursor_glyph (struct window *w); /* True if WINDOW is a valid window. */ #define WINDOW_VALID_P(WINDOW) \ - (WINDOWP (WINDOW) && !NILP (XWINDOW (WINDOW)->contents)) \ + (WINDOWP (WINDOW) && !NILP (XWINDOW (WINDOW)->contents)) /* A window of any sort, leaf or interior, is "valid" if its contents slot is non-nil. */ commit 38564f8a664347c42f7614d9c91e0d49e4a073e8 Author: Eli Zaretskii Date: Thu May 23 08:26:32 2019 +0300 Unbreak display of characters on MS-Windows * src/w32font.c (w32font_draw): Convert the glyph_string's char2b array to 16-bit WCHAR data that ExtTextOutW needs. diff --git a/src/w32font.c b/src/w32font.c index bd68e22cc9..47a33aec35 100644 --- a/src/w32font.c +++ b/src/w32font.c @@ -704,11 +704,23 @@ w32font_draw (struct glyph_string *s, int from, int to, int i; for (i = 0; i < len; i++) - ExtTextOutW (s->hdc, x + i, y, options, NULL, - s->char2b + from + i, 1, NULL); + { + WCHAR c = s->char2b[from + i] & 0xFFFF; + ExtTextOutW (s->hdc, x + i, y, options, NULL, &c, 1, NULL); + } } else - ExtTextOutW (s->hdc, x, y, options, NULL, s->char2b + from, len, NULL); + { + /* The number of glyphs in a glyph_string cannot be larger than + the maximum value of the 'used' member of a glyph_row, so we + are OK using alloca here. */ + eassert (len <= SHRT_MAX); + WCHAR *chars = alloca (len * sizeof (WCHAR)); + int j; + for (j = 0; j < len; j++) + chars[j] = s->char2b[from + j] & 0xFFFF; + ExtTextOutW (s->hdc, x, y, options, NULL, chars, len, NULL); + } /* Restore clip region. */ if (s->num_clips > 0) commit 627fa5a0cb8aa57b9c419d3bc0ae749cd573fd52 Author: Stefan Monnier Date: Wed May 22 23:29:17 2019 -0400 * lisp/cedet/srecode/insert.el: Use lexical-binding (srecode-insert-method): No need for lexical-let any more. diff --git a/lisp/cedet/srecode/insert.el b/lisp/cedet/srecode/insert.el index 26af2ffe2e..a7445ea401 100644 --- a/lisp/cedet/srecode/insert.el +++ b/lisp/cedet/srecode/insert.el @@ -1,4 +1,4 @@ -;;; srecode/insert.el --- Insert srecode templates to an output stream. +;;; srecode/insert.el --- Insert srecode templates to an output stream -*- lexical-binding:t -*- ;; Copyright (C) 2005, 2007-2019 Free Software Foundation, Inc. @@ -26,9 +26,6 @@ ;; Manage the insertion process for a template. ;; -(eval-when-compile - (require 'cl)) ;; for `lexical-let' - (require 'srecode/compile) (require 'srecode/find) (require 'srecode/dictionary) @@ -1049,21 +1046,20 @@ template where a ^ inserter occurs." ;; which implements the wrap insertion behavior in FUNCTION. The ;; maximum valid nesting depth is just the current depth + 1. (let ((srecode-template-inserter-point-override - (lexical-let ((inserter1 sti)) - (cons - ;; DEPTH - (+ (length (oref-default 'srecode-template active)) 1) - ;; FUNCTION - (lambda (dict) - (let ((srecode-template-inserter-point-override nil)) - (if (srecode-dictionary-lookup-name - dict (oref inserter1 :object-name)) - ;; Insert our sectional part with looping. - (srecode-insert-method-helper - inserter1 dict 'template) - ;; Insert our sectional part just once. - (srecode-insert-subtemplate - inserter1 dict 'template)))))))) + (cons + ;; DEPTH + (+ (length (oref-default 'srecode-template active)) 1) + ;; FUNCTION + (lambda (dict) + (let ((srecode-template-inserter-point-override nil)) + (if (srecode-dictionary-lookup-name + dict (oref sti :object-name)) + ;; Insert our sectional part with looping. + (srecode-insert-method-helper + sti dict 'template) + ;; Insert our sectional part just once. + (srecode-insert-subtemplate + sti dict 'template))))))) ;; Do a regular insertion for an include, but with our override in ;; place. (cl-call-next-method))) commit b95a5d194b21254a6e41561621498be9f29cf08f Author: Stefan Monnier Date: Wed May 22 23:21:47 2019 -0400 * lisp/allout.el, lisp/allout-widgets.el: Use cl-lib and pcase diff --git a/lisp/allout-widgets.el b/lisp/allout-widgets.el index 67fce325ff..fd04c31f3b 100644 --- a/lisp/allout-widgets.el +++ b/lisp/allout-widgets.el @@ -70,12 +70,7 @@ (require 'allout) (require 'widget) (require 'wid-edit) - -(eval-when-compile - (progn - (require 'overlay) - (require 'cl) - )) +(eval-when-compile (require 'cl-lib)) ;;;_ : internal variables needed before user-customization variables ;;; In order to enable activation of allout-widgets-mode via customization, @@ -960,7 +955,7 @@ posting threshold criteria." (when changes-pending (while changes-record (setq entry (pop changes-record)) - (case (car entry) + (pcase (car entry) (:exposed (push entry exposures)) (:added (push entry additions)) (:deleted (push entry deletions)) @@ -1378,34 +1373,34 @@ FROM and TO must be in increasing order, as must be the pairs in RANGES." ;; fresh: (setq ranges nil) - (assert (equal (funcall try 3 5) '(nil ((3 5))))) + (cl-assert (equal (funcall try 3 5) '(nil ((3 5))))) ;; add range at end: - (assert (equal (funcall try 10 12) '(nil ((3 5) (10 12))))) + (cl-assert (equal (funcall try 10 12) '(nil ((3 5) (10 12))))) ;; add range at beginning: - (assert (equal (funcall try 1 2) '(nil ((1 2) (3 5) (10 12))))) + (cl-assert (equal (funcall try 1 2) '(nil ((1 2) (3 5) (10 12))))) ;; insert range somewhere in the middle: - (assert (equal (funcall try 7 9) '(nil ((1 2) (3 5) (7 9) (10 12))))) + (cl-assert (equal (funcall try 7 9) '(nil ((1 2) (3 5) (7 9) (10 12))))) ;; consolidate some: - (assert (equal (funcall try 5 8) '(t ((1 2) (3 9) (10 12))))) + (cl-assert (equal (funcall try 5 8) '(t ((1 2) (3 9) (10 12))))) ;; add more: - (assert (equal (funcall try 15 17) '(nil ((1 2) (3 9) (10 12) (15 17))))) + (cl-assert (equal (funcall try 15 17) '(nil ((1 2) (3 9) (10 12) (15 17))))) ;; add more: - (assert (equal (funcall try 20 22) + (cl-assert (equal (funcall try 20 22) '(nil ((1 2) (3 9) (10 12) (15 17) (20 22))))) ;; encompass more: - (assert (equal (funcall try 4 11) '(t ((1 2) (3 12) (15 17) (20 22))))) + (cl-assert (equal (funcall try 4 11) '(t ((1 2) (3 12) (15 17) (20 22))))) ;; encompass all: - (assert (equal (funcall try 2 25) '(t ((1 25))))) + (cl-assert (equal (funcall try 2 25) '(t ((1 25))))) ;; fresh slate: (setq ranges nil) - (assert (equal (funcall try 20 25) '(nil ((20 25))))) - (assert (equal (funcall try 30 35) '(nil ((20 25) (30 35))))) - (assert (equal (funcall try 26 28) '(nil ((20 25) (26 28) (30 35))))) - (assert (equal (funcall try 15 20) '(t ((15 25) (26 28) (30 35))))) - (assert (equal (funcall try 10 30) '(t ((10 35))))) - (assert (equal (funcall try 5 6) '(nil ((5 6) (10 35))))) - (assert (equal (funcall try 2 100) '(t ((2 100))))) + (cl-assert (equal (funcall try 20 25) '(nil ((20 25))))) + (cl-assert (equal (funcall try 30 35) '(nil ((20 25) (30 35))))) + (cl-assert (equal (funcall try 26 28) '(nil ((20 25) (26 28) (30 35))))) + (cl-assert (equal (funcall try 15 20) '(t ((15 25) (26 28) (30 35))))) + (cl-assert (equal (funcall try 10 30) '(t ((10 35))))) + (cl-assert (equal (funcall try 5 6) '(nil ((5 6) (10 35))))) + (cl-assert (equal (funcall try 2 100) '(t ((2 100))))) (setq ranges nil) )) diff --git a/lisp/allout.el b/lisp/allout.el index b3b87e533b..0760855188 100644 --- a/lisp/allout.el +++ b/lisp/allout.el @@ -79,12 +79,7 @@ ;;;_* Dependency loads (require 'overlay) -(eval-when-compile - ;; `cl' is required for `assert'. `assert' is not covered by a standard - ;; autoload, but it is a macro, so that eval-when-compile is sufficient - ;; to byte-compile it in, or to do the require when the buffer evalled. - (require 'cl) - ) +(eval-when-compile (require 'cl-lib)) ;;;_* USER CUSTOMIZATION VARIABLES: @@ -6122,13 +6117,13 @@ signal." (point-max)))) ;; determine key mode and, if keypair, recipients: (setq recipients - (case keypair-mode + (pcase keypair-mode - (decrypting nil) + ('decrypting nil) - (default (if encrypt-to (epg-list-keys epg-context encrypt-to))) + ('default (if encrypt-to (epg-list-keys epg-context encrypt-to))) - ((prompt prompt-save) + ((or 'prompt 'prompt-save) (save-window-excursion (epa-select-keys epg-context keypair-message))))) @@ -6786,6 +6781,7 @@ To ignore intangibility, bind `inhibit-point-motion-hooks' to t." (defvar allout-tests-locally-true nil "Fodder for allout resumptions tests -- defvar just for byte compiler.") (defun allout-test-resumptions () + ;; FIXME: Use ERT. "Exercise allout resumptions." ;; for each resumption case, we also test that the right local/global ;; scopes are affected during resumption effects: @@ -6794,48 +6790,48 @@ To ignore intangibility, bind `inhibit-point-motion-hooks' to t." (with-temp-buffer (allout-tests-obliterate-variable 'allout-tests-globally-unbound) (allout-add-resumptions '(allout-tests-globally-unbound t)) - (assert (not (default-boundp 'allout-tests-globally-unbound))) - (assert (local-variable-p 'allout-tests-globally-unbound (current-buffer))) - (assert (boundp 'allout-tests-globally-unbound)) - (assert (equal allout-tests-globally-unbound t)) + (cl-assert (not (default-boundp 'allout-tests-globally-unbound))) + (cl-assert (local-variable-p 'allout-tests-globally-unbound (current-buffer))) + (cl-assert (boundp 'allout-tests-globally-unbound)) + (cl-assert (equal allout-tests-globally-unbound t)) (allout-do-resumptions) - (assert (not (local-variable-p 'allout-tests-globally-unbound + (cl-assert (not (local-variable-p 'allout-tests-globally-unbound (current-buffer)))) - (assert (not (boundp 'allout-tests-globally-unbound)))) + (cl-assert (not (boundp 'allout-tests-globally-unbound)))) ;; ensure that variable with prior global value is resumed (with-temp-buffer (allout-tests-obliterate-variable 'allout-tests-globally-true) (setq allout-tests-globally-true t) (allout-add-resumptions '(allout-tests-globally-true nil)) - (assert (equal (default-value 'allout-tests-globally-true) t)) - (assert (local-variable-p 'allout-tests-globally-true (current-buffer))) - (assert (equal allout-tests-globally-true nil)) + (cl-assert (equal (default-value 'allout-tests-globally-true) t)) + (cl-assert (local-variable-p 'allout-tests-globally-true (current-buffer))) + (cl-assert (equal allout-tests-globally-true nil)) (allout-do-resumptions) - (assert (not (local-variable-p 'allout-tests-globally-true + (cl-assert (not (local-variable-p 'allout-tests-globally-true (current-buffer)))) - (assert (boundp 'allout-tests-globally-true)) - (assert (equal allout-tests-globally-true t))) + (cl-assert (boundp 'allout-tests-globally-true)) + (cl-assert (equal allout-tests-globally-true t))) ;; ensure that prior local value is resumed (with-temp-buffer (allout-tests-obliterate-variable 'allout-tests-locally-true) (set (make-local-variable 'allout-tests-locally-true) t) - (assert (not (default-boundp 'allout-tests-locally-true)) + (cl-assert (not (default-boundp 'allout-tests-locally-true)) nil (concat "Test setup mistake -- variable supposed to" " not have global binding, but it does.")) - (assert (local-variable-p 'allout-tests-locally-true (current-buffer)) + (cl-assert (local-variable-p 'allout-tests-locally-true (current-buffer)) nil (concat "Test setup mistake -- variable supposed to have" " local binding, but it lacks one.")) (allout-add-resumptions '(allout-tests-locally-true nil)) - (assert (not (default-boundp 'allout-tests-locally-true))) - (assert (local-variable-p 'allout-tests-locally-true (current-buffer))) - (assert (equal allout-tests-locally-true nil)) + (cl-assert (not (default-boundp 'allout-tests-locally-true))) + (cl-assert (local-variable-p 'allout-tests-locally-true (current-buffer))) + (cl-assert (equal allout-tests-locally-true nil)) (allout-do-resumptions) - (assert (boundp 'allout-tests-locally-true)) - (assert (local-variable-p 'allout-tests-locally-true (current-buffer))) - (assert (equal allout-tests-locally-true t)) - (assert (not (default-boundp 'allout-tests-locally-true)))) + (cl-assert (boundp 'allout-tests-locally-true)) + (cl-assert (local-variable-p 'allout-tests-locally-true (current-buffer))) + (cl-assert (equal allout-tests-locally-true t)) + (cl-assert (not (default-boundp 'allout-tests-locally-true)))) ;; ensure that last of multiple resumptions holds, for various scopes. (with-temp-buffer @@ -6851,27 +6847,27 @@ To ignore intangibility, bind `inhibit-point-motion-hooks' to t." '(allout-tests-globally-true 3) '(allout-tests-locally-true 4)) ;; reestablish many of the basic conditions are maintained after re-add: - (assert (not (default-boundp 'allout-tests-globally-unbound))) - (assert (local-variable-p 'allout-tests-globally-unbound (current-buffer))) - (assert (equal allout-tests-globally-unbound 2)) - (assert (default-boundp 'allout-tests-globally-true)) - (assert (local-variable-p 'allout-tests-globally-true (current-buffer))) - (assert (equal allout-tests-globally-true 3)) - (assert (not (default-boundp 'allout-tests-locally-true))) - (assert (local-variable-p 'allout-tests-locally-true (current-buffer))) - (assert (equal allout-tests-locally-true 4)) + (cl-assert (not (default-boundp 'allout-tests-globally-unbound))) + (cl-assert (local-variable-p 'allout-tests-globally-unbound (current-buffer))) + (cl-assert (equal allout-tests-globally-unbound 2)) + (cl-assert (default-boundp 'allout-tests-globally-true)) + (cl-assert (local-variable-p 'allout-tests-globally-true (current-buffer))) + (cl-assert (equal allout-tests-globally-true 3)) + (cl-assert (not (default-boundp 'allout-tests-locally-true))) + (cl-assert (local-variable-p 'allout-tests-locally-true (current-buffer))) + (cl-assert (equal allout-tests-locally-true 4)) (allout-do-resumptions) - (assert (not (local-variable-p 'allout-tests-globally-unbound + (cl-assert (not (local-variable-p 'allout-tests-globally-unbound (current-buffer)))) - (assert (not (boundp 'allout-tests-globally-unbound))) - (assert (not (local-variable-p 'allout-tests-globally-true + (cl-assert (not (boundp 'allout-tests-globally-unbound))) + (cl-assert (not (local-variable-p 'allout-tests-globally-true (current-buffer)))) - (assert (boundp 'allout-tests-globally-true)) - (assert (equal allout-tests-globally-true t)) - (assert (boundp 'allout-tests-locally-true)) - (assert (local-variable-p 'allout-tests-locally-true (current-buffer))) - (assert (equal allout-tests-locally-true t)) - (assert (not (default-boundp 'allout-tests-locally-true)))) + (cl-assert (boundp 'allout-tests-globally-true)) + (cl-assert (equal allout-tests-globally-true t)) + (cl-assert (boundp 'allout-tests-locally-true)) + (cl-assert (local-variable-p 'allout-tests-locally-true (current-buffer))) + (cl-assert (equal allout-tests-locally-true t)) + (cl-assert (not (default-boundp 'allout-tests-locally-true)))) ;; ensure that deliberately unbinding registered variables doesn't foul things (with-temp-buffer commit 03feb9376b54c489e24478954a11061e9b0d6db7 Author: YAMAMOTO Mitsuharu Date: Thu May 23 10:30:59 2019 +0900 Make Cairo build obey hint-style font setting (Bug#35781) * src/ftfont.h (ftfont_open2): Remove extern. (ftfont_fix_match, ftfont_add_rendering_parameters) (ftfont_entity_pattern): Add externs. (struct font_info): Remove member bitmap_strike_index. (struct font_info) [USE_CAIRO]: Remove member ft_size_draw. All uses removed. Add member bitmap_position_unit. * src/xftfont.c (xftfont_fix_match, xftfont_add_rendering_parameters): Move functions from here ... * src/ftfont.c (ftfont_fix_match, ftfont_add_rendering_parameters): ... to here. All uses changed. * src/xftfont.c (xftfont_open): Extract FcPattern creation from font entity from here ... * src/ftfont.c (ftfont_entity_pattern): ... to here. * src/xftfont.c (syms_of_xftfont): Move DEFSYMs for Fontconfig's rendering parameters from here ... * src/ftfont.c (syms_of_ftfont): ... to here. * src/ftfont.c (ftfont_open, ftfont_open2): Undo introduction of bitmap_strike_index. Merge functions into ftfont_open. * src/ftcrfont.c (ftcrfont_open): Align code with xftfont_open rather than ftfont_open. (ftcrfont_close): Likewise. (ftcrfont_has_char, ftcrfont_encode_char): (ftcrfont_otf_capability) [HAVE_LIBOTF]: (ftcrfont_variation_glyphs) [HAVE_OTF_GET_VARIATION_GLYPHS]: New functions. (ftcrfont_driver): Register them. (ftcrfont_get_bitmap, ftcrfont_anchor_point): (ftcrfont_shape) [HAVE_M17N_FLT && HAVE_LIBOTF]: Use bitmap_position_unit instead of bitmap_strike_index to screen bitmap fonts. (ftcrfont_get_bitmap, ftcrfont_anchor_point): (ftcrfont_otf_capability) [HAVE_LIBOTF]: (ftcrfont_shape) [HAVE_M17N_FLT && HAVE_LIBOTF]: (ftcrfont_variation_glyphs) [HAVE_OTF_GET_VARIATION_GLYPHS]: Temporarily assign ftcrfont_info->ft_size and call corresponding ftfont functions. (ftcrfont_draw): Don't flush cairo surface when exporting. diff --git a/src/ftcrfont.c b/src/ftcrfont.c index 2d5a766557..9686cec0e8 100644 --- a/src/ftcrfont.c +++ b/src/ftcrfont.c @@ -79,7 +79,6 @@ ftcrfont_glyph_extents (struct font *font, cairo_glyph_t cr_glyph = {.index = glyph}; cairo_text_extents_t extents; - FT_Activate_Size (ftcrfont_info->ft_size_draw); cairo_scaled_font_glyph_extents (ftcrfont_info->cr_scaled_font, &cr_glyph, 1, &extents); cache->lbearing = floor (extents.x_bearing); @@ -118,103 +117,159 @@ ftcrfont_match (struct frame *f, Lisp_Object spec) static Lisp_Object ftcrfont_open (struct frame *f, Lisp_Object entity, int pixel_size) { - Lisp_Object font_object; - - FT_UInt size = XFIXNUM (AREF (entity, FONT_SIZE_INDEX)); + FcResult result; + Lisp_Object val, filename, font_object; + FcPattern *pat, *match; + struct font_info *ftcrfont_info; + struct font *font; + double size = 0; + cairo_font_face_t *font_face; + cairo_font_extents_t extents; + FT_Face ft_face; + FcMatrix *matrix; + + val = assq_no_quit (QCfont_entity, AREF (entity, FONT_EXTRA_INDEX)); + if (! CONSP (val)) + return Qnil; + val = XCDR (val); + filename = XCAR (val); + size = XFIXNUM (AREF (entity, FONT_SIZE_INDEX)); if (size == 0) size = pixel_size; + + block_input (); + + pat = ftfont_entity_pattern (entity, pixel_size); + FcConfigSubstitute (NULL, pat, FcMatchPattern); + FcDefaultSubstitute (pat); + match = FcFontMatch (NULL, pat, &result); + ftfont_fix_match (pat, match); + + FcPatternDestroy (pat); + font_face = cairo_ft_font_face_create_for_pattern (match); + if (!font_face) + { + unblock_input (); + FcPatternDestroy (match); + return Qnil; + } + cairo_matrix_t font_matrix, ctm; + cairo_matrix_init_scale (&font_matrix, pixel_size, pixel_size); + cairo_matrix_init_identity (&ctm); + cairo_font_options_t *options = cairo_font_options_create (); + cairo_scaled_font_t *scaled_font + = cairo_scaled_font_create (font_face, &font_matrix, &ctm, options); + cairo_font_face_destroy (font_face); + cairo_font_options_destroy (options); + unblock_input (); + font_object = font_build_object (VECSIZE (struct font_info), Qftcr, entity, size); + ASET (font_object, FONT_FILE_INDEX, filename); + font = XFONT_OBJECT (font_object); + font->pixel_size = size; + font->driver = &ftcrfont_driver; + font->encoding_charset = font->repertory_charset = -1; + + ftcrfont_info = (struct font_info *) font; + ftcrfont_info->cr_scaled_font = scaled_font; + + /* This means that there's no need of transformation. */ + ftcrfont_info->matrix.xx = 0; + if (FcPatternGetMatrix (match, FC_MATRIX, 0, &matrix) == FcResultMatch) + { + ftcrfont_info->matrix.xx = 0x10000L * matrix->xx; + ftcrfont_info->matrix.yy = 0x10000L * matrix->yy; + ftcrfont_info->matrix.xy = 0x10000L * matrix->xy; + ftcrfont_info->matrix.yx = 0x10000L * matrix->yx; + } + + ftcrfont_info->metrics = NULL; + ftcrfont_info->metrics_nrows = 0; + block_input (); - font_object = ftfont_open2 (f, entity, pixel_size, font_object); - if (FONT_OBJECT_P (font_object)) + 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++) { - struct font *font = XFONT_OBJECT (font_object); - struct font_info *ftcrfont_info = (struct font_info *) font; - FT_Face ft_face = ftcrfont_info->ft_size->face; - - font->driver = &ftcrfont_driver; - FT_New_Size (ft_face, &ftcrfont_info->ft_size_draw); - FT_Activate_Size (ftcrfont_info->ft_size_draw); - 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; - cairo_matrix_init_scale (&font_matrix, pixel_size, pixel_size); - cairo_matrix_init_identity (&ctm); - cairo_font_options_t *options = cairo_font_options_create (); - ftcrfont_info->cr_scaled_font = - cairo_scaled_font_create (font_face, &font_matrix, &ctm, options); - cairo_font_face_destroy (font_face); - cairo_font_options_destroy (options); - ftcrfont_info->metrics = NULL; - ftcrfont_info->metrics_nrows = 0; - if (ftcrfont_info->bitmap_strike_index >= 0) + 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) { - /* 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); - Lisp_Object val = assq_no_quit (QCminspace, - AREF (entity, FONT_EXTRA_INDEX)); - if (!(CONSP (val) && NILP (XCDR (val)))) - { - font->descent = lround (extents.descent); - font->height = font->ascent + font->descent; - } - else + if (glyphs != &stack_glyph) + cairo_glyph_free (glyphs); + else if (stack_glyph.index) { - font->height = lround (extents.height); - font->descent = font->height - font->ascent; + 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; - 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 if (stack_glyph.index) - { - 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; + cairo_scaled_font_extents (ftcrfont_info->cr_scaled_font, &extents); + font->ascent = lround (extents.ascent); + val = assq_no_quit (QCminspace, AREF (entity, FONT_EXTRA_INDEX)); + if (!(CONSP (val) && NILP (XCDR (val)))) + { + font->descent = lround (extents.descent); + font->height = font->ascent + font->descent; + } + else + { + font->height = lround (extents.height); + font->descent = font->height - font->ascent; + } - font->underline_position = -1; - font->underline_thickness = 0; - } + ft_face = cairo_ft_scaled_font_lock_face (scaled_font); + if (XFIXNUM (AREF (entity, FONT_SIZE_INDEX)) == 0) + { + int upEM = ft_face->units_per_EM; + + font->underline_position = -ft_face->underline_position * size / upEM; + font->underline_thickness = ft_face->underline_thickness * size / upEM; + if (font->underline_thickness > 2) + font->underline_position -= font->underline_thickness / 2; + } + else + { + font->underline_position = -1; + font->underline_thickness = 0; } +#ifdef HAVE_LIBOTF + ftcrfont_info->maybe_otf = (ft_face->face_flags & FT_FACE_FLAG_SFNT) != 0; + ftcrfont_info->otf = NULL; +#endif /* HAVE_LIBOTF */ + if (ft_face->units_per_EM) + ftcrfont_info->bitmap_position_unit = 0; + else + ftcrfont_info->bitmap_position_unit = (extents.height + / ft_face->size->metrics.height); + cairo_ft_scaled_font_unlock_face (scaled_font); + ftcrfont_info->ft_size = NULL; unblock_input (); + font->baseline_offset = 0; + font->relative_compose = 0; + font->default_ascent = 0; + font->vertical_centering = false; + return font_object; } @@ -225,19 +280,58 @@ ftcrfont_close (struct font *font) return; struct font_info *ftcrfont_info = (struct font_info *) font; - int i; block_input (); - for (i = 0; i < ftcrfont_info->metrics_nrows; i++) +#ifdef HAVE_LIBOTF + if (ftcrfont_info->otf) + { + OTF_close (ftcrfont_info->otf); + ftcrfont_info->otf = NULL; + } +#endif + for (int i = 0; i < ftcrfont_info->metrics_nrows; i++) if (ftcrfont_info->metrics[i]) xfree (ftcrfont_info->metrics[i]); if (ftcrfont_info->metrics) xfree (ftcrfont_info->metrics); - FT_Done_Size (ftcrfont_info->ft_size_draw); cairo_scaled_font_destroy (ftcrfont_info->cr_scaled_font); unblock_input (); +} + +static int +ftcrfont_has_char (Lisp_Object font, int c) +{ + if (FONT_ENTITY_P (font)) + return ftfont_has_char (font, c); - ftfont_close (font); + return -1; +} + +static unsigned +ftcrfont_encode_char (struct font *font, int c) +{ + struct font_info *ftcrfont_info = (struct font_info *) font; + unsigned code = FONT_INVALID_CODE; + unsigned char utf8[MAX_MULTIBYTE_LENGTH]; + unsigned char *p = utf8; + cairo_glyph_t stack_glyph; + cairo_glyph_t *glyphs = &stack_glyph; + int num_glyphs = 1; + + CHAR_STRING_ADVANCE (c, p); + if (cairo_scaled_font_text_to_glyphs (ftcrfont_info->cr_scaled_font, 0, 0, + (char *) utf8, p - utf8, + &glyphs, &num_glyphs, + NULL, NULL, NULL) + == CAIRO_STATUS_SUCCESS) + { + if (glyphs != &stack_glyph) + cairo_glyph_free (glyphs); + else if (stack_glyph.index) + code = stack_glyph.index; + } + + return code; } static void @@ -280,10 +374,18 @@ ftcrfont_get_bitmap (struct font *font, unsigned int code, { 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); + if (ftcrfont_info->bitmap_position_unit) + return -1; - return -1; + cairo_scaled_font_t *scaled_font = ftcrfont_info->cr_scaled_font; + FT_Face ft_face = cairo_ft_scaled_font_lock_face (scaled_font); + + ftcrfont_info->ft_size = ft_face->size; + int result = ftfont_get_bitmap (font, code, bitmap, bits_per_pixel); + cairo_ft_scaled_font_unlock_face (scaled_font); + ftcrfont_info->ft_size = NULL; + + return result; } static int @@ -292,25 +394,75 @@ ftcrfont_anchor_point (struct font *font, unsigned int code, int idx, { 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); + if (ftcrfont_info->bitmap_position_unit) + return -1; - return -1; + cairo_scaled_font_t *scaled_font = ftcrfont_info->cr_scaled_font; + FT_Face ft_face = cairo_ft_scaled_font_lock_face (scaled_font); + + ftcrfont_info->ft_size = ft_face->size; + int result = ftfont_anchor_point (font, code, idx, x, y); + cairo_ft_scaled_font_unlock_face (scaled_font); + ftcrfont_info->ft_size = NULL; + + return result; } +#ifdef HAVE_LIBOTF static Lisp_Object -ftcrfont_shape (Lisp_Object lgstring) +ftcrfont_otf_capability (struct font *font) { + struct font_info *ftcrfont_info = (struct font_info *) font; + cairo_scaled_font_t *scaled_font = ftcrfont_info->cr_scaled_font; + FT_Face ft_face = cairo_ft_scaled_font_lock_face (scaled_font); + + ftcrfont_info->ft_size = ft_face->size; + Lisp_Object result = ftfont_otf_capability (font); + cairo_ft_scaled_font_unlock_face (scaled_font); + ftcrfont_info->ft_size = NULL; + + return result; +} +#endif + #if defined HAVE_M17N_FLT && defined HAVE_LIBOTF +static Lisp_Object +ftcrfont_shape (Lisp_Object lgstring) +{ 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) - return ftfont_shape (lgstring); + if (ftcrfont_info->bitmap_position_unit) + return make_fixnum (0); + + cairo_scaled_font_t *scaled_font = ftcrfont_info->cr_scaled_font; + FT_Face ft_face = cairo_ft_scaled_font_lock_face (scaled_font); + + ftcrfont_info->ft_size = ft_face->size; + Lisp_Object result = ftfont_shape (lgstring); + cairo_ft_scaled_font_unlock_face (scaled_font); + ftcrfont_info->ft_size = NULL; + + return result; +} #endif - return make_fixnum (0); +#ifdef HAVE_OTF_GET_VARIATION_GLYPHS +static int +ftcrfont_variation_glyphs (struct font *font, int c, unsigned variations[256]) +{ + struct font_info *ftcrfont_info = (struct font_info *) font; + cairo_scaled_font_t *scaled_font = ftcrfont_info->cr_scaled_font; + FT_Face ft_face = cairo_ft_scaled_font_lock_face (scaled_font); + + ftcrfont_info->ft_size = ft_face->size; + int result = ftfont_variation_glyphs (font, c, variations); + cairo_ft_scaled_font_unlock_face (scaled_font); + ftcrfont_info->ft_size = NULL; + + return result; } +#endif /* HAVE_OTF_GET_VARIATION_GLYPHS */ static int ftcrfont_draw (struct glyph_string *s, @@ -321,8 +473,6 @@ ftcrfont_draw (struct glyph_string *s, struct font_info *ftcrfont_info = (struct font_info *) s->font; cairo_t *cr; cairo_glyph_t *glyphs; - cairo_surface_t *surface; - cairo_surface_type_t surface_type; int len = to - from; int i; @@ -351,17 +501,7 @@ ftcrfont_draw (struct glyph_string *s, x_set_cr_source_with_gc_foreground (f, s->gc); cairo_set_scaled_font (cr, ftcrfont_info->cr_scaled_font); - - FT_Activate_Size (ftcrfont_info->ft_size_draw); cairo_show_glyphs (cr, glyphs, len); - surface = cairo_get_target (cr); - /* XXX: It used to be necessary to flush when exporting. It might - be the case that this is no longer necessary. */ - surface_type = cairo_surface_get_type (surface); - if (surface_type != CAIRO_SURFACE_TYPE_XLIB - && (surface_type != CAIRO_SURFACE_TYPE_IMAGE - || cairo_image_surface_get_format (surface) != CAIRO_FORMAT_ARGB32)) - cairo_surface_flush (surface); x_end_cr_clip (f); @@ -383,18 +523,20 @@ struct font_driver const ftcrfont_driver = .list_family = ftfont_list_family, .open = ftcrfont_open, .close = ftcrfont_close, - .has_char = ftfont_has_char, - .encode_char = ftfont_encode_char, + .has_char = ftcrfont_has_char, + .encode_char = ftcrfont_encode_char, .text_extents = ftcrfont_text_extents, .draw = ftcrfont_draw, .get_bitmap = ftcrfont_get_bitmap, .anchor_point = ftcrfont_anchor_point, #ifdef HAVE_LIBOTF - .otf_capability = ftfont_otf_capability, + .otf_capability = ftcrfont_otf_capability, #endif +#if defined HAVE_M17N_FLT && defined HAVE_LIBOTF .shape = ftcrfont_shape, +#endif #ifdef HAVE_OTF_GET_VARIATION_GLYPHS - .get_variation_glyphs = ftfont_variation_glyphs, + .get_variation_glyphs = ftcrfont_variation_glyphs, #endif .filter_properties = ftfont_filter_properties, .combining_capability = ftfont_combining_capability, diff --git a/src/ftfont.c b/src/ftfont.c index f17bd9ab3f..d8b510d703 100644 --- a/src/ftfont.c +++ b/src/ftfont.c @@ -1079,12 +1079,159 @@ ftfont_list_family (struct frame *f) return list; } +void +ftfont_fix_match (FcPattern *pat, FcPattern *match) +{ + /* These values are not used for matching (except antialias), but for + rendering, so make sure they are carried over to the match. + We also put antialias here because most fonts are antialiased, so + the match will have antialias true. */ + + FcBool b = FcTrue; + int i; + double dpi; + + FcPatternGetBool (pat, FC_ANTIALIAS, 0, &b); + if (! b) + { + FcPatternDel (match, FC_ANTIALIAS); + FcPatternAddBool (match, FC_ANTIALIAS, FcFalse); + } + FcPatternGetBool (pat, FC_HINTING, 0, &b); + if (! b) + { + FcPatternDel (match, FC_HINTING); + FcPatternAddBool (match, FC_HINTING, FcFalse); + } +#ifndef FC_HINT_STYLE +# define FC_HINT_STYLE "hintstyle" +#endif + if (FcResultMatch == FcPatternGetInteger (pat, FC_HINT_STYLE, 0, &i)) + { + FcPatternDel (match, FC_HINT_STYLE); + FcPatternAddInteger (match, FC_HINT_STYLE, i); + } +#ifndef FC_LCD_FILTER + /* Older fontconfig versions don't have FC_LCD_FILTER. */ +#define FC_LCD_FILTER "lcdfilter" +#endif + if (FcResultMatch == FcPatternGetInteger (pat, FC_LCD_FILTER, 0, &i)) + { + FcPatternDel (match, FC_LCD_FILTER); + FcPatternAddInteger (match, FC_LCD_FILTER, i); + } + if (FcResultMatch == FcPatternGetInteger (pat, FC_RGBA, 0, &i)) + { + FcPatternDel (match, FC_RGBA); + FcPatternAddInteger (match, FC_RGBA, i); + } + if (FcResultMatch == FcPatternGetDouble (pat, FC_DPI, 0, &dpi)) + { + FcPatternDel (match, FC_DPI); + FcPatternAddDouble (match, FC_DPI, dpi); + } +} + +void +ftfont_add_rendering_parameters (FcPattern *pat, Lisp_Object entity) +{ + Lisp_Object tail; + int ival; + + for (tail = AREF (entity, FONT_EXTRA_INDEX); CONSP (tail); tail = XCDR (tail)) + { + Lisp_Object key = XCAR (XCAR (tail)); + Lisp_Object val = XCDR (XCAR (tail)); + + if (EQ (key, QCantialias)) + FcPatternAddBool (pat, FC_ANTIALIAS, NILP (val) ? FcFalse : FcTrue); + else if (EQ (key, QChinting)) + FcPatternAddBool (pat, FC_HINTING, NILP (val) ? FcFalse : FcTrue); + else if (EQ (key, QCautohint)) + FcPatternAddBool (pat, FC_AUTOHINT, NILP (val) ? FcFalse : FcTrue); + else if (EQ (key, QChintstyle)) + { + if (FIXNUMP (val)) + FcPatternAddInteger (pat, FC_HINT_STYLE, XFIXNUM (val)); + else if (SYMBOLP (val) + && FcNameConstant (SDATA (SYMBOL_NAME (val)), &ival)) + FcPatternAddInteger (pat, FC_HINT_STYLE, ival); + } + else if (EQ (key, QCrgba)) + { + if (FIXNUMP (val)) + FcPatternAddInteger (pat, FC_RGBA, XFIXNUM (val)); + else if (SYMBOLP (val) + && FcNameConstant (SDATA (SYMBOL_NAME (val)), &ival)) + FcPatternAddInteger (pat, FC_RGBA, ival); + } + else if (EQ (key, QClcdfilter)) + { + if (FIXNUMP (val)) + FcPatternAddInteger (pat, FC_LCD_FILTER, ival = XFIXNUM (val)); + else if (SYMBOLP (val) + && FcNameConstant (SDATA (SYMBOL_NAME (val)), &ival)) + FcPatternAddInteger (pat, FC_LCD_FILTER, ival); + } +#ifdef FC_EMBOLDEN + else if (EQ (key, QCembolden)) + FcPatternAddBool (pat, FC_EMBOLDEN, NILP (val) ? FcFalse : FcTrue); +#endif + } +} + +FcPattern * +ftfont_entity_pattern (Lisp_Object entity, int pixel_size) +{ + Lisp_Object val, filename, idx; + FcPattern *pat; + int i; + + val = assq_no_quit (QCfont_entity, AREF (entity, FONT_EXTRA_INDEX)); + eassert (CONSP (val)); + val = XCDR (val); + filename = XCAR (val); + idx = XCDR (val); + pat = FcPatternCreate (); + FcPatternAddInteger (pat, FC_WEIGHT, FONT_WEIGHT_NUMERIC (entity)); + i = FONT_SLANT_NUMERIC (entity) - 100; + if (i < 0) i = 0; + FcPatternAddInteger (pat, FC_SLANT, i); + FcPatternAddInteger (pat, FC_WIDTH, FONT_WIDTH_NUMERIC (entity)); + FcPatternAddDouble (pat, FC_PIXEL_SIZE, pixel_size); + val = AREF (entity, FONT_FAMILY_INDEX); + if (! NILP (val)) + FcPatternAddString (pat, FC_FAMILY, (FcChar8 *) SDATA (SYMBOL_NAME (val))); + val = AREF (entity, FONT_FOUNDRY_INDEX); + if (! NILP (val)) + FcPatternAddString (pat, FC_FOUNDRY, (FcChar8 *) SDATA (SYMBOL_NAME (val))); + val = AREF (entity, FONT_SPACING_INDEX); + if (! NILP (val)) + FcPatternAddInteger (pat, FC_SPACING, XFIXNUM (val)); + val = AREF (entity, FONT_DPI_INDEX); + if (! NILP (val)) + { + double dbl = XFIXNUM (val); + + FcPatternAddDouble (pat, FC_DPI, dbl); + } + val = AREF (entity, FONT_AVGWIDTH_INDEX); + if (FIXNUMP (val) && XFIXNUM (val) == 0) + FcPatternAddBool (pat, FC_SCALABLE, FcTrue); + /* This is necessary to identify the exact font (e.g. 10x20.pcf.gz + over 10x20-ISO8859-1.pcf.gz). */ + FcPatternAddCharSet (pat, FC_CHARSET, ftfont_get_fc_charset (entity)); + + ftfont_add_rendering_parameters (pat, entity); + + FcPatternAddString (pat, FC_FILE, (FcChar8 *) SDATA (filename)); + FcPatternAddInteger (pat, FC_INDEX, XFIXNUM (idx)); + + return pat; +} Lisp_Object -ftfont_open2 (struct frame *f, - Lisp_Object entity, - int pixel_size, - Lisp_Object font_object) +ftfont_open (struct frame *f, Lisp_Object entity, int pixel_size) { struct font_info *ftfont_info; struct font *font; @@ -1092,12 +1239,11 @@ ftfont_open2 (struct frame *f, FT_Face ft_face; FT_Size ft_size; FT_UInt size; - Lisp_Object val, filename, idx, cache; + Lisp_Object val, filename, idx, cache, font_object; bool scalable; 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,35 +1272,17 @@ ftfont_open2 (struct frame *f, size = pixel_size; if (FT_Set_Pixel_Sizes (ft_face, size, size) != 0) { - int min_distance = INT_MAX; - bool magnify = true; - - for (FT_Int i = 0; i < ft_face->num_fixed_sizes; i++) - { - 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) { - if (cache_data->face_refcount == 0) - { - FT_Done_Face (ft_face); - cache_data->ft_face = NULL; - } - return Qnil; + FT_Done_Face (ft_face); + cache_data->ft_face = NULL; } + return Qnil; } cache_data->face_refcount++; + font_object = font_build_object (VECSIZE (struct font_info), + Qfreetype, entity, size); ASET (font_object, FONT_FILE_INDEX, filename); font = XFONT_OBJECT (font_object); ftfont_info = (struct font_info *) font; @@ -1164,7 +1292,6 @@ 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; @@ -1258,31 +1385,6 @@ ftfont_open2 (struct frame *f, return font_object; } -Lisp_Object -ftfont_open (struct frame *f, Lisp_Object entity, int pixel_size) -{ - Lisp_Object font_object; - FT_UInt size; - size = XFIXNUM (AREF (entity, FONT_SIZE_INDEX)); - if (size == 0) - size = pixel_size; - font_object = font_build_object (VECSIZE (struct font_info), - Qfreetype, entity, size); - 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 ftfont_close (struct font *font) { @@ -2789,6 +2891,14 @@ syms_of_ftfont (void) /* The boolean-valued font property key specifying the use of leading. */ DEFSYM (QCminspace, ":minspace"); + /* Fontconfig's rendering parameters. */ + DEFSYM (QChinting, ":hinting"); + DEFSYM (QCautohint, ":autohint"); + DEFSYM (QChintstyle, ":hintstyle"); + DEFSYM (QCrgba, ":rgba"); + DEFSYM (QCembolden, ":embolden"); + DEFSYM (QClcdfilter, ":lcdfilter"); + staticpro (&freetype_font_cache); freetype_font_cache = list1 (Qt); diff --git a/src/ftfont.h b/src/ftfont.h index adbda49ff1..7860469491 100644 --- a/src/ftfont.h +++ b/src/ftfont.h @@ -37,10 +37,9 @@ along with GNU Emacs. If not, see . */ #endif /* HAVE_LIBOTF */ extern FcCharSet *ftfont_get_fc_charset (Lisp_Object); -extern Lisp_Object ftfont_open2 (struct frame *f, - Lisp_Object entity, - int pixel_size, - Lisp_Object font_object); +extern void ftfont_fix_match (FcPattern *, FcPattern *); +extern void ftfont_add_rendering_parameters (FcPattern *, Lisp_Object); +extern FcPattern *ftfont_entity_pattern (Lisp_Object, int); /* This struct is shared by the XFT, Freetype, and Cairo font backends. Members up to and including 'matrix' are common, the @@ -54,17 +53,14 @@ 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 cairo_scaled_font_t *cr_scaled_font; - /* To prevent cairo from cluttering the activated FT_Size maintained - in ftfont.c, we activate this special FT_Size before drawing. */ - FT_Size ft_size_draw; + /* Scale factor from the bitmap strike metrics in 1/64 pixels, used + as the hb_position_t value in HarfBuzz, to those in (scaled) + pixels. The value is 0 for scalable fonts. */ + double bitmap_position_unit; /* Font metrics cache. */ struct font_metrics **metrics; short metrics_nrows; diff --git a/src/xftfont.c b/src/xftfont.c index 2edc51fe35..4f0a0d81d8 100644 --- a/src/xftfont.c +++ b/src/xftfont.c @@ -127,120 +127,18 @@ xftfont_match (struct frame *f, Lisp_Object spec) static FcChar8 ascii_printable[95]; -static void -xftfont_fix_match (FcPattern *pat, FcPattern *match) -{ - /* These values are not used for matching (except antialias), but for - rendering, so make sure they are carried over to the match. - We also put antialias here because most fonts are antialiased, so - the match will have antialias true. */ - - FcBool b = FcTrue; - int i; - double dpi; - - FcPatternGetBool (pat, FC_ANTIALIAS, 0, &b); - if (! b) - { - FcPatternDel (match, FC_ANTIALIAS); - FcPatternAddBool (match, FC_ANTIALIAS, FcFalse); - } - FcPatternGetBool (pat, FC_HINTING, 0, &b); - if (! b) - { - FcPatternDel (match, FC_HINTING); - FcPatternAddBool (match, FC_HINTING, FcFalse); - } -#ifndef FC_HINT_STYLE -# define FC_HINT_STYLE "hintstyle" -#endif - if (FcResultMatch == FcPatternGetInteger (pat, FC_HINT_STYLE, 0, &i)) - { - FcPatternDel (match, FC_HINT_STYLE); - FcPatternAddInteger (match, FC_HINT_STYLE, i); - } -#ifndef FC_LCD_FILTER - /* Older fontconfig versions don't have FC_LCD_FILTER. */ -#define FC_LCD_FILTER "lcdfilter" -#endif - if (FcResultMatch == FcPatternGetInteger (pat, FC_LCD_FILTER, 0, &i)) - { - FcPatternDel (match, FC_LCD_FILTER); - FcPatternAddInteger (match, FC_LCD_FILTER, i); - } - if (FcResultMatch == FcPatternGetInteger (pat, FC_RGBA, 0, &i)) - { - FcPatternDel (match, FC_RGBA); - FcPatternAddInteger (match, FC_RGBA, i); - } - if (FcResultMatch == FcPatternGetDouble (pat, FC_DPI, 0, &dpi)) - { - FcPatternDel (match, FC_DPI); - FcPatternAddDouble (match, FC_DPI, dpi); - } -} - -static void -xftfont_add_rendering_parameters (FcPattern *pat, Lisp_Object entity) -{ - Lisp_Object tail; - int ival; - - for (tail = AREF (entity, FONT_EXTRA_INDEX); CONSP (tail); tail = XCDR (tail)) - { - Lisp_Object key = XCAR (XCAR (tail)); - Lisp_Object val = XCDR (XCAR (tail)); - - if (EQ (key, QCantialias)) - FcPatternAddBool (pat, FC_ANTIALIAS, NILP (val) ? FcFalse : FcTrue); - else if (EQ (key, QChinting)) - FcPatternAddBool (pat, FC_HINTING, NILP (val) ? FcFalse : FcTrue); - else if (EQ (key, QCautohint)) - FcPatternAddBool (pat, FC_AUTOHINT, NILP (val) ? FcFalse : FcTrue); - else if (EQ (key, QChintstyle)) - { - if (FIXNUMP (val)) - FcPatternAddInteger (pat, FC_HINT_STYLE, XFIXNUM (val)); - else if (SYMBOLP (val) - && FcNameConstant (SDATA (SYMBOL_NAME (val)), &ival)) - FcPatternAddInteger (pat, FC_HINT_STYLE, ival); - } - else if (EQ (key, QCrgba)) - { - if (FIXNUMP (val)) - FcPatternAddInteger (pat, FC_RGBA, XFIXNUM (val)); - else if (SYMBOLP (val) - && FcNameConstant (SDATA (SYMBOL_NAME (val)), &ival)) - FcPatternAddInteger (pat, FC_RGBA, ival); - } - else if (EQ (key, QClcdfilter)) - { - if (FIXNUMP (val)) - FcPatternAddInteger (pat, FC_LCD_FILTER, ival = XFIXNUM (val)); - else if (SYMBOLP (val) - && FcNameConstant (SDATA (SYMBOL_NAME (val)), &ival)) - FcPatternAddInteger (pat, FC_LCD_FILTER, ival); - } -#ifdef FC_EMBOLDEN - else if (EQ (key, QCembolden)) - FcPatternAddBool (pat, FC_EMBOLDEN, NILP (val) ? FcFalse : FcTrue); -#endif - } -} - static Lisp_Object xftfont_open (struct frame *f, Lisp_Object entity, int pixel_size) { FcResult result; Display *display = FRAME_X_DISPLAY (f); - Lisp_Object val, filename, idx, font_object; + Lisp_Object val, filename, font_object; FcPattern *pat = NULL, *match; struct font_info *xftfont_info = NULL; struct font *font; double size = 0; XftFont *xftfont = NULL; int spacing; - int i; XGlyphInfo extents; FT_Face ft_face; FcMatrix *matrix; @@ -250,52 +148,17 @@ xftfont_open (struct frame *f, Lisp_Object entity, int pixel_size) return Qnil; val = XCDR (val); filename = XCAR (val); - idx = XCDR (val); size = XFIXNUM (AREF (entity, FONT_SIZE_INDEX)); if (size == 0) size = pixel_size; - pat = FcPatternCreate (); - FcPatternAddInteger (pat, FC_WEIGHT, FONT_WEIGHT_NUMERIC (entity)); - i = FONT_SLANT_NUMERIC (entity) - 100; - if (i < 0) i = 0; - FcPatternAddInteger (pat, FC_SLANT, i); - FcPatternAddInteger (pat, FC_WIDTH, FONT_WIDTH_NUMERIC (entity)); - FcPatternAddDouble (pat, FC_PIXEL_SIZE, pixel_size); - val = AREF (entity, FONT_FAMILY_INDEX); - if (! NILP (val)) - FcPatternAddString (pat, FC_FAMILY, (FcChar8 *) SDATA (SYMBOL_NAME (val))); - val = AREF (entity, FONT_FOUNDRY_INDEX); - if (! NILP (val)) - FcPatternAddString (pat, FC_FOUNDRY, (FcChar8 *) SDATA (SYMBOL_NAME (val))); - val = AREF (entity, FONT_SPACING_INDEX); - if (! NILP (val)) - FcPatternAddInteger (pat, FC_SPACING, XFIXNUM (val)); - val = AREF (entity, FONT_DPI_INDEX); - if (! NILP (val)) - { - double dbl = XFIXNUM (val); - - FcPatternAddDouble (pat, FC_DPI, dbl); - } - val = AREF (entity, FONT_AVGWIDTH_INDEX); - if (FIXNUMP (val) && XFIXNUM (val) == 0) - FcPatternAddBool (pat, FC_SCALABLE, FcTrue); - /* This is necessary to identify the exact font (e.g. 10x20.pcf.gz - over 10x20-ISO8859-1.pcf.gz). */ - FcPatternAddCharSet (pat, FC_CHARSET, ftfont_get_fc_charset (entity)); - - xftfont_add_rendering_parameters (pat, entity); - - FcPatternAddString (pat, FC_FILE, (FcChar8 *) SDATA (filename)); - FcPatternAddInteger (pat, FC_INDEX, XFIXNUM (idx)); - block_input (); + pat = ftfont_entity_pattern (entity, pixel_size); /* Substitute in values from X resources and XftDefaultSet. */ XftDefaultSubstitute (display, FRAME_X_SCREEN_NUMBER (f), pat); match = XftFontMatch (display, FRAME_X_SCREEN_NUMBER (f), pat, &result); - xftfont_fix_match (pat, match); + ftfont_fix_match (pat, match); FcPatternDestroy (pat); xftfont = XftFontOpenPattern (display, match); @@ -695,7 +558,7 @@ xftfont_cached_font_ok (struct frame *f, Lisp_Object font_object, bool ok = false; int i1, i2, r1, r2; - xftfont_add_rendering_parameters (pat, entity); + ftfont_add_rendering_parameters (pat, entity); XftDefaultSubstitute (display, FRAME_X_SCREEN_NUMBER (f), pat); r1 = FcPatternGetBool (pat, FC_ANTIALIAS, 0, &b1); @@ -768,12 +631,6 @@ void syms_of_xftfont (void) { DEFSYM (Qxft, "xft"); - DEFSYM (QChinting, ":hinting"); - DEFSYM (QCautohint, ":autohint"); - DEFSYM (QChintstyle, ":hintstyle"); - DEFSYM (QCrgba, ":rgba"); - DEFSYM (QCembolden, ":embolden"); - DEFSYM (QClcdfilter, ":lcdfilter"); DEFVAR_BOOL ("xft-font-ascent-descent-override", xft_font_ascent_descent_override, commit 72047556fa391016ab507c02c2f489c97b53f088 Author: Basil L. Contovounesios Date: Thu May 16 16:29:49 2019 +0100 Fix url-copy-file argument handling For discussion, see the following thread: https://lists.gnu.org/archive/html/emacs-devel/2019-05/msg00500.html * lisp/url/url-handlers.el: Update autoloaded docstrings. Quote function symbols as such. (url-handler-regexp): Make grouping construct shy. (url-file-handler, url-insert-buffer-contents) (url-handlers-create-wrapper, url-handlers-set-buffer-mode): Simplify. (url-file-handler-identity): Clarify calling convention. (file-name-absolute-p, url-file-local-copy): Mark ignored arguments as such. (url-handler-directory-file-name): Prefer string comparison over regexp match where either will do. (url-copy-file): Handle integer as third argument as per copy-file. diff --git a/lisp/url/url-handlers.el b/lisp/url/url-handlers.el index 4988068293..9d7837d8a7 100644 --- a/lisp/url/url-handlers.el +++ b/lisp/url/url-handlers.el @@ -23,17 +23,17 @@ ;;; Code: -;; (require 'url) (require 'url-parse) -;; (require 'url-util) (eval-when-compile (require 'mm-decode)) -;; (require 'mailcap) (eval-when-compile (require 'subr-x)) ;; The following are autoloaded instead of `require'd to avoid eagerly ;; loading all of URL when turning on url-handler-mode in the .emacs. -(autoload 'url-expand-file-name "url-expand" "Convert url to a fully specified url, and canonicalize it.") -(autoload 'mm-dissect-buffer "mm-decode" "Dissect the current buffer and return a list of MIME handles.") -(autoload 'url-scheme-get-property "url-methods" "Get property of a URL SCHEME.") +(autoload 'url-expand-file-name "url-expand" + "Convert URL to a fully specified URL, and canonicalize it.") +(autoload 'mm-dissect-buffer "mm-decode" + "Dissect the current buffer and return a list of MIME handles.") +(autoload 'url-scheme-get-property "url-methods" + "Get PROPERTY of a URL SCHEME.") ;; Always used after mm-dissect-buffer and defined in the same file. (declare-function mm-save-part-to-file "mm-decode" (handle file)) @@ -112,15 +112,16 @@ (push (cons url-handler-regexp 'url-file-handler) file-name-handler-alist))) -(defcustom url-handler-regexp "\\`\\(https?\\|ftp\\|file\\|nfs\\|ssh\\|scp\\|rsync\\|telnet\\)://" +(defcustom url-handler-regexp + "\\`\\(?:https?\\|ftp\\|file\\|nfs\\|ssh\\|scp\\|rsync\\|telnet\\)://" "Regular expression for URLs handled by `url-handler-mode'. When URL Handler mode is enabled, this regular expression is added to `file-name-handler-alist'. Some valid URL protocols just do not make sense to visit -interactively \(about, data, info, irc, mailto, etc.). This +interactively (about, data, info, irc, mailto, etc.). This regular expression avoids conflicts with local files that look -like URLs \(Gnus is particularly bad at this)." +like URLs (Gnus is particularly bad at this)." :group 'url :type 'regexp :version "25.1" @@ -144,8 +145,8 @@ like URLs \(Gnus is particularly bad at this)." ;;;###autoload (defun url-file-handler (operation &rest args) "Function called from the `file-name-handler-alist' routines. -OPERATION is what needs to be done (`file-exists-p', etc). ARGS are -the arguments that would have been passed to OPERATION." +OPERATION is what needs to be done (`file-exists-p', etc.). +ARGS are the arguments that would have been passed to OPERATION." ;; Avoid recursive load. (if (and load-in-progress url-file-handler-load-in-progress) (url-run-real-handler operation args) @@ -153,48 +154,46 @@ the arguments that would have been passed to OPERATION." ;; Check, whether there are arguments we want pass to Tramp. (if (catch :do (dolist (url (cons default-directory args)) - (and (member - (url-type (url-generic-parse-url (and (stringp url) url))) - url-tramp-protocols) + (and (stringp url) + (member (url-type (url-generic-parse-url url)) + url-tramp-protocols) (throw :do t)))) - (apply 'url-tramp-file-handler operation args) + (apply #'url-tramp-file-handler operation args) ;; Otherwise, let's do the job. (let ((fn (get operation 'url-file-handlers)) - (val nil) - (hooked nil)) - (if (and (not fn) (intern-soft (format "url-%s" operation)) + val) + (if (and (not fn) (fboundp (intern-soft (format "url-%s" operation)))) (error "Missing URL handler mapping for %s" operation)) - (if fn - (setq hooked t - val (save-match-data (apply fn args))) - (setq hooked nil - val (url-run-real-handler operation args))) - (url-debug 'handlers "%s %S%S => %S" (if hooked "Hooked" "Real") + (setq val (if fn (save-match-data (apply fn args)) + (url-run-real-handler operation args))) + (url-debug 'handlers "%s %S%S => %S" (if fn "Hooked" "Real") operation args val) val))))) -(defun url-file-handler-identity (&rest args) - ;; Identity function - (car args)) - -;; These are operations that we can fully support -(put 'file-readable-p 'url-file-handlers 'url-file-exists-p) -(put 'substitute-in-file-name 'url-file-handlers 'url-file-handler-identity) -(put 'file-name-absolute-p 'url-file-handlers (lambda (&rest ignored) t)) -(put 'expand-file-name 'url-file-handlers 'url-handler-expand-file-name) -(put 'directory-file-name 'url-file-handlers 'url-handler-directory-file-name) -(put 'file-name-directory 'url-file-handlers 'url-handler-file-name-directory) -(put 'unhandled-file-name-directory 'url-file-handlers 'url-handler-unhandled-file-name-directory) -(put 'file-remote-p 'url-file-handlers 'url-handler-file-remote-p) -;; (put 'file-name-as-directory 'url-file-handlers 'url-handler-file-name-as-directory) +(defun url-file-handler-identity (arg &rest _ignored) + ;; Identity function. + arg) + +;; These are operations that we can fully support. +(put 'file-readable-p 'url-file-handlers #'url-file-exists-p) +(put 'substitute-in-file-name 'url-file-handlers #'url-file-handler-identity) +(put 'file-name-absolute-p 'url-file-handlers (lambda (&rest _ignored) t)) +(put 'expand-file-name 'url-file-handlers #'url-handler-expand-file-name) +(put 'directory-file-name 'url-file-handlers #'url-handler-directory-file-name) +(put 'file-name-directory 'url-file-handlers #'url-handler-file-name-directory) +(put 'unhandled-file-name-directory 'url-file-handlers + #'url-handler-unhandled-file-name-directory) +(put 'file-remote-p 'url-file-handlers #'url-handler-file-remote-p) +;; (put 'file-name-as-directory 'url-file-handlers +;; #'url-handler-file-name-as-directory) ;; These are operations that we do not support yet (DAV!!!) -(put 'file-writable-p 'url-file-handlers 'ignore) -(put 'file-symlink-p 'url-file-handlers 'ignore) +(put 'file-writable-p 'url-file-handlers #'ignore) +(put 'file-symlink-p 'url-file-handlers #'ignore) ;; Just like for ange-ftp: let's not waste time trying to look for RCS/foo,v ;; files and such since we can't do anything clever with them anyway. -(put 'vc-registered 'url-file-handlers 'ignore) +(put 'vc-registered 'url-file-handlers #'ignore) (defun url-handler-expand-file-name (file &optional base) ;; When we see "/foo/bar" in a file whose working dir is "http://bla/bla", @@ -215,7 +214,7 @@ the arguments that would have been passed to OPERATION." ;; reversible: (f-n-a-d (d-f-n (f-n-a-d X))) == (f-n-a-d X) (defun url-handler-directory-file-name (dir) ;; When there's more than a single /, just don't touch the slashes at all. - (if (string-match "//\\'" dir) dir + (if (string-suffix-p "//" dir) dir (url-run-real-handler 'directory-file-name (list dir)))) (defun url-handler-unhandled-file-name-directory (filename) @@ -257,44 +256,42 @@ the arguments that would have been passed to OPERATION." ;; `url-handler-unhandled-file-name-directory'. nil))) -;; The actual implementation +;; The actual implementation. ;;;###autoload -(defun url-copy-file (url newname &optional ok-if-already-exists - _keep-time _preserve-uid-gid _preserve-permissions) - "Copy URL to NEWNAME. Both args must be strings. -Signal a `file-already-exists' error if file NEWNAME already exists, -unless a third argument OK-IF-ALREADY-EXISTS is supplied and non-nil. -A number as third arg means request confirmation if NEWNAME already exists. -This is what happens in interactive use with M-x. -Fourth arg KEEP-TIME non-nil means give the new file the same -last-modified time as the old one. (This works on only some systems.) -Args PRESERVE-UID-GID and PRESERVE-PERMISSIONS are ignored. -A prefix arg makes KEEP-TIME non-nil." - (if (and (file-exists-p newname) - (not ok-if-already-exists)) - (signal 'file-already-exists (list "File exists" newname))) - (let ((buffer (url-retrieve-synchronously url)) - (handle nil)) - (if (not buffer) - (signal 'file-missing (list "Opening URL" "No such file or directory" - url))) - (with-current-buffer buffer - (setq handle (mm-dissect-buffer t))) +(defun url-copy-file (url newname &optional ok-if-already-exists &rest _ignored) + "Copy URL to NEWNAME. Both arguments must be strings. +Signal a `file-already-exists' error if file NEWNAME already +exists, unless a third argument OK-IF-ALREADY-EXISTS is supplied +and non-nil. An integer as third argument means request +confirmation if NEWNAME already exists." + (and (file-exists-p newname) + (or (not ok-if-already-exists) + (and (integerp ok-if-already-exists) + (not (yes-or-no-p + (format "File %s already exists; copy to it anyway? " + newname))))) + (signal 'file-already-exists (list "File already exists" newname))) + (let* ((buffer (or (url-retrieve-synchronously url) + (signal 'file-missing + (list "Opening URL" + "No such file or directory" url)))) + (handle (with-current-buffer buffer + (mm-dissect-buffer t)))) (let ((mm-attachment-file-modes (default-file-modes))) (mm-save-part-to-file handle newname)) (kill-buffer buffer) (mm-destroy-parts handle))) -(put 'copy-file 'url-file-handlers 'url-copy-file) +(put 'copy-file 'url-file-handlers #'url-copy-file) ;;;###autoload -(defun url-file-local-copy (url &rest ignored) +(defun url-file-local-copy (url &rest _ignored) "Copy URL into a temporary file on this machine. Returns the name of the local copy, or nil, if FILE is directly accessible." (let ((filename (make-temp-file "url"))) (url-copy-file url filename 'ok-if-already-exists) filename)) -(put 'file-local-copy 'url-file-handlers 'url-file-local-copy) +(put 'file-local-copy 'url-file-handlers #'url-file-local-copy) (defun url-insert (buffer &optional beg end) "Insert the body of a URL object. @@ -330,8 +327,8 @@ This is like `url-insert', but also decodes the current buffer as if it had been inserted from a file named URL." (if visit (setq buffer-file-name url)) (save-excursion - (let* ((start (point)) - (size-and-charset (url-insert buffer beg end))) + (let ((start (point)) + (size-and-charset (url-insert buffer beg end))) (kill-buffer buffer) (when replace (delete-region (point-min) start) @@ -342,10 +339,9 @@ if it had been inserted from a file named URL." (decode-coding-inserted-region (point-min) (point) url visit beg end replace)) (let ((inserted (car size-and-charset))) - (when (fboundp 'after-insert-file-set-coding) - (let ((insval (after-insert-file-set-coding inserted visit))) - (if insval (setq inserted insval)))) - (list url inserted))))) + (list url (or (and (fboundp 'after-insert-file-set-coding) + (after-insert-file-set-coding inserted visit)) + inserted)))))) ;;;###autoload (defun url-insert-file-contents (url &optional visit beg end replace) @@ -356,15 +352,14 @@ if it had been inserted from a file named URL." ;; instead. See bug#17549. (url-http--insert-file-helper buffer url visit)) (url-insert-buffer-contents buffer url visit beg end replace))) - -(put 'insert-file-contents 'url-file-handlers 'url-insert-file-contents) +(put 'insert-file-contents 'url-file-handlers #'url-insert-file-contents) (defun url-file-name-completion (url _directory &optional _predicate) ;; Even if it's not implemented, it's not an error to ask for completion, ;; in case it's available (bug#14806). ;; (error "Unimplemented") url) -(put 'file-name-completion 'url-file-handlers 'url-file-name-completion) +(put 'file-name-completion 'url-file-handlers #'url-file-name-completion) (defun url-file-name-all-completions (_file _directory) ;; Even if it's not implemented, it's not an error to ask for completion, @@ -372,7 +367,7 @@ if it had been inserted from a file named URL." ;; (error "Unimplemented") nil) (put 'file-name-all-completions - 'url-file-handlers 'url-file-name-all-completions) + 'url-file-handlers #'url-file-name-all-completions) ;; All other handlers map onto their respective backends. (defmacro url-handlers-create-wrapper (method args) @@ -382,10 +377,10 @@ if it had been inserted from a file named URL." (or (documentation method t) "No original documentation.")) (setq url (url-generic-parse-url url)) (when (url-type url) - (funcall (url-scheme-get-property (url-type url) (quote ,method)) - ,@(remove '&rest (remove '&optional args))))) + (funcall (url-scheme-get-property (url-type url) ',method) + ,@(remq '&rest (remq '&optional args))))) (unless (get ',method 'url-file-handlers) - (put ',method 'url-file-handlers ',(intern (format "url-%s" method)))))) + (put ',method 'url-file-handlers #',(intern (format "url-%s" method)))))) (url-handlers-create-wrapper file-exists-p (url)) (url-handlers-create-wrapper file-attributes (url &optional id-format)) @@ -396,12 +391,12 @@ if it had been inserted from a file named URL." (url-handlers-create-wrapper directory-files (url &optional full match nosort)) (url-handlers-create-wrapper file-truename (url &optional counter prev-dirs)) -(add-hook 'find-file-hook 'url-handlers-set-buffer-mode) +(add-hook 'find-file-hook #'url-handlers-set-buffer-mode) (defun url-handlers-set-buffer-mode () "Set correct modes for the current buffer if visiting a remote file." - (and (stringp buffer-file-name) - (string-match url-handler-regexp buffer-file-name) + (and buffer-file-name + (string-match-p url-handler-regexp buffer-file-name) (auto-save-mode 0))) (provide 'url-handlers) commit 70839740214c5fac91536df8bd4cd7af23afa3b2 Author: Stefan Monnier Date: Wed May 22 18:36:37 2019 -0400 * lisp/textmodes/sgml-mode.el: Fix lone `>` in sgml text (sgml--syntax-propertize-ppss):New variable and function. (sgml-syntax-propertize-rules): Use it. Don't ignore quotes not followed by a matching quote or a '>' or '<'. (sgml-syntax-propertize): Set up sgml--syntax-propertize-ppss. * test/lisp/textmodes/sgml-mode-tests.el (sgml-tests--quotes-syntax): Add test for lone '>'. diff --git a/lisp/textmodes/sgml-mode.el b/lisp/textmodes/sgml-mode.el index 1826129f0b..d0586fd9fc 100644 --- a/lisp/textmodes/sgml-mode.el +++ b/lisp/textmodes/sgml-mode.el @@ -328,6 +328,24 @@ Any terminating `>' or `/' is not matched.") (defvar sgml-font-lock-keywords sgml-font-lock-keywords-1 "Rules for highlighting SGML code. See also `sgml-tag-face-alist'.") +(defvar-local sgml--syntax-propertize-ppss nil) + +(defun sgml--syntax-propertize-ppss (pos) + "Return PPSS at POS, fixing the syntax of any lone `>' along the way." + (cl-assert (>= pos (car sgml--syntax-propertize-ppss))) + (let ((ppss (parse-partial-sexp (car sgml--syntax-propertize-ppss) pos -1 + nil (cdr sgml--syntax-propertize-ppss)))) + (while (eq -1 (car ppss)) + (put-text-property (1- (point)) (point) + 'syntax-table (string-to-syntax ".")) + ;; Hack attack: rather than recompute the ppss from + ;; (car sgml--syntax-propertize-ppss), we manually "fix it". + (setcar ppss 0) + (setq ppss (parse-partial-sexp (point) pos -1 nil ppss))) + (setcdr sgml--syntax-propertize-ppss ppss) + (setcar sgml--syntax-propertize-ppss pos) + ppss)) + (eval-and-compile (defconst sgml-syntax-propertize-rules (syntax-propertize-precompile-rules @@ -344,23 +362,28 @@ Any terminating `>' or `/' is not matched.") ;; the resulting number of calls to syntax-ppss made it too slow ;; (bug#33887), so we're now careful to leave alone any pair ;; of quotes that doesn't hold a < or > char, which is the vast majority. - ("\\(?:\\(?1:\"\\)[^\"<>]*[<>\"]\\|\\(?1:'\\)[^'<>]*[<>']\\)" - (1 (unless (memq (char-before) '(?\' ?\")) + ("\\(?:\\(?1:\"\\)[^\"<>]*\\|\\(?1:'\\)[^'\"<>]*\\)" + (1 (if (eq (char-after) (char-after (match-beginning 0))) + (forward-char 1) ;; Be careful to call `syntax-ppss' on a position before the one ;; we're going to change, so as not to need to flush the data we ;; just computed. - (if (prog1 (zerop (car (syntax-ppss (match-beginning 0)))) - (goto-char (1- (match-end 0)))) + (if (zerop (save-excursion + (car (sgml--syntax-propertize-ppss + (match-beginning 0))))) (string-to-syntax "."))))) ))) (defun sgml-syntax-propertize (start end) "Syntactic keywords for `sgml-mode'." - (goto-char start) + (setq sgml--syntax-propertize-ppss (cons start (syntax-ppss start))) + (cl-assert (>= (cadr sgml--syntax-propertize-ppss) 0)) (sgml-syntax-propertize-inside end) (funcall (syntax-propertize-rules sgml-syntax-propertize-rules) - start end)) + start end) + ;; Catch any '>' after the last quote. + (sgml--syntax-propertize-ppss end)) (defun sgml-syntax-propertize-inside (end) (let ((ppss (syntax-ppss))) diff --git a/test/lisp/textmodes/sgml-mode-tests.el b/test/lisp/textmodes/sgml-mode-tests.el index a900e8dcf2..1b8965e344 100644 --- a/test/lisp/textmodes/sgml-mode-tests.el +++ b/test/lisp/textmodes/sgml-mode-tests.el @@ -165,6 +165,10 @@ The point is set to the beginning of the buffer." (sgml-mode) (insert "a\"b c'd") (should (= 1 (car (syntax-ppss (1- (point-max)))))) + (should (= 0 (car (syntax-ppss (point-max))))) + (erase-buffer) + (insert "c>d") + (should (= 1 (car (syntax-ppss (1- (point-max)))))) (should (= 0 (car (syntax-ppss (point-max))))))) (provide 'sgml-mode-tests) commit dfed333b312d06b3416ebfadff544eae38313391 Author: Paul Eggert Date: Wed May 22 13:25:47 2019 -0700 Remove fixnum restriction on some display vars This is a minor patch to remove some fixnum restrictions. Many more such patches are needed, but one thing at a time. * doc/emacs/custom.texi (Examining): Update fill-column example. * src/buffer.c (fill-column, left-margin, tab-width) (buffer-saved-size, left-margin-width, right-margin-width) (left-fringe-width, right-fringe-width, scroll-bar-width) (scroll-bar-height, buffer-display-count): Allow any integer; do not restrict to fixnums. * src/character.h (SANE_TAB_WIDTH): Do not assume tab_width is a nonnegative fixnum. (sanitize_tab_width): Take a Lisp_Object integer, not an EMACS_INT. Only use changed. * src/data.c (store_symval_forwarding): Remove unnecessary SYMBOLP since the predicate (e.g., Qintegerp) is always a symbol (leave the test in as an eassert). Avoid assignments inside if-conditions. * src/fileio.c (Fdo_auto_save): Do not assume buffer-saved-size is a fixnum. Avoid undefined behavior on EMACS_INT overflow by multiplying a fixnum by at most 4, not by at most 13. * src/window.c (set_window_buffer): When buffer-display-count is too large for a fixnum, make it a bignum. * src/xdisp.c (FILL_COLUMN_INDICATOR_NEEDED): Remove macro, ... (fill_column_indicator_column): ... replacing with this new function. All uses changed. The function is a bit pickier, to prevent problems with non-character fixnums and columns out of range for int, and to remove the assumption that integers are in fixnum range. (append_space_for_newline, extend_face_to_end_of_line): Avoid undefined behavior with signed integer overflow. Simplify. diff --git a/doc/emacs/custom.texi b/doc/emacs/custom.texi index 8a8ac5d046..bdd6decb6b 100644 --- a/doc/emacs/custom.texi +++ b/doc/emacs/custom.texi @@ -801,6 +801,7 @@ Its value is 70 Automatically becomes buffer-local when set. This variable is safe as a file local variable if its value satisfies the predicate ‘integerp’. + Probably introduced at or before Emacs version 18. Documentation: Column beyond which automatic line-wrapping should happen. diff --git a/src/buffer.c b/src/buffer.c index 3b5078a175..209e29f0f1 100644 --- a/src/buffer.c +++ b/src/buffer.c @@ -5603,17 +5603,17 @@ Use the command `abbrev-mode' to change this variable. */); doc: /* Non-nil if searches and matches should ignore case. */); DEFVAR_PER_BUFFER ("fill-column", &BVAR (current_buffer, fill_column), - Qfixnump, + Qintegerp, doc: /* Column beyond which automatic line-wrapping should happen. Interactively, you can set the buffer local value using \\[set-fill-column]. */); DEFVAR_PER_BUFFER ("left-margin", &BVAR (current_buffer, left_margin), - Qfixnump, + Qintegerp, doc: /* Column for the default `indent-line-function' to indent to. Linefeed indents to this column in Fundamental mode. */); DEFVAR_PER_BUFFER ("tab-width", &BVAR (current_buffer, tab_width), - Qfixnump, + Qintegerp, doc: /* Distance between tab stops (for display of tab characters), in columns. NOTE: This controls the display width of a TAB character, and not the size of an indentation step. @@ -5784,7 +5784,7 @@ If it is nil, that means don't auto-save this buffer. */); Backing up is done before the first time the file is saved. */); DEFVAR_PER_BUFFER ("buffer-saved-size", &BVAR (current_buffer, save_length), - Qfixnump, + Qintegerp, doc: /* Length of current buffer when last read in, saved or auto-saved. 0 initially. -1 means auto-saving turned off until next real save. @@ -5858,7 +5858,7 @@ In addition, a char-table has six extra slots to control the display of: See also the functions `display-table-slot' and `set-display-table-slot'. */); DEFVAR_PER_BUFFER ("left-margin-width", &BVAR (current_buffer, left_margin_cols), - Qfixnump, + Qintegerp, doc: /* Width in columns of left marginal area for display of a buffer. A value of nil means no marginal area. @@ -5866,7 +5866,7 @@ Setting this variable does not take effect until a new buffer is displayed in a window. To make the change take effect, call `set-window-buffer'. */); DEFVAR_PER_BUFFER ("right-margin-width", &BVAR (current_buffer, right_margin_cols), - Qfixnump, + Qintegerp, doc: /* Width in columns of right marginal area for display of a buffer. A value of nil means no marginal area. @@ -5874,7 +5874,7 @@ Setting this variable does not take effect until a new buffer is displayed in a window. To make the change take effect, call `set-window-buffer'. */); DEFVAR_PER_BUFFER ("left-fringe-width", &BVAR (current_buffer, left_fringe_width), - Qfixnump, + Qintegerp, doc: /* Width of this buffer's left fringe (in pixels). A value of 0 means no left fringe is shown in this buffer's window. A value of nil means to use the left fringe width from the window's frame. @@ -5883,7 +5883,7 @@ Setting this variable does not take effect until a new buffer is displayed in a window. To make the change take effect, call `set-window-buffer'. */); DEFVAR_PER_BUFFER ("right-fringe-width", &BVAR (current_buffer, right_fringe_width), - Qfixnump, + Qintegerp, doc: /* Width of this buffer's right fringe (in pixels). A value of 0 means no right fringe is shown in this buffer's window. A value of nil means to use the right fringe width from the window's frame. @@ -5900,12 +5900,12 @@ Setting this variable does not take effect until a new buffer is displayed in a window. To make the change take effect, call `set-window-buffer'. */); DEFVAR_PER_BUFFER ("scroll-bar-width", &BVAR (current_buffer, scroll_bar_width), - Qfixnump, + Qintegerp, doc: /* Width of this buffer's vertical scroll bars in pixels. A value of nil means to use the scroll bar width from the window's frame. */); DEFVAR_PER_BUFFER ("scroll-bar-height", &BVAR (current_buffer, scroll_bar_height), - Qfixnump, + Qintegerp, doc: /* Height of this buffer's horizontal scroll bars in pixels. A value of nil means to use the scroll bar height from the window's frame. */); @@ -6175,7 +6175,7 @@ Setting this variable is very fast, much faster than scanning all the text in the buffer looking for properties to change. */); DEFVAR_PER_BUFFER ("buffer-display-count", - &BVAR (current_buffer, display_count), Qfixnump, + &BVAR (current_buffer, display_count), Qintegerp, doc: /* A number incremented each time this buffer is displayed in a window. The function `set-window-buffer' increments it. */); diff --git a/src/character.h b/src/character.h index 5dff85aed4..cc57a2a7d5 100644 --- a/src/character.h +++ b/src/character.h @@ -558,12 +558,13 @@ enum /* Return a non-outlandish value for the tab width. */ -#define SANE_TAB_WIDTH(buf) \ - sanitize_tab_width (XFIXNAT (BVAR (buf, tab_width))) +#define SANE_TAB_WIDTH(buf) sanitize_tab_width (BVAR (buf, tab_width)) + INLINE int -sanitize_tab_width (EMACS_INT width) +sanitize_tab_width (Lisp_Object width) { - return 0 < width && width <= 1000 ? width : 8; + return (FIXNUMP (width) && 0 < XFIXNUM (width) && XFIXNUM (width) <= 1000 + ? XFIXNUM (width) : 8); } /* Return the width of ASCII character C. The width is measured by diff --git a/src/data.c b/src/data.c index 476d28eadb..c1699aeae7 100644 --- a/src/data.c +++ b/src/data.c @@ -1122,20 +1122,21 @@ store_symval_forwarding (lispfwd valcontents, Lisp_Object newval, int offset = XBUFFER_OBJFWD (valcontents)->offset; Lisp_Object predicate = XBUFFER_OBJFWD (valcontents)->predicate; - if (!NILP (newval)) + if (!NILP (newval) && !NILP (predicate)) { - if (SYMBOLP (predicate)) + eassert (SYMBOLP (predicate)); + Lisp_Object choiceprop = Fget (predicate, Qchoice); + if (!NILP (choiceprop)) { - Lisp_Object prop; - - if ((prop = Fget (predicate, Qchoice), !NILP (prop))) - { - if (NILP (Fmemq (newval, prop))) - wrong_choice (prop, newval); - } - else if ((prop = Fget (predicate, Qrange), !NILP (prop))) + if (NILP (Fmemq (newval, choiceprop))) + wrong_choice (choiceprop, newval); + } + else + { + Lisp_Object rangeprop = Fget (predicate, Qrange); + if (CONSP (rangeprop)) { - Lisp_Object min = XCAR (prop), max = XCDR (prop); + Lisp_Object min = XCAR (rangeprop), max = XCDR (rangeprop); if (! NUMBERP (newval) || NILP (CALLN (Fleq, min, newval, max))) wrong_range (min, max, newval); diff --git a/src/fileio.c b/src/fileio.c index 4ee125d7de..9e9779967d 100644 --- a/src/fileio.c +++ b/src/fileio.c @@ -5802,6 +5802,7 @@ A non-nil CURRENT-ONLY argument means save only current buffer. */) && BUF_SAVE_MODIFF (b) < BUF_MODIFF (b) && BUF_AUTOSAVE_MODIFF (b) < BUF_MODIFF (b) /* -1 means we've turned off autosaving for a while--see below. */ + && FIXNUMP (BVAR (b, save_length)) && XFIXNUM (BVAR (b, save_length)) >= 0 && (do_handled_files || NILP (Ffind_file_name_handler (BVAR (b, auto_save_file_name), @@ -5815,13 +5816,17 @@ A non-nil CURRENT-ONLY argument means save only current buffer. */) && before_time.tv_sec - b->auto_save_failure_time < 1200) continue; + enum { growth_factor = 4 }; + verify (BUF_BYTES_MAX <= EMACS_INT_MAX / growth_factor); + set_buffer_internal (b); if (NILP (Vauto_save_include_big_deletions) - && (XFIXNAT (BVAR (b, save_length)) * 10 - > (BUF_Z (b) - BUF_BEG (b)) * 13) + && FIXNUMP (BVAR (b, save_length)) /* A short file is likely to change a large fraction; spare the user annoying messages. */ && XFIXNAT (BVAR (b, save_length)) > 5000 + && (growth_factor * (BUF_Z (b) - BUF_BEG (b)) + < (growth_factor - 1) * XFIXNAT (BVAR (b, save_length))) /* These messages are frequent and annoying for `*mail*'. */ && !NILP (BVAR (b, filename)) && NILP (no_message)) diff --git a/src/lisp.h b/src/lisp.h index 876b757bf3..6db9059689 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -2679,7 +2679,7 @@ struct Lisp_Buffer_Objfwd { enum Lisp_Fwd_Type type; /* = Lisp_Fwd_Buffer_Obj */ int offset; - /* One of Qnil, Qfixnump, Qsymbolp, Qstringp, Qfloatp or Qnumberp. */ + /* One of Qnil, Qintegerp, Qsymbolp, Qstringp, Qfloatp or Qnumberp. */ Lisp_Object predicate; }; diff --git a/src/window.c b/src/window.c index ca7cf7a4a6..deeb4f63fe 100644 --- a/src/window.c +++ b/src/window.c @@ -3947,8 +3947,8 @@ set_window_buffer (Lisp_Object window, Lisp_Object buffer, b->display_error_modiff = 0; /* Update time stamps of buffer display. */ - if (FIXNUMP (BVAR (b, display_count))) - bset_display_count (b, make_fixnum (XFIXNUM (BVAR (b, display_count)) + 1)); + if (INTEGERP (BVAR (b, display_count))) + bset_display_count (b, Fadd1 (BVAR (b, display_count))); bset_display_time (b, Fcurrent_time ()); w->window_end_pos = 0; diff --git a/src/xdisp.c b/src/xdisp.c index 9eed74cb98..5f43815234 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -376,17 +376,26 @@ static Lisp_Object list_of_error; || it->s[IT_BYTEPOS (*it)] == '\t')) \ || (IT_BYTEPOS (*it) < ZV_BYTE \ && (*BYTE_POS_ADDR (IT_BYTEPOS (*it)) == ' ' \ - || *BYTE_POS_ADDR (IT_BYTEPOS (*it)) == '\t')))) \ - -/* Test all the conditions needed to print the fill column indicator. */ -#define FILL_COLUMN_INDICATOR_NEEDED(it) \ - Vdisplay_fill_column_indicator \ - && (it->continuation_lines_width == 0) \ - && (!NILP (Vdisplay_fill_column_indicator_column)) \ - && FIXNATP (Vdisplay_fill_column_indicator_character) \ - && ((EQ (Vdisplay_fill_column_indicator_column, Qt) \ - && FIXNATP (BVAR (current_buffer, fill_column))) \ - || (FIXNATP (Vdisplay_fill_column_indicator_column))) + || *BYTE_POS_ADDR (IT_BYTEPOS (*it)) == '\t')))) + +/* If all the conditions needed to print the fill column indicator are + met, return the (nonnegative) column number, else return a negative + value. */ +static int +fill_column_indicator_column (struct it *it) +{ + if (Vdisplay_fill_column_indicator + && it->continuation_lines_width == 0 + && CHARACTERP (Vdisplay_fill_column_indicator_character)) + { + Lisp_Object col = (EQ (Vdisplay_fill_column_indicator_column, Qt) + ? BVAR (current_buffer, fill_column) + : Vdisplay_fill_column_indicator_column); + if (RANGED_FIXNUMP (0, col, INT_MAX)) + return XFIXNUM (col); + } + return -1; +} /* True means print newline to stdout before next mini-buffer message. */ @@ -20160,18 +20169,11 @@ append_space_for_newline (struct it *it, bool default_face_p) /* Corner case for when display-fill-column-indicator-mode is active and the extra character should be added in the same place than the line. */ - if ((it->w->pseudo_window_p == 0) - && FILL_COLUMN_INDICATOR_NEEDED(it)) + int indicator_column = (it->w->pseudo_window_p == 0 + ? fill_column_indicator_column (it) + : -1); + if (0 <= indicator_column) { - int fill_column_indicator_column = -1; - - if (EQ (Vdisplay_fill_column_indicator_column, Qt)) - fill_column_indicator_column = - XFIXNAT (BVAR (current_buffer, fill_column)); - else - fill_column_indicator_column = - XFIXNAT (Vdisplay_fill_column_indicator_column); - struct font *font = default_face->font ? default_face->font : FRAME_FONT (it->f); @@ -20179,18 +20181,19 @@ append_space_for_newline (struct it *it, bool default_face_p) font->average_width ? font->average_width : font->space_width; - const int column_x = - char_width * fill_column_indicator_column + - it->lnum_pixel_width; - - if (it->current_x == column_x) + int column_x; + if (!INT_MULTIPLY_WRAPV (indicator_column, char_width, + &column_x) + && !INT_ADD_WRAPV (it->lnum_pixel_width, column_x, + &column_x) + && it->current_x == column_x) { it->c = it->char_to_display = XFIXNAT (Vdisplay_fill_column_indicator_character); it->face_id = merge_faces (it->w, Qfill_column_indicator, 0, saved_face_id); - face = FACE_FROM_ID(it->f, it->face_id); + face = FACE_FROM_ID (it->f, it->face_id); goto produce_glyphs; } } @@ -20422,30 +20425,22 @@ extend_face_to_end_of_line (struct it *it) /* Display fill column indicator if not in modeline or toolbar and display fill column indicator mode is active. */ - if ((it->w->pseudo_window_p == 0) - && FILL_COLUMN_INDICATOR_NEEDED(it)) + int indicator_column = (it->w->pseudo_window_p == 0 + ? fill_column_indicator_column (it) + : -1); + if (0 <= indicator_column) { - int fill_column_indicator_column = -1; - - if (EQ (Vdisplay_fill_column_indicator_column, Qt)) - fill_column_indicator_column = - XFIXNAT (BVAR (current_buffer, fill_column)); - else - fill_column_indicator_column = - XFIXNAT (Vdisplay_fill_column_indicator_column); - struct font *font = default_face->font ? default_face->font : FRAME_FONT (f); const int char_width = font->average_width ? font->average_width : font->space_width; - const int column_x = - char_width * fill_column_indicator_column + - it->lnum_pixel_width; - - if ((it->current_x <= column_x) - && (column_x <= it->last_visible_x)) + int column_x; + if (!INT_MULTIPLY_WRAPV (indicator_column, char_width, &column_x) + && !INT_ADD_WRAPV (it->lnum_pixel_width, column_x, &column_x) + && it->current_x <= column_x + && column_x <= it->last_visible_x) { const char saved_char = it->char_to_display; const struct text_pos saved_pos = it->position; @@ -20625,45 +20620,33 @@ extend_face_to_end_of_line (struct it *it) it->face_id = face->id; /* Display fill-column indicator if needed. */ - if (FILL_COLUMN_INDICATOR_NEEDED(it)) + int indicator_column = fill_column_indicator_column (it); + if (0 <= indicator_column + && INT_ADD_WRAPV (it->lnum_pixel_width, indicator_column, + &indicator_column)) + indicator_column = -1; + do { - int fill_column_indicator_column = -1; + int saved_face_id; + bool indicate = it->current_x == indicator_column; + if (indicate) + { + saved_face_id = it->face_id; + it->face_id = + merge_faces (it->w, Qfill_column_indicator, 0, saved_face_id); + it->c = it->char_to_display = + XFIXNAT (Vdisplay_fill_column_indicator_character); + } - /* Vdisplay_fill_column_indicator_column accepts the special - value t to use the default fill-column variable. The - conditions are all defined in the macro - FILL_COLUMN_INDICATOR_NEEDED. */ - if (EQ (Vdisplay_fill_column_indicator_column, Qt)) - fill_column_indicator_column = - XFIXNAT (BVAR (current_buffer, fill_column)) + it->lnum_pixel_width; - else - fill_column_indicator_column = - XFIXNAT (Vdisplay_fill_column_indicator_column) + it->lnum_pixel_width; + PRODUCE_GLYPHS (it); - do + if (indicate) { - if (it->current_x == fill_column_indicator_column) - { - const int saved_face_id = it->face_id; - it->face_id = - merge_faces (it->w, Qfill_column_indicator, 0, saved_face_id); - it->c = it->char_to_display = - XFIXNAT (Vdisplay_fill_column_indicator_character); - PRODUCE_GLYPHS (it); - it->face_id = saved_face_id; - it->c = it->char_to_display = ' '; - } - else - PRODUCE_GLYPHS (it); - } while (it->current_x <= it->last_visible_x); + it->face_id = saved_face_id; + it->c = it->char_to_display = ' '; + } } - else - { - do - { - PRODUCE_GLYPHS (it); - } while (it->current_x <= it->last_visible_x); - } + while (it->current_x <= it->last_visible_x); if (WINDOW_RIGHT_MARGIN_WIDTH (it->w) > 0 && (it->glyph_row->used[RIGHT_MARGIN_AREA] commit 5c21832ae866077874fb662e49c695a7850ec22c Merge: d99f0c6fb8 b0da9151d8 Author: Glenn Morris Date: Wed May 22 10:18:51 2019 -0700 Merge from origin/emacs-26 b0da915 (origin/emacs-26, emacs-26) Fix a typo in ELisp manual 400907b Add option to disable help completion autoloading (Bug#28607) 122ba16 Don't segfault on force-window-update of deleted window 015b12e Fix typo in ELisp manual eadf044 Remove repeated function call in picture.el 1228a90 ; Fix mm-destroy-parts docstring typo 6cfd68d Fix Hideshow key binding typo in Emacs manual commit d99f0c6fb831da5cc5e4ca2661d660906f30625d Merge: 0d1ff4cbe2 7ce4b35ac4 Author: Glenn Morris Date: Wed May 22 10:18:51 2019 -0700 ; Merge from origin/emacs-26 The following commit was skipped: 7ce4b35 Backport: Fix name of gnus-summary-sort-by-mark(s) commit 0d1ff4cbe232e9ee398dc30058495c29996c0b33 Merge: 5a024b72c5 5d24af87c1 Author: Glenn Morris Date: Wed May 22 10:18:51 2019 -0700 Merge from origin/emacs-26 5d24af8 Remove from docs references to obsolete MULE variables 2bdc419 Do potentially destructive operations in prepare-commit-msg # Conflicts: # src/search.c commit b0da9151d880f7ae60367a4b3d3ef91209bbd06f Author: Tom Levy Date: Tue May 21 14:25:31 2019 +1200 Fix a typo in ELisp manual * doc/lispref/sequences.texi (Sequence Functions): Fix a typo. (Bug#35817) Copyright-paperwork-exempt: yes diff --git a/doc/lispref/sequences.texi b/doc/lispref/sequences.texi index 5cf2e89644..bf2c9c8a7d 100644 --- a/doc/lispref/sequences.texi +++ b/doc/lispref/sequences.texi @@ -601,7 +601,7 @@ returned value is a list. @defun seq-mapn function &rest sequences This function returns the result of applying @var{function} to each element of @var{sequences}. The arity (@pxref{What Is a Function, -sub-arity}) of @var{function} must match the number of sequences. +subr-arity}) of @var{function} must match the number of sequences. Mapping stops at the end of the shortest sequence, and the returned value is a list. commit 400907b3c1d94359dda38ad5f416829567d6e478 Author: Noam Postavsky Date: Wed May 15 20:29:38 2019 -0400 Add option to disable help completion autoloading (Bug#28607) * lisp/help-fns.el (help-enable-completion-auto-load): New option. (help--symbol-completion-table): Consult it. * doc/emacs/building.texi (Lisp Libraries): Document it. * etc/NEWS: Announce it. * doc/lispref/loading.texi (Autoload by Prefix): New section. (Autoload): Reference it. diff --git a/doc/emacs/building.texi b/doc/emacs/building.texi index 31acfc827b..246a04c282 100644 --- a/doc/emacs/building.texi +++ b/doc/emacs/building.texi @@ -1499,6 +1499,12 @@ library lets Emacs properly set up the hyperlinks in the @file{*Help*} buffer). To disable this feature, change the variable @code{help-enable-auto-load} to @code{nil}. +@vindex help-enable-completion-auto-load +Automatic loading also occurs when completing names for +@code{describe-variable} and @code{describe-function}, based on the +prefix being completed. To disable this feature, change the variable +@code{help-enable-completion-auto-load} to @code{nil}. + @vindex load-dangerous-libraries @cindex Lisp files byte-compiled by XEmacs By default, Emacs refuses to load compiled Lisp files which were diff --git a/doc/lispref/loading.texi b/doc/lispref/loading.texi index f0cc689d1f..fa6b301bb0 100644 --- a/doc/lispref/loading.texi +++ b/doc/lispref/loading.texi @@ -466,9 +466,11 @@ first call to the function automatically loads the proper library, in order to install the real definition and other associated code, then runs the real definition as if it had been loaded all along. Autoloading can also be triggered by looking up the documentation of -the function or macro (@pxref{Documentation Basics}). +the function or macro (@pxref{Documentation Basics}), and completion +of variable and function names (@pxref{Autoload by Prefix} below). @menu +* Autoload by Prefix:: Autoload by Prefix. * When to Autoload:: When to Use Autoload. @end menu @@ -703,6 +705,25 @@ symbol's new function value. If the value of the optional argument function, only a macro. @end defun +@node Autoload by Prefix +@subsection Autoload by Prefix +@cindex autoload by prefix + +@vindex definition-prefixes +@findex register-definition-prefixes +@vindex autoload-compute-prefixes +During completion for the commands @code{describe-variable} and +@code{describe-function}, Emacs will try to load files which may +contain definitions matching the prefix being completed. The variable +@code{definition-prefixes} holds a hashtable which maps a prefix to +the corresponding list of files to load for it. Entries to this +mapping are added by calls to @code{register-definition-prefixes} +which are generated by @code{update-file-autoloads} +(@pxref{Autoload}). Files which don't contain any definitions worth +loading (test files, for examples), should set +@code{autoload-compute-prefixes} to @code{nil} as a file-local +variable. + @node When to Autoload @subsection When to Use Autoload @cindex autoload, when to use diff --git a/etc/NEWS b/etc/NEWS index 573c8236b2..1b66862841 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -24,6 +24,12 @@ with a prefix argument or by typing 'C-u C-h C-n'. * Changes in Emacs 26.3 ++++ +** New option 'help-enable-completion-auto-load'. +This allows disabling the new feature introduced in Emacs 26.1 which +loads files during completion of 'C-h f' and 'C-h v' according to +'definition-prefixes'. + * Editing Changes in Emacs 26.3 diff --git a/lisp/help-fns.el b/lisp/help-fns.el index a7812e3b4b..8684a853af 100644 --- a/lisp/help-fns.el +++ b/lisp/help-fns.el @@ -89,11 +89,23 @@ The functions will receive the function name as argument.") (unless (help--loaded-p file) (load file 'noerror 'nomessage))))) +(defcustom help-enable-completion-auto-load t + "Whether completion for Help commands can perform autoloading. +If non-nil, whenever invoking completion for `describe-function' +or `describe-variable' load files that might contain definitions +with the current prefix. The files are chosen according to +`definition-prefixes'." + :type 'boolean + :group 'help + :version "26.3") + (defun help--symbol-completion-table (string pred action) - (let ((prefixes (radix-tree-prefixes (help-definition-prefixes) string))) - (help--load-prefixes prefixes)) + (when help-enable-completion-auto-load + (let ((prefixes (radix-tree-prefixes (help-definition-prefixes) string))) + (help--load-prefixes prefixes))) (let ((prefix-completions - (mapcar #'intern (all-completions string definition-prefixes)))) + (and help-enable-completion-auto-load + (mapcar #'intern (all-completions string definition-prefixes))))) (complete-with-action action obarray string (if pred (lambda (sym) (or (funcall pred sym) commit 122ba1689046c53535b4d6c5142cfd81752808d0 Author: Noam Postavsky Date: Sun May 19 13:05:55 2019 -0400 Don't segfault on force-window-update of deleted window * src/window.c (Fforce_window_update): Do nothing for deleted windows (Bug#35784). diff --git a/src/window.c b/src/window.c index dfac3b5b87..4d5ddeea14 100644 --- a/src/window.c +++ b/src/window.c @@ -3637,7 +3637,7 @@ displaying that buffer. */) return Qt; } - if (WINDOWP (object)) + if (WINDOW_LIVE_P (object)) { struct window *w = XWINDOW (object); mark_window_display_accurate (object, false); commit 015b12ebb84995386dd84ef80092f01fba882168 Author: Mauro Aranda Date: Sun May 19 11:36:26 2019 -0300 Fix typo in ELisp manual * doc/lispref/variables.texi (Directory Local Variables): Fix typo in dir-locals-set-class-variables description. (Bug#35799) diff --git a/doc/lispref/variables.texi b/doc/lispref/variables.texi index f1e0e37e6d..153a80a444 100644 --- a/doc/lispref/variables.texi +++ b/doc/lispref/variables.texi @@ -2009,7 +2009,7 @@ all files in those directories. The list in @var{variables} can be of one of the two forms: @code{(@var{major-mode} . @var{alist})} or @code{(@var{directory} . @var{list})}. With the first form, if the file's buffer turns on a mode that is derived from @var{major-mode}, -then the all the variables in the associated @var{alist} are applied; +then all the variables in the associated @var{alist} are applied; @var{alist} should be of the form @code{(@var{name} . @var{value})}. A special value @code{nil} for @var{major-mode} means the settings are applicable to any mode. In @var{alist}, you can use a special commit eadf044e0663703af61967c1ff890043f46c9a15 Author: Mauro Aranda Date: Fri May 17 10:00:01 2019 -0300 Remove repeated function call in picture.el * lisp/textmodes/picture.el (picture-mode-map): Remove repeated define-key call. (Bug#35772) diff --git a/lisp/textmodes/picture.el b/lisp/textmodes/picture.el index f0e30135f1..aed531e769 100644 --- a/lisp/textmodes/picture.el +++ b/lisp/textmodes/picture.el @@ -622,7 +622,6 @@ Leaves the region surrounding the rectangle." (defvar picture-mode-map (let ((map (make-keymap))) - (define-key map [remap self-insert-command] 'picture-self-insert) (define-key map [remap self-insert-command] 'picture-self-insert) (define-key map [remap completion-separator-self-insert-command] 'picture-self-insert) commit 1228a90c69b51c6e9084385552ff991e6915b175 Author: Basil L. Contovounesios Date: Mon May 20 00:37:13 2019 +0100 ; Fix mm-destroy-parts docstring typo * lisp/gnus/mm-decode.el (mm-destroy-parts): Fix typo in docstring copy-pasted from mm-remove-parts. diff --git a/lisp/gnus/mm-decode.el b/lisp/gnus/mm-decode.el index 21552abae7..33cb797bf6 100644 --- a/lisp/gnus/mm-decode.el +++ b/lisp/gnus/mm-decode.el @@ -1117,7 +1117,7 @@ external if displayed external." (mm-remove-part handle))))))) (defun mm-destroy-parts (handles) - "Remove the displayed MIME parts represented by HANDLES." + "Destroy the displayed MIME parts represented by HANDLES." (if (and (listp handles) (bufferp (car handles))) (mm-destroy-part handles) commit 6cfd68d4d7c3e577ba1ed55b304229fc6e78718b Author: Basil L. Contovounesios Date: Sun May 19 13:52:26 2019 +0100 Fix Hideshow key binding typo in Emacs manual * doc/emacs/programs.texi (Hideshow): Add missing function and key index entries. Fix hs-toggle-hiding binding typo. (bug#35798) diff --git a/doc/emacs/programs.texi b/doc/emacs/programs.texi index 9d712eb66c..df14fd8a05 100644 --- a/doc/emacs/programs.texi +++ b/doc/emacs/programs.texi @@ -1332,8 +1332,11 @@ count as blocks. @findex hs-show-block @findex hs-show-region @findex hs-hide-level +@findex hs-toggle-hiding +@findex hs-mouse-toggle-hiding @kindex C-c @@ C-h @kindex C-c @@ C-s +@kindex C-c @@ C-c @kindex C-c @@ C-M-h @kindex C-c @@ C-M-s @kindex C-c @@ C-r @@ -1346,7 +1349,7 @@ Hide the current block (@code{hs-hide-block}). @item C-c @@ C-s Show the current block (@code{hs-show-block}). @item C-c @@ C-c -@itemx C-x @@ C-e +@itemx C-c @@ C-e Either hide or show the current block (@code{hs-toggle-hiding}). @item S-mouse-2 Toggle hiding for the block you click on (@code{hs-mouse-toggle-hiding}). commit 7ce4b35ac427506bb8b43ab14a134bd2e707c9d6 Author: Eric Abrahamsen Date: Mon Nov 13 21:40:17 2017 -0800 Backport: Fix name of gnus-summary-sort-by-mark(s) * lisp/gnus/gnus-sum.el (gnus-summary-sort-by-marks): Needs the "s", according to docs and keymap both. (bug#35765) (cherry picked from commit 13248f7444630508cfc3b78a07e8d96613af11c8) diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el index 9c95934ee0..99b970e323 100644 --- a/lisp/gnus/gnus-sum.el +++ b/lisp/gnus/gnus-sum.el @@ -11963,7 +11963,7 @@ Argument REVERSE means reverse order." (interactive "P") (gnus-summary-sort 'chars reverse)) -(defun gnus-summary-sort-by-mark (&optional reverse) +(defun gnus-summary-sort-by-marks (&optional reverse) "Sort the summary buffer by article marks. Argument REVERSE means reverse order." (interactive "P") commit 5d24af87c15d9baa9db96fe3c3200d5585d58c4e Author: Eli Zaretskii Date: Fri May 17 09:58:15 2019 +0300 Remove from docs references to obsolete MULE variables * src/search.c (search_buffer): Remove obsolete text from a comment. * src/fns.c (Fstring_make_unibyte): Remove obsolete text from a doc string. diff --git a/src/fns.c b/src/fns.c index d629975520..8db2a86a72 100644 --- a/src/fns.c +++ b/src/fns.c @@ -1042,10 +1042,8 @@ string the same way whether it is unibyte or multibyte.) */) DEFUN ("string-make-unibyte", Fstring_make_unibyte, Sstring_make_unibyte, 1, 1, 0, doc: /* Return the unibyte equivalent of STRING. -Multibyte character codes are converted to unibyte according to -`nonascii-translation-table' or, if that is nil, `nonascii-insert-offset'. -If the lookup in the translation table fails, this function takes just -the low 8 bits of each character. */) +Multibyte character codes above 255 are converted to unibyte +by taking just the low 8 bits of each character's code. */) (Lisp_Object string) { CHECK_STRING (string); diff --git a/src/search.c b/src/search.c index 9bde884bc5..db7fecd9ba 100644 --- a/src/search.c +++ b/src/search.c @@ -1341,12 +1341,7 @@ search_buffer (Lisp_Object string, ptrdiff_t pos, ptrdiff_t pos_byte, } else { - /* Converting multibyte to single-byte. - - ??? Perhaps this conversion should be done in a special way - by subtracting nonascii-insert-offset from each non-ASCII char, - so that only the multibyte chars which really correspond to - the chosen single-byte character set can possibly match. */ + /* Converting multibyte to single-byte. */ raw_pattern_size = SCHARS (string); raw_pattern_size_byte = SCHARS (string); raw_pattern = SAFE_ALLOCA (raw_pattern_size + 1); commit 2bdc419f51630eb433deb139da67e419000c7694 Author: Konstantin Kharlamov Date: Thu May 16 00:25:53 2019 +0300 Do potentially destructive operations in prepare-commit-msg * build-aux/git-hooks/prepare-commit-msg: If someone occasionally puts Signed-off line, it will likely get there through -s option of git. Exploit this fact to abort before a user got a chance to type commit message. (Bug#35368) diff --git a/autogen.sh b/autogen.sh index 7972f01b38..bf8d61f0c6 100755 --- a/autogen.sh +++ b/autogen.sh @@ -323,7 +323,7 @@ git_config diff.texinfo.xfuncname \ tailored_hooks= sample_hooks= -for hook in commit-msg pre-commit; do +for hook in commit-msg pre-commit prepare-commit-msg; do cmp -- build-aux/git-hooks/$hook "$hooks/$hook" >/dev/null 2>&1 || tailored_hooks="$tailored_hooks $hook" done diff --git a/build-aux/git-hooks/prepare-commit-msg b/build-aux/git-hooks/prepare-commit-msg new file mode 100755 index 0000000000..3562a80223 --- /dev/null +++ b/build-aux/git-hooks/prepare-commit-msg @@ -0,0 +1,45 @@ +#!/bin/sh +# Check the format of GNU Emacs change log entries. + +# Copyright 2019 Free Software Foundation, Inc. + +# This file is part of GNU Emacs. + +# GNU Emacs is free software: you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation, either version 3 of the License, or +# (at your option) any later version. + +# GNU Emacs is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. + +# You should have received a copy of the GNU General Public License +# along with GNU Emacs. If not, see . + +COMMIT_MSG_FILE=$1 +COMMIT_SOURCE=$2 +SHA1=$3 + +# Prefer gawk if available, as it handles NUL bytes properly. +if type gawk >/dev/null 2>&1; then + awk=gawk +else + awk=awk +fi + +exec $awk ' + # Catch the case when someone ran git-commit with -s option, + # which automatically adds Signed-off-by. + /^Signed-off-by: / { + print "'\''Signed-off-by:'\'' in commit message" + status = 1 + } + END { + if (status != 0) { + print "Commit aborted; please see the file 'CONTRIBUTE'" + } + exit status + } +' <"$COMMIT_MSG_FILE"