;;; eww.el --- Emacs Web Wowser  -*- lexical-binding:t -*-

;; Copyright (C) 2013-2023 Free Software Foundation, Inc.

;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: html

;; This file is part of GNU Emacs.

;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.

;;; Commentary:

;;; Code:

(require 'cl-lib)
(require 'mm-url)
(require 'puny)
(require 'shr)
(require 'text-property-search)
(require 'thingatpt)
(require 'url)
(require 'url-queue)
(require 'url-file)
(require 'xdg)
(eval-when-compile (require 'subr-x))

(defgroup eww nil
  "Emacs Web Wowser."
  :version "25.1"
  :link '(custom-manual "(eww) Top")
  :group 'web
  :prefix "eww-")

(defcustom eww-header-line-format "%t: %u"
  "Header line format.
- %t is replaced by the title.
- %u is replaced by the URL."
  :version "24.4"
  :group 'eww
  :type 'string)

(defcustom eww-search-prefix "https://duckduckgo.com/html/?q="
  "Prefix URL to search engine."
  :version "24.4"
  :group 'eww
  :type 'string)

(defcustom eww-use-browse-url "\\`mailto:"
  "EWW will use `browse-url' when following links that match this regexp.
The action to be taken can be further customized via
`browse-url-handlers'."
  :version "28.1"
  :type 'regexp)

(defcustom eww-default-download-directory "~/Downloads/"
  "Default directory where `eww' saves downloaded files.
Used by `eww--download-directory', which see."
  :version "29.1"
  :group 'eww
  :type 'directory)

(defun eww--download-directory ()
  "Return the name of the EWW download directory.
The default is specified by `eww-default-download-directory'; however,
if that directory doesn't exist and the DOWNLOAD XDG user directory
is defined, use the latter instead."
  (or (and (file-exists-p eww-default-download-directory)
           eww-default-download-directory)
      (when-let ((dir (xdg-user-dir "DOWNLOAD")))
        (file-name-as-directory dir))
      eww-default-download-directory))

(defcustom eww-download-directory 'eww--download-directory
  "Directory where files will downloaded.
This should either be a directory name or a function (called with
no parameters) that returns a directory name."
  :version "28.1"
  :group 'eww
  :type '(choice directory function))

;;;###autoload
(defcustom eww-suggest-uris
  '(eww-links-at-point
    thing-at-point-url-at-point
    eww-current-url
    eww-bookmark-urls)
  "List of functions called to form the list of default URIs for `eww'.
Each of the elements is a function returning either a string or a list
of strings.  The results will be joined into a single list with
duplicate entries (if any) removed."
  :version "27.1"
  :group 'eww
  :type 'hook
  :options '(eww-links-at-point
             thing-at-point-url-at-point
             eww-current-url
             eww-bookmark-urls))

(defcustom eww-bookmarks-directory user-emacs-directory
  "Directory where bookmark files will be stored."
  :version "25.1"
  :group 'eww
  :type 'directory)

(defcustom eww-desktop-remove-duplicates t
  "Whether to remove duplicates from the history when saving desktop data.
If non-nil, repetitive EWW history entries (comprising of the URI, the
title, and the point position) will not be saved as part of the Emacs
desktop.  Otherwise, such entries will be retained."
  :version "25.1"
  :group 'eww
  :type 'boolean)

(defcustom eww-restore-desktop nil
  "How to restore EWW buffers on `desktop-restore'.
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."
  :version "25.1"
  :group 'eww
  :type '(choice (const :tag "Restore all automatically" t)
                 (const :tag "Require manual reload" nil)))

(defcustom eww-restore-reload-prompt
  "\n\n *** Use \\[eww-reload] to reload this buffer. ***\n"
  "The string to put in the buffers not reloaded on `desktop-restore'.
This prompt will be used if `eww-restore-desktop' is nil.

The string will be passed through `substitute-command-keys'."
  :version "25.1"
  :group 'eww
  :type 'string)

(defcustom eww-history-limit 50
  "Maximum number of entries to retain in the history."
  :version "25.1"
  :group 'eww
  :type '(choice (const :tag "Unlimited" nil)
                 integer))

(defcustom eww-retrieve-command nil
  "Command to retrieve an URL via an external program.
If nil, `url-retrieve' is used to download the data.
If `sync', `url-retrieve-synchronously' is used.
For other non-nil values, this should be a list of strings where
the first item is the program, and the rest are the arguments."
  :version "28.1"
  :type '(choice (const :tag "Use `url-retrieve'" nil)
                 (const :tag "Use `url-retrieve-synchronously'" sync)
                 (repeat :tag "Command/args" string )))

(defcustom eww-use-external-browser-for-content-type
  "\\`\\(video/\\|audio/\\|application/ogg\\)"
  "Always use external browser for specified content-type."
  :version "24.4"
  :group 'eww
  :type '(choice (const :tag "Never" nil)
                 regexp))

(defcustom eww-browse-url-new-window-is-tab 'tab-bar
  "Whether to open up new windows in a tab or a new buffer.
If t, then open the URL in a new tab rather than a new buffer if
`eww-browse-url' is asked to open it in a new window.
If `tab-bar', then open the URL in a new tab only when
the tab bar is enabled."
  :version "27.1"
  :group 'eww
  :type '(choice (const :tag "Always open URL in new tab" t)
                 (const :tag "Open new tab when tab bar is enabled" tab-bar)
                 (const :tag "Never open URL in new tab" nil)))

(defcustom eww-after-render-hook nil
  "A hook called after eww has finished rendering the buffer."
  :version "25.1"
  :group 'eww
  :type 'hook)

(defcustom eww-auto-rename-buffer nil
  "Automatically rename EWW buffers once the page is rendered.

When nil, do not rename the buffer.  With a non-nil value
determine the renaming scheme, as follows:

- `title': Use the web page's title.
- `url': Use the web page's URL.
- a function's symbol: Run a user-defined function that returns a
  string with which to rename the buffer.  Sample of a
  user-defined function:

  (defun my-eww-rename-buffer ()
    (when (eq major-mode \\='eww-mode)
      (when-let ((string (or (plist-get eww-data :title)
                             (plist-get eww-data :url))))
        (format \"*%s*\" string))))

The string of `title' and `url' is always truncated to the value
of `eww-buffer-name-length'."
  :version "29.1"
  :type '(choice
          (const :tag "Do not rename buffers (default)" nil)
          (const :tag "Rename buffer to web page title" title)
          (const :tag "Rename buffer to web page URL" url)
          (function :tag "A user-defined function to rename the buffer"))
  :group 'eww)

(defcustom eww-buffer-name-length 40
  "Length of renamed buffer name, per `eww-auto-rename-buffer'."
  :type 'natnum
  :version "29.1"
  :group 'eww)

(defcustom eww-form-checkbox-selected-symbol "[X]"
  "Symbol used to represent a selected checkbox.
See also `eww-form-checkbox-symbol'."
  :version "24.4"
  :group 'eww
  :type '(choice (const "[X]")
                 (const "☒")            ; Unicode BALLOT BOX WITH X
                 (const "☑")            ; Unicode BALLOT BOX WITH CHECK
                 string))

(defcustom eww-form-checkbox-symbol "[ ]"
  "Symbol used to represent a checkbox.
See also `eww-form-checkbox-selected-symbol'."
  :version "24.4"
  :group 'eww
  :type '(choice (const "[ ]")
                 (const "☐")            ; Unicode BALLOT BOX
                 string))

(defcustom eww-url-transformers '(eww-remove-tracking)
  "This is a list of transforming functions applied to an URL before usage.
The functions will be called with the URL as the single
parameter, and should return the (possibly) transformed URL."
  :type '(repeat function)
  :version "29.1")

(defface eww-form-submit
  '((((type x w32 ns haiku pgtk android) (class color))	; Like default mode line
     :box (:line-width 2 :style released-button)
     :background "#808080" :foreground "black"))
  "Face for eww buffer buttons."
  :version "24.4"
  :group 'eww)

(defface eww-form-file
  '((((type x w32 ns haiku pgtk android) (class color))	; Like default mode line
     :box (:line-width 2 :style released-button)
     :background "#808080" :foreground "black"))
  "Face for eww buffer buttons."
  :version "25.1"
  :group 'eww)

(defface eww-form-checkbox
  '((((type x w32 ns haiku pgtk android) (class color))	; Like default mode line
     :box (:line-width 2 :style released-button)
     :background "lightgrey" :foreground "black"))
  "Face for eww buffer buttons."
  :version "24.4"
  :group 'eww)

(defface eww-form-select
  '((((type x w32 ns haiku pgtk android) (class color))	; Like default mode line
     :box (:line-width 2 :style released-button)
     :background "lightgrey" :foreground "black"))
  "Face for eww buffer buttons."
  :version "24.4"
  :group 'eww)

(defface eww-form-text
  '((t :background "#505050"
       :foreground "white"
       :box (:line-width 1)))
  "Face for eww text inputs."
  :version "24.4"
  :group 'eww)

(defface eww-form-textarea
  '((t :background "#C0C0C0"
       :foreground "black"
       :box (:line-width 1)))
  "Face for eww textarea inputs."
  :version "24.4"
  :group 'eww)

(defface eww-invalid-certificate
  '((default :weight bold)
    (((class color)) :foreground "red"))
  "Face for web pages with invalid certificates."
  :version "25.1"
  :group 'eww)

(defface eww-valid-certificate
  '((default :weight bold)
    (((class color)) :foreground "ForestGreen"))
  "Face for web pages with valid certificates."
  :version "25.1"
  :group 'eww)

(defvar eww-data nil)
(defvar eww-history nil)
(defvar eww-history-position 0)
(defvar eww-prompt-history nil)

(defvar eww-local-regex "localhost"
  "When this regex is found in the URL, it's not a keyword but an address.")

(defvar eww-accept-content-types
  "text/html, text/plain, text/sgml, text/css, application/xhtml+xml, */*;q=0.01"
  "Value used for the HTTP \"Accept\" header.")

(defvar-keymap eww-link-keymap
  :parent shr-map
  "RET" #'eww-follow-link
  "<mouse-2>" #'eww-follow-link)

(defvar-keymap eww-image-link-keymap
  :parent shr-image-map
  "RET" #'eww-follow-link)

(defvar-keymap eww-minibuffer-url-keymap
  :doc "Keymap used in the minibuffer prompt for URLs or keywords."
  :parent minibuffer-local-completion-map
  "SPC" #'self-insert-command
  "?" #'self-insert-command)

(defun eww-suggested-uris nil
  "Return the list of URIs to suggest at the `eww' prompt.
This list can be customized via `eww-suggest-uris'."
  (let ((obseen (make-vector 42 0))
	(uris nil))
    (dolist (fun eww-suggest-uris)
      (let ((ret (funcall fun)))
	(dolist (uri (if (stringp ret) (list ret) ret))
	  (when (and uri (not (intern-soft uri obseen)))
	    (intern uri obseen)
	    (push   uri uris)))))
    (nreverse uris)))

;;;###autoload
(defun eww-browse ()
  "Function to be run to parse command line URLs.
This is meant to be used for MIME handlers or command line use.

Setting the handler for \"text/x-uri;\" to
\"emacs -f eww-browse %u\" will then start up Emacs and call eww
to browse the url.

This can also be used on the command line directly:

 emacs -f eww-browse https://gnu.org

will start Emacs and browse the GNU web site."
  (interactive)
  (unless command-line-args-left
    (user-error "No URL given"))
  (eww (pop command-line-args-left)))


;;;###autoload
(defun eww (url &optional new-buffer buffer)
  "Fetch URL and render the page.
If the input doesn't look like an URL or a domain name, the
word(s) will be searched for via `eww-search-prefix'.

If NEW-BUFFER is non-nil (interactively, the prefix arg), use a
new buffer instead of reusing the default EWW buffer.

If BUFFER, the data to be rendered is in that buffer.  In that
case, this function doesn't actually fetch URL.  BUFFER will be
killed after rendering.

For more information, see Info node `(eww) Top'."
  (interactive
   (let ((uris (eww-suggested-uris))
         (minibuffer-local-completion-map eww-minibuffer-url-keymap))
     (list (completing-read (format-prompt "Enter URL or keywords"
                                           (and uris (car uris)))
                            (seq-uniq (append eww-prompt-history uris))
                            nil nil nil 'eww-prompt-history uris)
           current-prefix-arg)))
  (setq url (eww--dwim-expand-url url))
  (pop-to-buffer-same-window
   (cond
    (new-buffer
     (generate-new-buffer "*eww*"))
    ((eq major-mode 'eww-mode)
     (current-buffer))
    (t
     (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)))
    (when (url-host parsed)
      (unless (puny-highly-restrictive-domain-p (url-host parsed))
        (setf (url-host parsed) (puny-encode-domain (url-host parsed)))))
    ;; When the URL is on the form "http://a/../../../g", chop off all
    ;; the leading "/.."s.
    (when (url-filename parsed)
      (while (string-match "\\`/[.][.]/" (url-filename parsed))
        (setf (url-filename parsed) (substring (url-filename parsed) 3))))
    (setq url (url-recreate-url parsed)))
  (setq url (eww--transform-url url))
  (plist-put eww-data :url url)
  (plist-put eww-data :title "")
  (eww--after-page-change)
  (let ((inhibit-read-only t))
    (insert (format "Loading %s..." url))
    (goto-char (point-min)))
  (let ((url-mime-accept-string eww-accept-content-types))
    (if buffer
        (let ((eww-buffer (current-buffer)))
          (with-current-buffer buffer
            (eww-render nil url nil eww-buffer)))
      (eww-retrieve url #'eww-render
                    (list url nil (current-buffer))))))

(defun eww-retrieve (url callback cbargs)
  (cond
   ((null eww-retrieve-command)
    (url-retrieve url #'eww-render cbargs))
   ((eq eww-retrieve-command 'sync)
    (let ((data-buffer (url-retrieve-synchronously url)))
      (with-current-buffer data-buffer
        (apply #'eww-render nil url cbargs))))
   (t
    (let ((buffer (generate-new-buffer " *eww retrieve*"))
          (error-buffer (generate-new-buffer " *eww error*")))
      (with-current-buffer buffer
        (set-buffer-multibyte nil)
        (make-process
         :name "*eww fetch*"
         :buffer (current-buffer)
         :stderr error-buffer
         :command (append eww-retrieve-command (list url))
         :sentinel (lambda (process _)
                     (unless (process-live-p process)
                       (when (buffer-live-p error-buffer)
                         (when (get-buffer-process error-buffer)
                           (delete-process (get-buffer-process error-buffer) ))
                         (kill-buffer error-buffer))
                       (when (buffer-live-p buffer)
                         (with-current-buffer buffer
                           (goto-char (point-min))
                           (insert "Content-type: text/html; charset=utf-8\n\n")
                           (apply #'funcall callback nil cbargs)))))))))))

(function-put 'eww 'browse-url-browser-kind 'internal)

(defun eww--dwim-expand-url (url)
  (setq url (string-trim url))
  (cond ((string-match-p "\\`file:/" url))
	;; Don't mangle file: URLs at all.
        ((string-match-p "\\`ftp://" url)
         (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.
         (if (or (string-match "\\`[A-Za-z]+:" url)
		 ;; Also try to match "naked" URLs like
		 ;; 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))
			       (> (length (split-string url "[.:]")) 1))
			  (string-match eww-local-regex url))))
             (progn
               (unless (string-match-p "\\`[a-zA-Z][-a-zA-Z0-9+.]*://" url)
                 (setq url (concat "http://" url)))
               ;; Some sites do not redirect final /
               (when (string= (url-filename (url-generic-parse-url url)) "")
                 (setq url (concat url "/"))))
           (setq url (concat eww-search-prefix
                             (mapconcat
                              #'url-hexify-string (split-string url) "+"))))))
  url)

(defun eww--preprocess-html (start end)
  "Translate all < characters that do not look like start of tags into &lt;."
  (save-excursion
    (save-restriction
      (narrow-to-region start end)
      (goto-char start)
      (let ((case-fold-search t))
        (while (re-search-forward "<[^0-9a-z!?/]" nil t)
          (goto-char (match-beginning 0))
          (delete-region (point) (1+ (point)))
          (insert "&lt;"))))))

;;;###autoload (defalias 'browse-web 'eww)

;;;###autoload
(defun eww-open-file (file &optional new-buffer)
  "Render FILE using EWW.
If NEW-BUFFER is non-nil (interactively, the prefix arg), use a
new buffer instead of reusing the default EWW buffer."
  (interactive "fFile: \nP")
  (let ((url-allow-non-local-files t))
    (eww (concat "file://"
	         (and (memq system-type '(windows-nt ms-dos))
		      "/")
	         (expand-file-name file))
         new-buffer)))

(defun eww--file-buffer (file)
  (with-current-buffer (generate-new-buffer " *eww file*")
    (set-buffer-multibyte nil)
    (insert "Content-type: " (or (mailcap-extension-to-mime
			          (url-file-extension file))
                                 "application/octet-stream")
            "\n\n")
    (insert-file-contents file)
    (current-buffer)))

;;;###autoload
(defun eww-search-words ()
  "Search the web for the text in the region.
If region is active (and not whitespace), search the web for
the text between region beginning and end.  Else, prompt the
user for a search string.  See the variable `eww-search-prefix'
for the search engine used."
  (interactive)
  (if (use-region-p)
      (let ((region-string (buffer-substring (region-beginning) (region-end))))
        (if (not (string-match-p "\\`[ \n\t\r\v\f]*\\'" region-string))
            (eww region-string)
          (call-interactively #'eww)))
    (call-interactively #'eww)))

(defun eww--open-url-in-new-buffer (url)
  "Open the URL in a new EWW buffer."
  ;; Clone is useful to keep history, but we
  ;; should not clone from a non-eww buffer.
  (with-current-buffer
      (if (eq major-mode 'eww-mode) (clone-buffer)
        (generate-new-buffer "*eww*"))
    (unless (equal url (eww-current-url))
      (eww-mode)
      (eww (if (consp url) (car url) url)))))

(defun eww-open-in-new-buffer (&optional no-select url)
  "Fetch URL (interactively, the link at point) into a new EWW buffer.

NO-SELECT non-nil means do not make the new buffer the current buffer."
  (interactive "P")
  (if-let ((url (or url (eww-suggested-uris))))
      (if (or (eq eww-browse-url-new-window-is-tab t)
              (and (eq eww-browse-url-new-window-is-tab 'tab-bar)
                   tab-bar-mode))
          (let ((tab-bar-new-tab-choice t))
            (tab-new)
            (eww--open-url-in-new-buffer url)
            (when no-select
              (tab-bar-switch-to-recent-tab)))
        (if no-select
            (save-window-excursion (eww--open-url-in-new-buffer url))
          (eww--open-url-in-new-buffer url)))
    (user-error "No link at point")))

(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--rename-buffer ()
  "Rename the current EWW buffer.
The renaming scheme is performed in accordance with
`eww-auto-rename-buffer'."
  (let ((rename-string)
        (formatter
         (lambda (string)
           (format "*%s # eww*" (truncate-string-to-width
                                 string eww-buffer-name-length))))
        (site-title (plist-get eww-data :title))
        (site-url (plist-get eww-data :url)))
    (cond ((null eww-auto-rename-buffer))
          ((eq eww-auto-rename-buffer 'url)
           (setq rename-string (funcall formatter site-url)))
          ((functionp eww-auto-rename-buffer)
           (setq rename-string (funcall eww-auto-rename-buffer)))
          (t (setq rename-string
                   (funcall formatter (if (or (equal site-title "")
                                              (null site-title))
                                          "Untitled"
                                        site-title)))))
    (when rename-string
      (rename-buffer rename-string t))))

(defun eww-render (status url &optional point buffer encode)
  (let* ((headers (eww-parse-headers))
	 (content-type
	  (mail-header-parse-content-type
           (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))
	 (shr-target-id (url-target (url-generic-parse-url url)))
	 last-coding-system-used)
    (let ((redirect (plist-get status :redirect)))
      (when redirect
        (setq url redirect)))
    (when (buffer-live-p buffer)
      (with-current-buffer buffer
        ;; Save the https peer status.
        (plist-put eww-data :peer (plist-get status :peer))
        ;; Make buffer listings more informative.
        (setq list-buffers-directory url)
        ;; Let the URL library have a handle to the current URL for
        ;; referer purposes.
        (setq url-current-lastloc (url-generic-parse-url url)))
      (unwind-protect
	  (progn
	    (cond
             ((and eww-use-external-browser-for-content-type
                   (string-match-p eww-use-external-browser-for-content-type
                                   (car content-type)))
              (erase-buffer)
              (insert "<title>Unsupported content type</title>")
              (insert (format "<h1>Content-type %s is unsupported</h1>"
                              (car content-type)))
              (insert (format "<a href=%S>Direct link to the document</a>"
                              url))
              (goto-char (point-min))
	      (eww-display-html charset url nil point buffer encode))
	     ((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 (or encode charset 'utf-8))))
	    (with-current-buffer buffer
	      (plist-put eww-data :url url)
	      (eww--after-page-change)
	      (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)
              ;; Enable undo again so that undo works in text input
              ;; boxes.
              (setq buffer-undo-list nil)))
        (kill-buffer data-buffer)))
    (unless (buffer-live-p buffer)
      (kill-buffer data-buffer))))

(defun eww-parse-headers ()
  (let ((headers nil))
    (goto-char (point-min))
    (while (and (not (eobp))
		(not (eolp)))
      (when (looking-at "\\([^:]+\\): *\\(.*\\)")
	(push (cons (downcase (match-string 1))
		    (match-string 2))
	      headers))
      (forward-line 1))
    (unless (eobp)
      (forward-line 1))
    headers))

(defun eww-detect-charset (html-p)
  (let ((case-fold-search t)
	(pt (point)))
    (or (and html-p
	     (re-search-forward
	      "<meta[\t\n\r ]+[^>]*charset=\"?\\([^\t\n\r \"/>]+\\)[\\\"'.*]" nil t)
	     (goto-char pt)
	     (match-string 1))
	(and (looking-at
	      "[\t\n\r ]*<\\?xml[\t\n\r ]+[^>]*encoding=\"\\([^\"]+\\)")
	     (match-string 1)))))

(declare-function libxml-parse-html-region "xml.c"
		  (start end &optional base-url discard-comments))

(defun eww-display-html (charset url &optional document point buffer encode)
  (unless (fboundp 'libxml-parse-html-region)
    (error "This function requires Emacs to be compiled with libxml2"))
  (unless (buffer-live-p buffer)
    (error "Buffer %s doesn't exist" buffer))
  ;; There should be a better way to abort loading images
  ;; asynchronously.
  (setq url-queue nil)
  (let ((document
	 (or document
	     (list
	      'base (list (cons 'href url))
	      (progn
		(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 and replace NUL with &#0; before parsing.
		  (while (re-search-forward "\\(\r$\\)\\|\0" nil t)
		    (replace-match (if (match-beginning 1) "" "&#0;") t t)))
                (eww--preprocess-html (point) (point-max))
		(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)
	    (inhibit-modification-hooks t)
            ;; Possibly set by the caller, e.g., `eww-render' which
            ;; preserves the old URL #target before chasing redirects.
            (shr-target-id (or 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)
                (meta . eww-tag-meta)
                (a . eww-tag-a)))))
	(erase-buffer)
        (with-delayed-message (2 "Rendering HTML...")
	  (shr-insert-document document))
	(cond
	 (point
	  (goto-char point))
	 (shr-target-id
	  (goto-char (point-min))
          (let ((match (text-property-search-forward
                        'shr-target-id shr-target-id #'member)))
            (when match
              (goto-char (prop-match-beginning match)))))
	 (t
	  (goto-char (point-min))
	  ;; Don't leave point inside forms, because the normal eww
	  ;; commands aren't available there.
	  (while (and (not (eobp))
		      (get-text-property (point) 'eww-form))
	    (forward-line 1)))))
      (eww-size-text-inputs))))

(defun eww-handle-link (dom)
  (let* ((rel (dom-attr dom 'rel))
	 (href (dom-attr dom 'href))
	 (where (assoc
		 ;; The text associated with :rel is case-insensitive.
		 (if rel (downcase rel))
		 '(("next" . :next)
		   ;; Texinfo uses "previous", but HTML specifies
		   ;; "prev", so recognize both.
		   ("previous" . :previous)
		   ("prev" . :previous)
		   ;; HTML specifies "start" but also "contents",
		   ;; and Gtk seems to use "home".  Recognize
		   ;; them all; but store them in different
		   ;; variables so that we can readily choose the
		   ;; "best" one.
		   ("start" . :start)
		   ("home" . :home)
		   ("contents" . :contents)
		   ("up" . :up)))))
    (when (and href where)
      (when (memq (cdr where) '(:next :previous))
        ;; Multi-page isearch support.
        (setq-local multi-isearch-next-buffer-function
                    #'eww-isearch-next-buffer))
      (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)
                (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))

(defun eww-tag-a (dom)
  (eww-handle-link dom)
  (let ((start (point)))
    (shr-tag-a dom)
    (if (dom-attr dom 'href)
        (put-text-property start (point)
                           'keymap
                           (if (mm-images-in-region-p start (point))
                               eww-image-link-keymap
                             eww-link-keymap)))))

(defun eww--limit-string-pixelwise (string pixels)
  (if (not pixels)
      string
    (with-temp-buffer
      (insert string)
      (if (< (eww--pixel-column) pixels)
	  string
	;; Iterate to find appropriate length.
	(while (and (> (eww--pixel-column) pixels)
		    (not (bobp)))
	  (forward-char -1))
	;; Return at least one character.
	(buffer-substring (point-min) (max (point)
					   (1+ (point-min))))))))

(defun eww--pixel-column ()
  (if (not (get-buffer-window (current-buffer)))
      (save-window-excursion
        ;; Avoid errors if the selected window is a dedicated one,
        ;; and they just want to insert a document into it.
        (set-window-dedicated-p nil nil)
	(set-window-buffer nil (current-buffer))
	(car (window-text-pixel-size nil (line-beginning-position) (point))))
    (car (window-text-pixel-size nil (line-beginning-position) (point)))))

(defun eww-update-header-line-format ()
  (setq header-line-format
	(and eww-header-line-format
	     (let ((peer (plist-get eww-data :peer))
                   (url (plist-get eww-data :url))
                   (title (propertize
                           (if (zerop (length (plist-get eww-data :title)))
		               "[untitled]"
                             (plist-get eww-data :title))
                           'face 'variable-pitch)))
	       ;; This connection is https.
	       (when peer
                 (add-face-text-property 0 (length title)
				         (if (plist-get peer :warnings)
				             'eww-invalid-certificate
				           'eww-valid-certificate)
                                         t title))
               ;; Limit the length of the title so that the host name
               ;; of the URL is always visible.
               (when url
                 (setq url (propertize url 'face 'variable-pitch))
                 (let* ((parsed (url-generic-parse-url url))
                        (host-length (string-pixel-width
                                      (propertize
                                       (format "%s://%s" (url-type parsed)
                                               (url-host parsed))
                                       'face 'variable-pitch)))
                        (width (window-width nil t)))
                   (cond
                    ;; The host bit is wider than the window, so nix
                    ;; the title.
                    ((> (+ host-length (string-pixel-width "xxxxx")) width)
                     (setq title ""))
                    ;; Trim the title.
                    ((> (+ (string-pixel-width (concat title "xx"))
                           host-length)
                        width)
                     (setq title
                           (concat
                            (eww--limit-string-pixelwise
                             title (- width host-length
                                      (string-pixel-width
                                       (propertize "...: " 'face
                                                   'variable-pitch))))
                            (propertize "..." 'face 'variable-pitch)))))))
	       (string-replace
		"%" "%%"
		(format-spec
		 eww-header-line-format
		 `((?u . ,(or url ""))
		   (?t . ,title))))))))

(defun eww--after-page-change ()
  (eww-update-header-line-format)
  (eww--rename-buffer))

(defun eww-tag-title (dom)
  (plist-put eww-data :title
	     (replace-regexp-in-string
	      "^ \\| $" ""
	      (replace-regexp-in-string "[ \t\r\n]+" " " (dom-text dom))))
  (eww--after-page-change))

(defun eww-display-raw (buffer &optional encode)
  (let ((data (buffer-substring (point) (point-max))))
    (unless (buffer-live-p buffer)
      (error "Buffer %s doesn't exist" buffer))
    (with-current-buffer buffer
      (let ((inhibit-read-only t))
	(erase-buffer)
	(insert data)
	(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)
  (let ((data (shr-parse-image-data)))
    (unless (buffer-live-p buffer)
      (error "Buffer %s doesn't exist" buffer))
    (with-current-buffer buffer
      (let ((inhibit-read-only t))
	(erase-buffer)
	(shr-put-image data nil))
      (goto-char (point-min)))))

(declare-function mailcap-view-mime "mailcap" (type))
(defun eww-display-pdf ()
  (let ((buf (current-buffer))
        (pos (point)))
    (with-current-buffer (get-buffer-create "*eww pdf*")
      (let ((inhibit-read-only t))
        (erase-buffer)
        (set-buffer-multibyte nil)
        (insert-buffer-substring buf pos)
        (mailcap-view-mime "application/pdf"))
      (if (zerop (buffer-size))
          ;; Buffer contents passed to shell command via temporary file.
          (kill-buffer)
        (goto-char (point-min))
        (pop-to-buffer-same-window (current-buffer))))))

(defun eww-setup-buffer ()
  (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 nil)
  ;; May be set later if there's a next/prev link.
  (setq-local multi-isearch-next-buffer-function nil)
  (unless (eq major-mode 'eww-mode)
    (eww-mode))
  (buffer-disable-undo))

(defun eww-current-url nil
  "Return URI of the Web page the current EWW buffer is visiting."
  (plist-get eww-data :url))

(defun eww-links-at-point ()
  "Return list of URIs, if any, linked at point."
  (seq-filter #'stringp
	      (list (get-text-property (point) 'shr-url)
	            (get-text-property (point) 'image-url))))

(defun eww-view-source ()
  "View the HTML source code of the current page."
  (interactive nil eww-mode)
  (let ((buf (get-buffer-create "*eww-source*"))
        (source (plist-get eww-data :source)))
    (with-current-buffer buf
      (let ((inhibit-read-only t))
	(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))))
        (cond
         ((fboundp 'mhtml-mode)
          (mhtml-mode))
         ((fboundp 'html-mode)
	  (html-mode)))))
    (view-buffer buf)))

(defun eww-toggle-paragraph-direction ()
  "Cycle the paragraph direction between left-to-right, right-to-left and auto."
  (interactive nil eww-mode)
  (setq bidi-paragraph-direction
        (cond ((eq bidi-paragraph-direction 'left-to-right)
               nil)
              ((eq bidi-paragraph-direction 'right-to-left)
               'left-to-right)
              (t
               'right-to-left)))
  (message "The paragraph direction is now %s"
           (if (null bidi-paragraph-direction)
               "automatic"
             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
contains the main textual portion, leaving out navigation menus and
the like."
  (interactive nil eww-mode)
  (let* ((old-data eww-data)
	 (dom (with-temp-buffer
		(insert (plist-get old-data :source))
		(condition-case nil
		    (decode-coding-region (point-min) (point-max) 'utf-8)
		  (coding-system-error nil))
                (eww--preprocess-html (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
                      (list 'base (list (cons 'href base))
                            (eww-highest-readability dom))
		      nil (current-buffer))
    (dolist (elem '(:source :url :title :next :previous :up :peer))
      (plist-put eww-data elem (plist-get old-data elem)))
    (eww--after-page-change)))

(defun eww-score-readability (node)
  (let ((score -1))
    (cond
     ((memq (dom-tag node) '(script head comment))
      (setq score -2))
     ((eq (dom-tag node) 'meta)
      (setq score -1))
     ((eq (dom-tag node) 'img)
      (setq score 2))
     ((eq (dom-tag node) 'a)
      (setq score (- (length (split-string (dom-text node))))))
     (t
      (dolist (elem (dom-children node))
	(cond
         ((stringp elem)
          (setq score (+ score (length (split-string elem)))))
         ((consp elem)
	  (setq score (+ score
			 (or (cdr (assoc :eww-readability-score (cdr elem)))
			     (eww-score-readability elem)))))))))
    ;; Cache the score of the node to avoid recomputing all the time.
    (dom-set-attribute node :eww-readability-score score)
    score))

(defun eww-highest-readability (node)
  (let ((result node)
	highest)
    (dolist (elem (dom-non-text-children node))
      (when (> (or (dom-attr
		    (setq highest (eww-highest-readability elem))
		    :eww-readability-score)
		   most-negative-fixnum)
	       (or (dom-attr result :eww-readability-score)
		   most-negative-fixnum))
        ;; We set a lower bound to how long we accept that the
        ;; readable portion of the page is going to be.
        (when (> (length (split-string (dom-texts highest))) 100)
	  (setq result highest))))
    result))

(defvar-keymap eww-mode-map
  "g" #'eww-reload             ;FIXME: revert-buffer-function instead!
  "G" #'eww
  "M-RET" #'eww-open-in-new-buffer
  "TAB" #'shr-next-link
  "C-M-i" #'shr-previous-link
  "<backtab>" #'shr-previous-link
  "<delete>" #'scroll-down-command
  "l" #'eww-back-url
  "r" #'eww-forward-url
  "n" #'eww-next-url
  "p" #'eww-previous-url
  "u" #'eww-up-url
  "t" #'eww-top-url
  "&" #'eww-browse-with-external-browser
  "d" #'eww-download
  "w" #'eww-copy-page-url
  "A" #'eww-copy-alternate-url
  "C" #'url-cookie-list
  "v" #'eww-view-source
  "R" #'eww-readable
  "H" #'eww-list-histories
  "E" #'eww-set-character-encoding
  "s" #'eww-switch-to-buffer
  "S" #'eww-list-buffers
  "F" #'eww-toggle-fonts
  "D" #'eww-toggle-paragraph-direction
  "M-C" #'eww-toggle-colors
  "M-I" #'eww-toggle-images

  "b" #'eww-add-bookmark
  "B" #'eww-list-bookmarks
  "M-n" #'eww-next-bookmark
  "M-p" #'eww-previous-bookmark

  "<mouse-8>" #'eww-back-url
  "<mouse-9>" #'eww-forward-url

  :menu '("Eww"
          ["Exit" quit-window t]
          ["Close browser" quit-window t]
          ["Reload" eww-reload t]
          ["Follow URL in new buffer" eww-open-in-new-buffer]
          ["Back to previous page" eww-back-url
           :active (not (zerop (length eww-history)))]
          ["Forward to next page" eww-forward-url
           :active (not (zerop eww-history-position))]
          ["Browse with external browser" eww-browse-with-external-browser t]
          ["Download" eww-download t]
          ["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]
          ["Toggle images" eww-toggle-images t]
          ["Character Encoding" eww-set-character-encoding]
          ["Toggle Paragraph Direction" eww-toggle-paragraph-direction]))

(defun eww-context-menu (menu click)
  "Populate MENU with eww commands at CLICK."
  (define-key menu [eww-separator] menu-bar-separator)
  (let ((easy-menu (make-sparse-keymap "Eww")))
    (easy-menu-define nil easy-menu nil
      '("Eww"
        ["Back to previous page" eww-back-url
	 :visible (not (zerop (length eww-history)))]
	["Forward to next page" eww-forward-url
	 :visible (not (zerop eww-history-position))]
	["Reload" eww-reload t]))
    (dolist (item (reverse (lookup-key easy-menu [menu-bar eww])))
      (when (consp item)
        (define-key menu (vector (car item)) (cdr item)))))

  (when (or (mouse-posn-property (event-start click) 'shr-url)
            (mouse-posn-property (event-start click) 'image-url))
    (define-key menu [shr-mouse-browse-url-new-window]
      `(menu-item "Follow URL in new window" ,(if browse-url-new-window-flag
                                                  'shr-mouse-browse-url
                                                'shr-mouse-browse-url-new-window)
                  :help "Browse the URL under the mouse cursor in a new window"))
    (define-key menu [shr-mouse-browse-url]
      `(menu-item "Follow URL" ,(if browse-url-new-window-flag
                                    'shr-mouse-browse-url-new-window
                                  'shr-mouse-browse-url)
                  :help "Browse the URL under the mouse cursor")))

  menu)

(defvar eww-tool-bar-map
  (let ((map (make-sparse-keymap)))
    (dolist (tool-bar-item
             '((quit-window . "close")
               (eww-reload . "refresh")
               (eww-back-url . "left-arrow")
               (eww-forward-url . "right-arrow")
               (eww-view-source . "show")
               (eww-copy-page-url . "copy")
               (eww-add-bookmark . "bookmark_add"))) ;; ...
      (tool-bar-local-item-from-menu
       (car tool-bar-item) (cdr tool-bar-item) map eww-mode-map))
    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.

\\{eww-mode-map}"
  :interactive nil
  (setq-local eww-data (list :title ""))
  (setq-local browse-url-browser-function #'eww-browse-url)
  (add-hook 'after-change-functions #'eww-process-text-input nil t)
  (add-hook 'context-menu-functions 'eww-context-menu 5 t)
  (setq-local eww-history nil)
  (setq-local eww-history-position 0)
  (when (boundp 'tool-bar-map)
    (setq-local tool-bar-map eww-tool-bar-map))
  ;; desktop support
  (setq-local desktop-save-buffer #'eww-desktop-misc-data)
  (setq truncate-lines t)
  (setq-local thing-at-point-provider-alist
              (append thing-at-point-provider-alist
                      '((url . eww--url-at-point))))
  (setq-local bookmark-make-record-function #'eww-bookmark-make-record)
  (buffer-disable-undo)
  (setq-local shr-url-transformer #'eww--transform-url)
  ;; Also rescale images when rescaling the text.
  (add-hook 'text-scale-mode-hook #'eww--rescale-images nil t)
  (setq buffer-read-only t))

(defvar text-scale-mode)
(defvar text-scale-mode-amount)
(defun eww--rescale-images ()
  (let ((scaling (if text-scale-mode
                     (+ 1 (* text-scale-mode-amount 0.1))
                   1)))
    (save-excursion
      (goto-char (point-min))
      (while-let ((match (text-property-search-forward
                          'display nil (lambda (_ value) (imagep value)))))
        (let ((image (prop-match-value match)))
          (unless (image-property image :original-scale)
            (setf (image-property image :original-scale)
                  (or (image-property image :scale) 1)))
          (setf (image-property image :scale)
                (* (image-property image :original-scale) scaling)))))))

(defun eww--url-at-point ()
  "`thing-at-point' provider function."
  (get-text-property (point) 'shr-url))

;;;###autoload
(defun eww-browse-url (url &optional new-window)
  "Ask the EWW browser to load URL.

Interactively, if the variable `browse-url-new-window-flag' is non-nil,
loads the document in a new buffer tab on the window tab-line.  A non-nil
prefix argument reverses the effect of `browse-url-new-window-flag'.

If `tab-bar-mode' is enabled, then whenever a document would
otherwise be loaded in a new buffer, it is loaded in a new tab
in the tab-bar on an existing frame.  See more options in
`eww-browse-url-new-window-is-tab'.

Non-interactively, this uses the optional second argument NEW-WINDOW
instead of `browse-url-new-window-flag'."
  (when new-window
    (when (or (eq eww-browse-url-new-window-is-tab t)
              (and (eq eww-browse-url-new-window-is-tab 'tab-bar)
                   tab-bar-mode))
      (let ((tab-bar-new-tab-choice t))
        (tab-new)))
    (pop-to-buffer-same-window
     (generate-new-buffer
      (format "*eww-%s*" (url-host (url-generic-parse-url
                                    (eww--dwim-expand-url url))))))
    (eww-mode))
  (let ((url-allow-non-local-files t))
    (eww url)))

(function-put 'eww-browse-url 'browse-url-browser-kind 'internal)

(defun eww-back-url ()
  "Go to the previously displayed page."
  (interactive nil eww-mode)
  (when (>= eww-history-position (length eww-history))
    (user-error "No previous page"))
  (eww-save-history)
  (setq eww-history-position (+ eww-history-position 2))
  (eww-restore-history (elt eww-history (1- eww-history-position))))

(defun eww-forward-url ()
  "Go to the next displayed page."
  (interactive nil eww-mode)
  (when (zerop eww-history-position)
    (user-error "No next page"))
  (eww-save-history)
  (eww-restore-history (elt eww-history (1- eww-history-position))))

(defun eww-restore-history (elem)
  (let ((inhibit-read-only t)
	(inhibit-modification-hooks t)
	(text (plist-get elem :text)))
    (setq eww-data elem)
    (if (null text)
	(eww-reload)			; FIXME: restore :point?
      (erase-buffer)
      (insert text)
      (goto-char (plist-get elem :point))
      ;; Make buffer listings more informative.
      (setq list-buffers-directory (plist-get elem :url))
      (eww--after-page-change))))

(defun eww-next-url ()
  "Go to the page marked `next'.
A page is marked `next' if rel=\"next\" appears in a <link>
or <a> tag."
  (interactive nil eww-mode)
  (if (plist-get eww-data :next)
      (eww-browse-url (shr-expand-url (plist-get eww-data :next)
				      (plist-get eww-data :url)))
    (user-error "No `next' on this page")))

(defun eww-previous-url ()
  "Go to the page marked `previous'.
A page is marked `previous' if rel=\"previous\" appears in a <link>
or <a> tag."
  (interactive nil eww-mode)
  (if (plist-get eww-data :previous)
      (eww-browse-url (shr-expand-url (plist-get eww-data :previous)
				      (plist-get eww-data :url)))
    (user-error "No `previous' on this page")))

(defun eww-up-url ()
  "Go to the page marked `up'.
A page is marked `up' if rel=\"up\" appears in a <link>
or <a> tag."
  (interactive nil eww-mode)
  (if (plist-get eww-data :up)
      (eww-browse-url (shr-expand-url (plist-get eww-data :up)
				      (plist-get eww-data :url)))
    (user-error "No `up' on this page")))

(defun eww-top-url ()
  "Go to the page marked `top'.
A page is marked `top' if rel=\"start\", rel=\"home\", or rel=\"contents\"
appears in a <link> or <a> tag."
  (interactive nil eww-mode)
  (let ((best-url (or (plist-get eww-data :start)
		      (plist-get eww-data :contents)
		      (plist-get eww-data :home))))
    (if best-url
	(eww-browse-url (shr-expand-url best-url (plist-get eww-data :url)))
      (user-error "No `top' for this page"))))

(defun eww-reload (&optional local encode)
  "Reload the current page.
If LOCAL is non-nil (interactively, the command was invoked with
a prefix argument), don't reload the page from the network, but
just re-display the HTML already fetched."
  (interactive "P" eww-mode)
  (let ((url (plist-get eww-data :url)))
    (if local
	(if (null (plist-get eww-data :dom))
	    (error "No current HTML data")
	  (eww-display-html 'utf-8 url (plist-get eww-data :dom)
			    (point) (current-buffer)))
      (let ((parsed (url-generic-parse-url url)))
        (if (equal (url-type parsed) "file")
            ;; Use Tramp instead of url.el for files (since url.el
            ;; doesn't work well with Tramp files).
            (let ((eww-buffer (current-buffer)))
              (with-current-buffer (eww--file-buffer (url-filename parsed))
                (eww-render nil url nil eww-buffer)))
          (let ((url-mime-accept-string eww-accept-content-types))
            (eww-retrieve url #'eww-render
		          (list url (point) (current-buffer) encode))))))))

;; Form support.

(defvar eww-form nil)

(defvar-keymap eww-submit-map
  "RET" #'eww-submit
  "C-c C-c" #'eww-submit)

(defvar-keymap eww-submit-file
  "RET" #'eww-select-file
  "C-c C-c" #'eww-submit)

(defvar-keymap eww-checkbox-map
  "SPC" #'eww-toggle-checkbox
  "RET" #'eww-toggle-checkbox
  "C-c C-c" #'eww-submit)

(defvar-keymap eww-text-map
  :full t :parent text-mode-map
  "RET" #'eww-submit
  "C-a" #'eww-beginning-of-text
  "C-c C-c" #'eww-submit
  "C-e" #'eww-end-of-text
  "TAB" #'shr-next-link
  "M-TAB" #'shr-previous-link
  "<backtab>" #'shr-previous-link)

(defvar-keymap eww-textarea-map
  :full t :parent text-mode-map
  "RET" #'forward-line
  "C-c C-c" #'eww-submit
  "TAB" #'shr-next-link
  "M-TAB" #'shr-previous-link
  "<backtab>" #'shr-previous-link)

(defvar-keymap eww-select-map
  :doc "Map for select buttons"
  "RET" #'eww-change-select
  "<follow-link>" 'mouse-face
  "<mouse-2>" #'eww-change-select
  "C-c C-c" #'eww-submit)

(defun eww-beginning-of-text ()
  "Move to the start of the input field."
  (interactive nil eww-mode)
  (goto-char (eww-beginning-of-field)))

(defun eww-end-of-text ()
  "Move to the end of the text in the input field."
  (interactive nil eww-mode)
  (goto-char (eww-end-of-field))
  (let ((start (eww-beginning-of-field)))
    (while (and (equal (following-char) ? )
		(> (point) start))
      (forward-char -1))
    (when (> (point) start)
      (forward-char 1))))

(defun eww-beginning-of-field ()
  (cond
   ((bobp)
    (point))
   ((not (eq (get-text-property (point) 'eww-form)
	     (get-text-property (1- (point)) 'eww-form)))
    (point))
   (t
    (previous-single-property-change
     (point) 'eww-form nil (point-min)))))

(defun eww-end-of-field ()
  (1- (next-single-property-change
       (point) 'eww-form nil (point-max))))

(defun eww-tag-form (dom)
  (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)
      (insert "\n"))
    (insert "\n")
    (when (> (point) start)
      (put-text-property start (1+ start)
			 'eww-form eww-form))))

(defun eww-form-submit (dom)
  (let ((start (point))
	(value (dom-attr dom 'value)))
    (if (null value)
        (shr-generic dom)
      (insert value))
    ;; If the contents of the <button>...</button> turns out to be
    ;; empty, or the value was blank, default to this:
    (when (= (point) start)
      (insert "Submit"))
    (add-face-text-property start (point) 'eww-form-submit)
    (put-text-property start (point) 'eww-form
		       (list :eww-form eww-form
			     :value value
			     :type "submit"
			     :name (dom-attr dom 'name)))
    (put-text-property start (point) 'keymap eww-submit-map)
    (insert " ")))

(defun eww-form-checkbox (dom)
  (let ((start (point)))
    (if (dom-attr dom 'checked)
	(insert eww-form-checkbox-selected-symbol)
      (insert eww-form-checkbox-symbol))
    (add-face-text-property start (point) 'eww-form-checkbox)
    (put-text-property start (point) 'eww-form
		       (list :eww-form eww-form
			     :value (dom-attr dom 'value)
			     :type (downcase (dom-attr dom 'type))
			     :checked (dom-attr dom 'checked)
			     :name (dom-attr dom 'name)))
    (put-text-property start (point) 'keymap eww-checkbox-map)
    (insert " ")))

(defun eww-form-file (dom)
  (let ((start (point))
	(value (dom-attr dom 'value)))
    (setq value
	  (if (zerop (length value))
	      " No file selected"
	    value))
    (insert "Browse")
    (add-face-text-property start (point) 'eww-form-file)
    (insert value)
    (put-text-property start (point) 'eww-form
		       (list :eww-form eww-form
			     :value (dom-attr dom 'value)
			     :type (downcase (dom-attr dom 'type))
			     :name (dom-attr dom 'name)))
    (put-text-property start (point) 'keymap eww-submit-file)
    (insert " ")))

(defun eww-select-file ()
  "Change the value of the upload file menu under point."
  (interactive nil eww-mode)
  (let*  ((input (get-text-property (point) 'eww-form)))
    (let ((filename
	   (let ((insert-default-directory t))
	     (read-file-name "filename:  "))))
      (eww-update-field filename (length "Browse"))
              (plist-put input :filename filename))))

(defun eww-form-text (dom)
  (let ((start (point))
	(type (downcase (or (dom-attr dom 'type) "text")))
	(value (or (dom-attr dom 'value) ""))
	(width (string-to-number (or (dom-attr dom 'size) "40")))
        (readonly-property (if (or (dom-attr dom 'disabled)
				   (dom-attr dom 'readonly))
                               'read-only
                             'inhibit-read-only)))
    (insert value)
    (when (< (length value) width)
      (insert (make-string (- width (length value)) ? )))
    (put-text-property start (point) 'face 'eww-form-text)
    (put-text-property start (point) 'inhibit-read-only t)
    (put-text-property start (point) 'local-map eww-text-map)
    (put-text-property start (point) readonly-property t)
    (put-text-property start (point) 'eww-form
                       (list :eww-form eww-form
                             :value value
                             :type type
                             :name (dom-attr dom 'name)))
    (insert " ")))

(defconst eww-text-input-types '("text" "password" "textarea"
                                 "color" "date" "datetime" "datetime-local"
                                 "email" "month" "number" "search" "tel"
                                 "time" "url" "week")
  "List of input types which represent a text input.
See URL `https://developer.mozilla.org/en-US/docs/Web/HTML/Element/Input'.")

(defun eww-process-text-input (beg end replace-length)
  (when-let* ((pos (and (< (1+ end) (point-max))
		        (> (1- end) (point-min))
		        (cond
		         ((get-text-property (1+ end) 'eww-form)
			  (1+ end))
		         ((get-text-property (1- end) 'eww-form)
			  (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)))
      (when (and form
		 (member type eww-text-input-types))
	(cond
	 ((> length 0)
	  ;; Delete some space at the end.
	  (save-excursion
	    (goto-char
	     (if (equal type "textarea")
		 (1- (line-end-position))
	       (eww-end-of-field)))
	    (while (and (> length 0)
			(eql (char-after (1- (point))) ? ))
	      (delete-region (1- (point)) (point))
	      (cl-decf length))))
	 ((< length 0)
	  ;; Add padding.
	  (save-excursion
	    (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) ? ))
	      (set-text-properties start (point) properties))
	    (goto-char (1- end)))))
	(set-text-properties (cdr (assq :start form))
                             (cdr (assq :end form))
			     properties)
	(let ((value (buffer-substring-no-properties
		      (eww-beginning-of-field)
		      (eww-end-of-field))))
	  (when (string-match " +\\'" value)
	    (setq value (substring value 0 (match-beginning 0))))
	  (plist-put form :value value)
	  (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) ?*)))))))))

(defun eww-tag-textarea (dom)
  (let ((start (point))
        (value (or (dom-text dom) ""))
	(lines (string-to-number (or (dom-attr dom 'rows) "10")))
	(width (string-to-number (or (dom-attr dom 'cols) "10")))
	end)
    (shr-ensure-newline)
    (insert value)
    (shr-ensure-newline)
    (when (< (count-lines start (point)) lines)
      (dotimes (_ (- lines (count-lines start (point))))
	(insert "\n")))
    (setq end (point-marker))
    (goto-char start)
    (while (< (point) end)
      (end-of-line)
      (let ((pad (- width (- (point) (line-beginning-position)))))
	(when (> pad 0)
	  (insert (make-string pad ? ))))
      (add-face-text-property (line-beginning-position)
			      (point) 'eww-form-textarea)
      (put-text-property (line-beginning-position) (point) 'inhibit-read-only t)
      (put-text-property (line-beginning-position) (point)
			 'local-map eww-textarea-map)
      (forward-line 1))
    (put-text-property start (point) 'eww-form
		       (list :eww-form eww-form
			     :value value
			     :type "textarea"
			     :name (dom-attr dom 'name)))
    (put-text-property start (1+ start) 'shr-tab-stop t)))

(defun eww-tag-input (dom)
  (let ((type (downcase (or (dom-attr dom 'type) "text")))
	(start (point)))
    (cond
     ((or (equal type "checkbox")
	  (equal type "radio"))
      (eww-form-checkbox dom))
     ((equal type "file")
      (eww-form-file dom))
     ((equal type "submit")
      (eww-form-submit dom))
     ((equal type "hidden")
      (let ((form eww-form)
	    (name (dom-attr dom 'name)))
	;; Don't add <input type=hidden> elements repeatedly.
	(while (and form
		    (or (not (consp (car form)))
			(not (eq (caar form) 'hidden))
			(not (equal (plist-get (cdr (car form)) :name)
				    name))))
	  (setq form (cdr form)))
	(unless form
	  (nconc eww-form (list
			   (list 'hidden
				 :name name
				 :value (or (dom-attr dom 'value) "")))))))
     (t
      (eww-form-text dom)))
    (unless (= start (point))
      (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-tab-stop t))))

(defun eww-tag-select (dom)
  (shr-ensure-paragraph)
  (let ((menu (list :name (dom-attr dom 'name)
		    :eww-form eww-form))
	(options nil)
	(start (point))
	(max 0))
    (dolist (elem (dom-by-tag dom 'option))
      (when (dom-attr elem 'selected)
	(nconc menu (list :value (dom-attr elem 'value))))
      (let ((display (dom-text elem)))
	(setq max (max max (length display)))
	(push (list 'item
		    :value (dom-attr elem 'value)
		    :display display)
	      options)))
    (when options
      (setq options (nreverse options))
      ;; If we have no selected values, default to the first value.
      (unless (plist-get menu :value)
	(nconc menu (list :value (nth 2 (car options)))))
      (nconc menu options)
      (let ((selected (eww-select-display menu)))
	(insert selected
		(make-string (- max (length selected)) ? )))
      (put-text-property start (point) 'eww-form menu)
      (add-face-text-property start (point) 'eww-form-select)
      (put-text-property start (point) 'keymap eww-select-map)
      (unless (= start (point))
       (put-text-property start (1+ start) 'help-echo "select field")
       (put-text-property start (1+ start) 'shr-tab-stop t))
      (shr-ensure-paragraph))))

(defun eww-select-display (select)
  (let ((value (plist-get select :value))
	display)
    (dolist (elem select)
      (when (and (consp elem)
		 (eq (car elem) 'item)
		 (equal value (plist-get (cdr elem) :value)))
	(setq display (plist-get (cdr elem) :display))))
    display))

(defun eww--form-items (form)
  (cl-loop for elem in form
           when (and (consp elem)
                     (eq (car elem) 'item))
           collect (cdr elem)))

(defun eww-change-select (event)
  "Change the value of the select drop-down menu under point."
  (interactive
   (list last-nonmenu-event)
   eww-mode)
  (mouse-set-point event)
  (let ((input (get-text-property (point) 'eww-form)))
    (popup-menu
     (cons
      "Change Value"
      (mapcar
       (lambda (elem)
         (vector (plist-get elem :display)
                 (lambda ()
                   (interactive)
                   (plist-put input :value (plist-get elem :value))
                   (goto-char (eww-update-field (plist-get elem :display))))
                 t))
       (eww--form-items input)))
     event)))

(defun eww-update-field (string &optional offset)
  (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 (+ (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)) ? ))
    (when (= 0 offset)
      (set-text-properties start new-end properties))
    start))

(defun eww-toggle-checkbox ()
  "Toggle the value of the checkbox under point."
  (interactive nil eww-mode)
  (let* ((input (get-text-property (point) 'eww-form))
	 (type (plist-get input :type)))
    (if (equal type "checkbox")
	(goto-char
	 (1+
	  (if (plist-get input :checked)
	      (progn
		(plist-put input :checked nil)
		(eww-update-field eww-form-checkbox-symbol))
	    (plist-put input :checked t)
	    (eww-update-field eww-form-checkbox-selected-symbol))))
      ;; Radio button.  Switch all other buttons off.
      (let ((name (plist-get input :name)))
	(save-excursion
	  (dolist (elem (eww-inputs (plist-get input :eww-form)))
	    (when (equal (plist-get (cdr elem) :name) name)
	      (goto-char (car elem))
	      (if (not (eq (cdr elem) input))
		  (progn
		    (plist-put (cdr elem) :checked nil)
		    (eww-update-field eww-form-checkbox-symbol))
		(plist-put (cdr elem) :checked t)
		(eww-update-field eww-form-checkbox-selected-symbol)))))
	(forward-char 1)))))

(defun eww-inputs (form)
  (let ((start (point-min))
	(inputs nil))
    (while (and start
		(< start (point-max)))
      (when (or (get-text-property start 'eww-form)
		(setq start (next-single-property-change start 'eww-form)))
	(when (eq (plist-get (get-text-property start 'eww-form) :eww-form)
		  form)
	  (push (cons start (get-text-property start 'eww-form))
		inputs))
	(setq start (next-single-property-change start 'eww-form))))
    (nreverse inputs)))

(defun eww-size-text-inputs ()
  (let ((start (point-min)))
    (while (and start
		(< start (point-max)))
      (when (or (get-text-property start 'eww-form)
		(setq start (next-single-property-change start 'eww-form)))
	(let ((props (get-text-property start 'eww-form)))
          (nconc props (list (cons :start start)))
          (setq start (next-single-property-change
                       start 'eww-form nil (point-max)))
          (nconc props (list (cons :end start))))))))

(defun eww-input-value (input)
  (let ((type (plist-get input :type))
	(value (plist-get input :value)))
    (cond
     ((equal type "textarea")
      (with-temp-buffer
	(insert value)
	(goto-char (point-min))
	(while (re-search-forward "^ +\n\\| +$" nil t)
	  (replace-match "" t t))
	(buffer-string)))
     (t
      (if (string-match " +\\'" value)
	  (substring value 0 (match-beginning 0))
	value)))))

(defun eww-submit ()
  "Submit the current form."
  (interactive nil eww-mode)
  (let* ((this-input (get-text-property (point) 'eww-form))
	 (form (plist-get this-input :eww-form))
	 values next-submit)
    (dolist (elem (sort (eww-inputs form)
			(lambda (o1 o2)
			  (< (car o1) (car o2)))))
      (let* ((input (cdr elem))
	     (input-start (car elem))
	     (name (plist-get input :name)))
	(when name
	  (cond
	   ((member (plist-get input :type) '("checkbox" "radio"))
	    (when (plist-get input :checked)
              (push (cons name (or (plist-get input :value) "on"))
		    values)))
	   ((equal (plist-get input :type) "file")
            (when-let ((file (plist-get input :filename)))
              (push (list "file"
                          (cons "filedata"
                                (with-temp-buffer
                                  (insert-file-contents file)
                                  (buffer-string)))
                          (cons "name" name)
                          (cons "filename" file))
                    values)))
	   ((equal (plist-get input :type) "submit")
	    ;; We want the values from buttons if we hit a button if
	    ;; we hit enter on it, or if it's the first button after
	    ;; the field we did hit return on.
	    (when (or (eq input this-input)
		      (and (not (eq input this-input))
			   (null next-submit)
			   (> input-start (point))))
	      (setq next-submit t)
	      (push (cons name (plist-get input :value))
		    values)))
	   (t
	    (push (cons name (eww-input-value input))
		  values))))))
    (dolist (elem form)
      (when (and (consp elem)
		 (eq (car elem) 'hidden))
	(push (cons (plist-get (cdr elem) :name)
		    (or (plist-get (cdr elem) :value) ""))
	      values)))
    (if (and (stringp (cdr (assq :method form)))
	     (equal (downcase (cdr (assq :method form))) "post"))
	(let ((mtype))
	  (dolist (x values mtype)
	    (if (equal (car x) "file")
		(progn
		  (setq mtype "multipart/form-data"))))
	  (cond ((equal mtype "multipart/form-data")
		 (let ((boundary (mml-compute-boundary '())))
		   (let ((url-request-method "POST")
			 (url-request-extra-headers
			  (list (cons "Content-Type"
				      (concat "multipart/form-data; boundary="
					      boundary))))
			 (url-request-data
			  (mm-url-encode-multipart-form-data values boundary)))
		     (eww-browse-url (shr-expand-url
				      (cdr (assq :action form))
				      (plist-get eww-data :url))))))
		(t
		 (let ((url-request-method "POST")
		       (url-request-extra-headers
			'(("Content-Type" .
			   "application/x-www-form-urlencoded")))
		       (url-request-data
			(mm-url-encode-www-form-urlencoded values)))
		   (eww-browse-url (shr-expand-url
				    (cdr (assq :action form))
				    (plist-get eww-data :url)))))))
      (eww-browse-url
       (concat
	(if (cdr (assq :action form))
	    (shr-expand-url (cdr (assq :action form)) (plist-get eww-data :url))
	  (plist-get eww-data :url))
	"?"
	(mm-url-encode-www-form-urlencoded values))))))

(defun eww-browse-with-external-browser (&optional url)
  "Browse the current URL with an external browser.
The browser to used is specified by the
`browse-url-secondary-browser-function' variable."
  (interactive nil eww-mode)
  (funcall browse-url-secondary-browser-function
           (or url (plist-get eww-data :url))))

(defun eww-remove-tracking (url)
  "Remove the commong utm_ tracking cookies from URLs."
  (replace-regexp-in-string ".utm_.*" "" url))

(defun eww--transform-url (url)
  "Apply `eww-url-transformers'."
  (when url
    (dolist (func eww-url-transformers)
      (setq url (funcall func url)))
    url))

(defun eww-follow-link (&optional external mouse-event)
  "Browse the URL under point.
If EXTERNAL is single prefix, browse the URL using
`browse-url-secondary-browser-function'.

If EXTERNAL is double prefix, browse in new buffer."
  (interactive
   (list current-prefix-arg last-nonmenu-event)
   eww-mode)
  (mouse-set-point mouse-event)
  (let* ((orig-url (get-text-property (point) 'shr-url))
         (url (eww--transform-url orig-url))
         target)
    (cond
     ((not url)
      (message "No link under point"))
     ((string-match-p eww-use-browse-url url)
      ;; This respects the user options `browse-url-handlers'
      ;; and `browse-url-mailto-function'.
      (browse-url url))
     ((and (consp external) (<= (car external) 4))
      (funcall browse-url-secondary-browser-function url)
      (shr--blink-link))
     ;; This is a #target url in the same page as the current one.
     ((and (setq target (url-target (url-generic-parse-url url)))
	   (eww-same-page-p url (plist-get eww-data :url)))
      (let ((point (point)))
	(eww-save-history)
	(plist-put eww-data :url url)
        (goto-char (point-min))
        (if-let ((match (text-property-search-forward 'shr-target-id target #'member)))
            (goto-char (prop-match-beginning match))
          (goto-char (if (equal target "top")
                         (point-min)
                       point)))))
     (t
      (eww-browse-url orig-url external)))))

(defun eww-same-page-p (url1 url2)
  "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)))
    (setf (url-target obj1) nil)
    (setf (url-target obj2) nil)
    (equal (url-recreate-url obj1) (url-recreate-url obj2))))

(defun eww-copy-page-url ()
  "Copy the URL of the current page into the kill ring."
  (interactive nil eww-mode)
  (message "%s" (plist-get eww-data :url))
  (kill-new (plist-get eww-data :url)))

(defun eww-download ()
  "Download URL to `eww-download-directory'.
Use link at point if there is one, else the current page's URL."
  (interactive nil eww-mode)
  (let ((dir (if (stringp eww-download-directory)
                 eww-download-directory
               (funcall eww-download-directory))))
    (access-file dir "Download failed")
    (let ((url (or (get-text-property (point) 'shr-url)
                   (eww-current-url))))
      (if (not url)
          (message "No URL under point")
        (url-retrieve url #'eww-download-callback (list url dir))))))

(defun eww-download-callback (status url dir)
  (unless (plist-get status :error)
    (let* ((obj (url-generic-parse-url url))
           (path (directory-file-name (car (url-path-and-query obj))))
           (file (eww-make-unique-file-name
                  (eww-decode-url-file-name (file-name-nondirectory path))
                  dir)))
      (goto-char (point-min))
      (re-search-forward "\r?\n\r?\n")
      (let ((coding-system-for-write 'no-conversion))
        (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)
        (stem file)
        (suffix ""))
    (when (string-match "\\`\\(.*\\)\\([.][^.]+\\)" file)
      (setq stem (match-string 1 file)
            suffix (match-string 2 file)))
    (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.
If CHARSET is nil then use UTF-8."
  (interactive "zUse character set (default `utf-8'): " eww-mode)
  (if (null charset)
      (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 nil eww-mode)
  (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 nil eww-mode)
  (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 nil eww-mode)
  (message "Colors are now %s"
	   (if (setq shr-use-colors (not shr-use-colors))
	       "on"
	     "off"))
  (eww-reload))

(defun eww-toggle-images ()
  "Toggle whether or not to display images."
  (interactive nil eww-mode)
  (setq shr-inhibit-images (not shr-inhibit-images))
  (eww-reload)
  (message "Images are now %s"
           (if shr-inhibit-images "off" "on")))

;;; Bookmarks code

(defvar eww-bookmarks nil)

(defun eww-add-bookmark ()
  "Bookmark the current page."
  (interactive nil eww-mode)
  (eww-read-bookmarks)
  (dolist (bookmark eww-bookmarks)
    (when (equal (plist-get eww-data :url) (plist-get bookmark :url))
      (user-error "Already bookmarked")))
  (when (y-or-n-p "Bookmark this page?")
    (let ((title (replace-regexp-in-string "[\n\t\r]" " "
					   (plist-get eww-data :title))))
      (setq title (replace-regexp-in-string "\\` +\\| +\\'" "" title))
      (push (list :url (plist-get eww-data :url)
		  :title title
		  :time (current-time-string))
	    eww-bookmarks))
    (eww-write-bookmarks)
    (message "Bookmarked %s (%s)" (plist-get eww-data :url)
	     (plist-get eww-data :title))))

(defun eww-write-bookmarks ()
  (with-temp-file (expand-file-name "eww-bookmarks" eww-bookmarks-directory)
    (insert ";; Auto-generated file; don't edit -*- mode: lisp-data -*-\n")
    (let ((print-length nil)
          (print-level nil))
      (pp eww-bookmarks (current-buffer)))))

(defun eww-read-bookmarks (&optional error-out)
  "Read bookmarks from `eww-bookmarks'.
If ERROR-OUT, signal user-error if there are no bookmarks."
  (let ((file (expand-file-name "eww-bookmarks" eww-bookmarks-directory)))
    (setq eww-bookmarks
	  (unless (zerop (or (file-attribute-size (file-attributes file)) 0))
	    (with-temp-buffer
	      (insert-file-contents file)
	      (read (current-buffer)))))
    (when (and error-out (not eww-bookmarks))
      (user-error "No bookmarks are defined"))))

;;;###autoload
(defun eww-list-bookmarks ()
  "Display the bookmarks."
  (interactive)
  (eww-read-bookmarks t)
  (pop-to-buffer "*eww bookmarks*")
  (eww-bookmark-prepare))

(defun eww-bookmark-prepare ()
  (set-buffer (get-buffer-create "*eww bookmarks*"))
  (eww-bookmark-mode)
  (let* ((width (/ (window-width) 2))
	 (format (format "%%-%ds %%s" width))
	 (inhibit-read-only t)
	 start title)
    (erase-buffer)
    (setq header-line-format (concat " " (format format "Title" "URL")))
    (dolist (bookmark eww-bookmarks)
      (setq start (point)
	    title (plist-get bookmark :title))
      (when (> (length title) 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))))

(defvar eww-bookmark-kill-ring nil)

(defun eww-bookmark-kill ()
  "Kill the current bookmark."
  (interactive nil eww-bookmark-mode)
  (let* ((start (line-beginning-position))
	 (bookmark (get-text-property start 'eww-bookmark))
	 (inhibit-read-only t))
    (unless bookmark
      (user-error "No bookmark on the current line"))
    (forward-line 1)
    (push (buffer-substring start (point)) eww-bookmark-kill-ring)
    (delete-region start (point))
    (setq eww-bookmarks (delq bookmark eww-bookmarks))
    (eww-write-bookmarks)))

(defun eww-bookmark-yank ()
  "Yank a previously killed bookmark to the current line."
  (interactive nil eww-bookmark-mode)
  (unless eww-bookmark-kill-ring
    (user-error "No previously killed bookmark"))
  (beginning-of-line)
  (let ((inhibit-read-only t)
	(start (point))
	bookmark)
    (insert (pop eww-bookmark-kill-ring))
    (setq bookmark (get-text-property start 'eww-bookmark))
    (if (= start (point-min))
	(push bookmark eww-bookmarks)
      (let ((line (count-lines start (point))))
	(setcdr (nthcdr (1- line) eww-bookmarks)
		(cons bookmark (nthcdr line eww-bookmarks)))))
    (eww-write-bookmarks)))

(defun eww-bookmark-browse ()
  "Browse the bookmark under point in eww."
  (interactive nil eww-bookmark-mode)
  (let ((bookmark (get-text-property (line-beginning-position) 'eww-bookmark)))
    (unless bookmark
      (user-error "No bookmark on the current line"))
    (quit-window)
    (eww-browse-url (plist-get bookmark :url))))

(defun eww-next-bookmark ()
  "Go to the next bookmark in the list."
  (interactive nil eww-bookmark-mode)
  (let ((first nil)
	bookmark)
    (unless (get-buffer "*eww bookmarks*")
      (setq first t)
      (eww-read-bookmarks t)
      (eww-bookmark-prepare))
    (with-current-buffer (get-buffer "*eww bookmarks*")
      (when (and (not first)
		 (not (eobp)))
	(forward-line 1))
      (setq bookmark (get-text-property (line-beginning-position)
					'eww-bookmark))
      (unless bookmark
	(user-error "No next bookmark")))
    (eww-browse-url (plist-get bookmark :url))))

(defun eww-previous-bookmark ()
  "Go to the previous bookmark in the list."
  (interactive nil eww-bookmark-mode)
  (let ((first nil)
	bookmark)
    (unless (get-buffer "*eww bookmarks*")
      (setq first t)
      (eww-read-bookmarks t)
      (eww-bookmark-prepare))
    (with-current-buffer (get-buffer "*eww bookmarks*")
      (if first
	  (goto-char (point-max))
	(beginning-of-line))
      ;; On the final line.
      (when (eolp)
	(forward-line -1))
      (if (bobp)
	  (user-error "No previous bookmark")
	(forward-line -1))
      (setq bookmark (get-text-property (line-beginning-position)
					'eww-bookmark)))
    (eww-browse-url (plist-get bookmark :url))))

(defun eww-bookmark-urls ()
  "Get the URLs from the current list of bookmarks."
  (interactive nil eww-boomark-mode)
  (eww-read-bookmarks)
  (mapcar (lambda (x) (plist-get x :url)) eww-bookmarks))

(defvar-keymap eww-bookmark-mode-map
  "C-k" #'eww-bookmark-kill
  "C-y" #'eww-bookmark-yank
  "RET" #'eww-bookmark-browse
  :menu '("Eww Bookmark"
          ["Exit" quit-window t]
          ["Browse" eww-bookmark-browse
           :active (get-text-property (line-beginning-position) 'eww-bookmark)]
          ["Kill" eww-bookmark-kill
           :active (get-text-property (line-beginning-position) 'eww-bookmark)]
          ["Yank" eww-bookmark-yank
           :active eww-bookmark-kill-ring]))

(define-derived-mode eww-bookmark-mode special-mode "eww bookmarks"
  "Mode for listing bookmarks.

\\{eww-bookmark-mode-map}"
  :interactive nil
  (buffer-disable-undo)
  (setq truncate-lines t))

;;; History code

(defun eww-save-history ()
  (plist-put eww-data :point (point))
  (plist-put eww-data :text (buffer-string))
  (let ((history-delete-duplicates nil))
    (add-to-history 'eww-history eww-data eww-history-limit t))
  (setq eww-data (list :title "")))

(defvar eww-current-buffer)

(defun eww-list-histories ()
  "List the eww-histories."
  (interactive)
  (when (null eww-history)
    (error "No eww-histories are defined"))
  (let ((eww-history-trans eww-history)
	(buffer (current-buffer)))
    (set-buffer (get-buffer-create "*eww history*"))
    (eww-history-mode)
    (setq-local eww-current-buffer buffer)
    (let ((inhibit-read-only t)
	  (domain-length 0)
	  (title-length 0)
	  url title format start)
      (erase-buffer)
      (dolist (history eww-history-trans)
	(setq start (point))
	(setq domain-length (max domain-length (length (plist-get history :url))))
	(setq title-length (max title-length (length (plist-get history :title)))))
      (setq format (format "%%-%ds %%-%ds" title-length domain-length)
	    header-line-format
	    (concat " " (format format "Title" "URL")))
      (dolist (history eww-history-trans)
	(setq start (point))
	(setq url (plist-get history :url))
	(setq title (plist-get history :title))
	(insert (format format title url))
	(insert "\n")
	(put-text-property start (1+ start) 'eww-history history))
      (goto-char (point-min)))
    (pop-to-buffer "*eww history*")))

(defun eww-history-browse ()
  "Browse the history under point in eww."
  (interactive nil eww-history-mode)
  (let ((history (get-text-property (line-beginning-position) 'eww-history)))
    (unless history
      (error "No history on the current line"))
    (let ((buffer eww-current-buffer))
      (quit-window)
      (when buffer
	(pop-to-buffer-same-window buffer)))
    (eww-restore-history history)))

(defvar-keymap eww-history-mode-map
  "RET" #'eww-history-browse
  "n" #'next-line
  "p" #'previous-line
  :menu '("Eww History"
          ["Exit" quit-window t]
          ["Browse" eww-history-browse
           :active (get-text-property (line-beginning-position)
                                      'eww-history)]))

(define-derived-mode eww-history-mode special-mode "eww history"
  "Mode for listing eww-histories.

\\{eww-history-mode-map}"
  :interactive nil
  (buffer-disable-undo)
  (setq truncate-lines t))

;;; eww buffers list

(defun eww-list-buffers ()
  "Enlist eww buffers."
  (interactive)
  (let (buffers-info
        (current (current-buffer)))
    (dolist (buffer (buffer-list))
      (with-current-buffer buffer
        (when (derived-mode-p 'eww-mode)
          (push (vector buffer (plist-get eww-data :title)
                        (plist-get eww-data :url))
                buffers-info))))
    (unless buffers-info
      (error "No eww buffers"))
    (setq buffers-info (nreverse buffers-info)) ;more recent on top
    (set-buffer (get-buffer-create "*eww buffers*"))
    (eww-buffers-mode)
    (let ((inhibit-read-only t)
          (domain-length 0)
          (title-length 0)
          url title format start)
      (erase-buffer)
      (dolist (buffer-info buffers-info)
        (setq title-length (max title-length
                                (length (elt buffer-info 1)))
              domain-length (max domain-length
                                 (length (elt buffer-info 2)))))
      (setq format (format "%%-%ds %%-%ds" title-length domain-length)
            header-line-format
            (concat " " (format format "Title" "URL")))
      (let ((line 0)
            (current-buffer-line 1))
        (dolist (buffer-info buffers-info)
          (setq start (point)
                title (elt buffer-info 1)
                url (elt buffer-info 2)
                line (1+ line))
          (insert (format format title url))
          (insert "\n")
          (let ((buffer (elt buffer-info 0)))
            (put-text-property start (1+ start) 'eww-buffer
                               buffer)
            (when (eq current buffer)
              (setq current-buffer-line line))))
        (goto-char (point-min))
        (forward-line (1- current-buffer-line)))))
  (pop-to-buffer "*eww buffers*"))

(defun eww-buffer-select ()
  "Switch to eww buffer."
  (interactive nil eww-buffers-mode)
  (let ((buffer (get-text-property (line-beginning-position)
                                   'eww-buffer)))
    (unless buffer
      (error "No buffer on current line"))
    (quit-window)
    (pop-to-buffer-same-window buffer)))

(defun eww-buffer-show ()
  "Display buffer under point in eww buffer list."
  (let ((buffer (get-text-property (line-beginning-position)
                                   'eww-buffer)))
    (unless buffer
      (error "No buffer on current line"))
    (other-window -1)
    (pop-to-buffer-same-window buffer)
    (other-window 1)))

(defun eww-buffer-show-next ()
  "Move to next eww buffer in the list and display it."
  (interactive nil eww-buffers-mode)
  (forward-line)
  (when (eobp)
    (goto-char (point-min)))
  (eww-buffer-show))

(defun eww-buffer-show-previous ()
  "Move to previous eww buffer in the list and display it."
  (interactive nil eww-buffers-mode)
  (beginning-of-line)
  (when (bobp)
    (goto-char (point-max)))
  (forward-line -1)
  (eww-buffer-show))

(defun eww-buffer-kill ()
  "Kill buffer from eww list."
  (interactive nil eww-buffers-mode)
  (let* ((start (line-beginning-position))
	 (buffer (get-text-property start 'eww-buffer))
	 (inhibit-read-only t))
    (unless buffer
      (user-error "No buffer on the current line"))
    (kill-buffer buffer)
    (forward-line 1)
    (delete-region start (point)))
  (when (eobp)
    (forward-line -1))
  (eww-buffer-show))

(defvar-keymap eww-buffers-mode-map
  "C-k" #'eww-buffer-kill
  "RET" #'eww-buffer-select
  "n" #'eww-buffer-show-next
  "p" #'eww-buffer-show-previous
  :menu '("Eww Buffers"
          ["Exit" quit-window t]
          ["Select" eww-buffer-select
           :active (get-text-property (line-beginning-position) 'eww-buffer)]
          ["Kill" eww-buffer-kill
           :active (get-text-property (line-beginning-position)
                                      'eww-buffer)]))

(define-derived-mode eww-buffers-mode special-mode "eww buffers"
  "Mode for listing buffers.

\\{eww-buffers-mode-map}"
  :interactive nil
  (buffer-disable-undo)
  (setq truncate-lines t))

;;; Desktop support

(defvar eww-desktop-data-save
  '(:url :title :point)
  "List of `eww-data' properties to preserve in the desktop file.
Also used when saving `eww-history'.")

(defun eww-desktop-data-1 (alist)
  (let ((acc  nil)
        (tail alist))
    (while tail
      (let ((k (car  tail))
            (v (cadr tail)))
        (when (memq k eww-desktop-data-save)
          (setq acc (cons k (cons v acc)))))
      (setq tail  (cddr tail)))
    acc))

(defun eww-desktop-history-duplicate (a b)
  (let ((tail a) (r t))
    (while tail
      (if (or (memq (car tail) '(:point)) ; ignore :point
	      (equal (cadr tail)
		     (plist-get b (car tail))))
	  (setq tail (cddr tail))
	(setq tail nil
	      r    nil)))
    ;; .
    r))

(defun eww-desktop-misc-data (_directory)
  "Return a property list with data used to restore eww buffers.
This list will contain, as :history, the list, whose first element is
the value of `eww-data', and the tail is `eww-history'.

If `eww-desktop-remove-duplicates' is non-nil, duplicate
entries (if any) will be removed from the list.

Only the properties listed in `eww-desktop-data-save' are included.
Generally, the list should not include the (usually overly large)
:dom, :source and :text properties."
  (let ((history (mapcar #'eww-desktop-data-1
                         (cons eww-data eww-history))))
    (list :history (if eww-desktop-remove-duplicates
                       (cl-remove-duplicates
                        history :test #'eww-desktop-history-duplicate)
                     history))))

(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
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]."
  (with-current-buffer (get-buffer-create buffer-name)
    (eww-mode)
    ;; NB: eww-history, eww-data are buffer-local per (eww-mode)
    (setq eww-history       (cdr (plist-get misc-data :history))
	  eww-data      (or (car (plist-get misc-data :history))
			    ;; backwards compatibility
			    (list :url (plist-get misc-data :uri))))
    (unless file-name
      (when (plist-get eww-data :url)
	(cl-case eww-restore-desktop
	  ((t auto) (eww (plist-get eww-data :url)))
	  ((nil) (when (zerop (buffer-size))
	           (let ((inhibit-read-only t))
	             (insert (substitute-command-keys
		              eww-restore-reload-prompt))))))))
    ;; .
    (current-buffer)))

(add-to-list 'desktop-locals-to-save
	     'eww-history-position)
(add-to-list 'desktop-buffer-mode-handlers
             '(eww-mode . eww-restore-desktop))

;;; Isearch support

(defun eww-isearch-next-buffer (&optional _buffer wrap)
  "Go to the next page to search using `rel' attribute for navigation."
  (let ((eww-retrieve-command 'sync))
    (if wrap
        (condition-case nil
	    (eww-top-url)
	  (error nil))
      (if isearch-forward
	  (eww-next-url)
        (eww-previous-url))))
  (current-buffer))

;;; bookmark.el support

(declare-function bookmark-make-record-default
                  "bookmark" (&optional no-file no-context posn))
(declare-function bookmark-prop-get "bookmark" (bookmark prop))

(defun eww-bookmark-name ()
  "Create a default bookmark name for the current EWW buffer."
  (plist-get eww-data :title))

(defun eww-bookmark-make-record ()
  "Create a bookmark for the current EWW buffer."
  `(,(eww-bookmark-name)
    ,@(bookmark-make-record-default t)
    (location . ,(plist-get eww-data :url))
    (handler . eww-bookmark-jump)))

;;;###autoload
(defun eww-bookmark-jump (bookmark)
  "Default bookmark handler for EWW buffers."
  (eww (bookmark-prop-get bookmark 'location)))

(put 'eww-bookmark-jump 'bookmark-handler-type "EWW")

(provide 'eww)

;;; Alternate links (RSS and Atom feeds, etc.)

(defun eww--alternate-urls (dom &optional base)
  "Return an alist of alternate links in DOM.

Each element is a list of the form (URL TYPE TITLE) where URL is
the href attribute of the link expanded relative to BASE, TYPE is
its type attribute, and TITLE is its title attribute.  If any of
these attributes is absent, the corresponding element is nil."
  (let ((alternates
         (seq-filter
          (lambda (attrs) (string= (alist-get 'rel attrs)
                                   "alternate"))
          (mapcar #'dom-attributes (dom-by-tag dom 'link)))))
    (mapcar (lambda (alternate)
              (list (url-expand-file-name (alist-get 'href alternate)
                                          base)
                    (alist-get 'type  alternate)
                    (alist-get 'title alternate)))
            alternates)))

(defun eww-read-alternate-url ()
  "Get the URL of an alternate link of this page.

If there is just one alternate link, return its URL.  If there
are multiple alternate links, prompt for one in the minibuffer
with completion.  If there are none, return nil."
  (when-let ((alternates (eww--alternate-urls
                          (plist-get eww-data :dom)
                          (plist-get eww-data :url))))
    (let ((url-max-width
           (seq-max (mapcar #'string-pixel-width
                            (mapcar #'car alternates))))
          (title-max-width
           (seq-max (mapcar #'string-pixel-width
                            (mapcar #'caddr alternates))))
          (sep-width (string-pixel-width " ")))
      (if (cdr alternates)
          (let ((completion-extra-properties
                 (list :annotation-function
                       (lambda (feed)
                         (let* ((attrs (alist-get feed
                                                  alternates
                                                  nil
                                                  nil
                                                  #'string=))
                                (type (car attrs))
                                (title (cadr attrs)))
                           (concat
                            (propertize " " 'display
                                        `(space :align-to
                                                (,(+ sep-width
                                                     url-max-width))))
                            title
                            (when type
                              (concat
                               (propertize " " 'display
                                           `(space :align-to
                                                   (,(+ (* 2 sep-width)
                                                        url-max-width
                                                        title-max-width))))
                               "[" type "]"))))))))
            (completing-read "Alternate URL: " alternates nil t))
        (caar alternates)))))

(defun eww-copy-alternate-url ()
  "Copy the alternate URL of the current page into the kill ring.
If there are multiple alternate links on the current page, prompt
for one in the minibuffer, with completion.
Alternate links are references that an HTML page may include to
point to its alternative representations, such as a translated
version or an RSS feed."
  (interactive nil eww-mode)
  (if-let ((url (eww-read-alternate-url)))
      (progn
        (kill-new url)
        (message "Copied %s to kill ring" url))
    (user-error "No alternate links found on this page!")))

;;; eww.el ends here