commit ef599f6cac04ddfe09bf1e63f57c4b9fd5f63ce5 (HEAD, refs/remotes/origin/master) Author: Lars Ingebrigtsen Date: Sun Apr 15 01:07:38 2018 +0200 Remove calls from string-to-multibyte in nnheader/nntp * lisp/gnus/nntp.el (nntp-copy-to-buffer): Apparently `insert' now behaves more like string-make-multibyte, but it now behaves more like string-to-multibyte, so remove that call here. I'm not quite sure I follow that logic, but apparently there are no ill effects. * lisp/gnus/nnheader.el (nnheader-insert-buffer-substring): Ditto. diff --git a/lisp/gnus/nnheader.el b/lisp/gnus/nnheader.el index 34b4137e93..b9ce20413f 100644 --- a/lisp/gnus/nnheader.el +++ b/lisp/gnus/nnheader.el @@ -1071,14 +1071,11 @@ See `find-file-noselect' for the arguments." (defmacro nnheader-insert-buffer-substring (buffer &optional start end) "Copy string from unibyte buffer to multibyte current buffer." - `(if enable-multibyte-characters - (insert (with-current-buffer ,buffer - (string-to-multibyte - ,(if (or start end) - `(buffer-substring (or ,start (point-min)) - (or ,end (point-max))) - '(buffer-string))))) - (insert-buffer-substring ,buffer ,start ,end))) + `(insert (with-current-buffer ,buffer + ,(if (or start end) + `(buffer-substring (or ,start (point-min)) + (or ,end (point-max))) + '(buffer-string))))) (defvar nnheader-last-message-time '(0 0)) (defun nnheader-message-maybe (&rest args) diff --git a/lisp/gnus/nntp.el b/lisp/gnus/nntp.el index 784240f4ff..be9e495510 100644 --- a/lisp/gnus/nntp.el +++ b/lisp/gnus/nntp.el @@ -342,9 +342,7 @@ retried once before actually displaying the error report." `(let ((string (buffer-substring ,start ,end))) (with-current-buffer ,buffer (erase-buffer) - (insert (if enable-multibyte-characters - (string-to-multibyte string) - string)) + (insert string) (goto-char (point-min)) nil))) commit 1ad6184c37a0e0f537688ea7d5e6ceca5f364eaa Author: Lars Ingebrigtsen Date: Sun Apr 15 00:57:40 2018 +0200 Remove a string-to-multibyte from nnmh.el * lisp/gnus/nnmh.el (nnmh-request-list-1): Remove superfluous string-to-multibyte. diff --git a/lisp/gnus/nnmh.el b/lisp/gnus/nnmh.el index ea07ad7519..33be64fb8d 100644 --- a/lisp/gnus/nnmh.el +++ b/lisp/gnus/nnmh.el @@ -241,12 +241,11 @@ as unread by Gnus.") (file-truename (file-name-as-directory (expand-file-name nnmh-toplev)))) dir) - (string-to-multibyte ;Why? Isn't it multibyte already? - (encode-coding-string - (nnheader-replace-chars-in-string - (substring dir (match-end 0)) - ?/ ?.) - nnmail-pathname-coding-system))) + (encode-coding-string + (nnheader-replace-chars-in-string + (substring dir (match-end 0)) + ?/ ?.) + nnmail-pathname-coding-system)) (or max 0) (or min 1)))))) t) commit 3250651e9cbb691db6dae04f2c13a139d81c6616 Author: Lars Ingebrigtsen Date: Sun Apr 15 00:48:27 2018 +0200 Remove call to string-to-multibyte from nndoc.el * lisp/gnus/nndoc.el (nndoc-oe-dbx-type-p): My testing shows that no matter whether we're in a unibyte or a multibyte buffer, doing the looking-at here without the string-to-multibyte, we'll get a match. We did not get a match with the call in and if we were in a unibyte buffer, but we presumably never are. diff --git a/lisp/gnus/nndoc.el b/lisp/gnus/nndoc.el index 2ed023f686..149406a9a2 100644 --- a/lisp/gnus/nndoc.el +++ b/lisp/gnus/nndoc.el @@ -765,7 +765,7 @@ from the document.") (looking-at "JMF")) (defun nndoc-oe-dbx-type-p () - (looking-at (string-to-multibyte "\317\255\022\376"))) + (looking-at "\317\255\022\376")) (defun nndoc-read-little-endian () (+ (prog1 (char-after) (forward-char 1)) commit 466693416d143f42c606c6aeb0c48a777fc1d637 Author: Lars Ingebrigtsen Date: Sun Apr 15 00:40:23 2018 +0200 Fix calculation in gnus-update-group-mark-positions * lisp/gnus/gnus-group.el (gnus-update-group-mark-positions): Rewrite a call to string-to-multibyte that didn't even work. After the rewrite it gives the correct result and should allow people to customise Gnus group process mark positions (but that's a pretty obscure feature). diff --git a/lisp/gnus/gnus-group.el b/lisp/gnus/gnus-group.el index e6081a41a5..b4f482b60a 100644 --- a/lisp/gnus/gnus-group.el +++ b/lisp/gnus/gnus-group.el @@ -1153,7 +1153,7 @@ The following commands are available: (goto-char (point-min)) (setq gnus-group-mark-positions (list (cons 'process (and (search-forward - (string-to-multibyte "\200") nil t) + (string gnus-process-mark) nil t) (- (point) (point-min) 1)))))))) (defun gnus-mouse-pick-group (e) commit f0ec607d531228ec7454fa2307ce8df67a92bda9 Author: Lars Ingebrigtsen Date: Sun Apr 15 00:32:10 2018 +0200 Removed outdated comment from nnweb.el * lisp/gnus/nnweb.el (nnweb-insert-html): Removed ten year old comment from Stefan about string-as-multibyte. diff --git a/lisp/gnus/nnweb.el b/lisp/gnus/nnweb.el index 3b63e71dcd..a64f10f98a 100644 --- a/lisp/gnus/nnweb.el +++ b/lisp/gnus/nnweb.el @@ -523,10 +523,6 @@ Valid types include `google', `dejanews', and `gmane'.") (defun nnweb-insert-html (parse) "Insert HTML based on a w3 parse tree." (if (stringp parse) - ;; We used to call nnheader-string-as-multibyte here, but it cannot - ;; be right, so I removed it. If a bug shows up because of this change, - ;; please do not blindly revert the change, but help me find the real - ;; cause of the bug instead. --Stef (insert parse) (insert "<" (symbol-name (car parse)) " ") (insert (mapconcat commit 9c5a9d4dd4e8dcdafe240b067f26681de4a0d4bf Author: Lars Ingebrigtsen Date: Sun Apr 15 00:30:14 2018 +0200 Rewrite Gnus calls to compat function mm-multibyte-p diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el index a5f1dfb103..33c5e2cedb 100644 --- a/lisp/gnus/message.el +++ b/lisp/gnus/message.el @@ -1351,7 +1351,8 @@ If nil, Message won't auto-save." :link '(custom-manual "(message)Various Message Variables") :type '(choice directory (const :tag "Don't auto-save" nil))) -(defcustom message-default-charset (and (not (mm-multibyte-p)) 'iso-8859-1) +(defcustom message-default-charset (and (not enable-multibyte-characters) + 'iso-8859-1) "Default charset used in non-MULE Emacsen. If nil, you might be asked to input the charset." :version "21.1" @@ -4294,7 +4295,7 @@ conformance." (point-max)))) (setq char (char-after))) (when (or (< char 128) - (and (mm-multibyte-p) + (and enable-multibyte-characters (memq (char-charset char) '(eight-bit-control eight-bit-graphic ;; Emacs 23, Bug#1770: @@ -4326,7 +4327,7 @@ conformance." (while (not (eobp)) (when (let ((char (char-after))) (or (< char 128) - (and (mm-multibyte-p) + (and enable-multibyte-characters ;; FIXME: Wrong for Emacs 23 (unicode) and for ;; things like undecodable utf-8 (in Emacs 21?). ;; Should at least use find-coding-systems-region. diff --git a/lisp/gnus/mm-bodies.el b/lisp/gnus/mm-bodies.el index faf887cbb9..e292dac16f 100644 --- a/lisp/gnus/mm-bodies.el +++ b/lisp/gnus/mm-bodies.el @@ -262,7 +262,7 @@ decoding. If it is nil, default to `mail-parse-charset'." (setq coding-system (mm-charset-to-coding-system mail-parse-charset))) (when (and charset coding-system - (mm-multibyte-p) + enable-multibyte-characters (or (not (eq coding-system 'ascii)) (setq coding-system mail-parse-charset))) (decode-coding-region (point-min) (point-max) coding-system)) @@ -289,7 +289,7 @@ decoding. If it is nil, default to `mail-parse-charset'." (setq coding-system (mm-charset-to-coding-system mail-parse-charset))) (when (and charset coding-system - (mm-multibyte-p) + enable-multibyte-characters (or (not (eq coding-system 'ascii)) (setq coding-system mail-parse-charset))) (decode-coding-string string coding-system))) diff --git a/lisp/gnus/mm-decode.el b/lisp/gnus/mm-decode.el index 18c5837dd5..3e6883b2a4 100644 --- a/lisp/gnus/mm-decode.el +++ b/lisp/gnus/mm-decode.el @@ -760,7 +760,7 @@ MIME-Version header before proceeding." (defun mm-copy-to-buffer () "Copy the contents of the current buffer to a fresh buffer." (let ((obuf (current-buffer)) - (mb (mm-multibyte-p)) + (mb enable-multibyte-characters) beg) (goto-char (point-min)) (search-forward-regexp "^\n" nil t) diff --git a/lisp/gnus/mm-util.el b/lisp/gnus/mm-util.el index 42c2f3ab15..25b156803a 100644 --- a/lisp/gnus/mm-util.el +++ b/lisp/gnus/mm-util.el @@ -559,7 +559,7 @@ nil means ASCII, a single-element list represents an appropriate MIME charset, and a longer list means no appropriate charset." (let (charsets) ;; The return possibilities of this function are a mess... - (or (and (mm-multibyte-p) + (or (and enable-multibyte-characters mm-use-find-coding-systems-region ;; Find the mime-charset of the most preferred coding ;; system that has one. @@ -628,7 +628,7 @@ charset, and a longer list means no appropriate charset." (defun mm-find-charset-region (b e) "Return a list of Emacs charsets in the region B to E." (cond - ((mm-multibyte-p) + (enable-multibyte-characters ;; Remove composition since the base charsets have been included. ;; Remove eight-bit-*, treat them as ascii. (let ((css (find-charset-region b e))) diff --git a/lisp/gnus/nnmail.el b/lisp/gnus/nnmail.el index d751f182e3..08db5ab5b6 100644 --- a/lisp/gnus/nnmail.el +++ b/lisp/gnus/nnmail.el @@ -1249,7 +1249,7 @@ Return the number of characters in the body." (progn (forward-line 1) (point)))) (insert (format "Xref: %s" (system-name))) (while group-alist - (insert (if (mm-multibyte-p) + (insert (if enable-multibyte-characters (format " %s:%d" (caar group-alist) (cdar group-alist)) (encode-coding-string (format " %s:%d" (caar group-alist) (cdar group-alist)) commit ad2c4d3c6166b6a02e6256f3aff171fbf5a2c80b Author: Lars Ingebrigtsen Date: Sun Apr 15 00:24:02 2018 +0200 Rewrite string-as-unibyte/string-as-multibyte logic in nnmail * lisp/gnus/nnmail.el (nnmail-insert-xref): Rewrite string-as-unibyte/string-as-multibyte logic and confirm that the result is the same in both multibyte and unibyte buffers after the change. diff --git a/lisp/gnus/nnmail.el b/lisp/gnus/nnmail.el index 249bd65a9d..d751f182e3 100644 --- a/lisp/gnus/nnmail.el +++ b/lisp/gnus/nnmail.el @@ -1250,10 +1250,10 @@ Return the number of characters in the body." (insert (format "Xref: %s" (system-name))) (while group-alist (insert (if (mm-multibyte-p) - (string-as-multibyte - (format " %s:%d" (caar group-alist) (cdar group-alist))) - (string-as-unibyte - (format " %s:%d" (caar group-alist) (cdar group-alist))))) + (format " %s:%d" (caar group-alist) (cdar group-alist)) + (encode-coding-string + (format " %s:%d" (caar group-alist) (cdar group-alist)) + 'utf-8))) (setq group-alist (cdr group-alist))) (insert "\n"))) commit 25487b921b9a24eeed0c1a4e9bcc5043845f0f20 Author: Lars Ingebrigtsen Date: Sun Apr 15 00:17:28 2018 +0200 Remove call to string-as-unibyte from nnmail * lisp/gnus/nnmail.el (nnmail-parse-active): Remove call to string-as-unibyte; the alist before and after the change are `equal' to each other, so it should presumably have no impact. diff --git a/lisp/gnus/nnmail.el b/lisp/gnus/nnmail.el index aa909cc979..249bd65a9d 100644 --- a/lisp/gnus/nnmail.el +++ b/lisp/gnus/nnmail.el @@ -666,7 +666,7 @@ nn*-request-list should have been called before calling this function." (setq group (symbol-name group))) (if (and (numberp (setq max (read buffer))) (numberp (setq min (read buffer)))) - (push (list (string-as-unibyte group) (cons min max)) + (push (list group (cons min max)) group-assoc))) (error nil)) (widen) commit 86bbde2808f0f555805cd4a6007acac547c0d4df Author: Lars Ingebrigtsen Date: Sun Apr 15 00:14:30 2018 +0200 Remove calls to string-as-unibyte from nnir.el * lisp/gnus/nnir.el (nnir-get-active): Remove two calls to string-as-unibyte from code that seems cargo-culted from Gnus functions where it is not needed, so it's presumably not needed here, either. diff --git a/lisp/gnus/nnir.el b/lisp/gnus/nnir.el index 7d75603ca0..7e5f56e4dd 100644 --- a/lisp/gnus/nnir.el +++ b/lisp/gnus/nnir.el @@ -1772,31 +1772,29 @@ article came from is also searched." (if (eq (car method) 'nntp) (while (not (eobp)) (ignore-errors - (push (string-as-unibyte - (gnus-group-full-name - (buffer-substring - (point) - (progn - (skip-chars-forward "^ \t") - (point))) - method)) + (push (gnus-group-full-name + (buffer-substring + (point) + (progn + (skip-chars-forward "^ \t") + (point))) + method) groups)) (forward-line)) (while (not (eobp)) (ignore-errors - (push (string-as-unibyte - (if (eq (char-after) ?\") - (gnus-group-full-name (read cur) method) - (let ((p (point)) (name "")) - (skip-chars-forward "^ \t\\\\") - (setq name (buffer-substring p (point))) - (while (eq (char-after) ?\\) - (setq p (1+ (point))) - (forward-char 2) - (skip-chars-forward "^ \t\\\\") - (setq name (concat name (buffer-substring - p (point))))) - (gnus-group-full-name name method)))) + (push (if (eq (char-after) ?\") + (gnus-group-full-name (read cur) method) + (let ((p (point)) (name "")) + (skip-chars-forward "^ \t\\\\") + (setq name (buffer-substring p (point))) + (while (eq (char-after) ?\\) + (setq p (1+ (point))) + (forward-char 2) + (skip-chars-forward "^ \t\\\\") + (setq name (concat name (buffer-substring + p (point))))) + (gnus-group-full-name name method))) groups)) (forward-line))))) groups)) commit 30f5fa75da7719a22281402ec697aa40c8ce4ed1 Author: Lars Ingebrigtsen Date: Sun Apr 15 00:09:47 2018 +0200 Remove call to string-as-unibyte in gnus-start.el * lisp/gnus/gnus-start.el (gnus-read-newsrc-el-file): Remove string-as-unibyte call, which appears not to do anything much in modern Emacsen. diff --git a/lisp/gnus/gnus-start.el b/lisp/gnus/gnus-start.el index cce201e1f1..623055e1f6 100644 --- a/lisp/gnus/gnus-start.el +++ b/lisp/gnus/gnus-start.el @@ -2450,10 +2450,6 @@ If FORCE is non-nil, the .newsrc file is read." (setq gnus-format-specs gnus-default-format-specs))) (when gnus-newsrc-assoc (setq gnus-newsrc-alist gnus-newsrc-assoc)))) - (dolist (elem gnus-newsrc-alist) - ;; Protect against broken .newsrc.el files. - (when (car elem) - (setcar elem (string-as-unibyte (car elem))))) (gnus-make-hashtable-from-newsrc-alist) (when (file-newer-than-file-p file ding-file) ;; Old format quick file commit 07672a06d3d486c66eddaf88dbdd2a3c01c72839 Author: Lars Ingebrigtsen Date: Sun Apr 15 00:07:08 2018 +0200 Remove call to string-as-unibyte from gnus-start.el * lisp/gnus/gnus-start.el (gnus-update-active-hashtb-from-killed): Remove a string-as-unibyte call here, which appears not to be necessary: I'm able to complete over non-ASCII names both before and after. diff --git a/lisp/gnus/gnus-start.el b/lisp/gnus/gnus-start.el index eb19ff36f6..cce201e1f1 100644 --- a/lisp/gnus/gnus-start.el +++ b/lisp/gnus/gnus-start.el @@ -1992,7 +1992,7 @@ backend check whether the group actually exists." (let ((hashtb (setq gnus-active-hashtb (gnus-make-hashtable 4096)))) (dolist (list (list gnus-killed-list gnus-zombie-list)) (dolist (group list) - (gnus-sethash (string-as-unibyte group) nil hashtb))))) + (gnus-sethash group nil hashtb))))) (defun gnus-get-killed-groups () "Go through the active hashtb and mark all unknown groups as killed." commit 6500684001d4d926ca1267eecf0803bb50ae680b Author: Lars Ingebrigtsen Date: Sat Apr 14 23:58:59 2018 +0200 Modernise a Gnus function a bit * lisp/gnus/gnus-start.el (gnus-update-active-hashtb-from-killed): Modernise code a bit. diff --git a/lisp/gnus/gnus-start.el b/lisp/gnus/gnus-start.el index a20a6e727d..eb19ff36f6 100644 --- a/lisp/gnus/gnus-start.el +++ b/lisp/gnus/gnus-start.el @@ -1989,15 +1989,10 @@ backend check whether the group actually exists." ;; Enter all dead groups into the hashtb. (defun gnus-update-active-hashtb-from-killed () - (let ((hashtb (setq gnus-active-hashtb (gnus-make-hashtable 4096))) - (lists (list gnus-killed-list gnus-zombie-list)) - killed) - (while lists - (setq killed (car lists)) - (while killed - (gnus-sethash (string-as-unibyte (car killed)) nil hashtb) - (setq killed (cdr killed))) - (setq lists (cdr lists))))) + (let ((hashtb (setq gnus-active-hashtb (gnus-make-hashtable 4096)))) + (dolist (list (list gnus-killed-list gnus-zombie-list)) + (dolist (group list) + (gnus-sethash (string-as-unibyte group) nil hashtb))))) (defun gnus-get-killed-groups () "Go through the active hashtb and mark all unknown groups as killed." commit 4b0c425047b61b306e7775bae11bd0edd78a7c96 Author: Lars Ingebrigtsen Date: Sat Apr 14 23:54:07 2018 +0200 Remove two string-as-unibyte in gnus-srvr.el * lisp/gnus/gnus-srvr.el (gnus-browse-foreign-server): We do not seem to need the string-as-unibyte here: We read a multibyte string from the *nntpd* buffer and then decode it later, and this apparently by some strange magic leads to the correct results in my test cases. diff --git a/lisp/gnus/gnus-srvr.el b/lisp/gnus/gnus-srvr.el index 94fd21b920..dfca5e9d2c 100644 --- a/lisp/gnus/gnus-srvr.el +++ b/lisp/gnus/gnus-srvr.el @@ -808,12 +808,11 @@ claim them." (while (not (eobp)) (ignore-errors (push (cons - (string-as-unibyte - (buffer-substring - (point) - (progn - (skip-chars-forward "^ \t") - (point)))) + (buffer-substring + (point) + (progn + (skip-chars-forward "^ \t") + (point))) (let ((last (read cur))) (cons (read cur) last))) groups)) @@ -821,19 +820,18 @@ claim them." (while (not (eobp)) (ignore-errors (push (cons - (string-as-unibyte - (if (eq (char-after) ?\") - (read cur) - (let ((p (point)) (name "")) - (skip-chars-forward "^ \t\\\\") - (setq name (buffer-substring p (point))) - (while (eq (char-after) ?\\) - (setq p (1+ (point))) - (forward-char 2) - (skip-chars-forward "^ \t\\\\") - (setq name (concat name (buffer-substring - p (point))))) - name))) + (if (eq (char-after) ?\") + (read cur) + (let ((p (point)) (name "")) + (skip-chars-forward "^ \t\\\\") + (setq name (buffer-substring p (point))) + (while (eq (char-after) ?\\) + (setq p (1+ (point))) + (forward-char 2) + (skip-chars-forward "^ \t\\\\") + (setq name (concat name (buffer-substring + p (point))))) + name)) (let ((last (read cur))) (cons (read cur) last))) groups)) commit 679a433744ca550a079ff47e1964ff558965b51a Author: Lars Ingebrigtsen Date: Sat Apr 14 23:25:01 2018 +0200 Fix a `string-to-multibyte' in Gnus * lisp/gnus/gnus-art.el (gnus-request-article-this-buffer): The original article buffer is multibyte, and we're inserting into the article buffer, which is also multibyte, so the `string-to-multibyte' here should be unnecessary? diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el index c153d94f3c..0b349ea2d2 100644 --- a/lisp/gnus/gnus-art.el +++ b/lisp/gnus/gnus-art.el @@ -7037,9 +7037,8 @@ If given a prefix, show the hidden text instead." ;; equivalent of string-make-multibyte which amount to decoding ;; with locale-coding-system, causing failure of ;; subsequent decoding. - (insert (string-to-multibyte - (with-current-buffer gnus-original-article-buffer - (buffer-substring (point-min) (point-max))))) + (insert (with-current-buffer gnus-original-article-buffer + (buffer-substring (point-min) (point-max)))) 'article) ;; Check the backlog. ((and gnus-keep-backlog commit 9f767b3ec83a89706bceb5e0a9c778092a7dfe5d Author: Lars Ingebrigtsen Date: Sat Apr 14 23:17:24 2018 +0200 Fix a string-as-unibyte in Gnus * lisp/gnus/gnus-art.el (gnus-article-browse-html-parts): Get rid of a string-as-unibyte. diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el index ed6e77fb32..c153d94f3c 100644 --- a/lisp/gnus/gnus-art.el +++ b/lisp/gnus/gnus-art.el @@ -2921,7 +2921,8 @@ message header will be added to the bodies of the \"text/html\" parts." (encode-coding-string title coding)) body content)) - (setq eheader (string-as-unibyte (buffer-string)) + (setq eheader (encode-coding-string + (buffer-string) 'utf-8) body content))) (erase-buffer) (mm-disable-multibyte) commit 196dc887d8ba324df01d594d5eda61591e251ff0 Author: Lars Ingebrigtsen Date: Sat Apr 14 22:38:53 2018 +0200 Further shr line folding/link continuation tweaks * lisp/net/shr.el (shr-fill-line): Tweak the link continuations further when folding lines. diff --git a/lisp/net/shr.el b/lisp/net/shr.el index d12ee68493..5eb35b74dd 100644 --- a/lisp/net/shr.el +++ b/lisp/net/shr.el @@ -734,18 +734,25 @@ size, and full-buffer size." (skip-chars-forward " ") (search-forward " " (line-end-position) 'move))) ;; Success; continue. - (let ((props (copy-sequence (text-properties-at (point)))) - (gap-start (point))) - (when (= (preceding-char) ?\s) - (delete-char -1)) - ;; We don't want to use the faces on the indentation, because - ;; that's ugly, but we want all the other properties to be - ;; continuous so that links do not split up into many links - ;; (which makes navigation awkward). - (setq props (plist-put props 'face nil)) + (when (= (preceding-char) ?\s) + (delete-char -1)) + (let ((gap-start (point))) (insert "\n") (shr-indent) - (add-text-properties gap-start (point) props)) + (when (and (> (1- gap-start) (point-min)) + ;; The link on both sides of the newline are the + ;; same... + (equal (get-text-property (point) 'shr-url) + (get-text-property (1- gap-start) 'shr-url))) + ;; ... so we join the two bits into one link logically, but + ;; not visually. This makes navigation between links work + ;; well, but avoids underscores before the link on the next + ;; line when indented. + (let ((props (copy-sequence (text-properties-at (point))))) + ;; We don't want to use the faces on the indentation, because + ;; that's ugly. + (setq props (plist-put props 'face nil)) + (add-text-properties gap-start (point) props)))) (setq start (point)) (shr-vertical-motion shr-internal-width) (when (looking-at " $") commit 56c4ce266d395a5940576bea3e69b636fb549b1e Author: Lars Ingebrigtsen Date: Sat Apr 14 21:55:39 2018 +0200 Indent after transforming for loop into do/while diff --git a/src/lread.c b/src/lread.c index 8019443c09..5fe4d26fd9 100644 --- a/src/lread.c +++ b/src/lread.c @@ -1587,192 +1587,191 @@ openp (Lisp_Object path, Lisp_Object str, Lisp_Object suffixes, absolute = complete_filename_p (str); - do - { - ptrdiff_t baselen, prefixlen; - - if (NILP (path)) - filename = str; - else - filename = Fexpand_file_name (str, XCAR (path)); - if (!complete_filename_p (filename)) - /* If there are non-absolute elts in PATH (eg "."). */ - /* Of course, this could conceivably lose if luser sets - default-directory to be something non-absolute... */ - { - filename = Fexpand_file_name (filename, BVAR (current_buffer, directory)); - if (!complete_filename_p (filename)) - /* Give up on this path element! */ - continue; - } + do { + ptrdiff_t baselen, prefixlen; + + if (NILP (path)) + filename = str; + else + filename = Fexpand_file_name (str, XCAR (path)); + if (!complete_filename_p (filename)) + /* If there are non-absolute elts in PATH (eg "."). */ + /* Of course, this could conceivably lose if luser sets + default-directory to be something non-absolute... */ + { + filename = Fexpand_file_name (filename, BVAR (current_buffer, directory)); + if (!complete_filename_p (filename)) + /* Give up on this path element! */ + continue; + } - /* Calculate maximum length of any filename made from - this path element/specified file name and any possible suffix. */ - want_length = max_suffix_len + SBYTES (filename); - if (fn_size <= want_length) - { - fn_size = 100 + want_length; - fn = SAFE_ALLOCA (fn_size); - } + /* Calculate maximum length of any filename made from + this path element/specified file name and any possible suffix. */ + want_length = max_suffix_len + SBYTES (filename); + if (fn_size <= want_length) + { + fn_size = 100 + want_length; + fn = SAFE_ALLOCA (fn_size); + } - /* Copy FILENAME's data to FN but remove starting /: if any. */ - prefixlen = ((SCHARS (filename) > 2 - && SREF (filename, 0) == '/' - && SREF (filename, 1) == ':') - ? 2 : 0); - baselen = SBYTES (filename) - prefixlen; - memcpy (fn, SDATA (filename) + prefixlen, baselen); - - /* Loop over suffixes. */ - for (tail = NILP (suffixes) ? list1 (empty_unibyte_string) : suffixes; - CONSP (tail); tail = XCDR (tail)) - { - Lisp_Object suffix = XCAR (tail); - ptrdiff_t fnlen, lsuffix = SBYTES (suffix); - Lisp_Object handler; - - /* Make complete filename by appending SUFFIX. */ - memcpy (fn + baselen, SDATA (suffix), lsuffix + 1); - fnlen = baselen + lsuffix; - - /* Check that the file exists and is not a directory. */ - /* We used to only check for handlers on non-absolute file names: - if (absolute) - handler = Qnil; - else - handler = Ffind_file_name_handler (filename, Qfile_exists_p); - It's not clear why that was the case and it breaks things like - (load "/bar.el") where the file is actually "/bar.el.gz". */ - /* make_string has its own ideas on when to return a unibyte - string and when a multibyte string, but we know better. - We must have a unibyte string when dumping, since - file-name encoding is shaky at best at that time, and in - particular default-file-name-coding-system is reset - several times during loadup. We therefore don't want to - encode the file before passing it to file I/O library - functions. */ - if (!STRING_MULTIBYTE (filename) && !STRING_MULTIBYTE (suffix)) - string = make_unibyte_string (fn, fnlen); - else - string = make_string (fn, fnlen); - handler = Ffind_file_name_handler (string, Qfile_exists_p); - if ((!NILP (handler) || (!NILP (predicate) && !EQ (predicate, Qt))) - && !NATNUMP (predicate)) - { - bool exists; - if (NILP (predicate) || EQ (predicate, Qt)) - exists = !NILP (Ffile_readable_p (string)); - else - { - Lisp_Object tmp = call1 (predicate, string); - if (NILP (tmp)) + /* Copy FILENAME's data to FN but remove starting /: if any. */ + prefixlen = ((SCHARS (filename) > 2 + && SREF (filename, 0) == '/' + && SREF (filename, 1) == ':') + ? 2 : 0); + baselen = SBYTES (filename) - prefixlen; + memcpy (fn, SDATA (filename) + prefixlen, baselen); + + /* Loop over suffixes. */ + for (tail = NILP (suffixes) ? list1 (empty_unibyte_string) : suffixes; + CONSP (tail); tail = XCDR (tail)) + { + Lisp_Object suffix = XCAR (tail); + ptrdiff_t fnlen, lsuffix = SBYTES (suffix); + Lisp_Object handler; + + /* Make complete filename by appending SUFFIX. */ + memcpy (fn + baselen, SDATA (suffix), lsuffix + 1); + fnlen = baselen + lsuffix; + + /* Check that the file exists and is not a directory. */ + /* We used to only check for handlers on non-absolute file names: + if (absolute) + handler = Qnil; + else + handler = Ffind_file_name_handler (filename, Qfile_exists_p); + It's not clear why that was the case and it breaks things like + (load "/bar.el") where the file is actually "/bar.el.gz". */ + /* make_string has its own ideas on when to return a unibyte + string and when a multibyte string, but we know better. + We must have a unibyte string when dumping, since + file-name encoding is shaky at best at that time, and in + particular default-file-name-coding-system is reset + several times during loadup. We therefore don't want to + encode the file before passing it to file I/O library + functions. */ + if (!STRING_MULTIBYTE (filename) && !STRING_MULTIBYTE (suffix)) + string = make_unibyte_string (fn, fnlen); + else + string = make_string (fn, fnlen); + handler = Ffind_file_name_handler (string, Qfile_exists_p); + if ((!NILP (handler) || (!NILP (predicate) && !EQ (predicate, Qt))) + && !NATNUMP (predicate)) + { + bool exists; + if (NILP (predicate) || EQ (predicate, Qt)) + exists = !NILP (Ffile_readable_p (string)); + else + { + Lisp_Object tmp = call1 (predicate, string); + if (NILP (tmp)) + exists = false; + else if (EQ (tmp, Qdir_ok) + || NILP (Ffile_directory_p (string))) + exists = true; + else + { exists = false; - else if (EQ (tmp, Qdir_ok) - || NILP (Ffile_directory_p (string))) - exists = true; - else - { - exists = false; - last_errno = EISDIR; - } - } + last_errno = EISDIR; + } + } - if (exists) - { - /* We succeeded; return this descriptor and filename. */ - if (storeptr) - *storeptr = string; - SAFE_FREE (); - return -2; - } - } - else - { - int fd; - const char *pfn; - struct stat st; + if (exists) + { + /* We succeeded; return this descriptor and filename. */ + if (storeptr) + *storeptr = string; + SAFE_FREE (); + return -2; + } + } + else + { + int fd; + const char *pfn; + struct stat st; - encoded_fn = ENCODE_FILE (string); - pfn = SSDATA (encoded_fn); + encoded_fn = ENCODE_FILE (string); + pfn = SSDATA (encoded_fn); - /* Check that we can access or open it. */ - if (NATNUMP (predicate)) - { - fd = -1; - if (INT_MAX < XFASTINT (predicate)) - last_errno = EINVAL; - else if (faccessat (AT_FDCWD, pfn, XFASTINT (predicate), - AT_EACCESS) - == 0) - { - if (file_directory_p (encoded_fn)) - last_errno = EISDIR; - else - fd = 1; - } - } - else - { - fd = emacs_open (pfn, O_RDONLY, 0); - if (fd < 0) - { - if (errno != ENOENT) - last_errno = errno; - } - else - { - int err = (fstat (fd, &st) != 0 ? errno - : S_ISDIR (st.st_mode) ? EISDIR : 0); - if (err) - { - last_errno = err; - emacs_close (fd); - fd = -1; - } - } - } + /* Check that we can access or open it. */ + if (NATNUMP (predicate)) + { + fd = -1; + if (INT_MAX < XFASTINT (predicate)) + last_errno = EINVAL; + else if (faccessat (AT_FDCWD, pfn, XFASTINT (predicate), + AT_EACCESS) + == 0) + { + if (file_directory_p (encoded_fn)) + last_errno = EISDIR; + else + fd = 1; + } + } + else + { + fd = emacs_open (pfn, O_RDONLY, 0); + if (fd < 0) + { + if (errno != ENOENT) + last_errno = errno; + } + else + { + int err = (fstat (fd, &st) != 0 ? errno + : S_ISDIR (st.st_mode) ? EISDIR : 0); + if (err) + { + last_errno = err; + emacs_close (fd); + fd = -1; + } + } + } - if (fd >= 0) - { - if (newer && !NATNUMP (predicate)) - { - struct timespec mtime = get_stat_mtime (&st); + if (fd >= 0) + { + if (newer && !NATNUMP (predicate)) + { + struct timespec mtime = get_stat_mtime (&st); - if (timespec_cmp (mtime, save_mtime) <= 0) - emacs_close (fd); - else - { - if (0 <= save_fd) - emacs_close (save_fd); - save_fd = fd; - save_mtime = mtime; - save_string = string; - } - } - else - { - /* We succeeded; return this descriptor and filename. */ - if (storeptr) - *storeptr = string; - SAFE_FREE (); - return fd; - } - } + if (timespec_cmp (mtime, save_mtime) <= 0) + emacs_close (fd); + else + { + if (0 <= save_fd) + emacs_close (save_fd); + save_fd = fd; + save_mtime = mtime; + save_string = string; + } + } + else + { + /* We succeeded; return this descriptor and filename. */ + if (storeptr) + *storeptr = string; + SAFE_FREE (); + return fd; + } + } - /* No more suffixes. Return the newest. */ - if (0 <= save_fd && ! CONSP (XCDR (tail))) - { - if (storeptr) - *storeptr = save_string; - SAFE_FREE (); - return save_fd; - } - } - } - if (absolute) - break; - path = XCDR (path); - } while (CONSP (path)); + /* No more suffixes. Return the newest. */ + if (0 <= save_fd && ! CONSP (XCDR (tail))) + { + if (storeptr) + *storeptr = save_string; + SAFE_FREE (); + return save_fd; + } + } + } + if (absolute) + break; + path = XCDR (path); + } while (CONSP (path)); SAFE_FREE (); errno = last_errno; commit f939cd025539791ad9af34b43af029a4f3d04f5f Author: Lars Ingebrigtsen Date: Sat Apr 14 21:55:08 2018 +0200 Make call-process work if exec-path is nil * src/lread.c (openp): If exec-path is nil, no files would be found to execute (bug#30564). Test cases: (let ((exec-path ())) (call-process "/bin/ls" nil (current-buffer))) This would previously fail, but now works. (let ((exec-path '("/bin/"))) (call-process "ls" nil (current-buffer))) This worked, and still works. diff --git a/src/lread.c b/src/lread.c index 8fb61f5633..8019443c09 100644 --- a/src/lread.c +++ b/src/lread.c @@ -1587,11 +1587,14 @@ openp (Lisp_Object path, Lisp_Object str, Lisp_Object suffixes, absolute = complete_filename_p (str); - for (; CONSP (path); path = XCDR (path)) + do { ptrdiff_t baselen, prefixlen; - filename = Fexpand_file_name (str, XCAR (path)); + if (NILP (path)) + filename = str; + else + filename = Fexpand_file_name (str, XCAR (path)); if (!complete_filename_p (filename)) /* If there are non-absolute elts in PATH (eg "."). */ /* Of course, this could conceivably lose if luser sets @@ -1768,7 +1771,8 @@ openp (Lisp_Object path, Lisp_Object str, Lisp_Object suffixes, } if (absolute) break; - } + path = XCDR (path); + } while (CONSP (path)); SAFE_FREE (); errno = last_errno; commit 94b9fe59986c368ac2bb1024d3487dea73658788 Author: Lars Ingebrigtsen Date: Sat Apr 14 21:18:51 2018 +0200 Make erc-current-logfile work with explicit parameter * lisp/erc/erc-log.el (erc-current-logfile): This function apparently refers to buffer-local variables, so switch to the buffer given before calculating the file name (bug#16111). diff --git a/lisp/erc/erc-log.el b/lisp/erc/erc-log.el index 1dd2e0aba4..584f566f04 100644 --- a/lisp/erc/erc-log.el +++ b/lisp/erc/erc-log.el @@ -344,18 +344,19 @@ If BUFFER is nil, the value of `current-buffer' is used. This is determined by `erc-generate-log-file-name-function'. The result is converted to lowercase, as IRC is case-insensitive" (unless buffer (setq buffer (current-buffer))) - (let ((target (or (buffer-name buffer) (erc-default-target))) - (nick (erc-current-nick)) - (server erc-session-server) - (port erc-session-port)) - (expand-file-name - (erc-log-standardize-name - (funcall erc-generate-log-file-name-function - buffer target nick server port)) - (if (functionp erc-log-channels-directory) - (funcall erc-log-channels-directory - buffer target nick server port) - erc-log-channels-directory)))) + (with-current-buffer buffer + (let ((target (or (buffer-name buffer) (erc-default-target))) + (nick (erc-current-nick)) + (server erc-session-server) + (port erc-session-port)) + (expand-file-name + (erc-log-standardize-name + (funcall erc-generate-log-file-name-function + buffer target nick server port)) + (if (functionp erc-log-channels-directory) + (funcall erc-log-channels-directory + buffer target nick server port) + erc-log-channels-directory))))) (defun erc-generate-log-file-name-with-date (buffer &rest ignore) "This function computes a short log file name. commit 7e012d038422605e44afbc916769e51f6682dbce Author: Lars Ingebrigtsen Date: Sat Apr 14 21:11:05 2018 +0200 Tweak shr link text property adjustments when folding * lisp/net/shr.el (shr-fill-line): If a link starts at the first word on a new folded line, then don't copy the link properties to the newline inserted. diff --git a/lisp/net/shr.el b/lisp/net/shr.el index fb17b856f4..d12ee68493 100644 --- a/lisp/net/shr.el +++ b/lisp/net/shr.el @@ -734,10 +734,10 @@ size, and full-buffer size." (skip-chars-forward " ") (search-forward " " (line-end-position) 'move))) ;; Success; continue. - (when (= (preceding-char) ?\s) - (delete-char -1)) (let ((props (copy-sequence (text-properties-at (point)))) (gap-start (point))) + (when (= (preceding-char) ?\s) + (delete-char -1)) ;; We don't want to use the faces on the indentation, because ;; that's ugly, but we want all the other properties to be ;; continuous so that links do not split up into many links commit 064ff7328160ebd893ae8578812bb41f469a5e48 Author: Lars Ingebrigtsen Date: Sat Apr 14 20:56:16 2018 +0200 * lisp/erc/erc-button.el (erc-button-search-url): Doc fix. diff --git a/lisp/erc/erc-button.el b/lisp/erc/erc-button.el index 8e1be30f35..749ae5db5a 100644 --- a/lisp/erc/erc-button.el +++ b/lisp/erc/erc-button.el @@ -122,7 +122,7 @@ longer than `erc-fill-column'." :type 'string) (defcustom erc-button-search-url "http://duckduckgo.com/?q=%s" - "URL used to browse Google search references. + "URL used to search for a term. %s is replaced by the search string." :version "27.1" :group 'erc-button commit 7912fdcc4d57e784acc6b2ae2fb545554afcfbb9 Author: Lars Ingebrigtsen Date: Sat Apr 14 20:54:24 2018 +0200 erc build fix for the previous patch diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index f1e21c9a96..8c4da32e83 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -75,6 +75,7 @@ (require 'thingatpt) (require 'auth-source) (require 'erc-compat) +(require 'subr-x) (defvar erc-official-location "https://www.emacswiki.org/emacs/ERC (mailing list: erc-discuss@gnu.org)" commit 994a369cd27c65988b9ab5df47549d002acfa3ad Author: Lars Ingebrigtsen Date: Sat Apr 14 20:52:36 2018 +0200 erc-truncate-buffer-on-save doc string clarification * lisp/erc/erc-log.el (erc-truncate-buffer-on-save): Doc clarification (bug#18207) since "truncate" is a word used by erc-truncate to mean something else. diff --git a/lisp/erc/erc-log.el b/lisp/erc/erc-log.el index 3294350b6e..1dd2e0aba4 100644 --- a/lisp/erc/erc-log.el +++ b/lisp/erc/erc-log.el @@ -122,7 +122,7 @@ custom function which returns the directory part and set (function :tag "Other function"))) (defcustom erc-truncate-buffer-on-save nil - "Truncate any ERC (channel, query, server) buffer when it is saved." + "Erase the contents of any ERC (channel, query, server) buffer when it is saved." :group 'erc-log :type 'boolean) commit 2f5d47b1df0248a6fd14b65889e564859cf305c8 Author: Lars Ingebrigtsen Date: Sat Apr 14 20:37:09 2018 +0200 Ignore all-whitespace topics in erc * lisp/erc/erc.el (erc-cmd-TOPIC): Ignore all-whitespace topics (bug#25153). diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 63228516be..f1e21c9a96 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -3693,8 +3693,10 @@ be displayed." ((string-match "^\\s-*\\([&#+!]\\S-+\\)\\s-\\(.*\\)$" topic) (let ((ch (match-string 1 topic)) (topic (match-string 2 topic))) - (erc-log (format "cmd: TOPIC [%s]: %s" ch topic)) - (erc-server-send (format "TOPIC %s :%s" ch topic) nil ch)) + ;; Ignore all-whitespace topics. + (unless (equal (string-trim topic) "") + (erc-log (format "cmd: TOPIC [%s]: %s" ch topic)) + (erc-server-send (format "TOPIC %s :%s" ch topic) nil ch))) t) ;; /topic #channel ((string-match "^\\s-*\\([&#+!]\\S-+\\)" topic) commit 5b535761f616f01277111cfbb9c635e7a417afad Author: Lars Ingebrigtsen Date: Sat Apr 14 20:32:05 2018 +0200 Rename url-button-google-url * lisp/erc/erc-button.el (erc-button-search-url): Renamed from url-button-google-url (bug#25717). Suggested by Andrew Robbins. (erc-button-alist): Use it. diff --git a/etc/NEWS b/etc/NEWS index 0bf5ba80b3..0c4daee9ac 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -210,6 +210,12 @@ concept index in the Gnus manual for the `match-list' entry. +++ *** nil is no longer an allowed value for `mm-text-html-renderer'. +** erc + +--- +*** `erc-button-google-url' has been renamed `erc-button-search-url' +and its value has been changed to Duck Duck Go. + ** eww/shr *** When opening external links in eww/shr (typically with the diff --git a/lisp/erc/erc-button.el b/lisp/erc/erc-button.el index 8269e5c163..8e1be30f35 100644 --- a/lisp/erc/erc-button.el +++ b/lisp/erc/erc-button.el @@ -121,12 +121,16 @@ longer than `erc-fill-column'." :group 'erc-button :type 'string) -(defcustom erc-button-google-url "http://www.google.com/search?q=%s" +(defcustom erc-button-search-url "http://duckduckgo.com/?q=%s" "URL used to browse Google search references. %s is replaced by the search string." + :version "27.1" :group 'erc-button :type 'string) +(define-obsolete-variable-alias 'erc-button-google-url + 'erc-button-search-url "27.1") + (defcustom erc-button-alist ;; Since the callback is only executed when the user is clicking on ;; a button, it makes no sense to optimize performance by @@ -148,7 +152,7 @@ longer than `erc-fill-column'." ("Lisp:\\([a-zA-Z.+-]+\\)" 0 t erc-browse-emacswiki-lisp 1) ("\\bGoogle:\\([^ \t\n\r\f]+\\)" 0 t (lambda (keywords) - (browse-url (format erc-button-google-url keywords))) + (browse-url (format erc-button-search-url keywords))) 1) ("\\brfc[#: ]?\\([0-9]+\\)" 0 t (lambda (num) commit cdefc045893a7fed57856ac385ab41c71f61c09f Author: John Goerzen Date: Sat Apr 14 20:10:53 2018 +0200 Subject: Fix problem with erc buffer renames after reconnect * lisp/erc/erc.el (erc-generate-new-buffer-name): Solve problem with renamed buffers on different servers after reconnect (bug#30639). Copyright-paperwork-exempt: yes diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 550800c57f..63228516be 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -1608,18 +1608,18 @@ symbol, it may have these values: (dolist (candidate (list buf-name (concat buf-name "/" server))) (if (and (not buffer-name) erc-reuse-buffers - (get-buffer candidate) - (or target + (or (not (get-buffer candidate)) + (or target + (with-current-buffer (get-buffer candidate) + (and (erc-server-buffer-p) + (not (erc-server-process-alive))))) (with-current-buffer (get-buffer candidate) - (and (erc-server-buffer-p) - (not (erc-server-process-alive))))) - (with-current-buffer (get-buffer candidate) - (and (string= erc-session-server server) - (erc-port-equal erc-session-port port)))) + (and (string= erc-session-server server) + (erc-port-equal erc-session-port port))))) (setq buffer-name candidate))) ;; if buffer-name is unset, neither candidate worked out for us, ;; fallback to the old uniquification method: - (or buffer-name (generate-new-buffer-name buf-name)) )) + (or buffer-name (generate-new-buffer-name (concat buf-name "/" server))))) (defun erc-get-buffer-create (server port target) "Create a new buffer based on the arguments." commit 369cb30d8cc9b2c1eee8ed21cca89e0277f8d61d Author: Lars Ingebrigtsen Date: Sat Apr 14 19:06:51 2018 +0200 (libxml-parse-html-region): Make DISCARD-COMMENTS obsolete * lisp/subr.el (libxml-parse-xml-region) (libxml-parse-html-region): Make DISCARD-COMMENTS obsolete. * src/xml.c (Flibxml_parse_html_region) (Flibxml_parse_xml_region): Don't mention DISCARD-COMMENTS, since it's now no longer part of the advertised signature (bug#27178). diff --git a/lisp/subr.el b/lisp/subr.el index 98724e9413..9cf7d596cd 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -1456,6 +1456,8 @@ be a list of the form returned by `event-start' and `event-end'." (set-advertised-calling-convention 'unintern '(name obarray) "23.3") (set-advertised-calling-convention 'indirect-function '(object) "25.1") (set-advertised-calling-convention 'redirect-frame-focus '(frame focus-frame) "24.3") +(set-advertised-calling-convention 'libxml-parse-xml-region '(start end base-url) "27.1") +(set-advertised-calling-convention 'libxml-parse-html-region '(start end base-url) "27.1") ;;;; Obsolescence declarations for variables, and aliases. diff --git a/src/xml.c b/src/xml.c index fa88040597..3674e320ef 100644 --- a/src/xml.c +++ b/src/xml.c @@ -272,11 +272,8 @@ DEFUN ("libxml-parse-html-region", Flibxml_parse_html_region, doc: /* Parse the region as an HTML document and return the parse tree. If BASE-URL is non-nil, it is used to expand relative URLs. -If DISCARD-COMMENTS is non-nil, the top-level HTML comment is discarded. - -This parameter is obsolete as of 27.1, and you should use the -`xml-remove-comments' function to strip comments before calling -this function if you don't want comments. */) +If you want comments to be stripped, use the `xml-remove-comments' +function to strip comments before calling this function. */) (Lisp_Object start, Lisp_Object end, Lisp_Object base_url, Lisp_Object discard_comments) { if (init_libxml2_functions ()) @@ -290,11 +287,8 @@ DEFUN ("libxml-parse-xml-region", Flibxml_parse_xml_region, doc: /* Parse the region as an XML document and return the parse tree. If BASE-URL is non-nil, it is used to expand relative URLs. -If DISCARD-COMMENTS is non-nil, the top-level XML comment is discarded. - -This parameter is obsolete as of 27.1, and you should use the -`xml-remove-comments' function to strip comments before calling -this function if you don't want comments. */) +If you want comments to be stripped, use the `xml-remove-comments' +function to strip comments before calling this function. */) (Lisp_Object start, Lisp_Object end, Lisp_Object base_url, Lisp_Object discard_comments) { if (init_libxml2_functions ()) commit 0b0d3815da99f575b74e82234bfb963d89362152 Author: Lars Ingebrigtsen Date: Sat Apr 14 17:18:53 2018 +0200 Revert "Revert "Give better errors in signing failures in Gnus"" This reverts commit 42141da5b0885b199636524c1e57f08ee1723aea. This patch was reverted in error. I misinterpreted an email saying that it didn't work, but apparently it worked as it should. diff --git a/lisp/gnus/mml1991.el b/lisp/gnus/mml1991.el index 93b1b5049a..b2056b2fd0 100644 --- a/lisp/gnus/mml1991.el +++ b/lisp/gnus/mml1991.el @@ -275,6 +275,8 @@ Whether the passphrase is cached at all is controlled by (mm-decode-content-transfer-encoding cte))) (let* ((pair (mml-secure-epg-sign 'OpenPGP 'clear)) (signature (car pair))) + (unless (stringp signature) + (error "Signature failed")) (delete-region (point-min) (point-max)) (insert (with-temp-buffer diff --git a/lisp/gnus/mml2015.el b/lisp/gnus/mml2015.el index 5980ddb38f..403b5e1af6 100644 --- a/lisp/gnus/mml2015.el +++ b/lisp/gnus/mml2015.el @@ -958,6 +958,8 @@ If set, it overrides the setting of `mml2015-sign-with-sender'." (let* ((pair (mml-secure-epg-sign 'OpenPGP t)) (signature (car pair)) (micalg (cdr pair))) + (unless (stringp signature) + (error "Signature failed")) (goto-char (point-min)) (insert (format "Content-Type: multipart/signed; boundary=\"%s\";\n" boundary)) commit e20d7381ee85611f9e1d1e6bef4fe2d7e2ae7780 Author: Lars Ingebrigtsen Date: Sat Apr 14 17:14:01 2018 +0200 Make DISCARD-COMMENTS in `libxml-parse-{html,xml}-region' obsolete * doc/lispref/text.texi (Parsing HTML/XML): Mention that discard-comments is obsolete. * lisp/xml.el (xml-remove-comments): New function (bug#27178). * src/xml.c (Flibxml_parse_html_region): Clarify what DISCARD-COMMENTS actually does, and say that the parameter is obsolete. (Flibxml_parse_xml_region): Ditto. diff --git a/doc/lispref/text.texi b/doc/lispref/text.texi index 9769043b72..e89bd0b7ef 100644 --- a/doc/lispref/text.texi +++ b/doc/lispref/text.texi @@ -4724,7 +4724,10 @@ The optional argument @var{base-url}, if non-@code{nil}, should be a string specifying the base URL for relative URLs occurring in links. If the optional argument @var{discard-comments} is non-@code{nil}, -then the parse tree is created without any comments. +any top-level comment is discarded. (This argument is obsolete and +will be removed in future Emacs versions. To remove comments, use the +@code{xml-remove-comments} utility function on the data before you +call the parsing function.) In the parse tree, each HTML node is represented by a list in which the first element is a symbol representing the node name, the second diff --git a/etc/NEWS b/etc/NEWS index 980a5b453a..0bf5ba80b3 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -115,6 +115,14 @@ detect built-in libxml support, instead of testing for that indirectly, e.g., by checking that functions like 'libxml-parse-html-region' return nil. ++++ +** `libxml-parse-xml-region' and `libxml-parse-html' region take +a parameter that's called DISCARD-COMMENTS, but it really only +discards the top-level comment. Therefore this parameter is now +obsolete, and the new utility function `xml-remove-comments' can be +used to remove comments before calling the libxml functions to parse +the data. + +++ ** New function 'fill-polish-nobreak-p', to be used in 'fill-nobreak-predicate'. It blocks line breaking after a one-letter word, also in the case when diff --git a/lisp/xml.el b/lisp/xml.el index 3bc8c08cb7..6ce944ccb8 100644 --- a/lisp/xml.el +++ b/lisp/xml.el @@ -1073,6 +1073,19 @@ The first line is indented with INDENT-STRING." (insert ?\n indent-string)) (insert ?< ?/ (symbol-name (xml-node-name xml)) ?>)))) +;;;###autoload +(defun xml-remove-comments (beg end) + "Remove XML/HTML comments in the region between BEG and END. +All text between the markers will be removed." + (save-excursion + (save-restriction + (narrow-to-region beg end) + (goto-char beg) + (while (search-forward "" nil t) + (delete-region start (point)))))))) + (provide 'xml) ;;; xml.el ends here diff --git a/src/xml.c b/src/xml.c index 42059d7713..fa88040597 100644 --- a/src/xml.c +++ b/src/xml.c @@ -271,7 +271,12 @@ DEFUN ("libxml-parse-html-region", Flibxml_parse_html_region, 2, 4, 0, doc: /* Parse the region as an HTML document and return the parse tree. If BASE-URL is non-nil, it is used to expand relative URLs. -If DISCARD-COMMENTS is non-nil, all HTML comments are discarded. */) + +If DISCARD-COMMENTS is non-nil, the top-level HTML comment is discarded. + +This parameter is obsolete as of 27.1, and you should use the +`xml-remove-comments' function to strip comments before calling +this function if you don't want comments. */) (Lisp_Object start, Lisp_Object end, Lisp_Object base_url, Lisp_Object discard_comments) { if (init_libxml2_functions ()) @@ -284,7 +289,12 @@ DEFUN ("libxml-parse-xml-region", Flibxml_parse_xml_region, 2, 4, 0, doc: /* Parse the region as an XML document and return the parse tree. If BASE-URL is non-nil, it is used to expand relative URLs. -If DISCARD-COMMENTS is non-nil, all HTML comments are discarded. */) + +If DISCARD-COMMENTS is non-nil, the top-level XML comment is discarded. + +This parameter is obsolete as of 27.1, and you should use the +`xml-remove-comments' function to strip comments before calling +this function if you don't want comments. */) (Lisp_Object start, Lisp_Object end, Lisp_Object base_url, Lisp_Object discard_comments) { if (init_libxml2_functions ()) commit db71b3182778b66fad3865825777b06cc20b89a8 Merge: 132b3a9ace 5a6bb01777 Author: Glenn Morris Date: Sat Apr 14 07:50:45 2018 -0700 Merge from origin/emacs-26 5a6bb01 (origin/emacs-26) Fix building etc/DOC in the MSDOS port 274c979 * lisp/select.el (gui-get-selection): Doc fix. ad731b0 ; * doc/lispref/display.texi (Temporary Displays): Fix typos. f1450e9 Complete documentation of syntax flags by adding `c' 6bdcaec Fix typos and minor wording issues in ELisp manual febac27 Merge branch 'emacs-26' of git.savannah.gnu.org:/srv/git/emac... 6c2e21e Avoid segfault in processes of type 'pipe' 60e10c5 Remove repetitions in documentation strings 208e752 * lisp/image.el (image-load-path): Doc fix. 92e0fd8 ; * etc/NEWS: Remove a FIXME. (Bug#31122) Conflicts: etc/NEWS commit 132b3a9ace018a120e1b30fc94c8c98904509884 Author: Lars Ingebrigtsen Date: Sat Apr 14 15:52:16 2018 +0200 Change the default From style to `angles' and make obsolete * lisp/gnus/message.el (message-from-style): Make `angles' the default (bug#29309) and mark as obsolete. * lisp/mail/sendmail.el (mail-from-style): Ditto. diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el index f7c3ec04ff..a5f1dfb103 100644 --- a/lisp/gnus/message.el +++ b/lisp/gnus/message.el @@ -156,7 +156,7 @@ If this variable is nil, no such courtesy message will be added." :group 'message-interface :type 'regexp) -(defcustom message-from-style mail-from-style +(defcustom message-from-style 'angles "Specifies how \"From\" headers look. If nil, they contain just the return address like: @@ -168,12 +168,16 @@ If `angles', they look like: Otherwise, most addresses look like `angles', but they look like `parens' if `angles' would need quoting and `parens' would not." - :version "23.2" + :version "27.1" :type '(choice (const :tag "simple" nil) (const parens) (const angles) (const default)) :group 'message-headers) +(make-obsolete-variable + 'message-from-style + "Only the `angles' value is valid according to RFC2822" "27.1") + (defcustom message-insert-canlock t "Whether to insert a Cancel-Lock header in news postings." diff --git a/lisp/mail/sendmail.el b/lisp/mail/sendmail.el index 212a6c74ba..cfbefd91d9 100644 --- a/lisp/mail/sendmail.el +++ b/lisp/mail/sendmail.el @@ -55,7 +55,7 @@ :type 'file) ;;;###autoload -(defcustom mail-from-style 'default +(defcustom mail-from-style 'angles "Specifies how \"From:\" fields look. If nil, they contain just the return address like: @@ -72,8 +72,11 @@ Otherwise, most addresses look like `angles', but they look like (const parens) (const angles) (const default)) - :version "20.3" + :version "27.1" :group 'sendmail) +(make-obsolete-variable + 'mail-from-style + "Only the `angles' value is valid according to RFC2822" "27.1") ;;;###autoload (defcustom mail-specify-envelope-from nil commit c768fe1be0d68c182d037891e0946983e5fbe644 Author: Lars Ingebrigtsen Date: Sat Apr 14 15:36:53 2018 +0200 Make image-mode respect `imagemagick-types-inhibit' * lisp/image-mode.el (image--imagemagick-wanted-p): New function (bug#29584). (image-toggle-display-image): Use it to see whether we want to use imagemagick. diff --git a/etc/NEWS b/etc/NEWS index d29a513c70..980a5b453a 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -551,6 +551,13 @@ such decisions (if they are to be made at all) are left to higher-level functions. +** image-mode + +*** image-mode started using ImageMagick by default for all images +some years back. It now respects `imagemagick-types-inhibit' as a way +to disable that. + + +++ ** The new function 'read-answer' accepts either long or short answers depending on the new customizable variable 'read-answer-short'. diff --git a/lisp/image-mode.el b/lisp/image-mode.el index 70d2ca87cc..320f21a62d 100644 --- a/lisp/image-mode.el +++ b/lisp/image-mode.el @@ -758,7 +758,7 @@ was inserted." (edges (and (null image-transform-resize) (window-inside-pixel-edges (get-buffer-window (current-buffer))))) - (type (if (fboundp 'imagemagick-types) + (type (if (image--imagemagick-wanted-p filename) 'imagemagick (image-type file-or-data nil data-p))) (image (if (not edges) @@ -803,6 +803,12 @@ was inserted." (if (called-interactively-p 'any) (message "Repeat this command to go back to displaying the file as text")))) +(defun image--imagemagick-wanted-p (filename) + (and (fboundp 'imagemagick-types) + (not (eq imagemagick-types-inhibit t)) + (not (memq (intern (upcase (file-name-extension filename)) obarray) + imagemagick-types-inhibit)))) + (defun image-toggle-hex-display () "Toggle between image and hex display." (interactive) commit 42141da5b0885b199636524c1e57f08ee1723aea Author: Lars Ingebrigtsen Date: Sat Apr 14 15:12:48 2018 +0200 Revert "Give better errors in signing failures in Gnus" This reverts commit ef2059e877d104bfe5abd24df05bb09c7295e4fa. Apparently this test triggered both when signing was successful and unsuccessful (bug#26298). diff --git a/lisp/gnus/mml1991.el b/lisp/gnus/mml1991.el index b2056b2fd0..93b1b5049a 100644 --- a/lisp/gnus/mml1991.el +++ b/lisp/gnus/mml1991.el @@ -275,8 +275,6 @@ Whether the passphrase is cached at all is controlled by (mm-decode-content-transfer-encoding cte))) (let* ((pair (mml-secure-epg-sign 'OpenPGP 'clear)) (signature (car pair))) - (unless (stringp signature) - (error "Signature failed")) (delete-region (point-min) (point-max)) (insert (with-temp-buffer diff --git a/lisp/gnus/mml2015.el b/lisp/gnus/mml2015.el index 403b5e1af6..5980ddb38f 100644 --- a/lisp/gnus/mml2015.el +++ b/lisp/gnus/mml2015.el @@ -958,8 +958,6 @@ If set, it overrides the setting of `mml2015-sign-with-sender'." (let* ((pair (mml-secure-epg-sign 'OpenPGP t)) (signature (car pair)) (micalg (cdr pair))) - (unless (stringp signature) - (error "Signature failed")) (goto-char (point-min)) (insert (format "Content-Type: multipart/signed; boundary=\"%s\";\n" boundary)) commit 5a6bb01777e40a87ac59162d9833a13c81b7f292 (refs/remotes/origin/emacs-26) Author: Eli Zaretskii Date: Sat Apr 14 15:52:40 2018 +0300 Fix building etc/DOC in the MSDOS port * msdos/sed1v2.inp (lisp.mk): Fix escaping in Sed commands. diff --git a/msdos/sed1v2.inp b/msdos/sed1v2.inp index 8b68cb7507..8505656a66 100644 --- a/msdos/sed1v2.inp +++ b/msdos/sed1v2.inp @@ -165,8 +165,8 @@ s/ *@LIBXPM@// /^lisp\.mk:/,/^$/c\ lisp.mk: $(lispsource)/loadup.el\ @rm -f $@\ - ${AM_V_GEN}printf 'shortlisp = \\n' > $@\ - ${AM_V_GEN}sed -n 's/^[ \t]*(load "\([^"]*\)".*/\1/p' $< | sed -e "s/$/.elc \/" -e "s/\.el\.elc/.el/" >> $@\ + ${AM_V_GEN}printf 'shortlisp = \\\\\\n' > $@\ + ${AM_V_GEN}sed -n 's/^[ \t]*(load "\\([^"]*\\)".*/\\1/p' $< | sed -e "s/\$\$/.elc \\\\/" -e "s/\\.el\\.elc/.el/" >> $@\ ${AM_V_GEN}djecho "" >> $@ #" commit 0a299bd9a0165576afdc7a2ff80de2f7604d49c9 Author: Lars Ingebrigtsen Date: Sat Apr 14 14:50:14 2018 +0200 Tweak mailcap precedence so that Emacs values are heeded better * lisp/net/mailcap.el (mailcap-parse-mailcaps): Place entries from system-wide mailcap files after the values that are distributed with Emacs, and the ones from ~/.mailcap before. (mailcap-parse-mailcap): Take an optional `after' parameter to achieve that. (mailcap-add-mailcap-entry): Ditto. diff --git a/lisp/net/mailcap.el b/lisp/net/mailcap.el index 414ba0fd85..a8ade01e81 100644 --- a/lisp/net/mailcap.el +++ b/lisp/net/mailcap.el @@ -427,20 +427,32 @@ MAILCAPS if set; otherwise (on Unix) use the path from RFC 1524, plus ((memq system-type mailcap-poor-system-types) (setq path '("~/.mailcap" "~/mail.cap" "~/etc/mail.cap"))) (t (setq path - ;; This is per RFC 1524, specifically - ;; with /usr before /usr/local. - '("~/.mailcap" "/etc/mailcap" "/usr/etc/mailcap" - "/usr/local/etc/mailcap")))) - (dolist (fname (reverse - (if (stringp path) - (split-string path path-separator t) - path))) - (when (and (file-readable-p fname) (file-regular-p fname)) - (mailcap-parse-mailcap fname))) + ;; This is per RFC 1524, specifically with /usr before + ;; /usr/local. + '("~/.mailcap" + ("/etc/mailcap" 'after) + ("/usr/etc/mailcap" 'after) + ("/usr/local/etc/mailcap" 'after))))) + ;; We read the entries from ~/.mailcap before the built-in values, + ;; but place the rest of then afterwards as fallback values. + (dolist (spec (reverse + (if (stringp path) + (split-string path path-separator t) + path))) + (let ((afterp (and (consp spec) + (cadr spec))) + (file-name (if (stringp spec) + spec + (car spec)))) + (when (and (file-readable-p file-name) + (file-regular-p file-name)) + (mailcap-parse-mailcap file-name afterp)))) (setq mailcap-parsed-p t))) -(defun mailcap-parse-mailcap (fname) - "Parse out the mailcap file specified by FNAME." +(defun mailcap-parse-mailcap (fname &optional after) + "Parse out the mailcap file specified by FNAME. +If AFTER, place the entries from the file after the ones that are +already there." (let (major ; The major mime type (image/audio/etc) minor ; The minor mime type (gif, basic, etc) save-pos ; Misc saved positions used in parsing @@ -510,7 +522,7 @@ MAILCAPS if set; otherwise (on Unix) use the path from RFC 1524, plus "*" minor)))) (mailcap-parse-mailcap-extras save-pos (point)))) (mailcap-mailcap-entry-passes-test info) - (mailcap-add-mailcap-entry major minor info)) + (mailcap-add-mailcap-entry major minor info after)) (beginning-of-line))))) (defun mailcap-parse-mailcap-extras (st nd) @@ -693,7 +705,7 @@ to supply to the test." (push (list otest result) mailcap-viewer-test-cache) result)))) -(defun mailcap-add-mailcap-entry (major minor info) +(defun mailcap-add-mailcap-entry (major minor info &optional after) (let ((old-major (assoc major mailcap-mime-data))) (if (null old-major) ; New major area (push (cons major (list (cons minor info))) mailcap-mime-data) @@ -701,15 +713,23 @@ to supply to the test." (cond ((or (null cur-minor) ; New minor area, or (assq 'test info)) ; Has a test, insert at beginning - (setcdr old-major (cons (cons minor info) (cdr old-major)))) + (setcdr old-major + (if after ; Or after, if specified. + (nconc (cdr old-major) + (list (cons minor info))) + (cons (cons minor info) (cdr old-major))))) ((and (not (assq 'test info)) ; No test info, replace completely (not (assq 'test cur-minor)) (equal (assq 'viewer info) ; Keep alternative viewer (assq 'viewer cur-minor))) - (setcdr cur-minor info)) + (unless after + (setcdr cur-minor info))) (t - (setcdr old-major (cons (cons minor info) (cdr old-major)))))) - ))) + (setcdr old-major + (if after + (nconc (cdr old-major) (list (cons minor info))) + (setcdr old-major + (cons (cons minor info) (cdr old-major))))))))))) (defun mailcap-add (type viewer &optional test) "Add VIEWER as a handler for TYPE. commit e1c2ec50862024f1db1f37d895ae119877fe30ce Author: Tino Calancha Date: Sat Apr 14 12:56:22 2018 +0200 Subject: Fix circular dependency for mm-decode * lisp/gnus/mm-decode.el: Do not require shr.el at the top of the file; `mm-shr' already requires shr.el in its body, and this function is the only `mm-convert-shr-links' caller (Bug#31151). diff --git a/lisp/gnus/mm-decode.el b/lisp/gnus/mm-decode.el index 69fc770ec7..18c5837dd5 100644 --- a/lisp/gnus/mm-decode.el +++ b/lisp/gnus/mm-decode.el @@ -25,7 +25,6 @@ (require 'mail-parse) (require 'mm-bodies) -(require 'shr) (eval-when-compile (require 'cl-lib)) (autoload 'gnus-map-function "gnus-util") @@ -1842,6 +1841,8 @@ text/html;\\s-*charset=\\([^\t\n\r \"'>]+\\)[^>]*>" nil t) (let ((inhibit-read-only t)) (delete-region min max)))))))) +(defvar shr-image-map) +(defvar shr-map) (autoload 'widget-convert-button "wid-edit") (defvar widget-keymap) commit 274c9796499a6619bd351351d2c26a1ae09a3eb7 Author: Eli Zaretskii Date: Sat Apr 14 10:53:34 2018 +0300 * lisp/select.el (gui-get-selection): Doc fix. diff --git a/lisp/select.el b/lisp/select.el index d5c9d7cbbb..698be83754 100644 --- a/lisp/select.el +++ b/lisp/select.el @@ -291,8 +291,10 @@ all upper-case names. The most often used ones, in addition to `PRIMARY', are `SECONDARY' and `CLIPBOARD'. DATA-TYPE is usually `STRING', but can also be one of the symbols -in `selection-converter-alist', which see. This argument is -ignored on NS, MS-Windows and MS-DOS." +in `selection-converter-alist', which see. Window systems other +than X usually support only a small subset of these symbols, in +addition to `STRING'; MS-Windows supports `TARGETS', which reports +the formats available in the clipboard if TYPE is `CLIPBOARD'." (let ((data (gui-backend-get-selection (or type 'PRIMARY) (or data-type 'STRING)))) (when (and (stringp data) commit 682118f5a06eebdc38767047e65d42aa9356cfe8 Author: Noam Postavsky Date: Sat Apr 14 01:58:38 2018 -0400 ; * doc/misc/url.texi (file/ftp): Remove stray '@end defopt'. diff --git a/doc/misc/url.texi b/doc/misc/url.texi index 8967c71301..a8ac117975 100644 --- a/doc/misc/url.texi +++ b/doc/misc/url.texi @@ -571,8 +571,6 @@ if it has the file suffix @file{.z}, @file{.gz}, @file{.Z}, hard-coded, and cannot be altered by customizing @code{jka-compr-compression-info-list}.) -@end defopt - @node info @section info @cindex Info commit 2825d849451be45ea738e2d2b2567c834fe5a0fb Author: Basil L. Contovounesios Date: Fri Apr 13 12:47:30 2018 +0100 Do not destructively modify interprogram paste * simple.el (kill-new, current-kill): Non-destructively reverse list returned by interprogram-paste-function. (bug#31097) diff --git a/lisp/simple.el b/lisp/simple.el index efe5406bf7..dada65d4ee 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -4369,7 +4369,8 @@ argument should still be a \"useful\" string for such uses." (funcall interprogram-paste-function)))) (when interprogram-paste (dolist (s (if (listp interprogram-paste) - (nreverse interprogram-paste) + ;; Use `reverse' to avoid modifying external data. + (reverse interprogram-paste) (list interprogram-paste))) (unless (and kill-do-not-save-duplicates (equal-including-properties s (car kill-ring))) @@ -4448,7 +4449,8 @@ move the yanking point; just return the Nth kill forward." ;; selection, with identical text. (let ((interprogram-cut-function nil)) (if (listp interprogram-paste) - (mapc 'kill-new (nreverse interprogram-paste)) + ;; Use `reverse' to avoid modifying external data. + (mapc #'kill-new (reverse interprogram-paste)) (kill-new interprogram-paste))) (car kill-ring)) (or kill-ring (error "Kill ring is empty")) commit 0263216ec39d0914f17b662a3e45b4163ab6cc78 Author: Lars Ingebrigtsen Date: Sat Apr 14 00:17:36 2018 +0200 Don't bind image commands on eww non-image links * lisp/net/eww.el (eww-link-keymap): Only inherit the normal shr keymap. (eww-image-link-keymap): New keymap with the image bindings. (eww-tag-a): Use the appropriate one on links (bug#30148). diff --git a/lisp/net/eww.el b/lisp/net/eww.el index cb7390f472..49bf10d4eb 100644 --- a/lisp/net/eww.el +++ b/lisp/net/eww.el @@ -224,6 +224,11 @@ See also `eww-form-checkbox-selected-symbol'." "When this regex is found in the URL, it's not a keyword but an address.") (defvar eww-link-keymap + (let ((map (copy-keymap shr-map))) + (define-key map "\r" 'eww-follow-link) + map)) + +(defvar eww-image-link-keymap (let ((map (copy-keymap shr-image-map))) (define-key map "\r" 'eww-follow-link) map)) @@ -551,7 +556,11 @@ Currently this means either text/html or application/xhtml+xml." (eww-handle-link dom) (let ((start (point))) (shr-tag-a dom) - (put-text-property start (point) 'keymap eww-link-keymap))) + (put-text-property start (point) + 'keymap + (if (mm-images-in-region-p start (point)) + eww-image-link-keymap + eww-link-keymap)))) (defun eww-update-header-line-format () (setq header-line-format commit 3ba07bfc3ec43aa10d8e2d06a8f36f7022287573 Author: Lars Ingebrigtsen Date: Sat Apr 14 00:15:15 2018 +0200 Move utility function to mm-util.el * lisp/gnus/mm-util.el (mm-images-in-region-p): Move from mm-decode.el and renamed, since it is generally useful. diff --git a/lisp/gnus/mm-decode.el b/lisp/gnus/mm-decode.el index d8753e5a1d..69fc770ec7 100644 --- a/lisp/gnus/mm-decode.el +++ b/lisp/gnus/mm-decode.el @@ -1856,7 +1856,7 @@ text/html;\\s-*charset=\\([^\t\n\r \"'>]+\\)[^>]*>" nil t) 'url-link start end :help-echo (get-text-property start 'help-echo) :keymap (setq keymap (copy-keymap - (if (mm--images-in-region-p start end) + (if (mm-images-in-region-p start end) shr-image-map shr-map))) (get-text-property start 'shr-url)) @@ -1874,19 +1874,6 @@ text/html;\\s-*charset=\\([^\t\n\r \"'>]+\\)[^>]*>" nil t) (overlay-put overlay 'face nil)) (setq start end))))) -(defun mm--images-in-region-p (start end) - (let ((found nil)) - (save-excursion - (goto-char start) - (while (and (not found) - (< (point) end)) - (let ((display (get-text-property (point) 'display))) - (when (and (consp display) - (eq (car display) 'image)) - (setq found t))) - (forward-char 1))) - found)) - (defun mm-handle-filename (handle) "Return filename of HANDLE if any." (or (mail-content-type-get (mm-handle-type handle) diff --git a/lisp/gnus/mm-util.el b/lisp/gnus/mm-util.el index 98f993367e..42c2f3ab15 100644 --- a/lisp/gnus/mm-util.el +++ b/lisp/gnus/mm-util.el @@ -882,6 +882,19 @@ gzip, bzip2, etc. are allowed." (when decomp (kill-buffer (current-buffer))))))) +(defun mm-images-in-region-p (start end) + (let ((found nil)) + (save-excursion + (goto-char start) + (while (and (not found) + (< (point) end)) + (let ((display (get-text-property (point) 'display))) + (when (and (consp display) + (eq (car display) 'image)) + (setq found t))) + (forward-char 1))) + found)) + (provide 'mm-util) ;;; mm-util.el ends here commit e442879b5a963a6eb37403fe09f476e7ee8e0f55 Author: Lars Ingebrigtsen Date: Sat Apr 14 00:08:26 2018 +0200 Make the url file: handler be less clever * doc/misc/url.texi (file/ftp): Remove mention of the url-directory-index-file variable, which is no longer consulted. * lisp/url/url-file.el (url-file-build-filename): Remove the DWIM code from the file: handler (bug#30195): It would look for index.html in a directory if we asked it to fetch the directory. Determining what to do in a directory should be left up to the programs that use this low-level library. If the library decides to load a different file than we specified, then things start falling apart, as demonstrated by this bug report. diff --git a/doc/misc/url.texi b/doc/misc/url.texi index fb0a55b3c8..8967c71301 100644 --- a/doc/misc/url.texi +++ b/doc/misc/url.texi @@ -571,11 +571,6 @@ if it has the file suffix @file{.z}, @file{.gz}, @file{.Z}, hard-coded, and cannot be altered by customizing @code{jka-compr-compression-info-list}.) -@defopt url-directory-index-file -This option specifies the filename to look for when a @code{file} or -@code{ftp} URL specifies a directory. The default is -@file{index.html}. If this file exists and is readable, it is viewed. -Otherwise, Emacs visits the directory using Dired. @end defopt @node info diff --git a/etc/NEWS b/etc/NEWS index e8383b7c24..d29a513c70 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -540,7 +540,15 @@ For instance, if /etc/mailcap has an entry for image/gif, that one will be chosen even if you have an entry for image/* in your ~/.mailcap file. But with the new method, entries from ~/.mailcap overrides all system and Emacs-provided defaults. To get the old -method back, set `mailcap-prefer-mailcap-viewers' to nil +method back, set `mailcap-prefer-mailcap-viewers' to nil. + + +** URL + +*** The file: handler no longer looks for index.html in directories if +you ask it for a file:///dir URL. Since this is a low-level library, +such decisions (if they are to be made at all) are left to +higher-level functions. +++ diff --git a/lisp/url/url-file.el b/lisp/url/url-file.el index 4fac406023..92edd9901e 100644 --- a/lisp/url/url-file.el +++ b/lisp/url/url-file.el @@ -142,17 +142,6 @@ to them." (not (string-match "/\\'" filename))) (setf (url-filename url) (format "%s/" filename))) - - ;; If it is a directory, look for an index file first. - (if (and (file-directory-p filename) - url-directory-index-file - (setq pos-index (expand-file-name url-directory-index-file filename)) - (file-exists-p pos-index) - (file-readable-p pos-index)) - (setq filename pos-index)) - - ;; Find the (possibly compressed) file - (setq filename (url-file-find-possibly-compressed-file filename)) filename)) ;;;###autoload commit 4575ae5a9c5589ac903362486951f0d36c8ff8ee Author: Lars Ingebrigtsen Date: Fri Apr 13 23:49:58 2018 +0200 Don't bind image commands on non-image links in Gnus * lisp/gnus/mm-decode.el (mm--images-in-region-p): New utility function. (mm-convert-shr-links): Only use the shr image map on links that contain images. This avoids binding commands like `r' on links that don't need it. diff --git a/lisp/gnus/mm-decode.el b/lisp/gnus/mm-decode.el index 7ab84c0c83..d8753e5a1d 100644 --- a/lisp/gnus/mm-decode.el +++ b/lisp/gnus/mm-decode.el @@ -25,6 +25,7 @@ (require 'mail-parse) (require 'mm-bodies) +(require 'shr) (eval-when-compile (require 'cl-lib)) (autoload 'gnus-map-function "gnus-util") @@ -1841,8 +1842,6 @@ text/html;\\s-*charset=\\([^\t\n\r \"'>]+\\)[^>]*>" nil t) (let ((inhibit-read-only t)) (delete-region min max)))))))) -(defvar shr-image-map) - (autoload 'widget-convert-button "wid-edit") (defvar widget-keymap) @@ -1856,7 +1855,10 @@ text/html;\\s-*charset=\\([^\t\n\r \"'>]+\\)[^>]*>" nil t) (widget-convert-button 'url-link start end :help-echo (get-text-property start 'help-echo) - :keymap (setq keymap (copy-keymap shr-image-map)) + :keymap (setq keymap (copy-keymap + (if (mm--images-in-region-p start end) + shr-image-map + shr-map))) (get-text-property start 'shr-url)) ;; Mask keys that launch `widget-button-click'. ;; Those bindings are provided by `widget-keymap' @@ -1872,6 +1874,19 @@ text/html;\\s-*charset=\\([^\t\n\r \"'>]+\\)[^>]*>" nil t) (overlay-put overlay 'face nil)) (setq start end))))) +(defun mm--images-in-region-p (start end) + (let ((found nil)) + (save-excursion + (goto-char start) + (while (and (not found) + (< (point) end)) + (let ((display (get-text-property (point) 'display))) + (when (and (consp display) + (eq (car display) 'image)) + (setq found t))) + (forward-char 1))) + found)) + (defun mm-handle-filename (handle) "Return filename of HANDLE if any." (or (mail-content-type-get (mm-handle-type handle) commit 52a5bc89c92cb4be88d9ec6eb2df178560559320 Author: Lars Ingebrigtsen Date: Fri Apr 13 22:52:16 2018 +0200 Revert "Add colors to faces that lack them." This reverts commit 16748a5f6bd57ec0967ecb5e14ffe8af5f43d888. From the discussion on the ding mailing list, I said: I think the colours should be reverted back to what they were before the change. Normal text should be white on black (if you have a dark background), and colours should be used to emphasise or de-emphasise certain text. Following that principle, normal Gnus groups should be white, not ... er... what are they now? Teal? diff --git a/lisp/gnus/gnus.el b/lisp/gnus/gnus.el index fb2ae192f1..2786323f67 100644 --- a/lisp/gnus/gnus.el +++ b/lisp/gnus/gnus.el @@ -356,7 +356,7 @@ be set in `.emacs' instead." (defface gnus-group-news-2-empty '((((class color) (background dark)) - (:foreground "turquoise4")) + (:foreground "turquoise")) (((class color) (background light)) (:foreground "CadetBlue4")) @@ -373,10 +373,10 @@ be set in `.emacs' instead." (defface gnus-group-news-3-empty '((((class color) (background dark)) - (:foreground "turquoise3")) + ()) (((class color) (background light)) - (:foreground "DeepSkyBlue4")) + ()) (t ())) "Level 3 empty newsgroup face." @@ -390,10 +390,10 @@ be set in `.emacs' instead." (defface gnus-group-news-4-empty '((((class color) (background dark)) - (:foreground "turquoise2")) + ()) (((class color) (background light)) - (:foreground "DeepSkyBlue3")) + ()) (t ())) "Level 4 empty newsgroup face." @@ -407,10 +407,10 @@ be set in `.emacs' instead." (defface gnus-group-news-5-empty '((((class color) (background dark)) - (:foreground "turquoise1")) + ()) (((class color) (background light)) - (:foreground "DeepSkyBlue2")) + ()) (t ())) "Level 5 empty newsgroup face." commit bdc2453fe83a0f50095d31b056af18fa2718d6db Author: Lars Ingebrigtsen Date: Fri Apr 13 22:27:21 2018 +0200 Tweak the fonts applied to shr indentation * lisp/net/shr.el (shr-fill-line): Don't use fonts (especially link fonts) over indentation, because that's ugly.. diff --git a/lisp/net/shr.el b/lisp/net/shr.el index 5ffaf153c3..fb17b856f4 100644 --- a/lisp/net/shr.el +++ b/lisp/net/shr.el @@ -736,13 +736,13 @@ size, and full-buffer size." ;; Success; continue. (when (= (preceding-char) ?\s) (delete-char -1)) - (let ((props `(face ,(get-text-property (point) 'face) - ;; Don't break the image-displayer property - ;; as it will cause `gnus-article-show-images' - ;; to show the two or more same images. - image-displayer - ,(get-text-property (point) 'image-displayer))) + (let ((props (copy-sequence (text-properties-at (point)))) (gap-start (point))) + ;; We don't want to use the faces on the indentation, because + ;; that's ugly, but we want all the other properties to be + ;; continuous so that links do not split up into many links + ;; (which makes navigation awkward). + (setq props (plist-put props 'face nil)) (insert "\n") (shr-indent) (add-text-properties gap-start (point) props)) commit 0eb68feed44a5c58931eb0cda19df95164958772 Author: Lars Ingebrigtsen Date: Fri Apr 13 21:58:25 2018 +0200 Further tweak point placement on gnus-summary-select-article-buffer * lisp/gnus/gnus-sum.el (gnus-summary-select-article-buffer): Place point in the empty space between headers and body. diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el index 0a7b233a48..aed5aaf01e 100644 --- a/lisp/gnus/gnus-sum.el +++ b/lisp/gnus/gnus-sum.el @@ -7071,7 +7071,8 @@ buffer." ;; If we've just selected the message, place point at the start of ;; the body because that's probably where we want to be. (when (bobp) - (article-goto-body)))) + (article-goto-body) + (forward-char -1)))) (defun gnus-summary-universal-argument (arg) "Perform any operation on all articles that are process/prefixed." commit 9f5f26c2b699f26937245905b3217b2fc6a4cf06 Author: Lars Ingebrigtsen Date: Fri Apr 13 21:33:37 2018 +0200 Tweak point placement in *Group* on `Q' exit * lisp/gnus/gnus-sum.el (gnus-summary-exit-no-update): When exiting the summary buffer with `Q', move point to the next unread group (which is the same thing that happens on `q' exit.) diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el index b1e9d60e3b..0a7b233a48 100644 --- a/lisp/gnus/gnus-sum.el +++ b/lisp/gnus/gnus-sum.el @@ -7353,7 +7353,7 @@ If FORCE (the prefix), also save the .newsrc file(s)." (setq gnus-newsgroup-name nil) (unless (gnus-ephemeral-group-p group) (gnus-group-update-group group nil t)) - (when (equal (gnus-group-group-name) group) + (when (gnus-group-goto-group group) (gnus-group-next-unread-group 1)) (gnus-article-stop-animations) (when quit-config commit e9f1260773335f0828de5815cdad0662a4e50e04 Author: Lars Ingebrigtsen Date: Fri Apr 13 21:18:51 2018 +0200 Tweak point placement in gnus-summary-select-article-buffer * lisp/gnus/gnus-sum.el (gnus-summary-select-article-buffer): Tweak where point is placed because when the user selects the article buffer, it's probably to cite something or click on something, and not do anything with the headers. diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el index e1789cdd59..b1e9d60e3b 100644 --- a/lisp/gnus/gnus-sum.el +++ b/lisp/gnus/gnus-sum.el @@ -7067,7 +7067,11 @@ buffer." 'only-article 'article) t) - (select-window (get-buffer-window gnus-article-buffer)))) + (select-window (get-buffer-window gnus-article-buffer)) + ;; If we've just selected the message, place point at the start of + ;; the body because that's probably where we want to be. + (when (bobp) + (article-goto-body)))) (defun gnus-summary-universal-argument (arg) "Perform any operation on all articles that are process/prefixed." commit cad2b8d109d4fd2b78d4e064af729336f348a2bb Author: Lars Ingebrigtsen Date: Fri Apr 13 20:24:04 2018 +0200 Compute erc line lengths correctly for utf-8 (etc.) * lisp/erc/erc-backend.el (erc-split-line): Fold the lines according to octet length, not the number of characters (bug#23047). diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el index 7eec56e363..814ecfae85 100644 --- a/lisp/erc/erc-backend.el +++ b/lisp/erc/erc-backend.el @@ -466,14 +466,18 @@ If this is set to nil, never try to reconnect." The length is specified in `erc-split-line-length'. Currently this is called by `erc-send-input'." - (if (< (length longline) - erc-split-line-length) - (list longline) + (let ((charset (car (erc-coding-system-for-target nil)))) (with-temp-buffer (insert longline) + ;; The line lengths are in octets, not characters (because these + ;; are server protocol limits), so we have to first make the + ;; text into bytes, then fold the bytes on "word" boundaries, + ;; and then make the bytes into text again. + (encode-coding-region (point-min) (point-max) charset) (let ((fill-column erc-split-line-length)) (fill-region (point-min) (point-max) nil t)) + (decode-coding-region (point-min) (point-max) charset) (split-string (buffer-string) "\n")))) (defun erc-forward-word () commit b7ac2761fc5e58dd48b8b11642d16ba2b4f04c74 Author: Lars Ingebrigtsen Date: Fri Apr 13 19:54:22 2018 +0200 Clean up some defvoo doc strings * lisp/gnus/nndiary.el: Remove "*" from doc strings from defvoo elements (bug#23392). * lisp/gnus/nndir.el: Ditto * lisp/gnus/nndoc.el: Ditto. * lisp/gnus/nnrss.el: Ditto. * lisp/gnus/nnspool.el: Ditto. * lisp/gnus/nntp.el: Ditto. diff --git a/lisp/gnus/nndiary.el b/lisp/gnus/nndiary.el index 609d90b107..0b300c1a16 100644 --- a/lisp/gnus/nndiary.el +++ b/lisp/gnus/nndiary.el @@ -232,7 +232,7 @@ through all nnml directories and generate nov databases for them all. This may very well take some time.") (defvoo nndiary-prepare-save-mail-hook nil - "*Hook run narrowed to an article before saving.") + "Hook run narrowed to an article before saving.") (defvoo nndiary-inhibit-expiry nil "If non-nil, inhibit expiry.") diff --git a/lisp/gnus/nndir.el b/lisp/gnus/nndir.el index 0506bb20ee..6dc6c33808 100644 --- a/lisp/gnus/nndir.el +++ b/lisp/gnus/nndir.el @@ -37,7 +37,7 @@ nnml-current-directory nnmh-current-directory) (defvoo nndir-nov-is-evil nil - "*Non-nil means that nndir will never retrieve NOV headers." + "Non-nil means that nndir will never retrieve NOV headers." nnml-nov-is-evil) diff --git a/lisp/gnus/nndoc.el b/lisp/gnus/nndoc.el index fa3117ae2f..2ed023f686 100644 --- a/lisp/gnus/nndoc.el +++ b/lisp/gnus/nndoc.el @@ -38,14 +38,14 @@ (nnoo-declare nndoc) (defvoo nndoc-article-type 'guess - "*Type of the file. + "Type of the file. One of `mbox', `babyl', `digest', `news', `rnews', `mmdf', `forward', `rfc934', `rfc822-forward', `mime-parts', `standard-digest', `slack-digest', `clari-briefs', `nsmail', `outlook', `oe-dbx', `mailman', `exim-bounce', or `guess'.") (defvoo nndoc-post-type 'mail - "*Whether the nndoc group is `mail' or `post'.") + "Whether the nndoc group is `mail' or `post'.") (defvoo nndoc-open-document-hook 'nnheader-ms-strip-cr "Hook run after opening a document. diff --git a/lisp/gnus/nnrss.el b/lisp/gnus/nnrss.el index c38f7eb79b..f80e2c5107 100644 --- a/lisp/gnus/nnrss.el +++ b/lisp/gnus/nnrss.el @@ -49,7 +49,7 @@ "Where nnrss will save its files.") (defvoo nnrss-ignore-article-fields '(slash:comments) - "*List of fields that should be ignored when comparing RSS articles. + "List of fields that should be ignored when comparing RSS articles. Some RSS feeds update article fields during their lives, e.g. to indicate the number of comments or the number of times the articles have been seen. However, if there is a difference diff --git a/lisp/gnus/nnspool.el b/lisp/gnus/nnspool.el index 128ce7cac6..c4dc575dcd 100644 --- a/lisp/gnus/nnspool.el +++ b/lisp/gnus/nnspool.el @@ -105,7 +105,7 @@ If nil, nnspool will load the entire file into a buffer and process it there.") (defvoo nnspool-rejected-article-hook nil - "*A hook that will be run when an article has been rejected by the server.") + "A hook that will be run when an article has been rejected by the server.") (defvoo nnspool-file-coding-system nnheader-file-coding-system "Coding system for nnspool.") diff --git a/lisp/gnus/nntp.el b/lisp/gnus/nntp.el index 5291919bab..784240f4ff 100644 --- a/lisp/gnus/nntp.el +++ b/lisp/gnus/nntp.el @@ -48,7 +48,7 @@ "Port number on the physical nntp server.") (defvoo nntp-server-opened-hook '(nntp-send-mode-reader) - "*Hook used for sending commands to the server at startup. + "Hook used for sending commands to the server at startup. The default value is `nntp-send-mode-reader', which makes an innd server spawn an nnrpd server.") @@ -94,7 +94,7 @@ For indirect connections: - `nntp-open-via-telnet-and-telnet'") (defvoo nntp-never-echoes-commands nil - "*Non-nil means the nntp server never echoes commands. + "Non-nil means the nntp server never echoes commands. It is reported that some nntps server doesn't echo commands. So, you may want to set this to non-nil in the method for such a server setting `nntp-open-connection-function' to `nntp-open-ssl-stream' for example. @@ -103,102 +103,102 @@ variable overrides the nil value of this variable.") (defvoo nntp-open-connection-functions-never-echo-commands '(nntp-open-network-stream) - "*List of functions that never echo commands. + "List of functions that never echo commands. Add or set a function which you set to `nntp-open-connection-function' to this list if it does not echo commands. Note that a non-nil value of the `nntp-never-echoes-commands' variable overrides this variable.") (defvoo nntp-pre-command nil - "*Pre-command to use with the various nntp-open-via-* methods. + "Pre-command to use with the various nntp-open-via-* methods. This is where you would put \"runsocks\" or stuff like that.") (defvoo nntp-telnet-command "telnet" - "*Telnet command used to connect to the nntp server. + "Telnet command used to connect to the nntp server. This command is used by the methods `nntp-open-telnet-stream', `nntp-open-via-rlogin-and-telnet' and `nntp-open-via-telnet-and-telnet'.") (defvoo nntp-telnet-switches '("-8") - "*Switches given to the telnet command `nntp-telnet-command'.") + "Switches given to the telnet command `nntp-telnet-command'.") (defvoo nntp-end-of-line "\r\n" - "*String to use on the end of lines when talking to the NNTP server. + "String to use on the end of lines when talking to the NNTP server. This is \"\\r\\n\" by default, but should be \"\\n\" when using an indirect connection method (nntp-open-via-*).") (defvoo nntp-via-rlogin-command "rsh" - "*Rlogin command used to connect to an intermediate host. + "Rlogin command used to connect to an intermediate host. This command is used by the methods `nntp-open-via-rlogin-and-telnet' and `nntp-open-via-rlogin-and-netcat'. The default is \"rsh\", but \"ssh\" is a popular alternative.") (defvoo nntp-via-rlogin-command-switches nil - "*Switches given to the rlogin command `nntp-via-rlogin-command'. + "Switches given to the rlogin command `nntp-via-rlogin-command'. If you use \"ssh\" for `nntp-via-rlogin-command', you may set this to \(\"-C\") in order to compress all data connections, otherwise set this to \(\"-t\" \"-e\" \"none\") or (\"-C\" \"-t\" \"-e\" \"none\") if the telnet command requires a pseudo-tty allocation on an intermediate host.") (defvoo nntp-via-telnet-command "telnet" - "*Telnet command used to connect to an intermediate host. + "Telnet command used to connect to an intermediate host. This command is used by the `nntp-open-via-telnet-and-telnet' method.") (defvoo nntp-via-telnet-switches '("-8") - "*Switches given to the telnet command `nntp-via-telnet-command'.") + "Switches given to the telnet command `nntp-via-telnet-command'.") (defvoo nntp-netcat-command "nc" - "*Netcat command used to connect to the nntp server. + "Netcat command used to connect to the nntp server. This command is used by the `nntp-open-netcat-stream' and `nntp-open-via-rlogin-and-netcat' methods.") (defvoo nntp-netcat-switches nil - "*Switches given to the netcat command `nntp-netcat-command'.") + "Switches given to the netcat command `nntp-netcat-command'.") (defvoo nntp-via-user-name nil - "*User name to log in on an intermediate host with. + "User name to log in on an intermediate host with. This variable is used by the various nntp-open-via-* methods.") (defvoo nntp-via-user-password nil - "*Password to use to log in on an intermediate host with. + "Password to use to log in on an intermediate host with. This variable is used by the `nntp-open-via-telnet-and-telnet' method.") (defvoo nntp-via-address nil - "*Address of an intermediate host to connect to. + "Address of an intermediate host to connect to. This variable is used by the various nntp-open-via-* methods.") (defvoo nntp-via-envuser nil - "*Whether both telnet client and server support the ENVIRON option. + "Whether both telnet client and server support the ENVIRON option. If non-nil, there will be no prompt for a login name.") (defvoo nntp-via-shell-prompt "bash\\|[$>] *\r?$" - "*Regular expression to match the shell prompt on an intermediate host. + "Regular expression to match the shell prompt on an intermediate host. This variable is used by the `nntp-open-via-telnet-and-telnet' method.") (defvoo nntp-large-newsgroup 50 - "*The number of articles which indicates a large newsgroup. + "The number of articles which indicates a large newsgroup. If the number of articles is greater than the value, verbose messages will be shown to indicate the current status.") (defvoo nntp-maximum-request 400 - "*The maximum number of the requests sent to the NNTP server at one time. + "The maximum number of the requests sent to the NNTP server at one time. If Emacs hangs up while retrieving headers, set the variable to a lower value.") (defvoo nntp-nov-is-evil nil - "*If non-nil, nntp will never attempt to use XOVER when talking to the server.") + "If non-nil, nntp will never attempt to use XOVER when talking to the server.") (defvoo nntp-xover-commands '("XOVER" "XOVERVIEW") - "*List of strings that are used as commands to fetch NOV lines from a server. + "List of strings that are used as commands to fetch NOV lines from a server. The strings are tried in turn until a positive response is gotten. If none of the commands are successful, nntp will just grab headers one by one.") (defvoo nntp-nov-gap 5 - "*Maximum allowed gap between two articles. + "Maximum allowed gap between two articles. If the gap between two consecutive articles is bigger than this variable, split the XOVER request into two requests.") (defvoo nntp-xref-number-is-evil nil - "*If non-nil, Gnus never trusts article numbers in the Xref header. + "If non-nil, Gnus never trusts article numbers in the Xref header. Some news servers, e.g., ones running Diablo, run multiple engines having the same articles but article numbers are not kept synchronized between them. If you connect to such a server, set this to a non-nil @@ -206,7 +206,7 @@ value, and Gnus never uses article numbers (that appear in the Xref header and vary by which engine is chosen) to refer to articles.") (defvoo nntp-prepare-server-hook nil - "*Hook run before a server is opened. + "Hook run before a server is opened. If can be used to set up a server remotely, for instance. Say you have an account at the machine \"other.machine\". This machine has access to an NNTP server that you can't access locally. You could @@ -237,11 +237,11 @@ server there that you can connect to. See also (defvoo nntp-connection-timeout nil - "*Number of seconds to wait before an nntp connection times out. + "Number of seconds to wait before an nntp connection times out. If this variable is nil, which is the default, no timers are set.") (defvoo nntp-prepare-post-hook nil - "*Hook run just before posting an article. It is supposed to be used + "Hook run just before posting an article. It is supposed to be used to insert Cancel-Lock headers.") (defvoo nntp-server-list-active-group 'try @@ -1743,26 +1743,26 @@ If SEND-IF-FORCE, only send authinfo to the server if the ;; ========================================================================== (defvoo nntp-open-telnet-envuser nil - "*If non-nil, telnet session (client and server both) will support the ENVIRON option and not prompt for login name.") + "If non-nil, telnet session (client and server both) will support the ENVIRON option and not prompt for login name.") (defvoo nntp-telnet-shell-prompt "bash\\|[$>] *\r?$" - "*Regular expression to match the shell prompt on the remote machine.") + "Regular expression to match the shell prompt on the remote machine.") (defvoo nntp-rlogin-program "rsh" - "*Program used to log in on remote machines. + "Program used to log in on remote machines. The default is \"rsh\", but \"ssh\" is a popular alternative.") (defvoo nntp-rlogin-parameters '("telnet" "-8" "${NNTPSERVER:=news}" "nntp") - "*Parameters to `nntp-open-rlogin'. + "Parameters to `nntp-open-rlogin'. That function may be used as `nntp-open-connection-function'. In that case, this list will be used as the parameter list given to rsh.") (defvoo nntp-rlogin-user-name nil - "*User name on remote system when using the rlogin connect method.") + "User name on remote system when using the rlogin connect method.") (defvoo nntp-telnet-parameters '("exec" "telnet" "-8" "${NNTPSERVER:=news}" "nntp") - "*Parameters to `nntp-open-telnet'. + "Parameters to `nntp-open-telnet'. That function may be used as `nntp-open-connection-function'. In that case, this list will be executed as a command after logging in via telnet.") commit ffbb4e8d542df44ced5afd89221b0dfb234d8525 Author: Eric Abrahamsen Date: Sun Apr 8 16:49:20 2018 -0700 Further fix to eieio-persistent * lisp/emacs-lisp/eieio-base.el (eieio-persistent-validate/fix-slot-value): Make handling of hash tables and vectors recursive. This is necessary because the write process, in `eieio-override-prin1' is also recursive. With any luck, this will be the last fix of its kind. If that's true, cherry-pick to Emacs 26.2 later on. diff --git a/lisp/emacs-lisp/eieio-base.el b/lisp/emacs-lisp/eieio-base.el index 9f9f870a75..75709ddc0a 100644 --- a/lisp/emacs-lisp/eieio-base.el +++ b/lisp/emacs-lisp/eieio-base.el @@ -360,32 +360,30 @@ Second, any text properties will be stripped from strings." proposed-value)))) ;; For hash-tables and vectors, the top-level `read' will not ;; "look inside" member values, so we need to do that - ;; explicitly. + ;; explicitly. Because `eieio-override-prin1' is recursive in + ;; the case of hash-tables and vectors, we recurse + ;; `eieio-persistent-validate/fix-slot-value' here as well. ((hash-table-p proposed-value) (maphash (lambda (key value) - (cond ((class-p (car-safe value)) - (setf (gethash key proposed-value) - (eieio-persistent-convert-list-to-object - value))) - ((and (consp value) - (eq (car value) 'quote)) - (setf (gethash key proposed-value) - (cadr value))))) + (setf (gethash key proposed-value) + (if (class-p (car-safe value)) + (eieio-persistent-convert-list-to-object + value) + (eieio-persistent-validate/fix-slot-value + class slot value)))) proposed-value) proposed-value) ((vectorp proposed-value) (dotimes (i (length proposed-value)) (let ((val (aref proposed-value i))) - (cond ((class-p (car-safe val)) - (aset proposed-value i - (eieio-persistent-convert-list-to-object - (aref proposed-value i)))) - ((and (consp val) - (eq (car val) 'quote)) - (aset proposed-value i - (cadr val)))))) + (aset proposed-value i + (if (class-p (car-safe val)) + (eieio-persistent-convert-list-to-object + val) + (eieio-persistent-validate/fix-slot-value + class slot val))))) proposed-value) ((stringp proposed-value) commit de28ae70effd64755e7543fd2cef90f8de5d8019 Author: Lars Ingebrigtsen Date: Fri Apr 13 19:28:17 2018 +0200 Make nnimap parse pathological spam headers better * lisp/gnus/nnimap.el (nnimap-transform-headers): Unfold certain pathological IMAP headers more correctly (bug#25502). Perhaps this function should be re-implemented. diff --git a/lisp/gnus/nnimap.el b/lisp/gnus/nnimap.el index 0d85a29ff2..dc51b5f0f0 100644 --- a/lisp/gnus/nnimap.el +++ b/lisp/gnus/nnimap.el @@ -220,15 +220,16 @@ textual parts.") (cl-return))) (goto-char (match-end 0)) ;; Unfold quoted {number} strings. - (while (re-search-forward - "[^]][ (]{\\([0-9]+\\)}\r?\n" - (save-excursion - ;; Start of the header section. - (or (re-search-forward "] {[0-9]+}\r?\n" nil t) - ;; Start of the next FETCH. - (re-search-forward "\\* [0-9]+ FETCH" nil t) - (point-max))) - t) + (while (or (looking-at "[ (]{\\([0-9]+\\)}\r?\n") + (re-search-forward + "[^]][ (]{\\([0-9]+\\)}\r?\n" + (save-excursion + ;; Start of the header section. + (or (re-search-forward "] {[0-9]+}\r?\n" nil t) + ;; Start of the next FETCH. + (re-search-forward "\\* [0-9]+ FETCH" nil t) + (point-max))) + t)) (setq size (string-to-number (match-string 1))) (delete-region (+ (match-beginning 0) 2) (point)) (setq string (buffer-substring (point) (+ (point) size))) commit ad731b0d8fe75af37959042db8de9db6178cf0e8 Author: Eli Zaretskii Date: Fri Apr 13 20:19:17 2018 +0300 ; * doc/lispref/display.texi (Temporary Displays): Fix typos. diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi index 1743a977ec..02dc830e0a 100644 --- a/doc/lispref/display.texi +++ b/doc/lispref/display.texi @@ -1241,7 +1241,7 @@ displays the buffer specified by @var{buffer-or-name} @emph{before} running @var{body}. @end defmac -A window showing a temporary buffer can be fit to the size of that +A window showing a temporary buffer can be fitted to the size of that buffer using the following mode: @defopt temp-buffer-resize-mode @@ -1274,7 +1274,7 @@ positive integer. At the time the function is called, the window to be resized is selected. @end defopt -The following function uses the current buffer for temporal display: +The following function uses the current buffer for temporary display: @defun momentary-string-display string position &optional char message This function momentarily displays @var{string} in the current buffer at commit 9f8c433d96011ed6d6120c614774ad2ce65bcc37 Author: Lars Ingebrigtsen Date: Fri Apr 13 19:09:03 2018 +0200 Fix syntax error in emacs-mime.texi in last check-in diff --git a/doc/misc/emacs-mime.texi b/doc/misc/emacs-mime.texi index db9ed8dda7..3925cceaa6 100644 --- a/doc/misc/emacs-mime.texi +++ b/doc/misc/emacs-mime.texi @@ -1858,8 +1858,8 @@ Emacs-provided viewer settings. If @code{nil}, Emacs-provided viewer settings have precedence. Next, the most specific viewer has precedence over less specific settings, -no matter if they're system-provided or private, so @string{image/gif} -in @file{/etc/mailcap} will ``win'' over a @string{image/*} setting in +no matter if they're system-provided or private, so @samp{image/gif} +in @file{/etc/mailcap} will ``win'' over a @samp{image/*} setting in @file{~/.mailcap}. @end table commit 7e47d44da4b54c518c5e09b4f3d58dafdd43033d Author: Lars Ingebrigtsen Date: Fri Apr 13 19:08:16 2018 +0200 Prefer settings from ~/.mailcap over system and Emacs settings * doc/misc/emacs-mime.texi (mailcap): Document the variable and how mailcap chooses which viewer to use. * lisp/net/mailcap.el (mailcap-prefer-mailcap-viewers): New variable. (mailcap-mime-info): Use it. diff --git a/doc/misc/emacs-mime.texi b/doc/misc/emacs-mime.texi index c0b16f30c4..db9ed8dda7 100644 --- a/doc/misc/emacs-mime.texi +++ b/doc/misc/emacs-mime.texi @@ -1845,11 +1845,23 @@ Interface functions: @table @code @item mailcap-parse-mailcaps @findex mailcap-parse-mailcaps +@vindex mailcap-prefer-mailcap-viewers Parse the @file{~/.mailcap} file. @item mailcap-mime-info Takes a @acronym{MIME} type as its argument and returns the matching viewer. +The @code{mailcap-prefer-mailcap-viewers} variable controls which +viewer is chosen. The default non-@code{nil} value means that +settings from @file{~/.mailcap} is preferred over system-wide or +Emacs-provided viewer settings. + +If @code{nil}, Emacs-provided viewer settings have precedence. Next, +the most specific viewer has precedence over less specific settings, +no matter if they're system-provided or private, so @string{image/gif} +in @file{/etc/mailcap} will ``win'' over a @string{image/*} setting in +@file{~/.mailcap}. + @end table diff --git a/etc/NEWS b/etc/NEWS index 88deb77984..e8383b7c24 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -526,11 +526,23 @@ does not fit in a machine integer (Bug#30408). 'json-insert', 'json-parse-string', and 'json-parse-buffer'. These are implemented in C using the Jansson library. +** Mailcap + --- -** The new function `mailcap-file-name-to-mime-type' has been added. +*** The new function `mailcap-file-name-to-mime-type' has been added. It's a simple convenience function for looking up MIME types based on file name extensions. +*** The default way the list of possible external viewers for MIME +types is sorted and chosen has changed. Earlier, the most specific +viewer was chosen, even if there was a general override in ~/.mailcap. +For instance, if /etc/mailcap has an entry for image/gif, that one +will be chosen even if you have an entry for image/* in your +~/.mailcap file. But with the new method, entries from ~/.mailcap +overrides all system and Emacs-provided defaults. To get the old +method back, set `mailcap-prefer-mailcap-viewers' to nil + + +++ ** The new function 'read-answer' accepts either long or short answers depending on the new customizable variable 'read-answer-short'. diff --git a/lisp/net/mailcap.el b/lisp/net/mailcap.el index 4ec00450f4..414ba0fd85 100644 --- a/lisp/net/mailcap.el +++ b/lisp/net/mailcap.el @@ -36,6 +36,14 @@ :version "21.1" :group 'mime) +(defcustom mailcap-prefer-mailcap-viewers t + "If non-nil, prefer viewers specified in ~/.mailcap. +If nil, the most specific viewer will be chosen, even if there is +a general override in ~/.mailcap. For instance, if /etc/mailcap +has an entry for \"image/gif\", that one will be chosen even if +you have an entry for \"image/*\" in your ~/.mailcap file." + :type 'boolean) + (defvar mailcap-parse-args-syntax-table (let ((table (copy-syntax-table emacs-lisp-mode-syntax-table))) (modify-syntax-entry ?' "\"" table) @@ -784,18 +792,23 @@ If NO-DECODE is non-nil, don't decode STRING." (setq passed (list viewer)) ;; None found, so heuristically select some applicable viewer ;; from `mailcap-mime-data'. + (mailcap-parse-mailcaps) (setq major (split-string (car ctl) "/")) (setq minor (cadr major) major (car major)) (when (setq major-info (cdr (assoc major mailcap-mime-data))) (when (setq viewers (mailcap-possible-viewers major-info minor)) - (setq info (mapcar (lambda (a) (cons (symbol-name (car a)) - (cdr a))) + (setq info (mapcar (lambda (a) + (cons (symbol-name (car a)) (cdr a))) (cdr ctl))) (dolist (entry viewers) (when (mailcap-viewer-passes-test entry info) (push entry passed))) - (setq passed (sort passed 'mailcap-viewer-lessp)) + ;; The data is in "logical" order; entries from ~/.mailcap + ;; are first, so we don't need to do any sorting if the + ;; user wants ~/.mailcap to be preferred. + (unless mailcap-prefer-mailcap-viewers + (setq passed (sort passed 'mailcap-viewer-lessp))) (setq viewer (car passed)))) (when (and (stringp (cdr (assq 'viewer viewer))) passed) commit 712607b05ac7c28a35e4682269adc53257ab9337 Author: Lars Ingebrigtsen Date: Fri Apr 13 18:35:07 2018 +0200 Fix bug in shr-urlify introduced in previous patch * lisp/net/shr.el (shr-urlify): Not all URLs have domains, so check for that before doing IDNA. diff --git a/lisp/net/shr.el b/lisp/net/shr.el index 7b8c841d9d..5ffaf153c3 100644 --- a/lisp/net/shr.el +++ b/lisp/net/shr.el @@ -1221,8 +1221,9 @@ START, and END. Note that START and END should be markers." ;; decoded version in the mouseover to let the ;; user know that there's something possibly ;; fishy. - (setf (url-host parsed) - (puny-encode-domain (url-host parsed))) + (when (url-host parsed) + (setf (url-host parsed) + (puny-encode-domain (url-host parsed)))) (setq iri (url-recreate-url parsed)) (if title (format "%s (%s)" iri title) commit b1943e84bc652e05f0737d1f171a5255b4d96f72 Author: Lars Ingebrigtsen Date: Fri Apr 13 17:30:59 2018 +0200 Make shr support inline
s * lisp/net/shr.el (shr-tag-div): Support display: inline; for
, since that's a very common thing (bug#25588). diff --git a/lisp/net/shr.el b/lisp/net/shr.el index aa62e72463..7b8c841d9d 100644 --- a/lisp/net/shr.el +++ b/lisp/net/shr.el @@ -1368,9 +1368,13 @@ ones, in case fg and bg are nil." (shr-ensure-paragraph)) (defun shr-tag-div (dom) - (shr-ensure-newline) - (shr-generic dom) - (shr-ensure-newline)) + (let ((display (cdr (assq 'display shr-stylesheet)))) + (if (or (equal display "inline") + (equal display "inline-block")) + (shr-generic dom) + (shr-ensure-newline) + (shr-generic dom) + (shr-ensure-newline)))) (defun shr-tag-s (dom) (shr-fontize-dom dom 'shr-strike-through)) commit c194be368cbbedd31092c22bd3a5b25113a83ac9 Author: Lars Ingebrigtsen Date: Fri Apr 13 17:11:07 2018 +0200 Notify the user a bit more before clicking IDNA links * lisp/net/shr.el (shr-urlify): Show the puny-encoded domain name in the mouseover string (bug#25600). diff --git a/lisp/net/shr.el b/lisp/net/shr.el index 2dc1036e41..aa62e72463 100644 --- a/lisp/net/shr.el +++ b/lisp/net/shr.el @@ -38,6 +38,7 @@ (require 'seq) (require 'svg) (require 'image) +(require 'puny) (defgroup shr nil "Simple HTML Renderer" @@ -1209,12 +1210,23 @@ START, and END. Note that START and END should be markers." (add-text-properties start (point) (list 'shr-url url - 'help-echo (let ((iri (or (ignore-errors - (decode-coding-string - (url-unhex-string url) - 'utf-8 t)) - url))) - (if title (format "%s (%s)" iri title) iri)) + 'help-echo (let ((parsed (url-generic-parse-url + (or (ignore-errors + (decode-coding-string + (url-unhex-string url) + 'utf-8 t)) + url))) + iri) + ;; If we have an IDNA domain, then show the + ;; decoded version in the mouseover to let the + ;; user know that there's something possibly + ;; fishy. + (setf (url-host parsed) + (puny-encode-domain (url-host parsed))) + (setq iri (url-recreate-url parsed)) + (if title + (format "%s (%s)" iri title) + iri)) 'follow-link t 'mouse-face 'highlight)) ;; Don't overwrite any keymaps that are already in the buffer (i.e., commit bd7601f21b4627d91d8cccbd8ccd7666d774a083 Author: Lars Ingebrigtsen Date: Fri Apr 13 16:50:45 2018 +0200 (nnimap-sequence): Add comment * lisp/gnus/nnimap.el (nnimap-sequence): Add comment. diff --git a/lisp/gnus/nnimap.el b/lisp/gnus/nnimap.el index 65d40eba69..0d85a29ff2 100644 --- a/lisp/gnus/nnimap.el +++ b/lisp/gnus/nnimap.el @@ -1865,6 +1865,8 @@ Return the server's response to the SELECT or EXAMINE command." (setq nnimap-connection-alist (delq entry nnimap-connection-alist)) nil)))) +;; Leave room for `open-network-stream' to issue a couple of IMAP +;; commands before nnimap starts. (defvar nnimap-sequence 5) (defun nnimap-send-command (&rest args) commit 560553b1fa2247b7e2b28dd2fe7f404040dacac6 Author: Lars Ingebrigtsen Date: Fri Apr 13 16:41:13 2018 +0200 (url-http): Ensure that the referrer is all-ASCII * lisp/url/url-http.el (url-http): Ensure that the referrer is all-ASCII. diff --git a/lisp/url/url-http.el b/lisp/url/url-http.el index bb3e76997a..d45bb323b1 100644 --- a/lisp/url/url-http.el +++ b/lisp/url/url-http.el @@ -1291,7 +1291,7 @@ The return value of this function is the retrieval buffer." (buffer (or retry-buffer (generate-new-buffer (format " *http %s:%d*" (url-host url) (url-port url))))) - (referer (url-http--get-referer url))) + (referer (url-http--encode-string (url-http--get-referer url)))) (if (not connection) ;; Failed to open the connection for some reason (progn commit a53bac31426397fcf9e1a52fecb9a1e281492867 Author: Lars Ingebrigtsen Date: Fri Apr 13 16:39:17 2018 +0200 gnutls.el now needs punycode * lisp/net/gnutls.el (puny): Require punycode. diff --git a/lisp/net/gnutls.el b/lisp/net/gnutls.el index cea6c25112..09df019e2e 100644 --- a/lisp/net/gnutls.el +++ b/lisp/net/gnutls.el @@ -36,6 +36,7 @@ ;;; Code: (require 'cl-lib) +(require 'puny) (defgroup gnutls nil "Emacs interface to the GnuTLS library." commit 4a6302330384ad89bcfccce6b563eb5462b753a9 Author: Lars Ingebrigtsen Date: Fri Apr 13 16:38:10 2018 +0200 Make Unicode domain names work again in URL after recent changes * lisp/net/gnutls.el (open-gnutls-stream): IDNA-encode hostnames before passing them on to gnutls for verification. * lisp/net/network-stream.el (network-stream-open-starttls): Ditto. * lisp/url/url-http.el (url-http--get-referer): Be IDNA-aware. (url-http-create-request): Don't de-Unicodify host names, because they may be IDNA names (that are later encoded). * lisp/url/url-util.el (url-domain): Be IDNA-aware when doing domain name computations. diff --git a/lisp/net/gnutls.el b/lisp/net/gnutls.el index 57ac26fc74..cea6c25112 100644 --- a/lisp/net/gnutls.el +++ b/lisp/net/gnutls.el @@ -154,12 +154,12 @@ trust and key files, and priority string." (cons 'gnutls-x509pki (gnutls-boot-parameters :type 'gnutls-x509pki - :hostname host)))))) + :hostname (puny-encode-domain host))))))) (if nowait process (gnutls-negotiate :process process :type 'gnutls-x509pki - :hostname host)))) + :hostname (puny-encode-domain host))))) (define-error 'gnutls-error "GnuTLS error") diff --git a/lisp/net/network-stream.el b/lisp/net/network-stream.el index f55f5486b6..19e0c6421f 100644 --- a/lisp/net/network-stream.el +++ b/lisp/net/network-stream.el @@ -295,7 +295,8 @@ gnutls-boot (as returned by `gnutls-boot-parameters')." (if (gnutls-available-p) (let ((cert (network-stream-certificate host service parameters))) (condition-case nil - (gnutls-negotiate :process stream :hostname host + (gnutls-negotiate :process stream + :hostname (puny-encode-domain host) :keylist (and cert (list cert))) ;; If we get a gnutls-specific error (for instance if ;; the certificate the server gives us is completely diff --git a/lisp/url/url-http.el b/lisp/url/url-http.el index 45e887b348..bb3e76997a 100644 --- a/lisp/url/url-http.el +++ b/lisp/url/url-http.el @@ -244,28 +244,29 @@ request.") (when url-current-lastloc (if (not (url-p url-current-lastloc)) (setq url-current-lastloc (url-generic-parse-url url-current-lastloc))) - (let* ((referer url-current-lastloc) - (referer-string (url-recreate-url referer))) - (when (and (not (memq url-privacy-level '(low high paranoid))) - (not (and (listp url-privacy-level) - (memq 'lastloc url-privacy-level)))) - ;; url-privacy-level allows referer. But url-lastloc-privacy-level - ;; may restrict who we send it to. - (cl-case url-lastloc-privacy-level - (host-match - (let ((referer-host (url-host referer)) - (url-host (url-host url))) - (when (string= referer-host url-host) - referer-string))) - (domain-match - (let ((referer-domain (url-domain referer)) - (url-domain (url-domain url))) - (when (and referer-domain - url-domain - (string= referer-domain url-domain)) - referer-string))) - (otherwise - referer-string)))))) + (let ((referer (copy-sequence url-current-lastloc))) + (setf (url-host referer) (puny-encode-domain (url-host referer))) + (let ((referer-string (url-recreate-url referer))) + (when (and (not (memq url-privacy-level '(low high paranoid))) + (not (and (listp url-privacy-level) + (memq 'lastloc url-privacy-level)))) + ;; url-privacy-level allows referer. But url-lastloc-privacy-level + ;; may restrict who we send it to. + (cl-case url-lastloc-privacy-level + (host-match + (let ((referer-host (url-host referer)) + (url-host (url-host url))) + (when (string= referer-host url-host) + referer-string))) + (domain-match + (let ((referer-domain (url-domain referer)) + (url-domain (url-domain url))) + (when (and referer-domain + url-domain + (string= referer-domain url-domain)) + referer-string))) + (otherwise + referer-string))))))) ;; Building an HTTP request (defun url-http-user-agent-string () @@ -298,7 +299,7 @@ as the Referer-header (subject to `url-privacy-level'." 'url-http-proxy-basic-auth-storage)) (url-get-authentication url-http-proxy nil 'any nil)))) (real-fname (url-filename url-http-target-url)) - (host (url-http--encode-string (url-host url-http-target-url))) + (host (url-host url-http-target-url)) (auth (if (cdr-safe (assoc "Authorization" url-http-extra-headers)) nil (url-get-authentication (or diff --git a/lisp/url/url-util.el b/lisp/url/url-util.el index 77e015068a..b206448480 100644 --- a/lisp/url/url-util.el +++ b/lisp/url/url-util.el @@ -645,7 +645,7 @@ not contain a registered name." ;; ;; Domain delegations change rarely enough that we won't bother with ;; cache invalidation, I think. - (let* ((host-parts (split-string (url-host url) "\\.")) + (let* ((host-parts (split-string (puny-encode-domain (url-host url)) "\\.")) (result (gethash host-parts url--domain-cache 'not-found))) (when (eq result 'not-found) (setq result commit f1450e9f348723d442d6faa57b685826ac557cc2 Author: Alan Mackenzie Date: Fri Apr 13 14:35:13 2018 +0000 Complete documentation of syntax flags by adding `c' * doc/lispref/syntax.texi ("Syntax Table Internals"): Add entry for `c' as `(1 lsh 23)'. diff --git a/doc/lispref/syntax.texi b/doc/lispref/syntax.texi index 3327d7855c..44a7730c7a 100644 --- a/doc/lispref/syntax.texi +++ b/doc/lispref/syntax.texi @@ -1018,7 +1018,7 @@ corresponds to each syntax flag. @item @samp{3} @tab @code{(lsh 1 18)} @tab @samp{n} @tab @code{(lsh 1 22)} @item -@samp{4} @tab @code{(lsh 1 19)} +@samp{4} @tab @code{(lsh 1 19)} @tab @samp{c} @tab @code{(lsh 1 23)} @end multitable @defun string-to-syntax desc commit 6bdcaec885fb1272617e7e02c6d1e571163b15f5 Author: Eli Zaretskii Date: Fri Apr 13 16:44:05 2018 +0300 Fix typos and minor wording issues in ELisp manual * doc/lispref/internals.texi (Writing Emacs Primitives): * doc/lispref/display.texi (Temporary Displays): Fix typos. * doc/lispref/text.texi (Filling, Changing Properties) (Transposition): Clarify and fix typos. * doc/lispref/positions.texi (Screen Lines): Improve wording. * doc/lispref/modes.texi (Minor Mode Conventions) (Font Lock Multiline): Fix typos. * doc/lispref/variables.texi (Dynamic Binding Tips): Fix a cross-reference. Fix a typo. * doc/lispref/sequences.texi (Sequence Functions): Fix typos. (Bug#31143) diff --git a/doc/lispref/internals.texi b/doc/lispref/internals.texi index 398ea8de85..e6043357a1 100644 --- a/doc/lispref/internals.texi +++ b/doc/lispref/internals.texi @@ -739,7 +739,7 @@ DEFUN ("foo", Ffoo, Sfoo, 0, UNEVALLED, 0 "(list (read-char-by-name \"Insert character: \")\ (prefix-numeric-value current-prefix-arg)\ t))", - doc: /* @dots{} /*) + doc: /* @dots{} */) @end group @end example @@ -769,7 +769,7 @@ this: @example @group DEFUN ("bar", Fbar, Sbar, 0, UNEVALLED, 0 - doc: /* @dots{} /* + doc: /* @dots{} */ attributes: @var{attr1} @var{attr2} @dots{}) @end group @end example diff --git a/doc/lispref/modes.texi b/doc/lispref/modes.texi index f1a00e72f3..8a77745d8f 100644 --- a/doc/lispref/modes.texi +++ b/doc/lispref/modes.texi @@ -1388,9 +1388,10 @@ similar to the code generated by the @code{define-minor-mode} macro): @example (interactive (list (or current-prefix-arg 'toggle))) -(let ((enable (if (eq arg 'toggle) - (not foo-mode) ; @r{this mode's mode variable} - (> (prefix-numeric-value arg) 0)))) +(let ((enable + (if (eq arg 'toggle) + (not foo-mode) ; @r{this is the mode's mode variable} + (> (prefix-numeric-value arg) 0)))) (if enable @var{do-enable} @var{do-disable})) @@ -3375,7 +3376,7 @@ easy to add the @code{font-lock-multiline} property by hand. The @code{font-lock-multiline} property is meant to ensure proper refontification; it does not automatically identify new multiline -constructs. Identifying the requires that Font Lock mode operate on +constructs. Identifying them requires that Font Lock mode operate on large enough chunks at a time. This will happen by accident on many cases, which may give the impression that multiline constructs magically work. If you set the @code{font-lock-multiline} variable diff --git a/doc/lispref/positions.texi b/doc/lispref/positions.texi index fdc8bb96ae..a09b6b6d09 100644 --- a/doc/lispref/positions.texi +++ b/doc/lispref/positions.texi @@ -569,9 +569,9 @@ The optional argument @var{cur-col} specifies the current column when the function is called. This is the window-relative horizontal coordinate of point, measured in units of font width of the frame's default face. Providing it speeds up the function, especially in very -long lines, because it doesn't have to go back in the buffer in order -to determine the current column. Note that @var{cur-col} is also -counted from the visual start of the line. +long lines, because the function doesn't have to go back in the buffer +in order to determine the current column. Note that @var{cur-col} is +also counted from the visual start of the line. @end defun @defun count-screen-lines &optional beg end count-final-newline window diff --git a/doc/lispref/sequences.texi b/doc/lispref/sequences.texi index 3a599e5f53..f347cd9e98 100644 --- a/doc/lispref/sequences.texi +++ b/doc/lispref/sequences.texi @@ -728,7 +728,7 @@ to every element of @var{sequence} returns non-@code{nil}. @result{} t @end group @group -(seq-some #'numberp [2 4 "6"]) +(seq-every-p #'numberp [2 4 "6"]) @result{} nil @end group @end example @@ -854,7 +854,7 @@ it is a function of two arguments to use instead of the default @code{equal}. @end group @group (seq-uniq '(1 2 2.0 1.0) #'=) -@result{} [1 2] +@result{} (1 2) @end group @end example @end defun diff --git a/doc/lispref/text.texi b/doc/lispref/text.texi index 0e1c9941e9..2db58f3123 100644 --- a/doc/lispref/text.texi +++ b/doc/lispref/text.texi @@ -1612,7 +1612,7 @@ that the line ends exactly at @code{fill-column}. It returns The argument @var{how}, if non-@code{nil} specifies explicitly the style of justification. It can be @code{left}, @code{right}, @code{full}, -@code{center}, or @code{none}. If it is @code{t}, that means to do +@code{center}, or @code{none}. If it is @code{t}, that means to follow specified justification style (see @code{current-justification}, below). @code{nil} means to do full justification. @@ -2976,7 +2976,7 @@ If any text in the region already has a non-@code{nil} @code{face} property, those face(s) are retained. This function sets the @code{face} property to a list of faces, with @var{face} as the first element (by default) and the pre-existing faces as the remaining elements. If the -optional argument @var{append} is non-@code{nil}, @var{face} is +optional argument @var{appendp} is non-@code{nil}, @var{face} is appended to the end of the list instead. Note that in a face list, the first occurring value for each attribute takes precedence. @@ -4297,10 +4297,10 @@ read register names use this function. This function can be used to transpose stretches of text: @defun transpose-regions start1 end1 start2 end2 &optional leave-markers -This function exchanges two nonoverlapping portions of the buffer. -Arguments @var{start1} and @var{end1} specify the bounds of one portion -and arguments @var{start2} and @var{end2} specify the bounds of the -other portion. +This function exchanges two nonoverlapping portions of the buffer (if +they overlap, the function signals an error). Arguments @var{start1} +and @var{end1} specify the bounds of one portion and arguments +@var{start2} and @var{end2} specify the bounds of the other portion. Normally, @code{transpose-regions} relocates markers with the transposed text; a marker previously positioned within one of the two transposed diff --git a/doc/lispref/variables.texi b/doc/lispref/variables.texi index 4d04335d83..af1bed461c 100644 --- a/doc/lispref/variables.texi +++ b/doc/lispref/variables.texi @@ -1004,12 +1004,13 @@ affect, nor be affected by, any uses of the same variable symbol elsewhere in the program. @item -Otherwise, define the variable with @code{defvar}, @code{defconst}, or -@code{defcustom}. @xref{Defining Variables}. Usually, the definition -should be at top-level in an Emacs Lisp file. As far as possible, it -should include a documentation string which explains the meaning and -purpose of the variable. You should also choose the variable's name -to avoid name conflicts (@pxref{Coding Conventions}). +Otherwise, define the variable with @code{defvar}, @code{defconst} +(@pxref{Defining Variables}), or @code{defcustom} (@pxref{Variable +Definitions}). Usually, the definition should be at top-level in an +Emacs Lisp file. As far as possible, it should include a +documentation string which explains the meaning and purpose of the +variable. You should also choose the variable's name to avoid name +conflicts (@pxref{Coding Conventions}). Then you can bind the variable anywhere in a program, knowing reliably what the effect will be. Wherever you encounter the variable, it will @@ -1024,7 +1025,7 @@ variables like @code{case-fold-search}: @group (defun search-for-abc () "Search for the string \"abc\", ignoring case differences." - (let ((case-fold-search nil)) + (let ((case-fold-search t)) (re-search-forward "abc"))) @end group @end example diff --git a/doc/lispref/windows.texi b/doc/lispref/windows.texi index 8d8877bdfd..f5de2fc90b 100644 --- a/doc/lispref/windows.texi +++ b/doc/lispref/windows.texi @@ -904,7 +904,7 @@ include mode and header line and a bottom divider, if any. If @var{window} is part of a horizontal combination and the value of the option @code{fit-window-to-buffer-horizontally} (see below) is -non-@code{nil}, this function adjusts @var{window}'s height. The new +non-@code{nil}, this function adjusts @var{window}'s width. The new width of @var{window} is calculated from the maximum length of its buffer's lines that follow the current start position of @var{window}. The optional argument @var{max-width} specifies a maximum width and commit 1fd104d30a8985e1f6962eb325207efad96273b6 Author: Lars Ingebrigtsen Date: Fri Apr 13 15:41:35 2018 +0200 Update defcustom version for last patch to url-vars.el * lisp/url/url-vars.el (url-lastloc-privacy-level): Update defcustom version. diff --git a/lisp/url/url-vars.el b/lisp/url/url-vars.el index 6ef21684a6..ef990a7588 100644 --- a/lisp/url/url-vars.el +++ b/lisp/url/url-vars.el @@ -170,7 +170,7 @@ domain-match -- Send last location if the new location is within the host-match -- Send last location if the new location is on the same host " - :version "26.1" + :version "27.1" :type '(radio (const :tag "Always send" none) (const :tag "Domains match" domain-match) (const :tag "Hosts match" host-match)) commit 013bb2097e7b269d0ff0fc0e0482e6d8de849620 Author: Lars Ingebrigtsen Date: Fri Apr 13 15:22:30 2018 +0200 Use a separate history for the eww prompt * lisp/net/eww.el (eww-prompt-history): A separate history variable for the interactive eww prompt. (eww): Use it. diff --git a/lisp/net/eww.el b/lisp/net/eww.el index 3f1a1aeae3..cb7390f472 100644 --- a/lisp/net/eww.el +++ b/lisp/net/eww.el @@ -218,6 +218,7 @@ See also `eww-form-checkbox-selected-symbol'." (defvar eww-data nil) (defvar eww-history nil) (defvar eww-history-position 0) +(defvar eww-prompt-history nil) (defvar eww-local-regex "localhost" "When this regex is found in the URL, it's not a keyword but an address.") @@ -250,7 +251,7 @@ word(s) will be searched for via `eww-search-prefix'." (prompt (concat "Enter URL or keywords" (if uris (format " (default %s)" (car uris)) "") ": "))) - (list (read-string prompt nil nil uris)))) + (list (read-string prompt nil 'eww-prompt-history uris)))) (setq url (eww--dwim-expand-url url)) (pop-to-buffer-same-window (if (eq major-mode 'eww-mode) commit 1f31c1348c4ddec31664e78f8cf4b9514d2a32c6 Author: Michael Albinus Date: Fri Apr 13 15:21:24 2018 +0200 Fix Bug#30246 * lisp/auth-source.el (auth-source-secrets-search): Do not suppress creation. (auth-source-secrets-create): Implement it. (Bug#30246) * lisp/net/secrets.el (secrets-debug): Set default to nil. * test/lisp/auth-source-tests.el (secrets): Require it. (auth-source-test-secrets-create-secret): New test. diff --git a/lisp/auth-source.el b/lisp/auth-source.el index 355c11fbf3..a2ed47a0d4 100644 --- a/lisp/auth-source.el +++ b/lisp/auth-source.el @@ -1514,9 +1514,6 @@ authentication tokens: " ;; TODO - (cl-assert (not create) nil - "The Secrets API auth-source backend doesn't support creation yet") - ;; TODO ;; (secrets-delete-item coll elt) (cl-assert (not delete) nil "The Secrets API auth-source backend doesn't support deletion yet") @@ -1576,12 +1573,168 @@ authentication tokens: returned-keys)) plist)) items))) + (cond + ;; if we need to create an entry AND none were found to match + ((and create + (not items)) + + ;; create based on the spec and record the value + (setq items (or + ;; if the user did not want to create the entry + ;; in the file, it will be returned + (apply (slot-value backend 'create-function) spec) + ;; if not, we do the search again without :create + ;; to get the updated data. + + ;; the result will be returned, even if the search fails + (apply #'auth-source-secrets-search + (plist-put spec :create nil)))))) items)) -(defun auth-source-secrets-create (&rest spec) - ;; TODO - ;; (apply 'secrets-create-item (auth-get-source entry) name passwd spec) - (debug spec)) +(cl-defun auth-source-secrets-create (&rest spec + &key backend host port create + &allow-other-keys) + (let* ((base-required '(host user port secret label)) + ;; we know (because of an assertion in auth-source-search) that the + ;; :create parameter is either t or a list (which includes nil) + (create-extra (if (eq t create) nil create)) + (current-data (car (auth-source-search :max 1 + :host host + :port port))) + (required (append base-required create-extra)) + (collection (oref backend source)) + ;; `args' are the arguments for `secrets-create-item'. + args + ;; `valist' is an alist + valist + ;; `artificial' will be returned if no creation is needed + artificial) + + ;; only for base required elements (defined as function parameters): + ;; fill in the valist with whatever data we may have from the search + ;; we complete the first value if it's a list and use the value otherwise + (dolist (br base-required) + (let ((val (plist-get spec (auth-source--symbol-keyword br)))) + (when val + (let ((br-choice (cond + ;; all-accepting choice (predicate is t) + ((eq t val) nil) + ;; just the value otherwise + (t val)))) + (when br-choice + (auth-source--aput valist br br-choice)))))) + + ;; for extra required elements, see if the spec includes a value for them + (dolist (er create-extra) + (let ((k (auth-source--symbol-keyword er)) + (keys (cl-loop for i below (length spec) by 2 + collect (nth i spec)))) + (when (memq k keys) + (auth-source--aput valist er (plist-get spec k))))) + + ;; for each required element + (dolist (r required) + (let* ((data (auth-source--aget valist r)) + ;; take the first element if the data is a list + (data (or (auth-source-netrc-element-or-first data) + (plist-get current-data + (auth-source--symbol-keyword r)))) + ;; this is the default to be offered + (given-default (auth-source--aget + auth-source-creation-defaults r)) + ;; the default supplementals are simple: + ;; for the user, try `given-default' and then (user-login-name); + ;; for the label, try `given-default' and then user@host; + ;; otherwise take `given-default' + (default (cond + ((and (not given-default) (eq r 'user)) + (user-login-name)) + ((and (not given-default) (eq r 'label)) + (format "%s@%s" + (or (auth-source-netrc-element-or-first + (auth-source--aget valist 'user)) + (plist-get artificial :user)) + (or (auth-source-netrc-element-or-first + (auth-source--aget valist 'host)) + (plist-get artificial :host)))) + (t given-default))) + (printable-defaults (list + (cons 'user + (or + (auth-source-netrc-element-or-first + (auth-source--aget valist 'user)) + (plist-get artificial :user) + "[any user]")) + (cons 'host + (or + (auth-source-netrc-element-or-first + (auth-source--aget valist 'host)) + (plist-get artificial :host) + "[any host]")) + (cons 'port + (or + (auth-source-netrc-element-or-first + (auth-source--aget valist 'port)) + (plist-get artificial :port) + "[any port]")) + (cons 'label + (or + (auth-source-netrc-element-or-first + (auth-source--aget valist 'label)) + (plist-get artificial :label) + "[any label]")))) + (prompt (or (auth-source--aget auth-source-creation-prompts r) + (cl-case r + (secret "%p password for %u@%h: ") + (user "%p user name for %h: ") + (host "%p host name for user %u: ") + (port "%p port for %u@%h: ") + (label "Enter label for %u@%h: ")) + (format "Enter %s (%%u@%%h:%%p): " r))) + (prompt (auth-source-format-prompt + prompt + `((?u ,(auth-source--aget printable-defaults 'user)) + (?h ,(auth-source--aget printable-defaults 'host)) + (?p ,(auth-source--aget printable-defaults 'port)))))) + + ;; Store the data, prompting for the password if needed. + (setq data (or data + (if (eq r 'secret) + (or (eval default) (read-passwd prompt)) + (if (stringp default) + (read-string (if (string-match ": *\\'" prompt) + (concat (substring prompt 0 (match-beginning 0)) + " (default " default "): ") + (concat prompt "(default " default ") ")) + nil nil default) + (eval default))))) + + (when data + (setq artificial (plist-put artificial + (auth-source--symbol-keyword r) + (if (eq r 'secret) + (let ((data data)) + (lambda () data)) + data)))) + + ;; When r is not an empty string... + (when (and (stringp data) + (< 0 (length data)) + (not (member r '(secret label)))) + ;; append the key (the symbol name of r) + ;; and the value in r + (setq args (append args (list (auth-source--symbol-keyword r) data)))))) + + (plist-put + artificial + :save-function + (let* ((collection collection) + (item (plist-get artificial :label)) + (secret (plist-get artificial :secret)) + (secret (if (functionp secret) (funcall secret) secret))) + (lambda () (apply 'secrets-create-item collection item secret args)))) + + (list artificial))) ;;; Backend specific parsing: Mac OS Keychain (using /usr/bin/security) backend diff --git a/lisp/net/secrets.el b/lisp/net/secrets.el index e5ab5b31ab..8070ccf96e 100644 --- a/lisp/net/secrets.el +++ b/lisp/net/secrets.el @@ -158,7 +158,7 @@ (defvar secrets-enabled nil "Whether there is a daemon offering the Secret Service API.") -(defvar secrets-debug t +(defvar secrets-debug nil "Write debug messages") (defconst secrets-service "org.freedesktop.secrets" diff --git a/test/lisp/auth-source-tests.el b/test/lisp/auth-source-tests.el index eb93f7488e..2f5a9320b1 100644 --- a/test/lisp/auth-source-tests.el +++ b/test/lisp/auth-source-tests.el @@ -29,9 +29,7 @@ (require 'ert) (require 'cl-lib) (require 'auth-source) - -(defvar secrets-enabled t - "Enable the secrets backend to test its features.") +(require 'secrets) (defun auth-source-ensure-ignored-backend (source) (auth-source-validate-backend source '((:source . "") @@ -289,5 +287,35 @@ (should (equal found-as-string (concat testname ": " needed))))) (delete-file netrc-file))) +(ert-deftest auth-source-test-secrets-create-secret () + (skip-unless secrets-enabled) + ;; The "session" collection is temporary for the lifetime of the + ;; Emacs process. Therefore, we don't care to delete it. + (let ((auth-sources '((:source (:secrets "session")))) + (host (md5 (concat (prin1-to-string process-environment) + (current-time-string)))) + (passwd (md5 (concat (prin1-to-string process-environment) + (current-time-string) (current-time-string)))) + auth-info auth-passwd) + ;; Redefine `read-*' in order to avoid interactive input. + (cl-letf (((symbol-function 'read-passwd) (lambda (_) passwd)) + ((symbol-function 'read-string) + (lambda (_prompt _initial _history default) default))) + (setq auth-info + (car (auth-source-search + :max 1 :host host :require '(:user :secret) :create t)))) + (should (functionp (plist-get auth-info :save-function))) + (funcall (plist-get auth-info :save-function)) + + ;; Check, that the item has been created indeed. + (auth-source-forget+ :host t) + (setq auth-info (car (auth-source-search :host host)) + auth-passwd (plist-get auth-info :secret) + auth-passwd (if (functionp auth-passwd) + (funcall auth-passwd) + auth-passwd)) + (should (string-equal (plist-get auth-info :user) (user-login-name))) + (should (string-equal auth-passwd passwd)))) + (provide 'auth-source-tests) ;;; auth-source-tests.el ends here commit 9822a6a5708227897432f47d3f676c646b7bd4b2 Author: Peder O. Klingenberg Date: Fri Apr 13 15:08:18 2018 +0200 Change gnutls-verify-error to be first-match * doc/misc/url.texi (Customization): Describe the new user option url-lastloc-privacy-level. * lisp/net/eww.el (eww-render): Set url-current-lastloc to the url we are rendering, to get the referer header right on subsequent requests. * lisp/url/url-http.el (url-http--get-referer): New function to determine which referer to send, if any, considering the users privacy settings and the target url we are visiting. (url-http-referer): New variable keeping track of the referer computed by url-http--get-referer (url-http-create-request): Use url-http-referer instead of the optional argument to set up the referer header. Leave checking of privacy settings to url-http--get-referer. (url-http): Set up url-http-referer by using url-http--get-referer. * lisp/url/url-queue.el (url-queue): New struct member context-buffer for keeping track of the context a queued job started from. (url-queue-retrieve): Store the current buffer in the queue object. (url-queue-start-retrieve): Make sure url-retrieve is called in the context of the original buffer, if available. * lisp/url/url-util.el (url-domain): New function to determine the domain of a given URL. * lisp/url/url-vars.el (url-current-lastloc): New variable to keep track of the desired "last location" (referer header). (url-lastloc-privacy-level): New custom setting for more fine-grained control over how lastloc (referer) is sent to servers (Bug#27012). diff --git a/doc/misc/url.texi b/doc/misc/url.texi index 1acf5f2319..fb0a55b3c8 100644 --- a/doc/misc/url.texi +++ b/doc/misc/url.texi @@ -1291,6 +1291,20 @@ It may also be a list of the types of messages to be logged. @end defopt @defopt url-privacy-level @end defopt +@defopt url-lastloc-privacy-level +Provided @code{lastloc} is not prohibited by @code{url-privacy-level}, +this determines who we send our last location to. @code{none} means +we include our last location in every outgoing request. +@code{domain-match} means we send it only if the domain of our last +location matches the domain of the URI we are requesting. +@code{host-match} means we only send our last location back to the +same host. The default is @code{domain-match}. + +Using @code{domain-match} for this option requires emacs to make one +or more DNS requests each time a new host is contacted, to determine +the domain of the host. Results of these lookups are cached, so +repeated visits do not require repeated domain lookups. +@end defopt @defopt url-uncompressor-alist @end defopt @defopt url-passwd-entry-func diff --git a/lisp/net/eww.el b/lisp/net/eww.el index 6b7fa05ded..3f1a1aeae3 100644 --- a/lisp/net/eww.el +++ b/lisp/net/eww.el @@ -272,7 +272,7 @@ word(s) will be searched for via `eww-search-prefix'." (insert (format "Loading %s..." url)) (goto-char (point-min))) (url-retrieve url 'eww-render - (list url nil (current-buffer)))) + (list url nil (current-buffer)))) (defun eww--dwim-expand-url (url) (setq url (string-trim url)) @@ -370,7 +370,10 @@ Currently this means either text/html or application/xhtml+xml." ;; Save the https peer status. (plist-put eww-data :peer (plist-get status :peer)) ;; Make buffer listings more informative. - (setq list-buffers-directory url)) + (setq list-buffers-directory url) + ;; Let the URL library have a handle to the current URL for + ;; referer purposes. + (setq url-current-lastloc (url-generic-parse-url url))) (unwind-protect (progn (cond diff --git a/lisp/url/url-http.el b/lisp/url/url-http.el index e2d7a50e29..45e887b348 100644 --- a/lisp/url/url-http.el +++ b/lisp/url/url-http.el @@ -54,6 +54,7 @@ (defvar url-http-target-url) (defvar url-http-transfer-encoding) (defvar url-show-status) +(defvar url-http-referer) (require 'url-gw) (require 'url-parse) @@ -238,6 +239,34 @@ request.") emacs-info os-info)) " "))) +(defun url-http--get-referer (url) + (url-http-debug "getting referer from buffer: buffer:%S target-url:%S lastloc:%S" (current-buffer) url url-current-lastloc) + (when url-current-lastloc + (if (not (url-p url-current-lastloc)) + (setq url-current-lastloc (url-generic-parse-url url-current-lastloc))) + (let* ((referer url-current-lastloc) + (referer-string (url-recreate-url referer))) + (when (and (not (memq url-privacy-level '(low high paranoid))) + (not (and (listp url-privacy-level) + (memq 'lastloc url-privacy-level)))) + ;; url-privacy-level allows referer. But url-lastloc-privacy-level + ;; may restrict who we send it to. + (cl-case url-lastloc-privacy-level + (host-match + (let ((referer-host (url-host referer)) + (url-host (url-host url))) + (when (string= referer-host url-host) + referer-string))) + (domain-match + (let ((referer-domain (url-domain referer)) + (url-domain (url-domain url))) + (when (and referer-domain + url-domain + (string= referer-domain url-domain)) + referer-string))) + (otherwise + referer-string)))))) + ;; Building an HTTP request (defun url-http-user-agent-string () "Compute a User-Agent string. @@ -254,8 +283,9 @@ The string is based on `url-privacy-level' and `url-user-agent'." ((eq url-user-agent 'default) (url-http--user-agent-default-string)))))) (if ua-string (format "User-Agent: %s\r\n" (string-trim ua-string)) ""))) -(defun url-http-create-request (&optional ref-url) - "Create an HTTP request for `url-http-target-url', referred to by REF-URL." +(defun url-http-create-request () + "Create an HTTP request for `url-http-target-url', using `url-http-referer' +as the Referer-header (subject to `url-privacy-level'." (let* ((extra-headers) (request nil) (no-cache (cdr-safe (assoc "Pragma" url-http-extra-headers))) @@ -274,7 +304,8 @@ The string is based on `url-privacy-level' and `url-user-agent'." (url-get-authentication (or (and (boundp 'proxy-info) proxy-info) - url-http-target-url) nil 'any nil)))) + url-http-target-url) nil 'any nil))) + (ref-url url-http-referer)) (if (equal "" real-fname) (setq real-fname "/")) (setq no-cache (and no-cache (string-match "no-cache" no-cache))) @@ -288,12 +319,6 @@ The string is based on `url-privacy-level' and `url-user-agent'." (string= ref-url ""))) (setq ref-url nil)) - ;; We do not want to expose the referrer if the user is paranoid. - (if (or (memq url-privacy-level '(low high paranoid)) - (and (listp url-privacy-level) - (memq 'lastloc url-privacy-level))) - (setq ref-url nil)) - ;; url-http-extra-headers contains an assoc-list of ;; header/value pairs that we need to put into the request. (setq extra-headers (mapconcat @@ -1264,7 +1289,8 @@ The return value of this function is the retrieval buffer." (mime-accept-string url-mime-accept-string) (buffer (or retry-buffer (generate-new-buffer - (format " *http %s:%d*" (url-host url) (url-port url)))))) + (format " *http %s:%d*" (url-host url) (url-port url))))) + (referer (url-http--get-referer url))) (if (not connection) ;; Failed to open the connection for some reason (progn @@ -1299,7 +1325,8 @@ The return value of this function is the retrieval buffer." url-http-no-retry url-http-connection-opened url-mime-accept-string - url-http-proxy)) + url-http-proxy + url-http-referer)) (set (make-local-variable var) nil)) (setq url-http-method (or url-request-method "GET") @@ -1317,7 +1344,8 @@ The return value of this function is the retrieval buffer." url-http-no-retry retry-buffer url-http-connection-opened nil url-mime-accept-string mime-accept-string - url-http-proxy url-using-proxy) + url-http-proxy url-using-proxy + url-http-referer referer) (set-process-buffer connection buffer) (set-process-filter connection 'url-http-generic-filter) diff --git a/lisp/url/url-queue.el b/lisp/url/url-queue.el index cd30d94a72..cfa8e9affe 100644 --- a/lisp/url/url-queue.el +++ b/lisp/url/url-queue.el @@ -52,7 +52,7 @@ (cl-defstruct url-queue url callback cbargs silentp buffer start-time pre-triggered - inhibit-cookiesp) + inhibit-cookiesp context-buffer) ;;;###autoload (defun url-queue-retrieve (url callback &optional cbargs silent inhibit-cookies) @@ -67,7 +67,8 @@ The variable `url-queue-timeout' sets a timeout." :callback callback :cbargs cbargs :silentp silent - :inhibit-cookiesp inhibit-cookies)))) + :inhibit-cookiesp inhibit-cookies + :context-buffer (current-buffer))))) (url-queue-setup-runners)) ;; To ensure asynch behavior, we start the required number of queue @@ -147,11 +148,14 @@ The variable `url-queue-timeout' sets a timeout." (defun url-queue-start-retrieve (job) (setf (url-queue-buffer job) (ignore-errors - (let ((url-request-noninteractive t)) - (url-retrieve (url-queue-url job) - #'url-queue-callback-function (list job) - (url-queue-silentp job) - (url-queue-inhibit-cookiesp job)))))) + (with-current-buffer (if (buffer-live-p (url-queue-context-buffer job)) + (url-queue-context-buffer job) + (current-buffer)) + (let ((url-request-noninteractive t)) + (url-retrieve (url-queue-url job) + #'url-queue-callback-function (list job) + (url-queue-silentp job) + (url-queue-inhibit-cookiesp job))))))) (defun url-queue-prune-old-entries () (let (dead-jobs) diff --git a/lisp/url/url-util.el b/lisp/url/url-util.el index 85bfb65cb6..77e015068a 100644 --- a/lisp/url/url-util.el +++ b/lisp/url/url-util.el @@ -627,6 +627,35 @@ Creates FILE and its parent directories if they do not exist." (error "Danger: `%s' is a symbolic link" file)) (set-file-modes file #o0600)))) +(autoload 'dns-query "dns") + +(defvar url--domain-cache (make-hash-table :test 'equal :size 17) + "Cache to minimize dns lookups.") + +;;;###autoload +(defun url-domain (url) + "Return the domain of the host of the url, or nil if url does +not contain a registered name." + ;; Determining the domain of a name can not be done with simple + ;; textual manipulations. a.b.c is either host a in domain b.c + ;; (www.google.com), or domain a.b.c with no separate host + ;; (bbc.co.uk). Instead of guessing based on tld (which in any case + ;; may be inaccurate in the face of subdelegations), we look for + ;; domain delegations in DNS. + ;; + ;; Domain delegations change rarely enough that we won't bother with + ;; cache invalidation, I think. + (let* ((host-parts (split-string (url-host url) "\\.")) + (result (gethash host-parts url--domain-cache 'not-found))) + (when (eq result 'not-found) + (setq result + (cl-loop for parts on host-parts + for dom = (mapconcat #'identity parts ".") + when (dns-query dom 'SOA) + return dom)) + (puthash host-parts result url--domain-cache)) + result)) + (provide 'url-util) ;;; url-util.el ends here diff --git a/lisp/url/url-vars.el b/lisp/url/url-vars.el index 62abcffe39..6ef21684a6 100644 --- a/lisp/url/url-vars.el +++ b/lisp/url/url-vars.el @@ -60,10 +60,18 @@ (defvar url-current-mime-headers nil "A parsed representation of the MIME headers for the current URL.") +(defvar url-current-lastloc nil + "A parsed representation of the URL to be considered as the last location. +Use of this value on outbound connections is subject to +`url-privacy-level' and `url-lastloc-privacy-level'. This is never set +by the url library, applications are expected to set this +variable in buffers representing a displayed location.") + (mapc 'make-variable-buffer-local '( url-current-object url-current-mime-headers + url-current-lastloc )) (defcustom url-honor-refresh-requests t @@ -117,7 +125,7 @@ Valid symbols are: email -- the email address os -- the operating system info emacs -- the version of Emacs -lastloc -- the last location +lastloc -- the last location (see also `url-lastloc-privacy-level') agent -- do not send the User-Agent string cookies -- never accept HTTP cookies @@ -150,6 +158,24 @@ variable." (const :tag "No cookies" :value cookie))) :group 'url) +(defcustom url-lastloc-privacy-level 'domain-match + "Further restrictions on sending the last location. +This value is only consulted if `url-privacy-level' permits +sending last location in the first place. + +Valid values are: +none -- Always send last location. +domain-match -- Send last location if the new location is within the + same domain +host-match -- Send last location if the new location is on the + same host +" + :version "26.1" + :type '(radio (const :tag "Always send" none) + (const :tag "Domains match" domain-match) + (const :tag "Hosts match" host-match)) + :group 'url) + (defvar url-inhibit-uncompression nil "Do not do decompression if non-nil.") (defcustom url-uncompressor-alist '((".z" . "x-gzip") commit fa416937997a113d84ab4e4910d730ce5d77613d Author: Lars Ingebrigtsen Date: Fri Apr 13 14:55:55 2018 +0200 Make #anchors work again in eww * lisp/net/eww.el (eww-render): When we have a #link link, then url.el will say that we have a redirect to a non-#link link, so get the anchor before url.el mangles the URL (bug#28441). (eww-display-html): ... and don't get it here, because it's gone by now. Test URL: http://www.gnu.org/s/hyperbole/#summary diff --git a/lisp/net/eww.el b/lisp/net/eww.el index 08a40cef18..6b7fa05ded 100644 --- a/lisp/net/eww.el +++ b/lisp/net/eww.el @@ -349,9 +349,6 @@ Currently this means either text/html or application/xhtml+xml." "application/xhtml+xml"))) (defun eww-render (status url &optional point buffer encode) - (let ((redirect (plist-get status :redirect))) - (when redirect - (setq url redirect))) (let* ((headers (eww-parse-headers)) (content-type (mail-header-parse-content-type @@ -364,7 +361,11 @@ Currently this means either text/html or application/xhtml+xml." (eww-detect-charset (eww-html-p (car content-type))) "utf-8")))) (data-buffer (current-buffer)) + (shr-target-id (url-target (url-generic-parse-url url))) last-coding-system-used) + (let ((redirect (plist-get status :redirect))) + (when redirect + (setq url redirect))) (with-current-buffer buffer ;; Save the https peer status. (plist-put eww-data :peer (plist-get status :peer)) @@ -460,7 +461,6 @@ Currently this means either text/html or application/xhtml+xml." (plist-put eww-data :dom document) (let ((inhibit-read-only t) (inhibit-modification-hooks t) - (shr-target-id (url-target (url-generic-parse-url url))) (shr-external-rendering-functions (append shr-external-rendering-functions commit febac2796b01b120476c9c38bfe1b32fb4f56f23 Merge: 6c2e21e1ca 60e10c5031 Author: Eli Zaretskii Date: Fri Apr 13 15:49:13 2018 +0300 Merge branch 'emacs-26' of git.savannah.gnu.org:/srv/git/emacs into emacs-26 commit 6c2e21e1cabfb9640320a043063c9a4761e58dec Author: Eli Zaretskii Date: Fri Apr 13 15:48:04 2018 +0300 Avoid segfault in processes of type 'pipe' * src/process.c (Fmake_pipe_process): Set up the decoding and encoding buffers. For the details, see http://lists.gnu.org/archive/html/emacs-devel/2018-04/msg00295.html. diff --git a/src/process.c b/src/process.c index b201e9b6ac..45ab1fd724 100644 --- a/src/process.c +++ b/src/process.c @@ -2461,6 +2461,10 @@ usage: (make-pipe-process &rest ARGS) */) /* This may signal an error. */ setup_process_coding_systems (proc); + pset_decoding_buf (p, empty_unibyte_string); + eassert (p->decoding_carryover == 0); + pset_encoding_buf (p, empty_unibyte_string); + specpdl_ptr = specpdl + specpdl_count; return proc; commit 0a719964238293abd34a500992b1df0cc750795e Author: Robert Pluim Date: Fri Apr 13 14:44:41 2018 +0200 Doc fix after previous gnutls patch * lisp/net/gnutls.el (gnutls-verify-error): Mention that the matching is first-match (bug#29977). diff --git a/lisp/net/gnutls.el b/lisp/net/gnutls.el index cce4962758..57ac26fc74 100644 --- a/lisp/net/gnutls.el +++ b/lisp/net/gnutls.el @@ -61,9 +61,9 @@ If the value is a list, it should have the form ((HOST-REGEX FLAGS...) (HOST-REGEX FLAGS...) ...) where each HOST-REGEX is a regular expression to be matched -against the hostname, and FLAGS is either t or a list of -one or more verification flags. The supported flags and the -corresponding conditions to be tested are: +against the hostname, on a first-match basis, and FLAGS is either +t or a list of one or more verification flags. The supported +flags and the corresponding conditions to be tested are: :trustfiles -- certificate must be issued by a trusted authority. :hostname -- hostname must match presented certificate's host name. commit d5cf7330fa72a81b779628c14a0a19f3fc180f22 Author: Robert Pluim Date: Fri Apr 13 14:24:11 2018 +0200 Change gnutls-verify-error to be first-match * lisp/net/gnutls.el (gnutls-boot-parameters): Convert to first-match for gnutls-verify-error rather than any-match (bug#29977). diff --git a/lisp/net/gnutls.el b/lisp/net/gnutls.el index 85c9308c0d..cce4962758 100644 --- a/lisp/net/gnutls.el +++ b/lisp/net/gnutls.el @@ -282,13 +282,9 @@ defaults to GNUTLS_VERIFY_ALLOW_X509_V1_CA_CRT." t) ;; if a list, look for hostname matches ((listp gnutls-verify-error) - (apply 'append - (mapcar - (lambda (check) - (when (string-match (nth 0 check) - hostname) - (nth 1 check))) - gnutls-verify-error))) + (cadr (cl-find-if #'(lambda (x) + (string-match (car x) hostname)) + gnutls-verify-error))) ;; else it's nil (t nil)))) (min-prime-bits (or min-prime-bits gnutls-min-prime-bits))) commit feb5b442f7c2db738b9c94069600c309061bc5b0 Author: Lars Ingebrigtsen Date: Fri Apr 13 14:21:31 2018 +0200 Mention the new `shr-selected-link' face diff --git a/etc/NEWS b/etc/NEWS index 554e5e2e9a..88deb77984 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -202,6 +202,13 @@ concept index in the Gnus manual for the `match-list' entry. +++ *** nil is no longer an allowed value for `mm-text-html-renderer'. +** eww/shr + +*** When opening external links in eww/shr (typically with the +`C-u RET' keystroke on a link), the link will be flashed with the new +`shr-selected-link' face to give the user feedback that the command +has been executed. + ** Htmlfontify *** The functions 'hfy-color', 'hfy-color-vals' and commit f51d3a83334f052024ca26c2bafd3ca8abca6a92 Author: Lars Ingebrigtsen Date: Fri Apr 13 14:19:47 2018 +0200 Clean up the double Gnus section diff --git a/etc/NEWS b/etc/NEWS index 12b72eb25b..554e5e2e9a 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -175,11 +175,6 @@ you don't need to set them in your early init file. *** New function 'package-activate-all'. -** Gnus - -*** A prefix argument to 'gnus-summary-limit-to-score' will limit reverse -Limit to articles with score at below. - ** Ecomplete *** The ecomplete sorting has changed to a decay-based algorithm. This can be controlled by the new `ecomplete-sort-predicate' variable. @@ -188,6 +183,11 @@ This can be controlled by the new `ecomplete-sort-predicate' variable. Of course it will still find it if you have it in ~/.ecompleterc ** Gnus + ++++ +*** A prefix argument to 'gnus-summary-limit-to-score' will limit reverse +Limit to articles with score at below. + *** The function 'gnus-score-find-favorite-words' has been renamed from 'gnus-score-find-favourite-words'. commit 4f4c7b8083b91633704b2d9c2c3ebbef8713060e Author: Lars Ingebrigtsen Date: Fri Apr 13 14:17:51 2018 +0200 When opening external links in eww, blink the link * lisp/net/eww.el (eww-follow-link): Ditto. * lisp/net/shr.el (shr-selected-link): New face (bug#25096). (shr--blink-link): New function to blink links. (shr--current-link-region): New utility function. (shr-browse-url): Use it to blink external links. Blinking the link allows the user to get immediate feedback that the action has been performed. Opening the external browser may take a while, and may not be obvious that is going on. diff --git a/lisp/net/eww.el b/lisp/net/eww.el index 10d9c47e8d..08a40cef18 100644 --- a/lisp/net/eww.el +++ b/lisp/net/eww.el @@ -1486,7 +1486,8 @@ If EXTERNAL is double prefix, browse in new buffer." ((string-match "^mailto:" url) (browse-url-mail url)) ((and (consp external) (<= (car external) 4)) - (funcall shr-external-browser url)) + (funcall shr-external-browser url) + (shr--blink-link)) ;; This is a #target url in the same page as the current one. ((and (url-target (url-generic-parse-url url)) (eww-same-page-p url (plist-get eww-data :url))) diff --git a/lisp/net/shr.el b/lisp/net/shr.el index e743f9d384..2dc1036e41 100644 --- a/lisp/net/shr.el +++ b/lisp/net/shr.el @@ -142,6 +142,11 @@ cid: URL as the argument.") "Font for link elements." :group 'shr) +(defface shr-selected-link + '((t (:inherit shr-link :background "red"))) + "Font for link elements." + :group 'shr) + (defvar shr-inhibit-images nil "If non-nil, inhibit loading images.") @@ -344,6 +349,30 @@ If the URL is already at the front of the kill ring act like (shr-probe-and-copy-url url) (shr-copy-url url))) +(defun shr--current-link-region () + (let ((current (get-text-property (point) 'shr-url)) + start) + (save-excursion + ;; Go to the beginning. + (while (and (not (bobp)) + (equal (get-text-property (point) 'shr-url) current)) + (forward-char -1)) + (unless (equal (get-text-property (point) 'shr-url) current) + (forward-char 1)) + (setq start (point)) + ;; Go to the end. + (while (and (not (eobp)) + (equal (get-text-property (point) 'shr-url) current)) + (forward-char 1)) + (list start (point))))) + +(defun shr--blink-link () + (let* ((region (shr--current-link-region)) + (overlay (make-overlay (car region) (cadr region)))) + (overlay-put overlay 'face 'shr-selected-link) + (run-at-time 1 nil (lambda () + (delete-overlay overlay))))) + (defun shr-next-link () "Skip to the next link." (interactive) @@ -950,7 +979,9 @@ the mouse click event." (browse-url-mail url)) (t (if external - (funcall shr-external-browser url) + (progn + (funcall shr-external-browser url) + (shr--blink-link)) (browse-url url)))))) (defun shr-save-contents (directory) commit c7abc5760bd18f082c9c028d3a5e108200d35d48 Author: Lars Ingebrigtsen Date: Fri Apr 13 13:40:29 2018 +0200 Tweak nnimap sequence numbers to avoid reuse * lisp/gnus/nnimap.el (nnimap-sequence): Start the sequence at a higher number to avoid reusing the sequence number used by `open-network-stream' (bug#30022). diff --git a/lisp/gnus/nnimap.el b/lisp/gnus/nnimap.el index 01d7948afb..65d40eba69 100644 --- a/lisp/gnus/nnimap.el +++ b/lisp/gnus/nnimap.el @@ -1865,7 +1865,7 @@ Return the server's response to the SELECT or EXAMINE command." (setq nnimap-connection-alist (delq entry nnimap-connection-alist)) nil)))) -(defvar nnimap-sequence 0) +(defvar nnimap-sequence 5) (defun nnimap-send-command (&rest args) (setf (nnimap-last-command-time nnimap-object) (current-time)) commit 60e10c503131f3088e901c7bbaaa53da816cf1e1 Author: Robert Pluim Date: Fri Apr 13 12:09:35 2018 +0200 Remove repetitions in documentation strings * lisp/bindings.el (right-word): Remove repetition (left-word): Likewise. * lisp/image-mode.el (image-mode-as-hex): Likewise. * lisp/cedet/semantic/tag-ls.el (semantic-tag-similar-p): Likewise. * lisp/textmodes/reftex-vars.el (reftex-view-crossref-extra): Likewise diff --git a/lisp/bindings.el b/lisp/bindings.el index e03b9e9a0c..3e202b9b78 100644 --- a/lisp/bindings.el +++ b/lisp/bindings.el @@ -807,7 +807,7 @@ and \\[backward-word], which see. Value is normally t. If an edge of the buffer or a field boundary is reached, point is left there -there and the function returns nil. Field boundaries are not noticed +and the function returns nil. Field boundaries are not noticed if `inhibit-field-text-motion' is non-nil." (interactive "^p") (if (eq (current-bidi-paragraph-direction) 'left-to-right) @@ -823,7 +823,7 @@ and \\[forward-word], which see. Value is normally t. If an edge of the buffer or a field boundary is reached, point is left there -there and the function returns nil. Field boundaries are not noticed +and the function returns nil. Field boundaries are not noticed if `inhibit-field-text-motion' is non-nil." (interactive "^p") (if (eq (current-bidi-paragraph-direction) 'left-to-right) diff --git a/lisp/cedet/semantic/tag-ls.el b/lisp/cedet/semantic/tag-ls.el index b9cce17669..39a4d9542e 100644 --- a/lisp/cedet/semantic/tag-ls.el +++ b/lisp/cedet/semantic/tag-ls.el @@ -134,7 +134,7 @@ By default, `semantic-tag-similar-ignorable-attributes' is referenced for attributes, and IGNORABLE-ATTRIBUTES will augment this list. Note that even though :name is not an attribute, it can be used to -to indicate lax comparison of names via `semantic--tag-similar-names-p'") +indicate lax comparison of names via `semantic--tag-similar-names-p'") ;; Note: optional thing is because overloadable fcns don't handle this ;; quite right. diff --git a/lisp/image-mode.el b/lisp/image-mode.el index 1052ed9761..c0186f07a1 100644 --- a/lisp/image-mode.el +++ b/lisp/image-mode.el @@ -676,7 +676,7 @@ displays an image file as hex. `image-minor-mode' provides the key to display an image file as the actual image. You can use `image-mode-as-hex' in `auto-mode-alist' when you want to -to display an image file as hex initially. +display an image file as hex initially. See commands `image-mode' and `image-minor-mode' for more information on these modes." diff --git a/lisp/textmodes/reftex-vars.el b/lisp/textmodes/reftex-vars.el index 01ee4f5fa4..11dbb8d570 100644 --- a/lisp/textmodes/reftex-vars.el +++ b/lisp/textmodes/reftex-vars.el @@ -1616,7 +1616,7 @@ viewing can be useful. Each entry has the structure MACRO-RE is matched against the macro. SEARCH-RE is the regexp used to search for cross references. `%s' in this regexp is replaced with -with the macro argument at point. HIGHLIGHT is an integer indicating +the macro argument at point. HIGHLIGHT is an integer indicating which subgroup of the match should be highlighted." :group 'reftex-viewing-cross-references :type '(repeat (group (regexp :tag "Macro Regexp ") commit 208e7520b64e6c65a33a3c68acf6f9b22ff69ffc Author: Eli Zaretskii Date: Thu Apr 12 15:44:06 2018 +0300 * lisp/image.el (image-load-path): Doc fix. diff --git a/lisp/image.el b/lisp/image.el index b021edb33d..db820949ed 100644 --- a/lisp/image.el +++ b/lisp/image.el @@ -115,6 +115,9 @@ told that the data would have the associated suffix if saved to a file.") (list (file-name-as-directory (expand-file-name "images" data-directory)) 'data-directory 'load-path) "List of locations in which to search for image files. +The images for icons shown in the tool bar are also looked up +in these locations. + If an element is a string, it defines a directory to search. If an element is a variable symbol whose value is a string, that value defines a directory to search. commit 92e0fd880c2d9689b89e13d317356c3ad00c7325 Author: Eli Zaretskii Date: Tue Apr 10 18:25:27 2018 +0300 ; * etc/NEWS: Remove a FIXME. (Bug#31122) diff --git a/etc/NEWS b/etc/NEWS index 823882c5c6..4b1f673a7c 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1375,10 +1375,9 @@ gets evaluated after the new mode's hook has run. This can be used to incorporate configuration changes made in the mode hook into the mode's setup. -** Autoload files can be generated without timestamps, -by setting 'autoload-timestamps' to nil. -FIXME As an experiment, nil is the current default. -If no insurmountable problems before next release, it can stay that way. +** Autoload files are now generated without timestamps. +Set 'autoload-timestamps' to a non-nil value to get timestamps in +autoload files. ** 'gnutls-boot' now takes a parameter ':complete-negotiation' that says that negotiation should complete even on non-blocking sockets.