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

3
;; Copyright (C) 2013-2014 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 'mm-url)
32

33 34 35
(defgroup eww nil
  "Emacs Web Wowser"
  :version "24.4"
36
  :link '(custom-manual "(eww) Top")
37 38 39 40 41 42 43
  :group 'hypermedia
  :prefix "eww-")

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

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

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

60 61
(defcustom eww-bookmarks-directory user-emacs-directory
  "Directory where bookmark files will be stored."
Stefan Monnier's avatar
Stefan Monnier committed
62
  :version "25.1"
63 64 65
  :group 'eww
  :type 'string)

66 67 68 69 70 71 72 73
(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))

74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92
(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))

93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109
(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)

(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
110 111 112 113 114 115 116
  '((((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)

117 118 119 120 121 122 123 124
(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
125 126 127 128 129 130 131 132
(defface eww-form-textarea
  '((t (:background "#C0C0C0"
		    :foreground "black"
		    :box (:line-width 1))))
  "Face for eww textarea inputs."
  :version "24.4"
  :group 'eww)

133
(defvar eww-current-url nil)
134
(defvar eww-current-dom nil)
135
(defvar eww-current-source nil)
136 137
(defvar eww-current-title ""
  "Title of current page.")
138
(defvar eww-history nil)
139
(defvar eww-history-position 0)
140

141 142 143
(defvar eww-next-url nil)
(defvar eww-previous-url nil)
(defvar eww-up-url nil)
144 145 146
(defvar eww-home-url nil)
(defvar eww-start-url nil)
(defvar eww-contents-url nil)
147

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

151 152 153 154 155
(defvar eww-link-keymap
  (let ((map (copy-keymap shr-map)))
    (define-key map "\r" 'eww-follow-link)
    map))

156
;;;###autoload
157
(defun eww (url)
158 159 160 161
  "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'."
  (interactive "sEnter URL or keywords: ")
162 163 164 165 166
  (cond ((string-match-p "\\`file://" url))
        ((string-match-p "\\`ftp://" url)
         (user-error "FTP is not supported."))
        (t
         (if (and (= (length (split-string url)) 1)
167 168 169
                 (or (and (not (string-match-p "\\`[\"\'].*[\"\']\\'" url))
                          (> (length (split-string url "\\.")) 1))
                     (string-match eww-local-regex url)))
170 171 172 173 174 175 176 177
             (progn
               (unless (string-match-p "\\`[a-zA-Z][-a-zA-Z0-9+.]*://" url)
                 (setq url (concat "http://" url)))
               ;; some site don't redirect final /
               (when (string= (url-filename (url-generic-parse-url url)) "")
                 (setq url (concat url "/"))))
           (setq url (concat eww-search-prefix
                             (replace-regexp-in-string " " "+" url))))))
178 179
  (url-retrieve url 'eww-render (list url)))

180 181
;;;###autoload (defalias 'browse-web 'eww)

182 183 184 185
;;;###autoload
(defun eww-open-file (file)
  "Render a file using EWW."
  (interactive "fFile: ")
186 187 188 189
  (eww (concat "file://"
	       (and (memq system-type '(windows-nt ms-dos))
		    "/")
	       (expand-file-name file))))
190

191
(defun eww-render (status url &optional point)
192 193 194
  (let ((redirect (plist-get status :redirect)))
    (when redirect
      (setq url redirect)))
195 196 197 198 199 200 201 202
  (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)))
203 204
			(eww-detect-charset (equal (car content-type)
						   "text/html"))
205 206 207 208
			"utf8"))))
	 (data-buffer (current-buffer)))
    (unwind-protect
	(progn
209
          (setq eww-current-title "")
210
	  (cond
211 212 213 214
           ((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))
215
	   ((equal (car content-type) "text/html")
216
	    (eww-display-html charset url nil point))
217
	   ((string-match-p "\\`image/" (car content-type))
218
	    (eww-display-image)
219
	    (eww-update-header-line-format))
220
	   (t
221 222
	    (eww-display-raw)
	    (eww-update-header-line-format)))
223
	  (setq eww-current-url url
224
		eww-history-position 0))
225 226 227 228
      (kill-buffer data-buffer))))

(defun eww-parse-headers ()
  (let ((headers nil))
229
    (goto-char (point-min))
230 231 232 233 234 235 236 237 238 239 240
    (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))

241 242 243 244 245
(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
246
	      "<meta[\t\n\r ]+[^>]*charset=\"?\\([^\t\n\r \"/>]+\\)[\\\"'.*]" nil t)
247 248 249 250 251 252
	     (goto-char pt)
	     (match-string 1))
	(and (looking-at
	      "[\t\n\r ]*<\\?xml[\t\n\r ]+[^>]*encoding=\"\\([^\"]+\\)")
	     (match-string 1)))))

253 254 255
(declare-function libxml-parse-html-region "xml.c"
		  (start end &optional base-url))

