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