:group 'eww
:type 'string)
+(defcustom eww-download-path "~/Downloads/"
+ "Path where files will downloaded."
+ :version "24.4"
+ :group 'eww
+ :type 'string)
+
+(defcustom eww-use-external-browser-for-content-type
+ "\\`\\(video/\\|audio/\\|application/ogg\\)"
+ "Always use external browser for specified content-type."
+ :version "24.4"
+ :group 'eww
+ :type '(choice (const :tag "Never" nil)
+ regexp))
+
+(defcustom eww-form-checkbox-selected-symbol "[X]"
+ "Symbol used to represent a selected checkbox.
+See also `eww-form-checkbox-symbol'."
+ :version "24.4"
+ :group 'eww
+ :type '(choice (const "[X]")
+ (const "☒") ; Unicode BALLOT BOX WITH X
+ (const "☑") ; Unicode BALLOT BOX WITH CHECK
+ string))
+
+(defcustom eww-form-checkbox-symbol "[ ]"
+ "Symbol used to represent a checkbox.
+See also `eww-form-checkbox-selected-symbol'."
+ :version "24.4"
+ :group 'eww
+ :type '(choice (const "[ ]")
+ (const "☐") ; Unicode BALLOT BOX
+ string))
+
(defface eww-form-submit
'((((type x w32 ns) (class color)) ; Like default mode line
:box (:line-width 2 :style released-button)
:group 'eww)
(defvar eww-current-url nil)
+(defvar eww-current-dom nil)
(defvar eww-current-title ""
"Title of current page.")
(defvar eww-history nil)
+(defvar eww-history-position 0)
(defvar eww-next-url nil)
(defvar eww-previous-url nil)
(defvar eww-start-url nil)
(defvar eww-contents-url nil)
+(defvar eww-local-regex "localhost"
+ "When this regex is found in the URL, it's not a keyword but an address.")
+
+(defvar eww-link-keymap
+ (let ((map (copy-keymap shr-map)))
+ (define-key map "\r" 'eww-follow-link)
+ map))
+
;;;###autoload
(defun eww (url)
"Fetch URL and render the page.
If the input doesn't look like an URL or a domain name, the
word(s) will be searched for via `eww-search-prefix'."
(interactive "sEnter URL or keywords: ")
- (if (and (= (length (split-string url)) 1)
- (> (length (split-string url "\\.")) 1))
- (progn
- (unless (string-match-p "\\`[a-zA-Z][-a-zA-Z0-9+.]*://" url)
- (setq url (concat "http://" url)))
- ;; some site don't redirect final /
- (when (string= (url-filename (url-generic-parse-url url)) "")
- (setq url (concat url "/"))))
- (unless (string-match-p "\\'file:" url)
- (setq url (concat eww-search-prefix
- (replace-regexp-in-string " " "+" url)))))
+ (cond ((string-match-p "\\`file:" url))
+ (t
+ (if (and (= (length (split-string url)) 1)
+ (or (> (length (split-string url "\\.")) 1)
+ (string-match eww-local-regex url)))
+ (progn
+ (unless (string-match-p "\\`[a-zA-Z][-a-zA-Z0-9+.]*://" url)
+ (setq url (concat "http://" url)))
+ ;; some site don't redirect final /
+ (when (string= (url-filename (url-generic-parse-url url)) "")
+ (setq url (concat url "/"))))
+ (setq url (concat eww-search-prefix
+ (replace-regexp-in-string " " "+" url))))))
(url-retrieve url 'eww-render (list url)))
;;;###autoload
(set (make-local-variable 'eww-start-url) nil)
(set (make-local-variable 'eww-contents-url) nil)
(let* ((headers (eww-parse-headers))
- (shr-target-id
- (and (string-match "#\\(.*\\)" url)
- (match-string 1 url)))
(content-type
(mail-header-parse-content-type
(or (cdr (assoc "content-type" headers))
(data-buffer (current-buffer)))
(unwind-protect
(progn
+ (setq eww-current-title "")
(cond
+ ((and eww-use-external-browser-for-content-type
+ (string-match-p eww-use-external-browser-for-content-type
+ (car content-type)))
+ (eww-browse-with-external-browser url))
((equal (car content-type) "text/html")
- (eww-display-html charset url))
- ((string-match "^image/" (car content-type))
- (eww-display-image))
+ (eww-display-html charset url nil point))
+ ((string-match-p "\\`image/" (car content-type))
+ (eww-display-image url)
+ (eww-update-header-line-format))
(t
- (eww-display-raw charset)))
- (cond
- (point
- (goto-char point))
- (shr-target-id
- (let ((point (next-single-property-change
- (point-min) 'shr-target-id)))
- (when point
- (goto-char (1+ point)))))))
+ (eww-display-raw)
+ (eww-update-header-line-format)))
+ (setq eww-current-url url
+ eww-history-position 0))
(kill-buffer data-buffer))))
(defun eww-parse-headers ()
"[\t\n\r ]*<\\?xml[\t\n\r ]+[^>]*encoding=\"\\([^\"]+\\)")
(match-string 1)))))
-(defun eww-display-html (charset url)
+(declare-function libxml-parse-html-region "xml.c"
+ (start end &optional base-url))
+
+(defun eww-display-html (charset url &optional document point)
+ (or (fboundp 'libxml-parse-html-region)
+ (error "This function requires Emacs to be compiled with libxml2"))
(unless (eq charset 'utf8)
- (decode-coding-region (point) (point-max) charset))
+ (condition-case nil
+ (decode-coding-region (point) (point-max) charset)
+ (coding-system-error nil)))
(let ((document
- (list
- 'base (list (cons 'href url))
- (libxml-parse-html-region (point) (point-max)))))
+ (or document
+ (list
+ 'base (list (cons 'href url))
+ (libxml-parse-html-region (point) (point-max))))))
(eww-setup-buffer)
- (setq eww-current-url url)
- (eww-update-header-line-format)
+ (setq eww-current-dom document)
(let ((inhibit-read-only t)
(after-change-functions nil)
(shr-width nil)
+ (shr-target-id (url-target (url-generic-parse-url url)))
(shr-external-rendering-functions
'((title . eww-tag-title)
(form . eww-tag-form)
(select . eww-tag-select)
(link . eww-tag-link)
(a . eww-tag-a))))
- (shr-insert-document document))
- (goto-char (point-min))))
+ (shr-insert-document document)
+ (cond
+ (point
+ (goto-char point))
+ (shr-target-id
+ (let ((point (next-single-property-change
+ (point-min) 'shr-target-id)))
+ (when point
+ (goto-char (1+ point)))))
+ (t
+ (goto-char (point-min)))))
+ (setq eww-current-url url
+ eww-history-position 0)
+ (eww-update-header-line-format)))
(defun eww-handle-link (cont)
(let* ((rel (assq :rel cont))
(defun eww-tag-a (cont)
(eww-handle-link cont)
- (shr-tag-a cont))
+ (let ((start (point)))
+ (shr-tag-a cont)
+ (put-text-property start (point) 'keymap eww-link-keymap)))
(defun eww-update-header-line-format ()
(if eww-header-line-format
(setq header-line-format
(replace-regexp-in-string
"%" "%%"
+ ;; FIXME? Title can be blank. Default to, eg, last component
+ ;; of url?
(format-spec eww-header-line-format
`((?u . ,eww-current-url)
(?t . ,eww-current-title)))))
(list :background (car new-colors))
t))))))
-(defun eww-display-raw (charset)
+(defun eww-display-raw ()
(let ((data (buffer-substring (point) (point-max))))
(eww-setup-buffer)
(let ((inhibit-read-only t))
(goto-char (point-min))))
(defun eww-display-image ()
- (let ((data (buffer-substring (point) (point-max))))
+ (let ((data (shr-parse-image-data)))
(eww-setup-buffer)
(let ((inhibit-read-only t))
(shr-put-image data nil))
(goto-char (point-min))))
(defun eww-setup-buffer ()
- (pop-to-buffer (get-buffer-create "*eww*"))
- (remove-overlays)
+ (switch-to-buffer (get-buffer-create "*eww*"))
(let ((inhibit-read-only t))
+ (remove-overlays)
(erase-buffer))
- (eww-mode))
+ (unless (eq major-mode 'eww-mode)
+ (eww-mode)))
(defvar eww-mode-map
(let ((map (make-sparse-keymap)))
(define-key map "\177" 'scroll-down-command)
(define-key map " " 'scroll-up-command)
(define-key map "l" 'eww-back-url)
+ (define-key map "f" 'eww-forward-url)
(define-key map "n" 'eww-next-url)
(define-key map "p" 'eww-previous-url)
(define-key map "u" 'eww-up-url)
(define-key map "t" 'eww-top-url)
- (define-key map "w" 'eww-browse-with-external-browser)
- (define-key map "y" 'eww-yank-page-url)
+ (define-key map "&" 'eww-browse-with-external-browser)
+ (define-key map "d" 'eww-download)
+ (define-key map "w" 'eww-copy-page-url)
+ (define-key map "C" 'url-cookie-list)
+
+ (define-key map "b" 'eww-add-bookmark)
+ (define-key map "B" 'eww-list-bookmarks)
+ (define-key map [(meta n)] 'eww-next-bookmark)
+ (define-key map [(meta p)] 'eww-previous-bookmark)
+
+ (easy-menu-define nil map ""
+ '("Eww"
+ ["Quit" eww-quit t]
+ ["Reload" eww-reload t]
+ ["Back to previous page" eww-back-url
+ :active (not (zerop (length eww-history)))]
+ ["Forward to next page" eww-forward-url
+ :active (not (zerop eww-history-position))]
+ ["Browse with external browser" eww-browse-with-external-browser t]
+ ["Download" eww-download t]
+ ["Copy page URL" eww-copy-page-url t]
+ ["Add bookmark" eww-add-bookmark t]
+ ["List bookmarks" eww-copy-page-url t]
+ ["List cookies" url-cookie-list t]))
map))
(define-derived-mode eww-mode nil "eww"
"Mode for browsing the web.
\\{eww-mode-map}"
+ ;; FIXME? This seems a strange default.
(set (make-local-variable 'eww-current-url) 'author)
+ (set (make-local-variable 'eww-current-dom) nil)
(set (make-local-variable 'browse-url-browser-function) 'eww-browse-url)
(set (make-local-variable 'after-change-functions) 'eww-process-text-input)
+ (set (make-local-variable 'eww-history) nil)
+ (set (make-local-variable 'eww-history-position) 0)
+ (buffer-disable-undo)
;;(setq buffer-read-only t)
)
-(defun eww-browse-url (url &optional new-window)
+(defun eww-save-history ()
+ (push (list :url eww-current-url
+ :title eww-current-title
+ :point (point)
+ :dom eww-current-dom
+ :text (buffer-string))
+ eww-history))
+
+;;;###autoload
+(defun eww-browse-url (url &optional _new-window)
(when (and (equal major-mode 'eww-mode)
eww-current-url)
- (push (list eww-current-url (point))
- eww-history))
+ (eww-save-history))
(eww url))
(defun eww-quit ()
(defun eww-back-url ()
"Go to the previously displayed page."
(interactive)
- (when (zerop (length eww-history))
+ (when (>= eww-history-position (length eww-history))
(error "No previous page"))
- (let ((prev (pop eww-history)))
- (url-retrieve (car prev) 'eww-render (list (car prev) (cadr prev)))))
+ (eww-save-history)
+ (setq eww-history-position (+ eww-history-position 2))
+ (eww-restore-history (elt eww-history (1- eww-history-position))))
+
+(defun eww-forward-url ()
+ "Go to the next displayed page."
+ (interactive)
+ (when (zerop eww-history-position)
+ (error "No next page"))
+ (eww-save-history)
+ (eww-restore-history (elt eww-history (1- eww-history-position))))
+
+(defun eww-restore-history (elem)
+ (let ((inhibit-read-only t))
+ (erase-buffer)
+ (insert (plist-get elem :text))
+ (setq eww-current-dom (plist-get elem :dom))
+ (goto-char (plist-get elem :point))
+ (setq eww-current-url (plist-get elem :url)
+ eww-current-title (plist-get elem :title))
+ (eww-update-header-line-format)))
(defun eww-next-url ()
"Go to the page marked `next'.
(defun eww-form-checkbox (cont)
(let ((start (point)))
(if (cdr (assq :checked cont))
- (insert "[X]")
- (insert "[ ]"))
+ (insert eww-form-checkbox-selected-symbol)
+ (insert eww-form-checkbox-symbol))
(add-face-text-property start (point) 'eww-form-checkbox)
(put-text-property start (point) 'eww-form
(list :eww-form eww-form
:name (cdr (assq :name cont))))
(insert " ")))
+(defconst eww-text-input-types '("text" "password" "textarea"
+ "color" "date" "datetime" "datetime-local"
+ "email" "month" "number" "search" "tel"
+ "time" "url" "week")
+ "List of input types which represent a text input.
+See URL `https://developer.mozilla.org/en-US/docs/Web/HTML/Element/Input'.")
+
(defun eww-process-text-input (beg end length)
- (let* ((form (get-text-property end 'eww-form))
+ (let* ((form (get-text-property (min (1+ end) (point-max)) 'eww-form))
(properties (text-properties-at end))
(type (plist-get form :type)))
(when (and form
- (member type '("text" "password" "textarea")))
+ (member type eww-text-input-types))
(cond
((zerop length)
;; Delete some space at the end.
:eww-form eww-form))
(options nil)
(start (point))
- (max 0))
- (dolist (elem cont)
+ (max 0)
+ opelem)
+ (if (eq (car (car cont)) 'optgroup)
+ (dolist (groupelem cont)
+ (unless (cdr (assq :disabled (cdr groupelem)))
+ (setq opelem (append opelem (cdr (cdr groupelem))))))
+ (setq opelem cont))
+ (dolist (elem opelem)
(when (eq (car elem) 'option)
(when (cdr (assq :selected (cdr elem)))
(nconc menu (list :value
"Change the value of the select drop-down menu under point."
(interactive)
(let* ((input (get-text-property (point) 'eww-form))
- (properties (text-properties-at (point)))
(completion-ignore-case t)
(options
(delq nil
(if (plist-get input :checked)
(progn
(plist-put input :checked nil)
- (eww-update-field "[ ]"))
+ (eww-update-field eww-form-checkbox-symbol))
(plist-put input :checked t)
- (eww-update-field "[X]"))))
+ (eww-update-field eww-form-checkbox-selected-symbol))))
;; Radio button. Switch all other buttons off.
(let ((name (plist-get input :name)))
(save-excursion
(if (not (eq (cdr elem) input))
(progn
(plist-put input :checked nil)
- (eww-update-field "[ ]"))
+ (eww-update-field eww-form-checkbox-symbol))
(plist-put input :checked t)
- (eww-update-field "[X]")))))
+ (eww-update-field eww-form-checkbox-selected-symbol)))))
(forward-char 1)))))
(defun eww-inputs (form)
"?"
(mm-url-encode-www-form-urlencoded values))))))
-(defun eww-browse-with-external-browser ()
+(defun eww-browse-with-external-browser (&optional url)
"Browse the current URL with an external browser.
The browser to used is specified by the `shr-external-browser' variable."
(interactive)
- (funcall shr-external-browser eww-current-url))
-
-(defun eww-yank-page-url ()
+ (funcall shr-external-browser (or url eww-current-url)))
+
+(defun eww-follow-link (&optional external mouse-event)
+ "Browse the URL under point.
+If EXTERNAL, browse the URL using `shr-external-browser'."
+ (interactive (list current-prefix-arg last-nonmenu-event))
+ (mouse-set-point mouse-event)
+ (let ((url (get-text-property (point) 'shr-url)))
+ (cond
+ ((not url)
+ (message "No link under point"))
+ ((string-match "^mailto:" url)
+ (browse-url-mail url))
+ (external
+ (funcall shr-external-browser url))
+ ;; This is a #target url in the same page as the current one.
+ ((and (url-target (url-generic-parse-url url))
+ (eww-same-page-p url eww-current-url))
+ (eww-save-history)
+ (eww-display-html 'utf8 url eww-current-dom))
+ (t
+ (eww-browse-url url)))))
+
+(defun eww-same-page-p (url1 url2)
+ "Return non-nil if boths URLs represent the same page.
+Differences in #targets are ignored."
+ (let ((obj1 (url-generic-parse-url url1))
+ (obj2 (url-generic-parse-url url2)))
+ (setf (url-target obj1) nil)
+ (setf (url-target obj2) nil)
+ (equal (url-recreate-url obj1) (url-recreate-url obj2))))
+
+(defun eww-copy-page-url ()
(interactive)
- (message eww-current-url)
+ (message "%s" eww-current-url)
(kill-new eww-current-url))
+
+(defun eww-download ()
+ "Download URL under point to `eww-download-directory'."
+ (interactive)
+ (let ((url (get-text-property (point) 'shr-url)))
+ (if (not url)
+ (message "No URL under point")
+ (url-retrieve url 'eww-download-callback (list url)))))
+
+(defun eww-download-callback (status url)
+ (unless (plist-get status :error)
+ (let* ((obj (url-generic-parse-url url))
+ (path (car (url-path-and-query obj)))
+ (file (eww-make-unique-file-name (file-name-nondirectory path)
+ eww-download-path)))
+ (write-file file)
+ (message "Saved %s" file))))
+
+(defun eww-make-unique-file-name (file directory)
+ (cond
+ ((zerop (length file))
+ (setq file "!"))
+ ((string-match "\\`[.]" file)
+ (setq file (concat "!" file))))
+ (let ((count 1))
+ (while (file-exists-p (expand-file-name file directory))
+ (setq file
+ (if (string-match "\\`\\(.*\\)\\([.][^.]+\\)" file)
+ (format "%s(%d)%s" (match-string 1 file)
+ count (match-string 2 file))
+ (format "%s(%d)" file count)))
+ (setq count (1+ count)))
+ (expand-file-name file directory)))
+
+;;; Bookmarks code
+
+(defvar eww-bookmarks nil)
+
+(defun eww-add-bookmark ()
+ "Add the current page to the bookmarks."
+ (interactive)
+ (eww-read-bookmarks)
+ (dolist (bookmark eww-bookmarks)
+ (when (equal eww-current-url
+ (plist-get bookmark :url))
+ (error "Already bookmarked")))
+ (if (y-or-n-p "bookmark this page? ")
+ (progn
+ (let ((title (replace-regexp-in-string "[\n\t\r]" " " eww-current-title)))
+ (setq title (replace-regexp-in-string "\\` +\\| +\\'" "" title))
+ (push (list :url eww-current-url
+ :title title
+ :time (current-time-string))
+ eww-bookmarks))
+ (eww-write-bookmarks)
+ (message "Bookmarked %s (%s)" eww-current-url eww-current-title))))
+
+(defun eww-write-bookmarks ()
+ (with-temp-file (expand-file-name "eww-bookmarks" user-emacs-directory)
+ (insert ";; Auto-generated file; don't edit\n")
+ (pp eww-bookmarks (current-buffer))))
+
+(defun eww-read-bookmarks ()
+ (let ((file (expand-file-name "eww-bookmarks" user-emacs-directory)))
+ (setq eww-bookmarks
+ (unless (zerop (or (nth 7 (file-attributes file)) 0))
+ (with-temp-buffer
+ (insert-file-contents file)
+ (read (current-buffer)))))))
+
+(defun eww-list-bookmarks ()
+ "Display the bookmarks."
+ (interactive)
+ (eww-bookmark-prepare)
+ (pop-to-buffer "*eww bookmarks*"))
+
+(defun eww-bookmark-prepare ()
+ (eww-read-bookmarks)
+ (when (null eww-bookmarks)
+ (error "No bookmarks are defined"))
+ (set-buffer (get-buffer-create "*eww bookmarks*"))
+ (eww-bookmark-mode)
+ (let ((format "%-40s %s")
+ (inhibit-read-only t)
+ start url)
+ (erase-buffer)
+ (setq header-line-format (concat " " (format format "URL" "Title")))
+ (dolist (bookmark eww-bookmarks)
+ (setq start (point))
+ (setq url (plist-get bookmark :url))
+ (when (> (length url) 40)
+ (setq url (substring url 0 40)))
+ (insert (format format url
+ (plist-get bookmark :title))
+ "\n")
+ (put-text-property start (1+ start) 'eww-bookmark bookmark))
+ (goto-char (point-min))))
+
+(defvar eww-bookmark-kill-ring nil)
+
+(defun eww-bookmark-kill ()
+ "Kill the current bookmark."
+ (interactive)
+ (let* ((start (line-beginning-position))
+ (bookmark (get-text-property start 'eww-bookmark))
+ (inhibit-read-only t))
+ (unless bookmark
+ (error "No bookmark on the current line"))
+ (forward-line 1)
+ (push (buffer-substring start (point)) eww-bookmark-kill-ring)
+ (delete-region start (point))
+ (setq eww-bookmarks (delq bookmark eww-bookmarks))
+ (eww-write-bookmarks)))
+
+(defun eww-bookmark-yank ()
+ "Yank a previously killed bookmark to the current line."
+ (interactive)
+ (unless eww-bookmark-kill-ring
+ (error "No previously killed bookmark"))
+ (beginning-of-line)
+ (let ((inhibit-read-only t)
+ (start (point))
+ bookmark)
+ (insert (pop eww-bookmark-kill-ring))
+ (setq bookmark (get-text-property start 'eww-bookmark))
+ (if (= start (point-min))
+ (push bookmark eww-bookmarks)
+ (let ((line (count-lines start (point))))
+ (setcdr (nthcdr (1- line) eww-bookmarks)
+ (cons bookmark (nthcdr line eww-bookmarks)))))
+ (eww-write-bookmarks)))
+
+(defun eww-bookmark-quit ()
+ "Kill the current buffer."
+ (interactive)
+ (kill-buffer (current-buffer)))
+
+(defun eww-bookmark-browse ()
+ "Browse the bookmark under point in eww."
+ (interactive)
+ (let ((bookmark (get-text-property (line-beginning-position) 'eww-bookmark)))
+ (unless bookmark
+ (error "No bookmark on the current line"))
+ ;; We wish to leave this window, but if it's the only window here,
+ ;; just let it remain.
+ (ignore-errors
+ (delete-window))
+ (eww-browse-url (plist-get bookmark :url))))
+
+(defun eww-next-bookmark ()
+ "Go to the next bookmark in the list."
+ (interactive)
+ (let ((first nil)
+ bookmark)
+ (unless (get-buffer "*eww bookmarks*")
+ (setq first t)
+ (eww-bookmark-prepare))
+ (with-current-buffer (get-buffer "*eww bookmarks*")
+ (when (and (not first)
+ (not (eobp)))
+ (forward-line 1))
+ (setq bookmark (get-text-property (line-beginning-position)
+ 'eww-bookmark))
+ (unless bookmark
+ (error "No next bookmark")))
+ (eww-browse-url (plist-get bookmark :url))))
+
+(defun eww-previous-bookmark ()
+ "Go to the previous bookmark in the list."
+ (interactive)
+ (let ((first nil)
+ bookmark)
+ (unless (get-buffer "*eww bookmarks*")
+ (setq first t)
+ (eww-bookmark-prepare))
+ (with-current-buffer (get-buffer "*eww bookmarks*")
+ (if first
+ (goto-char (point-max))
+ (beginning-of-line))
+ ;; On the final line.
+ (when (eolp)
+ (forward-line -1))
+ (if (bobp)
+ (error "No previous bookmark")
+ (forward-line -1))
+ (setq bookmark (get-text-property (line-beginning-position)
+ 'eww-bookmark)))
+ (eww-browse-url (plist-get bookmark :url))))
+
+(defvar eww-bookmark-mode-map
+ (let ((map (make-sparse-keymap)))
+ (suppress-keymap map)
+ (define-key map "q" 'eww-bookmark-quit)
+ (define-key map [(control k)] 'eww-bookmark-kill)
+ (define-key map [(control y)] 'eww-bookmark-yank)
+ (define-key map "\r" 'eww-bookmark-browse)
+ map))
+
+(define-derived-mode eww-bookmark-mode nil "eww bookmarks"
+ "Mode for listing bookmarks.
+
+\\{eww-bookmark-mode-map}"
+ (buffer-disable-undo)
+ (setq buffer-read-only t
+ truncate-lines t))
+
(provide 'eww)
;;; eww.el ends here
HCoop / bpt / emacs.git / blobdiff