]> code.delx.au - gnu-emacs/blobdiff - lisp/net/eww.el
Update copyright year to 2016
[gnu-emacs] / lisp / net / eww.el
index ec7a0baacf6d298dd0e509da8c1e4e4792435ba1..48bf556a526e255fd5934cc215a4ef02d911aefe 100644 (file)
@@ -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 <larsi@gnus.org>
 ;; 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)))