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
)
39 (defcustom eww-header-line-format
"%t: %u"
41 - %t is replaced by the title.
42 - %u is replaced by the URL."
47 (defcustom eww-search-prefix
"https://duckduckgo.com/html/?q="
48 "Prefix URL to search engine"
53 (defcustom eww-download-path
"~/Downloads/"
54 "Path where files will downloaded."
59 (defcustom eww-use-external-browser-for-content-type
60 "\\`\\(video/\\|audio/\\|application/ogg\\)"
61 "Always use external browser for specified content-type."
64 :type
'(choice (const :tag
"Never" nil
)
67 (defcustom eww-form-checkbox-selected-symbol
"[X]"
68 "Symbol used to represent a selected checkbox.
69 See also `eww-form-checkbox-symbol'."
72 :type
'(choice (const "[X]")
73 (const "☒") ; Unicode BALLOT BOX WITH X
74 (const "☑") ; Unicode BALLOT BOX WITH CHECK
77 (defcustom eww-form-checkbox-symbol
"[ ]"
78 "Symbol used to represent a checkbox.
79 See also `eww-form-checkbox-selected-symbol'."
82 :type
'(choice (const "[ ]")
83 (const "☐") ; Unicode BALLOT BOX
86 (defface eww-form-submit
87 '((((type x w32 ns
) (class color
)) ; Like default mode line
88 :box
(:line-width
2 :style released-button
)
89 :background
"#808080" :foreground
"black"))
90 "Face for eww buffer buttons."
94 (defface eww-form-checkbox
95 '((((type x w32 ns
) (class color
)) ; Like default mode line
96 :box
(:line-width
2 :style released-button
)
97 :background
"lightgrey" :foreground
"black"))
98 "Face for eww buffer buttons."
102 (defface eww-form-select
103 '((((type x w32 ns
) (class color
)) ; Like default mode line
104 :box
(:line-width
2 :style released-button
)
105 :background
"lightgrey" :foreground
"black"))
106 "Face for eww buffer buttons."
110 (defface eww-form-text
111 '((t (:background
"#505050"
113 :box
(:line-width
1))))
114 "Face for eww text inputs."
118 (defface eww-form-textarea
119 '((t (:background
"#C0C0C0"
121 :box
(:line-width
1))))
122 "Face for eww textarea inputs."
126 (defvar eww-current-url nil
)
127 (defvar eww-current-dom nil
)
128 (defvar eww-current-source nil
)
129 (defvar eww-current-title
""
130 "Title of current page.")
131 (defvar eww-history nil
)
132 (defvar eww-history-position
0)
134 (defvar eww-next-url nil
)
135 (defvar eww-previous-url nil
)
136 (defvar eww-up-url nil
)
137 (defvar eww-home-url nil
)
138 (defvar eww-start-url nil
)
139 (defvar eww-contents-url nil
)
141 (defvar eww-local-regex
"localhost"
142 "When this regex is found in the URL, it's not a keyword but an address.")
144 (defvar eww-link-keymap
145 (let ((map (copy-keymap shr-map
)))
146 (define-key map
"\r" 'eww-follow-link
)
151 "Fetch URL and render the page.
152 If the input doesn't look like an URL or a domain name, the
153 word(s) will be searched for via `eww-search-prefix'."
154 (interactive "sEnter URL or keywords: ")
155 (cond ((string-match-p "\\`file://" url
))
156 ((string-match-p "\\`ftp://" url
)
157 (user-error "FTP is not supported."))
159 (if (and (= (length (split-string url
)) 1)
160 (or (> (length (split-string url
"\\.")) 1)
161 (string-match eww-local-regex url
)))
163 (unless (string-match-p "\\`[a-zA-Z][-a-zA-Z0-9+.]*://" url
)
164 (setq url
(concat "http://" url
)))
165 ;; some site don't redirect final /
166 (when (string= (url-filename (url-generic-parse-url url
)) "")
167 (setq url
(concat url
"/"))))
168 (setq url
(concat eww-search-prefix
169 (replace-regexp-in-string " " "+" url
))))))
170 (url-retrieve url
'eww-render
(list url
)))
172 ;;;###autoload (defalias 'browse-web 'eww)
175 (defun eww-open-file (file)
176 "Render a file using EWW."
177 (interactive "fFile: ")
178 (eww (concat "file://"
179 (and (memq system-type
'(windows-nt ms-dos
))
181 (expand-file-name file
))))
183 (defun eww-render (status url
&optional point
)
184 (let ((redirect (plist-get status
:redirect
)))
186 (setq url redirect
)))
187 (setq-local eww-next-url nil
)
188 (setq-local eww-previous-url nil
)
189 (setq-local eww-up-url nil
)
190 (setq-local eww-home-url nil
)
191 (setq-local eww-start-url nil
)
192 (setq-local eww-contents-url nil
)
193 (let* ((headers (eww-parse-headers))
195 (mail-header-parse-content-type
196 (or (cdr (assoc "content-type" headers
))
200 (or (cdr (assq 'charset
(cdr content-type
)))
201 (eww-detect-charset (equal (car content-type
)
204 (data-buffer (current-buffer)))
207 (setq eww-current-title
"")
209 ((and eww-use-external-browser-for-content-type
210 (string-match-p eww-use-external-browser-for-content-type
212 (eww-browse-with-external-browser url
))
213 ((equal (car content-type
) "text/html")
214 (eww-display-html charset url nil point
))
215 ((string-match-p "\\`image/" (car content-type
))
217 (eww-update-header-line-format))
220 (eww-update-header-line-format)))
221 (setq eww-current-url url
222 eww-history-position
0))
223 (kill-buffer data-buffer
))))
225 (defun eww-parse-headers ()
227 (goto-char (point-min))
228 (while (and (not (eobp))
230 (when (looking-at "\\([^:]+\\): *\\(.*\\)")
231 (push (cons (downcase (match-string 1))
239 (defun eww-detect-charset (html-p)
240 (let ((case-fold-search t
)
244 "<meta[\t\n\r ]+[^>]*charset=\"?\\([^\t\n\r \"/>]+\\)[\\\"'.*]" nil t
)
248 "[\t\n\r ]*<\\?xml[\t\n\r ]+[^>]*encoding=\"\\([^\"]+\\)")
251 (declare-function libxml-parse-html-region
"xml.c"
252 (start end
&optional base-url
))
254 (defun eww-display-html (charset url
&optional document point
)
255 (or (fboundp 'libxml-parse-html-region
)
256 (error "This function requires Emacs to be compiled with libxml2"))
257 (unless (eq charset
'utf8
)
259 (decode-coding-region (point) (point-max) charset
)
260 (coding-system-error nil
)))
264 'base
(list (cons 'href url
))
265 (libxml-parse-html-region (point) (point-max))))))
266 (setq eww-current-source
(buffer-substring (point) (point-max)))
268 (setq eww-current-dom document
)
269 (let ((inhibit-read-only t
)
270 (after-change-functions nil
)
272 (shr-target-id (url-target (url-generic-parse-url url
)))
273 (shr-external-rendering-functions
274 '((title . eww-tag-title
)
275 (form . eww-tag-form
)
276 (input . eww-tag-input
)
277 (textarea . eww-tag-textarea
)
278 (body . eww-tag-body
)
279 (select . eww-tag-select
)
280 (link . eww-tag-link
)
282 (shr-insert-document document
)
287 (goto-char (point-min))
288 (let ((point (next-single-property-change
289 (point-min) 'shr-target-id
)))
293 (goto-char (point-min)))))
294 (setq eww-current-url url
295 eww-history-position
0)
296 (eww-update-header-line-format)))
298 (defun eww-handle-link (cont)
299 (let* ((rel (assq :rel cont
))
300 (href (assq :href cont
))
302 ;; The text associated with :rel is case-insensitive.
303 (if rel
(downcase (cdr rel
)))
304 '(("next" . eww-next-url
)
305 ;; Texinfo uses "previous", but HTML specifies
306 ;; "prev", so recognize both.
307 ("previous" . eww-previous-url
)
308 ("prev" . eww-previous-url
)
309 ;; HTML specifies "start" but also "contents",
310 ;; and Gtk seems to use "home". Recognize
311 ;; them all; but store them in different
312 ;; variables so that we can readily choose the
314 ("start" . eww-start-url
)
315 ("home" . eww-home-url
)
316 ("contents" . eww-contents-url
)
317 ("up" . eww-up-url
)))))
320 (set (cdr where
) (cdr href
)))))
322 (defun eww-tag-link (cont)
323 (eww-handle-link cont
)
326 (defun eww-tag-a (cont)
327 (eww-handle-link cont
)
328 (let ((start (point)))
330 (put-text-property start
(point) 'keymap eww-link-keymap
)))
332 (defun eww-update-header-line-format ()
333 (if eww-header-line-format
334 (setq header-line-format
335 (replace-regexp-in-string
337 ;; FIXME? Title can be blank. Default to, eg, last component
339 (format-spec eww-header-line-format
340 `((?u .
,eww-current-url
)
341 (?t .
,eww-current-title
)))))
342 (setq header-line-format nil
)))
344 (defun eww-tag-title (cont)
345 (setq eww-current-title
"")
347 (when (eq (car sub
) 'text
)
348 (setq eww-current-title
(concat eww-current-title
(cdr sub
)))))
349 (eww-update-header-line-format))
351 (defun eww-tag-body (cont)
352 (let* ((start (point))
353 (fgcolor (cdr (or (assq :fgcolor cont
)
355 (bgcolor (cdr (assq :bgcolor cont
)))
356 (shr-stylesheet (list (cons 'color fgcolor
)
357 (cons 'background-color bgcolor
))))
359 (eww-colorize-region start
(point) fgcolor bgcolor
)))
361 (defun eww-colorize-region (start end fg
&optional bg
)
363 (let ((new-colors (shr-color-check fg bg
)))
366 (add-face-text-property start end
367 (list :foreground
(cadr new-colors
))
370 (add-face-text-property start end
371 (list :background
(car new-colors
))
374 (defun eww-display-raw ()
375 (let ((data (buffer-substring (point) (point-max))))
377 (let ((inhibit-read-only t
))
379 (goto-char (point-min))))
381 (defun eww-display-image ()
382 (let ((data (shr-parse-image-data)))
384 (let ((inhibit-read-only t
))
385 (shr-put-image data nil
))
386 (goto-char (point-min))))
388 (defun eww-setup-buffer ()
389 (switch-to-buffer (get-buffer-create "*eww*"))
390 (let ((inhibit-read-only t
))
393 (unless (eq major-mode
'eww-mode
)
396 (defun eww-view-source ()
398 (let ((buf (get-buffer-create "*eww-source*"))
399 (source eww-current-source
))
400 (with-current-buffer buf
401 (delete-region (point-min) (point-max))
402 (insert (or eww-current-source
"no source"))
403 (goto-char (point-min))
404 (when (fboundp 'html-mode
)
409 (let ((map (make-sparse-keymap)))
410 (suppress-keymap map
)
411 (define-key map
"q" 'quit-window
)
412 (define-key map
"g" 'eww-reload
)
413 (define-key map
[tab] 'shr-next-link)
414 (define-key map [backtab] 'shr-previous-link)
415 (define-key map [delete] 'scroll-down-command)
416 (define-key map [?\S-\ ] 'scroll-down-command)
417 (define-key map "\177" 'scroll-down-command)
418 (define-key map " " 'scroll-up-command)
419 (define-key map "l" 'eww-back-url)
420 (define-key map "r" 'eww-forward-url)
421 (define-key map "n" 'eww-next-url)
422 (define-key map "p" 'eww-previous-url)
423 (define-key map "u" 'eww-up-url)
424 (define-key map "t" 'eww-top-url)
425 (define-key map "&" 'eww-browse-with-external-browser)
426 (define-key map "d" 'eww-download)
427 (define-key map "w" 'eww-copy-page-url)
428 (define-key map "C" 'url-cookie-list)
429 (define-key map "v" 'eww-view-source)
430 (define-key map "H" 'eww-list-histories)
432 (define-key map "b" 'eww-add-bookmark)
433 (define-key map "B" 'eww-list-bookmarks)
434 (define-key map [(meta n)] 'eww-next-bookmark)
435 (define-key map [(meta p)] 'eww-previous-bookmark)
437 (easy-menu-define nil map ""
440 ["Close browser" quit-window t]
441 ["Reload" eww-reload t]
442 ["Back to previous page" eww-back-url
443 :active (not (zerop (length eww-history)))]
444 ["Forward to next page" eww-forward-url
445 :active (not (zerop eww-history-position))]
446 ["Browse with external browser" eww-browse-with-external-browser t]
447 ["Download" eww-download t]
448 ["View page source" eww-view-source]
449 ["Copy page URL" eww-copy-page-url t]
450 ["List histories" eww-list-histories t]
451 ["Add bookmark" eww-add-bookmark t]
452 ["List bookmarks" eww-list-bookmarks t]
453 ["List cookies" url-cookie-list t]))
456 (defvar eww-tool-bar-map
457 (let ((map (make-sparse-keymap)))
458 (dolist (tool-bar-item
459 '((eww-quit . "close")
460 (eww-reload . "refresh")
461 (eww-back-url . "left-arrow")
462 (eww-forward-url . "right-arrow")
463 (eww-view-source . "show")
464 (eww-copy-page-url . "copy")
465 (eww-add-bookmark . "bookmark_add"))) ;; ...
466 (tool-bar-local-item-from-menu
467 (car tool-bar-item) (cdr tool-bar-item) map eww-mode-map))
469 "Tool bar for `eww-mode'.")
471 (define-derived-mode eww-mode nil "eww"
472 "Mode for browsing the web.
475 ;; FIXME? This seems a strange default.
476 (setq-local eww-current-url 'author)
477 (setq-local eww-current-dom nil)
478 (setq-local eww-current-source nil)
479 (setq-local browse-url-browser-function 'eww-browse-url)
480 (setq-local after-change-functions 'eww-process-text-input)
481 (setq-local eww-history nil)
482 (setq-local eww-history-position 0)
483 (when (boundp 'tool-bar-map)
484 (setq-local tool-bar-map eww-tool-bar-map))
485 (buffer-disable-undo)
486 ;;(setq buffer-read-only t)
490 (defun eww-browse-url (url &optional _new-window)
491 (when (and (equal major-mode 'eww-mode)
496 (defun eww-back-url ()
497 "Go to the previously displayed page."
499 (when (>= eww-history-position (length eww-history))
500 (user-error "No previous page"))
502 (setq eww-history-position (+ eww-history-position 2))
503 (eww-restore-history (elt eww-history (1- eww-history-position))))
505 (defun eww-forward-url ()
506 "Go to the next displayed page."
508 (when (zerop eww-history-position)
509 (user-error "No next page"))
511 (eww-restore-history (elt eww-history (1- eww-history-position))))
513 (defun eww-restore-history (elem)
514 (let ((inhibit-read-only t))
516 (insert (plist-get elem :text))
517 (setq eww-current-source (plist-get elem :source))
518 (setq eww-current-dom (plist-get elem :dom))
519 (goto-char (plist-get elem :point))
520 (setq eww-current-url (plist-get elem :url)
521 eww-current-title (plist-get elem :title))
522 (eww-update-header-line-format)))
524 (defun eww-next-url ()
525 "Go to the page marked `next'.
526 A page is marked `next' if rel=\"next\" appears in a <link>
530 (eww-browse-url (shr-expand-url eww-next-url eww-current-url))
531 (user-error "No `next' on this page")))
533 (defun eww-previous-url ()
534 "Go to the page marked `previous'.
535 A page is marked `previous' if rel=\"previous\" appears in a <link>
539 (eww-browse-url (shr-expand-url eww-previous-url eww-current-url))
540 (user-error "No `previous' on this page")))
543 "Go to the page marked `up'.
544 A page is marked `up' if rel=\"up\" appears in a <link>
548 (eww-browse-url (shr-expand-url eww-up-url eww-current-url))
549 (user-error "No `up' on this page")))
551 (defun eww-top-url ()
552 "Go to the page marked `top'.
553 A page is marked `top' if rel=\"start\", rel=\"home\", or rel=\"contents\"
554 appears in a <link> or <a> tag."
556 (let ((best-url (or eww-start-url
560 (eww-browse-url (shr-expand-url best-url eww-current-url))
561 (user-error "No `top' for this page"))))
564 "Reload the current page."
566 (url-retrieve eww-current-url 'eww-render
567 (list eww-current-url (point))))
571 (defvar eww-form nil)
573 (defvar eww-submit-map
574 (let ((map (make-sparse-keymap)))
575 (define-key map "\r" 'eww-submit)
576 (define-key map [(control c) (control c)] 'eww-submit)
579 (defvar eww-checkbox-map
580 (let ((map (make-sparse-keymap)))
581 (define-key map " " 'eww-toggle-checkbox)
582 (define-key map "\r" 'eww-toggle-checkbox)
583 (define-key map [(control c) (control c)] 'eww-submit)
587 (let ((map (make-keymap)))
588 (set-keymap-parent map text-mode-map)
589 (define-key map "\r" 'eww-submit)
590 (define-key map [(control a)] 'eww-beginning-of-text)
591 (define-key map [(control c) (control c)] 'eww-submit)
592 (define-key map [(control e)] 'eww-end-of-text)
593 (define-key map [tab] 'shr-next-link
)
594 (define-key map
[backtab] 'shr-previous-link)
597 (defvar eww-textarea-map
598 (let ((map (make-keymap)))
599 (set-keymap-parent map text-mode-map)
600 (define-key map "\r" 'forward-line)
601 (define-key map [(control c) (control c)] 'eww-submit)
602 (define-key map [tab] 'shr-next-link)
603 (define-key map [backtab] 'shr-previous-link
)
606 (defvar eww-select-map
607 (let ((map (make-sparse-keymap)))
608 (define-key map
"\r" 'eww-change-select
)
609 (define-key map
[(control c
) (control c
)] 'eww-submit
)
612 (defun eww-beginning-of-text ()
613 "Move to the start of the input field."
615 (goto-char (eww-beginning-of-field)))
617 (defun eww-end-of-text ()
618 "Move to the end of the text in the input field."
620 (goto-char (eww-end-of-field))
621 (let ((start (eww-beginning-of-field)))
622 (while (and (equal (following-char) ?
)
625 (when (> (point) start
)
628 (defun eww-beginning-of-field ()
632 ((not (eq (get-text-property (point) 'eww-form
)
633 (get-text-property (1- (point)) 'eww-form
)))
636 (previous-single-property-change
637 (point) 'eww-form nil
(point-min)))))
639 (defun eww-end-of-field ()
640 (1- (next-single-property-change
641 (point) 'eww-form nil
(point-max))))
643 (defun eww-tag-form (cont)
645 (list (assq :method cont
)
646 (assq :action cont
)))
648 (shr-ensure-paragraph)
653 (when (> (point) start
)
654 (put-text-property start
(1+ start
)
655 'eww-form eww-form
))))
657 (defun eww-form-submit (cont)
658 (let ((start (point))
659 (value (cdr (assq :value cont
))))
661 (if (zerop (length value
))
665 (add-face-text-property start
(point) 'eww-form-submit
)
666 (put-text-property start
(point) 'eww-form
667 (list :eww-form eww-form
670 :name
(cdr (assq :name cont
))))
671 (put-text-property start
(point) 'keymap eww-submit-map
)
674 (defun eww-form-checkbox (cont)
675 (let ((start (point)))
676 (if (cdr (assq :checked cont
))
677 (insert eww-form-checkbox-selected-symbol
)
678 (insert eww-form-checkbox-symbol
))
679 (add-face-text-property start
(point) 'eww-form-checkbox
)
680 (put-text-property start
(point) 'eww-form
681 (list :eww-form eww-form
682 :value
(cdr (assq :value cont
))
683 :type
(downcase (cdr (assq :type cont
)))
684 :checked
(cdr (assq :checked cont
))
685 :name
(cdr (assq :name cont
))))
686 (put-text-property start
(point) 'keymap eww-checkbox-map
)
689 (defun eww-form-text (cont)
690 (let ((start (point))
691 (type (downcase (or (cdr (assq :type cont
))
693 (value (or (cdr (assq :value cont
)) ""))
694 (width (string-to-number
695 (or (cdr (assq :size cont
))
697 (readonly-property (if (or (cdr (assq :disabled cont
))
698 (cdr (assq :readonly cont
)))
700 'inhibit-read-only
)))
702 (when (< (length value
) width
)
703 (insert (make-string (- width
(length value
)) ?
)))
704 (put-text-property start
(point) 'face
'eww-form-text
)
705 (put-text-property start
(point) 'local-map eww-text-map
)
706 (put-text-property start
(point) readonly-property t
)
707 (put-text-property start
(point) 'eww-form
708 (list :eww-form eww-form
711 :name
(cdr (assq :name cont
))))
714 (defconst eww-text-input-types
'("text" "password" "textarea"
715 "color" "date" "datetime" "datetime-local"
716 "email" "month" "number" "search" "tel"
718 "List of input types which represent a text input.
719 See URL `https://developer.mozilla.org/en-US/docs/Web/HTML/Element/Input'.")
721 (defun eww-process-text-input (beg end length
)
722 (let* ((form (get-text-property (min (1+ end
) (point-max)) 'eww-form
))
723 (properties (text-properties-at end
))
724 (type (plist-get form
:type
)))
726 (member type eww-text-input-types
))
729 ;; Delete some space at the end.
732 (if (equal type
"textarea")
733 (1- (line-end-position))
735 (let ((new (- end beg
)))
736 (while (and (> new
0)
737 (eql (following-char) ?
))
738 (delete-region (point) (1+ (point)))
739 (setq new
(1- new
))))
740 (set-text-properties beg end properties
)))
745 (if (equal type
"textarea")
746 (1- (line-end-position))
748 (let ((start (point)))
749 (insert (make-string length ?
))
750 (set-text-properties start
(point) properties
)))))
751 (let ((value (buffer-substring-no-properties
752 (eww-beginning-of-field)
753 (eww-end-of-field))))
754 (when (string-match " +\\'" value
)
755 (setq value
(substring value
0 (match-beginning 0))))
756 (plist-put form
:value value
)
757 (when (equal type
"password")
758 ;; Display passwords as asterisks.
759 (let ((start (eww-beginning-of-field)))
760 (put-text-property start
(+ start
(length value
))
761 'display
(make-string (length value
) ?
*))))))))
763 (defun eww-tag-textarea (cont)
764 (let ((start (point))
765 (value (or (cdr (assq :value cont
)) ""))
766 (lines (string-to-number
767 (or (cdr (assq :rows cont
))
769 (width (string-to-number
770 (or (cdr (assq :cols cont
))
776 (when (< (count-lines start
(point)) lines
)
777 (dotimes (i (- lines
(count-lines start
(point))))
779 (setq end
(point-marker))
781 (while (< (point) end
)
783 (let ((pad (- width
(- (point) (line-beginning-position)))))
785 (insert (make-string pad ?
))))
786 (add-face-text-property (line-beginning-position)
787 (point) 'eww-form-textarea
)
788 (put-text-property (line-beginning-position) (point)
789 'local-map eww-textarea-map
)
791 (put-text-property start
(point) 'eww-form
792 (list :eww-form eww-form
795 :name
(cdr (assq :name cont
))))))
797 (defun eww-tag-input (cont)
798 (let ((type (downcase (or (cdr (assq :type cont
))
802 ((or (equal type
"checkbox")
803 (equal type
"radio"))
804 (eww-form-checkbox cont
))
805 ((equal type
"submit")
806 (eww-form-submit cont
))
807 ((equal type
"hidden")
808 (let ((form eww-form
)
809 (name (cdr (assq :name cont
))))
810 ;; Don't add <input type=hidden> elements repeatedly.
812 (or (not (consp (car form
)))
813 (not (eq (caar form
) 'hidden
))
814 (not (equal (plist-get (cdr (car form
)) :name
)
816 (setq form
(cdr form
)))
818 (nconc eww-form
(list
821 :value
(cdr (assq :value cont
))))))))
823 (eww-form-text cont
)))
824 (unless (= start
(point))
825 (put-text-property start
(1+ start
) 'help-echo
"Input field"))))
827 (defun eww-tag-select (cont)
828 (shr-ensure-paragraph)
829 (let ((menu (list :name
(cdr (assq :name cont
))
835 (if (eq (car (car cont
)) 'optgroup
)
836 (dolist (groupelem cont
)
837 (unless (cdr (assq :disabled
(cdr groupelem
)))
838 (setq opelem
(append opelem
(cdr (cdr groupelem
))))))
840 (dolist (elem opelem
)
841 (when (eq (car elem
) 'option
)
842 (when (cdr (assq :selected
(cdr elem
)))
843 (nconc menu
(list :value
844 (cdr (assq :value
(cdr elem
))))))
845 (let ((display (or (cdr (assq 'text
(cdr elem
))) "")))
846 (setq max
(max max
(length display
)))
848 :value
(cdr (assq :value
(cdr elem
)))
852 (setq options
(nreverse options
))
853 ;; If we have no selected values, default to the first value.
854 (unless (plist-get menu
:value
)
855 (nconc menu
(list :value
(nth 2 (car options
)))))
857 (let ((selected (eww-select-display menu
)))
859 (make-string (- max
(length selected
)) ?
)))
860 (put-text-property start
(point) 'eww-form menu
)
861 (add-face-text-property start
(point) 'eww-form-select
)
862 (put-text-property start
(point) 'keymap eww-select-map
)
863 (unless (= start
(point))
864 (put-text-property start
(1+ start
) 'help-echo
"select field"))
865 (shr-ensure-paragraph))))
867 (defun eww-select-display (select)
868 (let ((value (plist-get select
:value
))
870 (dolist (elem select
)
871 (when (and (consp elem
)
872 (eq (car elem
) 'item
)
873 (equal value
(plist-get (cdr elem
) :value
)))
874 (setq display
(plist-get (cdr elem
) :display
))))
877 (defun eww-change-select ()
878 "Change the value of the select drop-down menu under point."
880 (let* ((input (get-text-property (point) 'eww-form
))
881 (completion-ignore-case t
)
884 (mapcar (lambda (elem)
886 (eq (car elem
) 'item
)
887 (cons (plist-get (cdr elem
) :display
)
888 (plist-get (cdr elem
) :value
))))
891 (completing-read "Change value: " options nil
'require-match
))
892 (inhibit-read-only t
))
893 (plist-put input
:value
(cdr (assoc-string display options t
)))
895 (eww-update-field display
))))
897 (defun eww-update-field (string)
898 (let ((properties (text-properties-at (point)))
899 (start (eww-beginning-of-field))
900 (end (1+ (eww-end-of-field))))
901 (delete-region start end
)
903 (make-string (- (- end start
) (length string
)) ?
))
904 (set-text-properties start end properties
)
907 (defun eww-toggle-checkbox ()
908 "Toggle the value of the checkbox under point."
910 (let* ((input (get-text-property (point) 'eww-form
))
911 (type (plist-get input
:type
)))
912 (if (equal type
"checkbox")
915 (if (plist-get input
:checked
)
917 (plist-put input
:checked nil
)
918 (eww-update-field eww-form-checkbox-symbol
))
919 (plist-put input
:checked t
)
920 (eww-update-field eww-form-checkbox-selected-symbol
))))
921 ;; Radio button. Switch all other buttons off.
922 (let ((name (plist-get input
:name
)))
924 (dolist (elem (eww-inputs (plist-get input
:eww-form
)))
925 (when (equal (plist-get (cdr elem
) :name
) name
)
926 (goto-char (car elem
))
927 (if (not (eq (cdr elem
) input
))
929 (plist-put input
:checked nil
)
930 (eww-update-field eww-form-checkbox-symbol
))
931 (plist-put input
:checked t
)
932 (eww-update-field eww-form-checkbox-selected-symbol
)))))
935 (defun eww-inputs (form)
936 (let ((start (point-min))
939 (< start
(point-max)))
940 (when (or (get-text-property start
'eww-form
)
941 (setq start
(next-single-property-change start
'eww-form
)))
942 (when (eq (plist-get (get-text-property start
'eww-form
) :eww-form
)
944 (push (cons start
(get-text-property start
'eww-form
))
946 (setq start
(next-single-property-change start
'eww-form
))))
949 (defun eww-input-value (input)
950 (let ((type (plist-get input
:type
))
951 (value (plist-get input
:value
)))
953 ((equal type
"textarea")
956 (goto-char (point-min))
957 (while (re-search-forward "^ +\n\\| +$" nil t
)
958 (replace-match "" t t
))
961 (if (string-match " +\\'" value
)
962 (substring value
0 (match-beginning 0))
966 "Submit the current form."
968 (let* ((this-input (get-text-property (point) 'eww-form
))
969 (form (plist-get this-input
:eww-form
))
971 (dolist (elem (sort (eww-inputs form
)
973 (< (car o1
) (car o2
)))))
974 (let* ((input (cdr elem
))
975 (input-start (car elem
))
976 (name (plist-get input
:name
)))
979 ((member (plist-get input
:type
) '("checkbox" "radio"))
980 (when (plist-get input
:checked
)
981 (push (cons name
(plist-get input
:value
))
983 ((equal (plist-get input
:type
) "submit")
984 ;; We want the values from buttons if we hit a button if
985 ;; we hit enter on it, or if it's the first button after
986 ;; the field we did hit return on.
987 (when (or (eq input this-input
)
988 (and (not (eq input this-input
))
990 (> input-start
(point))))
992 (push (cons name
(plist-get input
:value
))
995 (push (cons name
(eww-input-value input
))
998 (when (and (consp elem
)
999 (eq (car elem
) 'hidden
))
1000 (push (cons (plist-get (cdr elem
) :name
)
1001 (plist-get (cdr elem
) :value
))
1003 (if (and (stringp (cdr (assq :method form
)))
1004 (equal (downcase (cdr (assq :method form
))) "post"))
1005 (let ((url-request-method "POST")
1006 (url-request-extra-headers
1007 '(("Content-Type" .
"application/x-www-form-urlencoded")))
1008 (url-request-data (mm-url-encode-www-form-urlencoded values
)))
1009 (eww-browse-url (shr-expand-url (cdr (assq :action form
))
1013 (if (cdr (assq :action form
))
1014 (shr-expand-url (cdr (assq :action form
))
1018 (mm-url-encode-www-form-urlencoded values
))))))
1020 (defun eww-browse-with-external-browser (&optional url
)
1021 "Browse the current URL with an external browser.
1022 The browser to used is specified by the `shr-external-browser' variable."
1024 (funcall shr-external-browser
(or url eww-current-url
)))
1026 (defun eww-follow-link (&optional external mouse-event
)
1027 "Browse the URL under point.
1028 If EXTERNAL, browse the URL using `shr-external-browser'."
1029 (interactive (list current-prefix-arg last-nonmenu-event
))
1030 (mouse-set-point mouse-event
)
1031 (let ((url (get-text-property (point) 'shr-url
)))
1034 (message "No link under point"))
1035 ((string-match "^mailto:" url
)
1036 (browse-url-mail url
))
1038 (funcall shr-external-browser url
))
1039 ;; This is a #target url in the same page as the current one.
1040 ((and (url-target (url-generic-parse-url url
))
1041 (eww-same-page-p url eww-current-url
))
1043 (eww-display-html 'utf8 url eww-current-dom
))
1045 (eww-browse-url url
)))))
1047 (defun eww-same-page-p (url1 url2
)
1048 "Return non-nil if both URLs represent the same page.
1049 Differences in #targets are ignored."
1050 (let ((obj1 (url-generic-parse-url url1
))
1051 (obj2 (url-generic-parse-url url2
)))
1052 (setf (url-target obj1
) nil
)
1053 (setf (url-target obj2
) nil
)
1054 (equal (url-recreate-url obj1
) (url-recreate-url obj2
))))
1056 (defun eww-copy-page-url ()
1058 (message "%s" eww-current-url
)
1059 (kill-new eww-current-url
))
1061 (defun eww-download ()
1062 "Download URL under point to `eww-download-directory'."
1064 (let ((url (get-text-property (point) 'shr-url
)))
1066 (message "No URL under point")
1067 (url-retrieve url
'eww-download-callback
(list url
)))))
1069 (defun eww-download-callback (status url
)
1070 (unless (plist-get status
:error
)
1071 (let* ((obj (url-generic-parse-url url
))
1072 (path (car (url-path-and-query obj
)))
1073 (file (eww-make-unique-file-name (file-name-nondirectory path
)
1074 eww-download-path
)))
1076 (message "Saved %s" file
))))
1078 (defun eww-make-unique-file-name (file directory
)
1080 ((zerop (length file
))
1082 ((string-match "\\`[.]" file
)
1083 (setq file
(concat "!" file
))))
1085 (while (file-exists-p (expand-file-name file directory
))
1087 (if (string-match "\\`\\(.*\\)\\([.][^.]+\\)" file
)
1088 (format "%s(%d)%s" (match-string 1 file
)
1089 count
(match-string 2 file
))
1090 (format "%s(%d)" file count
)))
1091 (setq count
(1+ count
)))
1092 (expand-file-name file directory
)))
1096 (defvar eww-bookmarks nil
)
1098 (defun eww-add-bookmark ()
1099 "Add the current page to the bookmarks."
1101 (eww-read-bookmarks)
1102 (dolist (bookmark eww-bookmarks
)
1103 (when (equal eww-current-url
1104 (plist-get bookmark
:url
))
1105 (user-error "Already bookmarked")))
1106 (if (y-or-n-p "bookmark this page? ")
1108 (let ((title (replace-regexp-in-string "[\n\t\r]" " " eww-current-title
)))
1109 (setq title
(replace-regexp-in-string "\\` +\\| +\\'" "" title
))
1110 (push (list :url eww-current-url
1112 :time
(current-time-string))
1114 (eww-write-bookmarks)
1115 (message "Bookmarked %s (%s)" eww-current-url eww-current-title
))))
1117 (defun eww-write-bookmarks ()
1118 (with-temp-file (expand-file-name "eww-bookmarks" user-emacs-directory
)
1119 (insert ";; Auto-generated file; don't edit\n")
1120 (pp eww-bookmarks
(current-buffer))))
1122 (defun eww-read-bookmarks ()
1123 (let ((file (expand-file-name "eww-bookmarks" user-emacs-directory
)))
1125 (unless (zerop (or (nth 7 (file-attributes file
)) 0))
1127 (insert-file-contents file
)
1128 (read (current-buffer)))))))
1130 (defun eww-list-bookmarks ()
1131 "Display the bookmarks."
1133 (eww-bookmark-prepare)
1134 (pop-to-buffer "*eww bookmarks*"))
1136 (defun eww-bookmark-prepare ()
1137 (eww-read-bookmarks)
1138 (unless eww-bookmarks
1139 (user-error "No bookmarks are defined"))
1140 (set-buffer (get-buffer-create "*eww bookmarks*"))
1142 (let ((format "%-40s %s")
1143 (inhibit-read-only t
)
1146 (setq header-line-format
(concat " " (format format
"URL" "Title")))
1147 (dolist (bookmark eww-bookmarks
)
1148 (setq start
(point))
1149 (setq url
(plist-get bookmark
:url
))
1150 (when (> (length url
) 40)
1151 (setq url
(substring url
0 40)))
1152 (insert (format format url
1153 (plist-get bookmark
:title
))
1155 (put-text-property start
(1+ start
) 'eww-bookmark bookmark
))
1156 (goto-char (point-min))))
1158 (defvar eww-bookmark-kill-ring nil
)
1160 (defun eww-bookmark-kill ()
1161 "Kill the current bookmark."
1163 (let* ((start (line-beginning-position))
1164 (bookmark (get-text-property start
'eww-bookmark
))
1165 (inhibit-read-only t
))
1167 (user-error "No bookmark on the current line"))
1169 (push (buffer-substring start
(point)) eww-bookmark-kill-ring
)
1170 (delete-region start
(point))
1171 (setq eww-bookmarks
(delq bookmark eww-bookmarks
))
1172 (eww-write-bookmarks)))
1174 (defun eww-bookmark-yank ()
1175 "Yank a previously killed bookmark to the current line."
1177 (unless eww-bookmark-kill-ring
1178 (user-error "No previously killed bookmark"))
1180 (let ((inhibit-read-only t
)
1183 (insert (pop eww-bookmark-kill-ring
))
1184 (setq bookmark
(get-text-property start
'eww-bookmark
))
1185 (if (= start
(point-min))
1186 (push bookmark eww-bookmarks
)
1187 (let ((line (count-lines start
(point))))
1188 (setcdr (nthcdr (1- line
) eww-bookmarks
)
1189 (cons bookmark
(nthcdr line eww-bookmarks
)))))
1190 (eww-write-bookmarks)))
1192 (defun eww-bookmark-browse ()
1193 "Browse the bookmark under point in eww."
1195 (let ((bookmark (get-text-property (line-beginning-position) 'eww-bookmark
)))
1197 (user-error "No bookmark on the current line"))
1199 (eww-browse-url (plist-get bookmark
:url
))))
1201 (defun eww-next-bookmark ()
1202 "Go to the next bookmark in the list."
1206 (unless (get-buffer "*eww bookmarks*")
1208 (eww-bookmark-prepare))
1209 (with-current-buffer (get-buffer "*eww bookmarks*")
1210 (when (and (not first
)
1213 (setq bookmark
(get-text-property (line-beginning-position)
1216 (user-error "No next bookmark")))
1217 (eww-browse-url (plist-get bookmark
:url
))))
1219 (defun eww-previous-bookmark ()
1220 "Go to the previous bookmark in the list."
1224 (unless (get-buffer "*eww bookmarks*")
1226 (eww-bookmark-prepare))
1227 (with-current-buffer (get-buffer "*eww bookmarks*")
1229 (goto-char (point-max))
1230 (beginning-of-line))
1231 ;; On the final line.
1235 (user-error "No previous bookmark")
1237 (setq bookmark
(get-text-property (line-beginning-position)
1239 (eww-browse-url (plist-get bookmark
:url
))))
1241 (defvar eww-bookmark-mode-map
1242 (let ((map (make-sparse-keymap)))
1243 (suppress-keymap map
)
1244 (define-key map
"q" 'quit-window
)
1245 (define-key map
[(control k
)] 'eww-bookmark-kill
)
1246 (define-key map
[(control y
)] 'eww-bookmark-yank
)
1247 (define-key map
"\r" 'eww-bookmark-browse
)
1249 (easy-menu-define nil map
1250 "Menu for `eww-bookmark-mode-map'."
1252 ["Exit" quit-window t
]
1253 ["Browse" eww-bookmark-browse
1254 :active
(get-text-property (line-beginning-position) 'eww-bookmark
)]
1255 ["Kill" eww-bookmark-kill
1256 :active
(get-text-property (line-beginning-position) 'eww-bookmark
)]
1257 ["Yank" eww-bookmark-yank
1258 :active eww-bookmark-kill-ring
]))
1261 (define-derived-mode eww-bookmark-mode nil
"eww bookmarks"
1262 "Mode for listing bookmarks.
1264 \\{eww-bookmark-mode-map}"
1265 (buffer-disable-undo)
1266 (setq buffer-read-only t
1271 (defun eww-save-history ()
1272 (push (list :url eww-current-url
1273 :title eww-current-title
1275 :dom eww-current-dom
1276 :source eww-current-source
1277 :text
(buffer-string))
1280 (defun eww-list-histories ()
1281 "List the eww-histories."
1283 (when (null eww-history
)
1284 (error "No eww-histories are defined"))
1285 (set-buffer (get-buffer-create "*eww history*"))
1287 (let ((inhibit-read-only t
)
1290 url title format start
)
1292 (dolist (history eww-history
)
1293 (setq start
(point))
1294 (setq domain-length
(max domain-length
(length (plist-get history
:url
))))
1295 (setq title-length
(max title-length
(length (plist-get history
:title
))))
1297 (setq format
(format "%%-%ds %%-%ds" title-length domain-length
)
1299 (concat " " (format format
"Title" "URL")))
1301 (dolist (history eww-history
)
1302 (setq url
(plist-get history
:url
))
1303 (setq title
(plist-get history
:title
))
1304 (insert (format format title url
))
1306 (put-text-property start
(point) 'eww-history history
)
1308 (goto-char (point-min)))
1309 (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 (pop-to-buffer "*eww*")
1320 (eww-browse-url (plist-get history
:url
))))
1322 (defun eww-history-quit ()
1323 "Kill the current buffer."
1325 (kill-buffer (current-buffer)))
1327 (defvar eww-history-kill-ring nil
)
1329 (defun eww-history-kill ()
1330 "Kill the current history."
1332 (let* ((start (line-beginning-position))
1333 (history (get-text-property start
'eww-history
))
1334 (inhibit-read-only t
))
1336 (error "No history on the current line"))
1338 (push (buffer-substring start
(point)) eww-history-kill-ring
)
1339 (delete-region start
(point))
1340 (setq eww-history
(delq history eww-history
))
1343 (defvar eww-history-mode-map
1344 (let ((map (make-sparse-keymap)))
1345 (suppress-keymap map
)
1346 (define-key map
"q" 'eww-history-quit
)
1347 (define-key map
[(control k
)] 'eww-history-kill
)
1348 (define-key map
"\r" 'eww-history-browse
)
1349 (define-key map
"n" 'next-error-no-select
)
1350 (define-key map
"p" 'previous-error-no-select
)
1353 (define-derived-mode eww-history-mode nil
"eww history"
1354 "Mode for listing eww-histories.
1356 \\{eww-history-mode-map}"
1357 (buffer-disable-undo)
1358 (setq buffer-read-only t
1363 ;;; eww.el ends here