256
(defun eww-display-html (charset url &optional document point)
257 258
  (or (fboundp 'libxml-parse-html-region)
      (error "This function requires Emacs to be compiled with libxml2"))
259
  (unless (eq charset 'utf8)
260 261 262
    (condition-case nil
	(decode-coding-region (point) (point-max) charset)
      (coding-system-error nil)))
263
  (let ((document
264 265 266 267
	 (or document
	     (list
	      'base (list (cons 'href url))
	      (libxml-parse-html-region (point) (point-max))))))
268
    (setq eww-current-source (buffer-substring (point) (point-max)))
269
    (eww-setup-buffer)
270
    (setq eww-current-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 276
	   '((title . eww-tag-title)
	     (form . eww-tag-form)
277
	     (input . eww-tag-input)
278 279
	     (textarea . eww-tag-textarea)
	     (body . eww-tag-body)
280 281 282
	     (select . eww-tag-select)
	     (link . eww-tag-link)
	     (a . eww-tag-a))))
283 284 285 286 287
      (shr-insert-document document)
      (cond
       (point
	(goto-char point))
       (shr-target-id
288
	(goto-char (point-min))
289 290
	(let ((point (next-single-property-change
		      (point-min) 'shr-target-id)))
291 292
	  (when point
	    (goto-char point))))
293 294 295 296 297
       (t
	(goto-char (point-min)))))
    (setq eww-current-url url
	  eww-history-position 0)
    (eww-update-header-line-format)))
298

299 300 301
(defun eww-handle-link (cont)
  (let* ((rel (assq :rel cont))
  	(href (assq :href cont))
302 303 304
	(where (assoc
		;; The text associated with :rel is case-insensitive.
		(if rel (downcase (cdr rel)))
305
		      '(("next" . eww-next-url)
306 307
			;; Texinfo uses "previous", but HTML specifies
			;; "prev", so recognize both.
308
			("previous" . eww-previous-url)
309 310 311 312 313 314 315 316 317
			("prev" . eww-previous-url)
			;; 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" . eww-start-url)
			("home" . eww-home-url)
			("contents" . eww-contents-url)
318 319 320 321 322 323 324 325 326 327 328
			("up" . eww-up-url)))))
    (and href
	 where
	 (set (cdr where) (cdr href)))))

(defun eww-tag-link (cont)
  (eww-handle-link cont)
  (shr-generic cont))

