lisp/net/eww.el

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