code.delx.au - gnu-emacs/blob - lisp/net/eww.el

   1 ;;; eww.el --- Emacs Web Wowser
   2
   3 ;; Copyright (C) 2013-2014 Free Software Foundation, Inc.
   4
   5 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
   6 ;; Keywords: html
   7
   8 ;; This file is part of GNU Emacs.
   9
  10 ;; GNU Emacs is free software: you can redistribute it and/or modify
  11 ;; it under the terms of the GNU General Public License as published by
  12 ;; the Free Software Foundation, either version 3 of the License, or
  13 ;; (at your option) any later version.
  14
  15 ;; GNU Emacs is distributed in the hope that it will be useful,
  16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18 ;; GNU General Public License for more details.
  19
  20 ;; You should have received a copy of the GNU General Public License
  21 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  22
  23 ;;; Commentary:
  24
  25 ;;; Code:
  26
  27 (eval-when-compile (require 'cl))
  28 (require 'format-spec)
  29 (require 'shr)
  30 (require 'url)
  31 (require 'url-queue)
  32 (require 'url-util)                     ; for url-get-url-at-point
  33 (require 'mm-url)
  34 (eval-when-compile (require 'subr-x)) ;; for string-trim
  35
  36 (defgroup eww nil
  37   "Emacs Web Wowser"
  38   :version "25.1"
  39   :link '(custom-manual "(eww) Top")
  40   :group 'web
  41   :prefix "eww-")
  42
  43 (defcustom eww-header-line-format "%t: %u"
  44   "Header line format.
  45 - %t is replaced by the title.
  46 - %u is replaced by the URL."
  47   :version "24.4"
  48   :group 'eww
  49   :type 'string)
  50
  51 (defcustom eww-search-prefix "https://duckduckgo.com/html/?q="
  52   "Prefix URL to search engine"
  53   :version "24.4"
  54   :group 'eww
  55   :type 'string)
  56
  57 (defcustom eww-download-directory "~/Downloads/"
  58   "Directory where files will downloaded."
  59   :version "24.4"
  60   :group 'eww
  61   :type 'string)
  62
  63 (defcustom eww-suggest-uris
  64   '(eww-links-at-point
  65     url-get-url-at-point
  66     eww-current-url)
  67   "List of functions called to form the list of default URIs for `eww'.
  68 Each of the elements is a function returning either a string or a list
  69 of strings.  The results will be joined into a single list with
  70 duplicate entries (if any) removed."
  71   :version "25.1"
  72   :group 'eww
  73   :type 'hook
  74   :options '(eww-links-at-point
  75              url-get-url-at-point
  76              eww-current-url))
  77
  78 (defcustom eww-bookmarks-directory user-emacs-directory
  79   "Directory where bookmark files will be stored."
  80   :version "25.1"
  81   :group 'eww
  82   :type 'string)
  83
  84 (defcustom eww-desktop-remove-duplicates t
  85   "Whether to remove duplicates from the history when saving desktop data.
  86 If non-nil, repetitive EWW history entries (comprising of the URI, the
  87 title, and the point position) will not be saved as part of the Emacs
  88 desktop.  Otherwise, such entries will be retained."
  89   :version "25.1"
  90   :group 'eww
  91   :type 'boolean)
  92
  93 (defcustom eww-restore-desktop nil
  94   "How to restore EWW buffers on `desktop-restore'.
  95 If t or 'auto, the buffers will be reloaded automatically.
  96 If nil, buffers will require manual reload, and will contain the text
  97 specified in `eww-restore-reload-prompt' instead of the actual Web
  98 page contents."
  99   :version "25.1"
 100   :group 'eww
 101   :type '(choice (const :tag "Restore all automatically" t)
 102                  (const :tag "Require manual reload" nil)))
 103
 104 (defcustom eww-restore-reload-prompt
 105   "\n\n *** Use \\[eww-reload] to reload this buffer. ***\n"
 106   "The string to put in the buffers not reloaded on `desktop-restore'.
 107 This prompt will be used if `eww-restore-desktop' is nil.
 108
 109 The string will be passed through `substitute-command-keys'."
 110   :version "25.1"
 111   :group 'eww
 112   :type 'string)
 113
 114 (defcustom eww-history-limit 50
 115   "Maximum number of entries to retain in the history."
 116   :version "25.1"
 117   :group 'eww
 118   :type '(choice (const :tag "Unlimited" nil)
 119                  integer))
 120
 121 (defcustom eww-use-external-browser-for-content-type
 122   "\\`\\(video/\\|audio/\\|application/ogg\\)"
 123   "Always use external browser for specified content-type."
 124   :version "24.4"
 125   :group 'eww
 126   :type '(choice (const :tag "Never" nil)
 127                  regexp))
 128
 129 (defcustom eww-after-render-hook nil
 130   "A hook called after eww has finished rendering the buffer."
 131   :version "25.1"
 132   :group 'eww
 133   :type 'hook)
 134
 135 (defcustom eww-form-checkbox-selected-symbol "[X]"
 136   "Symbol used to represent a selected checkbox.
 137 See also `eww-form-checkbox-symbol'."
 138   :version "24.4"
 139   :group 'eww
 140   :type '(choice (const "[X]")
 141                  (const "☒")            ; Unicode BALLOT BOX WITH X
 142                  (const "☑")            ; Unicode BALLOT BOX WITH CHECK
 143                  string))
 144
 145 (defcustom eww-form-checkbox-symbol "[ ]"
 146   "Symbol used to represent a checkbox.
 147 See also `eww-form-checkbox-selected-symbol'."
 148   :version "24.4"
 149   :group 'eww
 150   :type '(choice (const "[ ]")
 151                  (const "☐")            ; Unicode BALLOT BOX
 152                  string))
 153
 154 (defface eww-form-submit
 155   '((((type x w32 ns) (class color))    ; Like default mode line
 156      :box (:line-width 2 :style released-button)
 157      :background "#808080" :foreground "black"))
 158   "Face for eww buffer buttons."
 159   :version "24.4"
 160   :group 'eww)
 161
 162 (defface eww-form-file
 163   '((((type x w32 ns) (class color))    ; Like default mode line
 164      :box (:line-width 2 :style released-button)
 165      :background "#808080" :foreground "black"))
 166   "Face for eww buffer buttons."
 167   :version "25.1"
 168   :group 'eww)
 169
 170 (defface eww-form-checkbox
 171   '((((type x w32 ns) (class color))    ; Like default mode line
 172      :box (:line-width 2 :style released-button)
 173      :background "lightgrey" :foreground "black"))
 174   "Face for eww buffer buttons."
 175   :version "24.4"
 176   :group 'eww)
 177
 178 (defface eww-form-select
 179   '((((type x w32 ns) (class color))    ; Like default mode line
 180      :box (:line-width 2 :style released-button)
 181      :background "lightgrey" :foreground "black"))
 182   "Face for eww buffer buttons."
 183   :version "24.4"
 184   :group 'eww)
 185
 186 (defface eww-form-text
 187   '((t (:background "#505050"
 188                     :foreground "white"
 189                     :box (:line-width 1))))
 190   "Face for eww text inputs."
 191   :version "24.4"
 192   :group 'eww)
 193
 194 (defface eww-form-textarea
 195   '((t (:background "#C0C0C0"
 196                     :foreground "black"
 197                     :box (:line-width 1))))
 198   "Face for eww textarea inputs."
 199   :version "24.4"
 200   :group 'eww)
 201
 202 (defvar eww-data nil)
 203 (defvar eww-history nil)
 204 (defvar eww-history-position 0)
 205
 206 (defvar eww-local-regex "localhost"
 207   "When this regex is found in the URL, it's not a keyword but an address.")
 208
 209 (defvar eww-link-keymap
 210   (let ((map (copy-keymap shr-map)))
 211     (define-key map "\r" 'eww-follow-link)
 212     map))
 213
 214 (defun eww-suggested-uris nil
 215   "Return the list of URIs to suggest at the `eww' prompt.
 216 This list can be customized via `eww-suggest-uris'."
 217   (let ((obseen (make-vector 42 0))
 218         (uris nil))
 219     (dolist (fun eww-suggest-uris)
 220       (let ((ret (funcall fun)))
 221         (dolist (uri (if (stringp ret) (list ret) ret))
 222           (when (and uri (not (intern-soft uri obseen)))
 223             (intern uri obseen)
 224             (push   uri uris)))))
 225     (nreverse uris)))
 226
 227 ;;;###autoload
 228 (defun eww (url)
 229   "Fetch URL and render the page.
 230 If the input doesn't look like an URL or a domain name, the
 231 word(s) will be searched for via `eww-search-prefix'."
 232   (interactive
 233    (let* ((uris (eww-suggested-uris))
 234           (prompt (concat "Enter URL or keywords"
 235                           (if uris (format " (default %s)" (car uris)) "")
 236                           ": ")))
 237      (list (read-string prompt nil nil uris))))
 238   (setq url (string-trim url))
 239   (cond ((string-match-p "\\`file:/" url))
 240         ;; Don't mangle file: URLs at all.
 241         ((string-match-p "\\`ftp://" url)
 242          (user-error "FTP is not supported."))
 243         (t
 244          (if (and (= (length (split-string url)) 1)
 245                   (or (and (not (string-match-p "\\`[\"\'].*[\"\']\\'" url))
 246                            (> (length (split-string url "[.:]")) 1))
 247                       (string-match eww-local-regex url)))
 248              (progn
 249                (unless (string-match-p "\\`[a-zA-Z][-a-zA-Z0-9+.]*://" url)
 250                  (setq url (concat "http://" url)))
 251                ;; some site don't redirect final /
 252                (when (string= (url-filename (url-generic-parse-url url)) "")
 253                  (setq url (concat url "/"))))
 254            (setq url (concat eww-search-prefix
 255                              (replace-regexp-in-string " " "+" url))))))
 256   (unless (eq major-mode 'eww-mode)
 257     (eww-setup-buffer)
 258     (eww-update-header-line-format)
 259     (let ((inhibit-read-only t))
 260       (insert (format "Loading %s..." url))))
 261   (url-retrieve url 'eww-render
 262                 (list url nil (current-buffer))))
 263
 264 ;;;###autoload (defalias 'browse-web 'eww)
 265
 266 ;;;###autoload
 267 (defun eww-open-file (file)
 268   "Render a file using EWW."
 269   (interactive "fFile: ")
 270   (eww (concat "file://"
 271                (and (memq system-type '(windows-nt ms-dos))
 272                     "/")
 273                (expand-file-name file))))
 274
 275 ;;;###autoload
 276 (defun eww-search-words (&optional beg end)
 277   "Search the web for the text between the point and marker.
 278 See the `eww-search-prefix' variable for the search engine used."
 279   (interactive "r")
 280   (eww (buffer-substring beg end)))
 281
 282 (defun eww-render (status url &optional point buffer encode)
 283   (let ((redirect (plist-get status :redirect)))
 284     (when redirect
 285       (setq url redirect)))
 286   (let* ((headers (eww-parse-headers))
 287          (content-type
 288           (mail-header-parse-content-type
 289            (or (cdr (assoc "content-type" headers))
 290                "text/plain")))
 291          (charset (intern
 292                    (downcase
 293                     (or (cdr (assq 'charset (cdr content-type)))
 294                         (eww-detect-charset (equal (car content-type)
 295                                                    "text/html"))
 296                         "utf-8"))))
 297          (data-buffer (current-buffer)))
 298     (unwind-protect
 299         (progn
 300           (cond
 301            ((and eww-use-external-browser-for-content-type
 302                  (string-match-p eww-use-external-browser-for-content-type
 303                                  (car content-type)))
 304             (eww-browse-with-external-browser url))
 305            ((equal (car content-type) "text/html")
 306             (eww-display-html charset url nil point buffer encode))
 307            ((equal (car content-type) "application/pdf")
 308             (eww-display-pdf))
 309            ((string-match-p "\\`image/" (car content-type))
 310             (eww-display-image buffer)
 311             (eww-update-header-line-format))
 312            (t
 313             (eww-display-raw buffer encode)
 314             (eww-update-header-line-format)))
 315           (plist-put eww-data :url url)
 316           (setq eww-history-position 0)
 317           (run-hooks 'eww-after-render-hook))
 318       (kill-buffer data-buffer))))
 319
 320 (defun eww-parse-headers ()
 321   (let ((headers nil))
 322     (goto-char (point-min))
 323     (while (and (not (eobp))
 324                 (not (eolp)))
 325       (when (looking-at "\\([^:]+\\): *\\(.*\\)")
 326         (push (cons (downcase (match-string 1))
 327                     (match-string 2))
 328               headers))
 329       (forward-line 1))
 330     (unless (eobp)
 331       (forward-line 1))
 332     headers))
 333
 334 (defun eww-detect-charset (html-p)
 335   (let ((case-fold-search t)
 336         (pt (point)))
 337     (or (and html-p
 338              (re-search-forward
 339               "<meta[\t\n\r ]+[^>]*charset=\"?\\([^\t\n\r \"/>]+\\)[\\\"'.*]" nil t)
 340              (goto-char pt)
 341              (match-string 1))
 342         (and (looking-at
 343               "[\t\n\r ]*<\\?xml[\t\n\r ]+[^>]*encoding=\"\\([^\"]+\\)")
 344              (match-string 1)))))
 345
 346 (declare-function libxml-parse-html-region "xml.c"
 347                   (start end &optional base-url))
 348
 349 (defun eww-display-html (charset url &optional document point buffer encode)
 350   (unless (fboundp 'libxml-parse-html-region)
 351     (error "This function requires Emacs to be compiled with libxml2"))
 352   (unless (buffer-live-p buffer)
 353     (error "Buffer %s doesn't exist" buffer))
 354   ;; There should be a better way to abort loading images
 355   ;; asynchronously.
 356   (setq url-queue nil)
 357   (let ((document
 358          (or document
 359              (list
 360               'base (list (cons 'href url))
 361               (progn
 362                 (when (or (and encode
 363                                (not (eq charset encode)))
 364                           (not (eq charset 'utf-8)))
 365                   (condition-case nil
 366                       (decode-coding-region (point) (point-max)
 367                                             (or encode charset))
 368                     (coding-system-error nil)))
 369                 (libxml-parse-html-region (point) (point-max))))))
 370         (source (and (null document)
 371                      (buffer-substring (point) (point-max)))))
 372     (with-current-buffer buffer
 373       (plist-put eww-data :source source)
 374       (plist-put eww-data :dom document)
 375       (let ((inhibit-read-only t)
 376             (after-change-functions nil)
 377             (shr-target-id (url-target (url-generic-parse-url url)))
 378             (shr-external-rendering-functions
 379              '((title . eww-tag-title)
 380                (form . eww-tag-form)
 381                (input . eww-tag-input)
 382                (textarea . eww-tag-textarea)
 383                (body . eww-tag-body)
 384                (select . eww-tag-select)
 385                (link . eww-tag-link)
 386                (a . eww-tag-a))))
 387         (erase-buffer)
 388         (shr-insert-document document)
 389         (cond
 390          (point
 391           (goto-char point))
 392          (shr-target-id
 393           (goto-char (point-min))
 394           (let ((point (next-single-property-change
 395                         (point-min) 'shr-target-id)))
 396             (when point
 397               (goto-char point))))
 398          (t
 399           (goto-char (point-min))
 400           ;; Don't leave point inside forms, because the normal eww
 401           ;; commands aren't available there.
 402           (while (and (not (eobp))
 403                       (get-text-property (point) 'eww-form))
 404             (forward-line 1)))))
 405       (plist-put eww-data :url url)
 406       (setq eww-history-position 0)
 407       (eww-update-header-line-format))))
 408
 409 (defun eww-handle-link (cont)
 410   (let* ((rel (assq :rel cont))
 411         (href (assq :href cont))
 412         (where (assoc
 413                 ;; The text associated with :rel is case-insensitive.
 414                 (if rel (downcase (cdr rel)))
 415                       '(("next" . :next)
 416                         ;; Texinfo uses "previous", but HTML specifies
 417                         ;; "prev", so recognize both.
 418                         ("previous" . :previous)
 419                         ("prev" . :previous)
 420                         ;; HTML specifies "start" but also "contents",
 421                         ;; and Gtk seems to use "home".  Recognize
 422                         ;; them all; but store them in different
 423                         ;; variables so that we can readily choose the
 424                         ;; "best" one.
 425                         ("start" . :start)
 426                         ("home" . :home)
 427                         ("contents" . :contents)
 428                         ("up" . up)))))
 429     (and href
 430          where
 431          (plist-put eww-data (cdr where) (cdr href)))))
 432
 433 (defun eww-tag-link (cont)
 434   (eww-handle-link cont)
 435   (shr-generic cont))
 436
 437 (defun eww-tag-a (cont)
 438   (eww-handle-link cont)
 439   (let ((start (point)))
 440     (shr-tag-a cont)
 441     (put-text-property start (point) 'keymap eww-link-keymap)))
 442
 443 (defun eww-update-header-line-format ()
 444   (if eww-header-line-format
 445       (setq header-line-format
 446             (replace-regexp-in-string
 447              "%" "%%"
 448              ;; FIXME?  Title can be blank.  Default to, eg, last component
 449              ;; of url?
 450              (format-spec eww-header-line-format
 451                           `((?u . ,(or (plist-get eww-data :url) ""))
 452                             (?t . ,(or (plist-get eww-data :title) ""))))))
 453     (setq header-line-format nil)))
 454
 455 (defun eww-tag-title (cont)
 456   (let ((title ""))
 457     (dolist (sub cont)
 458       (when (eq (car sub) 'text)
 459         (setq title (concat title (cdr sub)))))
 460     (plist-put eww-data :title
 461                (replace-regexp-in-string
 462                 "^ \\| $" ""
 463                 (replace-regexp-in-string "[ \t\r\n]+" " " title))))
 464   (eww-update-header-line-format))
 465
 466 (defun eww-tag-body (cont)
 467   (let* ((start (point))
 468          (fgcolor (cdr (or (assq :fgcolor cont)
 469                            (assq :text cont))))
 470          (bgcolor (cdr (assq :bgcolor cont)))
 471          (shr-stylesheet (list (cons 'color fgcolor)
 472                                (cons 'background-color bgcolor))))
 473     (shr-generic cont)
 474     (shr-colorize-region start (point) fgcolor bgcolor)))
 475
 476 (defun eww-display-raw (buffer &optional encode)
 477   (let ((data (buffer-substring (point) (point-max))))
 478     (unless (buffer-live-p buffer)
 479       (error "Buffer %s doesn't exist" buffer))
 480     (with-current-buffer buffer
 481       (let ((inhibit-read-only t))
 482         (erase-buffer)
 483         (insert data)
 484         (unless (eq encode 'utf-8)
 485           (encode-coding-region (point-min) (1+ (length data)) 'utf-8)
 486           (condition-case nil
 487               (decode-coding-region (point-min) (1+ (length data)) encode)
 488             (coding-system-error nil))))
 489       (goto-char (point-min)))))
 490
 491 (defun eww-display-image (buffer)
 492   (let ((data (shr-parse-image-data)))
 493     (unless (buffer-live-p buffer)
 494       (error "Buffer %s doesn't exist" buffer))
 495     (with-current-buffer buffer
 496       (let ((inhibit-read-only t))
 497         (erase-buffer)
 498         (shr-put-image data nil))
 499       (goto-char (point-min)))))
 500
 501 (defun eww-display-pdf ()
 502   (let ((data (buffer-substring (point) (point-max))))
 503     (switch-to-buffer (get-buffer-create "*eww pdf*"))
 504     (let ((coding-system-for-write 'raw-text)
 505           (inhibit-read-only t))
 506       (erase-buffer)
 507       (insert data)
 508       (doc-view-mode)))
 509   (goto-char (point-min)))
 510
 511 (defun eww-setup-buffer (&optional buffer)
 512   (switch-to-buffer
 513    (if (buffer-live-p buffer)
 514        buffer
 515      (get-buffer-create "*eww*")))
 516   (let ((inhibit-read-only t))
 517     (remove-overlays)
 518     (erase-buffer))
 519   (unless (eq major-mode 'eww-mode)
 520     (eww-mode)))
 521
 522 (defun eww-current-url nil
 523   "Return URI of the Web page the current EWW buffer is visiting."
 524   (plist-get eww-data :url))
 525
 526 (defun eww-links-at-point (&optional pt)
 527   "Return list of URIs, if any, linked at point."
 528   (remq nil
 529         (list (get-text-property (point) 'shr-url)
 530               (get-text-property (point) 'image-url))))
 531
 532 (defun eww-view-source ()
 533   "View the HTML source code of the current page."
 534   (interactive)
 535   (let ((buf (get-buffer-create "*eww-source*"))
 536         (source (plist-get eww-data :source)))
 537     (with-current-buffer buf
 538       (let ((inhibit-read-only t))
 539         (delete-region (point-min) (point-max))
 540         (insert (or source "no source"))
 541         (goto-char (point-min))
 542         (when (fboundp 'html-mode)
 543           (html-mode))))
 544     (view-buffer buf)))
 545
 546 (defun eww-readable ()
 547   "View the main \"readable\" parts of the current web page.
 548 This command uses heuristics to find the parts of the web page that
 549 contains the main textual portion, leaving out navigation menus and
 550 the like."
 551   (interactive)
 552   (let* ((old-data eww-data)
 553          (dom (shr-transform-dom
 554                (with-temp-buffer
 555                  (insert (plist-get old-data :source))
 556                  (condition-case nil
 557                      (decode-coding-region (point-min) (point-max) 'utf-8)
 558                    (coding-system-error nil))
 559                  (libxml-parse-html-region (point-min) (point-max))))))
 560     (eww-score-readability dom)
 561     (eww-save-history)
 562     (eww-display-html nil nil
 563                       (shr-retransform-dom
 564                        (eww-highest-readability dom))
 565                       nil (current-buffer))
 566     (dolist (elem '(:source :url :title :next :previous :up))
 567       (plist-put eww-data elem (plist-get old-data elem)))
 568     (eww-update-header-line-format)))
 569
 570 (defun eww-score-readability (node)
 571   (let ((score -1))
 572     (cond
 573      ((memq (car node) '(script head comment))
 574       (setq score -2))
 575      ((eq (car node) 'meta)
 576       (setq score -1))
 577      ((eq (car node) 'img)
 578       (setq score 2))
 579      ((eq (car node) 'a)
 580       (setq score (- (length (split-string
 581                               (or (cdr (assoc 'text (cdr node))) ""))))))
 582      (t
 583       (dolist (elem (cdr node))
 584         (cond
 585          ((and (stringp (cdr elem))
 586                (eq (car elem) 'text))
 587           (setq score (+ score (length (split-string (cdr elem))))))
 588          ((consp (cdr elem))
 589           (setq score (+ score
 590                          (or (cdr (assoc :eww-readability-score (cdr elem)))
 591                              (eww-score-readability elem)))))))))
 592     ;; Cache the score of the node to avoid recomputing all the time.
 593     (setcdr node (cons (cons :eww-readability-score score) (cdr node)))
 594     score))
 595
 596 (defun eww-highest-readability (node)
 597   (let ((result node)
 598         highest)
 599     (dolist (elem (cdr node))
 600       (when (and (consp (cdr elem))
 601                  (> (or (cdr (assoc
 602                               :eww-readability-score
 603                               (setq highest
 604                                     (eww-highest-readability elem))))
 605                         most-negative-fixnum)
 606                     (or (cdr (assoc :eww-readability-score (cdr result)))
 607                         most-negative-fixnum)))
 608         (setq result highest)))
 609     result))
 610
 611 (defvar eww-mode-map
 612   (let ((map (make-sparse-keymap)))
 613     (suppress-keymap map)
 614     (define-key map "q" 'quit-window)
 615     (define-key map "g" 'eww-reload)
 616     (define-key map "G" 'eww)
 617     (define-key map [?\t] 'shr-next-link)
 618     (define-key map [?\M-\t] 'shr-previous-link)
 619     (define-key map [backtab] 'shr-previous-link)
 620     (define-key map [delete] 'scroll-down-command)
 621     (define-key map [?\S-\ ] 'scroll-down-command)
 622     (define-key map "\177" 'scroll-down-command)
 623     (define-key map " " 'scroll-up-command)
 624     (define-key map "l" 'eww-back-url)
 625     (define-key map "r" 'eww-forward-url)
 626     (define-key map "n" 'eww-next-url)
 627     (define-key map "p" 'eww-previous-url)
 628     (define-key map "u" 'eww-up-url)
 629     (define-key map "t" 'eww-top-url)
 630     (define-key map "&" 'eww-browse-with-external-browser)
 631     (define-key map "d" 'eww-download)
 632     (define-key map "w" 'eww-copy-page-url)
 633     (define-key map "C" 'url-cookie-list)
 634     (define-key map "v" 'eww-view-source)
 635     (define-key map "R" 'eww-readable)
 636     (define-key map "H" 'eww-list-histories)
 637     (define-key map "E" 'eww-set-character-encoding)
 638
 639     (define-key map "b" 'eww-add-bookmark)
 640     (define-key map "B" 'eww-list-bookmarks)
 641     (define-key map [(meta n)] 'eww-next-bookmark)
 642     (define-key map [(meta p)] 'eww-previous-bookmark)
 643
 644     (easy-menu-define nil map ""
 645       '("Eww"
 646         ["Exit" quit-window t]
 647         ["Close browser" quit-window t]
 648         ["Reload" eww-reload t]
 649         ["Back to previous page" eww-back-url
 650          :active (not (zerop (length eww-history)))]
 651         ["Forward to next page" eww-forward-url
 652          :active (not (zerop eww-history-position))]
 653         ["Browse with external browser" eww-browse-with-external-browser t]
 654         ["Download" eww-download t]
 655         ["View page source" eww-view-source]
 656         ["Copy page URL" eww-copy-page-url t]
 657         ["List histories" eww-list-histories t]
 658         ["Add bookmark" eww-add-bookmark t]
 659         ["List bookmarks" eww-list-bookmarks t]
 660         ["List cookies" url-cookie-list t]
 661        ["Character Encoding" eww-set-character-encoding]))
 662     map))
 663
 664 (defvar eww-tool-bar-map
 665   (let ((map (make-sparse-keymap)))
 666     (dolist (tool-bar-item
 667              '((quit-window . "close")
 668                (eww-reload . "refresh")
 669                (eww-back-url . "left-arrow")
 670                (eww-forward-url . "right-arrow")
 671                (eww-view-source . "show")
 672                (eww-copy-page-url . "copy")
 673                (eww-add-bookmark . "bookmark_add"))) ;; ...
 674       (tool-bar-local-item-from-menu
 675        (car tool-bar-item) (cdr tool-bar-item) map eww-mode-map))
 676     map)
 677   "Tool bar for `eww-mode'.")
 678
 679 (define-derived-mode eww-mode nil "eww"
 680   "Mode for browsing the web.
 681
 682 \\{eww-mode-map}"
 683   (setq-local eww-data (list :title ""))
 684   (setq-local browse-url-browser-function 'eww-browse-url)
 685   (setq-local after-change-functions 'eww-process-text-input)
 686   (setq-local eww-history nil)
 687   (setq-local eww-history-position 0)
 688   (when (boundp 'tool-bar-map)
 689    (setq-local tool-bar-map eww-tool-bar-map))
 690   ;; desktop support
 691   (setq-local desktop-save-buffer 'eww-desktop-misc-data)
 692   (buffer-disable-undo)
 693   (setq buffer-read-only t))
 694
 695 ;;;###autoload
 696 (defun eww-browse-url (url &optional _new-window)
 697   (when (and (equal major-mode 'eww-mode)
 698              (plist-get eww-data :url))
 699     (eww-save-history))
 700   (eww url))
 701
 702 (defun eww-back-url ()
 703   "Go to the previously displayed page."
 704   (interactive)
 705   (when (>= eww-history-position (length eww-history))
 706     (user-error "No previous page"))
 707   (eww-save-history)
 708   (setq eww-history-position (+ eww-history-position 2))
 709   (eww-restore-history (elt eww-history (1- eww-history-position))))
 710
 711 (defun eww-forward-url ()
 712   "Go to the next displayed page."
 713   (interactive)
 714   (when (zerop eww-history-position)
 715     (user-error "No next page"))
 716   (eww-save-history)
 717   (eww-restore-history (elt eww-history (1- eww-history-position))))
 718
 719 (defun eww-restore-history (elem)
 720   (let ((inhibit-read-only t)
 721         (text (plist-get elem :text)))
 722     (setq eww-data elem)
 723     (if (null text)
 724         (eww-reload)                    ; FIXME: restore :point?
 725       (erase-buffer)
 726       (insert text)
 727       (goto-char (plist-get elem :point))
 728       (eww-update-header-line-format))))
 729
 730 (defun eww-next-url ()
 731   "Go to the page marked `next'.
 732 A page is marked `next' if rel=\"next\" appears in a <link>
 733 or <a> tag."
 734   (interactive)
 735   (if (plist-get eww-data :next)
 736       (eww-browse-url (shr-expand-url (plist-get eww-data :next)
 737                                       (plist-get eww-data :url)))
 738     (user-error "No `next' on this page")))
 739
 740 (defun eww-previous-url ()
 741   "Go to the page marked `previous'.
 742 A page is marked `previous' if rel=\"previous\" appears in a <link>
 743 or <a> tag."
 744   (interactive)
 745   (if (plist-get eww-data :previous)
 746       (eww-browse-url (shr-expand-url (plist-get eww-data :previous)
 747                                       (plist-get eww-data :url)))
 748     (user-error "No `previous' on this page")))
 749
 750 (defun eww-up-url ()
 751   "Go to the page marked `up'.
 752 A page is marked `up' if rel=\"up\" appears in a <link>
 753 or <a> tag."
 754   (interactive)
 755   (if (plist-get eww-data :up)
 756       (eww-browse-url (shr-expand-url (plist-get eww-data :up)
 757                                       (plist-get eww-data :url)))
 758     (user-error "No `up' on this page")))
 759
 760 (defun eww-top-url ()
 761   "Go to the page marked `top'.
 762 A page is marked `top' if rel=\"start\", rel=\"home\", or rel=\"contents\"
 763 appears in a <link> or <a> tag."
 764   (interactive)
 765   (let ((best-url (or (plist-get eww-data :start)
 766                       (plist-get eww-data :contents)
 767                       (plist-get eww-data :home))))
 768     (if best-url
 769         (eww-browse-url (shr-expand-url best-url (plist-get eww-data :url)))
 770       (user-error "No `top' for this page"))))
 771
 772 (defun eww-reload (&optional encode)
 773   "Reload the current page."
 774   (interactive)
 775   (let ((url (plist-get eww-data :url)))
 776     (url-retrieve url 'eww-render
 777                   (list url (point) (current-buffer) encode))))
 778
 779 ;; Form support.
 780
 781 (defvar eww-form nil)
 782
 783 (defvar eww-submit-map
 784   (let ((map (make-sparse-keymap)))
 785     (define-key map "\r" 'eww-submit)
 786     (define-key map [(control c) (control c)] 'eww-submit)
 787     map))
 788
 789 (defvar eww-submit-file
 790   (let ((map (make-sparse-keymap)))
 791     (define-key map "\r" 'eww-select-file)
 792     (define-key map [(control c) (control c)] 'eww-submit)
 793     map))
 794
 795 (defvar eww-checkbox-map
 796   (let ((map (make-sparse-keymap)))
 797     (define-key map " " 'eww-toggle-checkbox)
 798     (define-key map "\r" 'eww-toggle-checkbox)
 799     (define-key map [(control c) (control c)] 'eww-submit)
 800     map))
 801
 802 (defvar eww-text-map
 803   (let ((map (make-keymap)))
 804     (set-keymap-parent map text-mode-map)
 805     (define-key map "\r" 'eww-submit)
 806     (define-key map [(control a)] 'eww-beginning-of-text)
 807     (define-key map [(control c) (control c)] 'eww-submit)
 808     (define-key map [(control e)] 'eww-end-of-text)
 809     (define-key map [?\t] 'shr-next-link)
 810     (define-key map [?\M-\t] 'shr-previous-link)
 811     map))
 812
 813 (defvar eww-textarea-map
 814   (let ((map (make-keymap)))
 815     (set-keymap-parent map text-mode-map)
 816     (define-key map "\r" 'forward-line)
 817     (define-key map [(control c) (control c)] 'eww-submit)
 818     (define-key map [?\t] 'shr-next-link)
 819     (define-key map [?\M-\t] 'shr-previous-link)
 820     map))
 821
 822 (defvar eww-select-map
 823   (let ((map (make-sparse-keymap)))
 824     (define-key map "\r" 'eww-change-select)
 825     (define-key map [(control c) (control c)] 'eww-submit)
 826     map))
 827
 828 (defun eww-beginning-of-text ()
 829   "Move to the start of the input field."
 830   (interactive)
 831   (goto-char (eww-beginning-of-field)))
 832
 833 (defun eww-end-of-text ()
 834   "Move to the end of the text in the input field."
 835   (interactive)
 836   (goto-char (eww-end-of-field))
 837   (let ((start (eww-beginning-of-field)))
 838     (while (and (equal (following-char) ? )
 839                 (> (point) start))
 840       (forward-char -1))
 841     (when (> (point) start)
 842       (forward-char 1))))
 843
 844 (defun eww-beginning-of-field ()
 845   (cond
 846    ((bobp)
 847     (point))
 848    ((not (eq (get-text-property (point) 'eww-form)
 849              (get-text-property (1- (point)) 'eww-form)))
 850     (point))
 851    (t
 852     (previous-single-property-change
 853      (point) 'eww-form nil (point-min)))))
 854
 855 (defun eww-end-of-field ()
 856   (1- (next-single-property-change
 857        (point) 'eww-form nil (point-max))))
 858
 859 (defun eww-tag-form (cont)
 860   (let ((eww-form
 861          (list (assq :method cont)
 862                (assq :action cont)))
 863         (start (point)))
 864     (shr-ensure-paragraph)
 865     (shr-generic cont)
 866     (unless (bolp)
 867       (insert "\n"))
 868     (insert "\n")
 869     (when (> (point) start)
 870       (put-text-property start (1+ start)
 871                          'eww-form eww-form))))
 872
 873 (defun eww-form-submit (cont)
 874   (let ((start (point))
 875         (value (cdr (assq :value cont))))
 876     (setq value
 877           (if (zerop (length value))
 878               "Submit"
 879             value))
 880     (insert value)
 881     (add-face-text-property start (point) 'eww-form-submit)
 882     (put-text-property start (point) 'eww-form
 883                        (list :eww-form eww-form
 884                              :value value
 885                              :type "submit"
 886                              :name (cdr (assq :name cont))))
 887     (put-text-property start (point) 'keymap eww-submit-map)
 888     (insert " ")))
 889
 890 (defun eww-form-checkbox (cont)
 891   (let ((start (point)))
 892     (if (cdr (assq :checked cont))
 893         (insert eww-form-checkbox-selected-symbol)
 894       (insert eww-form-checkbox-symbol))
 895     (add-face-text-property start (point) 'eww-form-checkbox)
 896     (put-text-property start (point) 'eww-form
 897                        (list :eww-form eww-form
 898                              :value (cdr (assq :value cont))
 899                              :type (downcase (cdr (assq :type cont)))
 900                              :checked (cdr (assq :checked cont))
 901                              :name (cdr (assq :name cont))))
 902     (put-text-property start (point) 'keymap eww-checkbox-map)
 903     (insert " ")))
 904
 905 (defun eww-form-file (cont)
 906   (let ((start (point))
 907         (value (cdr (assq :value cont))))
 908     (setq value
 909           (if (zerop (length value))
 910               " No file selected"
 911             value))
 912     (insert "Browse")
 913     (add-face-text-property start (point) 'eww-form-file)
 914     (insert value)
 915     (put-text-property start (point) 'eww-form
 916                        (list :eww-form eww-form
 917                              :value (cdr (assq :value cont))
 918                              :type (downcase (cdr (assq :type cont)))
 919                              :name (cdr (assq :name cont))))
 920     (put-text-property start (point) 'keymap eww-submit-file)
 921     (insert " ")))
 922
 923 (defun eww-select-file ()
 924   "Change the value of the upload file menu under point."
 925   (interactive)
 926   (let*  ((input (get-text-property (point) 'eww-form)))
 927     (let ((filename
 928            (let ((insert-default-directory t))
 929              (read-file-name "filename:  "))))
 930       (eww-update-field filename (length "Browse"))
 931               (plist-put input :filename filename))))
 932
 933 (defun eww-form-text (cont)
 934   (let ((start (point))
 935         (type (downcase (or (cdr (assq :type cont))
 936                             "text")))
 937         (value (or (cdr (assq :value cont)) ""))
 938         (width (string-to-number
 939                 (or (cdr (assq :size cont))
 940                     "40")))
 941         (readonly-property (if (or (cdr (assq :disabled cont))
 942                                    (cdr (assq :readonly cont)))
 943                                'read-only
 944                              'inhibit-read-only)))
 945     (insert value)
 946     (when (< (length value) width)
 947       (insert (make-string (- width (length value)) ? )))
 948     (put-text-property start (point) 'face 'eww-form-text)
 949     (put-text-property start (point) 'inhibit-read-only t)
 950     (put-text-property start (point) 'local-map eww-text-map)
 951     (put-text-property start (point) readonly-property t)
 952     (put-text-property start (point) 'eww-form
 953                        (list :eww-form eww-form
 954                              :value value
 955                              :type type
 956                              :name (cdr (assq :name cont))))
 957     (insert " ")))
 958
 959 (defconst eww-text-input-types '("text" "password" "textarea"
 960                                  "color" "date" "datetime" "datetime-local"
 961                                  "email" "month" "number" "search" "tel"
 962                                  "time" "url" "week")
 963   "List of input types which represent a text input.
 964 See URL `https://developer.mozilla.org/en-US/docs/Web/HTML/Element/Input'.")
 965
 966 (defun eww-process-text-input (beg end length)
 967   (let* ((form (get-text-property (min (1+ end) (point-max)) 'eww-form))
 968          (properties (text-properties-at end))
 969          (type (plist-get form :type)))
 970     (when (and form
 971                (member type eww-text-input-types))
 972       (cond
 973        ((zerop length)
 974         ;; Delete some space at the end.
 975         (save-excursion
 976           (goto-char
 977            (if (equal type "textarea")
 978                (1- (line-end-position))
 979              (eww-end-of-field)))
 980           (let ((new (- end beg)))
 981             (while (and (> new 0)
 982                         (eql (following-char) ? ))
 983               (delete-region (point) (1+ (point)))
 984               (setq new (1- new))))
 985           (set-text-properties beg end properties)))
 986        ((> length 0)
 987         ;; Add padding.
 988         (save-excursion
 989           (goto-char
 990            (if (equal type "textarea")
 991                (1- (line-end-position))
 992              (eww-end-of-field)))
 993           (let ((start (point)))
 994             (insert (make-string length ? ))
 995             (set-text-properties start (point) properties)))))
 996       (let ((value (buffer-substring-no-properties
 997                     (eww-beginning-of-field)
 998                     (eww-end-of-field))))
 999         (when (string-match " +\\'" value)
1000           (setq value (substring value 0 (match-beginning 0))))
1001         (plist-put form :value value)
1002         (when (equal type "password")
1003           ;; Display passwords as asterisks.
1004           (let ((start (eww-beginning-of-field)))
1005             (put-text-property start (+ start (length value))
1006                                'display (make-string (length value) ?*))))))))
1007
1008 (defun eww-tag-textarea (cont)
1009   (let ((start (point))
1010         (value (or (cdr (assq :value cont)) ""))
1011         (lines (string-to-number
1012                 (or (cdr (assq :rows cont))
1013                     "10")))
1014         (width (string-to-number
1015                 (or (cdr (assq :cols cont))
1016                     "10")))
1017         end)
1018     (shr-ensure-newline)
1019     (insert value)
1020     (shr-ensure-newline)
1021     (when (< (count-lines start (point)) lines)
1022       (dotimes (i (- lines (count-lines start (point))))
1023         (insert "\n")))
1024     (setq end (point-marker))
1025     (goto-char start)
1026     (while (< (point) end)
1027       (end-of-line)
1028       (let ((pad (- width (- (point) (line-beginning-position)))))
1029         (when (> pad 0)
1030           (insert (make-string pad ? ))))
1031       (add-face-text-property (line-beginning-position)
1032                               (point) 'eww-form-textarea)
1033       (put-text-property (line-beginning-position) (point) 'inhibit-read-only t)
1034       (put-text-property (line-beginning-position) (point)
1035                          'local-map eww-textarea-map)
1036       (forward-line 1))
1037     (put-text-property start (point) 'eww-form
1038                        (list :eww-form eww-form
1039                              :value value
1040                              :type "textarea"
1041                              :name (cdr (assq :name cont))))))
1042
1043 (defun eww-tag-input (cont)
1044   (let ((type (downcase (or (cdr (assq :type cont))
1045                              "text")))
1046         (start (point)))
1047     (cond
1048      ((or (equal type "checkbox")
1049           (equal type "radio"))
1050       (eww-form-checkbox cont))
1051      ((equal type "file")
1052       (eww-form-file cont))
1053      ((equal type "submit")
1054       (eww-form-submit cont))
1055      ((equal type "hidden")
1056       (let ((form eww-form)
1057             (name (cdr (assq :name cont))))
1058         ;; Don't add <input type=hidden> elements repeatedly.
1059         (while (and form
1060                     (or (not (consp (car form)))
1061                         (not (eq (caar form) 'hidden))
1062                         (not (equal (plist-get (cdr (car form)) :name)
1063                                     name))))
1064           (setq form (cdr form)))
1065         (unless form
1066           (nconc eww-form (list
1067                            (list 'hidden
1068                                  :name name
1069                                  :value (cdr (assq :value cont))))))))
1070      (t
1071       (eww-form-text cont)))
1072     (unless (= start (point))
1073       (put-text-property start (1+ start) 'help-echo "Input field"))))
1074
1075 (defun eww-tag-select (cont)
1076   (shr-ensure-paragraph)
1077   (let ((menu (list :name (cdr (assq :name cont))
1078                     :eww-form eww-form))
1079         (options nil)
1080         (start (point))
1081         (max 0)
1082         opelem)
1083     (if (eq (car (car cont)) 'optgroup)
1084         (dolist (groupelem cont)
1085           (unless (cdr (assq :disabled (cdr groupelem)))
1086             (setq opelem (append opelem (cdr (cdr groupelem))))))
1087       (setq opelem cont))
1088     (dolist (elem opelem)
1089       (when (eq (car elem) 'option)
1090         (when (cdr (assq :selected (cdr elem)))
1091           (nconc menu (list :value
1092                             (cdr (assq :value (cdr elem))))))
1093         (let ((display (or (cdr (assq 'text (cdr elem))) "")))
1094           (setq max (max max (length display)))
1095           (push (list 'item
1096                       :value (cdr (assq :value (cdr elem)))
1097                       :display display)
1098                 options))))
1099     (when options
1100       (setq options (nreverse options))
1101       ;; If we have no selected values, default to the first value.
1102       (unless (plist-get menu :value)
1103         (nconc menu (list :value (nth 2 (car options)))))
1104       (nconc menu options)
1105       (let ((selected (eww-select-display menu)))
1106         (insert selected
1107                 (make-string (- max (length selected)) ? )))
1108       (put-text-property start (point) 'eww-form menu)
1109       (add-face-text-property start (point) 'eww-form-select)
1110       (put-text-property start (point) 'keymap eww-select-map)
1111       (unless (= start (point))
1112        (put-text-property start (1+ start) 'help-echo "select field"))
1113       (shr-ensure-paragraph))))
1114
1115 (defun eww-select-display (select)
1116   (let ((value (plist-get select :value))
1117         display)
1118     (dolist (elem select)
1119       (when (and (consp elem)
1120                  (eq (car elem) 'item)
1121                  (equal value (plist-get (cdr elem) :value)))
1122         (setq display (plist-get (cdr elem) :display))))
1123     display))
1124
1125 (defun eww-change-select ()
1126   "Change the value of the select drop-down menu under point."
1127   (interactive)
1128   (let* ((input (get-text-property (point) 'eww-form))
1129          (completion-ignore-case t)
1130          (options
1131           (delq nil
1132                 (mapcar (lambda (elem)
1133                           (and (consp elem)
1134                                (eq (car elem) 'item)
1135                                (cons (plist-get (cdr elem) :display)
1136                                      (plist-get (cdr elem) :value))))
1137                         input)))
1138          (display
1139           (completing-read "Change value: " options nil 'require-match))
1140          (inhibit-read-only t))
1141     (plist-put input :value (cdr (assoc-string display options t)))
1142     (goto-char
1143      (eww-update-field display))))
1144
1145 (defun eww-update-field (string &optional offset)
1146   (if (not offset) (setq offset 0))
1147   (let ((properties (text-properties-at (point)))
1148         (start (+ (eww-beginning-of-field) offset))
1149         (current-end (1+ (eww-end-of-field)))
1150         (new-end (1+ (+ (eww-beginning-of-field) (length string)))))
1151     (delete-region start current-end)
1152     (forward-char offset)
1153     (insert string
1154             (make-string (- (- (+ new-end offset) start) (length string)) ? ))
1155     (if (= 0 offset) (set-text-properties start new-end properties))
1156     start))
1157
1158 (defun eww-toggle-checkbox ()
1159   "Toggle the value of the checkbox under point."
1160   (interactive)
1161   (let* ((input (get-text-property (point) 'eww-form))
1162          (type (plist-get input :type)))
1163     (if (equal type "checkbox")
1164         (goto-char
1165          (1+
1166           (if (plist-get input :checked)
1167               (progn
1168                 (plist-put input :checked nil)
1169                 (eww-update-field eww-form-checkbox-symbol))
1170             (plist-put input :checked t)
1171             (eww-update-field eww-form-checkbox-selected-symbol))))
1172       ;; Radio button.  Switch all other buttons off.
1173       (let ((name (plist-get input :name)))
1174         (save-excursion
1175           (dolist (elem (eww-inputs (plist-get input :eww-form)))
1176             (when (equal (plist-get (cdr elem) :name) name)
1177               (goto-char (car elem))
1178               (if (not (eq (cdr elem) input))
1179                   (progn
1180                     (plist-put input :checked nil)
1181                     (eww-update-field eww-form-checkbox-symbol))
1182                 (plist-put input :checked t)
1183                 (eww-update-field eww-form-checkbox-selected-symbol)))))
1184         (forward-char 1)))))
1185
1186 (defun eww-inputs (form)
1187   (let ((start (point-min))
1188         (inputs nil))
1189     (while (and start
1190                 (< start (point-max)))
1191       (when (or (get-text-property start 'eww-form)
1192                 (setq start (next-single-property-change start 'eww-form)))
1193         (when (eq (plist-get (get-text-property start 'eww-form) :eww-form)
1194                   form)
1195           (push (cons start (get-text-property start 'eww-form))
1196                 inputs))
1197         (setq start (next-single-property-change start 'eww-form))))
1198     (nreverse inputs)))
1199
1200 (defun eww-input-value (input)
1201   (let ((type (plist-get input :type))
1202         (value (plist-get input :value)))
1203     (cond
1204      ((equal type "textarea")
1205       (with-temp-buffer
1206         (insert value)
1207         (goto-char (point-min))
1208         (while (re-search-forward "^ +\n\\| +$" nil t)
1209           (replace-match "" t t))
1210         (buffer-string)))
1211      (t
1212       (if (string-match " +\\'" value)
1213           (substring value 0 (match-beginning 0))
1214         value)))))
1215
1216 (defun eww-submit ()
1217   "Submit the current form."
1218   (interactive)
1219   (let* ((this-input (get-text-property (point) 'eww-form))
1220          (form (plist-get this-input :eww-form))
1221          values next-submit)
1222     (dolist (elem (sort (eww-inputs form)
1223                         (lambda (o1 o2)
1224                           (< (car o1) (car o2)))))
1225       (let* ((input (cdr elem))
1226              (input-start (car elem))
1227              (name (plist-get input :name)))
1228         (when name
1229           (cond
1230            ((member (plist-get input :type) '("checkbox" "radio"))
1231             (when (plist-get input :checked)
1232               (push (cons name (plist-get input :value))
1233                     values)))
1234            ((equal (plist-get input :type) "file")
1235             (push (cons "file"
1236                         (list (cons "filedata"
1237                                     (with-temp-buffer
1238                                       (insert-file-contents
1239                                        (plist-get input :filename))
1240                                       (buffer-string)))
1241                               (cons "name" (plist-get input :name))
1242                               (cons "filename" (plist-get input :filename))))
1243                   values))
1244            ((equal (plist-get input :type) "submit")
1245             ;; We want the values from buttons if we hit a button if
1246             ;; we hit enter on it, or if it's the first button after
1247             ;; the field we did hit return on.
1248             (when (or (eq input this-input)
1249                       (and (not (eq input this-input))
1250                            (null next-submit)
1251                            (> input-start (point))))
1252               (setq next-submit t)
1253               (push (cons name (plist-get input :value))
1254                     values)))
1255            (t
1256             (push (cons name (eww-input-value input))
1257                   values))))))
1258     (dolist (elem form)
1259       (when (and (consp elem)
1260                  (eq (car elem) 'hidden))
1261         (push (cons (plist-get (cdr elem) :name)
1262                     (or (plist-get (cdr elem) :value) ""))
1263               values)))
1264     (if (and (stringp (cdr (assq :method form)))
1265              (equal (downcase (cdr (assq :method form))) "post"))
1266         (let ((mtype))
1267           (dolist (x values mtype)
1268             (if (equal (car x) "file")
1269                 (progn
1270                   (setq mtype "multipart/form-data"))))
1271           (cond ((equal mtype "multipart/form-data")
1272                  (let ((boundary (mml-compute-boundary '())))
1273                    (let ((url-request-method "POST")
1274                          (url-request-extra-headers
1275                           (list (cons "Content-Type"
1276                                       (concat "multipart/form-data; boundary="
1277                                               boundary))))
1278                          (url-request-data
1279                           (mm-url-encode-multipart-form-data values boundary)))
1280                      (eww-browse-url (shr-expand-url
1281                                       (cdr (assq :action form))
1282                                       (plist-get eww-data :url))))))
1283                 (t
1284                  (let ((url-request-method "POST")
1285                        (url-request-extra-headers
1286                         '(("Content-Type" .
1287                            "application/x-www-form-urlencoded")))
1288                        (url-request-data
1289                         (mm-url-encode-www-form-urlencoded values)))
1290                    (eww-browse-url (shr-expand-url
1291                                     (cdr (assq :action form))
1292                                     (plist-get eww-data :url)))))))
1293       (eww-browse-url
1294        (concat
1295         (if (cdr (assq :action form))
1296             (shr-expand-url (cdr (assq :action form))
1297                             (plist-get eww-data :url))
1298           (plist-get eww-data :url))
1299         "?"
1300         (mm-url-encode-www-form-urlencoded values))))))
1301
1302 (defun eww-browse-with-external-browser (&optional url)
1303   "Browse the current URL with an external browser.
1304 The browser to used is specified by the `shr-external-browser' variable."
1305   (interactive)
1306   (funcall shr-external-browser (or url (plist-get eww-data :url))))
1307
1308 (defun eww-follow-link (&optional external mouse-event)
1309   "Browse the URL under point.
1310 If EXTERNAL, browse the URL using `shr-external-browser'."
1311   (interactive (list current-prefix-arg last-nonmenu-event))
1312   (mouse-set-point mouse-event)
1313   (let ((url (get-text-property (point) 'shr-url)))
1314     (cond
1315      ((not url)
1316       (message "No link under point"))
1317      ((string-match "^mailto:" url)
1318       (browse-url-mail url))
1319      (external
1320       (funcall shr-external-browser url))
1321      ;; This is a #target url in the same page as the current one.
1322      ((and (url-target (url-generic-parse-url url))
1323            (eww-same-page-p url (plist-get eww-data :url)))
1324       (let ((dom (plist-get eww-data :dom)))
1325         (eww-save-history)
1326         (eww-display-html 'utf-8 url dom nil (current-buffer))))
1327      (t
1328       (eww-browse-url url)))))
1329
1330 (defun eww-same-page-p (url1 url2)
1331   "Return non-nil if both URLs represent the same page.
1332 Differences in #targets are ignored."
1333   (let ((obj1 (url-generic-parse-url url1))
1334         (obj2 (url-generic-parse-url url2)))
1335     (setf (url-target obj1) nil)
1336     (setf (url-target obj2) nil)
1337     (equal (url-recreate-url obj1) (url-recreate-url obj2))))
1338
1339 (defun eww-copy-page-url ()
1340   (interactive)
1341   (message "%s" (plist-get eww-data :url))
1342   (kill-new (plist-get eww-data :url)))
1343
1344 (defun eww-download ()
1345   "Download URL under point to `eww-download-directory'."
1346   (interactive)
1347   (let ((url (get-text-property (point) 'shr-url)))
1348     (if (not url)
1349         (message "No URL under point")
1350       (url-retrieve url 'eww-download-callback (list url)))))
1351
1352 (defun eww-download-callback (status url)
1353   (unless (plist-get status :error)
1354     (let* ((obj (url-generic-parse-url url))
1355            (path (car (url-path-and-query obj)))
1356            (file (eww-make-unique-file-name (file-name-nondirectory path)
1357                                             eww-download-directory)))
1358       (goto-char (point-min))
1359       (re-search-forward "\r?\n\r?\n")
1360       (write-region (point) (point-max) file)
1361       (message "Saved %s" file))))
1362
1363 (defun eww-make-unique-file-name (file directory)
1364     (cond
1365      ((zerop (length file))
1366       (setq file "!"))
1367      ((string-match "\\`[.]" file)
1368       (setq file (concat "!" file))))
1369     (let ((count 1))
1370       (while (file-exists-p (expand-file-name file directory))
1371         (setq file
1372               (if (string-match "\\`\\(.*\\)\\([.][^.]+\\)" file)
1373                   (format "%s(%d)%s" (match-string 1 file)
1374                           count (match-string 2 file))
1375                 (format "%s(%d)" file count)))
1376         (setq count (1+ count)))
1377       (expand-file-name file directory)))
1378
1379 (defun eww-set-character-encoding (encode)
1380   "Set character encoding."
1381   (interactive "sSet Character Encoding (default utf-8): ")
1382   (cond ((zerop (length encode))
1383         (eww-reload 'utf-8))
1384        (t
1385         (if (not (coding-system-p (intern encode)))
1386             (user-error "Invalid encodeing type.")
1387           (eww-reload (intern encode))))))
1388
1389 ;;; Bookmarks code
1390
1391 (defvar eww-bookmarks nil)
1392
1393 (defun eww-add-bookmark ()
1394   "Add the current page to the bookmarks."
1395   (interactive)
1396   (eww-read-bookmarks)
1397   (dolist (bookmark eww-bookmarks)
1398     (when (equal (plist-get eww-data :url) (plist-get bookmark :url))
1399       (user-error "Already bookmarked")))
1400   (if (y-or-n-p "bookmark this page? ")
1401       (progn
1402         (let ((title (replace-regexp-in-string "[\n\t\r]" " "
1403                                                (plist-get eww-data :title))))
1404           (setq title (replace-regexp-in-string "\\` +\\| +\\'" "" title))
1405           (push (list :url (plist-get eww-data :url)
1406                       :title title
1407                       :time (current-time-string))
1408                 eww-bookmarks))
1409         (eww-write-bookmarks)
1410         (message "Bookmarked %s (%s)" (plist-get eww-data :url)
1411                  (plist-get eww-data :title)))))
1412
1413 (defun eww-write-bookmarks ()
1414   (with-temp-file (expand-file-name "eww-bookmarks" eww-bookmarks-directory)
1415     (insert ";; Auto-generated file; don't edit\n")
1416     (pp eww-bookmarks (current-buffer))))
1417
1418 (defun eww-read-bookmarks ()
1419   (let ((file (expand-file-name "eww-bookmarks" eww-bookmarks-directory)))
1420     (setq eww-bookmarks
1421           (unless (zerop (or (nth 7 (file-attributes file)) 0))
1422             (with-temp-buffer
1423               (insert-file-contents file)
1424               (read (current-buffer)))))))
1425
1426 ;;;###autoload
1427 (defun eww-list-bookmarks ()
1428   "Display the bookmarks."
1429   (interactive)
1430   (eww-bookmark-prepare)
1431   (pop-to-buffer "*eww bookmarks*"))
1432
1433 (defun eww-bookmark-prepare ()
1434   (eww-read-bookmarks)
1435   (unless eww-bookmarks
1436     (user-error "No bookmarks are defined"))
1437   (set-buffer (get-buffer-create "*eww bookmarks*"))
1438   (eww-bookmark-mode)
1439   (let ((format "%-40s %s")
1440         (inhibit-read-only t)
1441         start url)
1442     (erase-buffer)
1443     (setq header-line-format (concat " " (format format "URL" "Title")))
1444     (dolist (bookmark eww-bookmarks)
1445       (setq start (point))
1446       (setq url (plist-get bookmark :url))
1447       (when (> (length url) 40)
1448         (setq url (substring url 0 40)))
1449       (insert (format format url
1450                       (plist-get bookmark :title))
1451               "\n")
1452       (put-text-property start (1+ start) 'eww-bookmark bookmark))
1453     (goto-char (point-min))))
1454
1455 (defvar eww-bookmark-kill-ring nil)
1456
1457 (defun eww-bookmark-kill ()
1458   "Kill the current bookmark."
1459   (interactive)
1460   (let* ((start (line-beginning-position))
1461          (bookmark (get-text-property start 'eww-bookmark))
1462          (inhibit-read-only t))
1463     (unless bookmark
1464       (user-error "No bookmark on the current line"))
1465     (forward-line 1)
1466     (push (buffer-substring start (point)) eww-bookmark-kill-ring)
1467     (delete-region start (point))
1468     (setq eww-bookmarks (delq bookmark eww-bookmarks))
1469     (eww-write-bookmarks)))
1470
1471 (defun eww-bookmark-yank ()
1472   "Yank a previously killed bookmark to the current line."
1473   (interactive)
1474   (unless eww-bookmark-kill-ring
1475     (user-error "No previously killed bookmark"))
1476   (beginning-of-line)
1477   (let ((inhibit-read-only t)
1478         (start (point))
1479         bookmark)
1480     (insert (pop eww-bookmark-kill-ring))
1481     (setq bookmark (get-text-property start 'eww-bookmark))
1482     (if (= start (point-min))
1483         (push bookmark eww-bookmarks)
1484       (let ((line (count-lines start (point))))
1485         (setcdr (nthcdr (1- line) eww-bookmarks)
1486                 (cons bookmark (nthcdr line eww-bookmarks)))))
1487     (eww-write-bookmarks)))
1488
1489 (defun eww-bookmark-browse ()
1490   "Browse the bookmark under point in eww."
1491   (interactive)
1492   (let ((bookmark (get-text-property (line-beginning-position) 'eww-bookmark)))
1493     (unless bookmark
1494       (user-error "No bookmark on the current line"))
1495     (quit-window)
1496     (eww-browse-url (plist-get bookmark :url))))
1497
1498 (defun eww-next-bookmark ()
1499   "Go to the next bookmark in the list."
1500   (interactive)
1501   (let ((first nil)
1502         bookmark)
1503     (unless (get-buffer "*eww bookmarks*")
1504       (setq first t)
1505       (eww-bookmark-prepare))
1506     (with-current-buffer (get-buffer "*eww bookmarks*")
1507       (when (and (not first)
1508                  (not (eobp)))
1509         (forward-line 1))
1510       (setq bookmark (get-text-property (line-beginning-position)
1511                                         'eww-bookmark))
1512       (unless bookmark
1513         (user-error "No next bookmark")))
1514     (eww-browse-url (plist-get bookmark :url))))
1515
1516 (defun eww-previous-bookmark ()
1517   "Go to the previous bookmark in the list."
1518   (interactive)
1519   (let ((first nil)
1520         bookmark)
1521     (unless (get-buffer "*eww bookmarks*")
1522       (setq first t)
1523       (eww-bookmark-prepare))
1524     (with-current-buffer (get-buffer "*eww bookmarks*")
1525       (if first
1526           (goto-char (point-max))
1527         (beginning-of-line))
1528       ;; On the final line.
1529       (when (eolp)
1530         (forward-line -1))
1531       (if (bobp)
1532           (user-error "No previous bookmark")
1533         (forward-line -1))
1534       (setq bookmark (get-text-property (line-beginning-position)
1535                                         'eww-bookmark)))
1536     (eww-browse-url (plist-get bookmark :url))))
1537
1538 (defvar eww-bookmark-mode-map
1539   (let ((map (make-sparse-keymap)))
1540     (suppress-keymap map)
1541     (define-key map "q" 'quit-window)
1542     (define-key map [(control k)] 'eww-bookmark-kill)
1543     (define-key map [(control y)] 'eww-bookmark-yank)
1544     (define-key map "\r" 'eww-bookmark-browse)
1545
1546     (easy-menu-define nil map
1547       "Menu for `eww-bookmark-mode-map'."
1548       '("Eww Bookmark"
1549         ["Exit" quit-window t]
1550         ["Browse" eww-bookmark-browse
1551          :active (get-text-property (line-beginning-position) 'eww-bookmark)]
1552         ["Kill" eww-bookmark-kill
1553          :active (get-text-property (line-beginning-position) 'eww-bookmark)]
1554         ["Yank" eww-bookmark-yank
1555          :active eww-bookmark-kill-ring]))
1556     map))
1557
1558 (define-derived-mode eww-bookmark-mode nil "eww bookmarks"
1559   "Mode for listing bookmarks.
1560
1561 \\{eww-bookmark-mode-map}"
1562   (buffer-disable-undo)
1563   (setq buffer-read-only t
1564         truncate-lines t))
1565
1566 ;;; History code
1567
1568 (defun eww-save-history ()
1569   (plist-put eww-data :point (point))
1570   (plist-put eww-data :text (buffer-string))
1571   (push eww-data eww-history)
1572   (setq eww-data (list :title ""))
1573   ;; Don't let the history grow infinitely.  We store quite a lot of
1574   ;; data per page.
1575   (when-let (tail (and eww-history-limit
1576                        (nthcdr eww-history-limit eww-history)))
1577     (setcdr tail nil)))
1578
1579 (defun eww-list-histories ()
1580   "List the eww-histories."
1581   (interactive)
1582   (when (null eww-history)
1583     (error "No eww-histories are defined"))
1584   (let ((eww-history-trans eww-history))
1585     (set-buffer (get-buffer-create "*eww history*"))
1586     (eww-history-mode)
1587     (let ((inhibit-read-only t)
1588           (domain-length 0)
1589           (title-length 0)
1590           url title format start)
1591       (erase-buffer)
1592       (dolist (history eww-history-trans)
1593         (setq start (point))
1594         (setq domain-length (max domain-length (length (plist-get history :url))))
1595         (setq title-length (max title-length (length (plist-get history :title)))))
1596       (setq format (format "%%-%ds %%-%ds" title-length domain-length)
1597             header-line-format
1598             (concat " " (format format "Title" "URL")))
1599       (dolist (history eww-history-trans)
1600         (setq start (point))
1601         (setq url (plist-get history :url))
1602         (setq title (plist-get history :title))
1603         (insert (format format title url))
1604         (insert "\n")
1605         (put-text-property start (1+ start) 'eww-history history))
1606       (goto-char (point-min)))
1607     (pop-to-buffer "*eww history*")))
1608
1609 (defun eww-history-browse ()
1610   "Browse the history under point in eww."
1611   (interactive)
1612   (let ((history (get-text-property (line-beginning-position) 'eww-history)))
1613     (unless history
1614       (error "No history on the current line"))
1615     (quit-window)
1616     (eww-restore-history history)))
1617
1618 (defvar eww-history-mode-map
1619   (let ((map (make-sparse-keymap)))
1620     (suppress-keymap map)
1621     (define-key map "q" 'quit-window)
1622     (define-key map "\r" 'eww-history-browse)
1623 ;;    (define-key map "n" 'next-error-no-select)
1624 ;;    (define-key map "p" 'previous-error-no-select)
1625
1626     (easy-menu-define nil map
1627       "Menu for `eww-history-mode-map'."
1628       '("Eww History"
1629         ["Exit" quit-window t]
1630         ["Browse" eww-history-browse
1631          :active (get-text-property (line-beginning-position) 'eww-history)]))
1632     map))
1633
1634 (define-derived-mode eww-history-mode nil "eww history"
1635   "Mode for listing eww-histories.
1636
1637 \\{eww-history-mode-map}"
1638   (buffer-disable-undo)
1639   (setq buffer-read-only t
1640         truncate-lines t))
1641
1642 ;;; Desktop support
1643
1644 (defvar eww-desktop-data-save
1645   '(:url :title :point)
1646   "List of `eww-data' properties to preserve in the desktop file.
1647 Also used when saving `eww-history'.")
1648
1649 (defun eww-desktop-data-1 (alist)
1650   (let ((acc  nil)
1651         (tail alist))
1652     (while tail
1653       (let ((k (car  tail))
1654             (v (cadr tail)))
1655         (when (memq k eww-desktop-data-save)
1656           (setq acc (cons k (cons v acc)))))
1657       (setq tail  (cddr tail)))
1658     acc))
1659
1660 (defun eww-desktop-history-duplicate (a b)
1661   (let ((tail a) (r t))
1662     (while tail
1663       (if (or (memq (car tail) '(:point)) ; ignore :point
1664               (equal (cadr tail)
1665                      (plist-get b (car tail))))
1666           (setq tail (cddr tail))
1667         (setq tail nil
1668               r    nil)))
1669     ;; .
1670     r))
1671
1672 (defun eww-desktop-misc-data (directory)
1673   "Return a property list with data used to restore eww buffers.
1674 This list will contain, as :history, the list, whose first element is
1675 the value of `eww-data', and the tail is `eww-history'.
1676
1677 If `eww-desktop-remove-duplicates' is non-nil, duplicate
1678 entries (if any) will be removed from the list.
1679
1680 Only the properties listed in `eww-desktop-data-save' are included.
1681 Generally, the list should not include the (usually overly large)
1682 :dom, :source and :text properties."
1683   (let ((history  (mapcar 'eww-desktop-data-1
1684                           (cons eww-data eww-history))))
1685     (list :history  (if eww-desktop-remove-duplicates
1686                         (cl-remove-duplicates
1687                          history :test 'eww-desktop-history-duplicate)
1688                       history))))
1689
1690 (defun eww-restore-desktop (file-name buffer-name misc-data)
1691   "Restore an eww buffer from its desktop file record.
1692 If `eww-restore-desktop' is t or 'auto, this function will also
1693 initiate the retrieval of the respective URI in the background.
1694 Otherwise, the restored buffer will contain a prompt to do so by using
1695 \\[eww-reload]."
1696   (with-current-buffer (get-buffer-create buffer-name)
1697     (eww-mode)
1698     ;; NB: eww-history, eww-data are buffer-local per (eww-mode)
1699     (setq eww-history       (cdr (plist-get misc-data :history))
1700           eww-data      (or (car (plist-get misc-data :history))
1701                             ;; backwards compatibility
1702                             (list :url (plist-get misc-data :uri))))
1703     (unless file-name
1704       (when (plist-get eww-data :url)
1705         (case eww-restore-desktop
1706           ((t auto) (eww (plist-get eww-data :url)))
1707           ((zerop (buffer-size))
1708            (insert (substitute-command-keys
1709                     eww-restore-reload-prompt))))))
1710     ;; .
1711     (current-buffer)))
1712
1713 (add-to-list 'desktop-locals-to-save
1714              'eww-history-position)
1715 (add-to-list 'desktop-buffer-mode-handlers
1716              '(eww-mode . eww-restore-desktop))
1717
1718 (provide 'eww)
1719
1720 ;;; eww.el ends here