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

   1 ;;; eww.el --- Emacs Web Wowser
   2
   3 ;; Copyright (C) 2013-2014 Free Software Foundation, Inc.
   4
   5 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
   6 ;; Keywords: html
   7
   8 ;; This file is part of GNU Emacs.
   9
  10 ;; GNU Emacs is free software: you can redistribute it and/or modify
  11 ;; it under the terms of the GNU General Public License as published by
  12 ;; the Free Software Foundation, either version 3 of the License, or
  13 ;; (at your option) any later version.
  14
  15 ;; GNU Emacs is distributed in the hope that it will be useful,
  16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18 ;; GNU General Public License for more details.
  19
  20 ;; You should have received a copy of the GNU General Public License
  21 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  22
  23 ;;; Commentary:
  24
  25 ;;; Code:
  26
  27 (eval-when-compile (require 'cl))
  28 (require 'format-spec)
  29 (require 'shr)
  30 (require 'url)
  31 (require '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   (setq eww-current-title
 354         (replace-regexp-in-string
 355          "^ \\| $" ""
 356          (replace-regexp-in-string "[ \t\r\n]+" " " eww-current-title)))
 357   (eww-update-header-line-format))
 358
 359 (defun eww-tag-body (cont)
 360   (let* ((start (point))
 361          (fgcolor (cdr (or (assq :fgcolor cont)
 362                            (assq :text cont))))
 363          (bgcolor (cdr (assq :bgcolor cont)))
 364          (shr-stylesheet (list (cons 'color fgcolor)
 365                                (cons 'background-color bgcolor))))
 366     (shr-generic cont)
 367     (eww-colorize-region start (point) fgcolor bgcolor)))
 368
 369 (defun eww-colorize-region (start end fg &optional bg)
 370   (when (or fg bg)
 371     (let ((new-colors (shr-color-check fg bg)))
 372       (when new-colors
 373         (when fg
 374           (add-face-text-property start end
 375                                   (list :foreground (cadr new-colors))
 376                                   t))
 377         (when bg
 378           (add-face-text-property start end
 379                                   (list :background (car new-colors))
 380                                   t))))))
 381
 382 (defun eww-display-raw ()
 383   (let ((data (buffer-substring (point) (point-max))))
 384     (eww-setup-buffer)
 385     (let ((inhibit-read-only t))
 386       (insert data))
 387     (goto-char (point-min))))
 388
 389 (defun eww-display-image ()
 390   (let ((data (shr-parse-image-data)))
 391     (eww-setup-buffer)
 392     (let ((inhibit-read-only t))
 393       (shr-put-image data nil))
 394     (goto-char (point-min))))
 395
 396 (defun eww-setup-buffer ()
 397   (switch-to-buffer (get-buffer-create "*eww*"))
 398   (let ((inhibit-read-only t))
 399     (remove-overlays)
 400     (erase-buffer))
 401   (unless (eq major-mode 'eww-mode)
 402     (eww-mode))
 403   (setq-local eww-next-url nil)
 404   (setq-local eww-previous-url nil)
 405   (setq-local eww-up-url nil)
 406   (setq-local eww-home-url nil)
 407   (setq-local eww-start-url nil)
 408   (setq-local eww-contents-url nil))
 409
 410 (defun eww-view-source ()
 411   "View the HTML source code of the current page."
 412   (interactive)
 413   (let ((buf (get-buffer-create "*eww-source*"))
 414         (source eww-current-source))
 415     (with-current-buffer buf
 416       (delete-region (point-min) (point-max))
 417       (insert (or source "no source"))
 418       (goto-char (point-min))
 419       (when (fboundp 'html-mode)
 420         (html-mode)))
 421     (view-buffer buf)))
 422
 423 (defun eww-readable ()
 424   "View the main \"readable\" parts of the current web page.
 425 This command uses heuristics to find the parts of the web page that
 426 contains the main textual portion, leaving out navigation menus and
 427 the like."
 428   (interactive)
 429   (let* ((source eww-current-source)
 430          (dom (shr-transform-dom
 431                (with-temp-buffer
 432                  (insert source)
 433                  (condition-case nil
 434                      (decode-coding-region (point-min) (point-max) 'utf-8)
 435                    (coding-system-error nil))
 436                  (libxml-parse-html-region (point-min) (point-max))))))
 437     (eww-score-readability dom)
 438     (eww-save-history)
 439     (eww-display-html nil nil
 440                       (shr-retransform-dom
 441                        (eww-highest-readability dom)))
 442     (setq eww-current-source source)))
 443
 444 (defun eww-score-readability (node)
 445   (let ((score -1))
 446     (cond
 447      ((memq (car node) '(script head))
 448       (setq score -2))
 449      ((eq (car node) 'meta)
 450       (setq score -1))
 451      ((eq (car node) 'img)
 452       (setq score 2))
 453      ((eq (car node) 'a)
 454       (setq score (- (length (split-string
 455                               (or (cdr (assoc 'text (cdr node))) ""))))))
 456      (t
 457       (dolist (elem (cdr node))
 458         (cond
 459          ((eq (car elem) 'text)
 460           (setq score (+ score (length (split-string (cdr elem))))))
 461          ((consp (cdr elem))
 462           (setq score (+ score
 463                          (or (cdr (assoc :eww-readability-score (cdr elem)))
 464                              (eww-score-readability elem)))))))))
 465     ;; Cache the score of the node to avoid recomputing all the time.
 466     (setcdr node (cons (cons :eww-readability-score score) (cdr node)))
 467     score))
 468
 469 (defun eww-highest-readability (node)
 470   (let ((result node)
 471         highest)
 472     (dolist (elem (cdr node))
 473       (when (and (consp (cdr elem))
 474                  (> (or (cdr (assoc
 475                               :eww-readability-score
 476                               (setq highest
 477                                     (eww-highest-readability elem))))
 478                         most-negative-fixnum)
 479                     (or (cdr (assoc :eww-readability-score (cdr result)))
 480                         most-negative-fixnum)))
 481         (setq result highest)))
 482     result))
 483
 484 (defvar eww-mode-map
 485   (let ((map (make-sparse-keymap)))
 486     (suppress-keymap map)
 487     (define-key map "q" 'quit-window)
 488     (define-key map "g" 'eww-reload)
 489     (define-key map [?\t] 'shr-next-link)
 490     (define-key map [?\M-\t] 'shr-previous-link)
 491     (define-key map [delete] 'scroll-down-command)
 492     (define-key map [?\S-\ ] 'scroll-down-command)
 493     (define-key map "\177" 'scroll-down-command)
 494     (define-key map " " 'scroll-up-command)
 495     (define-key map "l" 'eww-back-url)
 496     (define-key map "r" 'eww-forward-url)
 497     (define-key map "n" 'eww-next-url)
 498     (define-key map "p" 'eww-previous-url)
 499     (define-key map "u" 'eww-up-url)
 500     (define-key map "t" 'eww-top-url)
 501     (define-key map "&" 'eww-browse-with-external-browser)
 502     (define-key map "d" 'eww-download)
 503     (define-key map "w" 'eww-copy-page-url)
 504     (define-key map "C" 'url-cookie-list)
 505     (define-key map "v" 'eww-view-source)
 506     (define-key map "R" 'eww-readable)
 507     (define-key map "H" 'eww-list-histories)
 508
 509     (define-key map "b" 'eww-add-bookmark)
 510     (define-key map "B" 'eww-list-bookmarks)
 511     (define-key map [(meta n)] 'eww-next-bookmark)
 512     (define-key map [(meta p)] 'eww-previous-bookmark)
 513
 514     (easy-menu-define nil map ""
 515       '("Eww"
 516         ["Exit" quit-window t]
 517         ["Close browser" quit-window t]
 518         ["Reload" eww-reload t]
 519         ["Back to previous page" eww-back-url
 520          :active (not (zerop (length eww-history)))]
 521         ["Forward to next page" eww-forward-url
 522          :active (not (zerop eww-history-position))]
 523         ["Browse with external browser" eww-browse-with-external-browser t]
 524         ["Download" eww-download t]
 525         ["View page source" eww-view-source]
 526         ["Copy page URL" eww-copy-page-url t]
 527         ["List histories" eww-list-histories t]
 528         ["Add bookmark" eww-add-bookmark t]
 529         ["List bookmarks" eww-list-bookmarks t]
 530         ["List cookies" url-cookie-list t]))
 531     map))
 532
 533 (defvar eww-tool-bar-map
 534   (let ((map (make-sparse-keymap)))
 535     (dolist (tool-bar-item
 536              '((quit-window . "close")
 537                (eww-reload . "refresh")
 538                (eww-back-url . "left-arrow")
 539                (eww-forward-url . "right-arrow")
 540                (eww-view-source . "show")
 541                (eww-copy-page-url . "copy")
 542                (eww-add-bookmark . "bookmark_add"))) ;; ...
 543       (tool-bar-local-item-from-menu
 544        (car tool-bar-item) (cdr tool-bar-item) map eww-mode-map))
 545     map)
 546   "Tool bar for `eww-mode'.")
 547
 548 (define-derived-mode eww-mode nil "eww"
 549   "Mode for browsing the web.
 550
 551 \\{eww-mode-map}"
 552   ;; FIXME?  This seems a strange default.
 553   (setq-local eww-current-url 'author)
 554   (setq-local eww-current-dom nil)
 555   (setq-local eww-current-source nil)
 556   (setq-local eww-current-title "")
 557   (setq-local browse-url-browser-function 'eww-browse-url)
 558   (setq-local after-change-functions 'eww-process-text-input)
 559   (setq-local eww-history nil)
 560   (setq-local eww-history-position 0)
 561   (when (boundp 'tool-bar-map)
 562    (setq-local tool-bar-map eww-tool-bar-map))
 563   (buffer-disable-undo)
 564   ;;(setq buffer-read-only t)
 565   )
 566
 567 ;;;###autoload
 568 (defun eww-browse-url (url &optional _new-window)
 569   (when (and (equal major-mode 'eww-mode)
 570              eww-current-url)
 571     (eww-save-history))
 572   (eww url))
 573
 574 (defun eww-back-url ()
 575   "Go to the previously displayed page."
 576   (interactive)
 577   (when (>= eww-history-position (length eww-history))
 578     (user-error "No previous page"))
 579   (eww-save-history)
 580   (setq eww-history-position (+ eww-history-position 2))
 581   (eww-restore-history (elt eww-history (1- eww-history-position))))
 582
 583 (defun eww-forward-url ()
 584   "Go to the next displayed page."
 585   (interactive)
 586   (when (zerop eww-history-position)
 587     (user-error "No next page"))
 588   (eww-save-history)
 589   (eww-restore-history (elt eww-history (1- eww-history-position))))
 590
 591 (defun eww-restore-history (elem)
 592   (let ((inhibit-read-only t))
 593     (erase-buffer)
 594     (insert (plist-get elem :text))
 595     (setq eww-current-source (plist-get elem :source)
 596           eww-current-dom (plist-get elem :dom))
 597     (goto-char (plist-get elem :point))
 598     (setq eww-current-url (plist-get elem :url)
 599           eww-current-title (plist-get elem :title))
 600     (eww-update-header-line-format)))
 601
 602 (defun eww-next-url ()
 603   "Go to the page marked `next'.
 604 A page is marked `next' if rel=\"next\" appears in a <link>
 605 or <a> tag."
 606   (interactive)
 607   (if eww-next-url
 608       (eww-browse-url (shr-expand-url eww-next-url eww-current-url))
 609     (user-error "No `next' on this page")))
 610
 611 (defun eww-previous-url ()
 612   "Go to the page marked `previous'.
 613 A page is marked `previous' if rel=\"previous\" appears in a <link>
 614 or <a> tag."
 615   (interactive)
 616   (if eww-previous-url
 617       (eww-browse-url (shr-expand-url eww-previous-url eww-current-url))
 618     (user-error "No `previous' on this page")))
 619
 620 (defun eww-up-url ()
 621   "Go to the page marked `up'.
 622 A page is marked `up' if rel=\"up\" appears in a <link>
 623 or <a> tag."
 624   (interactive)
 625   (if eww-up-url
 626       (eww-browse-url (shr-expand-url eww-up-url eww-current-url))
 627     (user-error "No `up' on this page")))
 628
 629 (defun eww-top-url ()
 630   "Go to the page marked `top'.
 631 A page is marked `top' if rel=\"start\", rel=\"home\", or rel=\"contents\"
 632 appears in a <link> or <a> tag."
 633   (interactive)
 634   (let ((best-url (or eww-start-url
 635                       eww-contents-url
 636                       eww-home-url)))
 637     (if best-url
 638         (eww-browse-url (shr-expand-url best-url eww-current-url))
 639       (user-error "No `top' for this page"))))
 640
 641 (defun eww-reload ()
 642   "Reload the current page."
 643   (interactive)
 644   (url-retrieve eww-current-url 'eww-render
 645                 (list eww-current-url (point))))
 646
 647 ;; Form support.
 648
 649 (defvar eww-form nil)
 650
 651 (defvar eww-submit-map
 652   (let ((map (make-sparse-keymap)))
 653     (define-key map "\r" 'eww-submit)
 654     (define-key map [(control c) (control c)] 'eww-submit)
 655     map))
 656
 657 (defvar eww-checkbox-map
 658   (let ((map (make-sparse-keymap)))
 659     (define-key map " " 'eww-toggle-checkbox)
 660     (define-key map "\r" 'eww-toggle-checkbox)
 661     (define-key map [(control c) (control c)] 'eww-submit)
 662     map))
 663
 664 (defvar eww-text-map
 665   (let ((map (make-keymap)))
 666     (set-keymap-parent map text-mode-map)
 667     (define-key map "\r" 'eww-submit)
 668     (define-key map [(control a)] 'eww-beginning-of-text)
 669     (define-key map [(control c) (control c)] 'eww-submit)
 670     (define-key map [(control e)] 'eww-end-of-text)
 671     (define-key map [?\t] 'shr-next-link)
 672     (define-key map [?\M-\t] 'shr-previous-link)
 673     map))
 674
 675 (defvar eww-textarea-map
 676   (let ((map (make-keymap)))
 677     (set-keymap-parent map text-mode-map)
 678     (define-key map "\r" 'forward-line)
 679     (define-key map [(control c) (control c)] 'eww-submit)
 680     (define-key map [?\t] 'shr-next-link)
 681     (define-key map [?\M-\t] 'shr-previous-link)
 682     map))
 683
 684 (defvar eww-select-map
 685   (let ((map (make-sparse-keymap)))
 686     (define-key map "\r" 'eww-change-select)
 687     (define-key map [(control c) (control c)] 'eww-submit)
 688     map))
 689
 690 (defun eww-beginning-of-text ()
 691   "Move to the start of the input field."
 692   (interactive)
 693   (goto-char (eww-beginning-of-field)))
 694
 695 (defun eww-end-of-text ()
 696   "Move to the end of the text in the input field."
 697   (interactive)
 698   (goto-char (eww-end-of-field))
 699   (let ((start (eww-beginning-of-field)))
 700     (while (and (equal (following-char) ? )
 701                 (> (point) start))
 702       (forward-char -1))
 703     (when (> (point) start)
 704       (forward-char 1))))
 705
 706 (defun eww-beginning-of-field ()
 707   (cond
 708    ((bobp)
 709     (point))
 710    ((not (eq (get-text-property (point) 'eww-form)
 711              (get-text-property (1- (point)) 'eww-form)))
 712     (point))
 713    (t
 714     (previous-single-property-change
 715      (point) 'eww-form nil (point-min)))))
 716
 717 (defun eww-end-of-field ()
 718   (1- (next-single-property-change
 719        (point) 'eww-form nil (point-max))))
 720
 721 (defun eww-tag-form (cont)
 722   (let ((eww-form
 723          (list (assq :method cont)
 724                (assq :action cont)))
 725         (start (point)))
 726     (shr-ensure-paragraph)
 727     (shr-generic cont)
 728     (unless (bolp)
 729       (insert "\n"))
 730     (insert "\n")
 731     (when (> (point) start)
 732       (put-text-property start (1+ start)
 733                          'eww-form eww-form))))
 734
 735 (defun eww-form-submit (cont)
 736   (let ((start (point))
 737         (value (cdr (assq :value cont))))
 738     (setq value
 739           (if (zerop (length value))
 740               "Submit"
 741             value))
 742     (insert value)
 743     (add-face-text-property start (point) 'eww-form-submit)
 744     (put-text-property start (point) 'eww-form
 745                        (list :eww-form eww-form
 746                              :value value
 747                              :type "submit"
 748                              :name (cdr (assq :name cont))))
 749     (put-text-property start (point) 'keymap eww-submit-map)
 750     (insert " ")))
 751
 752 (defun eww-form-checkbox (cont)
 753   (let ((start (point)))
 754     (if (cdr (assq :checked cont))
 755         (insert eww-form-checkbox-selected-symbol)
 756       (insert eww-form-checkbox-symbol))
 757     (add-face-text-property start (point) 'eww-form-checkbox)
 758     (put-text-property start (point) 'eww-form
 759                        (list :eww-form eww-form
 760                              :value (cdr (assq :value cont))
 761                              :type (downcase (cdr (assq :type cont)))
 762                              :checked (cdr (assq :checked cont))
 763                              :name (cdr (assq :name cont))))
 764     (put-text-property start (point) 'keymap eww-checkbox-map)
 765     (insert " ")))
 766
 767 (defun eww-form-text (cont)
 768   (let ((start (point))
 769         (type (downcase (or (cdr (assq :type cont))
 770                             "text")))
 771         (value (or (cdr (assq :value cont)) ""))
 772         (width (string-to-number
 773                 (or (cdr (assq :size cont))
 774                     "40")))
 775         (readonly-property (if (or (cdr (assq :disabled cont))
 776                                    (cdr (assq :readonly cont)))
 777                                'read-only
 778                              'inhibit-read-only)))
 779     (insert value)
 780     (when (< (length value) width)
 781       (insert (make-string (- width (length value)) ? )))
 782     (put-text-property start (point) 'face 'eww-form-text)
 783     (put-text-property start (point) 'local-map eww-text-map)
 784     (put-text-property start (point) readonly-property t)
 785     (put-text-property start (point) 'eww-form
 786                        (list :eww-form eww-form
 787                              :value value
 788                              :type type
 789                              :name (cdr (assq :name cont))))
 790     (insert " ")))
 791
 792 (defconst eww-text-input-types '("text" "password" "textarea"
 793                                  "color" "date" "datetime" "datetime-local"
 794                                  "email" "month" "number" "search" "tel"
 795                                  "time" "url" "week")
 796   "List of input types which represent a text input.
 797 See URL `https://developer.mozilla.org/en-US/docs/Web/HTML/Element/Input'.")
 798
 799 (defun eww-process-text-input (beg end length)
 800   (let* ((form (get-text-property (min (1+ end) (point-max)) 'eww-form))
 801          (properties (text-properties-at end))
 802          (type (plist-get form :type)))
 803     (when (and form
 804                (member type eww-text-input-types))
 805       (cond
 806        ((zerop length)
 807         ;; Delete some space at the end.
 808         (save-excursion
 809           (goto-char
 810            (if (equal type "textarea")
 811                (1- (line-end-position))
 812              (eww-end-of-field)))
 813           (let ((new (- end beg)))
 814             (while (and (> new 0)
 815                         (eql (following-char) ? ))
 816               (delete-region (point) (1+ (point)))
 817               (setq new (1- new))))
 818           (set-text-properties beg end properties)))
 819        ((> length 0)
 820         ;; Add padding.
 821         (save-excursion
 822           (goto-char
 823            (if (equal type "textarea")
 824                (1- (line-end-position))
 825              (eww-end-of-field)))
 826           (let ((start (point)))
 827             (insert (make-string length ? ))
 828             (set-text-properties start (point) properties)))))
 829       (let ((value (buffer-substring-no-properties
 830                     (eww-beginning-of-field)
 831                     (eww-end-of-field))))
 832         (when (string-match " +\\'" value)
 833           (setq value (substring value 0 (match-beginning 0))))
 834         (plist-put form :value value)
 835         (when (equal type "password")
 836           ;; Display passwords as asterisks.
 837           (let ((start (eww-beginning-of-field)))
 838             (put-text-property start (+ start (length value))
 839                                'display (make-string (length value) ?*))))))))
 840
 841 (defun eww-tag-textarea (cont)
 842   (let ((start (point))
 843         (value (or (cdr (assq :value cont)) ""))
 844         (lines (string-to-number
 845                 (or (cdr (assq :rows cont))
 846                     "10")))
 847         (width (string-to-number
 848                 (or (cdr (assq :cols cont))
 849                     "10")))
 850         end)
 851     (shr-ensure-newline)
 852     (insert value)
 853     (shr-ensure-newline)
 854     (when (< (count-lines start (point)) lines)
 855       (dotimes (i (- lines (count-lines start (point))))
 856         (insert "\n")))
 857     (setq end (point-marker))
 858     (goto-char start)
 859     (while (< (point) end)
 860       (end-of-line)
 861       (let ((pad (- width (- (point) (line-beginning-position)))))
 862         (when (> pad 0)
 863           (insert (make-string pad ? ))))
 864       (add-face-text-property (line-beginning-position)
 865                               (point) 'eww-form-textarea)
 866       (put-text-property (line-beginning-position) (point)
 867                          'local-map eww-textarea-map)
 868       (forward-line 1))
 869     (put-text-property start (point) 'eww-form
 870                        (list :eww-form eww-form
 871                              :value value
 872                              :type "textarea"
 873                              :name (cdr (assq :name cont))))))
 874
 875 (defun eww-tag-input (cont)
 876   (let ((type (downcase (or (cdr (assq :type cont))
 877                              "text")))
 878         (start (point)))
 879     (cond
 880      ((or (equal type "checkbox")
 881           (equal type "radio"))
 882       (eww-form-checkbox cont))
 883      ((equal type "submit")
 884       (eww-form-submit cont))
 885      ((equal type "hidden")
 886       (let ((form eww-form)
 887             (name (cdr (assq :name cont))))
 888         ;; Don't add <input type=hidden> elements repeatedly.
 889         (while (and form
 890                     (or (not (consp (car form)))
 891                         (not (eq (caar form) 'hidden))
 892                         (not (equal (plist-get (cdr (car form)) :name)
 893                                     name))))
 894           (setq form (cdr form)))
 895         (unless form
 896           (nconc eww-form (list
 897                            (list 'hidden
 898                                  :name name
 899                                  :value (cdr (assq :value cont))))))))
 900      (t
 901       (eww-form-text cont)))
 902     (unless (= start (point))
 903       (put-text-property start (1+ start) 'help-echo "Input field"))))
 904
 905 (defun eww-tag-select (cont)
 906   (shr-ensure-paragraph)
 907   (let ((menu (list :name (cdr (assq :name cont))
 908                     :eww-form eww-form))
 909         (options nil)
 910         (start (point))
 911         (max 0)
 912         opelem)
 913     (if (eq (car (car cont)) 'optgroup)
 914         (dolist (groupelem cont)
 915           (unless (cdr (assq :disabled (cdr groupelem)))
 916             (setq opelem (append opelem (cdr (cdr groupelem))))))
 917       (setq opelem cont))
 918     (dolist (elem opelem)
 919       (when (eq (car elem) 'option)
 920         (when (cdr (assq :selected (cdr elem)))
 921           (nconc menu (list :value
 922                             (cdr (assq :value (cdr elem))))))
 923         (let ((display (or (cdr (assq 'text (cdr elem))) "")))
 924           (setq max (max max (length display)))
 925           (push (list 'item
 926                       :value (cdr (assq :value (cdr elem)))
 927                       :display display)
 928                 options))))
 929     (when options
 930       (setq options (nreverse options))
 931       ;; If we have no selected values, default to the first value.
 932       (unless (plist-get menu :value)
 933         (nconc menu (list :value (nth 2 (car options)))))
 934       (nconc menu options)
 935       (let ((selected (eww-select-display menu)))
 936         (insert selected
 937                 (make-string (- max (length selected)) ? )))
 938       (put-text-property start (point) 'eww-form menu)
 939       (add-face-text-property start (point) 'eww-form-select)
 940       (put-text-property start (point) 'keymap eww-select-map)
 941       (unless (= start (point))
 942        (put-text-property start (1+ start) 'help-echo "select field"))
 943       (shr-ensure-paragraph))))
 944
 945 (defun eww-select-display (select)
 946   (let ((value (plist-get select :value))
 947         display)
 948     (dolist (elem select)
 949       (when (and (consp elem)
 950                  (eq (car elem) 'item)
 951                  (equal value (plist-get (cdr elem) :value)))
 952         (setq display (plist-get (cdr elem) :display))))
 953     display))
 954
 955 (defun eww-change-select ()
 956   "Change the value of the select drop-down menu under point."
 957   (interactive)
 958   (let* ((input (get-text-property (point) 'eww-form))
 959          (completion-ignore-case t)
 960          (options
 961           (delq nil
 962                 (mapcar (lambda (elem)
 963                           (and (consp elem)
 964                                (eq (car elem) 'item)
 965                                (cons (plist-get (cdr elem) :display)
 966                                      (plist-get (cdr elem) :value))))
 967                         input)))
 968          (display
 969           (completing-read "Change value: " options nil 'require-match))
 970          (inhibit-read-only t))
 971     (plist-put input :value (cdr (assoc-string display options t)))
 972     (goto-char
 973      (eww-update-field display))))
 974
 975 (defun eww-update-field (string)
 976   (let ((properties (text-properties-at (point)))
 977         (start (eww-beginning-of-field))
 978         (end (1+ (eww-end-of-field))))
 979     (delete-region start end)
 980     (insert string
 981             (make-string (- (- end start) (length string)) ? ))
 982     (set-text-properties start end properties)
 983     start))
 984
 985 (defun eww-toggle-checkbox ()
 986   "Toggle the value of the checkbox under point."
 987   (interactive)
 988   (let* ((input (get-text-property (point) 'eww-form))
 989          (type (plist-get input :type)))
 990     (if (equal type "checkbox")
 991         (goto-char
 992          (1+
 993           (if (plist-get input :checked)
 994               (progn
 995                 (plist-put input :checked nil)
 996                 (eww-update-field eww-form-checkbox-symbol))
 997             (plist-put input :checked t)
 998             (eww-update-field eww-form-checkbox-selected-symbol))))
 999       ;; Radio button.  Switch all other buttons off.
1000       (let ((name (plist-get input :name)))
1001         (save-excursion
1002           (dolist (elem (eww-inputs (plist-get input :eww-form)))
1003             (when (equal (plist-get (cdr elem) :name) name)
1004               (goto-char (car elem))
1005               (if (not (eq (cdr elem) input))
1006                   (progn
1007                     (plist-put input :checked nil)
1008                     (eww-update-field eww-form-checkbox-symbol))
1009                 (plist-put input :checked t)
1010                 (eww-update-field eww-form-checkbox-selected-symbol)))))
1011         (forward-char 1)))))
1012
1013 (defun eww-inputs (form)
1014   (let ((start (point-min))
1015         (inputs nil))
1016     (while (and start
1017                 (< start (point-max)))
1018       (when (or (get-text-property start 'eww-form)
1019                 (setq start (next-single-property-change start 'eww-form)))
1020         (when (eq (plist-get (get-text-property start 'eww-form) :eww-form)
1021                   form)
1022           (push (cons start (get-text-property start 'eww-form))
1023                 inputs))
1024         (setq start (next-single-property-change start 'eww-form))))
1025     (nreverse inputs)))
1026
1027 (defun eww-input-value (input)
1028   (let ((type (plist-get input :type))
1029         (value (plist-get input :value)))
1030     (cond
1031      ((equal type "textarea")
1032       (with-temp-buffer
1033         (insert value)
1034         (goto-char (point-min))
1035         (while (re-search-forward "^ +\n\\| +$" nil t)
1036           (replace-match "" t t))
1037         (buffer-string)))
1038      (t
1039       (if (string-match " +\\'" value)
1040           (substring value 0 (match-beginning 0))
1041         value)))))
1042
1043 (defun eww-submit ()
1044   "Submit the current form."
1045   (interactive)
1046   (let* ((this-input (get-text-property (point) 'eww-form))
1047          (form (plist-get this-input :eww-form))
1048          values next-submit)
1049     (dolist (elem (sort (eww-inputs form)
1050                          (lambda (o1 o2)
1051                            (< (car o1) (car o2)))))
1052       (let* ((input (cdr elem))
1053              (input-start (car elem))
1054              (name (plist-get input :name)))
1055         (when name
1056           (cond
1057            ((member (plist-get input :type) '("checkbox" "radio"))
1058             (when (plist-get input :checked)
1059               (push (cons name (plist-get input :value))
1060                     values)))
1061            ((equal (plist-get input :type) "submit")
1062             ;; We want the values from buttons if we hit a button if
1063             ;; we hit enter on it, or if it's the first button after
1064             ;; the field we did hit return on.
1065             (when (or (eq input this-input)
1066                       (and (not (eq input this-input))
1067                            (null next-submit)
1068                            (> input-start (point))))
1069               (setq next-submit t)
1070               (push (cons name (plist-get input :value))
1071                     values)))
1072            (t
1073             (push (cons name (eww-input-value input))
1074                   values))))))
1075     (dolist (elem form)
1076       (when (and (consp elem)
1077                  (eq (car elem) 'hidden))
1078         (push (cons (plist-get (cdr elem) :name)
1079                     (or (plist-get (cdr elem) :value) ""))
1080               values)))
1081     (if (and (stringp (cdr (assq :method form)))
1082              (equal (downcase (cdr (assq :method form))) "post"))
1083         (let ((url-request-method "POST")
1084               (url-request-extra-headers
1085                '(("Content-Type" . "application/x-www-form-urlencoded")))
1086               (url-request-data (mm-url-encode-www-form-urlencoded values)))
1087           (eww-browse-url (shr-expand-url (cdr (assq :action form))
1088                                           eww-current-url)))
1089       (eww-browse-url
1090        (concat
1091         (if (cdr (assq :action form))
1092             (shr-expand-url (cdr (assq :action form))
1093                             eww-current-url)
1094           eww-current-url)
1095         "?"
1096         (mm-url-encode-www-form-urlencoded values))))))
1097
1098 (defun eww-browse-with-external-browser (&optional url)
1099   "Browse the current URL with an external browser.
1100 The browser to used is specified by the `shr-external-browser' variable."
1101   (interactive)
1102   (funcall shr-external-browser (or url eww-current-url)))
1103
1104 (defun eww-follow-link (&optional external mouse-event)
1105   "Browse the URL under point.
1106 If EXTERNAL, browse the URL using `shr-external-browser'."
1107   (interactive (list current-prefix-arg last-nonmenu-event))
1108   (mouse-set-point mouse-event)
1109   (let ((url (get-text-property (point) 'shr-url)))
1110     (cond
1111      ((not url)
1112       (message "No link under point"))
1113      ((string-match "^mailto:" url)
1114       (browse-url-mail url))
1115      (external
1116       (funcall shr-external-browser url))
1117      ;; This is a #target url in the same page as the current one.
1118      ((and (url-target (url-generic-parse-url url))
1119            (eww-same-page-p url eww-current-url))
1120       (eww-save-history)
1121       (eww-display-html 'utf-8 url eww-current-dom))
1122      (t
1123       (eww-browse-url url)))))
1124
1125 (defun eww-same-page-p (url1 url2)
1126   "Return non-nil if both URLs represent the same page.
1127 Differences in #targets are ignored."
1128   (let ((obj1 (url-generic-parse-url url1))
1129         (obj2 (url-generic-parse-url url2)))
1130     (setf (url-target obj1) nil)
1131     (setf (url-target obj2) nil)
1132     (equal (url-recreate-url obj1) (url-recreate-url obj2))))
1133
1134 (defun eww-copy-page-url ()
1135   (interactive)
1136   (message "%s" eww-current-url)
1137   (kill-new eww-current-url))
1138
1139 (defun eww-download ()
1140   "Download URL under point to `eww-download-directory'."
1141   (interactive)
1142   (let ((url (get-text-property (point) 'shr-url)))
1143     (if (not url)
1144         (message "No URL under point")
1145       (url-retrieve url 'eww-download-callback (list url)))))
1146
1147 (defun eww-download-callback (status url)
1148   (unless (plist-get status :error)
1149     (let* ((obj (url-generic-parse-url url))
1150            (path (car (url-path-and-query obj)))
1151            (file (eww-make-unique-file-name (file-name-nondirectory path)
1152                                             eww-download-directory)))
1153       (write-file file)
1154       (message "Saved %s" file))))
1155
1156 (defun eww-make-unique-file-name (file directory)
1157     (cond
1158      ((zerop (length file))
1159       (setq file "!"))
1160      ((string-match "\\`[.]" file)
1161       (setq file (concat "!" file))))
1162     (let ((count 1))
1163       (while (file-exists-p (expand-file-name file directory))
1164         (setq file
1165               (if (string-match "\\`\\(.*\\)\\([.][^.]+\\)" file)
1166                   (format "%s(%d)%s" (match-string 1 file)
1167                           count (match-string 2 file))
1168                 (format "%s(%d)" file count)))
1169         (setq count (1+ count)))
1170       (expand-file-name file directory)))
1171
1172 ;;; Bookmarks code
1173
1174 (defvar eww-bookmarks nil)
1175
1176 (defun eww-add-bookmark ()
1177   "Add the current page to the bookmarks."
1178   (interactive)
1179   (eww-read-bookmarks)
1180   (dolist (bookmark eww-bookmarks)
1181     (when (equal eww-current-url
1182                  (plist-get bookmark :url))
1183       (user-error "Already bookmarked")))
1184   (if (y-or-n-p "bookmark this page? ")
1185       (progn
1186         (let ((title (replace-regexp-in-string "[\n\t\r]" " " eww-current-title)))
1187           (setq title (replace-regexp-in-string "\\` +\\| +\\'" "" title))
1188           (push (list :url eww-current-url
1189                       :title title
1190                       :time (current-time-string))
1191                 eww-bookmarks))
1192         (eww-write-bookmarks)
1193         (message "Bookmarked %s (%s)" eww-current-url eww-current-title))))
1194
1195 (defun eww-write-bookmarks ()
1196   (with-temp-file (expand-file-name "eww-bookmarks" eww-bookmarks-directory)
1197     (insert ";; Auto-generated file; don't edit\n")
1198     (pp eww-bookmarks (current-buffer))))
1199
1200 (defun eww-read-bookmarks ()
1201   (let ((file (expand-file-name "eww-bookmarks" eww-bookmarks-directory)))
1202     (setq eww-bookmarks
1203           (unless (zerop (or (nth 7 (file-attributes file)) 0))
1204             (with-temp-buffer
1205               (insert-file-contents file)
1206               (read (current-buffer)))))))
1207
1208 ;;;###autoload
1209 (defun eww-list-bookmarks ()
1210   "Display the bookmarks."
1211   (interactive)
1212   (eww-bookmark-prepare)
1213   (pop-to-buffer "*eww bookmarks*"))
1214
1215 (defun eww-bookmark-prepare ()
1216   (eww-read-bookmarks)
1217   (unless eww-bookmarks
1218     (user-error "No bookmarks are defined"))
1219   (set-buffer (get-buffer-create "*eww bookmarks*"))
1220   (eww-bookmark-mode)
1221   (let ((format "%-40s %s")
1222         (inhibit-read-only t)
1223         start url)
1224     (erase-buffer)
1225     (setq header-line-format (concat " " (format format "URL" "Title")))
1226     (dolist (bookmark eww-bookmarks)
1227       (setq start (point))
1228       (setq url (plist-get bookmark :url))
1229       (when (> (length url) 40)
1230         (setq url (substring url 0 40)))
1231       (insert (format format url
1232                       (plist-get bookmark :title))
1233               "\n")
1234       (put-text-property start (1+ start) 'eww-bookmark bookmark))
1235     (goto-char (point-min))))
1236
1237 (defvar eww-bookmark-kill-ring nil)
1238
1239 (defun eww-bookmark-kill ()
1240   "Kill the current bookmark."
1241   (interactive)
1242   (let* ((start (line-beginning-position))
1243          (bookmark (get-text-property start 'eww-bookmark))
1244          (inhibit-read-only t))
1245     (unless bookmark
1246       (user-error "No bookmark on the current line"))
1247     (forward-line 1)
1248     (push (buffer-substring start (point)) eww-bookmark-kill-ring)
1249     (delete-region start (point))
1250     (setq eww-bookmarks (delq bookmark eww-bookmarks))
1251     (eww-write-bookmarks)))
1252
1253 (defun eww-bookmark-yank ()
1254   "Yank a previously killed bookmark to the current line."
1255   (interactive)
1256   (unless eww-bookmark-kill-ring
1257     (user-error "No previously killed bookmark"))
1258   (beginning-of-line)
1259   (let ((inhibit-read-only t)
1260         (start (point))
1261         bookmark)
1262     (insert (pop eww-bookmark-kill-ring))
1263     (setq bookmark (get-text-property start 'eww-bookmark))
1264     (if (= start (point-min))
1265         (push bookmark eww-bookmarks)
1266       (let ((line (count-lines start (point))))
1267         (setcdr (nthcdr (1- line) eww-bookmarks)
1268                 (cons bookmark (nthcdr line eww-bookmarks)))))
1269     (eww-write-bookmarks)))
1270
1271 (defun eww-bookmark-browse ()
1272   "Browse the bookmark under point in eww."
1273   (interactive)
1274   (let ((bookmark (get-text-property (line-beginning-position) 'eww-bookmark)))
1275     (unless bookmark
1276       (user-error "No bookmark on the current line"))
1277     (quit-window)
1278     (eww-browse-url (plist-get bookmark :url))))
1279
1280 (defun eww-next-bookmark ()
1281   "Go to the next bookmark in the list."
1282   (interactive)
1283   (let ((first nil)
1284         bookmark)
1285     (unless (get-buffer "*eww bookmarks*")
1286       (setq first t)
1287       (eww-bookmark-prepare))
1288     (with-current-buffer (get-buffer "*eww bookmarks*")
1289       (when (and (not first)
1290                  (not (eobp)))
1291         (forward-line 1))
1292       (setq bookmark (get-text-property (line-beginning-position)
1293                                         'eww-bookmark))
1294       (unless bookmark
1295         (user-error "No next bookmark")))
1296     (eww-browse-url (plist-get bookmark :url))))
1297
1298 (defun eww-previous-bookmark ()
1299   "Go to the previous bookmark in the list."
1300   (interactive)
1301   (let ((first nil)
1302         bookmark)
1303     (unless (get-buffer "*eww bookmarks*")
1304       (setq first t)
1305       (eww-bookmark-prepare))
1306     (with-current-buffer (get-buffer "*eww bookmarks*")
1307       (if first
1308           (goto-char (point-max))
1309         (beginning-of-line))
1310       ;; On the final line.
1311       (when (eolp)
1312         (forward-line -1))
1313       (if (bobp)
1314           (user-error "No previous bookmark")
1315         (forward-line -1))
1316       (setq bookmark (get-text-property (line-beginning-position)
1317                                         'eww-bookmark)))
1318     (eww-browse-url (plist-get bookmark :url))))
1319
1320 (defvar eww-bookmark-mode-map
1321   (let ((map (make-sparse-keymap)))
1322     (suppress-keymap map)
1323     (define-key map "q" 'quit-window)
1324     (define-key map [(control k)] 'eww-bookmark-kill)
1325     (define-key map [(control y)] 'eww-bookmark-yank)
1326     (define-key map "\r" 'eww-bookmark-browse)
1327
1328     (easy-menu-define nil map
1329       "Menu for `eww-bookmark-mode-map'."
1330       '("Eww Bookmark"
1331         ["Exit" quit-window t]
1332         ["Browse" eww-bookmark-browse
1333          :active (get-text-property (line-beginning-position) 'eww-bookmark)]
1334         ["Kill" eww-bookmark-kill
1335          :active (get-text-property (line-beginning-position) 'eww-bookmark)]
1336         ["Yank" eww-bookmark-yank
1337          :active eww-bookmark-kill-ring]))
1338     map))
1339
1340 (define-derived-mode eww-bookmark-mode nil "eww bookmarks"
1341   "Mode for listing bookmarks.
1342
1343 \\{eww-bookmark-mode-map}"
1344   (buffer-disable-undo)
1345   (setq buffer-read-only t
1346         truncate-lines t))
1347
1348 ;;; History code
1349
1350 (defun eww-save-history ()
1351   (push (list :url eww-current-url
1352               :title eww-current-title
1353               :point (point)
1354               :dom eww-current-dom
1355               :source eww-current-source
1356               :text (buffer-string))
1357         eww-history))
1358
1359 (defun eww-list-histories ()
1360   "List the eww-histories."
1361   (interactive)
1362   (when (null eww-history)
1363     (error "No eww-histories are defined"))
1364   (let ((eww-history-trans eww-history))
1365     (set-buffer (get-buffer-create "*eww history*"))
1366     (eww-history-mode)
1367     (let ((inhibit-read-only t)
1368           (domain-length 0)
1369           (title-length 0)
1370           url title format start)
1371       (erase-buffer)
1372       (dolist (history eww-history-trans)
1373         (setq start (point))
1374         (setq domain-length (max domain-length (length (plist-get history :url))))
1375         (setq title-length (max title-length (length (plist-get history :title)))))
1376       (setq format (format "%%-%ds %%-%ds" title-length domain-length)
1377             header-line-format
1378             (concat " " (format format "Title" "URL")))
1379       (dolist (history eww-history-trans)
1380         (setq start (point))
1381         (setq url (plist-get history :url))
1382         (setq title (plist-get history :title))
1383         (insert (format format title url))
1384         (insert "\n")
1385         (put-text-property start (1+ start) 'eww-history history))
1386       (goto-char (point-min)))
1387     (pop-to-buffer "*eww history*")))
1388
1389 (defun eww-history-browse ()
1390   "Browse the history under point in eww."
1391   (interactive)
1392   (let ((history (get-text-property (line-beginning-position) 'eww-history)))
1393     (unless history
1394       (error "No history on the current line"))
1395     (quit-window)
1396     (eww-restore-history history)))
1397
1398 (defvar eww-history-mode-map
1399   (let ((map (make-sparse-keymap)))
1400     (suppress-keymap map)
1401     (define-key map "q" 'quit-window)
1402     (define-key map "\r" 'eww-history-browse)
1403 ;;    (define-key map "n" 'next-error-no-select)
1404 ;;    (define-key map "p" 'previous-error-no-select)
1405
1406     (easy-menu-define nil map
1407       "Menu for `eww-history-mode-map'."
1408       '("Eww History"
1409         ["Exit" quit-window t]
1410         ["Browse" eww-history-browse
1411          :active (get-text-property (line-beginning-position) 'eww-history)]))
1412     map))
1413
1414 (define-derived-mode eww-history-mode nil "eww history"
1415   "Mode for listing eww-histories.
1416
1417 \\{eww-history-mode-map}"
1418   (buffer-disable-undo)
1419   (setq buffer-read-only t
1420         truncate-lines t))
1421
1422 (provide 'eww)
1423
1424 ;;; eww.el ends here