eww.el 61 KB
Newer Older
1 2
;;; eww.el --- Emacs Web Wowser

Paul Eggert's avatar
Paul Eggert committed
3
;; Copyright (C) 2013-2015 Free Software Foundation, Inc.
4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27

;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: html

;; This file is part of GNU Emacs.

;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.

;;; Commentary:

;;; Code:

(eval-when-compile (require 'cl))
28
(require 'format-spec)
29 30
(require 'shr)
(require 'url)
31
(require 'url-queue)
32
(require 'url-util)			; for url-get-url-at-point
33
(require 'mm-url)
34
(eval-when-compile (require 'subr-x)) ;; for string-trim
35

36 37
(defgroup eww nil
  "Emacs Web Wowser"
38
  :version "25.1"
39
  :link '(custom-manual "(eww) Top")
40
  :group 'web
41 42 43 44 45 46
  :prefix "eww-")

(defcustom eww-header-line-format "%t: %u"
  "Header line format.
- %t is replaced by the title.
- %u is replaced by the URL."
47 48 49 50 51 52 53
  :version "24.4"
  :group 'eww
  :type 'string)

(defcustom eww-search-prefix "https://duckduckgo.com/html/?q="
  "Prefix URL to search engine"
  :version "24.4"
54 55 56
  :group 'eww
  :type 'string)

57 58
(defcustom eww-download-directory "~/Downloads/"
  "Directory where files will downloaded."
59 60 61 62
  :version "24.4"
  :group 'eww
  :type 'string)

63 64 65 66 67 68 69 70 71 72 73 74 75 76 77
(defcustom eww-suggest-uris
  '(eww-links-at-point
    url-get-url-at-point
    eww-current-url)
  "List of functions called to form the list of default URIs for `eww'.
Each of the elements is a function returning either a string or a list
of strings.  The results will be joined into a single list with
duplicate entries (if any) removed."
  :version "25.1"
  :group 'eww
  :type 'hook
  :options '(eww-links-at-point
	     url-get-url-at-point
	     eww-current-url))

78 79
(defcustom eww-bookmarks-directory user-emacs-directory
  "Directory where bookmark files will be stored."
Stefan Monnier's avatar
Stefan Monnier committed
80
  :version "25.1"
81 82 83
  :group 'eww
  :type 'string)

Ivan Shmakov's avatar
Ivan Shmakov committed
84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113
(defcustom eww-desktop-remove-duplicates t
  "Whether to remove duplicates from the history when saving desktop data.
If non-nil, repetitive EWW history entries (comprising of the URI, the
title, and the point position) will not be saved as part of the Emacs
desktop.  Otherwise, such entries will be retained."
  :version "25.1"
  :group 'eww
  :type 'boolean)

(defcustom eww-restore-desktop nil
  "How to restore EWW buffers on `desktop-restore'.
If t or 'auto, the buffers will be reloaded automatically.
If nil, buffers will require manual reload, and will contain the text
specified in `eww-restore-reload-prompt' instead of the actual Web
page contents."
  :version "25.1"
  :group 'eww
  :type '(choice (const :tag "Restore all automatically" t)
                 (const :tag "Require manual reload" nil)))

(defcustom eww-restore-reload-prompt
  "\n\n *** Use \\[eww-reload] to reload this buffer. ***\n"
  "The string to put in the buffers not reloaded on `desktop-restore'.
This prompt will be used if `eww-restore-desktop' is nil.

The string will be passed through `substitute-command-keys'."
  :version "25.1"
  :group 'eww
  :type 'string)

114 115 116 117 118 119
(defcustom eww-history-limit 50
  "Maximum number of entries to retain in the history."
  :version "25.1"
  :group 'eww
  :type '(choice (const :tag "Unlimited" nil)
                 integer))
120

121 122 123 124 125 126 127 128
(defcustom eww-use-external-browser-for-content-type
  "\\`\\(video/\\|audio/\\|application/ogg\\)"
  "Always use external browser for specified content-type."
  :version "24.4"
  :group 'eww
  :type '(choice (const :tag "Never" nil)
                 regexp))

129 130 131 132 133 134
(defcustom eww-after-render-hook nil
  "A hook called after eww has finished rendering the buffer."
  :version "25.1"
  :group 'eww
  :type 'hook)

135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153
(defcustom eww-form-checkbox-selected-symbol "[X]"
  "Symbol used to represent a selected checkbox.
See also `eww-form-checkbox-symbol'."
  :version "24.4"
  :group 'eww
  :type '(choice (const "[X]")
                 (const "☒")            ; Unicode BALLOT BOX WITH X
                 (const "☑")            ; Unicode BALLOT BOX WITH CHECK
                 string))

(defcustom eww-form-checkbox-symbol "[ ]"
  "Symbol used to represent a checkbox.
See also `eww-form-checkbox-selected-symbol'."
  :version "24.4"
  :group 'eww
  :type '(choice (const "[ ]")
                 (const "☐")            ; Unicode BALLOT BOX
                 string))

154 155 156 157 158 159 160 161
(defface eww-form-submit
  '((((type x w32 ns) (class color))	; Like default mode line
     :box (:line-width 2 :style released-button)
     :background "#808080" :foreground "black"))
  "Face for eww buffer buttons."
  :version "24.4"
  :group 'eww)

162 163 164 165 166
(defface eww-form-file
  '((((type x w32 ns) (class color))	; Like default mode line
     :box (:line-width 2 :style released-button)
     :background "#808080" :foreground "black"))
  "Face for eww buffer buttons."
167
  :version "25.1"
168
  :group 'eww)
169

170 171 172 173 174 175 176 177 178
(defface eww-form-checkbox
  '((((type x w32 ns) (class color))	; Like default mode line
     :box (:line-width 2 :style released-button)
     :background "lightgrey" :foreground "black"))
  "Face for eww buffer buttons."
  :version "24.4"
  :group 'eww)

(defface eww-form-select
179 180 181 182 183 184 185
  '((((type x w32 ns) (class color))	; Like default mode line
     :box (:line-width 2 :style released-button)
     :background "lightgrey" :foreground "black"))
  "Face for eww buffer buttons."
  :version "24.4"
  :group 'eww)

186 187 188 189 190 191 192 193
(defface eww-form-text
  '((t (:background "#505050"
		    :foreground "white"
		    :box (:line-width 1))))
  "Face for eww text inputs."
  :version "24.4"
  :group 'eww)

Kenjiro NAKAYAMA's avatar
Kenjiro NAKAYAMA committed
194 195 196 197 198 199 200 201
(defface eww-form-textarea
  '((t (:background "#C0C0C0"
		    :foreground "black"
		    :box (:line-width 1))))
  "Face for eww textarea inputs."
  :version "24.4"
  :group 'eww)

202 203 204 205 206 207 208 209 210 211 212 213 214 215
(defface eww-invalid-certificate
  '((default :weight bold)
    (((class color)) :foreground "red"))
  "Face for web pages with invalid certificates."
  :version "25.1"
  :group 'eww)

(defface eww-valid-certificate
  '((default :weight bold)
    (((class color)) :foreground "ForestGreen"))
  "Face for web pages with valid certificates."
  :version "25.1"
  :group 'eww)

216
(defvar eww-data nil)
217
(defvar eww-history nil)
218
(defvar eww-history-position 0)
219

220 221 222
(defvar eww-local-regex "localhost"
  "When this regex is found in the URL, it's not a keyword but an address.")

223 224 225 226 227
(defvar eww-link-keymap
  (let ((map (copy-keymap shr-map)))
    (define-key map "\r" 'eww-follow-link)
    map))

228 229 230 231 232 233 234 235 236 237 238 239 240
(defun eww-suggested-uris nil
  "Return the list of URIs to suggest at the `eww' prompt.
This list can be customized via `eww-suggest-uris'."
  (let ((obseen (make-vector 42 0))
	(uris nil))
    (dolist (fun eww-suggest-uris)
      (let ((ret (funcall fun)))
	(dolist (uri (if (stringp ret) (list ret) ret))
	  (when (and uri (not (intern-soft uri obseen)))
	    (intern uri obseen)
	    (push   uri uris)))))
    (nreverse uris)))

241
;;;###autoload
242
(defun eww (url)
243 244 245
  "Fetch URL and render the page.
If the input doesn't look like an URL or a domain name, the
word(s) will be searched for via `eww-search-prefix'."
246 247 248 249 250 251
  (interactive
   (let* ((uris (eww-suggested-uris))
	  (prompt (concat "Enter URL or keywords"
			  (if uris (format " (default %s)" (car uris)) "")
			  ": ")))
     (list (read-string prompt nil nil uris))))
252
  (setq url (string-trim url))
253
  (cond ((string-match-p "\\`file:/" url))
254
	;; Don't mangle file: URLs at all.
255 256 257
        ((string-match-p "\\`ftp://" url)
         (user-error "FTP is not supported."))
        (t
258
         (if (or (string-match "\\`https?:" url)
259 260
		 ;; Also try to match "naked" URLs like
		 ;; en.wikipedia.org/wiki/Free software
261
		 (string-match "\\`[A-Za-z_]+\\.[A-Za-z._]+/" url)
262 263 264 265
		 (and (= (length (split-string url)) 1)
		      (or (and (not (string-match-p "\\`[\"\'].*[\"\']\\'" url))
			       (> (length (split-string url "[.:]")) 1))
			  (string-match eww-local-regex url))))
266 267 268
             (progn
               (unless (string-match-p "\\`[a-zA-Z][-a-zA-Z0-9+.]*://" url)
                 (setq url (concat "http://" url)))
269
               ;; Some sites do not redirect final /
270 271 272 273
               (when (string= (url-filename (url-generic-parse-url url)) "")
                 (setq url (concat url "/"))))
           (setq url (concat eww-search-prefix
                             (replace-regexp-in-string " " "+" url))))))
Ivan Shmakov's avatar
Ivan Shmakov committed
274 275 276 277
  (if (eq major-mode 'eww-mode)
      (when (or (plist-get eww-data :url)
		(plist-get eww-data :dom))
	(eww-save-history))
278
    (eww-setup-buffer)
279
    (plist-put eww-data :url url)
280
    (plist-put eww-data :title "")
281 282
    (eww-update-header-line-format)
    (let ((inhibit-read-only t))
283 284
      (insert (format "Loading %s..." url))
      (goto-char (point-min))))
285
  (url-retrieve url 'eww-render
286
		(list url nil (current-buffer))))
287

288 289
;;;###autoload (defalias 'browse-web 'eww)

290 291 292 293
;;;###autoload
(defun eww-open-file (file)
  "Render a file using EWW."
  (interactive "fFile: ")
294 295 296 297
  (eww (concat "file://"
	       (and (memq system-type '(windows-nt ms-dos))
		    "/")
	       (expand-file-name file))))
298

299 300
;;;###autoload
(defun eww-search-words (&optional beg end)
301 302
  "Search the web for the text between the point and marker.
See the `eww-search-prefix' variable for the search engine used."
303 304 305
  (interactive "r")
  (eww (buffer-substring beg end)))

306
(defun eww-render (status url &optional point buffer encode)
307 308 309
  (let ((redirect (plist-get status :redirect)))
    (when redirect
      (setq url redirect)))
310 311 312 313 314 315 316 317
  (let* ((headers (eww-parse-headers))
	 (content-type
	  (mail-header-parse-content-type
	   (or (cdr (assoc "content-type" headers))
	       "text/plain")))
	 (charset (intern
		   (downcase
		    (or (cdr (assq 'charset (cdr content-type)))
318 319
			(eww-detect-charset (equal (car content-type)
						   "text/html"))
320
			"utf-8"))))
321
	 (data-buffer (current-buffer)))
322 323 324
    ;; Save the https peer status.
    (with-current-buffer buffer
      (plist-put eww-data :peer (plist-get status :peer)))
325 326 327
    (unwind-protect
	(progn
	  (cond
328 329 330 331
           ((and eww-use-external-browser-for-content-type
                 (string-match-p eww-use-external-browser-for-content-type
                                 (car content-type)))
            (eww-browse-with-external-browser url))
332
	   ((equal (car content-type) "text/html")
333
	    (eww-display-html charset url nil point buffer encode))
334 335
	   ((equal (car content-type) "application/pdf")
	    (eww-display-pdf))
336
	   ((string-match-p "\\`image/" (car content-type))
337
	    (eww-display-image buffer))
338
	   (t
339 340 341 342 343 344
	    (eww-display-raw buffer encode)))
	  (with-current-buffer buffer
	    (plist-put eww-data :url url)
	    (eww-update-header-line-format)
	    (setq eww-history-position 0)
	    (run-hooks 'eww-after-render-hook)))
345 346 347 348
      (kill-buffer data-buffer))))

(defun eww-parse-headers ()
  (let ((headers nil))
349
    (goto-char (point-min))
350 351 352 353 354 355 356 357 358 359 360
    (while (and (not (eobp))
		(not (eolp)))
      (when (looking-at "\\([^:]+\\): *\\(.*\\)")
	(push (cons (downcase (match-string 1))
		    (match-string 2))
	      headers))
      (forward-line 1))
    (unless (eobp)
      (forward-line 1))
    headers))

361 362 363 364 365
(defun eww-detect-charset (html-p)
  (let ((case-fold-search t)
	(pt (point)))
    (or (and html-p
	     (re-search-forward
Ivan Kanis's avatar
Ivan Kanis committed
366
	      "<meta[\t\n\r ]+[^>]*charset=\"?\\([^\t\n\r \"/>]+\\)[\\\"'.*]" nil t)
367 368 369 370 371 372
	     (goto-char pt)
	     (match-string 1))
	(and (looking-at
	      "[\t\n\r ]*<\\?xml[\t\n\r ]+[^>]*encoding=\"\\([^\"]+\\)")
	     (match-string 1)))))

373 374 375
(declare-function libxml-parse-html-region "xml.c"
		  (start end &optional base-url))

376
(defun eww-display-html (charset url &optional document point buffer encode)
377 378 379 380
  (unless (fboundp 'libxml-parse-html-region)
    (error "This function requires Emacs to be compiled with libxml2"))
  (unless (buffer-live-p buffer)
    (error "Buffer %s doesn't exist" buffer))
381 382 383
  ;; There should be a better way to abort loading images
  ;; asynchronously.
  (setq url-queue nil)
384
  (let ((document
385 386 387
	 (or document
	     (list
	      'base (list (cons 'href url))
388
	      (progn
389 390 391
		(when (or (and encode
			       (not (eq charset encode)))
			  (not (eq charset 'utf-8)))
392
		  (condition-case nil
393 394
		      (decode-coding-region (point) (point-max)
					    (or encode charset))
395 396 397 398
		    (coding-system-error nil)))
		(libxml-parse-html-region (point) (point-max))))))
	(source (and (null document)
		     (buffer-substring (point) (point-max)))))
399 400 401 402
    (with-current-buffer buffer
      (plist-put eww-data :source source)
      (plist-put eww-data :dom document)
      (let ((inhibit-read-only t)
403
	    (inhibit-modification-hooks t)
404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431
	    (shr-target-id (url-target (url-generic-parse-url url)))
	    (shr-external-rendering-functions
	     '((title . eww-tag-title)
	       (form . eww-tag-form)
	       (input . eww-tag-input)
	       (textarea . eww-tag-textarea)
	       (body . eww-tag-body)
	       (select . eww-tag-select)
	       (link . eww-tag-link)
	       (a . eww-tag-a))))
	(erase-buffer)
	(shr-insert-document document)
	(cond
	 (point
	  (goto-char point))
	 (shr-target-id
	  (goto-char (point-min))
	  (let ((point (next-single-property-change
			(point-min) 'shr-target-id)))
	    (when point
	      (goto-char point))))
	 (t
	  (goto-char (point-min))
	  ;; Don't leave point inside forms, because the normal eww
	  ;; commands aren't available there.
	  (while (and (not (eobp))
		      (get-text-property (point) 'eww-form))
	    (forward-line 1)))))
432
      (eww-size-text-inputs))))
433

434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452
(defun eww-handle-link (dom)
  (let* ((rel (dom-attr dom 'rel))
	 (href (dom-attr dom 'href))
	 (where (assoc
		 ;; The text associated with :rel is case-insensitive.
		 (if rel (downcase rel))
		 '(("next" . :next)
		   ;; Texinfo uses "previous", but HTML specifies
		   ;; "prev", so recognize both.
		   ("previous" . :previous)
		   ("prev" . :previous)
		   ;; HTML specifies "start" but also "contents",
		   ;; and Gtk seems to use "home".  Recognize
		   ;; them all; but store them in different
		   ;; variables so that we can readily choose the
		   ;; "best" one.
		   ("start" . :start)
		   ("home" . :home)
		   ("contents" . :contents)
Ivan Shmakov's avatar
Ivan Shmakov committed
453
		   ("up" . :up)))))
454 455
    (and href
	 where
456
	 (plist-put eww-data (cdr where) href))))
457

458 459 460
(defun eww-tag-link (dom)
  (eww-handle-link dom)
  (shr-generic dom))
461

462 463
(defun eww-tag-a (dom)
  (eww-handle-link dom)
464
  (let ((start (point)))
465
    (shr-tag-a dom)
466
    (put-text-property start (point) 'keymap eww-link-keymap)))
467

468
(defun eww-update-header-line-format ()
469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487
  (setq header-line-format
	(and eww-header-line-format
	     (let ((title (plist-get eww-data :title))
		   (peer (plist-get eww-data :peer)))
	       (when (zerop (length title))
		 (setq title "[untitled]"))
	       ;; This connection has is https.
	       (when peer
		 (setq title
		       (propertize title 'face
				   (if (plist-get peer :warnings)
				       'eww-invalid-certificate
				     'eww-valid-certificate))))
	       (replace-regexp-in-string
		"%" "%%"
		(format-spec
		 eww-header-line-format
		 `((?u . ,(or (plist-get eww-data :url) ""))
		   (?t . ,title))))))))
488

489
(defun eww-tag-title (dom)
490 491 492 493
  (plist-put eww-data :title
	     (replace-regexp-in-string
	      "^ \\| $" ""
	      (replace-regexp-in-string "[ \t\r\n]+" " " (dom-text dom))))
494 495
  (eww-update-header-line-format))

496
(defun eww-tag-body (dom)
497
  (let* ((start (point))
498 499
	 (fgcolor (or (dom-attr dom 'fgcolor) (dom-attr dom 'text)))
	 (bgcolor (dom-attr dom 'bgcolor))
500 501
	 (shr-stylesheet (list (cons 'color fgcolor)
			       (cons 'background-color bgcolor))))
502
    (shr-generic dom)
503
    (shr-colorize-region start (point) fgcolor bgcolor)))
504

505
(defun eww-display-raw (buffer &optional encode)
506
  (let ((data (buffer-substring (point) (point-max))))
507 508 509 510 511 512 513 514 515 516 517 518 519 520
    (unless (buffer-live-p buffer)
      (error "Buffer %s doesn't exist" buffer))
    (with-current-buffer buffer
      (let ((inhibit-read-only t))
	(erase-buffer)
	(insert data)
	(unless (eq encode 'utf-8)
	  (encode-coding-region (point-min) (1+ (length data)) 'utf-8)
	  (condition-case nil
	      (decode-coding-region (point-min) (1+ (length data)) encode)
	    (coding-system-error nil))))
      (goto-char (point-min)))))

(defun eww-display-image (buffer)
521
  (let ((data (shr-parse-image-data)))
522 523 524 525 526 527 528
    (unless (buffer-live-p buffer)
      (error "Buffer %s doesn't exist" buffer))
    (with-current-buffer buffer
      (let ((inhibit-read-only t))
	(erase-buffer)
	(shr-put-image data nil))
      (goto-char (point-min)))))
529

530
(declare-function mailcap-view-mime "mailcap" (type))
531 532 533 534 535 536 537
(defun eww-display-pdf ()
  (let ((data (buffer-substring (point) (point-max))))
    (switch-to-buffer (get-buffer-create "*eww pdf*"))
    (let ((coding-system-for-write 'raw-text)
	  (inhibit-read-only t))
      (erase-buffer)
      (insert data)
538
      (mailcap-view-mime "application/pdf")))
539 540
  (goto-char (point-min)))

541 542
(defun eww-setup-buffer ()
  (switch-to-buffer (get-buffer-create "*eww*"))
543
  (let ((inhibit-read-only t))
544
    (remove-overlays)
545
    (erase-buffer))
546
  (unless (eq major-mode 'eww-mode)
547
    (eww-mode)))
548

549 550 551 552 553 554 555 556 557 558
(defun eww-current-url nil
  "Return URI of the Web page the current EWW buffer is visiting."
  (plist-get eww-data :url))

(defun eww-links-at-point (&optional pt)
  "Return list of URIs, if any, linked at point."
  (remq nil
	(list (get-text-property (point) 'shr-url)
	      (get-text-property (point) 'image-url))))

559
(defun eww-view-source ()
560
  "View the HTML source code of the current page."
561 562
  (interactive)
  (let ((buf (get-buffer-create "*eww-source*"))
563
        (source (plist-get eww-data :source)))
564
    (with-current-buffer buf
565 566 567 568 569 570
      (let ((inhibit-read-only t))
	(delete-region (point-min) (point-max))
	(insert (or source "no source"))
	(goto-char (point-min))
	(when (fboundp 'html-mode)
	  (html-mode))))
571 572
    (view-buffer buf)))

573 574 575 576 577 578
(defun eww-readable ()
  "View the main \"readable\" parts of the current web page.
This command uses heuristics to find the parts of the web page that
contains the main textual portion, leaving out navigation menus and
the like."
  (interactive)
579
  (let* ((old-data eww-data)
580 581 582 583 584 585
	 (dom (with-temp-buffer
		(insert (plist-get old-data :source))
		(condition-case nil
		    (decode-coding-region (point-min) (point-max) 'utf-8)
		  (coding-system-error nil))
		(libxml-parse-html-region (point-min) (point-max)))))
586
    (eww-score-readability dom)
587
    (eww-save-history)
588
    (eww-display-html nil nil
589
		      (eww-highest-readability dom)
590
		      nil (current-buffer))
591 592 593
    (dolist (elem '(:source :url :title :next :previous :up))
      (plist-put eww-data elem (plist-get old-data elem)))
    (eww-update-header-line-format)))
594 595 596 597

(defun eww-score-readability (node)
  (let ((score -1))
    (cond
598
     ((memq (dom-tag node) '(script head comment))
599
      (setq score -2))
600
     ((eq (dom-tag node) 'meta)
601
      (setq score -1))
602
     ((eq (dom-tag node) 'img)
603
      (setq score 2))
604 605
     ((eq (dom-tag node) 'a)
      (setq score (- (length (split-string (dom-text node))))))
606
     (t
607 608 609
      (dolist (elem (dom-children node))
	(if (stringp elem)
	    (setq score (+ score (length (split-string elem))))
610 611
	  (setq score (+ score
			 (or (cdr (assoc :eww-readability-score (cdr elem)))
612
			     (eww-score-readability elem))))))))
613
    ;; Cache the score of the node to avoid recomputing all the time.
614
    (dom-set-attribute node :eww-readability-score score)
615 616 617 618 619
    score))

(defun eww-highest-readability (node)
  (let ((result node)
	highest)
620 621 622 623 624 625 626
    (dolist (elem (dom-non-text-children node))
      (when (> (or (dom-attr
		    (setq highest (eww-highest-readability elem))
		    :eww-readability-score)
		   most-negative-fixnum)
	       (or (dom-attr result :eww-readability-score)
		   most-negative-fixnum))
627 628 629
	(setq result highest)))
    result))

630 631 632
(defvar eww-mode-map
  (let ((map (make-sparse-keymap)))
    (suppress-keymap map)
633
    (define-key map "q" 'quit-window)
634
    (define-key map "g" 'eww-reload)
635
    (define-key map "G" 'eww)
636 637
    (define-key map [?\t] 'shr-next-link)
    (define-key map [?\M-\t] 'shr-previous-link)
638
    (define-key map [backtab] 'shr-previous-link)
639
    (define-key map [delete] 'scroll-down-command)
640
    (define-key map [?\S-\ ] 'scroll-down-command)
641 642
    (define-key map "\177" 'scroll-down-command)
    (define-key map " " 'scroll-up-command)
643
    (define-key map "l" 'eww-back-url)
644
    (define-key map "r" 'eww-forward-url)
645
    (define-key map "n" 'eww-next-url)
646
    (define-key map "p" 'eww-previous-url)
647 648
    (define-key map "u" 'eww-up-url)
    (define-key map "t" 'eww-top-url)
649
    (define-key map "&" 'eww-browse-with-external-browser)
650
    (define-key map "d" 'eww-download)
651
    (define-key map "w" 'eww-copy-page-url)
652
    (define-key map "C" 'url-cookie-list)
653
    (define-key map "v" 'eww-view-source)
654
    (define-key map "R" 'eww-readable)
655
    (define-key map "H" 'eww-list-histories)
656
    (define-key map "E" 'eww-set-character-encoding)
657
    (define-key map "S" 'eww-list-buffers)
658

659 660 661 662 663
    (define-key map "b" 'eww-add-bookmark)
    (define-key map "B" 'eww-list-bookmarks)
    (define-key map [(meta n)] 'eww-next-bookmark)
    (define-key map [(meta p)] 'eww-previous-bookmark)

664
    (easy-menu-define nil map ""
665
      '("Eww"
666
	["Exit" quit-window t]
667
	["Close browser" quit-window t]
668 669 670 671 672 673 674
	["Reload" eww-reload t]
	["Back to previous page" eww-back-url
	 :active (not (zerop (length eww-history)))]
	["Forward to next page" eww-forward-url
	 :active (not (zerop eww-history-position))]
	["Browse with external browser" eww-browse-with-external-browser t]
	["Download" eww-download t]
675
	["View page source" eww-view-source]
676
	["Copy page URL" eww-copy-page-url t]
677
	["List histories" eww-list-histories t]
678
	["List buffers" eww-list-buffers t]
679
	["Add bookmark" eww-add-bookmark t]
Kenjiro NAKAYAMA's avatar
Kenjiro NAKAYAMA committed
680
	["List bookmarks" eww-list-bookmarks t]
681 682
	["List cookies" url-cookie-list t]
       ["Character Encoding" eww-set-character-encoding]))
683 684
    map))

685 686 687
(defvar eww-tool-bar-map
  (let ((map (make-sparse-keymap)))
    (dolist (tool-bar-item
688
             '((quit-window . "close")
689 690 691 692 693 694 695 696 697 698 699
               (eww-reload . "refresh")
               (eww-back-url . "left-arrow")
               (eww-forward-url . "right-arrow")
               (eww-view-source . "show")
               (eww-copy-page-url . "copy")
               (eww-add-bookmark . "bookmark_add"))) ;; ...
      (tool-bar-local-item-from-menu
       (car tool-bar-item) (cdr tool-bar-item) map eww-mode-map))
    map)
  "Tool bar for `eww-mode'.")

700
(define-derived-mode eww-mode nil "eww"
701 702 703
  "Mode for browsing the web.

\\{eww-mode-map}"
704
  (setq-local eww-data (list :title ""))
705 706 707 708 709 710
  (setq-local browse-url-browser-function 'eww-browse-url)
  (setq-local after-change-functions 'eww-process-text-input)
  (setq-local eww-history nil)
  (setq-local eww-history-position 0)
  (when (boundp 'tool-bar-map)
   (setq-local tool-bar-map eww-tool-bar-map))
Ivan Shmakov's avatar
Ivan Shmakov committed
711 712
  ;; desktop support
  (setq-local desktop-save-buffer 'eww-desktop-misc-data)
713 714
  ;; multi-page isearch support
  (setq-local multi-isearch-next-buffer-function 'eww-isearch-next-buffer)
715
  (setq truncate-lines t)
716
  (buffer-disable-undo)
717
  (setq buffer-read-only t))
718

719
;;;###autoload
720 721
(defun eww-browse-url (url &optional new-window)
  (cond (new-window
Ivan Shmakov's avatar
Ivan Shmakov committed
722 723
	 (switch-to-buffer (generate-new-buffer "*eww*"))
         (eww-mode)))
724
  (eww url))
725

726
(defun eww-back-url ()
727 728
  "Go to the previously displayed page."
  (interactive)
729
  (when (>= eww-history-position (length eww-history))
730
    (user-error "No previous page"))
731 732 733
  (eww-save-history)
  (setq eww-history-position (+ eww-history-position 2))
  (eww-restore-history (elt eww-history (1- eww-history-position))))
734 735 736 737 738

(defun eww-forward-url ()
  "Go to the next displayed page."
  (interactive)
  (when (zerop eww-history-position)
739
    (user-error "No next page"))
740 741
  (eww-save-history)
  (eww-restore-history (elt eww-history (1- eww-history-position))))
742 743

(defun eww-restore-history (elem)
Ivan Shmakov's avatar
Ivan Shmakov committed
744
  (let ((inhibit-read-only t)
745
	(inhibit-modification-hooks t)
Ivan Shmakov's avatar
Ivan Shmakov committed
746
	(text (plist-get elem :text)))
747
    (setq eww-data elem)
Ivan Shmakov's avatar
Ivan Shmakov committed
748 749 750 751 752 753
    (if (null text)
	(eww-reload)			; FIXME: restore :point?
      (erase-buffer)
      (insert text)
      (goto-char (plist-get elem :point))
      (eww-update-header-line-format))))
754

755 756 757 758 759
(defun eww-next-url ()
  "Go to the page marked `next'.
A page is marked `next' if rel=\"next\" appears in a <link>
or <a> tag."
  (interactive)
760 761 762
  (if (plist-get eww-data :next)
      (eww-browse-url (shr-expand-url (plist-get eww-data :next)
				      (plist-get eww-data :url)))
763
    (user-error "No `next' on this page")))
764 765 766 767 768 769

(defun eww-previous-url ()
  "Go to the page marked `previous'.
A page is marked `previous' if rel=\"previous\" appears in a <link>
or <a> tag."
  (interactive)
770 771
  (if (plist-get eww-data :previous)
      (eww-browse-url (shr-expand-url (plist-get eww-data :previous)
772
				      (plist-get eww-data :url)))
773
    (user-error "No `previous' on this page")))
774 775 776 777 778 779

(defun eww-up-url ()
  "Go to the page marked `up'.
A page is marked `up' if rel=\"up\" appears in a <link>
or <a> tag."
  (interactive)
780 781 782
  (if (plist-get eww-data :up)
      (eww-browse-url (shr-expand-url (plist-get eww-data :up)
				      (plist-get eww-data :url)))
783
    (user-error "No `up' on this page")))
784 785 786

(defun eww-top-url ()
  "Go to the page marked `top'.
787 788
A page is marked `top' if rel=\"start\", rel=\"home\", or rel=\"contents\"
appears in a <link> or <a> tag."
789
  (interactive)
790 791 792
  (let ((best-url (or (plist-get eww-data :start)
		      (plist-get eww-data :contents)
		      (plist-get eww-data :home))))
793
    (if best-url
794
	(eww-browse-url (shr-expand-url best-url (plist-get eww-data :url)))
795
      (user-error "No `top' for this page"))))
796

797 798 799 800 801
(defun eww-reload (&optional local encode)
  "Reload the current page.
If LOCAL (the command prefix), don't reload the page from the
network, but just re-display the HTML already fetched."
  (interactive "P")
802
  (let ((url (plist-get eww-data :url)))
803 804 805 806 807 808 809
    (if local
	(if (null (plist-get eww-data :dom))
	    (error "No current HTML data")
	  (eww-display-html 'utf-8 url (plist-get eww-data :dom)
			    (point) (current-buffer)))
      (url-retrieve url 'eww-render
		    (list url (point) (current-buffer) encode)))))
810

811 812 813 814
;; Form support.

(defvar eww-form nil)

815 816 817
(defvar eww-submit-map
  (let ((map (make-sparse-keymap)))
    (define-key map "\r" 'eww-submit)
818
    (define-key map [(control c) (control c)] 'eww-submit)
819 820
    map))

821 822 823 824 825 826
(defvar eww-submit-file
  (let ((map (make-sparse-keymap)))
    (define-key map "\r" 'eww-select-file)
    (define-key map [(control c) (control c)] 'eww-submit)
    map))

827 828
(defvar eww-checkbox-map
  (let ((map (make-sparse-keymap)))
Kenjiro NAKAYAMA's avatar
Kenjiro NAKAYAMA committed
829
    (define-key map " " 'eww-toggle-checkbox)
830
    (define-key map "\r" 'eww-toggle-checkbox)
831
    (define-key map [(control c) (control c)] 'eww-submit)
832 833 834 835 836 837 838
    map))

(defvar eww-text-map
  (let ((map (make-keymap)))
    (set-keymap-parent map text-mode-map)
    (define-key map "\r" 'eww-submit)
    (define-key map [(control a)] 'eww-beginning-of-text)
839
    (define-key map [(control c) (control c)] 'eww-submit)
840
    (define-key map [(control e)] 'eww-end-of-text)
841 842
    (define-key map [?\t] 'shr-next-link)
    (define-key map [?\M-\t] 'shr-previous-link)
843 844 845 846 847 848
    map))

(defvar eww-textarea-map
  (let ((map (make-keymap)))
    (set-keymap-parent map text-mode-map)
    (define-key map "\r" 'forward-line)
849
    (define-key map [(control c) (control c)] 'eww-submit)
850 851
    (define-key map [?\t] 'shr-next-link)
    (define-key map [?\M-\t] 'shr-previous-link)
852 853 854 855 856
    map))

(defvar eww-select-map
  (let ((map (make-sparse-keymap)))
    (define-key map "\r" 'eww-change-select)
857
    (define-key map [(control c) (control c)] 'eww-submit)
858 859 860 861 862 863 864 865 866 867 868 869 870 871 872 873 874 875 876 877 878 879 880 881 882 883 884 885 886 887 888 889 890
    map))

(defun eww-beginning-of-text ()
  "Move to the start of the input field."
  (interactive)
  (goto-char (eww-beginning-of-field)))

(defun eww-end-of-text ()
  "Move to the end of the text in the input field."
  (interactive)
  (goto-char (eww-end-of-field))
  (let ((start (eww-beginning-of-field)))
    (while (and (equal (following-char) ? )
		(> (point) start))
      (forward-char -1))
    (when (> (point) start)
      (forward-char 1))))

(defun eww-beginning-of-field ()
  (cond
   ((bobp)
    (point))
   ((not (eq (get-text-property (point) 'eww-form)
	     (get-text-property (1- (point)) 'eww-form)))
    (point))
   (t
    (previous-single-property-change
     (point) 'eww-form nil (point-min)))))

(defun eww-end-of-field ()
  (1- (next-single-property-change
       (point) 'eww-form nil (point-max))))

891 892 893
(defun eww-tag-form (dom)
  (let ((eww-form (list (cons :method (dom-attr dom 'method))
			(cons :action (dom-attr dom 'action))))
894 895
	(start (point)))
    (shr-ensure-paragraph)
896
    (shr-generic dom)
897 898 899
    (unless (bolp)
      (insert "\n"))
    (insert "\n")
900 901 902
    (when (> (point) start)
      (put-text-property start (1+ start)
			 'eww-form eww-form))))
903

904
(defun eww-form-submit (dom)
905
  (let ((start (point))
906
	(value (dom-attr dom 'value)))
907 908 909 910 911 912 913 914 915 916
    (setq value
	  (if (zerop (length value))
	      "Submit"
	    value))
    (insert value)
    (add-face-text-property start (point) 'eww-form-submit)
    (put-text-property start (point) 'eww-form
		       (list :eww-form eww-form
			     :value value
			     :type "submit"
917
			     :name (dom-attr dom 'name)))
918 919 920
    (put-text-property start (point) 'keymap eww-submit-map)
    (insert " ")))

921
(defun eww-form-checkbox (dom)
922
  (let ((start (point)))
923
    (if (dom-attr dom 'checked)
924 925
	(insert eww-form-checkbox-selected-symbol)
      (insert eww-form-checkbox-symbol))
926 927 928
    (add-face-text-property start (point) 'eww-form-checkbox)
    (put-text-property start (point) 'eww-form
		       (list :eww-form eww-form
929 930 931 932
			     :value (dom-attr dom 'value)
			     :type (downcase (dom-attr dom 'type))
			     :checked (dom-attr dom 'checked)
			     :name (dom-attr dom 'name)))
933 934 935
    (put-text-property start (point) 'keymap eww-checkbox-map)
    (insert " ")))

936
(defun eww-form-file (dom)
937
  (let ((start (point))
938
	(value (dom-attr dom 'value)))
939 940 941 942 943 944 945 946 947
    (setq value
	  (if (zerop (length value))
	      " No file selected"
	    value))
    (insert "Browse")
    (add-face-text-property start (point) 'eww-form-file)
    (insert value)
    (put-text-property start (point) 'eww-form
		       (list :eww-form eww-form
948 949 950
			     :value (dom-attr dom 'value)
			     :type (downcase (dom-attr dom 'type))
			     :name (dom-attr dom 'name)))
951 952 953 954 955 956 957 958 959 960 961 962 963
    (put-text-property start (point) 'keymap eww-submit-file)
    (insert " ")))

(defun eww-select-file ()
  "Change the value of the upload file menu under point."
  (interactive)
  (let*  ((input (get-text-property (point) 'eww-form)))
    (let ((filename
	   (let ((insert-default-directory t))
	     (read-file-name "filename:  "))))
      (eww-update-field filename (length "Browse"))
              (plist-put input :filename filename))))

964
(defun eww-form-text (dom)
965
  (let ((start (point))
966 967 968 969 970
	(type (downcase (or (dom-attr dom 'type) "text")))
	(value (or (dom-attr dom 'value) ""))
	(width (string-to-number (or (dom-attr dom 'size) "40")))
        (readonly-property (if (or (dom-attr dom 'disabled)
				   (dom-attr dom 'readonly))
971 972
                               'read-only
                             'inhibit-read-only)))
973 974 975 976
    (insert value)
    (when (< (length value) width)
      (insert (make-string (- width (length value)) ? )))
    (put-text-property start (point) 'face 'eww-form-text)
977
    (put-text-property start (point) 'inhibit-read-only t)
978
    (put-text-property start (point) 'local-map eww-text-map)
979
    (put-text-property start (point) readonly-property t)
980
    (put-text-property start (point) 'eww-form
981 982 983
                       (list :eww-form eww-form
                             :value value
                             :type type
984
                             :name (dom-attr dom 'name)))
985 986
    (insert " ")))

987 988 989 990 991 992 993
(defconst eww-text-input-types '("text" "password" "textarea"
                                 "color" "date" "datetime" "datetime-local"
                                 "email" "month" "number" "search" "tel"
                                 "time" "url" "week")
  "List of input types which represent a text input.
See URL `https://develo