lisp/net/eww.el

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