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

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