1 ;;; eww.el --- Emacs Web Wowser
3 ;; Copyright (C) 2013-2014 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
)
36 :link
'(custom-manual "(eww) Top")
40 (defcustom eww-header-line-format
"%t: %u"
42 - %t is replaced by the title.
43 - %u is replaced by the URL."
48 (defcustom eww-search-prefix
"https://duckduckgo.com/html/?q="
49 "Prefix URL to search engine"
54 (defcustom eww-download-directory
"~/Downloads/"
55 "Directory where files will downloaded."
60 (defcustom eww-use-external-browser-for-content-type
61 "\\`\\(video/\\|audio/\\|application/ogg\\)"
62 "Always use external browser for specified content-type."
65 :type
'(choice (const :tag
"Never" nil
)
68 (defcustom eww-form-checkbox-selected-symbol
"[X]"
69 "Symbol used to represent a selected checkbox.
70 See also `eww-form-checkbox-symbol'."
73 :type
'(choice (const "[X]")
74 (const "☒") ; Unicode BALLOT BOX WITH X
75 (const "☑") ; Unicode BALLOT BOX WITH CHECK
78 (defcustom eww-form-checkbox-symbol
"[ ]"
79 "Symbol used to represent a checkbox.
80 See also `eww-form-checkbox-selected-symbol'."
83 :type
'(choice (const "[ ]")
84 (const "☐") ; Unicode BALLOT BOX
87 (defface eww-form-submit
88 '((((type x w32 ns
) (class color
)) ; Like default mode line
89 :box
(:line-width
2 :style released-button
)
90 :background
"#808080" :foreground
"black"))
91 "Face for eww buffer buttons."
95 (defface eww-form-checkbox
96 '((((type x w32 ns
) (class color
)) ; Like default mode line
97 :box
(:line-width
2 :style released-button
)
98 :background
"lightgrey" :foreground
"black"))
99 "Face for eww buffer buttons."
103 (defface eww-form-select
104 '((((type x w32 ns
) (class color
)) ; Like default mode line
105 :box
(:line-width
2 :style released-button
)
106 :background
"lightgrey" :foreground
"black"))
107 "Face for eww buffer buttons."
111 (defface eww-form-text
112 '((t (:background
"#505050"
114 :box
(:line-width
1))))
115 "Face for eww text inputs."
119 (defface eww-form-textarea
120 '((t (:background
"#C0C0C0"
122 :box
(:line-width
1))))
123 "Face for eww textarea inputs."
127 (defvar eww-current-url nil
)
128 (defvar eww-current-dom nil
)
129 (defvar eww-current-source nil
)
130 (defvar eww-current-title
""
131 "Title of current page.")
132 (defvar eww-history nil
)
133 (defvar eww-history-position
0)
135 (defvar eww-next-url nil
)
136 (defvar eww-previous-url nil
)
137 (defvar eww-up-url nil
)
138 (defvar eww-home-url nil
)
139 (defvar eww-start-url nil
)
140 (defvar eww-contents-url nil
)
142 (defvar eww-local-regex
"localhost"
143 "When this regex is found in the URL, it's not a keyword but an address.")
145 (defvar eww-link-keymap
146 (let ((map (copy-keymap shr-map
)))
147 (define-key map
"\r" 'eww-follow-link
)
152 "Fetch URL and render the page.
153 If the input doesn't look like an URL or a domain name, the
154 word(s) will be searched for via `eww-search-prefix'."
155 (interactive "sEnter URL or keywords: ")
156 (cond ((string-match-p "\\`file://" url
))
157 ((string-match-p "\\`ftp://" url
)
158 (user-error "FTP is not supported."))
160 (if (and (= (length (split-string url
)) 1)
161 (or (and (not (string-match-p "\\`[\"\'].*[\"\']\\'" url
))
162 (> (length (split-string url
"\\.")) 1))
163 (string-match eww-local-regex url
)))
165 (unless (string-match-p "\\`[a-zA-Z][-a-zA-Z0-9+.]*://" url
)
166 (setq url
(concat "http://" url
)))
167 ;; some site don't redirect final /
168 (when (string= (url-filename (url-generic-parse-url url
)) "")
169 (setq url
(concat url
"/"))))
170 (setq url
(concat eww-search-prefix
171 (replace-regexp-in-string " " "+" url
))))))
172 (url-retrieve url
'eww-render
(list url
)))
174 ;;;###autoload (defalias 'browse-web 'eww)
177 (defun eww-open-file (file)
178 "Render a file using EWW."
179 (interactive "fFile: ")
180 (eww (concat "file://"
181 (and (memq system-type
'(windows-nt ms-dos
))
183 (expand-file-name file
))))
185 (defun eww-render (status url
&optional point
)
186 (let ((redirect (plist-get status
:redirect
)))
188 (setq url redirect
)))
189 (let* ((headers (eww-parse-headers))
191 (mail-header-parse-content-type
192 (or (cdr (assoc "content-type" headers
))
196 (or (cdr (assq 'charset
(cdr content-type
)))
197 (eww-detect-charset (equal (car content-type
)
200 (data-buffer (current-buffer)))
203 (setq eww-current-title
"")
205 ((and eww-use-external-browser-for-content-type
206 (string-match-p eww-use-external-browser-for-content-type
208 (eww-browse-with-external-browser url
))
209 ((equal (car content-type
) "text/html")
210 (eww-display-html charset url nil point
))
211 ((string-match-p "\\`image/" (car content-type
))
213 (eww-update-header-line-format))
216 (eww-update-header-line-format)))
217 (setq eww-current-url url
218 eww-history-position
0))
219 (kill-buffer data-buffer
))))
221 (defun eww-parse-headers ()
223 (goto-char (point-min))
224 (while (and (not (eobp))
226 (when (looking-at "\\([^:]+\\): *\\(.*\\)")
227 (push (cons (downcase (match-string 1))
235 (defun eww-detect-charset (html-p)
236 (let ((case-fold-search t
)
240 "<meta[\t\n\r ]+[^>]*charset=\"?\\([^\t\n\r \"/>]+\\)[\\\"'.*]" nil t
)
244 "[\t\n\r ]*<\\?xml[\t\n\r ]+[^>]*encoding=\"\\([^\"]+\\)")
247 (declare-function libxml-parse-html-region
"xml.c"
248 (start end
&optional base-url
))
250 (defun eww-display-html (charset url
&optional document point
)
251 (or (fboundp 'libxml-parse-html-region
)
252 (error "This function requires Emacs to be compiled with libxml2"))
253 (unless (eq charset
'utf8
)
255 (decode-coding-region (point) (point-max) charset
)
256 (coding-system-error nil
)))
260 'base
(list (cons 'href url
))
261 (libxml-parse-html-region (point) (point-max))))))
262 (setq eww-current-source
(buffer-substring (point) (point-max)))
264 (setq eww-current-dom document
)
265 (let ((inhibit-read-only t
)
266 (after-change-functions nil
)
268 (shr-target-id (url-target (url-generic-parse-url url
)))
269 (shr-external-rendering-functions
270 '((title . eww-tag-title
)
271 (form . eww-tag-form
)
272 (input . eww-tag-input
)
273 (textarea . eww-tag-textarea
)
274 (body . eww-tag-body
)
275 (select . eww-tag-select
)
276 (link . eww-tag-link
)
278 (shr-insert-document document
)
283 (goto-char (point-min))
284 (let ((point (next-single-property-change
285 (point-min) 'shr-target-id
)))
289 (goto-char (point-min)))))
290 (setq eww-current-url url
291 eww-history-position
0)
292 (eww-update-header-line-format)))
294 (defun eww-handle-link (cont)
295 (let* ((rel (assq :rel cont
))
296 (href (assq :href cont
))
298 ;; The text associated with :rel is case-insensitive.
299 (if rel
(downcase (cdr rel
)))
300 '(("next" . eww-next-url
)
301 ;; Texinfo uses "previous", but HTML specifies
302 ;; "prev", so recognize both.
303 ("previous" . eww-previous-url
)
304 ("prev" . eww-previous-url
)
305 ;; HTML specifies "start" but also "contents",
306 ;; and Gtk seems to use "home". Recognize
307 ;; them all; but store them in different
308 ;; variables so that we can readily choose the
310 ("start" . eww-start-url
)
311 ("home" . eww-home-url
)
312 ("contents" . eww-contents-url
)
313 ("up" . eww-up-url
)))))
316 (set (cdr where
) (cdr href
)))))
318 (defun eww-tag-link (cont)
319 (eww-handle-link cont
)
322 (defun eww-tag-a (cont)
323 (eww-handle-link cont
)
324 (let ((start (point)))
326 (put-text-property start
(point) 'keymap eww-link-keymap
)))
328 (defun eww-update-header-line-format ()
329 (if eww-header-line-format
330 (setq header-line-format
331 (replace-regexp-in-string
333 ;; FIXME? Title can be blank. Default to, eg, last component
335 (format-spec eww-header-line-format
336 `((?u .
,eww-current-url
)
337 (?t .
,eww-current-title
)))))
338 (setq header-line-format nil
)))
340 (defun eww-tag-title (cont)
341 (setq eww-current-title
"")
343 (when (eq (car sub
) 'text
)
344 (setq eww-current-title
(concat eww-current-title
(cdr sub
)))))
345 (eww-update-header-line-format))
347 (defun eww-tag-body (cont)
348 (let* ((start (point))
349 (fgcolor (cdr (or (assq :fgcolor cont
)
351 (bgcolor (cdr (assq :bgcolor cont
)))
352 (shr-stylesheet (list (cons 'color fgcolor
)
353 (cons 'background-color bgcolor
))))
355 (eww-colorize-region start
(point) fgcolor bgcolor
)))
357 (defun eww-colorize-region (start end fg
&optional bg
)
359 (let ((new-colors (shr-color-check fg bg
)))
362 (add-face-text-property start end
363 (list :foreground
(cadr new-colors
))
366 (add-face-text-property start end
367 (list :background
(car new-colors
))
370 (defun eww-display-raw ()
371 (let ((data (buffer-substring (point) (point-max))))
373 (let ((inhibit-read-only t
))
375 (goto-char (point-min))))
377 (defun eww-display-image ()
378 (let ((data (shr-parse-image-data)))
380 (let ((inhibit-read-only t
))
381 (shr-put-image data nil
))
382 (goto-char (point-min))))
384 (defun eww-setup-buffer ()
385 (switch-to-buffer (get-buffer-create "*eww*"))
386 (let ((inhibit-read-only t
))
389 (unless (eq major-mode
'eww-mode
)
391 (setq-local eww-next-url nil
)
392 (setq-local eww-previous-url nil
)
393 (setq-local eww-up-url nil
)
394 (setq-local eww-home-url nil
)
395 (setq-local eww-start-url nil
)
396 (setq-local eww-contents-url nil
))
398 (defun eww-view-source ()
400 (let ((buf (get-buffer-create "*eww-source*"))
401 (source eww-current-source
))
402 (with-current-buffer buf
403 (delete-region (point-min) (point-max))
404 (insert (or eww-current-source
"no source"))
405 (goto-char (point-min))
406 (when (fboundp 'html-mode
)
411 (let ((map (make-sparse-keymap)))
412 (suppress-keymap map
)
413 (define-key map
"q" 'quit-window
)
414 (define-key map
"g" 'eww-reload
)
415 (define-key map
[?
\t] 'shr-next-link
)
416 (define-key map
[?\M-
\t] 'shr-previous-link
)
417 (define-key map
[delete] 'scroll-down-command)
418 (define-key map [?\S-\ ] 'scroll-down-command)
419 (define-key map "\177" 'scroll-down-command)
420 (define-key map " " 'scroll-up-command)
421 (define-key map "l" 'eww-back-url)
422 (define-key map "r" 'eww-forward-url)
423 (define-key map "n" 'eww-next-url)
424 (define-key map "p" 'eww-previous-url)
425 (define-key map "u" 'eww-up-url)
426 (define-key map "t" 'eww-top-url)
427 (define-key map "&" 'eww-browse-with-external-browser)
428 (define-key map "d" 'eww-download)
429 (define-key map "w" 'eww-copy-page-url)
430 (define-key map "C" 'url-cookie-list)
431 (define-key map "v" 'eww-view-source)
432 (define-key map "H" 'eww-list-histories)
434 (define-key map "b" 'eww-add-bookmark)
435 (define-key map "B" 'eww-list-bookmarks)
436 (define-key map [(meta n)] 'eww-next-bookmark)
437 (define-key map [(meta p)] 'eww-previous-bookmark)
439 (easy-menu-define nil map ""
442 ["Close browser" quit-window t]
443 ["Reload" eww-reload t]
444 ["Back to previous page" eww-back-url
445 :active (not (zerop (length eww-history)))]
446 ["Forward to next page" eww-forward-url
447 :active (not (zerop eww-history-position))]
448 ["Browse with external browser" eww-browse-with-external-browser t]
449 ["Download" eww-download t]
450 ["View page source" eww-view-source]
451 ["Copy page URL" eww-copy-page-url t]
452 ["List histories" eww-list-histories t]
453 ["Add bookmark" eww-add-bookmark t]
454 ["List bookmarks" eww-list-bookmarks t]
455 ["List cookies" url-cookie-list t]))
458 (defvar eww-tool-bar-map
459 (let ((map (make-sparse-keymap)))
460 (dolist (tool-bar-item
461 '((eww-quit . "close")
462 (eww-reload . "refresh")
463 (eww-back-url . "left-arrow")
464 (eww-forward-url . "right-arrow")
465 (eww-view-source . "show")
466 (eww-copy-page-url . "copy")
467 (eww-add-bookmark . "bookmark_add"))) ;; ...
468 (tool-bar-local-item-from-menu
469 (car tool-bar-item) (cdr tool-bar-item) map eww-mode-map))
471 "Tool bar for `eww-mode'.")
473 (define-derived-mode eww-mode nil "eww"
474 "Mode for browsing the web.
477 ;; FIXME? This seems a strange default.
478 (setq-local eww-current-url 'author)
479 (setq-local eww-current-dom nil)
480 (setq-local eww-current-source nil)
481 (setq-local browse-url-browser-function 'eww-browse-url)
482 (setq-local after-change-functions 'eww-process-text-input)
483 (setq-local eww-history nil)
484 (setq-local eww-history-position 0)
485 (when (boundp 'tool-bar-map)
486 (setq-local tool-bar-map eww-tool-bar-map))
487 (buffer-disable-undo)
488 ;;(setq buffer-read-only t)
492 (defun eww-browse-url (url &optional _new-window)
493 (when (and (equal major-mode 'eww-mode)
498 (defun eww-back-url ()
499 "Go to the previously displayed page."
501 (when (>= eww-history-position (length eww-history))
502 (user-error "No previous page"))
504 (setq eww-history-position (+ eww-history-position 2))
505 (eww-restore-history (elt eww-history (1- eww-history-position))))
507 (defun eww-forward-url ()
508 "Go to the next displayed page."
510 (when (zerop eww-history-position)
511 (user-error "No next page"))
513 (eww-restore-history (elt eww-history (1- eww-history-position))))
515 (defun eww-restore-history (elem)
516 (let ((inhibit-read-only t))
518 (insert (plist-get elem :text))
519 (setq eww-current-source (plist-get elem :source))
520 (setq eww-current-dom (plist-get elem :dom))
521 (goto-char (plist-get elem :point))
522 (setq eww-current-url (plist-get elem :url)
523 eww-current-title (plist-get elem :title))
524 (eww-update-header-line-format)))
526 (defun eww-next-url ()
527 "Go to the page marked `next'.
528 A page is marked `next' if rel=\"next\" appears in a <link>
532 (eww-browse-url (shr-expand-url eww-next-url eww-current-url))
533 (user-error "No `next' on this page")))
535 (defun eww-previous-url ()
536 "Go to the page marked `previous'.
537 A page is marked `previous' if rel=\"previous\" appears in a <link>
541 (eww-browse-url (shr-expand-url eww-previous-url eww-current-url))
542 (user-error "No `previous' on this page")))
545 "Go to the page marked `up'.
546 A page is marked `up' if rel=\"up\" appears in a <link>
550 (eww-browse-url (shr-expand-url eww-up-url eww-current-url))
551 (user-error "No `up' on this page")))
553 (defun eww-top-url ()
554 "Go to the page marked `top'.
555 A page is marked `top' if rel=\"start\", rel=\"home\", or rel=\"contents\"
556 appears in a <link> or <a> tag."
558 (let ((best-url (or eww-start-url
562 (eww-browse-url (shr-expand-url best-url eww-current-url))
563 (user-error "No `top' for this page"))))
566 "Reload the current page."
568 (url-retrieve eww-current-url 'eww-render
569 (list eww-current-url (point))))
573 (defvar eww-form nil)
575 (defvar eww-submit-map
576 (let ((map (make-sparse-keymap)))
577 (define-key map "\r" 'eww-submit)
578 (define-key map [(control c) (control c)] 'eww-submit)
581 (defvar eww-checkbox-map
582 (let ((map (make-sparse-keymap)))
583 (define-key map " " 'eww-toggle-checkbox)
584 (define-key map "\r" 'eww-toggle-checkbox)
585 (define-key map [(control c) (control c)] 'eww-submit)
589 (let ((map (make-keymap)))
590 (set-keymap-parent map text-mode-map)
591 (define-key map "\r" 'eww-submit)
592 (define-key map [(control a)] 'eww-beginning-of-text)
593 (define-key map [(control c) (control c)] 'eww-submit)
594 (define-key map [(control e)] 'eww-end-of-text)
595 (define-key map [?\t] 'shr-next-link)
596 (define-key map [?\M-\t] 'shr-previous-link)
599 (defvar eww-textarea-map
600 (let ((map (make-keymap)))
601 (set-keymap-parent map text-mode-map)
602 (define-key map "\r" 'forward-line)
603 (define-key map [(control c) (control c)] 'eww-submit)
604 (define-key map [?\t] 'shr-next-link)
605 (define-key map [?\M-\t] 'shr-previous-link)
608 (defvar eww-select-map
609 (let ((map (make-sparse-keymap)))
610 (define-key map "\r" 'eww-change-select)
611 (define-key map [(control c) (control c)] 'eww-submit)
614 (defun eww-beginning-of-text ()
615 "Move to the start of the input field."
617 (goto-char (eww-beginning-of-field)))
619 (defun eww-end-of-text ()
620 "Move to the end of the text in the input field."
622 (goto-char (eww-end-of-field))
623 (let ((start (eww-beginning-of-field)))
624 (while (and (equal (following-char) ? )
627 (when (> (point) start)
630 (defun eww-beginning-of-field ()
634 ((not (eq (get-text-property (point) 'eww-form)
635 (get-text-property (1- (point)) 'eww-form)))
638 (previous-single-property-change
639 (point) 'eww-form nil (point-min)))))
641 (defun eww-end-of-field ()
642 (1- (next-single-property-change
643 (point) 'eww-form nil (point-max))))
645 (defun eww-tag-form (cont)
647 (list (assq :method cont)
648 (assq :action cont)))
650 (shr-ensure-paragraph)
655 (when (> (point) start)
656 (put-text-property start (1+ start)
657 'eww-form eww-form))))
659 (defun eww-form-submit (cont)
660 (let ((start (point))
661 (value (cdr (assq :value cont))))
663 (if (zerop (length value))
667 (add-face-text-property start (point) 'eww-form-submit)
668 (put-text-property start (point) 'eww-form
669 (list :eww-form eww-form
672 :name (cdr (assq :name cont))))
673 (put-text-property start (point) 'keymap eww-submit-map)
676 (defun eww-form-checkbox (cont)
677 (let ((start (point)))
678 (if (cdr (assq :checked cont))
679 (insert eww-form-checkbox-selected-symbol)
680 (insert eww-form-checkbox-symbol))
681 (add-face-text-property start (point) 'eww-form-checkbox)
682 (put-text-property start (point) 'eww-form
683 (list :eww-form eww-form
684 :value (cdr (assq :value cont))
685 :type (downcase (cdr (assq :type cont)))
686 :checked (cdr (assq :checked cont))
687 :name (cdr (assq :name cont))))
688 (put-text-property start (point) 'keymap eww-checkbox-map)
691 (defun eww-form-text (cont)
692 (let ((start (point))
693 (type (downcase (or (cdr (assq :type cont))
695 (value (or (cdr (assq :value cont)) ""))
696 (width (string-to-number
697 (or (cdr (assq :size cont))
699 (readonly-property (if (or (cdr (assq :disabled cont))
700 (cdr (assq :readonly cont)))
702 'inhibit-read-only)))
704 (when (< (length value) width)
705 (insert (make-string (- width (length value)) ? )))
706 (put-text-property start (point) 'face 'eww-form-text)
707 (put-text-property start (point) 'local-map eww-text-map)
708 (put-text-property start (point) readonly-property t)
709 (put-text-property start (point) 'eww-form
710 (list :eww-form eww-form
713 :name (cdr (assq :name cont))))
716 (defconst eww-text-input-types '("text" "password" "textarea"
717 "color" "date" "datetime" "datetime-local"
718 "email" "month" "number" "search" "tel"
720 "List of input types which represent a text input.
721 See URL `https://developer.mozilla.org/en-US/docs/Web/HTML/Element/Input'.")
723 (defun eww-process-text-input (beg end length)
724 (let* ((form (get-text-property (min (1+ end) (point-max)) 'eww-form))
725 (properties (text-properties-at end))
726 (type (plist-get form :type)))
728 (member type eww-text-input-types))
731 ;; Delete some space at the end.
734 (if (equal type "textarea")
735 (1- (line-end-position))
737 (let ((new (- end beg)))
738 (while (and (> new 0)
739 (eql (following-char) ? ))
740 (delete-region (point) (1+ (point)))
741 (setq new (1- new))))
742 (set-text-properties beg end properties)))
747 (if (equal type "textarea")
748 (1- (line-end-position))
750 (let ((start (point)))
751 (insert (make-string length ? ))
752 (set-text-properties start (point) properties)))))
753 (let ((value (buffer-substring-no-properties
754 (eww-beginning-of-field)
755 (eww-end-of-field))))
756 (when (string-match " +\\'" value)
757 (setq value (substring value 0 (match-beginning 0))))
758 (plist-put form :value value)
759 (when (equal type "password")
760 ;; Display passwords as asterisks.
761 (let ((start (eww-beginning-of-field)))
762 (put-text-property start (+ start (length value))
763 'display (make-string (length value) ?*))))))))
765 (defun eww-tag-textarea (cont)
766 (let ((start (point))
767 (value (or (cdr (assq :value cont)) ""))
768 (lines (string-to-number
769 (or (cdr (assq :rows cont))
771 (width (string-to-number
772 (or (cdr (assq :cols cont))
778 (when (< (count-lines start (point)) lines)
779 (dotimes (i (- lines (count-lines start (point))))
781 (setq end (point-marker))
783 (while (< (point) end)
785 (let ((pad (- width (- (point) (line-beginning-position)))))
787 (insert (make-string pad ? ))))
788 (add-face-text-property (line-beginning-position)
789 (point) 'eww-form-textarea)
790 (put-text-property (line-beginning-position) (point)
791 'local-map eww-textarea-map)
793 (put-text-property start (point) 'eww-form
794 (list :eww-form eww-form
797 :name (cdr (assq :name cont))))))
799 (defun eww-tag-input (cont)
800 (let ((type (downcase (or (cdr (assq :type cont))
804 ((or (equal type "checkbox")
805 (equal type "radio"))
806 (eww-form-checkbox cont))
807 ((equal type "submit")
808 (eww-form-submit cont))
809 ((equal type "hidden")
810 (let ((form eww-form)
811 (name (cdr (assq :name cont))))
812 ;; Don't add <input type=hidden> elements repeatedly.
814 (or (not (consp (car form)))
815 (not (eq (caar form) 'hidden))
816 (not (equal (plist-get (cdr (car form)) :name)
818 (setq form (cdr form)))
820 (nconc eww-form (list
823 :value (cdr (assq :value cont))))))))
825 (eww-form-text cont)))
826 (unless (= start (point))
827 (put-text-property start (1+ start) 'help-echo "Input field"))))
829 (defun eww-tag-select (cont)
830 (shr-ensure-paragraph)
831 (let ((menu (list :name (cdr (assq :name cont))
837 (if (eq (car (car cont)) 'optgroup)
838 (dolist (groupelem cont)
839 (unless (cdr (assq :disabled (cdr groupelem)))
840 (setq opelem (append opelem (cdr (cdr groupelem))))))
842 (dolist (elem opelem)
843 (when (eq (car elem) 'option)
844 (when (cdr (assq :selected (cdr elem)))
845 (nconc menu (list :value
846 (cdr (assq :value (cdr elem))))))
847 (let ((display (or (cdr (assq 'text (cdr elem))) "")))
848 (setq max (max max (length display)))
850 :value (cdr (assq :value (cdr elem)))
854 (setq options (nreverse options))
855 ;; If we have no selected values, default to the first value.
856 (unless (plist-get menu :value)
857 (nconc menu (list :value (nth 2 (car options)))))
859 (let ((selected (eww-select-display menu)))
861 (make-string (- max (length selected)) ? )))
862 (put-text-property start (point) 'eww-form menu)
863 (add-face-text-property start (point) 'eww-form-select)
864 (put-text-property start (point) 'keymap eww-select-map)
865 (unless (= start (point))
866 (put-text-property start (1+ start) 'help-echo "select field"))
867 (shr-ensure-paragraph))))
869 (defun eww-select-display (select)
870 (let ((value (plist-get select :value))
872 (dolist (elem select)
873 (when (and (consp elem)
874 (eq (car elem) 'item)
875 (equal value (plist-get (cdr elem) :value)))
876 (setq display (plist-get (cdr elem) :display))))
879 (defun eww-change-select ()
880 "Change the value of the select drop-down menu under point."
882 (let* ((input (get-text-property (point) 'eww-form))
883 (completion-ignore-case t)
886 (mapcar (lambda (elem)
888 (eq (car elem) 'item)
889 (cons (plist-get (cdr elem) :display)
890 (plist-get (cdr elem) :value))))
893 (completing-read "Change value: " options nil 'require-match))
894 (inhibit-read-only t))
895 (plist-put input :value (cdr (assoc-string display options t)))
897 (eww-update-field display))))
899 (defun eww-update-field (string)
900 (let ((properties (text-properties-at (point)))
901 (start (eww-beginning-of-field))
902 (end (1+ (eww-end-of-field))))
903 (delete-region start end)
905 (make-string (- (- end start) (length string)) ? ))
906 (set-text-properties start end properties)
909 (defun eww-toggle-checkbox ()
910 "Toggle the value of the checkbox under point."
912 (let* ((input (get-text-property (point) 'eww-form))
913 (type (plist-get input :type)))
914 (if (equal type "checkbox")
917 (if (plist-get input :checked)
919 (plist-put input :checked nil)
920 (eww-update-field eww-form-checkbox-symbol))
921 (plist-put input :checked t)
922 (eww-update-field eww-form-checkbox-selected-symbol))))
923 ;; Radio button. Switch all other buttons off.
924 (let ((name (plist-get input :name)))
926 (dolist (elem (eww-inputs (plist-get input :eww-form)))
927 (when (equal (plist-get (cdr elem) :name) name)
928 (goto-char (car elem))
929 (if (not (eq (cdr elem) input))
931 (plist-put input :checked nil)
932 (eww-update-field eww-form-checkbox-symbol))
933 (plist-put input :checked t)
934 (eww-update-field eww-form-checkbox-selected-symbol)))))
937 (defun eww-inputs (form)
938 (let ((start (point-min))
941 (< start (point-max)))
942 (when (or (get-text-property start 'eww-form)
943 (setq start (next-single-property-change start 'eww-form)))
944 (when (eq (plist-get (get-text-property start 'eww-form) :eww-form)
946 (push (cons start (get-text-property start 'eww-form))
948 (setq start (next-single-property-change start 'eww-form))))
951 (defun eww-input-value (input)
952 (let ((type (plist-get input :type))
953 (value (plist-get input :value)))
955 ((equal type "textarea")
958 (goto-char (point-min))
959 (while (re-search-forward "^ +\n\\| +$" nil t)
960 (replace-match "" t t))
963 (if (string-match " +\\'" value)
964 (substring value 0 (match-beginning 0))
968 "Submit the current form."
970 (let* ((this-input (get-text-property (point) 'eww-form))
971 (form (plist-get this-input :eww-form))
973 (dolist (elem (sort (eww-inputs form)
975 (< (car o1) (car o2)))))
976 (let* ((input (cdr elem))
977 (input-start (car elem))
978 (name (plist-get input :name)))
981 ((member (plist-get input :type) '("checkbox" "radio"))
982 (when (plist-get input :checked)
983 (push (cons name (plist-get input :value))
985 ((equal (plist-get input :type) "submit")
986 ;; We want the values from buttons if we hit a button if
987 ;; we hit enter on it, or if it's the first button after
988 ;; the field we did hit return on.
989 (when (or (eq input this-input)
990 (and (not (eq input this-input))
992 (> input-start (point))))
994 (push (cons name (plist-get input :value))
997 (push (cons name (eww-input-value input))
1000 (when (and (consp elem)
1001 (eq (car elem) 'hidden))
1002 (push (cons (plist-get (cdr elem) :name)
1003 (plist-get (cdr elem) :value))
1005 (if (and (stringp (cdr (assq :method form)))
1006 (equal (downcase (cdr (assq :method form))) "post"))
1007 (let ((url-request-method "POST")
1008 (url-request-extra-headers
1009 '(("Content-Type" . "application/x-www-form-urlencoded")))
1010 (url-request-data (mm-url-encode-www-form-urlencoded values)))
1011 (eww-browse-url (shr-expand-url (cdr (assq :action form))
1015 (if (cdr (assq :action form))
1016 (shr-expand-url (cdr (assq :action form))
1020 (mm-url-encode-www-form-urlencoded values))))))
1022 (defun eww-browse-with-external-browser (&optional url)
1023 "Browse the current URL with an external browser.
1024 The browser to used is specified by the `shr-external-browser' variable."
1026 (funcall shr-external-browser (or url eww-current-url)))
1028 (defun eww-follow-link (&optional external mouse-event)
1029 "Browse the URL under point.
1030 If EXTERNAL, browse the URL using `shr-external-browser'."
1031 (interactive (list current-prefix-arg last-nonmenu-event))
1032 (mouse-set-point mouse-event)
1033 (let ((url (get-text-property (point) 'shr-url)))
1036 (message "No link under point"))
1037 ((string-match "^mailto:" url)
1038 (browse-url-mail url))
1040 (funcall shr-external-browser url))
1041 ;; This is a #target url in the same page as the current one.
1042 ((and (url-target (url-generic-parse-url url))
1043 (eww-same-page-p url eww-current-url))
1045 (eww-display-html 'utf8 url eww-current-dom))
1047 (eww-browse-url url)))))
1049 (defun eww-same-page-p (url1 url2)
1050 "Return non-nil if both URLs represent the same page.
1051 Differences in #targets are ignored."
1052 (let ((obj1 (url-generic-parse-url url1))
1053 (obj2 (url-generic-parse-url url2)))
1054 (setf (url-target obj1) nil)
1055 (setf (url-target obj2) nil)
1056 (equal (url-recreate-url obj1) (url-recreate-url obj2))))
1058 (defun eww-copy-page-url ()
1060 (message "%s" eww-current-url)
1061 (kill-new eww-current-url))
1063 (defun eww-download ()
1064 "Download URL under point to `eww-download-directory'."
1066 (let ((url (get-text-property (point) 'shr-url)))
1068 (message "No URL under point")
1069 (url-retrieve url 'eww-download-callback (list url)))))
1071 (defun eww-download-callback (status url)
1072 (unless (plist-get status :error)
1073 (let* ((obj (url-generic-parse-url url))
1074 (path (car (url-path-and-query obj)))
1075 (file (eww-make-unique-file-name (file-name-nondirectory path)
1076 eww-download-directory)))
1078 (message "Saved %s" file))))
1080 (defun eww-make-unique-file-name (file directory)
1082 ((zerop (length file))
1084 ((string-match "\\`[.]" file)
1085 (setq file (concat "!" file))))
1087 (while (file-exists-p (expand-file-name file directory))
1089 (if (string-match "\\`\\(.*\\)\\([.][^.]+\\)" file)
1090 (format "%s(%d)%s" (match-string 1 file)
1091 count (match-string 2 file))
1092 (format "%s(%d)" file count)))
1093 (setq count (1+ count)))
1094 (expand-file-name file directory)))
1098 (defvar eww-bookmarks nil)
1100 (defun eww-add-bookmark ()
1101 "Add the current page to the bookmarks."
1103 (eww-read-bookmarks)
1104 (dolist (bookmark eww-bookmarks)
1105 (when (equal eww-current-url
1106 (plist-get bookmark :url))
1107 (user-error "Already bookmarked")))
1108 (if (y-or-n-p "bookmark this page? ")
1110 (let ((title (replace-regexp-in-string "[\n\t\r]" " " eww-current-title)))
1111 (setq title (replace-regexp-in-string "\\` +\\| +\\'" "" title))
1112 (push (list :url eww-current-url
1114 :time (current-time-string))
1116 (eww-write-bookmarks)
1117 (message "Bookmarked %s (%s)" eww-current-url eww-current-title))))
1119 (defun eww-write-bookmarks ()
1120 (with-temp-file (expand-file-name "eww-bookmarks" user-emacs-directory)
1121 (insert ";; Auto-generated file; don't edit\n")
1122 (pp eww-bookmarks (current-buffer))))
1124 (defun eww-read-bookmarks ()
1125 (let ((file (expand-file-name "eww-bookmarks" user-emacs-directory)))
1127 (unless (zerop (or (nth 7 (file-attributes file)) 0))
1129 (insert-file-contents file)
1130 (read (current-buffer)))))))
1132 (defun eww-list-bookmarks ()
1133 "Display the bookmarks."
1135 (eww-bookmark-prepare)
1136 (pop-to-buffer "*eww bookmarks*"))
1138 (defun eww-bookmark-prepare ()
1139 (eww-read-bookmarks)
1140 (unless eww-bookmarks
1141 (user-error "No bookmarks are defined"))
1142 (set-buffer (get-buffer-create "*eww bookmarks*"))
1144 (let ((format "%-40s %s")
1145 (inhibit-read-only t)
1148 (setq header-line-format (concat " " (format format "URL" "Title")))
1149 (dolist (bookmark eww-bookmarks)
1150 (setq start (point))
1151 (setq url (plist-get bookmark :url))
1152 (when (> (length url) 40)
1153 (setq url (substring url 0 40)))
1154 (insert (format format url
1155 (plist-get bookmark :title))
1157 (put-text-property start (1+ start) 'eww-bookmark bookmark))
1158 (goto-char (point-min))))
1160 (defvar eww-bookmark-kill-ring nil)
1162 (defun eww-bookmark-kill ()
1163 "Kill the current bookmark."
1165 (let* ((start (line-beginning-position))
1166 (bookmark (get-text-property start 'eww-bookmark))
1167 (inhibit-read-only t))
1169 (user-error "No bookmark on the current line"))
1171 (push (buffer-substring start (point)) eww-bookmark-kill-ring)
1172 (delete-region start (point))
1173 (setq eww-bookmarks (delq bookmark eww-bookmarks))
1174 (eww-write-bookmarks)))
1176 (defun eww-bookmark-yank ()
1177 "Yank a previously killed bookmark to the current line."
1179 (unless eww-bookmark-kill-ring
1180 (user-error "No previously killed bookmark"))
1182 (let ((inhibit-read-only t)
1185 (insert (pop eww-bookmark-kill-ring))
1186 (setq bookmark (get-text-property start 'eww-bookmark))
1187 (if (= start (point-min))
1188 (push bookmark eww-bookmarks)
1189 (let ((line (count-lines start (point))))
1190 (setcdr (nthcdr (1- line) eww-bookmarks)
1191 (cons bookmark (nthcdr line eww-bookmarks)))))
1192 (eww-write-bookmarks)))
1194 (defun eww-bookmark-browse ()
1195 "Browse the bookmark under point in eww."
1197 (let ((bookmark (get-text-property (line-beginning-position) 'eww-bookmark)))
1199 (user-error "No bookmark on the current line"))
1201 (eww-browse-url (plist-get bookmark :url))))
1203 (defun eww-next-bookmark ()
1204 "Go to the next bookmark in the list."
1208 (unless (get-buffer "*eww bookmarks*")
1210 (eww-bookmark-prepare))
1211 (with-current-buffer (get-buffer "*eww bookmarks*")
1212 (when (and (not first)
1215 (setq bookmark (get-text-property (line-beginning-position)
1218 (user-error "No next bookmark")))
1219 (eww-browse-url (plist-get bookmark :url))))
1221 (defun eww-previous-bookmark ()
1222 "Go to the previous bookmark in the list."
1226 (unless (get-buffer "*eww bookmarks*")
1228 (eww-bookmark-prepare))
1229 (with-current-buffer (get-buffer "*eww bookmarks*")
1231 (goto-char (point-max))
1232 (beginning-of-line))
1233 ;; On the final line.
1237 (user-error "No previous bookmark")
1239 (setq bookmark (get-text-property (line-beginning-position)
1241 (eww-browse-url (plist-get bookmark :url))))
1243 (defvar eww-bookmark-mode-map
1244 (let ((map (make-sparse-keymap)))
1245 (suppress-keymap map)
1246 (define-key map "q" 'quit-window)
1247 (define-key map [(control k)] 'eww-bookmark-kill)
1248 (define-key map [(control y)] 'eww-bookmark-yank)
1249 (define-key map "\r" 'eww-bookmark-browse)
1251 (easy-menu-define nil map
1252 "Menu for `eww-bookmark-mode-map'."
1254 ["Exit" quit-window t]
1255 ["Browse" eww-bookmark-browse
1256 :active (get-text-property (line-beginning-position) 'eww-bookmark)]
1257 ["Kill" eww-bookmark-kill
1258 :active (get-text-property (line-beginning-position) 'eww-bookmark)]
1259 ["Yank" eww-bookmark-yank
1260 :active eww-bookmark-kill-ring]))
1263 (define-derived-mode eww-bookmark-mode nil "eww bookmarks"
1264 "Mode for listing bookmarks.
1266 \\{eww-bookmark-mode-map}"
1267 (buffer-disable-undo)
1268 (setq buffer-read-only t
1273 (defun eww-save-history ()
1274 (push (list :url eww-current-url
1275 :title eww-current-title
1277 :dom eww-current-dom
1278 :source eww-current-source
1279 :text (buffer-string))
1282 (defun eww-list-histories ()
1283 "List the eww-histories."
1285 (when (null eww-history)
1286 (error "No eww-histories are defined"))
1287 (let ((eww-history-trans eww-history))
1288 (set-buffer (get-buffer-create "*eww history*"))
1290 (let ((inhibit-read-only t)
1293 url title format start)
1295 (dolist (history eww-history-trans)
1296 (setq start (point))
1297 (setq domain-length (max domain-length (length (plist-get history :url))))
1298 (setq title-length (max title-length (length (plist-get history :title)))))
1299 (setq format (format "%%-%ds %%-%ds" title-length domain-length)
1301 (concat " " (format format "Title" "URL")))
1302 (dolist (history eww-history-trans)
1303 (setq start (point))
1304 (setq url (plist-get history :url))
1305 (setq title (plist-get history :title))
1306 (insert (format format title url))
1308 (put-text-property start (1+ start) 'eww-history history))
1309 (goto-char (point-min)))
1310 (pop-to-buffer "*eww history*")))
1312 (defun eww-history-browse ()
1313 "Browse the history under point in eww."
1315 (let ((history (get-text-property (line-beginning-position) 'eww-history)))
1317 (error "No history on the current line"))
1319 (eww-restore-history history)))
1321 (defvar eww-history-mode-map
1322 (let ((map (make-sparse-keymap)))
1323 (suppress-keymap map)
1324 (define-key map "q" 'quit-window)
1325 (define-key map "\r" 'eww-history-browse)
1326 ;; (define-key map "n" 'next-error-no-select)
1327 ;; (define-key map "p" 'previous-error-no-select)
1329 (easy-menu-define nil map
1330 "Menu for `eww-history-mode-map'."
1332 ["Exit" quit-window t]
1333 ["Browse" eww-history-browse
1334 :active (get-text-property (line-beginning-position) 'eww-history)]))
1337 (define-derived-mode eww-history-mode nil "eww history"
1338 "Mode for listing eww-histories.
1340 \\{eww-history-mode-map}"
1341 (buffer-disable-undo)
1342 (setq buffer-read-only t
1347 ;;; eww.el ends here