commit d2dea70415ca7ec390a2de11b224ab4cbb2c6b55 (HEAD, refs/remotes/origin/master) Author: Paul Eggert Date: Mon May 13 22:59:29 2019 -0700 Default to disabling ImageMagick (Bug#33587) ImageMagick has continuing stability and security problems, suggesting that 'configure' should disable it by default. See Glenn Morris's notes at: https://lists.gnu.org/r/emacs-devel/2018-12/msg00036.html * INSTALL, etc/NEWS, nt/INSTALL.W64: Mention this. * configure.ac (imagemagick): Default to off. diff --git a/INSTALL b/INSTALL index e38635c60b..b2a06b3d15 100644 --- a/INSTALL +++ b/INSTALL @@ -295,7 +295,9 @@ or more of these options: --without-gif for GIF image support --without-png for PNG image support --without-rsvg for SVG image support - --without-imagemagick for Imagemagick support + +Although ImageMagick support is disabled by default due to security +and stability concerns, you can enable it with --with-imagemagick. Use --without-toolkit-scroll-bars to disable Motif or Xaw3d scroll bars. diff --git a/configure.ac b/configure.ac index 79fe0c98c6..d13dddfd9a 100644 --- a/configure.ac +++ b/configure.ac @@ -432,7 +432,7 @@ OPTION_DEFAULT_ON([lcms2],[don't compile with Little CMS support]) OPTION_DEFAULT_ON([libsystemd],[don't compile with libsystemd support]) OPTION_DEFAULT_OFF([cairo],[compile with Cairo drawing (experimental)]) OPTION_DEFAULT_ON([xml2],[don't compile with XML parsing support]) -OPTION_DEFAULT_ON([imagemagick],[don't compile with ImageMagick image support]) +OPTION_DEFAULT_OFF([imagemagick],[compile with ImageMagick image support]) OPTION_DEFAULT_ON([json], [don't compile with native JSON support]) OPTION_DEFAULT_ON([xft],[don't use XFT for anti aliased fonts]) diff --git a/etc/NEWS b/etc/NEWS index fa9ca8603d..f7ee9a9dfe 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -37,6 +37,10 @@ functions 'json-serialize', 'json-insert', 'json-parse-string', and 'json-parse-buffer' are typically much faster than their Lisp counterparts from json.el. +** Emacs no longer defaults to using ImageMagick to display images, +due to security and stability concerns. To override the default, use +'configure --with-imagemagick'. + ** Several configure options now accept an option-argument 'ifavailable'. For example, './configure --with-xpm=ifavailable' now configures Emacs to attempt to use libxpm but to continue building even if libxpm is diff --git a/nt/INSTALL.W64 b/nt/INSTALL.W64 index 994c567c34..4583aed83b 100644 --- a/nt/INSTALL.W64 +++ b/nt/INSTALL.W64 @@ -139,10 +139,10 @@ which 'make install' will use - in this example we set it to C:\emacs\emacs-26. If a prefix is not specified the files will be put in the standard Unix directories located in your C:\msys64 directory, but this is not recommended. -Note also that we need to disable Imagemagick and D-Bus because Emacs -does not yet support them on Windows. +Note also that we need to disable D-Bus because Emacs does not yet +support them on Windows. - ./configure --prefix=/c/emacs/emacs-26 --without-imagemagick --without-dbus + ./configure --prefix=/c/emacs/emacs-26 --without-dbus ** Run make commit e0ee41d155b210327eb9c9ad5334f80ed59439f4 Author: Dmitry Gutov Date: Tue May 14 05:09:19 2019 +0300 Allow customizing the display of project file names when reading To hopefully resolve a long-running discussion (https://lists.gnu.org/archive/html/emacs-devel/2019-05/msg00162.html). * lisp/progmodes/project.el (project-read-file-name-function): New variable. (project--read-file-absolute, project--read-file-cpd-relative): New functions, possible values for the above. (project-find-file-in): Use the introduced variable. (project--completing-read-strict): Retain just the logic that fits the name. diff --git a/etc/NEWS b/etc/NEWS index 43ad8be1cc..fa9ca8603d 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1983,6 +1983,8 @@ returns a regexp that never matches anything, which is an identity for this operation. Previously, the empty string was returned in this case. +** New variable project-read-file-name-function. + * Changes in Emacs 27.1 on Non-Free Operating Systems diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index dbd24dfa0a..d11a5cf574 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -846,6 +846,8 @@ styles for specific categories, such as files, buffers, etc." (defvar completion-category-defaults '((buffer (styles . (basic substring))) (unicode-name (styles . (basic substring))) + ;; A new style that combines substring and pcm might be better, + ;; e.g. one that does not anchor to bos. (project-file (styles . (substring))) (info-menu (styles . (basic substring)))) "Default settings for specific completion categories. diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el index 7c8ca15868..ddb4f3354c 100644 --- a/lisp/progmodes/project.el +++ b/lisp/progmodes/project.el @@ -157,19 +157,13 @@ end it with `/'. DIR must be one of `project-roots' or vc-directory-exclusion-list) grep-find-ignored-files)) -(cl-defgeneric project-file-completion-table (project dirs) - "Return a completion table for files in directories DIRS in PROJECT. -DIRS is a list of absolute directories; it should be some -subset of the project roots and external roots. - -The default implementation delegates to `project-files'." - (let ((all-files (project-files project dirs))) - (lambda (string pred action) - (cond - ((eq action 'metadata) - '(metadata . ((category . project-file)))) - (t - (complete-with-action action all-files string pred)))))) +(defun project--file-completion-table (all-files) + (lambda (string pred action) + (cond + ((eq action 'metadata) + '(metadata . ((category . project-file)))) + (t + (complete-with-action action all-files string pred))))) (cl-defmethod project-roots ((project (head transient))) (list (cdr project))) @@ -470,55 +464,72 @@ recognized." (project-external-roots pr)))) (project-find-file-in (thing-at-point 'filename) dirs pr))) +(defcustom project-read-file-name-function #'project--read-file-cpd-relative + "Function to call to read a file name from a list. +For the arguments list, see `project--read-file-cpd-relative'." + :type '(repeat (choice (const :tag "Read with completion from relative names" + project--read-file-cpd-relative) + (const :tag "Read with completion from absolute names" + project--read-file-absolute) + (function :tag "custom function" nil)))) + +(defun project--read-file-cpd-relative (prompt + all-files &optional predicate + hist default) + (let* ((common-parent-directory + (let ((common-prefix (try-completion "" all-files))) + (if (> (length common-prefix) 0) + (file-name-directory common-prefix)))) + (cpd-length (length common-parent-directory)) + (prompt (if (zerop cpd-length) + prompt + (concat prompt (format " in %s" common-parent-directory)))) + (substrings (mapcar (lambda (s) (substring s cpd-length)) all-files)) + (new-collection (project--file-completion-table substrings)) + (res (project--completing-read-strict prompt + new-collection + predicate + hist default))) + (concat common-parent-directory res))) + +(defun project--read-file-absolute (prompt + all-files &optional predicate + hist default) + (project--completing-read-strict prompt + (project--file-completion-table all-files) + predicate + hist default)) + (defun project-find-file-in (filename dirs project) "Complete FILENAME in DIRS in PROJECT and visit the result." - (let* ((table (project-file-completion-table project dirs)) - (file (project--completing-read-strict - "Find file" table nil nil - filename))) + (let* ((all-files (project-files project dirs)) + (file (funcall project-read-file-name-function + "Find file" all-files nil nil + filename))) (if (string= file "") (user-error "You didn't specify the file") (find-file file)))) (defun project--completing-read-strict (prompt collection &optional predicate - hist default inherit-input-method) + hist default) ;; Tried both expanding the default before showing the prompt, and ;; removing it when it has no matches. Neither seems natural ;; enough. Removal is confusing; early expansion makes the prompt ;; too long. - (let* ((common-parent-directory - (let ((common-prefix (try-completion "" collection))) - (if (> (length common-prefix) 0) - (file-name-directory common-prefix)))) - (cpd-length (length common-parent-directory)) - (prompt (if (zerop cpd-length) - prompt - (concat prompt (format " in %s" common-parent-directory)))) - ;; XXX: This requires collection to be "flat" as well. - (substrings (mapcar (lambda (s) (substring s cpd-length)) - (all-completions "" collection))) - (new-collection - (lambda (string pred action) - (cond - ((eq action 'metadata) - (if (functionp collection) (funcall collection nil nil 'metadata))) - (t - (complete-with-action action substrings string pred))))) - (new-prompt (if default + (let* ((new-prompt (if default (format "%s (default %s): " prompt default) (format "%s: " prompt))) (res (completing-read new-prompt - new-collection predicate t + collection predicate t nil ;; initial-input - hist default inherit-input-method))) + hist default))) (when (and (equal res default) (not (test-completion res collection predicate))) (setq res (completing-read (format "%s: " prompt) - new-collection predicate t res hist nil - inherit-input-method))) - (concat common-parent-directory res))) + collection predicate t res hist nil))) + res)) (declare-function fileloop-continue "fileloop" ()) commit 9b28a5083edecacfac3c7e16308bd8af3f4773a2 Author: YAMAMOTO Mitsuharu Date: Tue May 14 10:17:16 2019 +0900 Avoid artifacts in ftx and ftcr font backend drivers * src/ftcrfont.c (ftcrfont_open): * src/ftfont.c (ftfont_open2): Make font->height equal to sum of font->ascent and font->descent. Respect :minspace property. (ftfont_open2): Remove redundant assignment. (syms_of_ftfont) : New DEFSYM. diff --git a/src/ftcrfont.c b/src/ftcrfont.c index 8a1c9a48e1..e7c73eac4d 100644 --- a/src/ftcrfont.c +++ b/src/ftcrfont.c @@ -160,8 +160,18 @@ ftcrfont_open (struct frame *f, Lisp_Object entity, int pixel_size) cairo_font_extents_t extents; cairo_scaled_font_extents (ftcrfont_info->cr_scaled_font, &extents); font->ascent = lround (extents.ascent); - font->descent = lround (extents.descent); - font->height = lround (extents.height); + 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 + { + font->height = lround (extents.height); + font->descent = font->height - font->ascent; + } cairo_glyph_t stack_glyph; int n = 0; diff --git a/src/ftfont.c b/src/ftfont.c index d0078a3770..4770c3c40b 100644 --- a/src/ftfont.c +++ b/src/ftfont.c @@ -1108,7 +1108,6 @@ ftfont_open2 (struct frame *f, return Qnil; filename = XCAR (val); idx = XCDR (val); - val = XCDR (cache); cache_data = xmint_pointer (XCDR (cache)); ft_face = cache_data->ft_face; if (cache_data->face_refcount > 0) @@ -1172,20 +1171,38 @@ ftfont_open2 (struct frame *f, font->driver = &ftfont_driver; font->encoding_charset = font->repertory_charset = -1; + val = assq_no_quit (QCminspace, AREF (entity, FONT_EXTRA_INDEX)); + bool no_leading_p = !(CONSP (val) && NILP (XCDR (val))); upEM = ft_face->units_per_EM; scalable = (FIXNUMP (AREF (entity, FONT_AVGWIDTH_INDEX)) && XFIXNUM (AREF (entity, FONT_AVGWIDTH_INDEX)) == 0); if (scalable) { font->ascent = ft_face->ascender * size / upEM + 0.5; - font->descent = - ft_face->descender * size / upEM + 0.5; - font->height = ft_face->height * size / upEM + 0.5; + if (no_leading_p) + { + font->descent = - ft_face->descender * size / upEM + 0.5; + font->height = font->ascent + font->descent; + } + else + { + font->height = ft_face->height * size / upEM + 0.5; + font->descent = font->height - font->ascent; + } } else { font->ascent = ft_face->size->metrics.ascender >> 6; - font->descent = - ft_face->size->metrics.descender >> 6; - font->height = ft_face->size->metrics.height >> 6; + if (no_leading_p) + { + font->descent = - ft_face->size->metrics.descender >> 6; + font->height = font->ascent + font->descent; + } + else + { + font->height = ft_face->size->metrics.height >> 6; + font->descent = font->height - font->ascent; + } } if (FIXNUMP (AREF (entity, FONT_SPACING_INDEX))) spacing = XFIXNUM (AREF (entity, FONT_SPACING_INDEX)); @@ -2769,6 +2786,9 @@ syms_of_ftfont (void) DEFSYM (Qsans, "sans"); DEFSYM (Qsans__serif, "sans serif"); + /* The boolean-valued font property key specifying the use of leading. */ + DEFSYM (QCminspace, ":minspace"); + staticpro (&freetype_font_cache); freetype_font_cache = list1 (Qt); commit 2f7e97ef482ddacd0ed21ccd25ca777beb60ab35 Author: Basil L. Contovounesios Date: Mon Mar 18 18:21:15 2019 +0000 Fix mail-header-separator font lock in message.el * lisp/gnus/message.el (message-font-lock-keywords): Dynamically font lock mail-header-separator, in case it changes. (bug#34898) diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el index 6da6140c5b..edfe1a39f3 100644 --- a/lisp/gnus/message.el +++ b/lisp/gnus/message.el @@ -1601,19 +1601,21 @@ starting with `not' and followed by regexps." (progn (goto-char (match-beginning 0)) (match-end 0)) nil (1 'message-header-name) (2 'message-header-other nil t))) - ,@(if (and mail-header-separator - (not (equal mail-header-separator ""))) - `((,(concat "^\\(" (regexp-quote mail-header-separator) "\\)$") - 1 'message-separator)) - nil) - ((lambda (limit) - (re-search-forward (concat "^\\(" - message-cite-prefix-regexp - "\\).*") - limit t)) - (0 'message-cited-text)) - ("<#/?\\(multipart\\|part\\|external\\|mml\\|secure\\)[^>]*>" - (0 'message-mml)))) + (,(lambda (limit) + (and mail-header-separator + (not (equal mail-header-separator "")) + (re-search-forward + (concat "^" (regexp-quote mail-header-separator) "$") + limit t))) + 0 'message-separator) + (,(lambda (limit) + (re-search-forward (concat "^\\(?:" + message-cite-prefix-regexp + "\\).*") + limit t)) + 0 'message-cited-text) + ("<#/?\\(?:multipart\\|part\\|external\\|mml\\|secure\\)[^>]*>" + 0 'message-mml))) "Additional expressions to highlight in Message mode.") (defvar message-face-alist commit 417c52b0b7fbf5cb02d229e81b7aaaacf2082bde Author: Kévin Le Gouguec Date: Sun May 12 18:55:01 2019 +0200 Extract common code for adding text properties * lisp/font-lock.el (font-lock--add-text-property): New function. (font-lock-prepend-text-property) (font-lock-append-text-property): Use it. (Bug#35476) diff --git a/lisp/font-lock.el b/lisp/font-lock.el index 95ca2f99c2..3991a4ee8e 100644 --- a/lisp/font-lock.el +++ b/lisp/font-lock.el @@ -1387,11 +1387,13 @@ delimit the region to fontify." ;; below and given a `font-lock-' prefix. Those that are not used are defined ;; in Lisp below and commented out. sm. -(defun font-lock-prepend-text-property (start end prop value &optional object) - "Prepend to one property of the text from START to END. -Arguments PROP and VALUE specify the property and value to prepend to the value -already in place. The resulting property values are always lists. -Optional argument OBJECT is the string or buffer containing the text." +(defun font-lock--add-text-property (start end prop value object append) + "Add an element to a property of the text from START to END. +Arguments PROP and VALUE specify the property and value to add to +the value already in place. The resulting property values are +always lists. Argument OBJECT is the string or buffer containing +the text. If argument APPEND is non-nil, VALUE will be appended, +otherwise it will be prepended." (let ((val (if (and (listp value) (not (keywordp (car value)))) ;; Already a list of faces. value @@ -1407,35 +1409,26 @@ Optional argument OBJECT is the string or buffer containing the text." (or (keywordp (car prev)) (memq (car prev) '(foreground-color background-color))) (setq prev (list prev))) - (put-text-property start next prop - (append val (if (listp prev) prev (list prev))) - object) + (let* ((list-prev (if (listp prev) prev (list prev))) + (new-value (if append + (append list-prev val) + (append val list-prev)))) + (put-text-property start next prop new-value object)) (setq start next)))) +(defun font-lock-prepend-text-property (start end prop value &optional object) + "Prepend to one property of the text from START to END. +Arguments PROP and VALUE specify the property and value to prepend to the value +already in place. The resulting property values are always lists. +Optional argument OBJECT is the string or buffer containing the text." + (font-lock--add-text-property start end prop value object nil)) + (defun font-lock-append-text-property (start end prop value &optional object) "Append to one property of the text from START to END. Arguments PROP and VALUE specify the property and value to append to the value already in place. The resulting property values are always lists. Optional argument OBJECT is the string or buffer containing the text." - (let ((val (if (and (listp value) (not (keywordp (car value)))) - ;; Already a list of faces. - value - ;; A single face (e.g. a plist of face properties). - (list value))) - next prev) - (while (/= start end) - (setq next (next-single-property-change start prop object end) - prev (get-text-property start prop object)) - ;; Canonicalize old forms of face property. - (and (memq prop '(face font-lock-face)) - (listp prev) - (or (keywordp (car prev)) - (memq (car prev) '(foreground-color background-color))) - (setq prev (list prev))) - (put-text-property start next prop - (append (if (listp prev) prev (list prev)) val) - object) - (setq start next)))) + (font-lock--add-text-property start end prop value object t)) (defun font-lock-fillin-text-property (start end prop value &optional object) "Fill in one property of the text from START to END. commit 59ad303e8f3bb174ce326c76a9e7649f602120db Author: Kévin Le Gouguec Date: Sun May 12 18:36:09 2019 +0200 Stop splicing anonymous faces in font-lock-append-text-property This is the same fix as 2019-04-29 "Refrain from splicing anonymous faces in text properties", which was only applied to font-lock-prepend-text-property. * lisp/font-lock.el (font-lock-append-text-property): Distinguish list of faces from property list. * test/lisp/font-lock-tests.el: New test suite. (Bug#35476) diff --git a/lisp/font-lock.el b/lisp/font-lock.el index 7ff4e606fa..95ca2f99c2 100644 --- a/lisp/font-lock.el +++ b/lisp/font-lock.el @@ -1417,7 +1417,12 @@ Optional argument OBJECT is the string or buffer containing the text." Arguments PROP and VALUE specify the property and value to append to the value already in place. The resulting property values are always lists. Optional argument OBJECT is the string or buffer containing the text." - (let ((val (if (listp value) value (list value))) next prev) + (let ((val (if (and (listp value) (not (keywordp (car value)))) + ;; Already a list of faces. + value + ;; A single face (e.g. a plist of face properties). + (list value))) + next prev) (while (/= start end) (setq next (next-single-property-change start prop object end) prev (get-text-property start prop object)) diff --git a/test/lisp/font-lock-tests.el b/test/lisp/font-lock-tests.el new file mode 100644 index 0000000000..5d127039ff --- /dev/null +++ b/test/lisp/font-lock-tests.el @@ -0,0 +1,41 @@ +;;; font-lock-tests.el --- Test suite for font-lock. -*- lexical-binding: t -*- + +;; Copyright (C) 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 . + +;;; Code: +(require 'ert) + +(ert-deftest font-lock-test-append-anonymous-face () + "Ensure `font-lock-append-text-property' does not splice anonymous faces." + (with-temp-buffer + (insert "foo") + (add-text-properties 1 3 '(face italic)) + (font-lock-append-text-property 1 3 'face '(:strike-through t)) + (should (equal (get-text-property 1 'face (current-buffer)) + '(italic (:strike-through t)))))) + +(ert-deftest font-lock-test-prepend-anonymous-face () + "Ensure `font-lock-prepend-text-property' does not splice anonymous faces." + (with-temp-buffer + (insert "foo") + (add-text-properties 1 3 '(face italic)) + (font-lock-prepend-text-property 1 3 'face '(:strike-through t)) + (should (equal (get-text-property 1 'face (current-buffer)) + '((:strike-through t) italic))))) + +;; font-lock-tests.el ends here commit 364d4e156d80bff711d000bdb2e0ac765726c953 Author: Basil L. Contovounesios Date: Mon May 7 16:42:41 2018 +0100 Do not hard-code message-mode keys in docstring * lisp/gnus/message.el (message-mode): Replace hard-coded bindings in docstring with summary of message-mode-map. (bug#31388) diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el index 1851337b43..6da6140c5b 100644 --- a/lisp/gnus/message.el +++ b/lisp/gnus/message.el @@ -2897,42 +2897,9 @@ See also `message-forbidden-properties'." ;;;###autoload (define-derived-mode message-mode text-mode "Message" "Major mode for editing mail and news to be sent. -Like Text Mode but with these additional commands:\\ -C-c C-s `message-send' (send the message) C-c C-c `message-send-and-exit' -C-c C-d Postpone sending the message C-c C-k Kill the message -C-c C-f move to a header field (and create it if there isn't): - C-c C-f C-t move to To C-c C-f C-s move to Subject - C-c C-f C-c move to Cc C-c C-f C-b move to Bcc - C-c C-f C-w move to Fcc C-c C-f C-r move to Reply-To - C-c C-f C-u move to Summary C-c C-f C-n move to Newsgroups - C-c C-f C-k move to Keywords C-c C-f C-d move to Distribution - C-c C-f C-o move to From (\"Originator\") - C-c C-f C-f move to Followup-To - C-c C-f C-m move to Mail-Followup-To - C-c C-f C-e move to Expires - C-c C-f C-i cycle through Importance values - C-c C-f s change subject and append \"(was: )\" - C-c C-f x crossposting with FollowUp-To header and note in body - C-c C-f t replace To: header with contents of Cc: or Bcc: - C-c C-f a Insert X-No-Archive: header and a note in the body -C-c C-t `message-insert-to' (add a To header to a news followup) -C-c C-l `message-to-list-only' (removes all but list address in to/cc) -C-c C-n `message-insert-newsgroups' (add a Newsgroup header to a news reply) -C-c C-b `message-goto-body' (move to beginning of message text). -C-c C-i `message-goto-signature' (move to the beginning of the signature). -C-c C-w `message-insert-signature' (insert `message-signature-file' file). -C-c C-y `message-yank-original' (insert current message, if any). -C-c C-q `message-fill-yanked-message' (fill what was yanked). -C-c C-e `message-elide-region' (elide the text between point and mark). -C-c C-v `message-delete-not-region' (remove the text outside the region). -C-c C-z `message-kill-to-signature' (kill the text up to the signature). -C-c C-r `message-caesar-buffer-body' (rot13 the message body). -C-c C-a `mml-attach-file' (attach a file as MIME). -C-c C-u `message-insert-or-toggle-importance' (insert or cycle importance). -C-c M-n `message-insert-disposition-notification-to' (request receipt). -C-c M-m `message-mark-inserted-region' (mark region with enclosing tags). -C-c M-f `message-mark-insert-file' (insert file marked with enclosing tags). -M-RET `message-newline-and-reformat' (break the line and reformat)." +Like `text-mode', but with these additional commands: + +\\{message-mode-map}" (set (make-local-variable 'message-reply-buffer) nil) (set (make-local-variable 'message-inserted-headers) nil) (set (make-local-variable 'message-send-actions) nil) commit f4c1d95bef2ee8077eef46a2e6c585c3fc8bc499 Author: Basil L. Contovounesios Date: Mon May 13 23:23:06 2019 +0100 Fix last change to message-signature :type * lisp/gnus/message.el (message-signature): List more specific :type alternatives before more general ones, as per "(elisp) Composite Types". diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el index b68b953464..1851337b43 100644 --- a/lisp/gnus/message.el +++ b/lisp/gnus/message.el @@ -1083,10 +1083,10 @@ If t, insert `message-signature-file'. If a function or form, insert its result. See `mail-signature' for the recommended format of a signature." :version "23.2" - :type '(choice string (const :tag "Contents of signature file" t) - function - sexp - (const :tag "None" nil)) + :type '(choice string + (const :tag "None" nil) + (const :tag "Contents of signature file" t) + function sexp) :risky t :link '(custom-manual "(message)Insertion Variables") :group 'message-insertion) commit 2ecb7c5c0bc7c74df0751bbd3824de4aec8ed467 Author: Robert Pluim Date: Mon May 13 16:45:16 2019 -0400 Document nil value of message-signature and mail-signature * lisp/gnus/message.el (message-signature): Allow nil as a customizable value, and describe its effect. * lisp/mail/sendmail.el (mail-signature): Describe effect of nil value (bug#32680). diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el index 442104af8a..b68b953464 100644 --- a/lisp/gnus/message.el +++ b/lisp/gnus/message.el @@ -1078,13 +1078,15 @@ point and mark around the citation text as modified." (defcustom message-signature mail-signature "String to be inserted at the end of the message buffer. -If t, the `message-signature-file' file will be inserted instead. -If a function, the result from the function will be used instead. -If a form, the result from the form will be used instead." +If nil, don't insert a signature. +If t, insert `message-signature-file'. +If a function or form, insert its result. +See `mail-signature' for the recommended format of a signature." :version "23.2" :type '(choice string (const :tag "Contents of signature file" t) function - sexp) + sexp + (const :tag "None" nil)) :risky t :link '(custom-manual "(message)Insertion Variables") :group 'message-insertion) diff --git a/lisp/mail/sendmail.el b/lisp/mail/sendmail.el index 93b6c90521..208ebb6801 100644 --- a/lisp/mail/sendmail.el +++ b/lisp/mail/sendmail.el @@ -370,6 +370,7 @@ By default, this is the file specified by `mail-personal-alias-file'." t) ;;;###autoload (defcustom mail-signature t "Text inserted at end of mail buffer when a message is initialized. +If nil, no signature is inserted. If t, it means to insert the contents of the file `mail-signature-file'. If a string, that string is inserted. (To make a proper signature, the string should begin with \\n\\n-- \\n, commit cd5b0538c5ba1b4bb243897de0e1dbea3fad0637 Author: Juri Linkov Date: Mon May 13 23:40:11 2019 +0300 * lisp/vc/log-view.el (log-view-diff-common): Use the previous revision only when the end of the region is on a line after the last entry. (Bug#35624) diff --git a/lisp/vc/log-view.el b/lisp/vc/log-view.el index e47fad8908..3389264ce6 100644 --- a/lisp/vc/log-view.el +++ b/lisp/vc/log-view.el @@ -618,10 +618,11 @@ considered file(s)." ;; When TO and FR are the same, or when point is on a line after ;; the last entry, look at the previous revision. (when (or (string-equal fr to) - (>= (point) + (>= end (save-excursion - (goto-char (car fr-entry)) - (forward-line)))) + (goto-char end) + (log-view-end-of-defun) + (point)))) (setq fr (vc-call-backend log-view-vc-backend 'previous-revision nil fr))) (vc-diff-internal t (list log-view-vc-backend commit f515bc6398141fea36b7a77453d5f114a59e55b3 Author: Alexandre Garreau Date: Mon May 13 16:34:06 2019 -0400 [PATCH 1/1] Adds variable 'eww-accept-content-types' * lisp/gnus/message.el (message-simplify-subject): Decouple simplification from "Re:" adding (bug#33200). (message-reply): Add the "Re:"'s here. (message-followup): And here. diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el index 2c2122d89a..442104af8a 100644 --- a/lisp/gnus/message.el +++ b/lisp/gnus/message.el @@ -2051,8 +2051,9 @@ see `message-narrow-to-headers-or-head'." (let ((regexp (if (stringp gnus-list-identifiers) gnus-list-identifiers (mapconcat 'identity gnus-list-identifiers " *\\|")))) - (if (string-match (concat "\\(\\(\\(Re: +\\)?\\(" regexp - " *\\)\\)+\\(Re: +\\)?\\)") subject) + (if (and (not (equal regexp "")) + (string-match (concat "\\(\\(\\(Re: +\\)?\\(" regexp + " *\\)\\)+\\(Re: +\\)?\\)") subject)) (concat (substring subject 0 (match-beginning 1)) (or (match-string 3 subject) (match-string 5 subject)) @@ -6948,21 +6949,12 @@ Useful functions to put in this list include: :type '(repeat function)) (defun message-simplify-subject (subject &optional functions) - "Return simplified SUBJECT." - (unless functions - ;; Simplify fully: - (setq functions message-simplify-subject-functions)) - (when (and (memq 'message-strip-list-identifiers functions) - gnus-list-identifiers) - (setq subject (message-strip-list-identifiers subject))) - (when (memq 'message-strip-subject-re functions) - (setq subject (concat "Re: " (message-strip-subject-re subject)))) - (when (and (memq 'message-strip-subject-trailing-was functions) - message-subject-trailing-was-query) - (setq subject (message-strip-subject-trailing-was subject))) - (when (memq 'message-strip-subject-encoded-words functions) - (setq subject (message-strip-subject-encoded-words subject))) - subject) + "Return simplified SUBJECT. +Do so by calling each one-argument function in the list of functions +specified by FUNCTIONS, if non-nil, or by the variable +`message-simplify-subject-functions' otherwise." + (dolist (fun (or functions message-simplify-subject-functions) subject) + (setq subject (funcall fun subject)))) ;;;###autoload (defun message-reply (&optional to-address wide switch-function) @@ -6995,7 +6987,7 @@ Useful functions to put in this list include: subject (or (message-fetch-field "subject") "none")) ;; Strip list identifiers, "Re: ", and "was:" - (setq subject (message-simplify-subject subject)) + (setq subject (concat "Re: " (message-simplify-subject subject))) (when (and (setq gnus-warning (message-fetch-field "gnus-warning")) (string-match "<[^>]+>" gnus-warning)) @@ -7066,7 +7058,7 @@ If TO-NEWSGROUPS, use that as the new Newsgroups line." (string-match "world" distribution))) (setq distribution nil)) ;; Strip list identifiers, "Re: ", and "was:" - (setq subject (message-simplify-subject subject)) + (setq subject (concat "Re: " (message-simplify-subject subject))) (widen)) (message-pop-to-buffer (message-buffer-name "followup" from newsgroups)) commit 86c8582c9e4497406522c3073e232e1af2eb23d1 Author: Lars Ingebrigtsen Date: Mon May 13 16:16:10 2019 -0400 Make mml respect the "recipient-filename" parameter * lisp/gnus/mml.el (mml-insert-mime-headers): Implement the already-documented "recipient-filename" parameter (bug#34654). diff --git a/lisp/gnus/mml.el b/lisp/gnus/mml.el index 7a99a0dc46..b0b4fd0a54 100644 --- a/lisp/gnus/mml.el +++ b/lisp/gnus/mml.el @@ -906,8 +906,14 @@ be \"related\" or \"alternate\"." (or disposition (mml-content-disposition type (cdr (assq 'filename cont))))) (when parameters - (mml-insert-parameter-string - cont mml-content-disposition-parameters)) + (let ((cont (copy-sequence cont))) + ;; Set the file name to what's specified by the user. + (when-let ((recipient-filename (cdr (assq 'recipient-filename cont)))) + (setcdr cont + (cons (cons 'filename recipient-filename) + (cdr cont)))) + (mml-insert-parameter-string + cont mml-content-disposition-parameters))) (insert "\n")) (unless (eq encoding '7bit) (insert (format "Content-Transfer-Encoding: %s\n" encoding))) commit 8fe73515ad08402d16de44b32dc93b98069e0498 Author: Lars Ingebrigtsen Date: Mon May 13 15:17:00 2019 -0400 Make eww understand #fragment URLs at point interactively * lisp/net/eww.el (eww-suggest-uris): Use thing-at-point-url-at-point instead of url-get-url-at-point (bug#31927) because it's much better at guessing what the URL actually is (especially with #fragments). diff --git a/lisp/net/eww.el b/lisp/net/eww.el index 63afe11f05..206f9cfdf3 100644 --- a/lisp/net/eww.el +++ b/lisp/net/eww.el @@ -29,7 +29,7 @@ (require 'shr) (require 'url) (require 'url-queue) -(require 'url-util) ; for url-get-url-at-point +(require 'thingatpt) (require 'mm-url) (require 'puny) (eval-when-compile (require 'subr-x)) ;; for string-trim @@ -64,17 +64,17 @@ ;;;###autoload (defcustom eww-suggest-uris '(eww-links-at-point - url-get-url-at-point + thing-at-point-url-at-point eww-current-url) "List of functions called to form the list of default URIs for `eww'. Each of the elements is a function returning either a string or a list of strings. The results will be joined into a single list with duplicate entries (if any) removed." - :version "25.1" + :version "27.1" :group 'eww :type 'hook :options '(eww-links-at-point - url-get-url-at-point + thing-at-point-url-at-point eww-current-url)) (defcustom eww-bookmarks-directory user-emacs-directory diff --git a/lisp/url/url-util.el b/lisp/url/url-util.el index 5b8350642f..a46e7bb385 100644 --- a/lisp/url/url-util.el +++ b/lisp/url/url-util.el @@ -543,6 +543,7 @@ This uses `url-current-object', set locally to the buffer." (defun url-get-url-at-point (&optional pt) "Get the URL closest to point, but don't change position. Has a preference for looking backward when not directly on a symbol." + (declare (obsolete thing-at-point-url-at-point "27.1")) ;; Not at all perfect - point must be right in the name. (save-excursion (if pt (goto-char pt)) commit 967711995ecedc0ed79602ad71af57f45d6a3720 Author: Paul Eggert Date: Mon May 13 12:43:13 2019 -0700 Fix broken build on m68k The GCC + valgrind fix caused the m68k build to fail (Bug#35711). Simplify string allocation a bit to make similar problems less likely in the future. * src/alloc.c (sdata, SDATA_NBYTES, SDATA_DATA) [GC_CHECK_STRING_BYTES]: Use the same implementation as with !GC_CHECK_STRING_BYTES, as the special case is no longer needed. (SDATA_ALIGN): New constant. (SDATA_SIZE): Remove this macro, replacing with ... (sdata_size): ... this new function. All uses changed. Properly account for sizes and alignments even in the m68k case, and even if GC_CHECK_STRING_BYTES is not defined. diff --git a/src/alloc.c b/src/alloc.c index 948a0e8a2d..af4adb3856 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -1447,9 +1447,7 @@ mark_interval_tree (INTERVAL i) #define LARGE_STRING_BYTES 1024 -/* The SDATA typedef is a struct or union describing string memory - sub-allocated from an sblock. This is where the contents of Lisp - strings are stored. */ +/* The layout of a nonnull string. */ struct sdata { @@ -1468,13 +1466,8 @@ struct sdata unsigned char data[FLEXIBLE_ARRAY_MEMBER]; }; -#ifdef GC_CHECK_STRING_BYTES - -typedef struct sdata sdata; -#define SDATA_NBYTES(S) (S)->nbytes -#define SDATA_DATA(S) (S)->data - -#else +/* A union describing string memory sub-allocated from an sblock. + This is where the contents of Lisp strings are stored. */ typedef union { @@ -1502,8 +1495,6 @@ typedef union #define SDATA_NBYTES(S) (S)->n.nbytes #define SDATA_DATA(S) ((struct sdata *) (S))->data -#endif /* not GC_CHECK_STRING_BYTES */ - enum { SDATA_DATA_OFFSET = offsetof (struct sdata, data) }; /* Structure describing a block of memory which is sub-allocated to @@ -1586,31 +1577,20 @@ static char const string_overrun_cookie[GC_STRING_OVERRUN_COOKIE_SIZE] = # define GC_STRING_OVERRUN_COOKIE_SIZE 0 #endif -/* Value is the size of an sdata structure large enough to hold NBYTES - bytes of string data. The value returned includes a terminating - NUL byte, the size of the sdata structure, and padding. */ - -#ifdef GC_CHECK_STRING_BYTES - -#define SDATA_SIZE(NBYTES) FLEXSIZEOF (struct sdata, data, (NBYTES) + 1) +/* Return the size of an sdata structure large enough to hold N bytes + of string data. This counts the sdata structure, the N bytes, a + terminating NUL byte, and alignment padding. */ -#else /* not GC_CHECK_STRING_BYTES */ - -/* The 'max' reserves space for the nbytes union member even when NBYTES + 1 is - less than the size of that member. The 'max' is not needed when - SDATA_DATA_OFFSET is a multiple of FLEXALIGNOF (struct sdata), - because then the alignment code reserves enough space. */ - -#define SDATA_SIZE(NBYTES) \ - ((SDATA_DATA_OFFSET \ - + (SDATA_DATA_OFFSET % FLEXALIGNOF (struct sdata) == 0 \ - ? NBYTES \ - : max (NBYTES, FLEXALIGNOF (struct sdata) - 1)) \ - + 1 \ - + FLEXALIGNOF (struct sdata) - 1) \ - & ~(FLEXALIGNOF (struct sdata) - 1)) - -#endif /* not GC_CHECK_STRING_BYTES */ +static ptrdiff_t +sdata_size (ptrdiff_t n) +{ + /* Reserve space for the nbytes union member even when N + 1 is less + than the size of that member. */ + ptrdiff_t unaligned_size = max (SDATA_DATA_OFFSET + n + 1, + sizeof (sdata)); + int sdata_align = max (FLEXALIGNOF (struct sdata), alignof (sdata)); + return (unaligned_size + sdata_align - 1) & ~(sdata_align - 1); +} /* Extra bytes to allocate for each string. */ #define GC_STRING_EXTRA GC_STRING_OVERRUN_COOKIE_SIZE @@ -1664,21 +1644,14 @@ string_bytes (struct Lisp_String *s) static void check_sblock (struct sblock *b) { - sdata *from, *end, *from_end; - - end = b->next_free; + sdata *end = b->next_free; - for (from = b->data; from < end; from = from_end) + for (sdata *from = b->data; from < end; ) { - /* Compute the next FROM here because copying below may - overwrite data we need to compute it. */ - ptrdiff_t nbytes; - - /* Check that the string size recorded in the string is the - same as the one recorded in the sdata structure. */ - nbytes = SDATA_SIZE (from->string ? string_bytes (from->string) - : SDATA_NBYTES (from)); - from_end = (sdata *) ((char *) from + nbytes + GC_STRING_EXTRA); + ptrdiff_t nbytes = sdata_size (from->string + ? string_bytes (from->string) + : SDATA_NBYTES (from)); + from = (sdata *) ((char *) from + nbytes + GC_STRING_EXTRA); } } @@ -1810,14 +1783,14 @@ allocate_string_data (struct Lisp_String *s, { sdata *data, *old_data; struct sblock *b; - ptrdiff_t needed, old_nbytes; + ptrdiff_t old_nbytes; if (STRING_BYTES_MAX < nbytes) string_overflow (); /* Determine the number of bytes needed to store NBYTES bytes of string data. */ - needed = SDATA_SIZE (nbytes); + ptrdiff_t needed = sdata_size (nbytes); if (s->u.s.data) { old_data = SDATA_OF_STRING (s); @@ -2068,7 +2041,7 @@ compact_small_strings (void) nbytes = s ? STRING_BYTES (s) : SDATA_NBYTES (from); eassert (nbytes <= LARGE_STRING_BYTES); - ptrdiff_t size = SDATA_SIZE (nbytes); + ptrdiff_t size = sdata_size (nbytes); sdata *from_end = (sdata *) ((char *) from + size + GC_STRING_EXTRA); commit 3de3452014e8c8dade2cd62aa6c6a701692aa3f9 Author: Lars Ingebrigtsen Date: Mon May 13 15:10:33 2019 -0400 Add a comment about the previous shr change diff --git a/lisp/net/shr.el b/lisp/net/shr.el index 4820d8b436..3ab5116597 100644 --- a/lisp/net/shr.el +++ b/lisp/net/shr.el @@ -1791,6 +1791,8 @@ The preference is a float determined from `shr-prefer-media-type'." (defun shr-mark-fill (start) ;; We may not have inserted any text to fill. (when (and (/= start (point)) + ;; Tables insert themselves with the correct indentation, + ;; so don't do anything if we're at the start of a table. (not (get-text-property start 'shr-table-id))) (put-text-property start (1+ start) 'shr-indentation shr-indentation))) commit 648a52ae69a1786774e2e94c69f43f7c1d6f24e0 Author: Lars Ingebrigtsen Date: Mon May 13 15:04:46 2019 -0400 Fix problems in shr when indenting tables * lisp/net/shr.el (shr-mark-fill, shr-insert-table): Fix problems when block-quoting/
  • -ing a table -- the indentation/prefix was inserted twice (bug#32277). diff --git a/lisp/net/shr.el b/lisp/net/shr.el index 2f628e1caa..4820d8b436 100644 --- a/lisp/net/shr.el +++ b/lisp/net/shr.el @@ -1790,7 +1790,8 @@ The preference is a float determined from `shr-prefer-media-type'." (defun shr-mark-fill (start) ;; We may not have inserted any text to fill. - (unless (= start (point)) + (when (and (/= start (point)) + (not (get-text-property start 'shr-table-id))) (put-text-property start (1+ start) 'shr-indentation shr-indentation))) @@ -2087,7 +2088,8 @@ flags that control whether to collect or render objects." (setq max (max max (nth 2 column)))) max))) (dotimes (_ (max height 1)) - (shr-indent) + (when (bolp) + (shr-indent)) (insert shr-table-vertical-line "\n")) (dolist (column row) (when (> (nth 2 column) -1) commit 81af228a63c6ca284ae9fc1647615842c03d7881 Author: Federico Tedin Date: Mon May 13 14:06:16 2019 -0400 Use a more specific Accepts header in eww * lisp/net/eww.el (eww-accept-content-types): New variable. (eww): Use it. (eww-reload): Use it. (bug#33002). Copyright-paperwork-exempt: yes diff --git a/lisp/net/eww.el b/lisp/net/eww.el index d9ac3e1ff5..63afe11f05 100644 --- a/lisp/net/eww.el +++ b/lisp/net/eww.el @@ -223,6 +223,10 @@ See also `eww-form-checkbox-selected-symbol'." (defvar eww-local-regex "localhost" "When this regex is found in the URL, it's not a keyword but an address.") +(defvar eww-accept-content-types + "text/html, text/plain, text/sgml, text/css, application/xhtml+xml, */*;q=0.01" + "Value used for the HTTP 'Accept' header.") + (defvar eww-link-keymap (let ((map (copy-keymap shr-map))) (define-key map "\r" 'eww-follow-link) @@ -290,8 +294,9 @@ the default EWW buffer." (let ((inhibit-read-only t)) (insert (format "Loading %s..." url)) (goto-char (point-min))) - (url-retrieve url 'eww-render - (list url nil (current-buffer)))) + (let ((url-mime-accept-string eww-accept-content-types)) + (url-retrieve url 'eww-render + (list url nil (current-buffer))))) (defun eww--dwim-expand-url (url) (setq url (string-trim url)) @@ -952,8 +957,9 @@ just re-display the HTML already fetched." (error "No current HTML data") (eww-display-html 'utf-8 url (plist-get eww-data :dom) (point) (current-buffer))) - (url-retrieve url 'eww-render - (list url (point) (current-buffer) encode))))) + (let ((url-mime-accept-string eww-accept-content-types)) + (url-retrieve url 'eww-render + (list url (point) (current-buffer) encode)))))) ;; Form support.