1 ;;; eww.el --- Emacs Web Wowser
3 ;; Copyright (C) 2013 Free Software Foundation, Inc.
5 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
8 ;; This file is part of GNU Emacs.
10 ;; GNU Emacs is free software: you can redistribute it and/or modify
11 ;; it under the terms of the GNU General Public License as published by
12 ;; the Free Software Foundation, either version 3 of the License, or
13 ;; (at your option) any later version.
15 ;; GNU Emacs is distributed in the hope that it will be useful,
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18 ;; GNU General Public License for more details.
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
27 (eval-when-compile (require 'cl
))
28 (require 'format-spec
)
39 (defcustom eww-header-line-format
"%t: %u"
41 - %t is replaced by the title.
42 - %u is replaced by the URL."
46 (defface eww-form-submit
47 '((((type x w32 ns
) (class color
)) ; Like default mode line
48 :box
(:line-width
2 :style released-button
)
49 :background
"#808080" :foreground
"black"))
50 "Face for eww buffer buttons."
54 (defface eww-form-checkbox
55 '((((type x w32 ns
) (class color
)) ; Like default mode line
56 :box
(:line-width
2 :style released-button
)
57 :background
"lightgrey" :foreground
"black"))
58 "Face for eww buffer buttons."
62 (defface eww-form-select
63 '((((type x w32 ns
) (class color
)) ; Like default mode line
64 :box
(:line-width
2 :style released-button
)
65 :background
"lightgrey" :foreground
"black"))
66 "Face for eww buffer buttons."
70 (defface eww-form-text
71 '((t (:background
"#505050"
73 :box
(:line-width
1))))
74 "Face for eww text inputs."
78 (defvar eww-current-url nil
)
79 (defvar eww-current-title
""
80 "Title of current page.")
81 (defvar eww-history nil
)
83 (defvar eww-next-url nil
)
84 (defvar eww-previous-url nil
)
85 (defvar eww-up-url nil
)
86 (defvar eww-home-url nil
)
87 (defvar eww-start-url nil
)
88 (defvar eww-contents-url nil
)
92 "Fetch URL and render the page."
93 (interactive "sUrl: ")
94 (unless (string-match-p "\\`[a-zA-Z][-a-zA-Z0-9+.]*://" url
)
95 (setq url
(concat "http://" url
)))
96 (url-retrieve url
'eww-render
(list url
)))
99 (defun eww-open-file (file)
100 "Render a file using EWW."
101 (interactive "fFile: ")
102 (eww (concat "file://" (expand-file-name file
))))
104 (defun eww-render (status url
&optional point
)
105 (let ((redirect (plist-get status
:redirect
)))
107 (setq url redirect
)))
108 (set (make-local-variable 'eww-next-url
) nil
)
109 (set (make-local-variable 'eww-previous-url
) nil
)
110 (set (make-local-variable 'eww-up-url
) nil
)
111 (set (make-local-variable 'eww-home-url
) nil
)
112 (set (make-local-variable 'eww-start-url
) nil
)
113 (set (make-local-variable 'eww-contents-url
) nil
)
114 (let* ((headers (eww-parse-headers))
116 (and (string-match "#\\(.*\\)" url
)
117 (match-string 1 url
)))
119 (mail-header-parse-content-type
120 (or (cdr (assoc "content-type" headers
))
124 (or (cdr (assq 'charset
(cdr content-type
)))
125 (eww-detect-charset (equal (car content-type
)
128 (data-buffer (current-buffer)))
132 ((equal (car content-type
) "text/html")
133 (eww-display-html charset url
))
134 ((string-match "^image/" (car content-type
))
137 (eww-display-raw charset
)))
142 (let ((point (next-single-property-change
143 (point-min) 'shr-target-id
)))
145 (goto-char (1+ point
)))))))
146 (kill-buffer data-buffer
))))
148 (defun eww-parse-headers ()
150 (goto-char (point-min))
151 (while (and (not (eobp))
153 (when (looking-at "\\([^:]+\\): *\\(.*\\)")
154 (push (cons (downcase (match-string 1))
162 (defun eww-detect-charset (html-p)
163 (let ((case-fold-search t
)
167 "<meta[\t\n\r ]+[^>]*charset=\"?\\([^\t\n\r \"/>]+\\)" nil t
)
171 "[\t\n\r ]*<\\?xml[\t\n\r ]+[^>]*encoding=\"\\([^\"]+\\)")
174 (defun eww-display-html (charset url
)
175 (unless (eq charset
'utf8
)
176 (decode-coding-region (point) (point-max) charset
))
179 'base
(list (cons 'href url
))
180 (libxml-parse-html-region (point) (point-max)))))
182 (setq eww-current-url url
)
183 (eww-update-header-line-format)
184 (let ((inhibit-read-only t
)
185 (after-change-functions nil
)
187 (shr-external-rendering-functions
188 '((title . eww-tag-title
)
189 (form . eww-tag-form
)
190 (input . eww-tag-input
)
191 (textarea . eww-tag-textarea
)
192 (body . eww-tag-body
)
193 (select . eww-tag-select
)
194 (link . eww-tag-link
)
196 (shr-insert-document document
))
197 (goto-char (point-min))))
199 (defun eww-handle-link (cont)
200 (let* ((rel (assq :rel cont
))
201 (href (assq :href cont
))
203 ;; The text associated with :rel is case-insensitive.
204 (if rel
(downcase (cdr rel
)))
205 '(("next" . eww-next-url
)
206 ;; Texinfo uses "previous", but HTML specifies
207 ;; "prev", so recognize both.
208 ("previous" . eww-previous-url
)
209 ("prev" . eww-previous-url
)
210 ;; HTML specifies "start" but also "contents",
211 ;; and Gtk seems to use "home". Recognize
212 ;; them all; but store them in different
213 ;; variables so that we can readily choose the
215 ("start" . eww-start-url
)
216 ("home" . eww-home-url
)
217 ("contents" . eww-contents-url
)
218 ("up" . eww-up-url
)))))
221 (set (cdr where
) (cdr href
)))))
223 (defun eww-tag-link (cont)
224 (eww-handle-link cont
)
227 (defun eww-tag-a (cont)
228 (eww-handle-link cont
)
231 (defun eww-update-header-line-format ()
232 (if eww-header-line-format
233 (setq header-line-format
234 (replace-regexp-in-string
236 (format-spec eww-header-line-format
237 `((?u .
,eww-current-url
)
238 (?t .
,eww-current-title
)))))
239 (setq header-line-format nil
)))
241 (defun eww-tag-title (cont)
242 (setq eww-current-title
"")
244 (when (eq (car sub
) 'text
)
245 (setq eww-current-title
(concat eww-current-title
(cdr sub
)))))
246 (eww-update-header-line-format))
248 (defun eww-tag-body (cont)
249 (let* ((start (point))
250 (fgcolor (cdr (or (assq :fgcolor cont
)
252 (bgcolor (cdr (assq :bgcolor cont
)))
253 (shr-stylesheet (list (cons 'color fgcolor
)
254 (cons 'background-color bgcolor
))))
256 (eww-colorize-region start
(point) fgcolor bgcolor
)))
258 (defun eww-colorize-region (start end fg
&optional bg
)
260 (let ((new-colors (shr-color-check fg bg
)))
263 (add-face-text-property start end
264 (list :foreground
(cadr new-colors
))
267 (add-face-text-property start end
268 (list :background
(car new-colors
))
271 (defun eww-display-raw (charset)
272 (let ((data (buffer-substring (point) (point-max))))
274 (let ((inhibit-read-only t
))
276 (goto-char (point-min))))
278 (defun eww-display-image ()
279 (let ((data (buffer-substring (point) (point-max))))
281 (let ((inhibit-read-only t
))
282 (shr-put-image data nil
))
283 (goto-char (point-min))))
285 (defun eww-setup-buffer ()
286 (pop-to-buffer (get-buffer-create "*eww*"))
288 (let ((inhibit-read-only t
))
293 (let ((map (make-sparse-keymap)))
294 (suppress-keymap map
)
295 (define-key map
"q" 'eww-quit
)
296 (define-key map
"g" 'eww-reload
)
297 (define-key map
[tab] 'shr-next-link)
298 (define-key map [backtab] 'shr-previous-link)
299 (define-key map [delete] 'scroll-down-command)
300 (define-key map "\177" 'scroll-down-command)
301 (define-key map " " 'scroll-up-command)
302 (define-key map "l" 'eww-back-url)
303 (define-key map "n" 'eww-next-url)
304 (define-key map "p" 'eww-previous-url)
305 (define-key map "u" 'eww-up-url)
306 (define-key map "t" 'eww-top-url)
309 (define-derived-mode eww-mode nil "eww"
310 "Mode for browsing the web.
313 (set (make-local-variable 'eww-current-url) 'author)
314 (set (make-local-variable 'browse-url-browser-function) 'eww-browse-url)
315 (set (make-local-variable 'after-change-functions) 'eww-process-text-input)
316 ;;(setq buffer-read-only t)
319 (defun eww-browse-url (url &optional new-window)
320 (when (and (equal major-mode 'eww-mode)
322 (push (list eww-current-url (point))
327 "Exit the Emacs Web Wowser."
329 (setq eww-history nil)
330 (kill-buffer (current-buffer)))
332 (defun eww-back-url ()
333 "Go to the previously displayed page."
335 (when (zerop (length eww-history))
336 (error "No previous page"))
337 (let ((prev (pop eww-history)))
338 (url-retrieve (car prev) 'eww-render (list (car prev) (cadr prev)))))
340 (defun eww-next-url ()
341 "Go to the page marked `next'.
342 A page is marked `next' if rel=\"next\" appears in a <link>
346 (eww-browse-url (shr-expand-url eww-next-url eww-current-url))
347 (error "No `next' on this page")))
349 (defun eww-previous-url ()
350 "Go to the page marked `previous'.
351 A page is marked `previous' if rel=\"previous\" appears in a <link>
355 (eww-browse-url (shr-expand-url eww-previous-url eww-current-url))
356 (error "No `previous' on this page")))
359 "Go to the page marked `up'.
360 A page is marked `up' if rel=\"up\" appears in a <link>
364 (eww-browse-url (shr-expand-url eww-up-url eww-current-url))
365 (error "No `up' on this page")))
367 (defun eww-top-url ()
368 "Go to the page marked `top'.
369 A page is marked `top' if rel=\"start\", rel=\"home\", or rel=\"contents\"
370 appears in a <link> or <a> tag."
372 (let ((best-url (or eww-start-url
376 (eww-browse-url (shr-expand-url best-url eww-current-url))
377 (error "No `top' for this page"))))
380 "Reload the current page."
382 (url-retrieve eww-current-url 'eww-render
383 (list eww-current-url (point))))
387 (defvar eww-form nil)
389 (defvar eww-submit-map
390 (let ((map (make-sparse-keymap)))
391 (define-key map "\r" 'eww-submit)
394 (defvar eww-checkbox-map
395 (let ((map (make-sparse-keymap)))
396 (define-key map [space] 'eww-toggle-checkbox)
397 (define-key map "\r" 'eww-toggle-checkbox)
401 (let ((map (make-keymap)))
402 (set-keymap-parent map text-mode-map)
403 (define-key map "\r" 'eww-submit)
404 (define-key map [(control a)] 'eww-beginning-of-text)
405 (define-key map [(control e)] 'eww-end-of-text)
406 (define-key map [tab] 'shr-next-link
)
407 (define-key map
[backtab] 'shr-previous-link)
410 (defvar eww-textarea-map
411 (let ((map (make-keymap)))
412 (set-keymap-parent map text-mode-map)
413 (define-key map "\r" 'forward-line)
414 (define-key map [tab] 'shr-next-link)
415 (define-key map [backtab] 'shr-previous-link
)
418 (defvar eww-select-map
419 (let ((map (make-sparse-keymap)))
420 (define-key map
"\r" 'eww-change-select
)
423 (defun eww-beginning-of-text ()
424 "Move to the start of the input field."
426 (goto-char (eww-beginning-of-field)))
428 (defun eww-end-of-text ()
429 "Move to the end of the text in the input field."
431 (goto-char (eww-end-of-field))
432 (let ((start (eww-beginning-of-field)))
433 (while (and (equal (following-char) ?
)
436 (when (> (point) start
)
439 (defun eww-beginning-of-field ()
443 ((not (eq (get-text-property (point) 'eww-form
)
444 (get-text-property (1- (point)) 'eww-form
)))
447 (previous-single-property-change
448 (point) 'eww-form nil
(point-min)))))
450 (defun eww-end-of-field ()
451 (1- (next-single-property-change
452 (point) 'eww-form nil
(point-max))))
454 (defun eww-tag-form (cont)
456 (list (assq :method cont
)
457 (assq :action cont
)))
459 (shr-ensure-paragraph)
464 (when (> (point) start
)
465 (put-text-property start
(1+ start
)
466 'eww-form eww-form
))))
468 (defun eww-form-submit (cont)
469 (let ((start (point))
470 (value (cdr (assq :value cont
))))
472 (if (zerop (length value
))
476 (add-face-text-property start
(point) 'eww-form-submit
)
477 (put-text-property start
(point) 'eww-form
478 (list :eww-form eww-form
481 :name
(cdr (assq :name cont
))))
482 (put-text-property start
(point) 'keymap eww-submit-map
)
485 (defun eww-form-checkbox (cont)
486 (let ((start (point)))
487 (if (cdr (assq :checked cont
))
490 (add-face-text-property start
(point) 'eww-form-checkbox
)
491 (put-text-property start
(point) 'eww-form
492 (list :eww-form eww-form
493 :value
(cdr (assq :value cont
))
494 :type
(downcase (cdr (assq :type cont
)))
495 :checked
(cdr (assq :checked cont
))
496 :name
(cdr (assq :name cont
))))
497 (put-text-property start
(point) 'keymap eww-checkbox-map
)
500 (defun eww-form-text (cont)
501 (let ((start (point))
502 (type (downcase (or (cdr (assq :type cont
))
504 (value (or (cdr (assq :value cont
)) ""))
505 (width (string-to-number
506 (or (cdr (assq :size cont
))
509 (when (< (length value
) width
)
510 (insert (make-string (- width
(length value
)) ?
)))
511 (put-text-property start
(point) 'face
'eww-form-text
)
512 (put-text-property start
(point) 'local-map eww-text-map
)
513 (put-text-property start
(point) 'inhibit-read-only t
)
514 (put-text-property start
(point) 'eww-form
515 (list :eww-form eww-form
518 :name
(cdr (assq :name cont
))))
521 (defun eww-process-text-input (beg end length
)
522 (let* ((form (get-text-property end
'eww-form
))
523 (properties (text-properties-at end
))
524 (type (plist-get form
:type
)))
526 (member type
'("text" "password" "textarea")))
529 ;; Delete some space at the end.
532 (if (equal type
"textarea")
533 (1- (line-end-position))
535 (let ((new (- end beg
)))
536 (while (and (> new
0)
537 (eql (following-char) ?
))
538 (delete-region (point) (1+ (point)))
539 (setq new
(1- new
))))
540 (set-text-properties beg end properties
)))
545 (if (equal type
"textarea")
546 (1- (line-end-position))
548 (let ((start (point)))
549 (insert (make-string length ?
))
550 (set-text-properties start
(point) properties
)))))
551 (let ((value (buffer-substring-no-properties
552 (eww-beginning-of-field)
553 (eww-end-of-field))))
554 (when (string-match " +\\'" value
)
555 (setq value
(substring value
0 (match-beginning 0))))
556 (plist-put form
:value value
)
557 (when (equal type
"password")
558 ;; Display passwords as asterisks.
559 (let ((start (eww-beginning-of-field)))
560 (put-text-property start
(+ start
(length value
))
561 'display
(make-string (length value
) ?
*))))))))
563 (defun eww-tag-textarea (cont)
564 (let ((start (point))
565 (value (or (cdr (assq :value cont
)) ""))
566 (lines (string-to-number
567 (or (cdr (assq :rows cont
))
569 (width (string-to-number
570 (or (cdr (assq :cols cont
))
576 (when (< (count-lines start
(point)) lines
)
577 (dotimes (i (- lines
(count-lines start
(point))))
579 (setq end
(point-marker))
581 (while (< (point) end
)
583 (let ((pad (- width
(- (point) (line-beginning-position)))))
585 (insert (make-string pad ?
))))
586 (add-face-text-property (line-beginning-position)
587 (point) 'eww-form-text
)
588 (put-text-property (line-beginning-position) (point)
589 'local-map eww-textarea-map
)
591 (put-text-property start
(point) 'eww-form
592 (list :eww-form eww-form
595 :name
(cdr (assq :name cont
))))))
597 (defun eww-tag-input (cont)
598 (let ((type (downcase (or (cdr (assq :type cont
))
602 ((or (equal type
"checkbox")
603 (equal type
"radio"))
604 (eww-form-checkbox cont
))
605 ((equal type
"submit")
606 (eww-form-submit cont
))
607 ((equal type
"hidden")
608 (let ((form eww-form
)
609 (name (cdr (assq :name cont
))))
610 ;; Don't add <input type=hidden> elements repeatedly.
612 (or (not (consp (car form
)))
613 (not (eq (caar form
) 'hidden
))
614 (not (equal (plist-get (cdr (car form
)) :name
)
616 (setq form
(cdr form
)))
618 (nconc eww-form
(list
621 :value
(cdr (assq :value cont
))))))))
623 (eww-form-text cont
)))
624 (unless (= start
(point))
625 (put-text-property start
(1+ start
) 'help-echo
"Input field"))))
627 (defun eww-tag-select (cont)
628 (shr-ensure-paragraph)
629 (let ((menu (list :name
(cdr (assq :name cont
))
635 (when (eq (car elem
) 'option
)
636 (when (cdr (assq :selected
(cdr elem
)))
637 (nconc menu
(list :value
638 (cdr (assq :value
(cdr elem
))))))
639 (let ((display (or (cdr (assq 'text
(cdr elem
))) "")))
640 (setq max
(max max
(length display
)))
642 :value
(cdr (assq :value
(cdr elem
)))
646 (setq options
(nreverse options
))
647 ;; If we have no selected values, default to the first value.
648 (unless (plist-get menu
:value
)
649 (nconc menu
(list :value
(nth 2 (car options
)))))
651 (let ((selected (eww-select-display menu
)))
653 (make-string (- max
(length selected
)) ?
)))
654 (put-text-property start
(point) 'eww-form menu
)
655 (add-face-text-property start
(point) 'eww-form-select
)
656 (put-text-property start
(point) 'keymap eww-select-map
)
657 (shr-ensure-paragraph))))
659 (defun eww-select-display (select)
660 (let ((value (plist-get select
:value
))
662 (dolist (elem select
)
663 (when (and (consp elem
)
664 (eq (car elem
) 'item
)
665 (equal value
(plist-get (cdr elem
) :value
)))
666 (setq display
(plist-get (cdr elem
) :display
))))
669 (defun eww-change-select ()
670 "Change the value of the select drop-down menu under point."
672 (let* ((input (get-text-property (point) 'eww-form
))
673 (properties (text-properties-at (point)))
674 (completion-ignore-case t
)
677 (mapcar (lambda (elem)
679 (eq (car elem
) 'item
)
680 (cons (plist-get (cdr elem
) :display
)
681 (plist-get (cdr elem
) :value
))))
684 (completing-read "Change value: " options nil
'require-match
))
685 (inhibit-read-only t
))
686 (plist-put input
:value
(cdr (assoc-string display options t
)))
688 (eww-update-field display
))))
690 (defun eww-update-field (string)
691 (let ((properties (text-properties-at (point)))
692 (start (eww-beginning-of-field))
693 (end (1+ (eww-end-of-field))))
694 (delete-region start end
)
696 (make-string (- (- end start
) (length string
)) ?
))
697 (set-text-properties start end properties
)
700 (defun eww-toggle-checkbox ()
701 "Toggle the value of the checkbox under point."
703 (let* ((input (get-text-property (point) 'eww-form
))
704 (type (plist-get input
:type
)))
705 (if (equal type
"checkbox")
708 (if (plist-get input
:checked
)
710 (plist-put input
:checked nil
)
711 (eww-update-field "[ ]"))
712 (plist-put input
:checked t
)
713 (eww-update-field "[X]"))))
714 ;; Radio button. Switch all other buttons off.
715 (let ((name (plist-get input
:name
)))
717 (dolist (elem (eww-inputs (plist-get input
:eww-form
)))
718 (when (equal (plist-get (cdr elem
) :name
) name
)
719 (goto-char (car elem
))
720 (if (not (eq (cdr elem
) input
))
722 (plist-put input
:checked nil
)
723 (eww-update-field "[ ]"))
724 (plist-put input
:checked t
)
725 (eww-update-field "[X]")))))
728 (defun eww-inputs (form)
729 (let ((start (point-min))
732 (< start
(point-max)))
733 (when (or (get-text-property start
'eww-form
)
734 (setq start
(next-single-property-change start
'eww-form
)))
735 (when (eq (plist-get (get-text-property start
'eww-form
) :eww-form
)
737 (push (cons start
(get-text-property start
'eww-form
))
739 (setq start
(next-single-property-change start
'eww-form
))))
742 (defun eww-input-value (input)
743 (let ((type (plist-get input
:type
))
744 (value (plist-get input
:value
)))
746 ((equal type
"textarea")
749 (goto-char (point-min))
750 (while (re-search-forward "^ +\n\\| +$" nil t
)
751 (replace-match "" t t
))
754 (if (string-match " +\\'" value
)
755 (substring value
0 (match-beginning 0))
759 "Submit the current form."
761 (let* ((this-input (get-text-property (point) 'eww-form
))
762 (form (plist-get this-input
:eww-form
))
764 (dolist (elem (sort (eww-inputs form
)
766 (< (car o1
) (car o2
)))))
767 (let* ((input (cdr elem
))
768 (input-start (car elem
))
769 (name (plist-get input
:name
)))
772 ((member (plist-get input
:type
) '("checkbox" "radio"))
773 (when (plist-get input
:checked
)
774 (push (cons name
(plist-get input
:value
))
776 ((equal (plist-get input
:type
) "submit")
777 ;; We want the values from buttons if we hit a button if
778 ;; we hit enter on it, or if it's the first button after
779 ;; the field we did hit return on.
780 (when (or (eq input this-input
)
781 (and (not (eq input this-input
))
783 (> input-start
(point))))
785 (push (cons name
(plist-get input
:value
))
788 (push (cons name
(eww-input-value input
))
791 (when (and (consp elem
)
792 (eq (car elem
) 'hidden
))
793 (push (cons (plist-get (cdr elem
) :name
)
794 (plist-get (cdr elem
) :value
))
796 (if (and (stringp (cdr (assq :method form
)))
797 (equal (downcase (cdr (assq :method form
))) "post"))
798 (let ((url-request-method "POST")
799 (url-request-extra-headers
800 '(("Content-Type" .
"application/x-www-form-urlencoded")))
801 (url-request-data (mm-url-encode-www-form-urlencoded values
)))
802 (eww-browse-url (shr-expand-url (cdr (assq :action form
))
806 (if (cdr (assq :action form
))
807 (shr-expand-url (cdr (assq :action form
))
811 (mm-url-encode-www-form-urlencoded values
))))))