]> code.delx.au - gnu-emacs/blobdiff - lisp/net/eww.el
Merge from origin/emacs-25
[gnu-emacs] / lisp / net / eww.el
index 88dfb0214b9e659eb937c4aafa44a36eb56156bd..d37b1b3261bb6c2a6f3b7cd654cb7befe29bcad8 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
@@ -31,6 +31,7 @@
 (require 'url-queue)
 (require 'url-util)                    ; for url-get-url-at-point
 (require 'mm-url)
+(require 'puny)
 (eval-when-compile (require 'subr-x)) ;; for string-trim
 
 (defgroup eww nil
@@ -93,7 +94,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."
@@ -222,7 +223,7 @@ 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)))
+  (let ((map (copy-keymap shr-image-map)))
     (define-key map "\r" 'eww-follow-link)
     map))
 
@@ -274,12 +275,16 @@ 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))))))
+  (pop-to-buffer-same-window
+   (if (eq major-mode 'eww-mode)
+       (current-buffer)
+     (get-buffer-create "*eww*")))
   (eww-setup-buffer)
   ;; Check whether the domain only uses "Highly Restricted" Unicode
   ;; IDNA characters.  If not, transform to punycode to indicate that
   ;; there may be funny business going on.
   (let ((parsed (url-generic-parse-url url)))
-    (unless (puny-highly-restrictive-p (url-host parsed))
+    (unless (puny-highly-restrictive-domain-p (url-host parsed))
       (setf (url-host parsed) (puny-encode-domain (url-host parsed)))
       (setq url (url-recreate-url parsed))))
   (plist-put eww-data :url url)
@@ -322,14 +327,16 @@ Currently this means either text/html or application/xhtml+xml."
   (let* ((headers (eww-parse-headers))
         (content-type
          (mail-header-parse-content-type
-          (or (cdr (assoc "content-type" headers))
-              "text/plain")))
+           (if (zerop (length (cdr (assoc "content-type" headers))))
+              "text/plain"
+             (cdr (assoc "content-type" headers)))))
         (charset (intern
                   (downcase
                    (or (cdr (assq 'charset (cdr content-type)))
                        (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)))
@@ -347,11 +354,13 @@ Currently this means either text/html or application/xhtml+xml."
           ((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))))
 
@@ -397,17 +406,19 @@ Currently this means either text/html or application/xhtml+xml."
             (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))
+                (save-excursion
+                  ;; Remove CRLF before parsing.
+                  (while (re-search-forward "\r$" nil t)
+                    (replace-match "" t t)))
                (libxml-parse-html-region (point) (point-max))))))
        (source (and (null document)
                     (buffer-substring (point) (point-max)))))
     (with-current-buffer buffer
+      (setq bidi-paragraph-direction nil)
       (plist-put eww-data :source source)
       (plist-put eww-data :dom document)
       (let ((inhibit-read-only t)
@@ -536,11 +547,9 @@ Currently this means either text/html or application/xhtml+xml."
       (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)
@@ -556,7 +565,7 @@ Currently this means either text/html or application/xhtml+xml."
 (declare-function mailcap-view-mime "mailcap" (type))
 (defun eww-display-pdf ()
   (let ((data (buffer-substring (point) (point-max))))
-    (switch-to-buffer (get-buffer-create "*eww pdf*"))
+    (pop-to-buffer-same-window (get-buffer-create "*eww pdf*"))
     (let ((coding-system-for-write 'raw-text)
          (inhibit-read-only t))
       (erase-buffer)
@@ -565,14 +574,13 @@ Currently this means either text/html or application/xhtml+xml."
   (goto-char (point-min)))
 
 (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)
+  (setq bidi-paragraph-direction nil)
   (unless (eq major-mode 'eww-mode)
     (eww-mode)))
 
@@ -609,6 +617,15 @@ Currently this means either text/html or application/xhtml+xml."
          (html-mode))))
     (view-buffer buf)))
 
+(defun eww-toggle-paragraph-direction ()
+  "Toggle the paragraphs direction between left-to-right and right-to-left."
+  (interactive)
+  (setq bidi-paragraph-direction
+        (if (eq bidi-paragraph-direction 'left-to-right)
+            'right-to-left
+          'left-to-right))
+  (message "The paragraph direction is now %s" bidi-paragraph-direction))
+
 (defun eww-readable ()
   "View the main \"readable\" parts of the current web page.
 This command uses heuristics to find the parts of the web page that
@@ -621,11 +638,13 @@ the like."
                (condition-case nil
                    (decode-coding-region (point-min) (point-max) 'utf-8)
                  (coding-system-error nil))
-               (libxml-parse-html-region (point-min) (point-max)))))
+               (libxml-parse-html-region (point-min) (point-max))))
+         (base (plist-get eww-data :url)))
     (eww-score-readability dom)
     (eww-save-history)
     (eww-display-html nil nil
-                     (eww-highest-readability dom)
+                      (list 'base (list (cons 'href base))
+                            (eww-highest-readability dom))
                      nil (current-buffer))
     (dolist (elem '(:source :url :title :next :previous :up))
       (plist-put eww-data elem (plist-get old-data elem)))
@@ -688,8 +707,10 @@ the like."
     (define-key map "R" 'eww-readable)
     (define-key map "H" 'eww-list-histories)
     (define-key map "E" 'eww-set-character-encoding)
+    (define-key map "s" 'eww-switch-to-buffer)
     (define-key map "S" 'eww-list-buffers)
     (define-key map "F" 'eww-toggle-fonts)
+    (define-key map "D" 'eww-toggle-paragraph-direction)
     (define-key map [(meta C)] 'eww-toggle-colors)
 
     (define-key map "b" 'eww-add-bookmark)
@@ -711,13 +732,15 @@ the like."
        ["View page source" eww-view-source]
        ["Copy page URL" eww-copy-page-url t]
        ["List histories" eww-list-histories t]
+       ["Switch to buffer" eww-switch-to-buffer t]
        ["List buffers" eww-list-buffers t]
        ["Add bookmark" eww-add-bookmark t]
        ["List bookmarks" eww-list-bookmarks t]
        ["List cookies" url-cookie-list t]
        ["Toggle fonts" eww-toggle-fonts t]
        ["Toggle colors" eww-toggle-colors t]
-       ["Character Encoding" eww-set-character-encoding]))
+        ["Character Encoding" eww-set-character-encoding]
+        ["Toggle Paragraph Direction" eww-toggle-paragraph-direction]))
     map))
 
 (defvar eww-tool-bar-map
@@ -750,16 +773,15 @@ 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
-        bidi-paragraph-direction 'left-to-right)
+  (setq truncate-lines t)
   (buffer-disable-undo)
   (setq buffer-read-only t))
 
 ;;;###autoload
 (defun eww-browse-url (url &optional new-window)
-  (cond (new-window
-        (switch-to-buffer (generate-new-buffer "*eww*"))
-         (eww-mode)))
+  (when new-window
+    (pop-to-buffer-same-window (generate-new-buffer "*eww*"))
+    (eww-mode))
   (eww url))
 
 (defun eww-back-url ()
@@ -931,6 +953,7 @@ network, but just re-display the HTML already fetched."
   (let ((eww-form (list (cons :method (dom-attr dom 'method))
                        (cons :action (dom-attr dom 'action))))
        (start (point)))
+    (insert "\n")
     (shr-ensure-paragraph)
     (shr-generic dom)
     (unless (bolp)
@@ -1040,6 +1063,7 @@ See URL `https://developer.mozilla.org/en-US/docs/Web/HTML/Element/Input'.")
                        (1- end)))))
     (let* ((form (get-text-property pos 'eww-form))
           (properties (text-properties-at pos))
+           (buffer-undo-list t)
           (inhibit-read-only t)
           (length (- end beg replace-length))
           (type (plist-get form :type)))
@@ -1054,19 +1078,19 @@ See URL `https://developer.mozilla.org/en-US/docs/Web/HTML/Element/Input'.")
                 (1- (line-end-position))
               (eww-end-of-field)))
            (while (and (> length 0)
-                       (eql (following-char) ? ))
+                       (eql (char-after (1- (point))) ? ))
              (delete-region (1- (point)) (point))
              (cl-decf length))))
         ((< length 0)
          ;; Add padding.
          (save-excursion
-           (goto-char (1- end))
+           (goto-char end)
            (goto-char
             (if (equal type "textarea")
                 (1- (line-end-position))
               (1+ (eww-end-of-field))))
            (let ((start (point)))
-             (insert (make-string (abs length) ? ))
+              (insert (make-string (abs length) ? ))
              (set-text-properties start (point) properties))
            (goto-char (1- end)))))
        (set-text-properties (plist-get form :start) (plist-get form :end)
@@ -1080,8 +1104,9 @@ See URL `https://developer.mozilla.org/en-US/docs/Web/HTML/Element/Input'.")
          (when (equal type "password")
            ;; Display passwords as asterisks.
            (let ((start (eww-beginning-of-field)))
-             (put-text-property start (+ start (length value))
-                                'display (make-string (length value) ?*)))))))))
+             (put-text-property
+               start (+ start (length value))
+               'display (make-string (length value) ?*)))))))))
 
 (defun eww-tag-textarea (dom)
   (let ((start (point))
@@ -1139,11 +1164,13 @@ See URL `https://developer.mozilla.org/en-US/docs/Web/HTML/Element/Input'.")
          (nconc eww-form (list
                           (list 'hidden
                                 :name name
-                                :value (dom-attr dom 'value)))))))
+                                :value (or (dom-attr dom 'value) "")))))))
      (t
       (eww-form-text dom)))
     (unless (= start (point))
-      (put-text-property start (1+ start) 'help-echo "Input field"))))
+      (put-text-property start (1+ start) 'help-echo "Input field")
+      ;; Mark this as an element we can TAB to.
+      (put-text-property start (1+ start) 'shr-url dom))))
 
 (defun eww-tag-select (dom)
   (shr-ensure-paragraph)
@@ -1474,21 +1501,21 @@ Differences in #targets are ignored."
       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)
-          (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 (format "%s(%d)%s" stem count suffix))
-       (setq count (1+ count)))
-      (expand-file-name file directory)))
+  (cond
+   ((zerop (length file))
+    (setq file "!"))
+   ((string-match "\\`[.]" file)
+    (setq file (concat "!" file))))
+  (let ((count 1)
+        (stem file)
+        (suffix ""))
+    (when (string-match "\\`\\(.*\\)\\([.][^.]+\\)" file)
+      (setq stem (match-string 1 file)
+            suffix (match-string 2)))
+    (while (file-exists-p (expand-file-name file directory))
+      (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 to CHARSET.
@@ -1498,14 +1525,31 @@ If CHARSET is nil then use UTF-8."
       (eww-reload nil 'utf-8)
     (eww-reload nil charset)))
 
+(defun eww-switch-to-buffer ()
+  "Prompt for an EWW buffer to display in the selected window."
+  (interactive)
+  (let ((completion-extra-properties
+         '(:annotation-function (lambda (buf)
+                                  (with-current-buffer buf
+                                    (format " %s" (eww-current-url)))))))
+    (pop-to-buffer-same-window
+     (read-buffer "Switch to EWW buffer: "
+                  (cl-loop for buf in (nreverse (buffer-list))
+                           if (with-current-buffer buf (derived-mode-p 'eww-mode))
+                           return buf)
+                  t
+                  (lambda (bufn)
+                    (with-current-buffer
+                        (if (consp bufn) (cdr bufn) (get-buffer bufn))
+                      (derived-mode-p 'eww-mode)))))))
+
 (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))
+  (setq shr-use-fonts (not shr-use-fonts))
+  (eww-reload)
+  (message "Proportional fonts are now %s"
+           (if shr-use-fonts "on" "off")))
 
 (defun eww-toggle-colors ()
   "Toggle whether to use HTML-specified colors or not."
@@ -1556,8 +1600,8 @@ If CHARSET is nil then use UTF-8."
 (defun eww-list-bookmarks ()
   "Display the bookmarks."
   (interactive)
-  (eww-bookmark-prepare)
-  (pop-to-buffer "*eww bookmarks*"))
+  (pop-to-buffer "*eww bookmarks*")
+  (eww-bookmark-prepare))
 
 (defun eww-bookmark-prepare ()
   (eww-read-bookmarks)
@@ -1744,7 +1788,7 @@ If CHARSET is nil then use UTF-8."
     (let ((buffer eww-current-buffer))
       (quit-window)
       (when buffer
-       (switch-to-buffer buffer)))
+       (pop-to-buffer-same-window buffer)))
     (eww-restore-history history)))
 
 (defvar eww-history-mode-map
@@ -1825,7 +1869,7 @@ If CHARSET is nil then use UTF-8."
     (unless buffer
       (error "No buffer on current line"))
     (quit-window)
-    (switch-to-buffer buffer)))
+    (pop-to-buffer-same-window buffer)))
 
 (defun eww-buffer-show ()
   "Display buffer under point in eww buffer list."
@@ -1834,7 +1878,7 @@ If CHARSET is nil then use UTF-8."
     (unless buffer
       (error "No buffer on current line"))
     (other-window -1)
-    (switch-to-buffer buffer)
+    (pop-to-buffer-same-window buffer)
     (other-window 1)))
 
 (defun eww-buffer-show-next ()
@@ -1943,7 +1987,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]."