1 ;;; eww.el --- Emacs Web Wowser
3 ;; Copyright (C) 2013 Free Software Foundation, Inc.
5 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
8 ;; This file is part of GNU Emacs.
10 ;; GNU Emacs is free software: you can redistribute it and/or modify
11 ;; it under the terms of the GNU General Public License as published by
12 ;; the Free Software Foundation, either version 3 of the License, or
13 ;; (at your option) any later version.
15 ;; GNU Emacs is distributed in the hope that it will be useful,
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18 ;; GNU General Public License for more details.
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
27 (eval-when-compile (require 'cl
))
28 (require 'format-spec
)
39 (defcustom eww-header-line-format
"%t: %u"
41 - %t is replaced by the title.
42 - %u is replaced by the URL."
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 (defface eww-form-submit
60 '((((type x w32 ns
) (class color
)) ; Like default mode line
61 :box
(:line-width
2 :style released-button
)
62 :background
"#808080" :foreground
"black"))
63 "Face for eww buffer buttons."
67 (defface eww-form-checkbox
68 '((((type x w32 ns
) (class color
)) ; Like default mode line
69 :box
(:line-width
2 :style released-button
)
70 :background
"lightgrey" :foreground
"black"))
71 "Face for eww buffer buttons."
75 (defface eww-form-select
76 '((((type x w32 ns
) (class color
)) ; Like default mode line
77 :box
(:line-width
2 :style released-button
)
78 :background
"lightgrey" :foreground
"black"))
79 "Face for eww buffer buttons."
83 (defface eww-form-text
84 '((t (:background
"#505050"
86 :box
(:line-width
1))))
87 "Face for eww text inputs."
91 (defvar eww-current-url nil
)
92 (defvar eww-current-title
""
93 "Title of current page.")
94 (defvar eww-history nil
)
95 (defvar eww-history-position
0)
97 (defvar eww-next-url nil
)
98 (defvar eww-previous-url nil
)
99 (defvar eww-up-url nil
)
100 (defvar eww-home-url nil
)
101 (defvar eww-start-url nil
)
102 (defvar eww-contents-url nil
)
106 "Fetch URL and render the page.
107 If the input doesn't look like an URL or a domain name, the
108 word(s) will be searched for via `eww-search-prefix'."
109 (interactive "sEnter URL or keywords: ")
110 (if (and (= (length (split-string url
)) 1)
111 (> (length (split-string url
"\\.")) 1))
113 (unless (string-match-p "\\`[a-zA-Z][-a-zA-Z0-9+.]*://" url
)
114 (setq url
(concat "http://" url
)))
115 ;; some site don't redirect final /
116 (when (string= (url-filename (url-generic-parse-url url
)) "")
117 (setq url
(concat url
"/"))))
118 (unless (string-match-p "\\'file:" url
)
119 (setq url
(concat eww-search-prefix
120 (replace-regexp-in-string " " "+" url
)))))
121 (url-retrieve url
'eww-render
(list url
)))
124 (defun eww-open-file (file)
125 "Render a file using EWW."
126 (interactive "fFile: ")
127 (eww (concat "file://" (expand-file-name file
))))
129 (defun eww-render (status url
&optional point
)
130 (let ((redirect (plist-get status
:redirect
)))
132 (setq url redirect
)))
133 (set (make-local-variable 'eww-next-url
) nil
)
134 (set (make-local-variable 'eww-previous-url
) nil
)
135 (set (make-local-variable 'eww-up-url
) nil
)
136 (set (make-local-variable 'eww-home-url
) nil
)
137 (set (make-local-variable 'eww-start-url
) nil
)
138 (set (make-local-variable 'eww-contents-url
) nil
)
139 (let* ((headers (eww-parse-headers))
141 (and (string-match "#\\(.*\\)" url
)
142 (match-string 1 url
)))
144 (mail-header-parse-content-type
145 (or (cdr (assoc "content-type" headers
))
149 (or (cdr (assq 'charset
(cdr content-type
)))
150 (eww-detect-charset (equal (car content-type
)
153 (data-buffer (current-buffer)))
157 ((equal (car content-type
) "text/html")
158 (eww-display-html charset url
))
159 ((string-match "^image/" (car content-type
))
163 (setq eww-current-url url
164 eww-history-position
0)
165 (eww-update-header-line-format)
170 (let ((point (next-single-property-change
171 (point-min) 'shr-target-id
)))
173 (goto-char (1+ point
)))))))
174 (kill-buffer data-buffer
))))
176 (defun eww-parse-headers ()
178 (goto-char (point-min))
179 (while (and (not (eobp))
181 (when (looking-at "\\([^:]+\\): *\\(.*\\)")
182 (push (cons (downcase (match-string 1))
190 (defun eww-detect-charset (html-p)
191 (let ((case-fold-search t
)
195 "<meta[\t\n\r ]+[^>]*charset=\"?\\([^\t\n\r \"/>]+\\)[\\\"'.*]" nil t
)
199 "[\t\n\r ]*<\\?xml[\t\n\r ]+[^>]*encoding=\"\\([^\"]+\\)")
202 (declare-function libxml-parse-html-region
"xml.c"
203 (start end
&optional base-url
))
205 (defun eww-display-html (charset url
)
206 (or (fboundp 'libxml-parse-html-region
)
207 (error "This function requires Emacs to be compiled with libxml2"))
208 (unless (eq charset
'utf8
)
210 (decode-coding-region (point) (point-max) charset
)
211 (coding-system-error nil
)))
214 'base
(list (cons 'href url
))
215 (libxml-parse-html-region (point) (point-max)))))
217 (let ((inhibit-read-only t
)
218 (after-change-functions nil
)
220 (shr-external-rendering-functions
221 '((title . eww-tag-title
)
222 (form . eww-tag-form
)
223 (input . eww-tag-input
)
224 (textarea . eww-tag-textarea
)
225 (body . eww-tag-body
)
226 (select . eww-tag-select
)
227 (link . eww-tag-link
)
229 (shr-insert-document document
))
230 (goto-char (point-min))))
232 (defun eww-handle-link (cont)
233 (let* ((rel (assq :rel cont
))
234 (href (assq :href cont
))
236 ;; The text associated with :rel is case-insensitive.
237 (if rel
(downcase (cdr rel
)))
238 '(("next" . eww-next-url
)
239 ;; Texinfo uses "previous", but HTML specifies
240 ;; "prev", so recognize both.
241 ("previous" . eww-previous-url
)
242 ("prev" . eww-previous-url
)
243 ;; HTML specifies "start" but also "contents",
244 ;; and Gtk seems to use "home". Recognize
245 ;; them all; but store them in different
246 ;; variables so that we can readily choose the
248 ("start" . eww-start-url
)
249 ("home" . eww-home-url
)
250 ("contents" . eww-contents-url
)
251 ("up" . eww-up-url
)))))
254 (set (cdr where
) (cdr href
)))))
256 (defun eww-tag-link (cont)
257 (eww-handle-link cont
)
260 (defun eww-tag-a (cont)
261 (eww-handle-link cont
)
264 (defun eww-update-header-line-format ()
265 (if eww-header-line-format
266 (setq header-line-format
267 (replace-regexp-in-string
269 ;; FIXME? Title can be blank. Default to, eg, last component
271 (format-spec eww-header-line-format
272 `((?u .
,eww-current-url
)
273 (?t .
,eww-current-title
)))))
274 (setq header-line-format nil
)))
276 (defun eww-tag-title (cont)
277 (setq eww-current-title
"")
279 (when (eq (car sub
) 'text
)
280 (setq eww-current-title
(concat eww-current-title
(cdr sub
)))))
281 (eww-update-header-line-format))
283 (defun eww-tag-body (cont)
284 (let* ((start (point))
285 (fgcolor (cdr (or (assq :fgcolor cont
)
287 (bgcolor (cdr (assq :bgcolor cont
)))
288 (shr-stylesheet (list (cons 'color fgcolor
)
289 (cons 'background-color bgcolor
))))
291 (eww-colorize-region start
(point) fgcolor bgcolor
)))
293 (defun eww-colorize-region (start end fg
&optional bg
)
295 (let ((new-colors (shr-color-check fg bg
)))
298 (add-face-text-property start end
299 (list :foreground
(cadr new-colors
))
302 (add-face-text-property start end
303 (list :background
(car new-colors
))
306 (defun eww-display-raw ()
307 (let ((data (buffer-substring (point) (point-max))))
309 (let ((inhibit-read-only t
))
311 (goto-char (point-min))))
313 (defun eww-display-image ()
314 (let ((data (shr-parse-image-data)))
316 (let ((inhibit-read-only t
))
317 (shr-put-image data nil
))
318 (goto-char (point-min))))
320 (defun eww-setup-buffer ()
321 (switch-to-buffer (get-buffer-create "*eww*"))
322 (let ((inhibit-read-only t
))
325 (unless (eq major-mode
'eww-mode
)
329 (let ((map (make-sparse-keymap)))
330 (suppress-keymap map
)
331 (define-key map
"q" 'eww-quit
)
332 (define-key map
"g" 'eww-reload
)
333 (define-key map
[tab] 'shr-next-link)
334 (define-key map [backtab] 'shr-previous-link)
335 (define-key map [delete] 'scroll-down-command)
336 (define-key map "\177" 'scroll-down-command)
337 (define-key map " " 'scroll-up-command)
338 (define-key map "l" 'eww-back-url)
339 (define-key map "f" 'eww-forward-url)
340 (define-key map "n" 'eww-next-url)
341 (define-key map "p" 'eww-previous-url)
342 (define-key map "u" 'eww-up-url)
343 (define-key map "t" 'eww-top-url)
344 (define-key map "&" 'eww-browse-with-external-browser)
345 (define-key map "d" 'eww-download)
346 (define-key map "w" 'eww-copy-page-url)
347 (define-key map "C" 'url-cookie-list)
349 (define-key map "b" 'eww-add-bookmark)
350 (define-key map "B" 'eww-list-bookmarks)
351 (define-key map [(meta n)] 'eww-next-bookmark)
352 (define-key map [(meta p)] 'eww-previous-bookmark)
354 (easy-menu-define nil map ""
357 ["Reload" eww-reload t]
358 ["Back to previous page" eww-back-url
359 :active (not (zerop (length eww-history)))]
360 ["Forward to next page" eww-forward-url
361 :active (not (zerop eww-history-position))]
362 ["Browse with external browser" eww-browse-with-external-browser t]
363 ["Download" eww-download t]
364 ["Copy page URL" eww-copy-page-url t]
365 ["Add bookmark" eww-add-bookmark t]
366 ["List bookmarks" eww-copy-page-url t]
367 ["List cookies" url-cookie-list t]))
370 (define-derived-mode eww-mode nil "eww"
371 "Mode for browsing the web.
374 ;; FIXME? This seems a strange default.
375 (set (make-local-variable 'eww-current-url) 'author)
376 (set (make-local-variable 'browse-url-browser-function) 'eww-browse-url)
377 (set (make-local-variable 'after-change-functions) 'eww-process-text-input)
378 (set (make-local-variable 'eww-history) nil)
379 (set (make-local-variable 'eww-history-position) 0)
380 (buffer-disable-undo)
381 ;;(setq buffer-read-only t)
384 (defun eww-save-history ()
385 (push (list :url eww-current-url
386 :title eww-current-title
388 :text (buffer-string))
392 (defun eww-browse-url (url &optional _new-window)
393 (when (and (equal major-mode 'eww-mode)
399 "Exit the Emacs Web Wowser."
401 (setq eww-history nil)
402 (kill-buffer (current-buffer)))
404 (defun eww-back-url ()
405 "Go to the previously displayed page."
407 (when (>= eww-history-position (length eww-history))
408 (error "No previous page"))
410 (setq eww-history-position (+ eww-history-position 2))
411 (eww-restore-history (elt eww-history (1- eww-history-position))))
413 (defun eww-forward-url ()
414 "Go to the next displayed page."
416 (when (zerop eww-history-position)
417 (error "No next page"))
419 (eww-restore-history (elt eww-history (1- eww-history-position))))
421 (defun eww-restore-history (elem)
422 (let ((inhibit-read-only t))
424 (insert (plist-get elem :text))
425 (goto-char (plist-get elem :point))
426 (setq eww-current-url (plist-get elem :url)
427 eww-current-title (plist-get elem :title))))
429 (defun eww-next-url ()
430 "Go to the page marked `next'.
431 A page is marked `next' if rel=\"next\" appears in a <link>
435 (eww-browse-url (shr-expand-url eww-next-url eww-current-url))
436 (error "No `next' on this page")))
438 (defun eww-previous-url ()
439 "Go to the page marked `previous'.
440 A page is marked `previous' if rel=\"previous\" appears in a <link>
444 (eww-browse-url (shr-expand-url eww-previous-url eww-current-url))
445 (error "No `previous' on this page")))
448 "Go to the page marked `up'.
449 A page is marked `up' if rel=\"up\" appears in a <link>
453 (eww-browse-url (shr-expand-url eww-up-url eww-current-url))
454 (error "No `up' on this page")))
456 (defun eww-top-url ()
457 "Go to the page marked `top'.
458 A page is marked `top' if rel=\"start\", rel=\"home\", or rel=\"contents\"
459 appears in a <link> or <a> tag."
461 (let ((best-url (or eww-start-url
465 (eww-browse-url (shr-expand-url best-url eww-current-url))
466 (error "No `top' for this page"))))
469 "Reload the current page."
471 (url-retrieve eww-current-url 'eww-render
472 (list eww-current-url (point))))
476 (defvar eww-form nil)
478 (defvar eww-submit-map
479 (let ((map (make-sparse-keymap)))
480 (define-key map "\r" 'eww-submit)
481 (define-key map [(control c) (control c)] 'eww-submit)
484 (defvar eww-checkbox-map
485 (let ((map (make-sparse-keymap)))
486 (define-key map [space] 'eww-toggle-checkbox)
487 (define-key map "\r" 'eww-toggle-checkbox)
488 (define-key map [(control c) (control c)] 'eww-submit)
492 (let ((map (make-keymap)))
493 (set-keymap-parent map text-mode-map)
494 (define-key map "\r" 'eww-submit)
495 (define-key map [(control a)] 'eww-beginning-of-text)
496 (define-key map [(control c) (control c)] 'eww-submit)
497 (define-key map [(control e)] 'eww-end-of-text)
498 (define-key map [tab] 'shr-next-link
)
499 (define-key map
[backtab] 'shr-previous-link)
502 (defvar eww-textarea-map
503 (let ((map (make-keymap)))
504 (set-keymap-parent map text-mode-map)
505 (define-key map "\r" 'forward-line)
506 (define-key map [(control c) (control c)] 'eww-submit)
507 (define-key map [tab] 'shr-next-link)
508 (define-key map [backtab] 'shr-previous-link
)
511 (defvar eww-select-map
512 (let ((map (make-sparse-keymap)))
513 (define-key map
"\r" 'eww-change-select
)
514 (define-key map
[(control c
) (control c
)] 'eww-submit
)
517 (defun eww-beginning-of-text ()
518 "Move to the start of the input field."
520 (goto-char (eww-beginning-of-field)))
522 (defun eww-end-of-text ()
523 "Move to the end of the text in the input field."
525 (goto-char (eww-end-of-field))
526 (let ((start (eww-beginning-of-field)))
527 (while (and (equal (following-char) ?
)
530 (when (> (point) start
)
533 (defun eww-beginning-of-field ()
537 ((not (eq (get-text-property (point) 'eww-form
)
538 (get-text-property (1- (point)) 'eww-form
)))
541 (previous-single-property-change
542 (point) 'eww-form nil
(point-min)))))
544 (defun eww-end-of-field ()
545 (1- (next-single-property-change
546 (point) 'eww-form nil
(point-max))))
548 (defun eww-tag-form (cont)
550 (list (assq :method cont
)
551 (assq :action cont
)))
553 (shr-ensure-paragraph)
558 (when (> (point) start
)
559 (put-text-property start
(1+ start
)
560 'eww-form eww-form
))))
562 (defun eww-form-submit (cont)
563 (let ((start (point))
564 (value (cdr (assq :value cont
))))
566 (if (zerop (length value
))
570 (add-face-text-property start
(point) 'eww-form-submit
)
571 (put-text-property start
(point) 'eww-form
572 (list :eww-form eww-form
575 :name
(cdr (assq :name cont
))))
576 (put-text-property start
(point) 'keymap eww-submit-map
)
579 (defun eww-form-checkbox (cont)
580 (let ((start (point)))
581 (if (cdr (assq :checked cont
))
584 (add-face-text-property start
(point) 'eww-form-checkbox
)
585 (put-text-property start
(point) 'eww-form
586 (list :eww-form eww-form
587 :value
(cdr (assq :value cont
))
588 :type
(downcase (cdr (assq :type cont
)))
589 :checked
(cdr (assq :checked cont
))
590 :name
(cdr (assq :name cont
))))
591 (put-text-property start
(point) 'keymap eww-checkbox-map
)
594 (defun eww-form-text (cont)
595 (let ((start (point))
596 (type (downcase (or (cdr (assq :type cont
))
598 (value (or (cdr (assq :value cont
)) ""))
599 (width (string-to-number
600 (or (cdr (assq :size cont
))
603 (when (< (length value
) width
)
604 (insert (make-string (- width
(length value
)) ?
)))
605 (put-text-property start
(point) 'face
'eww-form-text
)
606 (put-text-property start
(point) 'local-map eww-text-map
)
607 (put-text-property start
(point) 'inhibit-read-only t
)
608 (put-text-property start
(point) 'eww-form
609 (list :eww-form eww-form
612 :name
(cdr (assq :name cont
))))
615 (defun eww-process-text-input (beg end length
)
616 (let* ((form (get-text-property (min (1+ end
) (point-max)) 'eww-form
))
617 (properties (text-properties-at end
))
618 (type (plist-get form
:type
)))
620 (member type
'("text" "password" "textarea")))
623 ;; Delete some space at the end.
626 (if (equal type
"textarea")
627 (1- (line-end-position))
629 (let ((new (- end beg
)))
630 (while (and (> new
0)
631 (eql (following-char) ?
))
632 (delete-region (point) (1+ (point)))
633 (setq new
(1- new
))))
634 (set-text-properties beg end properties
)))
639 (if (equal type
"textarea")
640 (1- (line-end-position))
642 (let ((start (point)))
643 (insert (make-string length ?
))
644 (set-text-properties start
(point) properties
)))))
645 (let ((value (buffer-substring-no-properties
646 (eww-beginning-of-field)
647 (eww-end-of-field))))
648 (when (string-match " +\\'" value
)
649 (setq value
(substring value
0 (match-beginning 0))))
650 (plist-put form
:value value
)
651 (when (equal type
"password")
652 ;; Display passwords as asterisks.
653 (let ((start (eww-beginning-of-field)))
654 (put-text-property start
(+ start
(length value
))
655 'display
(make-string (length value
) ?
*))))))))
657 (defun eww-tag-textarea (cont)
658 (let ((start (point))
659 (value (or (cdr (assq :value cont
)) ""))
660 (lines (string-to-number
661 (or (cdr (assq :rows cont
))
663 (width (string-to-number
664 (or (cdr (assq :cols cont
))
670 (when (< (count-lines start
(point)) lines
)
671 (dotimes (i (- lines
(count-lines start
(point))))
673 (setq end
(point-marker))
675 (while (< (point) end
)
677 (let ((pad (- width
(- (point) (line-beginning-position)))))
679 (insert (make-string pad ?
))))
680 (add-face-text-property (line-beginning-position)
681 (point) 'eww-form-text
)
682 (put-text-property (line-beginning-position) (point)
683 'local-map eww-textarea-map
)
685 (put-text-property start
(point) 'eww-form
686 (list :eww-form eww-form
689 :name
(cdr (assq :name cont
))))))
691 (defun eww-tag-input (cont)
692 (let ((type (downcase (or (cdr (assq :type cont
))
696 ((or (equal type
"checkbox")
697 (equal type
"radio"))
698 (eww-form-checkbox cont
))
699 ((equal type
"submit")
700 (eww-form-submit cont
))
701 ((equal type
"hidden")
702 (let ((form eww-form
)
703 (name (cdr (assq :name cont
))))
704 ;; Don't add <input type=hidden> elements repeatedly.
706 (or (not (consp (car form
)))
707 (not (eq (caar form
) 'hidden
))
708 (not (equal (plist-get (cdr (car form
)) :name
)
710 (setq form
(cdr form
)))
712 (nconc eww-form
(list
715 :value
(cdr (assq :value cont
))))))))
717 (eww-form-text cont
)))
718 (unless (= start
(point))
719 (put-text-property start
(1+ start
) 'help-echo
"Input field"))))
721 (defun eww-tag-select (cont)
722 (shr-ensure-paragraph)
723 (let ((menu (list :name
(cdr (assq :name cont
))
729 (when (eq (car elem
) 'option
)
730 (when (cdr (assq :selected
(cdr elem
)))
731 (nconc menu
(list :value
732 (cdr (assq :value
(cdr elem
))))))
733 (let ((display (or (cdr (assq 'text
(cdr elem
))) "")))
734 (setq max
(max max
(length display
)))
736 :value
(cdr (assq :value
(cdr elem
)))
740 (setq options
(nreverse options
))
741 ;; If we have no selected values, default to the first value.
742 (unless (plist-get menu
:value
)
743 (nconc menu
(list :value
(nth 2 (car options
)))))
745 (let ((selected (eww-select-display menu
)))
747 (make-string (- max
(length selected
)) ?
)))
748 (put-text-property start
(point) 'eww-form menu
)
749 (add-face-text-property start
(point) 'eww-form-select
)
750 (put-text-property start
(point) 'keymap eww-select-map
)
751 (shr-ensure-paragraph))))
753 (defun eww-select-display (select)
754 (let ((value (plist-get select
:value
))
756 (dolist (elem select
)
757 (when (and (consp elem
)
758 (eq (car elem
) 'item
)
759 (equal value
(plist-get (cdr elem
) :value
)))
760 (setq display
(plist-get (cdr elem
) :display
))))
763 (defun eww-change-select ()
764 "Change the value of the select drop-down menu under point."
766 (let* ((input (get-text-property (point) 'eww-form
))
767 (completion-ignore-case t
)
770 (mapcar (lambda (elem)
772 (eq (car elem
) 'item
)
773 (cons (plist-get (cdr elem
) :display
)
774 (plist-get (cdr elem
) :value
))))
777 (completing-read "Change value: " options nil
'require-match
))
778 (inhibit-read-only t
))
779 (plist-put input
:value
(cdr (assoc-string display options t
)))
781 (eww-update-field display
))))
783 (defun eww-update-field (string)
784 (let ((properties (text-properties-at (point)))
785 (start (eww-beginning-of-field))
786 (end (1+ (eww-end-of-field))))
787 (delete-region start end
)
789 (make-string (- (- end start
) (length string
)) ?
))
790 (set-text-properties start end properties
)
793 (defun eww-toggle-checkbox ()
794 "Toggle the value of the checkbox under point."
796 (let* ((input (get-text-property (point) 'eww-form
))
797 (type (plist-get input
:type
)))
798 (if (equal type
"checkbox")
801 (if (plist-get input
:checked
)
803 (plist-put input
:checked nil
)
804 (eww-update-field "[ ]"))
805 (plist-put input
:checked t
)
806 (eww-update-field "[X]"))))
807 ;; Radio button. Switch all other buttons off.
808 (let ((name (plist-get input
:name
)))
810 (dolist (elem (eww-inputs (plist-get input
:eww-form
)))
811 (when (equal (plist-get (cdr elem
) :name
) name
)
812 (goto-char (car elem
))
813 (if (not (eq (cdr elem
) input
))
815 (plist-put input
:checked nil
)
816 (eww-update-field "[ ]"))
817 (plist-put input
:checked t
)
818 (eww-update-field "[X]")))))
821 (defun eww-inputs (form)
822 (let ((start (point-min))
825 (< start
(point-max)))
826 (when (or (get-text-property start
'eww-form
)
827 (setq start
(next-single-property-change start
'eww-form
)))
828 (when (eq (plist-get (get-text-property start
'eww-form
) :eww-form
)
830 (push (cons start
(get-text-property start
'eww-form
))
832 (setq start
(next-single-property-change start
'eww-form
))))
835 (defun eww-input-value (input)
836 (let ((type (plist-get input
:type
))
837 (value (plist-get input
:value
)))
839 ((equal type
"textarea")
842 (goto-char (point-min))
843 (while (re-search-forward "^ +\n\\| +$" nil t
)
844 (replace-match "" t t
))
847 (if (string-match " +\\'" value
)
848 (substring value
0 (match-beginning 0))
852 "Submit the current form."
854 (let* ((this-input (get-text-property (point) 'eww-form
))
855 (form (plist-get this-input
:eww-form
))
857 (dolist (elem (sort (eww-inputs form
)
859 (< (car o1
) (car o2
)))))
860 (let* ((input (cdr elem
))
861 (input-start (car elem
))
862 (name (plist-get input
:name
)))
865 ((member (plist-get input
:type
) '("checkbox" "radio"))
866 (when (plist-get input
:checked
)
867 (push (cons name
(plist-get input
:value
))
869 ((equal (plist-get input
:type
) "submit")
870 ;; We want the values from buttons if we hit a button if
871 ;; we hit enter on it, or if it's the first button after
872 ;; the field we did hit return on.
873 (when (or (eq input this-input
)
874 (and (not (eq input this-input
))
876 (> input-start
(point))))
878 (push (cons name
(plist-get input
:value
))
881 (push (cons name
(eww-input-value input
))
884 (when (and (consp elem
)
885 (eq (car elem
) 'hidden
))
886 (push (cons (plist-get (cdr elem
) :name
)
887 (plist-get (cdr elem
) :value
))
889 (if (and (stringp (cdr (assq :method form
)))
890 (equal (downcase (cdr (assq :method form
))) "post"))
891 (let ((url-request-method "POST")
892 (url-request-extra-headers
893 '(("Content-Type" .
"application/x-www-form-urlencoded")))
894 (url-request-data (mm-url-encode-www-form-urlencoded values
)))
895 (eww-browse-url (shr-expand-url (cdr (assq :action form
))
899 (if (cdr (assq :action form
))
900 (shr-expand-url (cdr (assq :action form
))
904 (mm-url-encode-www-form-urlencoded values
))))))
906 (defun eww-browse-with-external-browser ()
907 "Browse the current URL with an external browser.
908 The browser to used is specified by the `shr-external-browser' variable."
910 (funcall shr-external-browser eww-current-url
))
912 (defun eww-copy-page-url ()
914 (message "%s" eww-current-url
)
915 (kill-new eww-current-url
))
917 (defun eww-download ()
918 "Download URL under point to `eww-download-directory'."
920 (let ((url (get-text-property (point) 'shr-url
)))
922 (message "No URL under point")
923 (url-retrieve url
'eww-download-callback
(list url
)))))
925 (defun eww-download-callback (status url
)
926 (unless (plist-get status
:error
)
927 (let* ((obj (url-generic-parse-url url
))
928 (path (car (url-path-and-query obj
)))
929 (file (eww-make-unique-file-name (file-name-nondirectory path
)
932 (message "Saved %s" file
))))
934 (defun eww-make-unique-file-name (file directory
)
936 ((zerop (length file
))
938 ((string-match "\\`[.]" file
)
939 (setq file
(concat "!" file
))))
941 (while (file-exists-p (expand-file-name file directory
))
943 (if (string-match "\\`\\(.*\\)\\([.][^.]+\\)" file
)
944 (format "%s(%d)%s" (match-string 1 file
)
945 count
(match-string 2 file
))
946 (format "%s(%d)" file count
)))
947 (setq count
(1+ count
)))
948 (expand-file-name file directory
)))
952 (defvar eww-bookmarks nil
)
954 (defun eww-add-bookmark ()
955 "Add the current page to the bookmarks."
958 (dolist (bookmark eww-bookmarks
)
959 (when (equal eww-current-url
960 (plist-get bookmark
:url
))
961 (error "Already bookmarked")))
962 (let ((title (replace-regexp-in-string "[\n\t\r]" " " eww-current-title
)))
963 (setq title
(replace-regexp-in-string "\\` +\\| +\\'" "" title
))
964 (push (list :url eww-current-url
966 :time
(current-time-string))
968 (eww-write-bookmarks)
969 (message "Bookmarked %s (%s)" eww-current-url eww-current-title
))
971 (defun eww-write-bookmarks ()
972 (with-temp-file (expand-file-name "eww-bookmarks" user-emacs-directory
)
973 (insert ";; Auto-generated file; don't edit\n")
974 (pp eww-bookmarks
(current-buffer))))
976 (defun eww-read-bookmarks ()
977 (let ((file (expand-file-name "eww-bookmarks" user-emacs-directory
)))
979 (unless (zerop (or (nth 7 (file-attributes file
)) 0))
981 (insert-file-contents file
)
982 (read (current-buffer)))))))
984 (defun eww-list-bookmarks ()
985 "Display the bookmarks."
987 (eww-bookmark-prepare)
988 (pop-to-buffer "*eww bookmarks*"))
990 (defun eww-bookmark-prepare ()
992 (when (null eww-bookmarks
)
993 (error "No bookmarks are defined"))
994 (set-buffer (get-buffer-create "*eww bookmarks*"))
996 (let ((format "%-40s %s")
997 (inhibit-read-only t
)
1000 (setq header-line-format
(concat " " (format format
"URL" "Title")))
1001 (dolist (bookmark eww-bookmarks
)
1002 (setq start
(point))
1003 (setq url
(plist-get bookmark
:url
))
1004 (when (> (length url
) 40)
1005 (setq url
(substring url
0 40)))
1006 (insert (format format url
1007 (plist-get bookmark
:title
))
1009 (put-text-property start
(1+ start
) 'eww-bookmark bookmark
))
1010 (goto-char (point-min))))
1012 (defvar eww-bookmark-kill-ring nil
)
1014 (defun eww-bookmark-kill ()
1015 "Kill the current bookmark."
1017 (let* ((start (line-beginning-position))
1018 (bookmark (get-text-property start
'eww-bookmark
))
1019 (inhibit-read-only t
))
1021 (error "No bookmark on the current line"))
1023 (push (buffer-substring start
(point)) eww-bookmark-kill-ring
)
1024 (delete-region start
(point))
1025 (setq eww-bookmarks
(delq bookmark eww-bookmarks
))
1026 (eww-write-bookmarks)))
1028 (defun eww-bookmark-yank ()
1029 "Yank a previously killed bookmark to the current line."
1031 (unless eww-bookmark-kill-ring
1032 (error "No previously killed bookmark"))
1034 (let ((inhibit-read-only t
)
1037 (insert (pop eww-bookmark-kill-ring
))
1038 (setq bookmark
(get-text-property start
'eww-bookmark
))
1039 (if (= start
(point-min))
1040 (push bookmark eww-bookmarks
)
1041 (let ((line (count-lines start
(point))))
1042 (setcdr (nthcdr (1- line
) eww-bookmarks
)
1043 (cons bookmark
(nthcdr line eww-bookmarks
)))))
1044 (eww-write-bookmarks)))
1046 (defun eww-bookmark-quit ()
1047 "Kill the current buffer."
1049 (kill-buffer (current-buffer)))
1051 (defun eww-bookmark-browse ()
1052 "Browse the bookmark under point in eww."
1054 (let ((bookmark (get-text-property (line-beginning-position) 'eww-bookmark
)))
1056 (error "No bookmark on the current line"))
1057 ;; We wish to leave this window, but if it's the only window here,
1058 ;; just let it remain.
1061 (eww (plist-get bookmark
:url
))))
1063 (defun eww-next-bookmark ()
1064 "Go to the next bookmark in the list."
1068 (unless (get-buffer "*eww bookmarks*")
1070 (eww-bookmark-prepare))
1071 (with-current-buffer (get-buffer "*eww bookmarks*")
1072 (when (and (not first
)
1075 (setq bookmark
(get-text-property (line-beginning-position)
1078 (error "No next bookmark")))
1079 (eww-browse-url (plist-get bookmark
:url
))))
1081 (defun eww-previous-bookmark ()
1082 "Go to the previous bookmark in the list."
1086 (unless (get-buffer "*eww bookmarks*")
1088 (eww-bookmark-prepare))
1089 (with-current-buffer (get-buffer "*eww bookmarks*")
1091 (goto-char (point-max))
1092 (beginning-of-line))
1093 ;; On the final line.
1097 (error "No previous bookmark")
1099 (setq bookmark
(get-text-property (line-beginning-position)
1101 (eww-browse-url (plist-get bookmark
:url
))))
1103 (defvar eww-bookmark-mode-map
1104 (let ((map (make-sparse-keymap)))
1105 (suppress-keymap map
)
1106 (define-key map
"q" 'eww-bookmark-quit
)
1107 (define-key map
[(control k
)] 'eww-bookmark-kill
)
1108 (define-key map
[(control y
)] 'eww-bookmark-yank
)
1109 (define-key map
"\r" 'eww-bookmark-browse
)
1112 (define-derived-mode eww-bookmark-mode nil
"eww bookmarks"
1113 "Mode for listing bookmarks.
1115 \\{eww-bookmark-mode-map}"
1116 (buffer-disable-undo)
1117 (setq buffer-read-only t
1122 ;;; eww.el ends here