X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/294127e7d59a5d23a32561716a1b192db410e12f..0e963201d03d9229bb8ac4323291d2b0119526ed:/lisp/net/eww.el diff --git a/lisp/net/eww.el b/lisp/net/eww.el index ec7a0baacf..48bf556a52 100644 --- a/lisp/net/eww.el +++ b/lisp/net/eww.el @@ -1,6 +1,6 @@ ;;; eww.el --- Emacs Web Wowser -*- lexical-binding:t -*- -;; Copyright (C) 2013-2015 Free Software Foundation, Inc. +;; Copyright (C) 2013-2016 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Keywords: html @@ -49,7 +49,7 @@ :type 'string) (defcustom eww-search-prefix "https://duckduckgo.com/html/?q=" - "Prefix URL to search engine" + "Prefix URL to search engine." :version "24.4" :group 'eww :type 'string) @@ -60,6 +60,7 @@ :group 'eww :type 'string) +;;;###autoload (defcustom eww-suggest-uris '(eww-links-at-point url-get-url-at-point @@ -92,7 +93,7 @@ desktop. Otherwise, such entries will be retained." (defcustom eww-restore-desktop nil "How to restore EWW buffers on `desktop-restore'. -If t or 'auto, the buffers will be reloaded automatically. +If t or `auto', the buffers will be reloaded automatically. If nil, buffers will require manual reload, and will contain the text specified in `eww-restore-reload-prompt' instead of the actual Web page contents." @@ -253,7 +254,7 @@ word(s) will be searched for via `eww-search-prefix'." (cond ((string-match-p "\\`file:/" url)) ;; Don't mangle file: URLs at all. ((string-match-p "\\`ftp://" url) - (user-error "FTP is not supported.")) + (user-error "FTP is not supported")) (t ;; Anything that starts with something that vaguely looks ;; like a protocol designator is interpreted as a full URL. @@ -262,7 +263,7 @@ word(s) will be searched for via `eww-search-prefix'." ;; en.wikipedia.org/wiki/Free software (string-match "\\`[A-Za-z_]+\\.[A-Za-z._]+/" url) (and (= (length (split-string url)) 1) - (or (and (not (string-match-p "\\`[\"\'].*[\"\']\\'" url)) + (or (and (not (string-match-p "\\`[\"'].*[\"']\\'" url)) (> (length (split-string url "[.:]")) 1)) (string-match eww-local-regex url)))) (progn @@ -273,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)))) @@ -291,7 +288,7 @@ word(s) will be searched for via `eww-search-prefix'." ;;;###autoload (defun eww-open-file (file) - "Render a file using EWW." + "Render FILE using EWW." (interactive "fFile: ") (eww (concat "file://" (and (memq system-type '(windows-nt ms-dos)) @@ -300,11 +297,17 @@ word(s) will be searched for via `eww-search-prefix'." ;;;###autoload (defun eww-search-words (&optional beg end) - "Search the web for the text between the point and marker. + "Search the web for the text between BEG and END. See the `eww-search-prefix' variable for the search engine used." (interactive "r") (eww (buffer-substring beg end))) +(defun eww-html-p (content-type) + "Return non-nil if CONTENT-TYPE designates an HTML content type. +Currently this means either text/html or application/xhtml+xml." + (member content-type '("text/html" + "application/xhtml+xml"))) + (defun eww-render (status url &optional point buffer encode) (let ((redirect (plist-get status :redirect))) (when redirect @@ -317,10 +320,10 @@ See the `eww-search-prefix' variable for the search engine used." (charset (intern (downcase (or (cdr (assq 'charset (cdr content-type))) - (eww-detect-charset (equal (car content-type) - "text/html")) + (eww-detect-charset (eww-html-p (car content-type))) "utf-8")))) - (data-buffer (current-buffer))) + (data-buffer (current-buffer)) + last-coding-system-used) ;; Save the https peer status. (with-current-buffer buffer (plist-put eww-data :peer (plist-get status :peer))) @@ -331,18 +334,20 @@ See the `eww-search-prefix' variable for the search engine used." (string-match-p eww-use-external-browser-for-content-type (car content-type))) (eww-browse-with-external-browser url)) - ((equal (car content-type) "text/html") + ((eww-html-p (car content-type)) (eww-display-html charset url nil point buffer encode)) ((equal (car content-type) "application/pdf") (eww-display-pdf)) ((string-match-p "\\`image/" (car content-type)) (eww-display-image buffer)) (t - (eww-display-raw buffer encode))) + (eww-display-raw buffer (or encode charset 'utf-8)))) (with-current-buffer buffer (plist-put eww-data :url url) (eww-update-header-line-format) (setq eww-history-position 0) + (and last-coding-system-used + (set-buffer-file-coding-system last-coding-system-used)) (run-hooks 'eww-after-render-hook))) (kill-buffer data-buffer)))) @@ -373,7 +378,7 @@ See the `eww-search-prefix' variable for the search engine used." (match-string 1))))) (declare-function libxml-parse-html-region "xml.c" - (start end &optional base-url)) + (start end &optional base-url discard-comments)) (defun eww-display-html (charset url &optional document point buffer encode) (unless (fboundp 'libxml-parse-html-region) @@ -388,31 +393,30 @@ See the `eww-search-prefix' variable for the search engine used." (list 'base (list (cons 'href url)) (progn - (when (or (and encode - (not (eq charset encode))) - (not (eq charset 'utf-8))) - (condition-case nil - (decode-coding-region (point) (point-max) - (or encode charset)) - (coding-system-error nil))) + (setq encode (or encode charset 'utf-8)) + (condition-case nil + (decode-coding-region (point) (point-max) encode) + (coding-system-error nil)) (libxml-parse-html-region (point) (point-max)))))) (source (and (null document) (buffer-substring (point) (point-max))))) (with-current-buffer buffer + (setq bidi-paragraph-direction 'left-to-right) (plist-put eww-data :source source) (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 - '((title . eww-tag-title) - (form . eww-tag-form) - (input . eww-tag-input) - (textarea . eww-tag-textarea) - (body . eww-tag-body) - (select . eww-tag-select) - (link . eww-tag-link) - (a . eww-tag-a)))) + (append + '((title . eww-tag-title) + (form . eww-tag-form) + (input . eww-tag-input) + (textarea . eww-tag-textarea) + (select . eww-tag-select) + (link . eww-tag-link) + (meta . eww-tag-meta) + (a . eww-tag-a))))) (erase-buffer) (shr-insert-document document) (cond @@ -457,6 +461,27 @@ See the `eww-search-prefix' variable for the search engine used." where (plist-put eww-data (cdr where) href)))) +(defvar eww-redirect-level 1) + +(defun eww-tag-meta (dom) + (when (and (cl-equalp (dom-attr dom 'http-equiv) "refresh") + (< eww-redirect-level 5)) + (when-let (refresh (dom-attr dom 'content)) + (when (or (string-match "^\\([0-9]+\\) *;.*url=\"\\([^\"]+\\)\"" refresh) + (string-match "^\\([0-9]+\\) *;.*url=\\([^ ]+\\)" refresh)) + (let ((timeout (match-string 1 refresh)) + (url (match-string 2 refresh)) + (eww-redirect-level (1+ eww-redirect-level))) + (if (equal timeout "0") + (eww (shr-expand-url url)) + (eww-tag-a + (dom-node 'a `((href . ,(shr-expand-url url))) + (format "Auto refresh in %s second%s disabled" + timeout + (if (equal timeout "1") + "" + "s")))))))))) + (defun eww-tag-link (dom) (eww-handle-link dom) (shr-generic dom)) @@ -495,15 +520,6 @@ See the `eww-search-prefix' variable for the search engine used." (replace-regexp-in-string "[ \t\r\n]+" " " (dom-text dom)))) (eww-update-header-line-format)) -(defun eww-tag-body (dom) - (let* ((start (point)) - (fgcolor (or (dom-attr dom 'fgcolor) (dom-attr dom 'text))) - (bgcolor (dom-attr dom 'bgcolor)) - (shr-stylesheet (list (cons 'color fgcolor) - (cons 'background-color bgcolor)))) - (shr-generic dom) - (shr-colorize-region start (point) fgcolor bgcolor))) - (defun eww-display-raw (buffer &optional encode) (let ((data (buffer-substring (point) (point-max)))) (unless (buffer-live-p buffer) @@ -512,11 +528,9 @@ See the `eww-search-prefix' variable for the search engine used." (let ((inhibit-read-only t)) (erase-buffer) (insert data) - (unless (eq encode 'utf-8) - (encode-coding-region (point-min) (1+ (length data)) 'utf-8) - (condition-case nil - (decode-coding-region (point-min) (1+ (length data)) encode) - (coding-system-error nil)))) + (condition-case nil + (decode-coding-region (point-min) (1+ (length data)) encode) + (coding-system-error nil))) (goto-char (point-min))))) (defun eww-display-image (buffer) @@ -542,9 +556,13 @@ See the `eww-search-prefix' variable for the search engine used." (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)) + (setq bidi-paragraph-direction 'left-to-right) (unless (eq major-mode 'eww-mode) (eww-mode))) @@ -568,6 +586,15 @@ See the `eww-search-prefix' variable for the search engine used." (delete-region (point-min) (point-max)) (insert (or source "no source")) (goto-char (point-min)) + ;; Decode the source and set the buffer's encoding according + ;; to what the HTML source specifies in its 'charset' header, + ;; if any. + (let ((cs (find-auto-coding "" (point-max)))) + (when (consp cs) + (setq cs (car cs)) + (when (coding-system-p cs) + (decode-coding-region (point-min) (point-max) cs) + (setq buffer-file-coding-system last-coding-system-used)))) (when (fboundp 'html-mode) (html-mode)))) (view-buffer buf))) @@ -631,7 +658,6 @@ the like." (defvar eww-mode-map (let ((map (make-sparse-keymap))) - (set-keymap-parent map special-mode-map) (define-key map "g" 'eww-reload) ;FIXME: revert-buffer-function instead! (define-key map "G" 'eww) (define-key map [?\t] 'shr-next-link) @@ -653,6 +679,7 @@ the like." (define-key map "H" 'eww-list-histories) (define-key map "E" 'eww-set-character-encoding) (define-key map "S" 'eww-list-buffers) + (define-key map "F" 'eww-toggle-fonts) (define-key map "b" 'eww-add-bookmark) (define-key map "B" 'eww-list-bookmarks) @@ -695,6 +722,8 @@ the like." map) "Tool bar for `eww-mode'.") +;; Autoload cookie needed by desktop.el. +;;;###autoload (define-derived-mode eww-mode special-mode "eww" "Mode for browsing the web." (setq-local eww-data (list :title "")) @@ -1172,16 +1201,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 () @@ -1369,7 +1401,7 @@ If EXTERNAL is double prefix, browse in new buffer." (eww-browse-url url external))))) (defun eww-same-page-p (url1 url2) - "Return non-nil if both URLs represent the same page. + "Return non-nil if URL1 and URL2 represent the same page. Differences in #targets are ignored." (let ((obj1 (url-generic-parse-url url1)) (obj2 (url-generic-parse-url url2))) @@ -1395,36 +1427,72 @@ 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 (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 + ;; environment settings), then we return the original, hexified + ;; string. + string))) + (defun eww-make-unique-file-name (file directory) (cond ((zerop (length file)) (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))) (defun eww-set-character-encoding (charset) - "Set character encoding." + "Set character encoding to CHARSET. +If CHARSET is nil then use UTF-8." (interactive "zUse character set (default utf-8): ") (if (null charset) (eww-reload nil 'utf-8) (eww-reload nil charset))) +(defun eww-toggle-fonts () + "Toggle whether to use monospaced or font-enabled layouts." + (interactive) + (message "Fonts are now %s" + (if (setq shr-use-fonts (not shr-use-fonts)) + "on" + "off")) + (eww-reload)) + ;;; Bookmarks code (defvar eww-bookmarks nil) @@ -1484,7 +1552,7 @@ Differences in #targets are ignored." (setq start (point) title (plist-get bookmark :title)) (when (> (length title) width) - (setq title (substring title 0 width))) + (setq title (truncate-string-to-width title width))) (insert (format format title (plist-get bookmark :url)) "\n") (put-text-property start (1+ start) 'eww-bookmark bookmark)) (goto-char (point-min)))) @@ -1574,8 +1642,6 @@ Differences in #targets are ignored." (defvar eww-bookmark-mode-map (let ((map (make-sparse-keymap))) - (suppress-keymap map) - (define-key map "q" 'quit-window) (define-key map [(control k)] 'eww-bookmark-kill) (define-key map [(control y)] 'eww-bookmark-yank) (define-key map "\r" 'eww-bookmark-browse) @@ -1592,13 +1658,12 @@ Differences in #targets are ignored." :active eww-bookmark-kill-ring])) map)) -(define-derived-mode eww-bookmark-mode nil "eww bookmarks" +(define-derived-mode eww-bookmark-mode special-mode "eww bookmarks" "Mode for listing bookmarks. \\{eww-bookmark-mode-map}" (buffer-disable-undo) - (setq buffer-read-only t - truncate-lines t)) + (setq truncate-lines t)) ;;; History code @@ -1661,8 +1726,6 @@ Differences in #targets are ignored." (defvar eww-history-mode-map (let ((map (make-sparse-keymap))) - (suppress-keymap map) - (define-key map "q" 'quit-window) (define-key map "\r" 'eww-history-browse) ;; (define-key map "n" 'next-error-no-select) ;; (define-key map "p" 'previous-error-no-select) @@ -1675,13 +1738,12 @@ Differences in #targets are ignored." :active (get-text-property (line-beginning-position) 'eww-history)])) map)) -(define-derived-mode eww-history-mode nil "eww history" +(define-derived-mode eww-history-mode special-mode "eww history" "Mode for listing eww-histories. \\{eww-history-mode-map}" (buffer-disable-undo) - (setq buffer-read-only t - truncate-lines t)) + (setq truncate-lines t)) ;;; eww buffers list @@ -1786,8 +1848,6 @@ Differences in #targets are ignored." (defvar eww-buffers-mode-map (let ((map (make-sparse-keymap))) - (suppress-keymap map) - (define-key map "q" 'quit-window) (define-key map [(control k)] 'eww-buffer-kill) (define-key map "\r" 'eww-buffer-select) (define-key map "n" 'eww-buffer-show-next) @@ -1803,13 +1863,12 @@ Differences in #targets are ignored." :active (get-text-property (line-beginning-position) 'eww-buffer)])) map)) -(define-derived-mode eww-buffers-mode nil "eww buffers" +(define-derived-mode eww-buffers-mode special-mode "eww buffers" "Mode for listing buffers. \\{eww-buffers-mode-map}" (buffer-disable-undo) - (setq buffer-read-only t - truncate-lines t)) + (setq truncate-lines t)) ;;; Desktop support @@ -1861,7 +1920,7 @@ Generally, the list should not include the (usually overly large) (defun eww-restore-desktop (file-name buffer-name misc-data) "Restore an eww buffer from its desktop file record. -If `eww-restore-desktop' is t or 'auto, this function will also +If `eww-restore-desktop' is t or `auto', this function will also initiate the retrieval of the respective URI in the background. Otherwise, the restored buffer will contain a prompt to do so by using \\[eww-reload]." @@ -1877,8 +1936,9 @@ Otherwise, the restored buffer will contain a prompt to do so by using (case eww-restore-desktop ((t auto) (eww (plist-get eww-data :url))) ((zerop (buffer-size)) - (insert (substitute-command-keys - eww-restore-reload-prompt)))))) + (let ((inhibit-read-only t)) + (insert (substitute-command-keys + eww-restore-reload-prompt))))))) ;; . (current-buffer)))