]> code.delx.au - gnu-emacs/blobdiff - lisp/net/eww.el
Merge from origin/emacs-25
[gnu-emacs] / lisp / net / eww.el
index f8d7c75aa2bbe17d5a83845a125ed7b48cc7c4a0..d37b1b3261bb6c2a6f3b7cd654cb7befe29bcad8 100644 (file)
@@ -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
@@ -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))
 
@@ -279,6 +280,13 @@ word(s) will be searched for via `eww-search-prefix'."
        (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-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)
   (plist-put eww-data :title "")
   (eww-update-header-line-format)
@@ -402,11 +410,15 @@ Currently this means either text/html or application/xhtml+xml."
                (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 'left-to-right)
+      (setq bidi-paragraph-direction nil)
       (plist-put eww-data :source source)
       (plist-put eww-data :dom document)
       (let ((inhibit-read-only t)
@@ -414,9 +426,11 @@ Currently this means either text/html or application/xhtml+xml."
            (shr-target-id (url-target (url-generic-parse-url url)))
            (shr-external-rendering-functions
              (append
+              shr-external-rendering-functions
               '((title . eww-tag-title)
                 (form . eww-tag-form)
                 (input . eww-tag-input)
+                (button . eww-form-submit)
                 (textarea . eww-tag-textarea)
                 (select . eww-tag-select)
                 (link . eww-tag-link)
@@ -566,7 +580,7 @@ Currently this means either text/html or application/xhtml+xml."
   (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)))
 
@@ -603,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
@@ -615,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)))
@@ -682,8 +707,11 @@ 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)
     (define-key map "B" 'eww-list-bookmarks)
@@ -704,11 +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]
-       ["Character Encoding" eww-set-character-encoding]))
+       ["Toggle fonts" eww-toggle-fonts t]
+       ["Toggle colors" eww-toggle-colors t]
+        ["Character Encoding" eww-set-character-encoding]
+        ["Toggle Paragraph Direction" eww-toggle-paragraph-direction]))
     map))
 
 (defvar eww-tool-bar-map
@@ -1132,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)
@@ -1467,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.
@@ -1491,11 +1525,37 @@ 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))
+  (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."
+  (interactive)
+  (message "Colors are now %s"
+          (if (setq shr-use-colors (not shr-use-colors))
               "on"
             "off"))
   (eww-reload))
@@ -1540,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)