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-bookmarks-directory user-emacs-directory
61 "Directory where bookmark files will be stored."
66 (defcustom eww-use-external-browser-for-content-type
67 "\\`\\(video/\\|audio/\\|application/ogg\\)"
68 "Always use external browser for specified content-type."
71 :type '(choice (const :tag "Never" nil)
74 (defcustom eww-form-checkbox-selected-symbol "[X]"
75 "Symbol used to represent a selected checkbox.
76 See also `eww-form-checkbox-symbol'."
79 :type '(choice (const "[X]")
80 (const "☒") ; Unicode BALLOT BOX WITH X
81 (const "☑") ; Unicode BALLOT BOX WITH CHECK
84 (defcustom eww-form-checkbox-symbol "[ ]"
85 "Symbol used to represent a checkbox.
86 See also `eww-form-checkbox-selected-symbol'."
89 :type '(choice (const "[ ]")
90 (const "☐") ; Unicode BALLOT BOX
93 (defface eww-form-submit
94 '((((type x w32 ns) (class color)) ; Like default mode line
95 :box (:line-width 2 :style released-button)
96 :background "#808080" :foreground "black"))
97 "Face for eww buffer buttons."
101 (defface eww-form-checkbox
102 '((((type x w32 ns) (class color)) ; Like default mode line
103 :box (:line-width 2 :style released-button)
104 :background "lightgrey" :foreground "black"))
105 "Face for eww buffer buttons."
109 (defface eww-form-select
110 '((((type x w32 ns) (class color)) ; Like default mode line
111 :box (:line-width 2 :style released-button)
112 :background "lightgrey" :foreground "black"))
113 "Face for eww buffer buttons."
117 (defface eww-form-text
118 '((t (:background "#505050"
120 :box (:line-width 1))))
121 "Face for eww text inputs."
125 (defface eww-form-textarea
126 '((t (:background "#C0C0C0"
128 :box (:line-width 1))))
129 "Face for eww textarea inputs."
133 (defvar eww-current-url nil)
134 (defvar eww-current-dom nil)
135 (defvar eww-current-source nil)
136 (defvar eww-current-title ""
137 "Title of current page.")
138 (defvar eww-history nil)
139 (defvar eww-history-position 0)
141 (defvar eww-next-url nil)
142 (defvar eww-previous-url nil)
143 (defvar eww-up-url nil)
144 (defvar eww-home-url nil)
145 (defvar eww-start-url nil)
146 (defvar eww-contents-url nil)
148 (defvar eww-local-regex "localhost"
149 "When this regex is found in the URL, it's not a keyword but an address.")
151 (defvar eww-link-keymap
152 (let ((map (copy-keymap shr-map)))
153 (define-key map "\r" 'eww-follow-link)
158 "Fetch URL and render the page.
159 If the input doesn't look like an URL or a domain name, the
160 word(s) will be searched for via `eww-search-prefix'."
161 (interactive "sEnter URL or keywords: ")
162 (cond ((string-match-p "\\`file:/" url))
163 ((string-match-p "\\`ftp://" url)
164 (user-error "FTP is not supported."))
166 (if (and (= (length (split-string url)) 1)
167 (or (and (not (string-match-p "\\`[\"\'].*[\"\']\\'" url))
168 (> (length (split-string url "[.:]")) 1))
169 (string-match eww-local-regex url)))
171 (unless (string-match-p "\\`[a-zA-Z][-a-zA-Z0-9+.]*://" url)
172 (setq url (concat "http://" url)))
173 ;; some site don't redirect final /
174 (when (string= (url-filename (url-generic-parse-url url)) "")
175 (setq url (concat url "/"))))
176 (setq url (concat eww-search-prefix
177 (replace-regexp-in-string " " "+" url))))))
178 (url-retrieve url 'eww-render (list url)))
180 ;;;###autoload (defalias 'browse-web 'eww)
183 (defun eww-open-file (file)
184 "Render a file using EWW."
185 (interactive "fFile: ")
186 (eww (concat "file://"
187 (and (memq system-type '(windows-nt ms-dos))
189 (expand-file-name file))))
191 (defun eww-render (status url &optional point)
192 (let ((redirect (plist-get status :redirect)))
194 (setq url redirect)))
195 (let* ((headers (eww-parse-headers))
197 (mail-header-parse-content-type
198 (or (cdr (assoc "content-type" headers))
202 (or (cdr (assq 'charset (cdr content-type)))
203 (eww-detect-charset (equal (car content-type)
206 (data-buffer (current-buffer)))
209 (setq eww-current-title "")
211 ((and eww-use-external-browser-for-content-type
212 (string-match-p eww-use-external-browser-for-content-type
214 (eww-browse-with-external-browser url))
215 ((equal (car content-type) "text/html")
216 (eww-display-html charset url nil point))
217 ((string-match-p "\\`image/" (car content-type))
219 (eww-update-header-line-format))
222 (eww-update-header-line-format)))
223 (setq eww-current-url url
224 eww-history-position 0))
225 (kill-buffer data-buffer))))
227 (defun eww-parse-headers ()
229 (goto-char (point-min))
230 (while (and (not (eobp))
232 (when (looking-at "\\([^:]+\\): *\\(.*\\)")
233 (push (cons (downcase (match-string 1))
241 (defun eww-detect-charset (html-p)
242 (let ((case-fold-search t)
246 "<meta[\t\n\r ]+[^>]*charset=\"?\\([^\t\n\r \"/>]+\\)[\\\"'.*]" nil t)
250 "[\t\n\r ]*<\\?xml[\t\n\r ]+[^>]*encoding=\"\\([^\"]+\\)")
253 (declare-function libxml-parse-html-region "xml.c"
254 (start end &optional base-url))
256 (defun eww-display-html (charset url &optional document point)
257 (or (fboundp 'libxml-parse-html-region)
258 (error "This function requires Emacs to be compiled with libxml2"))
259 (unless (eq charset 'utf8)
261 (decode-coding-region (point) (point-max) charset)
262 (coding-system-error nil)))
266 'base (list (cons 'href url))
267 (libxml-parse-html-region (point) (point-max)))))
268 (source (buffer-substring (point) (point-max))))
270 (setq eww-current-source source
271 eww-current-dom document)
272 (let ((inhibit-read-only t)
273 (after-change-functions nil)
274 (shr-target-id (url-target (url-generic-parse-url url)))
275 (shr-external-rendering-functions
276 '((title . eww-tag-title)
277 (form . eww-tag-form)
278 (input . eww-tag-input)
279 (textarea . eww-tag-textarea)
280 (body . eww-tag-body)
281 (select . eww-tag-select)
282 (link . eww-tag-link)
284 (shr-insert-document document)
289 (goto-char (point-min))
290 (let ((point (next-single-property-change
291 (point-min) 'shr-target-id)))
295 (goto-char (point-min)))))
296 (setq eww-current-url url
297 eww-history-position 0)
298 (eww-update-header-line-format)))
300 (defun eww-handle-link (cont)
301 (let* ((rel (assq :rel cont))
302 (href (assq :href cont))
304 ;; The text associated with :rel is case-insensitive.
305 (if rel (downcase (cdr rel)))
306 '(("next" . eww-next-url)
307 ;; Texinfo uses "previous", but HTML specifies
308 ;; "prev", so recognize both.
309 ("previous" . eww-previous-url)
310 ("prev" . eww-previous-url)
311 ;; HTML specifies "start" but also "contents",
312 ;; and Gtk seems to use "home". Recognize
313 ;; them all; but store them in different
314 ;; variables so that we can readily choose the
316 ("start" . eww-start-url)
317 ("home" . eww-home-url)
318 ("contents" . eww-contents-url)
319 ("up" . eww-up-url)))))
322 (set (cdr where) (cdr href)))))
324 (defun eww-tag-link (cont)
325 (eww-handle-link cont)
328 (defun eww-tag-a (cont)
329 (eww-handle-link cont)
330 (let ((start (point)))
332 (put-text-property start (point) 'keymap eww-link-keymap)))
334 (defun eww-update-header-line-format ()
335 (if eww-header-line-format
336 (setq header-line-format
337 (replace-regexp-in-string
339 ;; FIXME? Title can be blank. Default to, eg, last component
341 (format-spec eww-header-line-format
342 `((?u . ,eww-current-url)
343 (?t . ,eww-current-title)))))
344 (setq header-line-format nil)))
346 (defun eww-tag-title (cont)
347 (setq eww-current-title "")
349 (when (eq (car sub) 'text)
350 (setq eww-current-title (concat eww-current-title (cdr sub)))))
351 (eww-update-header-line-format))
353 (defun eww-tag-body (cont)
354 (let* ((start (point))
355 (fgcolor (cdr (or (assq :fgcolor cont)
357 (bgcolor (cdr (assq :bgcolor cont)))
358 (shr-stylesheet (list (cons 'color fgcolor)
359 (cons 'background-color bgcolor))))
361 (eww-colorize-region start (point) fgcolor bgcolor)))
363 (defun eww-colorize-region (start end fg &optional bg)
365 (let ((new-colors (shr-color-check fg bg)))
368 (add-face-text-property start end
369 (list :foreground (cadr new-colors))
372 (add-face-text-property start end
373 (list :background (car new-colors))
376 (defun eww-display-raw ()
377 (let ((data (buffer-substring (point) (point-max))))
379 (let ((inhibit-read-only t))
381 (goto-char (point-min))))
383 (defun eww-display-image ()
384 (let ((data (shr-parse-image-data)))
386 (let ((inhibit-read-only t))
387 (shr-put-image data nil))
388 (goto-char (point-min))))
390 (defun eww-setup-buffer ()
391 (switch-to-buffer (get-buffer-create "*eww*"))
392 (let ((inhibit-read-only t))
395 (unless (eq major-mode 'eww-mode)
397 (setq-local eww-next-url nil)
398 (setq-local eww-previous-url nil)
399 (setq-local eww-up-url nil)
400 (setq-local eww-home-url nil)
401 (setq-local eww-start-url nil)
402 (setq-local eww-contents-url nil))
404 (defun eww-view-source ()
406 (let ((buf (get-buffer-create "*eww-source*"))
407 (source eww-current-source))
408 (with-current-buffer buf
409 (delete-region (point-min) (point-max))
410 (insert (or source "no source"))
411 (goto-char (point-min))
412 (when (fboundp 'html-mode)
417 (let ((map (make-sparse-keymap)))
418 (suppress-keymap map)
419 (define-key map "q" 'quit-window)
420 (define-key map "g" 'eww-reload)
421 (define-key map [?\t] 'shr-next-link)
422 (define-key map [?\M-\t] 'shr-previous-link)
423 (define-key map [delete] 'scroll-down-command)
424 (define-key map [?\S-\ ] 'scroll-down-command)
425 (define-key map "\177" 'scroll-down-command)
426 (define-key map " " 'scroll-up-command)
427 (define-key map "l" 'eww-back-url)
428 (define-key map "r" 'eww-forward-url)
429 (define-key map "n" 'eww-next-url)
430 (define-key map "p" 'eww-previous-url)
431 (define-key map "u" 'eww-up-url)
432 (define-key map "t" 'eww-top-url)
433 (define-key map "&" 'eww-browse-with-external-browser)
434 (define-key map "d" 'eww-download)
435 (define-key map "w" 'eww-copy-page-url)
436 (define-key map "C" 'url-cookie-list)
437 (define-key map "v" 'eww-view-source)
438 (define-key map "H" 'eww-list-histories)
440 (define-key map "b" 'eww-add-bookmark)
441 (define-key map "B" 'eww-list-bookmarks)
442 (define-key map [(meta n)] 'eww-next-bookmark)
443 (define-key map [(meta p)] 'eww-previous-bookmark)
445 (easy-menu-define nil map ""
447 ["Exit" quit-window t]
448 ["Close browser" quit-window t]
449 ["Reload" eww-reload t]
450 ["Back to previous page" eww-back-url
451 :active (not (zerop (length eww-history)))]
452 ["Forward to next page" eww-forward-url
453 :active (not (zerop eww-history-position))]
454 ["Browse with external browser" eww-browse-with-external-browser t]
455 ["Download" eww-download t]
456 ["View page source" eww-view-source]
457 ["Copy page URL" eww-copy-page-url t]
458 ["List histories" eww-list-histories t]
459 ["Add bookmark" eww-add-bookmark t]
460 ["List bookmarks" eww-list-bookmarks t]
461 ["List cookies" url-cookie-list t]))
464 (defvar eww-tool-bar-map
465 (let ((map (make-sparse-keymap)))
466 (dolist (tool-bar-item
467 '((quit-window . "close")
468 (eww-reload . "refresh")
469 (eww-back-url . "left-arrow")
470 (eww-forward-url . "right-arrow")
471 (eww-view-source . "show")
472 (eww-copy-page-url . "copy")
473 (eww-add-bookmark . "bookmark_add"))) ;; ...
474 (tool-bar-local-item-from-menu
475 (car tool-bar-item) (cdr tool-bar-item) map eww-mode-map))
477 "Tool bar for `eww-mode'.")
479 (define-derived-mode eww-mode nil "eww"
480 "Mode for browsing the web.
483 ;; FIXME? This seems a strange default.
484 (setq-local eww-current-url 'author)
485 (setq-local eww-current-dom nil)
486 (setq-local eww-current-source nil)
487 (setq-local eww-current-title "")
488 (setq-local browse-url-browser-function 'eww-browse-url)
489 (setq-local after-change-functions 'eww-process-text-input)
490 (setq-local eww-history nil)
491 (setq-local eww-history-position 0)
492 (when (boundp 'tool-bar-map)
493 (setq-local tool-bar-map eww-tool-bar-map))
494 (buffer-disable-undo)
495 ;;(setq buffer-read-only t)
499 (defun eww-browse-url (url &optional _new-window)
500 (when (and (equal major-mode 'eww-mode)
505 (defun eww-back-url ()
506 "Go to the previously displayed page."
508 (when (>= eww-history-position (length eww-history))
509 (user-error "No previous page"))
511 (setq eww-history-position (+ eww-history-position 2))
512 (eww-restore-history (elt eww-history (1- eww-history-position))))
514 (defun eww-forward-url ()
515 "Go to the next displayed page."
517 (when (zerop eww-history-position)
518 (user-error "No next page"))
520 (eww-restore-history (elt eww-history (1- eww-history-position))))
522 (defun eww-restore-history (elem)
523 (let ((inhibit-read-only t))
525 (insert (plist-get elem :text))
526 (setq eww-current-source (plist-get elem :source))
527 (setq eww-current-dom (plist-get elem :dom))
528 (goto-char (plist-get elem :point))
529 (setq eww-current-url (plist-get elem :url)
530 eww-current-title (plist-get elem :title))
531 (eww-update-header-line-format)))
533 (defun eww-next-url ()
534 "Go to the page marked `next'.
535 A page is marked `next' if rel=\"next\" appears in a <link>
539 (eww-browse-url (shr-expand-url eww-next-url eww-current-url))
540 (user-error "No `next' on this page")))
542 (defun eww-previous-url ()
543 "Go to the page marked `previous'.
544 A page is marked `previous' if rel=\"previous\" appears in a <link>
548 (eww-browse-url (shr-expand-url eww-previous-url eww-current-url))
549 (user-error "No `previous' on this page")))
552 "Go to the page marked `up'.
553 A page is marked `up' if rel=\"up\" appears in a <link>
557 (eww-browse-url (shr-expand-url eww-up-url eww-current-url))
558 (user-error "No `up' on this page")))
560 (defun eww-top-url ()
561 "Go to the page marked `top'.
562 A page is marked `top' if rel=\"start\", rel=\"home\", or rel=\"contents\"
563 appears in a <link> or <a> tag."
565 (let ((best-url (or eww-start-url
569 (eww-browse-url (shr-expand-url best-url eww-current-url))
570 (user-error "No `top' for this page"))))
573 "Reload the current page."
575 (url-retrieve eww-current-url 'eww-render
576 (list eww-current-url (point))))
580 (defvar eww-form nil)
582 (defvar eww-submit-map
583 (let ((map (make-sparse-keymap)))
584 (define-key map "\r" 'eww-submit)
585 (define-key map [(control c) (control c)] 'eww-submit)
588 (defvar eww-checkbox-map
589 (let ((map (make-sparse-keymap)))
590 (define-key map " " 'eww-toggle-checkbox)
591 (define-key map "\r" 'eww-toggle-checkbox)
592 (define-key map [(control c) (control c)] 'eww-submit)
596 (let ((map (make-keymap)))
597 (set-keymap-parent map text-mode-map)
598 (define-key map "\r" 'eww-submit)
599 (define-key map [(control a)] 'eww-beginning-of-text)
600 (define-key map [(control c) (control c)] 'eww-submit)
601 (define-key map [(control e)] 'eww-end-of-text)
602 (define-key map [?\t] 'shr-next-link)
603 (define-key map [?\M-\t] 'shr-previous-link)
606 (defvar eww-textarea-map
607 (let ((map (make-keymap)))
608 (set-keymap-parent map text-mode-map)
609 (define-key map "\r" 'forward-line)
610 (define-key map [(control c) (control c)] 'eww-submit)
611 (define-key map [?\t] 'shr-next-link)
612 (define-key map [?\M-\t] 'shr-previous-link)
615 (defvar eww-select-map
616 (let ((map (make-sparse-keymap)))
617 (define-key map "\r" 'eww-change-select)
618 (define-key map [(control c) (control c)] 'eww-submit)
621 (defun eww-beginning-of-text ()
622 "Move to the start of the input field."
624 (goto-char (eww-beginning-of-field)))
626 (defun eww-end-of-text ()
627 "Move to the end of the text in the input field."
629 (goto-char (eww-end-of-field))
630 (let ((start (eww-beginning-of-field)))
631 (while (and (equal (following-char) ? )
634 (when (> (point) start)
637 (defun eww-beginning-of-field ()
641 ((not (eq (get-text-property (point) 'eww-form)
642 (get-text-property (1- (point)) 'eww-form)))
645 (previous-single-property-change
646 (point) 'eww-form nil (point-min)))))
648 (defun eww-end-of-field ()
649 (1- (next-single-property-change
650 (point) 'eww-form nil (point-max))))
652 (defun eww-tag-form (cont)
654 (list (assq :method cont)
655 (assq :action cont)))
657 (shr-ensure-paragraph)
662 (when (> (point) start)
663 (put-text-property start (1+ start)
664 'eww-form eww-form))))
666 (defun eww-form-submit (cont)
667 (let ((start (point))
668 (value (cdr (assq :value cont))))
670 (if (zerop (length value))
674 (add-face-text-property start (point) 'eww-form-submit)
675 (put-text-property start (point) 'eww-form
676 (list :eww-form eww-form
679 :name (cdr (assq :name cont))))
680 (put-text-property start (point) 'keymap eww-submit-map)
683 (defun eww-form-checkbox (cont)
684 (let ((start (point)))
685 (if (cdr (assq :checked cont))
686 (insert eww-form-checkbox-selected-symbol)
687 (insert eww-form-checkbox-symbol))
688 (add-face-text-property start (point) 'eww-form-checkbox)
689 (put-text-property start (point) 'eww-form
690 (list :eww-form eww-form
691 :value (cdr (assq :value cont))
692 :type (downcase (cdr (assq :type cont)))
693 :checked (cdr (assq :checked cont))
694 :name (cdr (assq :name cont))))
695 (put-text-property start (point) 'keymap eww-checkbox-map)
698 (defun eww-form-text (cont)
699 (let ((start (point))
700 (type (downcase (or (cdr (assq :type cont))
702 (value (or (cdr (assq :value cont)) ""))
703 (width (string-to-number
704 (or (cdr (assq :size cont))
706 (readonly-property (if (or (cdr (assq :disabled cont))
707 (cdr (assq :readonly cont)))
709 'inhibit-read-only)))
711 (when (< (length value) width)
712 (insert (make-string (- width (length value)) ? )))
713 (put-text-property start (point) 'face 'eww-form-text)
714 (put-text-property start (point) 'local-map eww-text-map)
715 (put-text-property start (point) readonly-property t)
716 (put-text-property start (point) 'eww-form
717 (list :eww-form eww-form
720 :name (cdr (assq :name cont))))
723 (defconst eww-text-input-types '("text" "password" "textarea"
724 "color" "date" "datetime" "datetime-local"
725 "email" "month" "number" "search" "tel"
727 "List of input types which represent a text input.
728 See URL `https://developer.mozilla.org/en-US/docs/Web/HTML/Element/Input'.")
730 (defun eww-process-text-input (beg end length)
731 (let* ((form (get-text-property (min (1+ end) (point-max)) 'eww-form))
732 (properties (text-properties-at end))
733 (type (plist-get form :type)))
735 (member type eww-text-input-types))
738 ;; Delete some space at the end.
741 (if (equal type "textarea")
742 (1- (line-end-position))
744 (let ((new (- end beg)))
745 (while (and (> new 0)
746 (eql (following-char) ? ))
747 (delete-region (point) (1+ (point)))
748 (setq new (1- new))))
749 (set-text-properties beg end properties)))
754 (if (equal type "textarea")
755 (1- (line-end-position))
757 (let ((start (point)))
758 (insert (make-string length ? ))
759 (set-text-properties start (point) properties)))))
760 (let ((value (buffer-substring-no-properties
761 (eww-beginning-of-field)
762 (eww-end-of-field))))
763 (when (string-match " +\\'" value)
764 (setq value (substring value 0 (match-beginning 0))))
765 (plist-put form :value value)
766 (when (equal type "password")
767 ;; Display passwords as asterisks.
768 (let ((start (eww-beginning-of-field)))
769 (put-text-property start (+ start (length value))
770 'display (make-string (length value) ?*))))))))
772 (defun eww-tag-textarea (cont)
773 (let ((start (point))
774 (value (or (cdr (assq :value cont)) ""))
775 (lines (string-to-number
776 (or (cdr (assq :rows cont))
778 (width (string-to-number
779 (or (cdr (assq :cols cont))
785 (when (< (count-lines start (point)) lines)
786 (dotimes (i (- lines (count-lines start (point))))
788 (setq end (point-marker))
790 (while (< (point) end)
792 (let ((pad (- width (- (point) (line-beginning-position)))))
794 (insert (make-string pad ? ))))
795 (add-face-text-property (line-beginning-position)
796 (point) 'eww-form-textarea)
797 (put-text-property (line-beginning-position) (point)
798 'local-map eww-textarea-map)
800 (put-text-property start (point) 'eww-form
801 (list :eww-form eww-form
804 :name (cdr (assq :name cont))))))
806 (defun eww-tag-input (cont)
807 (let ((type (downcase (or (cdr (assq :type cont))
811 ((or (equal type "checkbox")
812 (equal type "radio"))
813 (eww-form-checkbox cont))
814 ((equal type "submit")
815 (eww-form-submit cont))
816 ((equal type "hidden")
817 (let ((form eww-form)
818 (name (cdr (assq :name cont))))
819 ;; Don't add <input type=hidden> elements repeatedly.
821 (or (not (consp (car form)))
822 (not (eq (caar form) 'hidden))
823 (not (equal (plist-get (cdr (car form)) :name)
825 (setq form (cdr form)))
827 (nconc eww-form (list
830 :value (cdr (assq :value cont))))))))
832 (eww-form-text cont)))
833 (unless (= start (point))
834 (put-text-property start (1+ start) 'help-echo "Input field"))))
836 (defun eww-tag-select (cont)
837 (shr-ensure-paragraph)
838 (let ((menu (list :name (cdr (assq :name cont))
844 (if (eq (car (car cont)) 'optgroup)
845 (dolist (groupelem cont)
846 (unless (cdr (assq :disabled (cdr groupelem)))
847 (setq opelem (append opelem (cdr (cdr groupelem))))))
849 (dolist (elem opelem)
850 (when (eq (car elem) 'option)
851 (when (cdr (assq :selected (cdr elem)))
852 (nconc menu (list :value
853 (cdr (assq :value (cdr elem))))))
854 (let ((display (or (cdr (assq 'text (cdr elem))) "")))
855 (setq max (max max (length display)))
857 :value (cdr (assq :value (cdr elem)))
861 (setq options (nreverse options))
862 ;; If we have no selected values, default to the first value.
863 (unless (plist-get menu :value)
864 (nconc menu (list :value (nth 2 (car options)))))
866 (let ((selected (eww-select-display menu)))
868 (make-string (- max (length selected)) ? )))
869 (put-text-property start (point) 'eww-form menu)
870 (add-face-text-property start (point) 'eww-form-select)
871 (put-text-property start (point) 'keymap eww-select-map)
872 (unless (= start (point))
873 (put-text-property start (1+ start) 'help-echo "select field"))
874 (shr-ensure-paragraph))))
876 (defun eww-select-display (select)
877 (let ((value (plist-get select :value))
879 (dolist (elem select)
880 (when (and (consp elem)
881 (eq (car elem) 'item)
882 (equal value (plist-get (cdr elem) :value)))
883 (setq display (plist-get (cdr elem) :display))))
886 (defun eww-change-select ()
887 "Change the value of the select drop-down menu under point."
889 (let* ((input (get-text-property (point) 'eww-form))
890 (completion-ignore-case t)
893 (mapcar (lambda (elem)
895 (eq (car elem) 'item)
896 (cons (plist-get (cdr elem) :display)
897 (plist-get (cdr elem) :value))))
900 (completing-read "Change value: " options nil 'require-match))
901 (inhibit-read-only t))
902 (plist-put input :value (cdr (assoc-string display options t)))
904 (eww-update-field display))))
906 (defun eww-update-field (string)
907 (let ((properties (text-properties-at (point)))
908 (start (eww-beginning-of-field))
909 (end (1+ (eww-end-of-field))))
910 (delete-region start end)
912 (make-string (- (- end start) (length string)) ? ))
913 (set-text-properties start end properties)
916 (defun eww-toggle-checkbox ()
917 "Toggle the value of the checkbox under point."
919 (let* ((input (get-text-property (point) 'eww-form))
920 (type (plist-get input :type)))
921 (if (equal type "checkbox")
924 (if (plist-get input :checked)
926 (plist-put input :checked nil)
927 (eww-update-field eww-form-checkbox-symbol))
928 (plist-put input :checked t)
929 (eww-update-field eww-form-checkbox-selected-symbol))))
930 ;; Radio button. Switch all other buttons off.
931 (let ((name (plist-get input :name)))
933 (dolist (elem (eww-inputs (plist-get input :eww-form)))
934 (when (equal (plist-get (cdr elem) :name) name)
935 (goto-char (car elem))
936 (if (not (eq (cdr elem) input))
938 (plist-put input :checked nil)
939 (eww-update-field eww-form-checkbox-symbol))
940 (plist-put input :checked t)
941 (eww-update-field eww-form-checkbox-selected-symbol)))))
944 (defun eww-inputs (form)
945 (let ((start (point-min))
948 (< start (point-max)))
949 (when (or (get-text-property start 'eww-form)
950 (setq start (next-single-property-change start 'eww-form)))
951 (when (eq (plist-get (get-text-property start 'eww-form) :eww-form)
953 (push (cons start (get-text-property start 'eww-form))
955 (setq start (next-single-property-change start 'eww-form))))
958 (defun eww-input-value (input)
959 (let ((type (plist-get input :type))
960 (value (plist-get input :value)))
962 ((equal type "textarea")
965 (goto-char (point-min))
966 (while (re-search-forward "^ +\n\\| +$" nil t)
967 (replace-match "" t t))
970 (if (string-match " +\\'" value)
971 (substring value 0 (match-beginning 0))
975 "Submit the current form."
977 (let* ((this-input (get-text-property (point) 'eww-form))
978 (form (plist-get this-input :eww-form))
980 (dolist (elem (sort (eww-inputs form)
982 (< (car o1) (car o2)))))
983 (let* ((input (cdr elem))
984 (input-start (car elem))
985 (name (plist-get input :name)))
988 ((member (plist-get input :type) '("checkbox" "radio"))
989 (when (plist-get input :checked)
990 (push (cons name (plist-get input :value))
992 ((equal (plist-get input :type) "submit")
993 ;; We want the values from buttons if we hit a button if
994 ;; we hit enter on it, or if it's the first button after
995 ;; the field we did hit return on.
996 (when (or (eq input this-input)
997 (and (not (eq input this-input))
999 (> input-start (point))))
1000 (setq next-submit t)
1001 (push (cons name (plist-get input :value))
1004 (push (cons name (eww-input-value input))
1007 (when (and (consp elem)
1008 (eq (car elem) 'hidden))
1009 (push (cons (plist-get (cdr elem) :name)
1010 (or (plist-get (cdr elem) :value) ""))
1012 (if (and (stringp (cdr (assq :method form)))
1013 (equal (downcase (cdr (assq :method form))) "post"))
1014 (let ((url-request-method "POST")
1015 (url-request-extra-headers
1016 '(("Content-Type" . "application/x-www-form-urlencoded")))
1017 (url-request-data (mm-url-encode-www-form-urlencoded values)))
1018 (eww-browse-url (shr-expand-url (cdr (assq :action form))
1022 (if (cdr (assq :action form))
1023 (shr-expand-url (cdr (assq :action form))
1027 (mm-url-encode-www-form-urlencoded values))))))
1029 (defun eww-browse-with-external-browser (&optional url)
1030 "Browse the current URL with an external browser.
1031 The browser to used is specified by the `shr-external-browser' variable."
1033 (funcall shr-external-browser (or url eww-current-url)))
1035 (defun eww-follow-link (&optional external mouse-event)
1036 "Browse the URL under point.
1037 If EXTERNAL, browse the URL using `shr-external-browser'."
1038 (interactive (list current-prefix-arg last-nonmenu-event))
1039 (mouse-set-point mouse-event)
1040 (let ((url (get-text-property (point) 'shr-url)))
1043 (message "No link under point"))
1044 ((string-match "^mailto:" url)
1045 (browse-url-mail url))
1047 (funcall shr-external-browser url))
1048 ;; This is a #target url in the same page as the current one.
1049 ((and (url-target (url-generic-parse-url url))
1050 (eww-same-page-p url eww-current-url))
1052 (eww-display-html 'utf8 url eww-current-dom))
1054 (eww-browse-url url)))))
1056 (defun eww-same-page-p (url1 url2)
1057 "Return non-nil if both URLs represent the same page.
1058 Differences in #targets are ignored."
1059 (let ((obj1 (url-generic-parse-url url1))
1060 (obj2 (url-generic-parse-url url2)))
1061 (setf (url-target obj1) nil)
1062 (setf (url-target obj2) nil)
1063 (equal (url-recreate-url obj1) (url-recreate-url obj2))))
1065 (defun eww-copy-page-url ()
1067 (message "%s" eww-current-url)
1068 (kill-new eww-current-url))
1070 (defun eww-download ()
1071 "Download URL under point to `eww-download-directory'."
1073 (let ((url (get-text-property (point) 'shr-url)))
1075 (message "No URL under point")
1076 (url-retrieve url 'eww-download-callback (list url)))))
1078 (defun eww-download-callback (status url)
1079 (unless (plist-get status :error)
1080 (let* ((obj (url-generic-parse-url url))
1081 (path (car (url-path-and-query obj)))
1082 (file (eww-make-unique-file-name (file-name-nondirectory path)
1083 eww-download-directory)))
1085 (message "Saved %s" file))))
1087 (defun eww-make-unique-file-name (file directory)
1089 ((zerop (length file))
1091 ((string-match "\\`[.]" file)
1092 (setq file (concat "!" file))))
1094 (while (file-exists-p (expand-file-name file directory))
1096 (if (string-match "\\`\\(.*\\)\\([.][^.]+\\)" file)
1097 (format "%s(%d)%s" (match-string 1 file)
1098 count (match-string 2 file))
1099 (format "%s(%d)" file count)))
1100 (setq count (1+ count)))
1101 (expand-file-name file directory)))
1105 (defvar eww-bookmarks nil)
1107 (defun eww-add-bookmark ()
1108 "Add the current page to the bookmarks."
1110 (eww-read-bookmarks)
1111 (dolist (bookmark eww-bookmarks)
1112 (when (equal eww-current-url
1113 (plist-get bookmark :url))
1114 (user-error "Already bookmarked")))
1115 (if (y-or-n-p "bookmark this page? ")
1117 (let ((title (replace-regexp-in-string "[\n\t\r]" " " eww-current-title)))
1118 (setq title (replace-regexp-in-string "\\` +\\| +\\'" "" title))
1119 (push (list :url eww-current-url
1121 :time (current-time-string))
1123 (eww-write-bookmarks)
1124 (message "Bookmarked %s (%s)" eww-current-url eww-current-title))))
1126 (defun eww-write-bookmarks ()
1127 (with-temp-file (expand-file-name "eww-bookmarks" eww-bookmarks-directory)
1128 (insert ";; Auto-generated file; don't edit\n")
1129 (pp eww-bookmarks (current-buffer))))
1131 (defun eww-read-bookmarks ()
1132 (let ((file (expand-file-name "eww-bookmarks" eww-bookmarks-directory)))
1134 (unless (zerop (or (nth 7 (file-attributes file)) 0))
1136 (insert-file-contents file)
1137 (read (current-buffer)))))))
1139 (defun eww-list-bookmarks ()
1140 "Display the bookmarks."
1142 (eww-bookmark-prepare)
1143 (pop-to-buffer "*eww bookmarks*"))
1145 (defun eww-bookmark-prepare ()
1146 (eww-read-bookmarks)
1147 (unless eww-bookmarks
1148 (user-error "No bookmarks are defined"))
1149 (set-buffer (get-buffer-create "*eww bookmarks*"))
1151 (let ((format "%-40s %s")
1152 (inhibit-read-only t)
1155 (setq header-line-format (concat " " (format format "URL" "Title")))
1156 (dolist (bookmark eww-bookmarks)
1157 (setq start (point))
1158 (setq url (plist-get bookmark :url))
1159 (when (> (length url) 40)
1160 (setq url (substring url 0 40)))
1161 (insert (format format url
1162 (plist-get bookmark :title))
1164 (put-text-property start (1+ start) 'eww-bookmark bookmark))
1165 (goto-char (point-min))))
1167 (defvar eww-bookmark-kill-ring nil)
1169 (defun eww-bookmark-kill ()
1170 "Kill the current bookmark."
1172 (let* ((start (line-beginning-position))
1173 (bookmark (get-text-property start 'eww-bookmark))
1174 (inhibit-read-only t))
1176 (user-error "No bookmark on the current line"))
1178 (push (buffer-substring start (point)) eww-bookmark-kill-ring)
1179 (delete-region start (point))
1180 (setq eww-bookmarks (delq bookmark eww-bookmarks))
1181 (eww-write-bookmarks)))
1183 (defun eww-bookmark-yank ()
1184 "Yank a previously killed bookmark to the current line."
1186 (unless eww-bookmark-kill-ring
1187 (user-error "No previously killed bookmark"))
1189 (let ((inhibit-read-only t)
1192 (insert (pop eww-bookmark-kill-ring))
1193 (setq bookmark (get-text-property start 'eww-bookmark))
1194 (if (= start (point-min))
1195 (push bookmark eww-bookmarks)
1196 (let ((line (count-lines start (point))))
1197 (setcdr (nthcdr (1- line) eww-bookmarks)
1198 (cons bookmark (nthcdr line eww-bookmarks)))))
1199 (eww-write-bookmarks)))
1201 (defun eww-bookmark-browse ()
1202 "Browse the bookmark under point in eww."
1204 (let ((bookmark (get-text-property (line-beginning-position) 'eww-bookmark)))
1206 (user-error "No bookmark on the current line"))
1208 (eww-browse-url (plist-get bookmark :url))))
1210 (defun eww-next-bookmark ()
1211 "Go to the next bookmark in the list."
1215 (unless (get-buffer "*eww bookmarks*")
1217 (eww-bookmark-prepare))
1218 (with-current-buffer (get-buffer "*eww bookmarks*")
1219 (when (and (not first)
1222 (setq bookmark (get-text-property (line-beginning-position)
1225 (user-error "No next bookmark")))
1226 (eww-browse-url (plist-get bookmark :url))))
1228 (defun eww-previous-bookmark ()
1229 "Go to the previous bookmark in the list."
1233 (unless (get-buffer "*eww bookmarks*")
1235 (eww-bookmark-prepare))
1236 (with-current-buffer (get-buffer "*eww bookmarks*")
1238 (goto-char (point-max))
1239 (beginning-of-line))
1240 ;; On the final line.
1244 (user-error "No previous bookmark")
1246 (setq bookmark (get-text-property (line-beginning-position)
1248 (eww-browse-url (plist-get bookmark :url))))
1250 (defvar eww-bookmark-mode-map
1251 (let ((map (make-sparse-keymap)))
1252 (suppress-keymap map)
1253 (define-key map "q" 'quit-window)
1254 (define-key map [(control k)] 'eww-bookmark-kill)
1255 (define-key map [(control y)] 'eww-bookmark-yank)
1256 (define-key map "\r" 'eww-bookmark-browse)
1258 (easy-menu-define nil map
1259 "Menu for `eww-bookmark-mode-map'."
1261 ["Exit" quit-window t]
1262 ["Browse" eww-bookmark-browse
1263 :active (get-text-property (line-beginning-position) 'eww-bookmark)]
1264 ["Kill" eww-bookmark-kill
1265 :active (get-text-property (line-beginning-position) 'eww-bookmark)]
1266 ["Yank" eww-bookmark-yank
1267 :active eww-bookmark-kill-ring]))
1270 (define-derived-mode eww-bookmark-mode nil "eww bookmarks"
1271 "Mode for listing bookmarks.
1273 \\{eww-bookmark-mode-map}"
1274 (buffer-disable-undo)
1275 (setq buffer-read-only t
1280 (defun eww-save-history ()
1281 (push (list :url eww-current-url
1282 :title eww-current-title
1284 :dom eww-current-dom
1285 :source eww-current-source
1286 :text (buffer-string))
1289 (defun eww-list-histories ()
1290 "List the eww-histories."
1292 (when (null eww-history)
1293 (error "No eww-histories are defined"))
1294 (let ((eww-history-trans eww-history))
1295 (set-buffer (get-buffer-create "*eww history*"))
1297 (let ((inhibit-read-only t)
1300 url title format start)
1302 (dolist (history eww-history-trans)
1303 (setq start (point))
1304 (setq domain-length (max domain-length (length (plist-get history :url))))
1305 (setq title-length (max title-length (length (plist-get history :title)))))
1306 (setq format (format "%%-%ds %%-%ds" title-length domain-length)
1308 (concat " " (format format "Title" "URL")))
1309 (dolist (history eww-history-trans)
1310 (setq start (point))
1311 (setq url (plist-get history :url))
1312 (setq title (plist-get history :title))
1313 (insert (format format title url))
1315 (put-text-property start (1+ start) 'eww-history history))
1316 (goto-char (point-min)))
1317 (pop-to-buffer "*eww history*")))
1319 (defun eww-history-browse ()
1320 "Browse the history under point in eww."
1322 (let ((history (get-text-property (line-beginning-position) 'eww-history)))
1324 (error "No history on the current line"))
1326 (eww-restore-history history)))
1328 (defvar eww-history-mode-map
1329 (let ((map (make-sparse-keymap)))
1330 (suppress-keymap map)
1331 (define-key map "q" 'quit-window)
1332 (define-key map "\r" 'eww-history-browse)
1333 ;; (define-key map "n" 'next-error-no-select)
1334 ;; (define-key map "p" 'previous-error-no-select)
1336 (easy-menu-define nil map
1337 "Menu for `eww-history-mode-map'."
1339 ["Exit" quit-window t]
1340 ["Browse" eww-history-browse
1341 :active (get-text-property (line-beginning-position) 'eww-history)]))
1344 (define-derived-mode eww-history-mode nil "eww history"
1345 "Mode for listing eww-histories.
1347 \\{eww-history-mode-map}"
1348 (buffer-disable-undo)
1349 (setq buffer-read-only t
1354 ;;; eww.el ends here