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