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