eww.el 27.5 KB
Newer Older
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27
;;; eww.el --- Emacs Web Wowser

;; Copyright (C) 2013 Free Software Foundation, Inc.

;; 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 36 37 38 39 40 41 42
(defgroup eww nil
  "Emacs Web Wowser"
  :version "24.4"
  :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."
43 44 45 46 47 48 49
  :version "24.4"
  :group 'eww
  :type 'string)

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

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

59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75
(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
76 77 78 79 80 81 82
  '((((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)

83 84 85 86 87 88 89 90
(defface eww-form-text
  '((t (:background "#505050"
		    :foreground "white"
		    :box (:line-width 1))))
  "Face for eww text inputs."
  :version "24.4"
  :group 'eww)

91
(defvar eww-current-url nil)
92 93
(defvar eww-current-title ""
  "Title of current page.")
94
(defvar eww-history nil)
95
(defvar eww-history-position 0)
96

97 98 99
(defvar eww-next-url nil)
(defvar eww-previous-url nil)
(defvar eww-up-url nil)
100 101 102
(defvar eww-home-url nil)
(defvar eww-start-url nil)
(defvar eww-contents-url nil)
103

104
;;;###autoload
105
(defun eww (url)
106 107 108 109 110 111
  "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: ")
  (if (and (= (length (split-string url)) 1)
           (> (length (split-string url "\\.")) 1))
112 113 114 115 116 117
      (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 "/"))))
118
    (unless (string-match-p "\\'file:" url)
Ivan Kanis's avatar
Ivan Kanis committed
119 120
      (setq url (concat eww-search-prefix
                        (replace-regexp-in-string " " "+" url)))))
