commit a8627008abe4ab339df19b417776da28b3ce0fc7 Author: Lars Ingebrigtsen Date: Fri Dec 25 08:31:10 2015 +0100 More eww file name coding fixes * eww.el (eww-decode-url-file-name): Use the base coding system to check for encodability. diff --git a/lisp/net/eww.el b/lisp/net/eww.el index 091a4ae..593ed22 100644 --- a/lisp/net/eww.el +++ b/lisp/net/eww.el @@ -1430,8 +1430,8 @@ Differences in #targets are ignored." (car (detect-coding-string binary)))))) (encodes (find-coding-systems-string decoded))) (if (or (equal encodes '(undecided)) - (memq (or file-name-coding-system - default-file-name-coding-system) + (memq (coding-system-base (or file-name-coding-system + default-file-name-coding-system)) encodes)) decoded ;; If we can't encode the decoded file name (due to language commit 2a0f18d9b6ce0ccce3d9c4a4a3b5743bae71b41e Author: Lars Ingebrigtsen Date: Fri Dec 25 07:56:08 2015 +0100 Always save eww history * eww.el (eww-setup-buffer): Always save history, even when called from outside the eww buffer (bug#19638). diff --git a/lisp/net/eww.el b/lisp/net/eww.el index 620913f..091a4ae 100644 --- a/lisp/net/eww.el +++ b/lisp/net/eww.el @@ -274,17 +274,13 @@ word(s) will be searched for via `eww-search-prefix'." (setq url (concat url "/")))) (setq url (concat eww-search-prefix (replace-regexp-in-string " " "+" url)))))) - (if (eq major-mode 'eww-mode) - (when (or (plist-get eww-data :url) - (plist-get eww-data :dom)) - (eww-save-history)) - (eww-setup-buffer) - (plist-put eww-data :url url) - (plist-put eww-data :title "") - (eww-update-header-line-format) - (let ((inhibit-read-only t)) - (insert (format "Loading %s..." url)) - (goto-char (point-min)))) + (eww-setup-buffer) + (plist-put eww-data :url url) + (plist-put eww-data :title "") + (eww-update-header-line-format) + (let ((inhibit-read-only t)) + (insert (format "Loading %s..." url)) + (goto-char (point-min))) (url-retrieve url 'eww-render (list url nil (current-buffer)))) @@ -540,6 +536,9 @@ Currently this means either text/html or application/xhtml+xml." (defun eww-setup-buffer () (switch-to-buffer (get-buffer-create "*eww*")) + (when (or (plist-get eww-data :url) + (plist-get eww-data :dom)) + (eww-save-history)) (let ((inhibit-read-only t)) (remove-overlays) (erase-buffer)) commit 9e089ec8a380ec3758fcf1564c5f86dc92c68c2a Author: Lars Ingebrigtsen Date: Fri Dec 25 07:45:27 2015 +0100 Default web pages to right-to-left * eww.el (eww-mode): Most web pages are left-to-right, so make that the default (bug#19801). * shr.el (shr-tag-html): Respect "dir" attributes (left-to-right, right-to-left). diff --git a/lisp/net/eww.el b/lisp/net/eww.el index 65ff733..620913f 100644 --- a/lisp/net/eww.el +++ b/lisp/net/eww.el @@ -717,7 +717,8 @@ the like." (setq-local desktop-save-buffer #'eww-desktop-misc-data) ;; multi-page isearch support (setq-local multi-isearch-next-buffer-function #'eww-isearch-next-buffer) - (setq truncate-lines t) + (setq truncate-lines t + bidi-paragraph-direction 'left-to-right) (buffer-disable-undo) (setq buffer-read-only t)) diff --git a/lisp/net/shr.el b/lisp/net/shr.el index 905c9c5..a7fdf9e 100644 --- a/lisp/net/shr.el +++ b/lisp/net/shr.el @@ -1109,6 +1109,15 @@ ones, in case fg and bg are nil." ;;; Tag-specific rendering rules. +(defun shr-tag-html (dom) + (let ((dir (dom-attr dom 'dir))) + (cond + ((equal dir "ltr") + (setq bidi-paragraph-direction 'left-to-right)) + ((equal dir "rtl") + (setq bidi-paragraph-direction 'right-to-left)))) + (shr-generic dom)) + (defun shr-tag-body (dom) (let* ((start (point)) (fgcolor (or (dom-attr dom 'fgcolor) (dom-attr dom 'text))) commit 5e56f606952e5e81b4d3a93ea70e791b74b33041 Author: Lars Ingebrigtsen Date: Fri Dec 25 06:47:28 2015 +0100 Make toggling checkboxes work again * eww.el (eww-update-field): Make toggling checkboxes work again (bug#21881). diff --git a/lisp/net/eww.el b/lisp/net/eww.el index 8ea17e0..65ff733 100644 --- a/lisp/net/eww.el +++ b/lisp/net/eww.el @@ -1181,16 +1181,19 @@ See URL `https://developer.mozilla.org/en-US/docs/Web/HTML/Element/Input'.") (eww-update-field display)))) (defun eww-update-field (string &optional offset) - (if (not offset) (setq offset 0)) + (unless offset + (setq offset 0)) (let ((properties (text-properties-at (point))) (start (+ (eww-beginning-of-field) offset)) (current-end (1+ (eww-end-of-field))) - (new-end (1+ (+ (eww-beginning-of-field) (length string))))) + (new-end (+ (eww-beginning-of-field) (length string))) + (inhibit-read-only t)) (delete-region start current-end) (forward-char offset) (insert string (make-string (- (- (+ new-end offset) start) (length string)) ? )) - (if (= 0 offset) (set-text-properties start new-end properties)) + (when (= 0 offset) + (set-text-properties start new-end properties)) start)) (defun eww-toggle-checkbox () commit 9f0fd7cb1aec3eb9e2e0f7b8854c30870286d96c Author: Lars Ingebrigtsen Date: Fri Dec 25 06:33:25 2015 +0100 Don't store cookies with empty names * lisp/url/url-cookie.el (url-cookie-store): Refuse to store cookies with empty names (bug#21936). diff --git a/lisp/url/url-cookie.el b/lisp/url/url-cookie.el index df9cf62..1f8ddfd 100644 --- a/lisp/url/url-cookie.el +++ b/lisp/url/url-cookie.el @@ -119,41 +119,42 @@ telling Microsoft that." (defun url-cookie-store (name value &optional expires domain localpart secure) "Store a cookie." - (let ((storage (if secure url-cookie-secure-storage url-cookie-storage)) - tmp found-domain) - ;; First, look for a matching domain. - (if (setq found-domain (assoc domain storage)) - ;; Need to either stick the new cookie in existing domain storage - ;; or possibly replace an existing cookie if the names match. - (unless (dolist (cur (setq storage (cdr found-domain)) tmp) - (and (equal localpart (url-cookie-localpart cur)) - (equal name (url-cookie-name cur)) - (progn - (setf (url-cookie-expires cur) expires) - (setf (url-cookie-value cur) value) - (setq tmp t)))) - ;; New cookie. - (setcdr found-domain (cons - (url-cookie-create :name name - :value value - :expires expires - :domain domain - :localpart localpart - :secure secure) - (cdr found-domain)))) - ;; Need to add a new top-level domain. - (setq tmp (url-cookie-create :name name - :value value - :expires expires - :domain domain - :localpart localpart - :secure secure)) - (cond (storage - (setcdr storage (cons (list domain tmp) (cdr storage)))) - (secure - (setq url-cookie-secure-storage (list (list domain tmp)))) - (t - (setq url-cookie-storage (list (list domain tmp)))))))) + (when (> (length name) 0) + (let ((storage (if secure url-cookie-secure-storage url-cookie-storage)) + tmp found-domain) + ;; First, look for a matching domain. + (if (setq found-domain (assoc domain storage)) + ;; Need to either stick the new cookie in existing domain storage + ;; or possibly replace an existing cookie if the names match. + (unless (dolist (cur (setq storage (cdr found-domain)) tmp) + (and (equal localpart (url-cookie-localpart cur)) + (equal name (url-cookie-name cur)) + (progn + (setf (url-cookie-expires cur) expires) + (setf (url-cookie-value cur) value) + (setq tmp t)))) + ;; New cookie. + (setcdr found-domain (cons + (url-cookie-create :name name + :value value + :expires expires + :domain domain + :localpart localpart + :secure secure) + (cdr found-domain)))) + ;; Need to add a new top-level domain. + (setq tmp (url-cookie-create :name name + :value value + :expires expires + :domain domain + :localpart localpart + :secure secure)) + (cond (storage + (setcdr storage (cons (list domain tmp) (cdr storage)))) + (secure + (setq url-cookie-secure-storage (list (list domain tmp)))) + (t + (setq url-cookie-storage (list (list domain tmp))))))))) (defun url-cookie-expired-p (cookie) "Return non-nil if COOKIE is expired." commit 248da292fe46224b0b5a79b632c89cf4de2c2081 Author: Lars Ingebrigtsen Date: Fri Dec 25 06:19:34 2015 +0100 Stop rendering HTML before specdlr exhaustion Fixes: 22117 * shr.el (shr-descend): Stop rendering before we run out of specpdl room (bug#22117). diff --git a/lisp/net/shr.el b/lisp/net/shr.el index 8a3f73e..905c9c5 100644 --- a/lisp/net/shr.el +++ b/lisp/net/shr.el @@ -432,8 +432,8 @@ size, and full-buffer size." (shr-stylesheet shr-stylesheet) (shr-depth (1+ shr-depth)) (start (point))) - ;; shr uses about 12 frames per nested node. - (if (> shr-depth (/ max-specpdl-size 12)) + ;; shr uses many frames per nested node. + (if (> shr-depth (/ max-specpdl-size 15)) (setq shr-warning "Too deeply nested to render properly; consider increasing `max-specpdl-size'") (when style (if (string-match "color\\|display\\|border-collapse" style) commit fe4606f93b91ff3d046aee0cf21ecc277af7a786 Author: Lars Ingebrigtsen Date: Fri Dec 25 06:04:01 2015 +0100 Use cl-reduce, not reduce. diff --git a/lisp/net/shr.el b/lisp/net/shr.el index 0b1a4da..8a3f73e 100644 --- a/lisp/net/shr.el +++ b/lisp/net/shr.el @@ -1588,8 +1588,8 @@ The preference is a float determined from `shr-prefer-media-type'." (car tbodies)) (t ;; Table with multiple tbodies. Convert into a single tbody. - `(tbody nil - ,@(reduce 'append (mapcar 'dom-non-text-children tbodies))))))) + `(tbody nil ,@(cl-reduce 'append + (mapcar 'dom-non-text-children tbodies))))))) (defun shr-tag-table (dom) (shr-ensure-paragraph) commit cdaf33029d6620073833876d76056045ecfbc7c4 Author: Lars Ingebrigtsen Date: Fri Dec 25 06:01:19 2015 +0100 Allow several tags in shr * shr.el (shr-table-body): New function to find the real body of a table. (shr-tag-table): Use it to render several tags in a table (bug#22170). diff --git a/lisp/net/shr.el b/lisp/net/shr.el index 2389952..0b1a4da 100644 --- a/lisp/net/shr.el +++ b/lisp/net/shr.el @@ -1579,12 +1579,23 @@ The preference is a float determined from `shr-prefer-media-type'." ;; Then render the table again with these new "hard" widths. (shr-insert-table (shr-make-table dom sketch-widths t) sketch-widths))) +(defun shr-table-body (dom) + (let ((tbodies (dom-by-tag dom 'tbody))) + (cond + ((null tbodies) + dom) + ((= (length tbodies) 1) + (car tbodies)) + (t + ;; Table with multiple tbodies. Convert into a single tbody. + `(tbody nil + ,@(reduce 'append (mapcar 'dom-non-text-children tbodies))))))) + (defun shr-tag-table (dom) (shr-ensure-paragraph) (let* ((caption (dom-children (dom-child-by-tag dom 'caption))) (header (dom-non-text-children (dom-child-by-tag dom 'thead))) - (body (dom-non-text-children (or (dom-child-by-tag dom 'tbody) - dom))) + (body (dom-non-text-children (shr-table-body dom))) (footer (dom-non-text-children (dom-child-by-tag dom 'tfoot))) (bgcolor (dom-attr dom 'bgcolor)) (start (point)) commit edfdd0a6cbdfa9e5e4bd0553e2b489401ca39266 Author: Lars Ingebrigtsen Date: Thu Dec 24 22:47:58 2015 +0100 Make prettier unique file names in eww (eww-make-unique-file-name): Make unique file names by making files like foo(2).jpg instead of foo(1)(2).jpg. diff --git a/lisp/net/eww.el b/lisp/net/eww.el index d560636..8ea17e0 100644 --- a/lisp/net/eww.el +++ b/lisp/net/eww.el @@ -1442,13 +1442,14 @@ Differences in #targets are ignored." (setq file "!")) ((string-match "\\`[.]" file) (setq file (concat "!" file)))) - (let ((count 1)) + (let ((count 1) + (stem file) + (suffix "")) + (when (string-match "\\`\\(.*\\)\\([.][^.]+\\)" file) + (setq stem (match-string 1) + suffix (match-string 2))) (while (file-exists-p (expand-file-name file directory)) - (setq file - (if (string-match "\\`\\(.*\\)\\([.][^.]+\\)" file) - (format "%s(%d)%s" (match-string 1 file) - count (match-string 2 file)) - (format "%s(%d)" file count))) + (setq file (format "%s(%d)%s" stem count suffix)) (setq count (1+ count))) (expand-file-name file directory))) commit af22a010d87516c2a646572fb27512c03057784f Author: Lars Ingebrigtsen Date: Thu Dec 24 22:21:24 2015 +0100 Decode hex-encoded URLs before using them as file names * eww.el (eww-decode-url-file-name): New function. (eww-download-callback): Use it to decode file names before saving them. diff --git a/lisp/net/eww.el b/lisp/net/eww.el index 2224b2e..d560636 100644 --- a/lisp/net/eww.el +++ b/lisp/net/eww.el @@ -1404,13 +1404,38 @@ Differences in #targets are ignored." (unless (plist-get status :error) (let* ((obj (url-generic-parse-url url)) (path (car (url-path-and-query obj))) - (file (eww-make-unique-file-name (file-name-nondirectory path) - eww-download-directory))) + (file (eww-make-unique-file-name + (eww-decode-url-file-name (file-name-nondirectory path)) + eww-download-directory))) (goto-char (point-min)) (re-search-forward "\r?\n\r?\n") (write-region (point) (point-max) file) (message "Saved %s" file)))) +(defun eww-decode-url-file-name (string) + (let* ((binary (url-unhex-string string)) + (decoded + (decode-coding-string + binary + ;; Possibly set by `universal-coding-system-argument'. + (or coding-system-for-read + ;; RFC 3986 says that %AB stuff is utf-8. + (if (equal (decode-coding-string binary 'utf-8) + '(unicode)) + 'utf-8 + ;; But perhaps not. + (car (detect-coding-string binary)))))) + (encodes (find-coding-systems-string decoded))) + (if (or (equal encodes '(undecided)) + (memq (or file-name-coding-system + default-file-name-coding-system) + encodes)) + decoded + ;; If we can't encode the decoded file name (due to language + ;; environment settings), then we return the original, hexified + ;; string. + string))) + (defun eww-make-unique-file-name (file directory) (cond ((zerop (length file)) commit 60c0f1a18ad88d6dc1a8f4ee5d9d18940eaeb6f7 Author: Ashish SHUKLA Date: Thu Dec 24 18:54:41 2015 +0100 Add FreeBSD cert bundle * doc/misc/emacs-gnutls.texi (Help For Users): Document FreeBSD bundle. * lisp/net/gnutls.el (gnutls-trustfiles): Add FreeBSD cert bundle. diff --git a/doc/misc/emacs-gnutls.texi b/doc/misc/emacs-gnutls.texi index 4f6ef01..d951e2f 100644 --- a/doc/misc/emacs-gnutls.texi +++ b/doc/misc/emacs-gnutls.texi @@ -123,14 +123,15 @@ The @code{gnutls-trustfiles} variable is a list of trustfiles host name (although @code{gnutls-negotiate} supports a trustfile per connection so it could be done if needed). The trustfiles can be in PEM or DER format and examples can be found in most Unix -distributions. By default four locations are tried in this order: -@file{/etc/ssl/certs/ca-certificates.crt} for Debian, Ubuntu, Gentoo -and Arch Linux; @file{/etc/pki/tls/certs/ca-bundle.crt} for Fedora -and RHEL; @file{/etc/ssl/ca-bundle.pem} for Suse; -@file{/usr/ssl/certs/ca-bundle.crt} for Cygwin. You can easily -customize @code{gnutls-trustfiles} to be something else, but let us -know if you do, so we can make the change to benefit the other users -of that platform. +distributions. By default the following locations are tried in this +order: @file{/etc/ssl/certs/ca-certificates.crt} for Debian, Ubuntu, +Gentoo and Arch Linux; @file{/etc/pki/tls/certs/ca-bundle.crt} for +Fedora and RHEL; @file{/etc/ssl/ca-bundle.pem} for Suse; +@file{/usr/ssl/certs/ca-bundle.crt} for Cygwin; +@file{/usr/local/share/certs/ca-root-nss.crt} for FreeBSD. You can +easily customize @code{gnutls-trustfiles} to be something else, but +let us know if you do, so we can make the change to benefit the other +users of that platform. @end defvar @defvar gnutls-verify-error diff --git a/lisp/net/gnutls.el b/lisp/net/gnutls.el index 479c9a5..ccaef8a 100644 --- a/lisp/net/gnutls.el +++ b/lisp/net/gnutls.el @@ -67,10 +67,11 @@ set this variable to \"normal:-dhe-rsa\"." (defcustom gnutls-trustfiles '( - "/etc/ssl/certs/ca-certificates.crt" ; Debian, Ubuntu, Gentoo and Arch Linux - "/etc/pki/tls/certs/ca-bundle.crt" ; Fedora and RHEL - "/etc/ssl/ca-bundle.pem" ; Suse - "/usr/ssl/certs/ca-bundle.crt" ; Cygwin + "/etc/ssl/certs/ca-certificates.crt" ; Debian, Ubuntu, Gentoo and Arch Linux + "/etc/pki/tls/certs/ca-bundle.crt" ; Fedora and RHEL + "/etc/ssl/ca-bundle.pem" ; Suse + "/usr/ssl/certs/ca-bundle.crt" ; Cygwin + "/usr/local/share/certs/ca-root-nss.crt" ; FreeBSD ) "List of CA bundle location filenames or a function returning said list. The files may be in PEM or DER format, as per the GnuTLS documentation. commit 45ebbc0301c8514a5f3215f45981c787cb26f915 Author: Lars Ingebrigtsen Date: Thu Dec 24 17:34:31 2015 +0100 Allow overriding shr functions from eww * eww.el (eww-display-html): Allow overriding elements in `shr-external-rendering-functions'. diff --git a/lisp/net/eww.el b/lisp/net/eww.el index 5748e88..2224b2e 100644 --- a/lisp/net/eww.el +++ b/lisp/net/eww.el @@ -411,13 +411,15 @@ Currently this means either text/html or application/xhtml+xml." (inhibit-modification-hooks t) (shr-target-id (url-target (url-generic-parse-url url))) (shr-external-rendering-functions - '((title . eww-tag-title) - (form . eww-tag-form) - (input . eww-tag-input) - (textarea . eww-tag-textarea) - (select . eww-tag-select) - (link . eww-tag-link) - (a . eww-tag-a)))) + (append + shr-external-rendering-functions + '((title . eww-tag-title) + (form . eww-tag-form) + (input . eww-tag-input) + (textarea . eww-tag-textarea) + (select . eww-tag-select) + (link . eww-tag-link) + (a . eww-tag-a))))) (erase-buffer) (shr-insert-document document) (cond diff --git a/lisp/net/shr.el b/lisp/net/shr.el index d51b8c7..2389952 100644 --- a/lisp/net/shr.el +++ b/lisp/net/shr.el @@ -135,6 +135,14 @@ cid: URL as the argument.") (defvar shr-inhibit-images nil "If non-nil, inhibit loading images.") +(defvar shr-external-rendering-functions nil + "Alist of tag/function pairs used to alter how shr renders certain tags. +For instance, eww uses this to alter rendering of title, forms +and other things: +((title . eww-tag-title) + (form . eww-tag-form) + ...)") + ;;; Internal variables. (defvar shr-folding-mode nil) @@ -150,7 +158,6 @@ cid: URL as the argument.") (defvar shr-depth 0) (defvar shr-warning nil) (defvar shr-ignore-cache nil) -(defvar shr-external-rendering-functions nil) (defvar shr-target-id nil) (defvar shr-table-separator-length 1) (defvar shr-table-separator-pixel-width 0) commit 821107d53c2e390240d25c036b99ebbf9b4a93b6 Author: Lars Ingebrigtsen Date: Thu Dec 24 14:40:16 2015 +0100 Ignore invalid SVG images * shr.el (shr-tag-svg): Ignore SVG images that have no width or height, because these can't be displayed by ImageMagick, anyway. diff --git a/lisp/net/shr.el b/lisp/net/shr.el index dbf45b8..d51b8c7 100644 --- a/lisp/net/shr.el +++ b/lisp/net/shr.el @@ -1152,7 +1152,9 @@ ones, in case fg and bg are nil." (defun shr-tag-svg (dom) (when (and (image-type-available-p 'svg) - (not shr-inhibit-images)) + (not shr-inhibit-images) + (dom-attr dom 'width) + (dom-attr dom 'height)) (funcall shr-put-image-function (list (shr-dom-to-xml dom) 'image/svg+xml) "SVG Image"))) commit b05471e42c17e02c56c87d7599ada0c124a5fe09 Author: Lars Ingebrigtsen Date: Thu Dec 24 14:00:38 2015 +0100 shr table rendering fix * shr.el (shr-tag-table): Allow rendering body-less tables that have headers. diff --git a/lisp/net/shr.el b/lisp/net/shr.el index a48d098..dbf45b8 100644 --- a/lisp/net/shr.el +++ b/lisp/net/shr.el @@ -1582,7 +1582,7 @@ The preference is a float determined from `shr-prefer-media-type'." (shr-stylesheet (nconc (list (cons 'background-color bgcolor)) shr-stylesheet)) (nheader (if header (shr-max-columns header))) - (nbody (if body (shr-max-columns body))) + (nbody (if body (shr-max-columns body) 0)) (nfooter (if footer (shr-max-columns footer)))) (if (and (not caption) (not header)