(defun eww-tag-a (cont)
  (eww-handle-link cont)
329 330 331
  (let ((start (point)))
    (shr-tag-a cont)
    (put-text-property start (point) 'keymap eww-link-keymap)))
332

333 334
(defun eww-update-header-line-format ()
  (if eww-header-line-format
335 336 337
      (setq header-line-format
	    (replace-regexp-in-string
	     "%" "%%"
338 339
	     ;; FIXME?  Title can be blank.  Default to, eg, last component
	     ;; of url?
340 341 342
	     (format-spec eww-header-line-format
			  `((?u . ,eww-current-url)
			    (?t . ,eww-current-title)))))
343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366
    (setq header-line-format nil)))

(defun eww-tag-title (cont)
  (setq eww-current-title "")
  (dolist (sub cont)
    (when (eq (car sub) 'text)
      (setq eww-current-title (concat eww-current-title (cdr sub)))))
  (eww-update-header-line-format))

(defun eww-tag-body (cont)
  (let* ((start (point))
	 (fgcolor (cdr (or (assq :fgcolor cont)
                           (assq :text cont))))
	 (bgcolor (cdr (assq :bgcolor cont)))
	 (shr-stylesheet (list (cons 'color fgcolor)
			       (cons 'background-color bgcolor))))
    (shr-generic cont)
    (eww-colorize-region start (point) fgcolor bgcolor)))

(defun eww-colorize-region (start end fg &optional bg)
  (when (or fg bg)
    (let ((new-colors (shr-color-check fg bg)))
      (when new-colors
	(when fg
367
	  (add-face-text-property start end
368 369
				  (list :foreground (cadr new-colors))
				  t))
370
	(when bg
371
	  (add-face-text-property start end
372 373
				  (list :background (car new-colors))
				  t))))))
374

375
(defun eww-display-raw ()
376 377 378 379 380 381 382
  (let ((data (buffer-substring (point) (point-max))))
    (eww-setup-buffer)
    (let ((inhibit-read-only t))
      (insert data))
    (goto-char (point-min))))

(defun eww-display-image ()
383
  (let ((data (shr-parse-image-data)))
384 385 386 387 388 389
    (eww-setup-buffer)
    (let ((inhibit-read-only t))
      (shr-put-image data nil))
    (goto-char (point-min))))

(defun eww-setup-buffer ()
390
  (switch-to-buffer (get-buffer-create "*eww*"))
391
  (let ((inhibit-read-only t))
392
    (remove-overlays)
393
    (erase-buffer))
394
  (unless (eq major-mode 'eww-mode)
395 396 397 398 399 400 401
    (eww-mode))
  (setq-local eww-next-url nil)
  (setq-local eww-previous-url nil)
  (setq-local eww-up-url nil)
  (setq-local eww-home-url nil)
  (setq-local eww-start-url nil)
  (setq-local eww-contents-url nil))
402

403 404 405 406 407 408 409 410
(defun eww-view-source ()
  (interactive)
  (let ((buf (get-buffer-create "*eww-source*"))
        (source eww-current-source))
    (with-current-buffer buf
      (delete-region (point-min) (point-max))
      (insert (or eww-current-source "no source"))
      (goto-char (point-min))
411
      (when (fboundp 'html-mode)
412 413 414
        (html-mode)))
    (view-buffer buf)))

415 416 417
(defvar eww-mode-map
  (let ((map (make-sparse-keymap)))
    (suppress-keymap map)
418
    (define-key map "q" 'quit-window)
419
    (define-key map "g" 'eww-reload)
420 421
    (define-key map [?\t] 'shr-next-link)
    (define-key map [?\M-\t] 'shr-previous-link)
422
    (define-key map [delete] 'scroll-down-command)
423
    (define-key map [?\S-\ ] 'scroll-down-command)
424 425
    (define-key map "\177" 'scroll-down-command)
    (define-key map " " 'scroll-up-command)
426
    (define-key map "l" 'eww-back-url)
427
    (define-key map "r" 'eww-forward-url)
428
    (define-key map "n" 'eww-next-url)
429
    (define-key map "p" 'eww-previous-url)
430 431
    (define-key map "u" 'eww-up-url)
    (define-key map "t" 'eww-top-url)
432
    (define-key map "&" 'eww-browse-with-external-browser)
433
    (define-key map "d" 'eww-download)
434
    (define-key map "w" 'eww-copy-page-url)
435
    (define-key map "C" 'url-cookie-list)
436
    (define-key map "v" 'eww-view-source)
437
    (define-key map "H" 'eww-list-histories)
438

439 440 441 442 443
    (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)

444
    (easy-menu-define nil map ""
445
      '("Eww"
446 447
	["Exit" eww-quit t]
	["Close browser" quit-window t]
448 449 450 451 452 453 454
	["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]
455
	["View page source" eww-view-source]
456
	["Copy page URL" eww-copy-page-url t]
457
	["List histories" eww-list-histories t]
458
	["Add bookmark" eww-add-bookmark t]
Kenjiro NAKAYAMA's avatar
Kenjiro NAKAYAMA committed
459
	["List bookmarks" eww-list-bookmarks t]
460
	["List cookies" url-cookie-list t]))
461 462
    map))

463 464 465 466 467 468 469 470 471 472 473 474 475 476 477
(defvar eww-tool-bar-map
  (let ((map (make-sparse-keymap)))
    (dolist (tool-bar-item
             '((eww-quit . "close")
               (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'.")

478
(define-derived-mode eww-mode nil "eww"
479 480 481
  "Mode for browsing the web.

\\{eww-mode-map}"
482
  ;; FIXME?  This seems a strange default.
483 484 485
  (setq-local eww-current-url 'author)
  (setq-local eww-current-dom nil)
  (setq-local eww-current-source nil)
486
  (setq-local eww-current-title "")
487 488 489 490 491 492
  (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))
493
  (buffer-disable-undo)
494 495
  ;;(setq buffer-read-only t)
  )
496

497
;;;###autoload
Daniel Hackney's avatar
Daniel Hackney committed
498
(defun eww-browse-url (url &optional _new-window)
499 500
  (when (and (equal major-mode 'eww-mode)
	     eww-current-url)
501
    (eww-save-history))
502
  (eww url))
503

504
(defun eww-back-url ()
505 506
  "Go to the previously displayed page."
  (interactive)
507
  (when (>= eww-history-position (length eww-history))
508
    (user-error "No previous page"))
509 510 511
  (eww-save-history)
  (setq eww-history-position (+ eww-history-position 2))
  (eww-restore-history (elt eww-history (1- eww-history-position))))
512 513 514 515 516

(defun eww-forward-url ()
  "Go to the next displayed page."
  (interactive)
  (when (zerop eww-history-position)
517
    (user-error "No next page"))
518 519
  (eww-save-history)
  (eww-restore-history (elt eww-history (1- eww-history-position))))
520 521 522

(defun eww-restore-history (elem)
  (let ((inhibit-read-only t))
523
    (erase-buffer)
524
    (insert (plist-get elem :text))
525
    (setq eww-current-source (plist-get elem :source))
526
    (setq eww-current-dom (plist-get elem :dom))
527
    (goto-char (plist-get elem :point))
528
    (setq eww-current-url (plist-get elem :url)
529 530
	  eww-current-title (plist-get elem :title))
    (eww-update-header-line-format)))
531

532 533 534 535 536 537 538
(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)
  (if eww-next-url
      (eww-browse-url (shr-expand-url eww-next-url eww-current-url))
539
    (user-error "No `next' on this page")))
540 541 542 543 544 545 546 547

(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)
  (if eww-previous-url
      (eww-browse-url (shr-expand-url eww-previous-url eww-current-url))
548
    (user-error "No `previous' on this page")))
549 550 551 552 553 554 555 556

(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)
  (if eww-up-url
      (eww-browse-url (shr-expand-url eww-up-url eww-current-url))
557
    (user-error "No `up' on this page")))
558 559 560

(defun eww-top-url ()
  "Go to the page marked `top'.
561 562
A page is marked `top' if rel=\"start\", rel=\"home\", or rel=\"contents\"
appears in a <link> or <a> tag."
563
  (interactive)
564 565 566 567 568
  (let ((best-url (or eww-start-url
		      eww-contents-url
		      eww-home-url)))
    (if best-url
	(eww-browse-url (shr-expand-url best-url eww-current-url))
569
      (user-error "No `top' for this page"))))
570

571 572 573 574 575 576
(defun eww-reload ()
  "Reload the current page."
  (interactive)
  (url-retrieve eww-current-url 'eww-render
		(list eww-current-url (point))))

577 578 579 580
;; Form support.

(defvar eww-form nil)

581 582 583
(defvar eww-submit-map
  (let ((map (make-sparse-keymap)))
    (define-key map "\r" 'eww-submit)
584
    (define-key map [(control c) (control c)] 'eww-submit)
585 586 587 588
    map))

(defvar eww-checkbox-map
  (let ((map (make-sparse-keymap)))
Kenjiro NAKAYAMA's avatar
Kenjiro NAKAYAMA committed
589
    (define-key map " " 'eww-toggle-checkbox)
590
    (define-key map "\r" 'eww-toggle-checkbox)
591
    (define-key map [(control c) (control c)] 'eww-submit)
592 593 594 595 596 597 598
    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)
599
    (define-key map [(control c) (control c)] 'eww-submit)
600
    (define-key map [(control e)] 'eww-end-of-text)
601 602
    (define-key map [?\t] 'shr-next-link)
    (define-key map [?\M-\t] 'shr-previous-link)
603 604 605 606 607 608
    map))

(defvar eww-textarea-map
  (let ((map (make-keymap)))
    (set-keymap-parent map text-mode-map)
    (define-key map "\r" 'forward-line)
609
    (define-key map [(control c) (control c)] 'eww-submit)
610 611
    (define-key map [?\t] 'shr-next-link)
    (define-key map [?\M-\t] 'shr-previous-link)
612 613 614 615 616
    map))

(defvar eww-select-map
  (let ((map (make-sparse-keymap)))
    (define-key map "\r" 'eww-change-select)
617
    (define-key map [(control c) (control c)] 'eww-submit)
618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650
    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))))

651 652 653 654 655 656 657
(defun eww-tag-form (cont)
  (let ((eww-form
	 (list (assq :method cont)
	       (assq :action cont)))
	(start (point)))
    (shr-ensure-paragraph)
    (shr-generic cont)
658 659 660
    (unless (bolp)
      (insert "\n"))
    (insert "\n")
661 662 663
    (when (> (point) start)
      (put-text-property start (1+ start)
			 'eww-form eww-form))))
664

665 666 667 668 669 670 671 672 673 674 675 676 677 678 679 680 681 682 683 684
(defun eww-form-submit (cont)
  (let ((start (point))
	(value (cdr (assq :value cont))))
    (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"
			     :name (cdr (assq :name cont))))
    (put-text-property start (point) 'keymap eww-submit-map)
    (insert " ")))

(defun eww-form-checkbox (cont)
  (let ((start (point)))
    (if (cdr (assq :checked cont))
685 686
	(insert eww-form-checkbox-selected-symbol)
      (insert eww-form-checkbox-symbol))
687 688 689 690 691 692 693 694 695 696 697 698 699 700 701 702 703
    (add-face-text-property start (point) 'eww-form-checkbox)
    (put-text-property start (point) 'eww-form
		       (list :eww-form eww-form
			     :value (cdr (assq :value cont))
			     :type (downcase (cdr (assq :type cont)))
			     :checked (cdr (assq :checked cont))
			     :name (cdr (assq :name cont))))
    (put-text-property start (point) 'keymap eww-checkbox-map)
    (insert " ")))

(defun eww-form-text (cont)
  (let ((start (point))
	(type (downcase (or (cdr (assq :type cont))
			    "text")))
	(value (or (cdr (assq :value cont)) ""))
	(width (string-to-number
		(or (cdr (assq :size cont))
704 705 706 707 708
		    "40")))
        (readonly-property (if (or (cdr (assq :disabled cont))
                                   (cdr (assq :readonly cont)))
                               'read-only
                             'inhibit-read-only)))
709 710 711 712 713
    (insert value)
    (when (< (length value) width)
      (insert (make-string (- width (length value)) ? )))
    (put-text-property start (point) 'face 'eww-form-text)
    (put-text-property start (point) 'local-map eww-text-map)
714
    (put-text-property start (point) readonly-property t)
715
    (put-text-property start (point) 'eww-form
716 717 718 719
                       (list :eww-form eww-form
                             :value value
                             :type type
                             :name (cdr (assq :name cont))))
720 721
    (insert " ")))

722 723 724 725 726 727 728
(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://developer.mozilla.org/en-US/docs/Web/HTML/Element/Input'.")

729
(defun eww-process-text-input (beg end length)
730
  (let* ((form (get-text-property (min (1+ end) (point-max)) 'eww-form))
731 732 733
	 (properties (text-properties-at end))
	 (type (plist-get form :type)))
    (when (and form
734
	       (member type eww-text-input-types))
735 736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760 761 762 763 764 765 766 767 768 769
      (cond
       ((zerop length)
	;; Delete some space at the end.
	(save-excursion
	  (goto-char
	   (if (equal type "textarea")
	       (1- (line-end-position))
	     (eww-end-of-field)))
	  (let ((new (- end beg)))
	    (while (and (> new 0)
			(eql (following-char) ? ))
	      (delete-region (point) (1+ (point)))
	      (setq new (1- new))))
	  (set-text-properties beg end properties)))
       ((> length 0)
	;; Add padding.
	(save-excursion
	  (goto-char
	   (if (equal type "textarea")
	       (1- (line-end-position))
	     (eww-end-of-field)))
	  (let ((start (point)))
	    (insert (make-string length ? ))
	    (set-text-properties start (point) properties)))))
      (let ((value (buffer-substring-no-properties
		    (eww-beginning-of-field)
		    (eww-end-of-field))))
	(when (string-match " +\\'" value)
	  (setq value (substring value 0 (match-beginning 0))))
	(plist-put form :value value)
	(when (equal type "password")
	  ;; Display passwords as asterisks.
	  (let ((start (eww-beginning-of-field)))
	    (put-text-property start (+ start (length value))
			       'display (make-string (length value) ?*))))))))
770

771
(defun eww-tag-textarea (cont)
772 773 774 775 776 777 778 779 780 781 782 783 784 785 786 787 788 789 790 791 792 793 794
  (let ((start (point))
	(value (or (cdr (assq :value cont)) ""))
	(lines (string-to-number
		(or (cdr (assq :rows cont))
		    "10")))
	(width (string-to-number
		(or (cdr (assq :cols cont))
		    "10")))
	end)
    (shr-ensure-newline)
    (insert value)
    (shr-ensure-newline)
    (when (< (count-lines start (point)) lines)
      (dotimes (i (- lines (count-lines start (point))))
	(insert "\n")))
    (setq end (point-marker))
    (goto-char start)
    (while (< (point) end)
      (end-of-line)
      (let ((pad (- width (- (point) (line-beginning-position)))))
	(when (> pad 0)
	  (insert (make-string pad ? ))))
      (add-face-text-property (line-beginning-position)
Kenjiro NAKAYAMA's avatar
Kenjiro NAKAYAMA committed
795
			      (point) 'eww-form-textarea)
796 797 798 799 800 801 802 803 804 805 806 807 808 809 810 811 812 813 814 815 816 817 818 819 820 821 822 823 824 825 826 827 828 829 830 831 832 833
      (put-text-property (line-beginning-position) (point)
			 'local-map eww-textarea-map)
      (forward-line 1))
    (put-text-property start (point) 'eww-form
		       (list :eww-form eww-form
			     :value value
			     :type "textarea"
			     :name (cdr (assq :name cont))))))

(defun eww-tag-input (cont)
  (let ((type (downcase (or (cdr (assq :type cont))
			     "text")))
	(start (point)))
    (cond
     ((or (equal type "checkbox")
	  (equal type "radio"))
      (eww-form-checkbox cont))
     ((equal type "submit")
      (eww-form-submit cont))
     ((equal type "hidden")
      (let ((form eww-form)
	    (name (cdr (assq :name cont))))
	;; Don't add <input type=hidden> elements repeatedly.
	(while (and form
		    (or (not (consp (car form)))
			(not (eq (caar form) 'hidden))
			(not (equal (plist-get (cdr (car form)) :name)
				    name))))
	  (setq form (cdr form)))
	(unless form
	  (nconc eww-form (list
			   (list 'hidden
				 :name name
				 :value (cdr (assq :value cont))))))))
     (t
      (eww-form-text cont)))
    (unless (= start (point))
      (put-text-property start (1+ start) 'help-echo "Input field"))))
834

835 836
(defun eww-tag-select (cont)
  (shr-ensure-paragraph)
837
  (let ((menu (list :name (cdr (assq :name cont))
838 839
		    :eww-form eww-form))
	(options nil)
840
	(start (point))
841 842 843 844 845 846 847 848
	(max 0)
	opelem)
    (if (eq (car (car cont)) 'optgroup)
	(dolist (groupelem cont)
	  (unless (cdr (assq :disabled (cdr groupelem)))
	    (setq opelem (append opelem (cdr (cdr groupelem))))))
      (setq opelem cont))
    (dolist (elem opelem)
849 850 851 852
      (when (eq (car elem) 'option)
	(when (cdr (assq :selected (cdr elem)))
	  (nconc menu (list :value
			    (cdr (assq :value (cdr elem))))))
853 854 855 856 857 858
	(let ((display (or (cdr (assq 'text (cdr elem))) "")))
	  (setq max (max max (length display)))
	  (push (list 'item
		      :value (cdr (assq :value (cdr elem)))
		      :display display)
		options))))
859
    (when options
860
      (setq options (nreverse options))
861
      ;; If we have no selected values, default to the first value.
862
      (unless (plist-get menu :value)
863 864
	(nconc menu (list :value (nth 2 (car options)))))
      (nconc menu options)
865 866 867 868 869 870
      (let ((selected (eww-select-display menu)))
	(insert selected
		(make-string (- max (length selected)) ? )))
      (put-text-property start (point) 'eww-form menu)
      (add-face-text-property start (point) 'eww-form-select)
      (put-text-property start (point) 'keymap eww-select-map)
871 872
      (unless (= start (point))
       (put-text-property start (1+ start) 'help-echo "select field"))
873
      (shr-ensure-paragraph))))
874

875 876 877 878 879 880 881 882 883 884 885 886 887 888 889 890 891 892 893 894 895 896 897 898 899 900 901 902 903 904 905 906 907 908 909 910 911 912 913 914 915 916 917 918 919 920 921 922 923 924 925
(defun eww-select-display (select)
  (let ((value (plist-get select :value))
	display)
    (dolist (elem select)
      (when (and (consp elem)
		 (eq (car elem) 'item)
		 (equal value (plist-get (cdr elem) :value)))
	(setq display (plist-get (cdr elem) :display))))
    display))

(defun eww-change-select ()
  "Change the value of the select drop-down menu under point."
  (interactive)
  (let* ((input (get-text-property (point) 'eww-form))
	 (completion-ignore-case t)
	 (options
	  (delq nil
		(mapcar (lambda (elem)
			  (and (consp elem)
			       (eq (car elem) 'item)
			       (cons (plist-get (cdr elem) :display)
				     (plist-get (cdr elem) :value))))
			input)))
	 (display
	  (completing-read "Change value: " options nil 'require-match))
	 (inhibit-read-only t))
    (plist-put input :value (cdr (assoc-string display options t)))
    (goto-char
     (eww-update-field display))))

(defun eww-update-field (string)
  (let ((properties (text-properties-at (point)))
	(start (eww-beginning-of-field))
	(end (1+ (eww-end-of-field))))
    (delete-region start end)
    (insert string
	    (make-string (- (- end start) (length string)) ? ))
    (set-text-properties start end properties)
    start))

(defun eww-toggle-checkbox ()
  "Toggle the value of the checkbox under point."
  (interactive)
  (let* ((input (get-text-property (point) 'eww-form))
	 (type (plist-get input :type)))
    (if (equal type "checkbox")
	(goto-char
	 (1+
	  (if (plist-get input :checked)
	      (progn
		(plist-put input :checked nil)
926
		(eww-update-field eww-form-checkbox-symbol))
927
	    (plist-put input :checked t)
928
	    (eww-update-field eww-form-checkbox-selected-symbol))))
929 930 931 932 933 934 935 936 937
      ;; Radio button.  Switch all other buttons off.
      (let ((name (plist-get input :name)))
	(save-excursion
	  (dolist (elem (eww-inputs (plist-get input :eww-form)))
	    (when (equal (plist-get (cdr elem) :name) name)
	      (goto-char (car elem))
	      (if (not (eq (cdr elem) input))
		  (progn
		    (plist-put input :checked nil)
938
		    (eww-update-field eww-form-checkbox-symbol))
939
		(plist-put input :checked t)
940
		(eww-update-field eww-form-checkbox-selected-symbol)))))
941 942 943 944 945 946 947 948 949 950 951 952 953 954 955 956 957 958 959 960 961 962 963 964 965 966 967 968 969 970 971 972 973 974 975 976 977 978 979 980 981 982 983 984 985 986 987 988 989 990 991 992 993 994 995 996 997 998 999 1000 1001 1002 1003 1004
	(forward-char 1)))))

(defun eww-inputs (form)
  (let ((start (point-min))
	(inputs nil))
    (while (and start
		(< start (point-max)))
      (when (or (get-text-property start 'eww-form)
		(setq start (next-single-property-change start 'eww-form)))
	(when (eq (plist-get (get-text-property start 'eww-form) :eww-form)
		  form)
	  (push (cons start (get-text-property start 'eww-form))
		inputs))
	(setq start (next-single-property-change start 'eww-form))))
    (nreverse inputs)))

(defun eww-input-value (input)
  (let ((type (plist-get input :type))
	(value (plist-get input :value)))
    (cond
     ((equal type "textarea")
      (with-temp-buffer
	(insert value)
	(goto-char (point-min))
	(while (re-search-forward "^ +\n\\| +$" nil t)
	  (replace-match "" t t))
	(buffer-string)))
     (t
      (if (string-match " +\\'" value)
	  (substring value 0 (match-beginning 0))
	value)))))

(defun eww-submit ()
  "Submit the current form."
  (interactive)
  (let* ((this-input (get-text-property (point) 'eww-form))
	 (form (plist-get this-input :eww-form))
	 values next-submit)
    (dolist (elem (sort (eww-inputs form)
			 (lambda (o1 o2)
			   (< (car o1) (car o2)))))
      (let* ((input (cdr elem))
	     (input-start (car elem))
	     (name (plist-get input :name)))
	(when name
	  (cond
	   ((member (plist-get input :type) '("checkbox" "radio"))
	    (when (plist-get input :checked)
	      (push (cons name (plist-get input :value))
		    values)))
	   ((equal (plist-get input :type) "submit")
	    ;; We want the values from buttons if we hit a button if
	    ;; we hit enter on it, or if it's the first button after
	    ;; the field we did hit return on.
	    (when (or (eq input this-input)
		      (and (not (eq input this-input))
			   (null next-submit)
			   (> input-start (point))))
	      (setq next-submit t)
	      (push (cons name (plist-get input :value))
		    values)))
	   (t
	    (push (cons name (eww-input-value input))
		  values))))))
1005 1006 1007 1008 1009 1010
    (dolist (elem form)
      (when (and (consp elem)
		 (eq (car elem) 'hidden))
	(push (cons (plist-get (cdr elem) :name)
		    (plist-get (cdr elem) :value))
	      values)))
1011 1012 1013 1014 1015 1016 1017 1018 1019 1020 1021 1022 1023 1024 1025 1026
    (if (and (stringp (cdr (assq :method form)))
	     (equal (downcase (cdr (assq :method form))) "post"))
	(let ((url-request-method "POST")
	      (url-request-extra-headers
	       '(("Content-Type" . "application/x-www-form-urlencoded")))
	      (url-request-data (mm-url-encode-www-form-urlencoded values)))
	  (eww-browse-url (shr-expand-url (cdr (assq :action form))
					  eww-current-url)))
      (eww-browse-url
       (concat
	(if (cdr (assq :action form))
	    (shr-expand-url (cdr (assq :action form))
			    eww-current-url)
	  eww-current-url)
	"?"
	(mm-url-encode-www-form-urlencoded values))))))
1027

1028
(defun eww-browse-with-external-browser (&optional url)
1029
  "Browse the current URL with an external browser.
1030
The browser to used is specified by the `shr-external-browser' variable."
1031
  (interactive)
1032
  (funcall shr-external-browser (or url eww-current-url)))
1033

1034 1035 1036 1037 1038 1039 1040 1041 1042 1043 1044 1045 1046 1047 1048 1049 1050 1051 1052 1053 1054 1055
(defun eww-follow-link (&optional external mouse-event)
  "Browse the URL under point.
If EXTERNAL, browse the URL using `shr-external-browser'."
  (interactive (list current-prefix-arg last-nonmenu-event))
  (mouse-set-point mouse-event)
  (let ((url (get-text-property (point) 'shr-url)))
    (cond
     ((not url)
      (message "No link under point"))
     ((string-match "^mailto:" url)
      (browse-url-mail url))
     (external
      (funcall shr-external-browser url))
     ;; This is a #target url in the same page as the current one.
     ((and (url-target (url-generic-parse-url url))
	   (eww-same-page-p url eww-current-url))
      (eww-save-history)
      (eww-display-html 'utf8 url eww-current-dom))
     (t
      (eww-browse-url url)))))

(defun eww-same-page-p (url1 url2)
Paul Eggert's avatar
Paul Eggert committed
1056
  "Return non-nil if both URLs represent the same page.
1057 1058 1059 1060 1061 1062 1063
Differences in #targets are ignored."
  (let ((obj1 (url-generic-parse-url url1))
	(obj2 (url-generic-parse-url url2)))
    (setf (url-target obj1) nil)
    (setf (url-target obj2) nil)
    (equal (url-recreate-url obj1) (url-recreate-url obj2))))

1064
(defun eww-copy-page-url ()
Ivan Kanis's avatar
Ivan Kanis committed
1065
  (interactive)
1066
  (message "%s" eww-current-url)
Ivan Kanis's avatar
Ivan Kanis committed
1067
  (kill-new eww-current-url))
1068

1069 1070 1071 1072 1073 1074 1075 1076 1077 1078 1079 1080 1081
(defun eww-download ()
  "Download URL under point to `eww-download-directory'."
  (interactive)
  (let ((url (get-text-property (point) 'shr-url)))
    (if (not url)
        (message "No URL under point")
      (url-retrieve url 'eww-download-callback (list url)))))

(defun eww-download-callback (status url)
  (unless (plist-get status :error)
    (let* ((obj (url-generic-parse-url url))
           (path (car (url-path-and-query obj)))
           (file (eww-make-unique-file-name (file-name-nondirectory path)
1082
					    eww-download-directory)))
1083 1084 1085 1086 1087 1088 1089 1090 1091
      (write-file file)
      (message "Saved %s" file))))

(defun eww-make-unique-file-name (file directory)
    (cond
     ((zerop (length file))
      (setq file "!"))
     ((string-match "\\`[.]" file)
      (setq file (concat "!" file))))
1092
    (let ((count 1))
1093 1094 1095 1096 1097 1098 1099 1100 1101
      (while (file-exists-p (expand-file-name file directory))
	(setq file
	      (if (string-match "\\`\\(.*\\)\\([.][^.]+\\)" file)
		  (format "%s(%d)%s" (match-string 1 file)
			  count (match-string 2 file))
		(format "%s(%d)" file count)))
	(setq count (1+ count)))
      (expand-file-name file directory)))

1102 1103 1104 1105 1106 1107 1108 1109 1110 1111 1112
;;; Bookmarks code

(defvar eww-bookmarks nil)

(defun eww-add-bookmark ()
  "Add the current page to the bookmarks."
  (interactive)
  (eww-read-bookmarks)
  (dolist (bookmark eww-bookmarks)
    (when (equal eww-current-url
		 (plist-get bookmark :url))
1113
      (user-error "Already bookmarked")))
Ted Zlatanov's avatar
Ted Zlatanov committed
1114 1115 1116 1117 1118 1119 1120 1121 1122 1123
  (if (y-or-n-p "bookmark this page? ")
      (progn
	(let ((title (replace-regexp-in-string "[\n\t\r]" " " eww-current-title)))
	  (setq title (replace-regexp-in-string "\\` +\\| +\\'" "" title))
	  (push (list :url eww-current-url
		      :title title
		      :time (current-time-string))
		eww-bookmarks))
	(eww-write-bookmarks)
	(message "Bookmarked %s (%s)" eww-current-url eww-current-title))))
1124 1125

(defun eww-write-bookmarks ()
1126
  (with-temp-file (expand-file-name "eww-bookmarks" eww-bookmarks-directory)
1127 1128 1129 1130
    (insert ";; Auto-generated file; don't edit\n")
    (pp eww-bookmarks (current-buffer))))

(defun eww-read-bookmarks ()
1131
  (let ((file (expand-file-name "eww-bookmarks" eww-bookmarks-directory)))
1132 1133 1134 1135 1136
    (setq eww-bookmarks
	  (unless (zerop (or (nth 7 (file-attributes file)) 0))
	    (with-temp-buffer
	      (insert-file-contents file)
	      (read (current-buffer)))))))
1137 1138 1139 1140 1141 1142 1143 1144 1145

(defun eww-list-bookmarks ()
  "Display the bookmarks."
  (interactive)
  (eww-bookmark-prepare)
  (pop-to-buffer "*eww bookmarks*"))

(defun eww-bookmark-prepare ()
  (eww-read-bookmarks)
1146 1147
  (unless eww-bookmarks
    (user-error "No bookmarks are defined"))
1148 1149 1150 1151 1152 1153 1154 1155 1156 1157 1158 1159 1160 1161 1162 1163 1164 1165 1166 1167 1168 1169 1170 1171 1172 1173 1174
  (set-buffer (get-buffer-create "*eww bookmarks*"))
  (eww-bookmark-mode)
  (let ((format "%-40s %s")
	(inhibit-read-only t)
	start url)
    (erase-buffer)
    (setq header-line-format (concat " " (format format "URL" "Title")))
    (dolist (bookmark eww-bookmarks)
      (setq start (point))
      (setq url (plist-get bookmark :url))
      (when (> (length url) 40)
	(setq url (substring url 0 40)))
      (insert (format format url
		      (plist-get bookmark :title))
	      "\n")
      (put-text-property start (1+ start) 'eww-bookmark bookmark))
    (goto-char (point-min))))

(defvar eww-bookmark-kill-ring nil)

(defun eww-bookmark-kill ()
  "Kill the current bookmark."
  (interactive)
  (let* ((start (line-beginning-position))
	 (bookmark (get-text-property start 'eww-bookmark))
	 (inhibit-read-only t))
    (unless bookmark
1175
      (user-error "No bookmark on the current line"))
1176 1177 1178 1179 1180 1181 1182 1183 1184 1185
    (forward-line 1)
    (push (buffer-substring start (point)) eww-bookmark-kill-ring)
    (delete-region start (point))
    (setq eww-bookmarks (delq bookmark eww-bookmarks))
    (eww-write-bookmarks)))

(defun eww-bookmark-yank ()
  "Yank a previously killed bookmark to the current line."
  (interactive)
  (unless eww-bookmark-kill-ring
1186
    (user-error "No previously killed bookmark"))
1187 1188 1189 1190 1191 1192 1193 1194 1195 1196 1197 1198 1199 1200 1201 1202 1203 1204
  (beginning-of-line)
  (let ((inhibit-read-only t)
	(start (point))
	bookmark)
    (insert (pop eww-bookmark-kill-ring))
    (setq bookmark (get-text-property start 'eww-bookmark))
    (if (= start (point-min))
	(push bookmark eww-bookmarks)
      (let ((line (count-lines start (point))))
	(setcdr (nthcdr (1- line) eww-bookmarks)
		(cons bookmark (nthcdr line eww-bookmarks)))))
    (eww-write-bookmarks)))

(defun eww-bookmark-browse ()
  "Browse the bookmark under point in eww."
  (interactive)
  (let ((bookmark (get-text-property (line-beginning-position) 'eww-bookmark)))
    (unless bookmark
1205
      (user-error "No bookmark on the current line"))
1206
    (quit-window)
Ted Zlatanov's avatar
Ted Zlatanov committed
1207
    (eww-browse-url (plist-get bookmark :url))))
1208 1209 1210 1211 1212 1213 1214 1215 1216 1217 1218 1219 1220 1221 1222 1223

(defun eww-next-bookmark ()
  "Go to the next bookmark in the list."
  (interactive)
  (let ((first nil)
	bookmark)
    (unless (get-buffer "*eww bookmarks*")
      (setq first t)
      (eww-bookmark-prepare))
    (with-current-buffer (get-buffer "*eww bookmarks*")
      (when (and (not first)
		 (not (eobp)))
	(forward-line 1))
      (setq bookmark (get-text-property (line-beginning-position)
					'eww-bookmark))
      (unless bookmark
1224
	(user-error "No next bookmark")))
1225 1226 1227 1228 1229 1230 1231 1232 1233 1234 1235 1236 1237 1238 1239 1240 1241 1242
    (eww-browse-url (plist-get bookmark :url))))

(defun eww-previous-bookmark ()
  "Go to the previous bookmark in the list."
  (interactive)
  (let ((first nil)
	bookmark)
    (unless (get-buffer "*eww bookmarks*")
      (setq first t)
      (eww-bookmark-prepare))
    (with-current-buffer (get-buffer "*eww bookmarks*")