121 122
  (url-retrieve url 'eww-render (list url)))

123 124 125 126 127 128
;;;###autoload
(defun eww-open-file (file)
  "Render a file using EWW."
  (interactive "fFile: ")
  (eww (concat "file://" (expand-file-name file))))

129
(defun eww-render (status url &optional point)
130 131 132
  (let ((redirect (plist-get status :redirect)))
    (when redirect
      (setq url redirect)))
133 134 135
  (set (make-local-variable 'eww-next-url) nil)
  (set (make-local-variable 'eww-previous-url) nil)
  (set (make-local-variable 'eww-up-url) nil)
136 137 138
  (set (make-local-variable 'eww-home-url) nil)
  (set (make-local-variable 'eww-start-url) nil)
  (set (make-local-variable 'eww-contents-url) nil)
139
  (let* ((headers (eww-parse-headers))
140 141 142
	 (shr-target-id
	  (and (string-match "#\\(.*\\)" url)
	       (match-string 1 url)))
143 144 145 146 147 148 149
	 (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)))
150 151
			(eww-detect-charset (equal (car content-type)
						   "text/html"))
152 153 154 155 156 157 158 159 160 161 162
			"utf8"))))
	 (data-buffer (current-buffer)))
    (unwind-protect
	(progn
	  (cond
	   ((equal (car content-type) "text/html")
	    (eww-display-html charset url))
	   ((string-match "^image/" (car content-type))
	    (eww-display-image))
	   (t
	    (eww-display-raw charset)))
163 164 165 166 167 168 169 170
	  (cond
	   (point
	    (goto-char point))
	   (shr-target-id
	    (let ((point (next-single-property-change
			  (point-min) 'shr-target-id)))
	      (when point
		(goto-char (1+ point)))))))
171 172 173 174
      (kill-buffer data-buffer))))

(defun eww-parse-headers ()
  (let ((headers nil))
175
    (goto-char (point-min))
176 177 178 179 180 181 182 183 184 185 186
    (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))

187 188 189 190 191
(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
192
	      "<meta[\t\n\r ]+[^>]*charset=\"?\\([^\t\n\r \"/>]+\\)[\\\"'.*]" nil t)
193 194 195 196 197 198
	     (goto-char pt)
	     (match-string 1))
	(and (looking-at
	      "[\t\n\r ]*<\\?xml[\t\n\r ]+[^>]*encoding=\"\\([^\"]+\\)")
	     (match-string 1)))))

199 200 201 202 203 204 205 206 207
(defun eww-display-html (charset url)
  (unless (eq charset 'utf8)
    (decode-coding-region (point) (point-max) charset))
  (let ((document
	 (list
	  'base (list (cons 'href url))
	  (libxml-parse-html-region (point) (point-max)))))
    (eww-setup-buffer)
    (setq eww-current-url url)
208
    (eww-update-header-line-format)
209
    (let ((inhibit-read-only t)
210
	  (after-change-functions nil)
211
	  (shr-width nil)
212
	  (shr-external-rendering-functions
213 214
	   '((title . eww-tag-title)
	     (form . eww-tag-form)
215
	     (input . eww-tag-input)
216 217
	     (textarea . eww-tag-textarea)
	     (body . eww-tag-body)
218 219 220
	     (select . eww-tag-select)
	     (link . eww-tag-link)
	     (a . eww-tag-a))))
221
      (shr-insert-document document))
222 223
    (goto-char (point-min))))

224 225 226
(defun eww-handle-link (cont)
  (let* ((rel (assq :rel cont))
  	(href (assq :href cont))
227 228 229
	(where (assoc
		;; The text associated with :rel is case-insensitive.
		(if rel (downcase (cdr rel)))
230
		      '(("next" . eww-next-url)
231 232
			;; Texinfo uses "previous", but HTML specifies
			;; "prev", so recognize both.
233
			("previous" . eww-previous-url)
234 235 236 237 238 239 240 241 242
			("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)
243 244 245 246 247 248 249 250 251 252 253 254 255
			("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)
  (shr-tag-a cont))

256 257
(defun eww-update-header-line-format ()
  (if eww-header-line-format
258 259 260 261 262 263
      (setq header-line-format
	    (replace-regexp-in-string
	     "%" "%%"
	     (format-spec eww-header-line-format
			  `((?u . ,eww-current-url)
			    (?t . ,eww-current-title)))))
264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287
    (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
288
	  (add-face-text-property start end
289 290
				  (list :foreground (cadr new-colors))
				  t))
291
	(when bg
292
	  (add-face-text-property start end
293 294
				  (list :background (car new-colors))
				  t))))))
295

296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311
(defun eww-display-raw (charset)
  (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 ()
  (let ((data (buffer-substring (point) (point-max))))
    (eww-setup-buffer)
    (let ((inhibit-read-only t))
      (shr-put-image data nil))
    (goto-char (point-min))))

(defun eww-setup-buffer ()
  (pop-to-buffer (get-buffer-create "*eww*"))
312
  (remove-overlays)
313 314 315 316 317 318 319 320
  (let ((inhibit-read-only t))
    (erase-buffer))
  (eww-mode))

(defvar eww-mode-map
  (let ((map (make-sparse-keymap)))
    (suppress-keymap map)
    (define-key map "q" 'eww-quit)
321
    (define-key map "g" 'eww-reload)
322 323
    (define-key map [tab] 'shr-next-link)
    (define-key map [backtab] 'shr-previous-link)
324 325 326
    (define-key map [delete] 'scroll-down-command)
    (define-key map "\177" 'scroll-down-command)
    (define-key map " " 'scroll-up-command)
327
    (define-key map "l" 'eww-back-url)
328
    (define-key map "f" 'eww-forward-url)
329
    (define-key map "n" 'eww-next-url)
330
    (define-key map "p" 'eww-previous-url)
331 332
    (define-key map "u" 'eww-up-url)
    (define-key map "t" 'eww-top-url)
333
    (define-key map "&" 'eww-browse-with-external-browser)
334
    (define-key map "d" 'eww-download)
335
    (define-key map "w" 'eww-copy-page-url)
336 337
    map))

338
(define-derived-mode eww-mode nil "eww"
339 340 341 342
  "Mode for browsing the web.

\\{eww-mode-map}"
  (set (make-local-variable 'eww-current-url) 'author)
343 344 345 346
  (set (make-local-variable 'browse-url-browser-function) 'eww-browse-url)
  (set (make-local-variable 'after-change-functions) 'eww-process-text-input)
  ;;(setq buffer-read-only t)
  )
347

348 349 350 351 352 353 354 355 356 357
(defun eww-save-history ()
  (let ((elem (list :url eww-current-url
		    :point (point)
		    :text (buffer-string))))
    (if (or (zerop eww-history-position)
	    (= eww-history-position (length eww-history)))
	(push elem eww-history)
      (setcdr (nthcdr eww-history-position eww-history)
	      (cons elem (nthcdr eww-history-position eww-history))))))

358
(defun eww-browse-url (url &optional new-window)
359 360
  (when (and (equal major-mode 'eww-mode)
	     eww-current-url)
361
    (eww-save-history))
362
  (eww url))
363 364 365 366 367 368 369

(defun eww-quit ()
  "Exit the Emacs Web Wowser."
  (interactive)
  (setq eww-history nil)
  (kill-buffer (current-buffer)))

370
(defun eww-back-url ()
371 372
  "Go to the previously displayed page."
  (interactive)
373
  (when (>= eww-history-position (length eww-history))
374
    (error "No previous page"))
375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391
  (eww-restore-history
   (if (not (zerop eww-history-position))
       (elt eww-history eww-history-position)
     (eww-save-history)
     (elt eww-history (1+ eww-history-position))))
  (setq eww-history-position (1+ eww-history-position)))

(defun eww-forward-url ()
  "Go to the next displayed page."
  (interactive)
  (when (zerop eww-history-position)
    (error "No next page"))
  (eww-restore-history (elt eww-history (1- eww-history-position)))
  (setq eww-history-position (1- eww-history-position)))

(defun eww-restore-history (elem)
  (let ((inhibit-read-only t))
392
    (erase-buffer)
393 394 395
    (insert (plist-get elem :text))
    (goto-char (plist-get elem :point))
    (setq eww-current-url (plist-get elem :url))))
396

397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425
(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))
    (error "No `next' on this page")))

(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))
    (error "No `previous' on this page")))

(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))
    (error "No `up' on this page")))

(defun eww-top-url ()
  "Go to the page marked `top'.
426 427
A page is marked `top' if rel=\"start\", rel=\"home\", or rel=\"contents\"
appears in a <link> or <a> tag."
428
  (interactive)
429 430 431 432 433 434
  (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))
      (error "No `top' for this page"))))
435

436 437 438 439 440 441
(defun eww-reload ()
  "Reload the current page."
  (interactive)
  (url-retrieve eww-current-url 'eww-render
		(list eww-current-url (point))))

442 443 444 445
;; Form support.

(defvar eww-form nil)

446 447 448
(defvar eww-submit-map
  (let ((map (make-sparse-keymap)))
    (define-key map "\r" 'eww-submit)
449
    (define-key map [(control c) (control c)] 'eww-submit)
450 451 452 453 454 455
    map))

(defvar eww-checkbox-map
  (let ((map (make-sparse-keymap)))
    (define-key map [space] 'eww-toggle-checkbox)
    (define-key map "\r" 'eww-toggle-checkbox)
456
    (define-key map [(control c) (control c)] 'eww-submit)
457 458 459 460 461 462 463
    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)
464
    (define-key map [(control c) (control c)] 'eww-submit)
465 466 467 468 469 470 471 472 473
    (define-key map [(control e)] 'eww-end-of-text)
    (define-key map [tab] 'shr-next-link)
    (define-key map [backtab] 'shr-previous-link)
    map))

(defvar eww-textarea-map
  (let ((map (make-keymap)))
    (set-keymap-parent map text-mode-map)
    (define-key map "\r" 'forward-line)
474
    (define-key map [(control c) (control c)] 'eww-submit)
475 476 477 478 479 480 481
    (define-key map [tab] 'shr-next-link)
    (define-key map [backtab] 'shr-previous-link)
    map))

(defvar eww-select-map
  (let ((map (make-sparse-keymap)))
    (define-key map "\r" 'eww-change-select)
482
    (define-key map [(control c) (control c)] 'eww-submit)
483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515
    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))))

516 517 518 519 520 521 522
(defun eww-tag-form (cont)
  (let ((eww-form
	 (list (assq :method cont)
	       (assq :action cont)))
	(start (point)))
    (shr-ensure-paragraph)
    (shr-generic cont)
523 524 525
    (unless (bolp)
      (insert "\n"))
    (insert "\n")
526 527 528
    (when (> (point) start)
      (put-text-property start (1+ start)
			 'eww-form eww-form))))
529

530 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623
(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))
	(insert "[X]")
      (insert "[ ]"))
    (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))
		    "40"))))
    (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)
    (put-text-property start (point) 'inhibit-read-only t)
    (put-text-property start (point) 'eww-form
		       (list :eww-form eww-form
			     :value value
			     :type type
			     :name (cdr (assq :name cont))))
    (insert " ")))

(defun eww-process-text-input (beg end length)
  (let* ((form (get-text-property end 'eww-form))
	 (properties (text-properties-at end))
	 (type (plist-get form :type)))
    (when (and form
	       (member type '("text" "password" "textarea")))
      (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) ?*))))))))
624

625
(defun eww-tag-textarea (cont)
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 651 652 653 654 655 656 657 658 659 660 661 662 663 664 665 666 667 668 669 670 671 672 673 674 675 676 677 678 679 680 681 682 683 684 685 686 687
  (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)
			      (point) 'eww-form-text)
      (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"))))
688

689 690
(defun eww-tag-select (cont)
  (shr-ensure-paragraph)
691
  (let ((menu (list :name (cdr (assq :name cont))
692 693
		    :eww-form eww-form))
	(options nil)
694 695
	(start (point))
	(max 0))
696 697 698 699 700
    (dolist (elem cont)
      (when (eq (car elem) 'option)
	(when (cdr (assq :selected (cdr elem)))
	  (nconc menu (list :value
			    (cdr (assq :value (cdr elem))))))
701 702 703 704 705 706
	(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))))
707
    (when options
708
      (setq options (nreverse options))
709
      ;; If we have no selected values, default to the first value.
710
      (unless (plist-get menu :value)
711 712
	(nconc menu (list :value (nth 2 (car options)))))
      (nconc menu options)
713 714 715 716 717 718
      (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)
719
      (shr-ensure-paragraph))))
720

721 722 723 724 725 726 727 728 729 730 731 732 733 734 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 770 771 772 773 774 775 776 777 778 779 780 781 782 783 784 785 786 787 788 789 790 791 792 793 794 795 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 834 835 836 837 838 839 840 841 842 843 844 845 846 847 848 849 850 851
(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))
	 (properties (text-properties-at (point)))
	 (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)
		(eww-update-field "[ ]"))
	    (plist-put input :checked t)
	    (eww-update-field "[X]"))))
      ;; 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)
		    (eww-update-field "[ ]"))
		(plist-put input :checked t)
		(eww-update-field "[X]")))))
	(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))))))
852 853 854 855 856 857
    (dolist (elem form)
      (when (and (consp elem)
		 (eq (car elem) 'hidden))
	(push (cons (plist-get (cdr elem) :name)
		    (plist-get (cdr elem) :value))
	      values)))
858 859 860 861 862 863 864 865 866 867 868 869 870 871 872 873
    (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))))))
874

875 876
(defun eww-browse-with-external-browser ()
  "Browse the current URL with an external browser.
877
The browser to used is specified by the `shr-external-browser' variable."
878
  (interactive)
879
  (funcall shr-external-browser eww-current-url))
880

881
(defun eww-copy-page-url ()
Ivan Kanis's avatar
Ivan Kanis committed
882
  (interactive)
883
  (message "%s" eww-current-url)
Ivan Kanis's avatar
Ivan Kanis committed
884
  (kill-new eww-current-url))
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
(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)
					    eww-download-path)))
      (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))))
    (let ((base file)
	  (count 1))
      (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)))

920 921 922
(provide 'eww)

;;; eww.el ends here