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