mirror/emacs
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2024-11-28 07:45:00 +00:00
Code Issues Releases Activity
ea55048823
emacs/lisp/net/eww.el

2966 lines
106 KiB
EmacsLisp
Raw Blame History

;;; eww.el --- Emacs Web Wowser -*- lexical-binding:t -*-
;; Copyright (C) 2013-2024 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: html
;; This file is part of GNU Emacs.
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;; Code:
(require 'cl-lib)
(require 'mm-url)
(require 'puny)
(require 'shr)
(require 'text-property-search)
(require 'thingatpt)
(require 'url)
(require 'url-queue)
(require 'url-file)
(require 'vtable)
(require 'xdg)
(eval-when-compile (require 'subr-x))
(defgroup eww nil
"Emacs Web Wowser."
:version "25.1"
:link '(custom-manual "(eww) Top")
:group 'web
:prefix "eww-")
(defcustom eww-header-line-format "%t: %u"
"Header line format.
- %t is replaced by the title.
- %u is replaced by the URL."
:version "24.4"
:group 'eww
:type 'string)
(defcustom eww-search-prefix "https://duckduckgo.com/html/?q="
"Prefix URL to search engine."
:version "24.4"
:group 'eww
:type 'string)
(defcustom eww-use-browse-url "\\`mailto:"
"EWW will use `browse-url' when following links that match this regexp.
The action to be taken can be further customized via
`browse-url-handlers'."
:version "28.1"
:type 'regexp)
(defcustom eww-default-download-directory "~/Downloads/"
"Default directory where `eww' saves downloaded files.
Used by `eww--download-directory', which see."
:version "29.1"
:group 'eww
:type 'directory)
(defun eww--download-directory ()
"Return the name of the EWW download directory.
The default is specified by `eww-default-download-directory'; however,
if that directory doesn't exist and the DOWNLOAD XDG user directory
is defined, use the latter instead."
(or (and (file-exists-p eww-default-download-directory)
eww-default-download-directory)
(when-let* ((dir (xdg-user-dir "DOWNLOAD")))
(file-name-as-directory dir))
eww-default-download-directory))
(defcustom eww-download-directory 'eww--download-directory
"Directory where files will downloaded.
This should either be a directory name or a function (called with
no parameters) that returns a directory name."
:version "28.1"
:group 'eww
:type '(choice directory function))
;;;###autoload
(defcustom eww-suggest-uris
'(eww-links-at-point
thing-at-point-url-at-point
eww-current-url
eww-bookmark-urls)
"List of functions called to form the list of default URIs for `eww'.
Each of the elements is a function returning either a string or a list
of strings. The results will be joined into a single list with
duplicate entries (if any) removed."
:version "30.1"
:group 'eww
:type 'hook
:options '(eww-links-at-point
thing-at-point-url-at-point
eww-current-url
eww-bookmark-urls))
(defcustom eww-guess-content-type-functions
'(eww--html-if-doctype)
"List of functions used by EWW to guess the content-type of Web pages.
These are only used when the page does not have a valid Content-Type
header. Functions are called in order, until one of them returns a
non-nil value to be used as Content-Type. The functions receive two
arguments: an alist of page's headers, and the buffer that holds the
complete response of the server from which the page was requested.
If the list of the functions is exhausted without any non-nil value,
EWW assumes content-type is \"application/octet-stream\", per RFC-9110."
:version "31.1"
:group 'eww
:type '(repeat function))
(defcustom eww-bookmarks-directory user-emacs-directory
"Directory where bookmark files will be stored."
:version "25.1"
:group 'eww
:type 'directory)
(defcustom eww-desktop-remove-duplicates t
"Whether to remove duplicates from the history when saving desktop data.
If non-nil, repetitive EWW history entries (comprising of the URI, the
title, and the point position) will not be saved as part of the Emacs
desktop. Otherwise, such entries will be retained."
:version "25.1"
:group 'eww
:type 'boolean)
(defcustom eww-restore-desktop nil
"How to restore EWW buffers on `desktop-restore'.
If t or `auto', the buffers will be reloaded automatically.
If nil, buffers will require manual reload, and will contain the text
specified in `eww-restore-reload-prompt' instead of the actual Web
page contents."
:version "25.1"
:group 'eww
:type '(choice (const :tag "Restore all automatically" t)
(const :tag "Require manual reload" nil)))
(defcustom eww-restore-reload-prompt
"\n\n *** Use \\[eww-reload] to reload this buffer. ***\n"
"The string to put in the buffers not reloaded on `desktop-restore'.
This prompt will be used if `eww-restore-desktop' is nil.
The string will be passed through `substitute-command-keys'."
:version "25.1"
:group 'eww
:type 'string)
(defcustom eww-history-limit 50
"Maximum number of entries to retain in the history."
:version "25.1"
:group 'eww
:type '(choice (const :tag "Unlimited" nil)
integer))
(defcustom eww-retrieve-command nil
"Command to retrieve an URL via an external program.
If nil, `url-retrieve' is used to download the data.
If `sync', `url-retrieve-synchronously' is used.
For other non-nil values, this should be a list of strings where
the first item is the program, and the rest are the arguments."
:version "28.1"
:type '(choice (const :tag "Use `url-retrieve'" nil)
(const :tag "Use `url-retrieve-synchronously'" sync)
(repeat :tag "Command/args" 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-browse-url-new-window-is-tab 'tab-bar
"Whether to open up new windows in a tab or a new buffer.
If t, then open the URL in a new tab rather than a new buffer if
`eww-browse-url' is asked to open it in a new window.
If `tab-bar', then open the URL in a new tab only when
the tab bar is enabled."
:version "27.1"
:group 'eww
:type '(choice (const :tag "Always open URL in new tab" t)
(const :tag "Open new tab when tab bar is enabled" tab-bar)
(const :tag "Never open URL in new tab" nil)))
(defcustom eww-before-browse-history-function #'eww-delete-future-history
"A function to call to update history before browsing to a new page.
EWW provides the following values for this option:
* `eww-delete-future-history': Delete any history entries after the
currently-shown one. This is the default behavior, and works the same
as in most other web browsers.
* `eww-clone-previous-history': Clone and prepend any history entries up
to the currently-shown one. This is like `eww-delete-future-history',
except that it preserves the previous contents of the history list at
the end.
* `ignore': Preserve the current history unchanged. This will result in
the new page simply being prepended to the existing history list.
You can also set this to any other function you wish."
:version "30.1"
:group 'eww
:type '(choice (function-item :tag "Delete future history"
eww-delete-future-history)
(function-item :tag "Clone previous history"
eww-clone-previous-history)
(function-item :tag "Preserve history"
ignore)
(function :tag "Custom function")))
(defcustom eww-after-render-hook nil
"A hook called after eww has finished rendering the buffer."
:version "25.1"
:group 'eww
:type 'hook)
(defcustom eww-auto-rename-buffer nil
"Automatically rename EWW buffers once the page is rendered.
When nil, do not rename the buffer. With a non-nil value
determine the renaming scheme, as follows:
- `title': Use the web page's title.
- `url': Use the web page's URL.
- a function's symbol: Run a user-defined function that returns a
string with which to rename the buffer. Sample of a
user-defined function:
(defun my-eww-rename-buffer ()
(when (eq major-mode \\='eww-mode)
(when-let* ((string (or (plist-get eww-data :title)
(plist-get eww-data :url))))
(format \"*%s*\" string))))
The string of `title' and `url' is always truncated to the value
of `eww-buffer-name-length'."
:version "29.1"
:type '(choice
(const :tag "Do not rename buffers (default)" nil)
(const :tag "Rename buffer to web page title" title)
(const :tag "Rename buffer to web page URL" url)
(function :tag "A user-defined function to rename the buffer"))
:group 'eww)
(defcustom eww-buffer-name-length 40
"Length of renamed buffer name, per `eww-auto-rename-buffer'."
:type 'natnum
:version "29.1"
:group 'eww)
(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))
(defcustom eww-url-transformers '(eww-remove-tracking)
"This is a list of transforming functions applied to an URL before usage.
The functions will be called with the URL as the single
parameter, and should return the (possibly) transformed URL."
:type '(repeat function)
:version "29.1")
(defcustom eww-readable-urls nil
"A list of regexps matching URLs to display in readable mode by default.
EWW will display matching URLs using `eww-readable' (which see).
Each element can be one of the following forms: a regular expression in
string form or a cons cell of the form (REGEXP . READABILITY). If
READABILITY is non-nil, this behaves the same as the string form;
otherwise, URLs matching REGEXP will never be displayed in readable mode
by default."
:type '(repeat (choice (string :tag "Readable URL")
(cons :tag "URL and Readability"
(string :tag "URL")
(radio (const :tag "Readable" t)
(const :tag "Non-readable" nil)))))
:version "30.1")
(defcustom eww-readable-adds-to-history t
"If non-nil, calling `eww-readable' adds a new entry to the history."
:type 'boolean
:version "30.1")
(defface eww-form-submit
'((((type x w32 ns haiku pgtk android) (class color)) ; Like default mode line
:box (:line-width 2 :style released-button)
:background "#808080" :foreground "black"))
"Face for eww buffer buttons."
:version "24.4"
:group 'eww)
(defface eww-form-file
'((((type x w32 ns haiku pgtk android) (class color)) ; Like default mode line
:box (:line-width 2 :style released-button)
:background "#808080" :foreground "black"))
"Face for eww buffer buttons."
:version "25.1"
:group 'eww)
(defface eww-form-checkbox
'((((type x w32 ns haiku pgtk android) (class color)) ; Like default mode line
:box (:line-width 2 :style released-button)
:background "lightgrey" :foreground "black"))
"Face for eww buffer buttons."
:version "24.4"
:group 'eww)
(defface eww-form-select
'((((type x w32 ns haiku pgtk android) (class color)) ; Like default mode line
:box (:line-width 2 :style released-button)
:background "lightgrey" :foreground "black"))
"Face for eww buffer buttons."
:version "24.4"
:group 'eww)
(defface eww-form-text
'((t :background "#505050"
:foreground "white"
:box (:line-width 1)))
"Face for eww text inputs."
:version "24.4"
:group 'eww)
(defface eww-form-textarea
'((t :background "#C0C0C0"
:foreground "black"
:box (:line-width 1)))
"Face for eww textarea inputs."
:version "24.4"
:group 'eww)
(defface eww-invalid-certificate
'((default :weight bold)
(((class color)) :foreground "red"))
"Face for web pages with invalid certificates."
:version "25.1"
:group 'eww)
(defface eww-valid-certificate
'((default :weight bold)
(((class color)) :foreground "ForestGreen"))
"Face for web pages with valid certificates."
:version "25.1"
:group 'eww)
(defvar eww-data nil)
(defvar eww-history nil)
(defvar eww-history-position 0
"The 1-indexed position in `eww-history'.
If zero, EWW is at the newest page, which isn't yet present in
`eww-history'.")
(defvar eww-prompt-history nil)
(defvar eww-local-regex "localhost"
"When this regex is found in the URL, it's not a keyword but an address.")
(defvar eww-accept-content-types
"text/html, text/plain, text/sgml, text/css, application/xhtml+xml, */*;q=0.01"
"Value used for the HTTP \"Accept\" header.")
(defvar-keymap eww-link-keymap
:parent shr-map
"RET" #'eww-follow-link
"<mouse-2>" #'eww-follow-link)
(defvar-keymap eww-image-link-keymap
:parent shr-image-map
"RET" #'eww-follow-link)
(defvar-keymap eww-minibuffer-url-keymap
:doc "Keymap used in the minibuffer prompt for URLs or keywords."
:parent minibuffer-local-completion-map
"SPC" #'self-insert-command
"?" #'self-insert-command)
(defun eww-suggested-uris nil
"Return the list of URIs to suggest at the `eww' prompt.
This list can be customized via `eww-suggest-uris'."
(let ((obseen (obarray-make 42))
(uris nil))
(dolist (fun eww-suggest-uris)
(let ((ret (funcall fun)))
(dolist (uri (if (stringp ret) (list ret) ret))
(when (and uri (not (intern-soft uri obseen)))
(intern uri obseen)
(push uri uris)))))
(nreverse uris)))
;;;###autoload
(defun eww-browse ()
"Function to be run to parse command line URLs.
This is meant to be used for MIME handlers or command line use.
Setting the handler for \"text/x-uri;\" to
\"emacs -f eww-browse %u\" will then start up Emacs and call eww
to browse the url.
This can also be used on the command line directly:
emacs -f eww-browse https://gnu.org
will start Emacs and browse the GNU web site."
(interactive)
(unless command-line-args-left
(user-error "No URL given"))
(eww (pop command-line-args-left)))
;;;###autoload
(defun eww (url &optional new-buffer buffer)
"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'.
If NEW-BUFFER is non-nil (interactively, the prefix arg), use a
new buffer instead of reusing the default EWW buffer.
If BUFFER, the data to be rendered is in that buffer. In that
case, this function doesn't actually fetch URL. BUFFER will be
killed after rendering.
For more information, see Info node `(eww) Top'."
(interactive
(let ((uris (eww-suggested-uris))
(minibuffer-local-completion-map eww-minibuffer-url-keymap))
(list (completing-read (format-prompt "Enter URL or keywords"
(and uris (car uris)))
(seq-uniq (append eww-prompt-history uris))
nil nil nil 'eww-prompt-history uris)
current-prefix-arg)))
(setq url (eww--dwim-expand-url url))
(pop-to-buffer-same-window
(cond
(new-buffer
(generate-new-buffer "*eww*"))
((eq major-mode 'eww-mode)
(current-buffer))
(t
(get-buffer-create "*eww*"))))
(eww-setup-buffer)
(eww--before-browse)
;; Check whether the domain only uses "Highly Restricted" Unicode
;; IDNA characters. If not, transform to punycode to indicate that
;; there may be funny business going on.
(let ((parsed (url-generic-parse-url url)))
(when (url-host parsed)
(unless (puny-highly-restrictive-domain-p (url-host parsed))
(setf (url-host parsed) (puny-encode-domain (url-host parsed)))))
;; When the URL is on the form "http://a/../../../g", chop off all
;; the leading "/.."s.
(when (url-filename parsed)
(while (string-match "\\`/[.][.]/" (url-filename parsed))
(setf (url-filename parsed) (substring (url-filename parsed) 3))))
(setq url (url-recreate-url parsed)))
(setq url (eww--transform-url url))
(plist-put eww-data :url url)
(plist-put eww-data :title "")
(eww--after-page-change)
(let ((inhibit-read-only t))
(insert (format "Loading %s..." url))
(goto-char (point-min)))
(let ((url-mime-accept-string eww-accept-content-types))
(if buffer
(let ((eww-buffer (current-buffer)))
(with-current-buffer buffer
(eww-render nil url nil eww-buffer)))
(eww-retrieve url #'eww-render
(list url nil (current-buffer))))))
(defun eww-retrieve (url callback cbargs)
(cond
((null eww-retrieve-command)
(url-retrieve url callback cbargs))
((eq eww-retrieve-command 'sync)
(let ((data-buffer (url-retrieve-synchronously url)))
(with-current-buffer data-buffer
(apply callback nil cbargs))))
(t
(let ((buffer (generate-new-buffer " *eww retrieve*"))
(error-buffer (generate-new-buffer " *eww error*")))
(with-current-buffer buffer
(set-buffer-multibyte nil)
(make-process
:name "*eww fetch*"
:buffer (current-buffer)
:stderr error-buffer
:command (append eww-retrieve-command (list url))
:sentinel (lambda (process _)
(unless (process-live-p process)
(when (buffer-live-p error-buffer)
(when (get-buffer-process error-buffer)
(delete-process (get-buffer-process error-buffer) ))
(kill-buffer error-buffer))
(when (buffer-live-p buffer)
(with-current-buffer buffer
(goto-char (point-min))
(insert "Content-type: text/html; charset=utf-8\n\n")
(apply #'funcall callback nil cbargs)))))))))))
(function-put 'eww 'browse-url-browser-kind 'internal)
(defun eww--dwim-expand-url (url)
(setq url (string-trim url))
(cond ((string-match-p "\\`file:/" url))
;; Don't mangle file: URLs at all.
((string-match-p "\\`ftp://" url)
(user-error "FTP is not supported"))
(t
;; Anything that starts with something that vaguely looks
;; like a protocol designator is interpreted as a full URL.
(if (or (string-match "\\`[A-Za-z]+:" url)
;; Also try to match "naked" URLs like
;; en.wikipedia.org/wiki/Free software
(string-match "\\`[A-Za-z_]+\\.[A-Za-z._]+/" url)
(and (= (length (split-string url)) 1)
(or (and (not (string-match-p "\\`[\"'].*[\"']\\'" url))
(> (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 sites do not redirect final /
(when (string= (url-filename (url-generic-parse-url url)) "")
(setq url (concat url "/"))))
(setq url (concat eww-search-prefix
(mapconcat
#'url-hexify-string (split-string url) "+"))))))
url)
(defun eww--preprocess-html (start end)
"Translate all < characters that do not look like start of tags into &lt;."
(save-excursion
(save-restriction
(narrow-to-region start end)
(goto-char start)
(let ((case-fold-search t))
(while (re-search-forward "<[^0-9a-z!?/]" nil t)
(goto-char (match-beginning 0))
(delete-region (point) (1+ (point)))
(insert "&lt;"))))))
;;;###autoload (defalias 'browse-web 'eww)
;;;###autoload
(defun eww-open-file (file &optional new-buffer)
"Render FILE using EWW.
If NEW-BUFFER is non-nil (interactively, the prefix arg), use a
new buffer instead of reusing the default EWW buffer."
(interactive "fFile: \nP")
(let ((url-allow-non-local-files t))
(eww (concat "file://"
(and (memq system-type '(windows-nt ms-dos))
"/")
(expand-file-name file))
new-buffer)))
(defun eww--file-buffer (file)
(with-current-buffer (generate-new-buffer " *eww file*")
(set-buffer-multibyte nil)
(insert "Content-type: " (or (mailcap-extension-to-mime
(url-file-extension file))
"application/octet-stream")
"\n\n")
(insert-file-contents file)
(current-buffer)))
;;;###autoload
(defun eww-search-words ()
"Search the web for the text in the region.
If region is active (and not whitespace), search the web for
the text between region beginning and end. Else, prompt the
user for a search string. See the variable `eww-search-prefix'
for the search engine used."
(interactive)
(if (use-region-p)
(let ((region-string (buffer-substring (region-beginning) (region-end))))
(if (not (string-match-p "\\`[ \n\t\r\v\f]*\\'" region-string))
(eww region-string)
(call-interactively #'eww)))
(call-interactively #'eww)))
(defun eww--open-url-in-new-buffer (url)
"Open the URL in a new EWW buffer."
;; Clone is useful to keep history, but we
;; should not clone from a non-eww buffer.
(with-current-buffer
(if (eq major-mode 'eww-mode) (clone-buffer)
(generate-new-buffer "*eww*"))
(unless (equal url (eww-current-url))
(eww-mode)
(eww (if (consp url) (car url) url)))))
(defun eww-open-in-new-buffer (&optional no-select url)
"Fetch URL (interactively, the link at point) into a new EWW buffer.
NO-SELECT non-nil means do not make the new buffer the current buffer."
(interactive "P")
(if-let* ((url (or url (eww-suggested-uris))))
(if (or (eq eww-browse-url-new-window-is-tab t)
(and (eq eww-browse-url-new-window-is-tab 'tab-bar)
tab-bar-mode))
(let ((tab-bar-new-tab-choice t))
(tab-new)
(eww--open-url-in-new-buffer url)
(when no-select
(tab-bar-switch-to-recent-tab)))
(if no-select
(save-window-excursion (eww--open-url-in-new-buffer url))
(eww--open-url-in-new-buffer url)))
(user-error "No link at point")))
(defun eww-html-p (content-type)
"Return non-nil if CONTENT-TYPE designates an HTML content type.
Currently this means either text/html or application/xhtml+xml."
(member content-type '("text/html"
"application/xhtml+xml")))
(defun eww--guess-content-type (headers response-buffer)
"Use HEADERS and RESPONSE-BUFFER to guess the Content-Type.
Will call each function in `eww-guess-content-type-functions', until one
of them returns a value. This mechanism is used only if there isn't a
valid Content-Type header. If none of the functions can guess, return
\"application/octet-stream\"."
(save-excursion
(or (run-hook-with-args-until-success
'eww-guess-content-type-functions headers response-buffer)
"application/octet-stream")))
(defun eww--html-if-doctype (_headers response-buffer)
"Return \"text/html\" if RESPONSE-BUFFER has an HTML doctype declaration.
HEADERS is unused."
;; https://html.spec.whatwg.org/multipage/syntax.html#the-doctype
(with-current-buffer response-buffer
(let ((case-fold-search t))
(save-excursion
(goto-char (point-min))
;; Match basic "<!doctype html>" and also legacy variants as
;; specified in link above -- being purposely lax about it.
(when (search-forward "<!doctype html" nil t)
"text/html")))))
(defun eww--rename-buffer ()
"Rename the current EWW buffer.
The renaming scheme is performed in accordance with
`eww-auto-rename-buffer'."
(let ((rename-string)
(formatter
(lambda (string)
(format "*%s # eww*" (truncate-string-to-width
string eww-buffer-name-length))))
(site-title (plist-get eww-data :title))
(site-url (plist-get eww-data :url)))
(cond ((null eww-auto-rename-buffer))
((eq eww-auto-rename-buffer 'url)
(setq rename-string (funcall formatter site-url)))
((functionp eww-auto-rename-buffer)
(setq rename-string (funcall eww-auto-rename-buffer)))
(t (setq rename-string
(funcall formatter (if (or (equal site-title "")
(null site-title))
"Untitled"
site-title)))))
(when rename-string
(rename-buffer rename-string t))))
(defun eww-render (status url &optional point buffer encode)
(let* ((headers (eww-parse-headers))
(content-type
(mail-header-parse-content-type
(if (zerop (length (cdr (assoc "content-type" headers))))
(eww--guess-content-type headers (current-buffer))
(cdr (assoc "content-type" headers)))))
(charset (intern
(downcase
(or (cdr (assq 'charset (cdr content-type)))
(eww-detect-charset (eww-html-p (car content-type)))
"utf-8"))))
(data-buffer (current-buffer))
(shr-target-id (url-target (url-generic-parse-url url)))
last-coding-system-used)
(let ((redirect (plist-get status :redirect)))
(when redirect
(setq url redirect)))
(when (buffer-live-p buffer)
(with-current-buffer buffer
;; Save the https peer status.
(plist-put eww-data :peer (plist-get status :peer))
;; Make buffer listings more informative.
(setq list-buffers-directory url)
;; Let the URL library have a handle to the current URL for
;; referer purposes.
(setq url-current-lastloc (url-generic-parse-url url)))
(unwind-protect
(progn
(cond
((and eww-use-external-browser-for-content-type
(string-match-p eww-use-external-browser-for-content-type
(car content-type)))
(erase-buffer)
(insert "<title>Unsupported content type</title>")
(insert (format "<h1>Content-type %s is unsupported</h1>"
(car content-type)))
(insert (format "<a href=%S>Direct link to the document</a>"
url))
(goto-char (point-min))
(eww-display-html (or encode charset) url nil point buffer))
((eww-html-p (car content-type))
(eww-display-html (or encode charset) url nil point buffer))
((equal (car content-type) "application/pdf")
(eww-display-pdf))
((string-match-p "\\`image/" (car content-type))
(eww-display-image buffer))
(t
(eww-display-raw buffer (or encode charset 'utf-8))))
(with-current-buffer buffer
(plist-put eww-data :url url)
(eww--after-page-change)
(and last-coding-system-used
(set-buffer-file-coding-system last-coding-system-used))
(unless shr-fill-text
(visual-line-mode)
(visual-wrap-prefix-mode))
(run-hooks 'eww-after-render-hook)
;; Enable undo again so that undo works in text input
;; boxes.
(setq buffer-undo-list nil)))
(kill-buffer data-buffer)))
(unless (buffer-live-p buffer)
(kill-buffer data-buffer))))
(defun eww-parse-headers ()
(let ((headers nil))
(goto-char (point-min))
(while (and (not (eobp))
(not (eolp)))
(when (looking-at "\\([^:]+\\): *\\(.*\\)")
(push (cons (downcase (match-string 1))
(match-string 2))
headers))
(forward-line 1))
(unless (eobp)
(forward-line 1))
headers))
(defun eww-detect-charset (html-p)
(let ((case-fold-search t)
(pt (point)))
(or (and html-p
(re-search-forward
"<meta[\t\n\r ]+[^>]*charset=\"?\\([^\t\n\r \"/>]+\\)[\\\"'.*]" nil t)
(goto-char pt)
(match-string 1))
(and (looking-at
"[\t\n\r ]*<\\?xml[\t\n\r ]+[^>]*encoding=\"\\([^\"]+\\)")
(match-string 1)))))
(declare-function libxml-parse-html-region "xml.c"
(start end &optional base-url discard-comments))
(defun eww--parse-html-region (start end &optional coding-system)
"Parse the HTML between START and END, returning the DOM as an S-expression.
Use CODING-SYSTEM to decode the region; if nil, decode as UTF-8.
This replaces the region with the preprocessed HTML."
(setq coding-system (or coding-system 'utf-8))
(with-restriction start end
(condition-case nil
(decode-coding-region (point-min) (point-max) coding-system)
(coding-system-error nil))
;; Remove CRLF and replace NUL with &#0; before parsing.
(while (re-search-forward "\\(\r$\\)\\|\0" nil t)
(replace-match (if (match-beginning 1) "" "&#0;") t t))
(eww--preprocess-html (point-min) (point-max))
(libxml-parse-html-region (point-min) (point-max))))
(defsubst eww-document-base (url dom)
`(base ((href . ,url)) ,dom))
(defun eww-display-document (document &optional point buffer)
(unless (fboundp 'libxml-parse-html-region)
(error "This function requires Emacs to be compiled with libxml2"))
(setq buffer (or buffer (current-buffer)))
(unless (buffer-live-p buffer)
(error "Buffer %s doesn't exist" buffer))
;; There should be a better way to abort loading images
;; asynchronously.
(setq url-queue nil)
(let ((url (when (eq (car document) 'base)
(alist-get 'href (cadr document)))))
(unless url
(error "Document is missing base URL"))
(with-current-buffer buffer
(setq bidi-paragraph-direction nil)
(plist-put eww-data :dom document)
(let ((inhibit-read-only t)
(inhibit-modification-hooks t)
;; Possibly set by the caller, e.g., `eww-render' which
;; preserves the old URL #target before chasing redirects.
(shr-target-id (or shr-target-id
(url-target (url-generic-parse-url url))))
(shr-external-rendering-functions
(append
shr-external-rendering-functions
'((title . eww-tag-title)
(form . eww-tag-form)
(input . eww-tag-input)
(button . eww-form-submit)
(textarea . eww-tag-textarea)
(select . eww-tag-select)
(link . eww-tag-link)
(meta . eww-tag-meta)
(a . eww-tag-a)))))
(erase-buffer)
(with-delayed-message (2 "Rendering HTML...")
(shr-insert-document document))
(cond
(point
(goto-char point))
(shr-target-id
(goto-char (point-min))
(let ((match (text-property-search-forward
'shr-target-id shr-target-id #'member)))
(when match
(goto-char (prop-match-beginning match)))))
(t
(goto-char (point-min))
;; Don't leave point inside forms, because the normal eww
;; commands aren't available there.
(while (and (not (eobp))
(get-text-property (point) 'eww-form))
(forward-line 1)))))
(eww-size-text-inputs))))
(defun eww-display-html (charset url &optional document point buffer)
(let ((source (buffer-substring (point) (point-max))))
(with-current-buffer buffer
(plist-put eww-data :source source)))
(unless document
(let ((dom (eww--parse-html-region (point) (point-max) charset)))
(when (eww-default-readable-p url)
(eww-score-readability dom)
(setq dom (eww-highest-readability dom))
(with-current-buffer buffer
(plist-put eww-data :readable t)))
(setq document (eww-document-base url dom))))
(eww-display-document document point buffer))
(defun eww-handle-link (dom)
(let* ((rel (dom-attr dom 'rel))
(href (dom-attr dom 'href))
(where (assoc
;; The text associated with :rel is case-insensitive.
(if rel (downcase rel))
'(("next" . :next)
;; Texinfo uses "previous", but HTML specifies
;; "prev", so recognize both.
("previous" . :previous)
("prev" . :previous)
;; HTML specifies "start" but also "contents",
;; and Gtk seems to use "home". Recognize
;; them all; but store them in different
;; variables so that we can readily choose the
;; "best" one.
("start" . :start)
("home" . :home)
("contents" . :contents)
("up" . :up)))))
(when (and href where)
(when (memq (cdr where) '(:next :previous))
;; Multi-page isearch support.
(setq-local multi-isearch-next-buffer-function
#'eww-isearch-next-buffer))
(plist-put eww-data (cdr where) href))))
(defvar eww-redirect-level 1)
(defun eww-tag-meta (dom)
(when (and (cl-equalp (dom-attr dom 'http-equiv) "refresh")
(< eww-redirect-level 5))
(when-let* ((refresh (dom-attr dom 'content)))
(when (or (string-match "^\\([0-9]+\\) *;.*url=\"\\([^\"]+\\)\"" refresh)
(string-match "^\\([0-9]+\\) *;.*url='\\([^']+\\)'" refresh)
(string-match "^\\([0-9]+\\) *;.*url=\\([^ ]+\\)" refresh))
(let ((timeout (match-string 1 refresh))
(url (match-string 2 refresh))
(eww-redirect-level (1+ eww-redirect-level)))
(if (equal timeout "0")
(eww (shr-expand-url url))
(eww-tag-a
(dom-node 'a `((href . ,(shr-expand-url url)))
(format "Auto refresh in %s second%s disabled"
timeout
(if (equal timeout "1")
""
"s"))))))))))
(defun eww-tag-link (dom)
(eww-handle-link dom)
(shr-generic dom))
(defun eww-tag-a (dom)
(eww-handle-link dom)
(let ((start (point)))
(shr-tag-a dom)
(if (dom-attr dom 'href)
(put-text-property start (point)
'keymap
(if (mm-images-in-region-p start (point))
eww-image-link-keymap
eww-link-keymap)))))
(defun eww--limit-string-pixelwise (string pixels)
(if (not pixels)
string
(with-temp-buffer
(insert string)
(if (< (eww--pixel-column) pixels)
string
;; Iterate to find appropriate length.
(while (and (> (eww--pixel-column) pixels)
(not (bobp)))
(forward-char -1))
;; Return at least one character.
(buffer-substring (point-min) (max (point)
(1+ (point-min))))))))
(defun eww--pixel-column ()
(if (not (get-buffer-window (current-buffer)))
(save-window-excursion
;; Avoid errors if the selected window is a dedicated one,
;; and they just want to insert a document into it.
(set-window-dedicated-p nil nil)
(set-window-buffer nil (current-buffer))
(car (window-text-pixel-size nil (line-beginning-position) (point))))
(car (window-text-pixel-size nil (line-beginning-position) (point)))))
(defun eww-update-header-line-format ()
(setq header-line-format
(and eww-header-line-format
(let ((peer (plist-get eww-data :peer))
(url (plist-get eww-data :url))
(title (propertize
(if (zerop (length (plist-get eww-data :title)))
"[untitled]"
(plist-get eww-data :title))
'face 'variable-pitch)))
;; This connection is https.
(when peer
(add-face-text-property 0 (length title)
(if (plist-get peer :warnings)
'eww-invalid-certificate
'eww-valid-certificate)
t title))
;; Limit the length of the title so that the host name
;; of the URL is always visible.
(when url
(setq url (propertize url 'face 'variable-pitch))
(let* ((parsed (url-generic-parse-url url))
(host-length (string-pixel-width
(propertize
(format "%s://%s" (url-type parsed)
(url-host parsed))
'face 'variable-pitch)))
(width (window-width nil t)))
(cond
;; The host bit is wider than the window, so nix
;; the title.
((> (+ host-length (string-pixel-width "xxxxx")) width)
(setq title ""))
;; Trim the title.
((> (+ (string-pixel-width (concat title "xx"))
host-length)
width)
(setq title
(concat
(eww--limit-string-pixelwise
title (- width host-length
(string-pixel-width
(propertize "...: " 'face
'variable-pitch))))
(propertize "..." 'face 'variable-pitch)))))))
(string-replace
"%" "%%"
(format-spec
eww-header-line-format
`((?u . ,(or url ""))
(?t . ,title))))))))
(defun eww--before-browse ()
(funcall eww-before-browse-history-function)
(setq eww-history-position 0
eww-data (list :title "")))
(defun eww--after-page-change ()
(eww-update-header-line-format)
(eww--rename-buffer))
(defun eww-tag-title (dom)
(plist-put eww-data :title
(replace-regexp-in-string
"^ \\| $" ""
(replace-regexp-in-string "[ \t\r\n]+" " " (dom-text dom))))
(eww--after-page-change))
(defun eww-display-raw (buffer &optional encode)
(let ((data (buffer-substring (point) (point-max))))
(unless (buffer-live-p buffer)
(error "Buffer %s doesn't exist" buffer))
(with-current-buffer buffer
(let ((inhibit-read-only t))
(erase-buffer)
(insert data)
(condition-case nil
(decode-coding-region (point-min) (1+ (length data)) encode)
(coding-system-error nil)))
(goto-char (point-min)))))
(defun eww-display-image (buffer)
(let ((data (shr-parse-image-data)))
(unless (buffer-live-p buffer)
(error "Buffer %s doesn't exist" buffer))
(with-current-buffer buffer
(let ((inhibit-read-only t))
(erase-buffer)
(shr-put-image data nil))
(goto-char (point-min)))))
(declare-function mailcap-view-mime "mailcap" (type))
(defun eww-display-pdf ()
(let ((buf (current-buffer))
(pos (point)))
(with-current-buffer (get-buffer-create "*eww pdf*")
(let ((inhibit-read-only t))
(erase-buffer)
(set-buffer-multibyte nil)
(insert-buffer-substring buf pos)
(mailcap-view-mime "application/pdf"))
(if (zerop (buffer-size))
;; Buffer contents passed to shell command via temporary file.
(kill-buffer)
(goto-char (point-min))
(pop-to-buffer-same-window (current-buffer))))))
(defun eww-setup-buffer ()
(when (or (plist-get eww-data :url)
(plist-get eww-data :dom))
(eww-save-history))
(let ((inhibit-read-only t))
(remove-overlays)
(erase-buffer))
(setq bidi-paragraph-direction nil)
;; May be set later if there's a next/prev link.
(setq-local multi-isearch-next-buffer-function nil)
(unless (eq major-mode 'eww-mode)
(eww-mode))
(buffer-disable-undo))
(defun eww-current-url nil
"Return URI of the Web page the current EWW buffer is visiting."
(plist-get eww-data :url))
(defun eww-links-at-point ()
"Return list of URIs, if any, linked at point."
(seq-filter #'stringp
(list (get-text-property (point) 'shr-url)
(get-text-property (point) 'image-url))))
(defun eww-view-source ()
"View the HTML source code of the current page."
(interactive nil eww-mode)
(let ((buf (get-buffer-create "*eww-source*"))
(source (plist-get eww-data :source)))
(with-current-buffer buf
(let ((inhibit-read-only t))
(delete-region (point-min) (point-max))
(insert (or source "no source"))
(goto-char (point-min))
;; Decode the source and set the buffer's encoding according
;; to what the HTML source specifies in its 'charset' header,
;; if any.
(let ((cs (find-auto-coding "" (point-max))))
(when (consp cs)
(setq cs (car cs))
(when (coding-system-p cs)
(decode-coding-region (point-min) (point-max) cs)
(setq buffer-file-coding-system last-coding-system-used))))
(cond
((fboundp 'mhtml-mode)
(mhtml-mode))
((fboundp 'html-mode)
(html-mode)))))
(view-buffer buf)))
(defun eww-toggle-paragraph-direction ()
"Cycle the paragraph direction between left-to-right, right-to-left and auto."
(interactive nil eww-mode)
(setq bidi-paragraph-direction
(cond ((eq bidi-paragraph-direction 'left-to-right)
nil)
((eq bidi-paragraph-direction 'right-to-left)
'left-to-right)
(t
'right-to-left)))
(message "The paragraph direction is now %s"
(if (null bidi-paragraph-direction)
"automatic"
bidi-paragraph-direction)))
(defun eww-readable (&optional arg)
"Toggle display of only the main \"readable\" parts of the current web page.
This command uses heuristics to find the parts of the web page that
contain the main textual portion, leaving out navigation menus and the
like.
If called interactively, toggle the display of the readable parts. If
the prefix argument is positive, display the readable parts, and if it
is zero or negative, display the full page.
If called from Lisp, toggle the display of the readable parts if ARG is
`toggle'. Display the readable parts if ARG is nil, omitted, or is a
positive number. Display the full page if ARG is a negative number.
When `eww-readable-adds-to-history' is non-nil, calling this function
adds a new entry to `eww-history'."
(interactive (list (if current-prefix-arg
(prefix-numeric-value current-prefix-arg)
'toggle))
eww-mode)
(let* ((old-data eww-data)
(make-readable (cond
((eq arg 'toggle)
(not (plist-get old-data :readable)))
((and (numberp arg) (< arg 1))
nil)
(t t)))
(dom (with-temp-buffer
(insert (plist-get old-data :source))
(eww--parse-html-region (point-min) (point-max))))
(base (plist-get eww-data :url)))
(when make-readable
(eww-score-readability dom)
(setq dom (eww-highest-readability dom)))
(when eww-readable-adds-to-history
(eww-save-history)
(eww--before-browse)
(dolist (elem '(:source :url :title :next :previous :up :peer))
(plist-put eww-data elem (plist-get old-data elem))))
(eww-display-document (eww-document-base base dom))
(plist-put eww-data :readable make-readable)
(eww--after-page-change)))
(defun eww-score-readability (node)
(let ((score -1))
(cond
((memq (dom-tag node) '(script head comment))
(setq score -2))
((eq (dom-tag node) 'meta)
(setq score -1))
((eq (dom-tag node) 'img)
(setq score 2))
((eq (dom-tag node) 'a)
(setq score (- (length (split-string (dom-text node))))))
(t
(dolist (elem (dom-children node))
(cond
((stringp elem)
(setq score (+ score (length (split-string elem)))))
((consp elem)
(setq score (+ score
(or (cdr (assoc :eww-readability-score (cdr elem)))
(eww-score-readability elem)))))))))
;; Cache the score of the node to avoid recomputing all the time.
(dom-set-attribute node :eww-readability-score score)
score))
(defun eww-highest-readability (node)
(let ((result node)
highest)
(dolist (elem (dom-non-text-children node))
(when (> (or (dom-attr
(setq highest (eww-highest-readability elem))
:eww-readability-score)
most-negative-fixnum)
(or (dom-attr result :eww-readability-score)
most-negative-fixnum))
;; We set a lower bound to how long we accept that the
;; readable portion of the page is going to be.
(when (> (length (split-string (dom-texts highest))) 100)
(setq result highest))))
result))
(defun eww-default-readable-p (url)
"Return non-nil if URL should be displayed in readable mode by default.
This consults the entries in `eww-readable-urls' (which see)."
(catch 'found
(let (result)
(dolist (regexp eww-readable-urls)
(if (consp regexp)
(setq result (cdr regexp)
regexp (car regexp))
(setq result t))
(when (string-match regexp url)
(throw 'found result))))))
(defvar-keymap eww-mode-map
"g" #'eww-reload ;FIXME: revert-buffer-function instead!
"G" #'eww
"M-RET" #'eww-open-in-new-buffer
"TAB" #'shr-next-link
"C-M-i" #'shr-previous-link
"<backtab>" #'shr-previous-link
"<delete>" #'scroll-down-command
"l" #'eww-back-url
"r" #'eww-forward-url
"n" #'eww-next-url
"p" #'eww-previous-url
"u" #'eww-up-url
"t" #'eww-top-url
"&" #'eww-browse-with-external-browser
"d" #'eww-download
"w" #'eww-copy-page-url
"A" #'eww-copy-alternate-url
"C" #'url-cookie-list
"v" #'eww-view-source
"R" #'eww-readable
"H" #'eww-list-histories
"E" #'eww-set-character-encoding
"s" #'eww-switch-to-buffer
"S" #'eww-list-buffers
"F" #'eww-toggle-fonts
"D" #'eww-toggle-paragraph-direction
"M-C" #'eww-toggle-colors
"M-I" #'eww-toggle-images
"b" #'eww-add-bookmark
"B" #'eww-list-bookmarks
"M-n" #'eww-next-bookmark
"M-p" #'eww-previous-bookmark
"<mouse-8>" #'eww-back-url
"<mouse-9>" #'eww-forward-url
:menu '("Eww"
["Exit" quit-window t]
["Close browser" quit-window t]
["Reload" eww-reload t]
["Follow URL in new buffer" eww-open-in-new-buffer]
["Back to previous page" eww-back-url
:active (< eww-history-position (length eww-history))]
["Forward to next page" eww-forward-url
:active (> eww-history-position 1)]
["Browse with external browser" eww-browse-with-external-browser t]
["Download" eww-download t]
["View page source" eww-view-source]
["Copy page URL" eww-copy-page-url t]
["List histories" eww-list-histories t]
["Switch to buffer" eww-switch-to-buffer t]
["List buffers" eww-list-buffers t]
["Add bookmark" eww-add-bookmark t]
["List bookmarks" eww-list-bookmarks t]
["List cookies" url-cookie-list t]
["Toggle fonts" eww-toggle-fonts t]
["Toggle colors" eww-toggle-colors t]
["Toggle images" eww-toggle-images t]
["Character Encoding" eww-set-character-encoding]
["Toggle Paragraph Direction" eww-toggle-paragraph-direction]))
(defun eww-context-menu (menu click)
"Populate MENU with eww commands at CLICK."
(define-key menu [eww-separator] menu-bar-separator)
(let ((easy-menu (make-sparse-keymap "Eww")))
(easy-menu-define nil easy-menu nil
'("Eww"
["Back to previous page" eww-back-url
:active (< eww-history-position (length eww-history))]
["Forward to next page" eww-forward-url
:active (> eww-history-position 1)]
["Reload" eww-reload t]))
(dolist (item (reverse (lookup-key easy-menu [menu-bar eww])))
(when (consp item)
(define-key menu (vector (car item)) (cdr item)))))
(when (or (mouse-posn-property (event-start click) 'shr-url)
(mouse-posn-property (event-start click) 'image-url))
(define-key menu [shr-mouse-browse-url-new-window]
`(menu-item "Follow URL in new window" ,(if browse-url-new-window-flag
'shr-mouse-browse-url
'shr-mouse-browse-url-new-window)
:help "Browse the URL under the mouse cursor in a new window"))
(define-key menu [shr-mouse-browse-url]
`(menu-item "Follow URL" ,(if browse-url-new-window-flag
'shr-mouse-browse-url-new-window
'shr-mouse-browse-url)
:help "Browse the URL under the mouse cursor")))
menu)
(defvar eww-tool-bar-map
(let ((map (make-sparse-keymap)))
(dolist (tool-bar-item
'((quit-window . "close")
(eww-reload . "refresh")
(eww-back-url . "left-arrow")
(eww-forward-url . "right-arrow")
(eww-view-source . "show")
(eww-copy-page-url . "copy")
(eww-add-bookmark . "bookmark_add"))) ;; ...
(tool-bar-local-item-from-menu
(car tool-bar-item) (cdr tool-bar-item) map eww-mode-map))
map)
"Tool bar for `eww-mode'.")
(declare-function set-text-conversion-style "textconv.c")
(defun eww-check-text-conversion ()
"Check if point is within a field and toggle text conversion.
Set `text-conversion-style' to the value `action' if it isn't
already and point is within the prompt field, or if
`text-conversion-style' is nil, so as to guarantee that
the input method functions properly for the purpose of typing
within text input fields."
(when (and (eq major-mode 'eww-mode)
(fboundp 'set-text-conversion-style))
(if (eq (car-safe (get-text-property (point) 'field))
:eww-form)
(unless (eq text-conversion-style 'action)
(set-text-conversion-style 'action))
(unless (not text-conversion-style)
(set-text-conversion-style nil)))))
;; Autoload cookie needed by desktop.el.
;;;###autoload
(define-derived-mode eww-mode special-mode "eww"
"Mode for browsing the web.
\\{eww-mode-map}"
:interactive nil
(setq-local eww-data (list :title ""))
(setq-local browse-url-browser-function #'eww-browse-url)
(add-hook 'after-change-functions #'eww-process-text-input nil t)
(add-hook 'context-menu-functions 'eww-context-menu 5 t)
(setq-local eww-history nil)
(setq-local eww-history-position 0)
(when (boundp 'tool-bar-map)
(setq-local tool-bar-map eww-tool-bar-map))
;; desktop support
(setq-local desktop-save-buffer #'eww-desktop-misc-data)
(setq truncate-lines t)
;; visual-wrap-prefix-mode support
(setq-local adaptive-fill-function #'shr-adaptive-fill-function)
;; thingatpt support
(setq-local thing-at-point-provider-alist
(cons '(url . eww--url-at-point)
thing-at-point-provider-alist))
(setq-local forward-thing-provider-alist
(cons '(url . eww--forward-url)
forward-thing-provider-alist))
(setq-local bounds-of-thing-at-point-provider-alist
(cons '(url . eww--bounds-of-url-at-point)
bounds-of-thing-at-point-provider-alist))
(setq-local bookmark-make-record-function #'eww-bookmark-make-record)
(buffer-disable-undo)
(setq-local shr-url-transformer #'eww--transform-url)
;; Also rescale images when rescaling the text.
(add-hook 'text-scale-mode-hook #'eww--rescale-images nil t)
(setq-local outline-search-function 'shr-outline-search
outline-level 'shr-outline-level)
(add-hook 'post-command-hook #'eww-check-text-conversion nil t)
(setq buffer-read-only t)
;; Insertion at the first character of a field should inherit the
;; field's face, form and field, not the previous character's.
(setq text-property-default-nonsticky '((face . t) (eww-form . t)
(field . t))))
(declare-function imagep "image.c")
(defvar text-scale-mode)
(defvar text-scale-mode-amount)
(defun eww--rescale-images ()
(let ((scaling (if text-scale-mode
(+ 1 (* text-scale-mode-amount 0.1))
1)))
(save-excursion
(goto-char (point-min))
(while-let ((match (text-property-search-forward
'display nil
(lambda (_ value)
(and value (get-display-property
nil 'image nil value))))))
(let* ((image (cons 'image
(get-display-property nil 'image nil
(prop-match-value match))))
(original-scale (or (image-property image :original-scale)
(setf (image-property image :original-scale)
(or (image-property image :scale)
'default)))))
(when (eq original-scale 'default)
(setq original-scale (image-compute-scaling-factor
image-scaling-factor)))
(setf (image-property image :scale)
(* original-scale scaling)))))))
(defun eww--url-at-point ()
"`thing-at-point' provider function."
(thing-at-point-for-char-property 'shr-url))
(defun eww--forward-url (backward)
"`forward-thing' provider function."
(forward-thing-for-char-property 'shr-url backward))
(defun eww--bounds-of-url-at-point ()
"`bounds-of-thing-at-point' provider function."
(bounds-of-thing-at-point-for-char-property 'shr-url))
;;;###autoload
(defun eww-browse-url (url &optional new-window)
"Ask the EWW browser to load URL.
Interactively, if the variable `browse-url-new-window-flag' is non-nil,
loads the document in a new buffer tab on the window tab-line. A non-nil
prefix argument reverses the effect of `browse-url-new-window-flag'.
If `tab-bar-mode' is enabled, then whenever a document would
otherwise be loaded in a new buffer, it is loaded in a new tab
in the tab-bar on an existing frame. See more options in
`eww-browse-url-new-window-is-tab'.
Non-interactively, this uses the optional second argument NEW-WINDOW
instead of `browse-url-new-window-flag'."
(when new-window
(when (or (eq eww-browse-url-new-window-is-tab t)
(and (eq eww-browse-url-new-window-is-tab 'tab-bar)
tab-bar-mode))
(let ((tab-bar-new-tab-choice t))
(tab-new)))
(pop-to-buffer-same-window
(generate-new-buffer
(format "*eww-%s*" (url-host (url-generic-parse-url
(eww--dwim-expand-url url))))))
(eww-mode))
(let ((url-allow-non-local-files t))
(eww url)))
(function-put 'eww-browse-url 'browse-url-browser-kind 'internal)
(defun eww-back-url ()
"Go to the previously displayed page."
(interactive nil eww-mode)
(when (>= eww-history-position (length eww-history))
(user-error "No previous page"))
(if (eww-save-history)
;; We were at the latest page (which was just added to the
;; history), so go back two entries.
(setq eww-history-position 2)
(setq eww-history-position (1+ eww-history-position)))
(eww-restore-history (elt eww-history (1- eww-history-position))))
(defun eww-forward-url ()
"Go to the next displayed page."
(interactive nil eww-mode)
(when (<= eww-history-position 1)
(user-error "No next page"))
(eww-save-history)
(setq eww-history-position (1- eww-history-position))
(eww-restore-history (elt eww-history (1- eww-history-position))))
(defun eww-restore-history (elem)
(let ((inhibit-read-only t)
(inhibit-modification-hooks t)
(text (plist-get elem :text)))
(setq eww-data elem)
(if (null text)
(eww-reload) ; FIXME: restore :point?
(erase-buffer)
(insert text)
(goto-char (plist-get elem :point))
;; Make buffer listings more informative.
(setq list-buffers-directory (plist-get elem :url))
(eww--after-page-change))))
(defun eww-next-url ()
"Go to the page marked `next'.
A page is marked `next' if rel=\"next\" appears in a <link>
or <a> tag."
(interactive nil eww-mode)
(if (plist-get eww-data :next)
(eww-browse-url (shr-expand-url (plist-get eww-data :next)
(plist-get eww-data :url)))
(user-error "No `next' on this page")))
(defun eww-previous-url ()
"Go to the page marked `previous'.
A page is marked `previous' if rel=\"previous\" appears in a <link>
or <a> tag."
(interactive nil eww-mode)
(if (plist-get eww-data :previous)
(eww-browse-url (shr-expand-url (plist-get eww-data :previous)
(plist-get eww-data :url)))
(user-error "No `previous' on this page")))
(defun eww-up-url ()
"Go to the page marked `up'.
A page is marked `up' if rel=\"up\" appears in a <link>
or <a> tag."
(interactive nil eww-mode)
(if (plist-get eww-data :up)
(eww-browse-url (shr-expand-url (plist-get eww-data :up)
(plist-get eww-data :url)))
(user-error "No `up' on this page")))
(defun eww-top-url ()
"Go to the page marked `top'.
A page is marked `top' if rel=\"start\", rel=\"home\", or rel=\"contents\"
appears in a <link> or <a> tag."
(interactive nil eww-mode)
(let ((best-url (or (plist-get eww-data :start)
(plist-get eww-data :contents)
(plist-get eww-data :home))))
(if best-url
(eww-browse-url (shr-expand-url best-url (plist-get eww-data :url)))
(user-error "No `top' for this page"))))
(defun eww-reload (&optional local encode)
"Reload the current page.
If LOCAL is non-nil (interactively, the command was invoked with
a prefix argument), don't reload the page from the network, but
just re-display the HTML already fetched."
(interactive "P" eww-mode)
(let ((url (plist-get eww-data :url)))
(if local
(if (null (plist-get eww-data :dom))
(error "No current HTML data")
(eww-display-document (plist-get eww-data :dom) (point)))
(let ((parsed (url-generic-parse-url url)))
(if (equal (url-type parsed) "file")
;; Use Tramp instead of url.el for files (since url.el
;; doesn't work well with Tramp files).
(let ((eww-buffer (current-buffer)))
(with-current-buffer (eww--file-buffer (url-filename parsed))
(eww-render nil url nil eww-buffer)))
(let ((url-mime-accept-string eww-accept-content-types))
(eww-retrieve url #'eww-render
(list url (point) (current-buffer) encode))))))))
;; Form support.
(defvar eww-form nil)
(defvar-keymap eww-submit-map
"RET" #'eww-submit
"C-c C-c" #'eww-submit
"<mouse-2>" #'eww-submit)
(defvar-keymap eww-submit-file
"RET" #'eww-select-file
"C-c C-c" #'eww-submit
"<mouse-2>" #'eww-select-file)
(defvar-keymap eww-checkbox-map
"SPC" #'eww-toggle-checkbox
"RET" #'eww-toggle-checkbox
"C-c C-c" #'eww-submit
"<mouse-2>" #'eww-toggle-checkbox)
(defvar-keymap eww-text-map
:full t :parent text-mode-map
"RET" #'eww-submit
"C-a" #'eww-beginning-of-text
"C-c C-c" #'eww-submit
"C-e" #'eww-end-of-text
"TAB" #'shr-next-link
"M-TAB" #'shr-previous-link
"<backtab>" #'shr-previous-link)
(defvar-keymap eww-textarea-map
:full t :parent text-mode-map
"RET" #'forward-line
"C-c C-c" #'eww-submit
"TAB" #'shr-next-link
"M-TAB" #'shr-previous-link
"<backtab>" #'shr-previous-link)
(defvar-keymap eww-select-map
:doc "Map for select buttons"
"RET" #'eww-change-select
"<follow-link>" 'mouse-face
"<mouse-2>" #'eww-change-select
"C-c C-c" #'eww-submit)
(defun eww-beginning-of-text ()
"Move to the start of the input field."
(interactive nil eww-mode)
(goto-char (eww-beginning-of-field)))
(defun eww-end-of-text ()
"Move to the end of the text in the input field."
(interactive nil eww-mode)
(goto-char (eww-end-of-field))
(let ((start (eww-beginning-of-field)))
(while (and (equal (following-char) ? )
(> (point) start))
(forward-char -1))
(when (> (point) start)
(forward-char 1))))
(defun eww-beginning-of-field ()
(cond
((bobp)
(point))
((not (eq (get-text-property (point) 'eww-form)
(get-text-property (1- (point)) 'eww-form)))
(point))
(t
(previous-single-property-change
(point) 'eww-form nil (point-min)))))
(defun eww-end-of-field ()
(1- (next-single-property-change
(point) 'eww-form nil (point-max))))
(defun eww-tag-form (dom)
(let ((eww-form (list (cons :method (dom-attr dom 'method))
(cons :action (dom-attr dom 'action))))
(start (point)))
(insert "\n")
(shr-ensure-paragraph)
(shr-generic dom)
(unless (bolp)
(insert "\n"))
(insert "\n")
(when (> (point) start)
(put-text-property start (1+ start)
'eww-form eww-form))))
(defun eww-form-submit (dom)
(let ((start (point))
(value (dom-attr dom 'value)))
(if (null value)
(shr-generic dom)
(insert value))
;; If the contents of the <button>...</button> turns out to be
;; empty, or the value was blank, default to this:
(when (= (point) start)
(insert "Submit"))
(add-face-text-property start (point) 'eww-form-submit)
(put-text-property start (point) 'eww-form
(list :eww-form eww-form
:value value
:type "submit"
:name (dom-attr dom 'name)))
(put-text-property start (point) 'keymap eww-submit-map)
;; Pretend to touch-screen.el that this is a button.
(put-text-property start (point) 'button t)
(insert " ")))
(defun eww-form-checkbox (dom)
(let ((start (point)))
(if (dom-attr dom 'checked)
(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
:value (dom-attr dom 'value)
:type (downcase (dom-attr dom 'type))
:checked (dom-attr dom 'checked)
:name (dom-attr dom 'name)))
(put-text-property start (point) 'keymap eww-checkbox-map)
;; Pretend to touch-screen.el that this is a button.
(put-text-property start (point) 'button t)
(insert " ")))
(defun eww-form-file (dom)
(let ((start (point))
(value (dom-attr dom 'value)))
(setq value
(if (zerop (length value))
" No file selected"
value))
(insert "Browse")
(add-face-text-property start (point) 'eww-form-file)
(insert value)
(put-text-property start (point) 'eww-form
(list :eww-form eww-form
:value (dom-attr dom 'value)
:type (downcase (dom-attr dom 'type))
:name (dom-attr dom 'name)))
(put-text-property start (point) 'keymap eww-submit-file)
;; Pretend to touch-screen.el that this is a button.
(put-text-property start (point) 'button t)
(insert " ")))
(defun eww-select-file (&optional event)
"Change the value of the upload file menu under point.
EVENT, if non-nil, is the mouse event that preceded this command.
Interactively, EVENT is the value of `last-nonmenu-event'."
(interactive (list last-nonmenu-event) eww-mode)
(when (and event (setq event (event-start event)))
(goto-char (posn-point event)))
(let* ((input (get-text-property (point) 'eww-form)))
(let ((filename
(let ((insert-default-directory t))
(read-file-name "filename: "))))
(eww-update-field filename (length "Browse"))
(plist-put input :filename filename))))
(defun eww-form-text (dom)
(let ((start (point))
(type (downcase (or (dom-attr dom 'type) "text")))
(value (or (dom-attr dom 'value) ""))
(width (string-to-number (or (dom-attr dom 'size) "40")))
(readonly-property (if (or (dom-attr dom 'disabled)
(dom-attr dom 'readonly))
'read-only
'inhibit-read-only))
form)
(setq form (list :eww-form eww-form
:value value
:type type
:name (dom-attr dom 'name)))
(insert value)
(when (< (length value) width)
(insert (make-string (- width (length value)) ? )))
(put-text-property start (point) 'face 'eww-form-text)
(put-text-property start (point) 'inhibit-read-only t)
(put-text-property start (point) 'local-map eww-text-map)
(put-text-property start (point) readonly-property t)
(put-text-property start (point) 'eww-form form)
(put-text-property start (point) 'field form)
(put-text-property start (point) 'front-sticky t)
(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 replace-length)
(when-let* ((pos (field-beginning (point))))
(let* ((form (get-text-property pos 'eww-form))
(properties (text-properties-at pos))
(buffer-undo-list t)
(inhibit-read-only t)
(length (- end beg replace-length))
(type (plist-get form :type)))
(when (and form
(member type eww-text-input-types))
(cond
((> length 0)
;; Delete some space at the end.
(save-excursion
(goto-char
(if (equal type "textarea")
(1- (line-end-position))
(eww-end-of-field)))
(while (and (> length 0)
(eq (char-after (1- (point))) ? ))
(delete-region (1- (point)) (point))
(cl-decf length))))
((< length 0)
;; Add padding.
(save-excursion
(goto-char end)
(goto-char
(if (equal type "textarea")
(1- (line-end-position))
(1+ (eww-end-of-field))))
(let ((start (point)))
(insert (make-string (abs length) ? ))
(set-text-properties start (point) properties))
(goto-char (1- end)))))
(set-text-properties (cdr (assq :start form))
(cdr (assq :end form))
properties)
(let ((value (buffer-substring-no-properties
(eww-beginning-of-field)
(eww-end-of-field))))
(when (string-match " +\\'" value)
(setq value (substring value 0 (match-beginning 0))))
(plist-put form :value value)
(plist-put form :type type)
(when (equal type "password")
;; Display passwords as asterisks.
(let ((start (eww-beginning-of-field)))
(put-text-property
start (+ start (length value))
'display (make-string (length value) ?*)))))))))
(defun eww-tag-textarea (dom)
(let ((start (point))
(value (or (dom-text dom) ""))
(lines (string-to-number (or (dom-attr dom 'rows) "10")))
(width (string-to-number (or (dom-attr dom 'cols) "10")))
end form)
(shr-ensure-newline)
(insert value)
(shr-ensure-newline)
(when (< (count-lines start (point)) lines)
(dotimes (_ (- lines (count-lines start (point))))
(insert "\n")))
(setq end (point-marker))
(goto-char start)
(while (< (point) end)
(end-of-line)
(let ((pad (- width (- (point) (line-beginning-position)))))
(when (> pad 0)
(insert (make-string pad ? ))))
(add-face-text-property (line-beginning-position)
(point) 'eww-form-textarea)
(put-text-property (line-beginning-position) (point) 'inhibit-read-only t)
(put-text-property (line-beginning-position) (point)
'local-map eww-textarea-map)
(forward-line 1))
(setq form (list :eww-form eww-form
:value value
:type "textarea"
:name (dom-attr dom 'name)))
(put-text-property start (point) 'eww-form form)
(put-text-property start (point) 'front-sticky t)
(put-text-property start (point) 'field form)
(put-text-property start (1+ start) 'shr-tab-stop t)))
(defun eww-tag-input (dom)
(let ((type (downcase (or (dom-attr dom 'type) "text")))
(start (point)))
(cond
((or (equal type "checkbox")
(equal type "radio"))
(eww-form-checkbox dom))
((equal type "file")
(eww-form-file dom))
((equal type "submit")
(eww-form-submit dom))
((equal type "hidden")
(let ((form eww-form)
(name (dom-attr dom 'name)))
;; Don't add <input type=hidden> elements repeatedly.
(while (and form
(or (not (consp (car form)))
(not (eq (caar form) 'hidden))
(not (equal (plist-get (cdr (car form)) :name)
name))))
(setq form (cdr form)))
(unless form
(nconc eww-form (list
(list 'hidden
:name name
:value (or (dom-attr dom 'value) "")))))))
(t
(eww-form-text dom)))
(unless (= start (point))
(put-text-property start (1+ start) 'help-echo "Input field")
;; Mark this as an element we can TAB to.
(put-text-property start (1+ start) 'shr-tab-stop t))))
(defun eww-tag-select (dom)
(shr-ensure-paragraph)
(let ((menu (list :name (dom-attr dom 'name)
:eww-form eww-form))
(options nil)
(start (point))
(max 0))
(dolist (elem (dom-by-tag dom 'option))
(when (dom-attr elem 'selected)
(nconc menu (list :value (dom-attr elem 'value))))
(let ((display (dom-text elem)))
(setq max (max max (length display)))
(push (list 'item
:value (dom-attr elem 'value)
:display display)
options)))
(when options
(setq options (nreverse options))
;; If we have no selected values, default to the first value.
(unless (plist-get menu :value)
(nconc menu (list :value (nth 2 (car options)))))
(nconc menu options)
(let ((selected (eww-select-display menu)))
(insert selected
(make-string (- max (length selected)) ? )))
(put-text-property start (point) 'eww-form menu)
(add-face-text-property start (point) 'eww-form-select)
(put-text-property start (point) 'keymap eww-select-map)
;; Pretend to touch-screen.el that this is a button.
(put-text-property start (point) 'button t)
(unless (= start (point))
(put-text-property start (1+ start) 'help-echo "select field")
(put-text-property start (1+ start) 'shr-tab-stop t))
(shr-ensure-paragraph))))
(defun eww-select-display (select)
(let ((value (plist-get select :value))
display)
(dolist (elem select)
(when (and (consp elem)
(eq (car elem) 'item)
(equal value (plist-get (cdr elem) :value)))
(setq display (plist-get (cdr elem) :display))))
display))
(defun eww--form-items (form)
(cl-loop for elem in form
when (and (consp elem)
(eq (car elem) 'item))
collect (cdr elem)))
(defun eww-change-select (event)
"Change the value of the select drop-down menu under point."
(interactive
(list last-nonmenu-event)
eww-mode)
(mouse-set-point event)
(let ((input (get-text-property (point) 'eww-form)))
(popup-menu
(cons
"Change Value"
(mapcar
(lambda (elem)
(vector (plist-get elem :display)
(lambda ()
(interactive)
(plist-put input :value (plist-get elem :value))
(goto-char (eww-update-field (plist-get elem :display))))
t))
(eww--form-items input)))
event)))
(defun eww-update-field (string &optional offset)
(unless offset
(setq offset 0))
(let ((properties (text-properties-at (point)))
(start (+ (eww-beginning-of-field) offset))
(current-end (1+ (eww-end-of-field)))
(new-end (+ (eww-beginning-of-field) (length string)))
(inhibit-read-only t))
(delete-region start current-end)
(forward-char offset)
(insert string
(make-string (- (- (+ new-end offset) start) (length string)) ? ))
(when (= 0 offset)
(set-text-properties start new-end properties))
start))
(defun eww-toggle-checkbox (&optional event)
"Toggle the value of the checkbox under point.
EVENT, if non-nil, is the mouse event that preceded this command.
Interactively, EVENT is the value of `last-nonmenu-event'."
(interactive (list last-nonmenu-event) eww-mode)
(when (and event (setq event (event-start event)))
(goto-char (posn-point event)))
(let* ((input (get-text-property (point) 'eww-form))
(type (plist-get input :type)))
(if (equal type "checkbox")
(goto-char
(1+
(if (plist-get input :checked)
(progn
(plist-put input :checked nil)
(eww-update-field eww-form-checkbox-symbol))
(plist-put input :checked t)
(eww-update-field eww-form-checkbox-selected-symbol))))
;; Radio button. Switch all other buttons off.
(let ((name (plist-get input :name)))
(save-excursion
(dolist (elem (eww-inputs (plist-get input :eww-form)))
(when (equal (plist-get (cdr elem) :name) name)
(goto-char (car elem))
(if (not (eq (cdr elem) input))
(progn
(plist-put (cdr elem) :checked nil)
(eww-update-field eww-form-checkbox-symbol))
(plist-put (cdr elem) :checked t)
(eww-update-field eww-form-checkbox-selected-symbol)))))
(forward-char 1)))))
(defun eww-inputs (form)
(let ((start (point-min))
(inputs nil))
(while (and start
(< start (point-max)))
(when (or (get-text-property start 'eww-form)
(setq start (next-single-property-change start 'eww-form)))
(when (eq (plist-get (get-text-property start 'eww-form) :eww-form)
form)
(push (cons start (get-text-property start 'eww-form))
inputs))
(setq start (next-single-property-change start 'eww-form))))
(nreverse inputs)))
(defun eww-size-text-inputs ()
(let ((start (point-min)))
(while (and start
(< start (point-max)))
(when (or (get-text-property start 'eww-form)
(setq start (next-single-property-change start 'eww-form)))
(let ((props (get-text-property start 'eww-form)))
(nconc props (list (cons :start start)))
(setq start (next-single-property-change
start 'eww-form nil (point-max)))
(nconc props (list (cons :end start))))))))
(defun eww-input-value (input)
(let ((type (plist-get input :type))
(value (plist-get input :value)))
(cond
((equal type "textarea")
(with-temp-buffer
(insert value)
(goto-char (point-min))
(while (re-search-forward "^ +\n\\| +$" nil t)
(replace-match "" t t))
(buffer-string)))
(t
(if (string-match " +\\'" value)
(substring value 0 (match-beginning 0))
value)))))
(defun eww-submit (&optional event)
"Submit the form under point or EVENT.
EVENT, if non-nil, is the mouse event that preceded this command.
Interactively, EVENT is the value of `last-nonmenu-event'."
(interactive (list last-nonmenu-event) eww-mode)
(when (and event (setq event (event-start event)))
(goto-char (posn-point event)))
(let* ((this-input (get-text-property (point) 'eww-form))
(form (plist-get this-input :eww-form))
values next-submit)
(dolist (elem (sort (eww-inputs form)
(lambda (o1 o2)
(< (car o1) (car o2)))))
(let* ((input (cdr elem))
(input-start (car elem))
(name (plist-get input :name)))
(when name
(cond
((member (plist-get input :type) '("checkbox" "radio"))
(when (plist-get input :checked)
(push (cons name (or (plist-get input :value) "on"))
values)))
((equal (plist-get input :type) "file")
(when-let* ((file (plist-get input :filename)))
(push (list "file"
(cons "filedata"
(with-temp-buffer
(insert-file-contents file)
(buffer-string)))
(cons "name" name)
;; RFC 2183 declares that recipients should
;; only respect the basename of the filename
;; parameter, and the leading directories
;; might divulge private information, so we
;; only send the basename in our request.
(cons "filename" (file-name-nondirectory file)))
values)))
((equal (plist-get input :type) "submit")
;; We want the values from buttons if we hit a button if
;; we hit enter on it, or if it's the first button after
;; the field we did hit return on.
(when (or (eq input this-input)
(and (not (eq input this-input))
(null next-submit)
(> input-start (point))))
(setq next-submit t)
(push (cons name (plist-get input :value))
values)))
(t
(push (cons name (eww-input-value input))
values))))))
(dolist (elem form)
(when (and (consp elem)
(eq (car elem) 'hidden))
(push (cons (plist-get (cdr elem) :name)
(or (plist-get (cdr elem) :value) ""))
values)))
(if (and (stringp (cdr (assq :method form)))
(equal (downcase (cdr (assq :method form))) "post"))
(let ((mtype))
(dolist (x values mtype)
(if (equal (car x) "file")
(progn
(setq mtype "multipart/form-data"))))
(cond ((equal mtype "multipart/form-data")
(let ((boundary (mml-compute-boundary '())))
(let ((url-request-method "POST")
(url-request-extra-headers
(list (cons "Content-Type"
(concat "multipart/form-data; boundary="
boundary))))
(url-request-data
(mm-url-encode-multipart-form-data values boundary)))
(eww-browse-url (shr-expand-url
(cdr (assq :action form))
(plist-get eww-data :url))))))
(t
(let ((url-request-method "POST")
(url-request-extra-headers
'(("Content-Type" .
"application/x-www-form-urlencoded")))
(url-request-data
(mm-url-encode-www-form-urlencoded values)))
(eww-browse-url (shr-expand-url
(cdr (assq :action form))
(plist-get eww-data :url)))))))
(eww-browse-url
(concat
(if (cdr (assq :action form))
(shr-expand-url (cdr (assq :action form)) (plist-get eww-data :url))
(plist-get eww-data :url))
"?"
(mm-url-encode-www-form-urlencoded values))))))
(defun eww-browse-with-external-browser (&optional url)
"Browse the current URL with an external browser.
The browser to used is specified by the
`browse-url-secondary-browser-function' variable."
(interactive nil eww-mode)
(funcall browse-url-secondary-browser-function
(or url (plist-get eww-data :url))))
(defun eww-remove-tracking (url)
"Remove the commong utm_ tracking cookies from URLs."
(replace-regexp-in-string ".utm_.*" "" url))
(defun eww--transform-url (url)
"Apply `eww-url-transformers'."
(when url
(dolist (func eww-url-transformers)
(setq url (funcall func url)))
url))
(defun eww-follow-link (&optional external mouse-event)
"Browse the URL under point.
If EXTERNAL is single prefix, browse the URL using
`browse-url-secondary-browser-function'.
If EXTERNAL is double prefix, browse in new buffer."
(interactive
(list current-prefix-arg last-nonmenu-event)
eww-mode)
(mouse-set-point mouse-event)
(let* ((orig-url (get-text-property (point) 'shr-url))
(url (eww--transform-url orig-url))
target)
(cond
((not url)
(message "No link under point"))
((string-match-p eww-use-browse-url url)
;; This respects the user options `browse-url-handlers'
;; and `browse-url-mailto-function'.
(browse-url url))
((and (consp external) (<= (car external) 4))
(funcall browse-url-secondary-browser-function url)
(shr--blink-link))
;; This is a #target url in the same page as the current one.
((and (setq target (url-target (url-generic-parse-url url)))
(eww-same-page-p url (plist-get eww-data :url)))
(let ((point (point)))
(eww-save-history)
(eww--before-browse)
(plist-put eww-data :url url)
(goto-char (point-min))
(if-let* ((match (text-property-search-forward 'shr-target-id target #'member)))
(goto-char (prop-match-beginning match))
(goto-char (if (equal target "top")
(point-min)
point)))))
(t
(eww-browse-url orig-url external)))))
(defun eww-same-page-p (url1 url2)
"Return non-nil if URL1 and URL2 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 ()
"Copy the URL of the current page into the kill ring."
(interactive nil eww-mode)
(message "%s" (plist-get eww-data :url))
(kill-new (plist-get eww-data :url)))
(defun eww-download ()
"Download URL to `eww-download-directory'.
Use link at point if there is one, else the current page's URL."
(interactive nil eww-mode)
(let ((dir (if (stringp eww-download-directory)
eww-download-directory
(funcall eww-download-directory))))
(access-file dir "Download failed")
(let ((url (or (get-text-property (point) 'shr-url)
(eww-current-url))))
(if (not url)
(message "No URL under point")
(url-retrieve url #'eww-download-callback (list url dir))))))
(defun eww-download-callback (status url dir)
(unless (plist-get status :error)
(let* ((obj (url-generic-parse-url url))
(path (directory-file-name (car (url-path-and-query obj))))
(file (eww-make-unique-file-name
(eww-decode-url-file-name (file-name-nondirectory path))
dir)))
(goto-char (point-min))
(re-search-forward "\r?\n\r?\n")
(let ((coding-system-for-write 'no-conversion))
(write-region (point) (point-max) file))
(message "Saved %s" file))))
(defun eww-decode-url-file-name (string)
(let* ((binary (url-unhex-string string))
(decoded
(decode-coding-string
binary
;; Possibly set by `universal-coding-system-argument'.
(or coding-system-for-read
;; RFC 3986 says that %AB stuff is utf-8.
(if (equal (decode-coding-string binary 'utf-8)
'(unicode))
'utf-8
;; But perhaps not.
(car (detect-coding-string binary))))))
(encodes (find-coding-systems-string decoded)))
(if (or (equal encodes '(undecided))
(memq (coding-system-base (or file-name-coding-system
default-file-name-coding-system))
encodes))
decoded
;; If we can't encode the decoded file name (due to language
;; environment settings), then we return the original, hexified
;; string.
string)))
(defun eww-make-unique-file-name (file directory)
(cond
((zerop (length file))
(setq file "!"))
((string-match "\\`[.]" file)
(setq file (concat "!" file))))
(let ((count 1)
(stem file)
(suffix ""))
(when (string-match "\\`\\(.*\\)\\([.][^.]+\\)" file)
(setq stem (match-string 1 file)
suffix (match-string 2 file)))
(while (file-exists-p (expand-file-name file directory))
(setq file (format "%s(%d)%s" stem count suffix))
(setq count (1+ count)))
(expand-file-name file directory)))
(defun eww-set-character-encoding (charset)
"Set character encoding to CHARSET.
If CHARSET is nil then use UTF-8."
(interactive "zUse character set (default `utf-8'): " eww-mode)
(if (null charset)
(eww-reload nil 'utf-8)
(eww-reload nil charset)))
(defun eww-switch-to-buffer ()
"Prompt for an EWW buffer to display in the selected window."
(interactive nil eww-mode)
(let ((completion-extra-properties
`(:annotation-function
,(lambda (buf)
(with-current-buffer buf
(format " %s" (eww-current-url))))))
(curbuf (current-buffer)))
(pop-to-buffer-same-window
(read-buffer "Switch to EWW buffer: "
(cl-loop for buf in (nreverse (buffer-list))
if (with-current-buffer buf (derived-mode-p 'eww-mode))
return buf)
t
(lambda (bufn)
(setq bufn (if (consp bufn) (cdr bufn) (get-buffer bufn)))
(and (with-current-buffer bufn
(derived-mode-p 'eww-mode))
(not (eq bufn curbuf))))))))
(defun eww-toggle-fonts ()
"Toggle whether to use monospaced or font-enabled layouts."
(interactive nil eww-mode)
(setq shr-use-fonts (not shr-use-fonts))
(eww-reload)
(message "Proportional fonts are now %s"
(if shr-use-fonts "on" "off")))
(defun eww-toggle-colors ()
"Toggle whether to use HTML-specified colors or not."
(interactive nil eww-mode)
(message "Colors are now %s"
(if (setq shr-use-colors (not shr-use-colors))
"on"
"off"))
(eww-reload))
(defun eww-toggle-images ()
"Toggle whether or not to display images."
(interactive nil eww-mode)
(setq shr-inhibit-images (not shr-inhibit-images))
(eww-reload)
(message "Images are now %s"
(if shr-inhibit-images "off" "on")))
;;; Bookmarks code
(defvar eww-bookmarks nil)
(defun eww-add-bookmark ()
"Bookmark the current page."
(interactive nil eww-mode)
(eww-read-bookmarks)
(dolist (bookmark eww-bookmarks)
(when (equal (plist-get eww-data :url) (plist-get bookmark :url))
(user-error "Already bookmarked")))
(when (y-or-n-p "Bookmark this page?")
(let ((title (replace-regexp-in-string "[\n\t\r]" " "
(plist-get eww-data :title))))
(setq title (replace-regexp-in-string "\\` +\\| +\\'" "" title))
(push (list :url (plist-get eww-data :url)
:title title
:time (current-time-string))
eww-bookmarks))
(eww-write-bookmarks)
(message "Bookmarked %s (%s)" (plist-get eww-data :url)
(plist-get eww-data :title))))
(defun eww-write-bookmarks ()
(with-temp-file (expand-file-name "eww-bookmarks" eww-bookmarks-directory)
(insert ";; Auto-generated file; don't edit -*- mode: lisp-data -*-\n")
(let ((print-length nil)
(print-level nil))
(pp eww-bookmarks (current-buffer)))))
(defun eww-read-bookmarks (&optional error-out)
"Read bookmarks from `eww-bookmarks'.
If ERROR-OUT, signal user-error if there are no bookmarks."
(let ((file (expand-file-name "eww-bookmarks" eww-bookmarks-directory)))
(setq eww-bookmarks
(unless (zerop (or (file-attribute-size (file-attributes file)) 0))
(with-temp-buffer
(insert-file-contents file)
(read (current-buffer)))))
(when (and error-out (not eww-bookmarks))
(user-error "No bookmarks are defined"))))
;;;###autoload
(defun eww-list-bookmarks ()
"Display the bookmarks."
(interactive)
(eww-read-bookmarks t)
(pop-to-buffer "*eww bookmarks*")
(eww-bookmark-prepare))
(defun eww-bookmark-prepare ()
(set-buffer (get-buffer-create "*eww bookmarks*"))
(eww-bookmark-mode)
(let* ((width (/ (window-width) 2))
(format (format "%%-%ds %%s" width))
(inhibit-read-only t)
start title)
(erase-buffer)
(setq header-line-format (concat " " (format format "Title" "URL")))
(dolist (bookmark eww-bookmarks)
(setq start (point)
title (plist-get bookmark :title))
(when (> (length title) width)
(setq title (truncate-string-to-width title width)))
(insert (format format title (plist-get bookmark :url)) "\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 nil eww-bookmark-mode)
(let* ((start (line-beginning-position))
(bookmark (get-text-property start 'eww-bookmark))
(inhibit-read-only t))
(unless bookmark
(user-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 nil eww-bookmark-mode)
(unless eww-bookmark-kill-ring
(user-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-browse ()
"Browse the bookmark under point in eww."
(interactive nil eww-bookmark-mode)
(let ((bookmark (get-text-property (line-beginning-position) 'eww-bookmark)))
(unless bookmark
(user-error "No bookmark on the current line"))
(quit-window)
(eww-browse-url (plist-get bookmark :url))))
(defun eww-next-bookmark ()
"Go to the next bookmark in the list."
(interactive nil eww-bookmark-mode)
(let ((first nil)
bookmark)
(unless (get-buffer "*eww bookmarks*")
(setq first t)
(eww-read-bookmarks t)
(eww-bookmark-prepare))
(with-current-buffer "*eww bookmarks*"
(when (and (not first)
(not (eobp)))
(forward-line 1))
(setq bookmark (get-text-property (line-beginning-position)
'eww-bookmark))
(unless bookmark
(user-error "No next bookmark")))
(eww-browse-url (plist-get bookmark :url))))
(defun eww-previous-bookmark ()
"Go to the previous bookmark in the list."
(interactive nil eww-bookmark-mode)
(let ((first nil)
bookmark)
(unless (get-buffer "*eww bookmarks*")
(setq first t)
(eww-read-bookmarks t)
(eww-bookmark-prepare))
(with-current-buffer "*eww bookmarks*"
(if first
(goto-char (point-max))
(beginning-of-line))
;; On the final line.
(when (eolp)
(forward-line -1))
(if (bobp)
(user-error "No previous bookmark")
(forward-line -1))
(setq bookmark (get-text-property (line-beginning-position)
'eww-bookmark)))
(eww-browse-url (plist-get bookmark :url))))
(defun eww-bookmark-urls ()
"Get the URLs from the current list of bookmarks."
(interactive nil eww-boomark-mode)
(eww-read-bookmarks)
(mapcar (lambda (x) (plist-get x :url)) eww-bookmarks))
(defvar-keymap eww-bookmark-mode-map
"C-k" #'eww-bookmark-kill
"C-y" #'eww-bookmark-yank
"RET" #'eww-bookmark-browse
:menu '("Eww Bookmark"
["Exit" quit-window t]
["Browse" eww-bookmark-browse
:active (get-text-property (line-beginning-position) 'eww-bookmark)]
["Kill" eww-bookmark-kill
:active (get-text-property (line-beginning-position) 'eww-bookmark)]
["Yank" eww-bookmark-yank
:active eww-bookmark-kill-ring]))
(define-derived-mode eww-bookmark-mode special-mode "eww bookmarks"
"Mode for listing bookmarks.
\\{eww-bookmark-mode-map}"
:interactive nil
(buffer-disable-undo)
(setq truncate-lines t))
;;; History code
(defun eww-save-history ()
"Save the current page's data to the history.
If the current page is a historical one loaded from
`eww-history' (e.g. by calling `eww-back-url'), this will update the
page's entry in `eww-history' and return nil. Otherwise, add a new
entry to `eww-history' and return t."
(plist-put eww-data :point (point))
(plist-put eww-data :text (buffer-string))
(if (zerop eww-history-position)
(let ((history-delete-duplicates nil))
(add-to-history 'eww-history eww-data eww-history-limit t)
(setq eww-history-position 1)
t)
(setf (elt eww-history (1- eww-history-position)) eww-data)
nil))
(defun eww-delete-future-history ()
"Remove any entries in `eww-history' after the currently-shown one.
This is useful for `eww-before-browse-history-function' to make EWW's
navigation to a new page from a historical one work like other web
browsers: it will delete any \"future\" history elements before adding
the new page to the end of the history.
For example, if `eww-history' looks like this (going from newest to
oldest, with \"*\" marking the current page):
E D C* B A
then calling this function updates `eww-history' to:
C* B A"
(when (> eww-history-position 1)
(setq eww-history (nthcdr (1- eww-history-position) eww-history)
;; We don't really need to set this since `eww--before-browse'
;; sets it too, but this ensures that other callers can use
;; this function and get the expected results.
eww-history-position 1)))
(defun eww-clone-previous-history ()
"Clone and prepend entries in `eww-history' up to the currently-shown one.
These cloned entries get added to the beginning of `eww-history' so that
it's possible to navigate back to the very first page for this EWW
without deleting any history entries.
For example, if `eww-history' looks like this (going from newest to
oldest, with \"*\" marking the current page):
E D C* B A
then calling this function updates `eww-history' to:
C* B A E D C B A
This is useful for setting `eww-before-browse-history-function' (which
see)."
(when (> eww-history-position 1)
(setq eww-history (take eww-history-limit
(append (nthcdr (1- eww-history-position)
eww-history)
eww-history))
;; As with `eww-delete-future-history', we don't really need
;; to set this since `eww--before-browse' sets it too, but
;; let's be thorough.
eww-history-position 1)))
(defvar eww-current-buffer)
(defun eww-list-histories ()
"List the eww-histories."
(interactive)
(when (null eww-history)
(error "No eww-histories are defined"))
(let ((eww-history-trans eww-history)
(buffer (current-buffer)))
(set-buffer (get-buffer-create "*eww history*"))
(eww-history-mode)
(setq-local eww-current-buffer buffer)
(let ((inhibit-read-only t)
(domain-length 0)
(title-length 0)
url title format start)
(erase-buffer)
(dolist (history eww-history-trans)
(setq start (point))
(setq domain-length (max domain-length (length (plist-get history :url))))
(setq title-length (max title-length (length (plist-get history :title)))))
(setq format (format "%%-%ds %%-%ds" title-length domain-length)
header-line-format
(concat " " (format format "Title" "URL")))
(dolist (history eww-history-trans)
(setq start (point))
(setq url (plist-get history :url))
(setq title (plist-get history :title))
(insert (format format title url))
(insert "\n")
(put-text-property start (1+ start) 'eww-history history))
(goto-char (point-min)))
(pop-to-buffer "*eww history*")))
(defun eww-history-browse ()
"Browse the history under point in eww."
(interactive nil eww-history-mode)
(let ((history (get-text-property (line-beginning-position) 'eww-history)))
(unless history
(error "No history on the current line"))
(let ((buffer eww-current-buffer))
(quit-window)
(when buffer
(pop-to-buffer-same-window buffer)))
(eww-restore-history history)))
(defvar-keymap eww-history-mode-map
"RET" #'eww-history-browse
"n" #'next-line
"p" #'previous-line
:menu '("Eww History"
["Exit" quit-window t]
["Browse" eww-history-browse
:active (get-text-property (line-beginning-position)
'eww-history)]))
(define-derived-mode eww-history-mode special-mode "eww history"
"Mode for listing eww-histories.
\\{eww-history-mode-map}"
:interactive nil
(buffer-disable-undo)
(setq truncate-lines t))
;;; eww buffers list
(defun eww-buffer-list ()
"Return a list of all live eww buffers."
(match-buffers '(derived-mode . eww-mode)))
(defun eww-list-buffers ()
"Pop a buffer with a list of eww buffers."
(interactive)
(with-current-buffer (get-buffer-create "*eww buffers*")
(eww-buffers-mode)
(eww--list-buffers-display-table))
(pop-to-buffer "*eww buffers*"))
(defun eww--list-buffers-display-table (&optional _ignore-auto _noconfirm)
"Display a table with the list of eww buffers.
Will remove all buffer contents first. The parameters IGNORE-AUTO and
NOCONFIRM are ignored, they are for compatibility with
`revert-buffer-function'."
(let ((inhibit-read-only t))
(erase-buffer)
(make-vtable
:columns '((:name "Title" :min-width "25%" :max-width "50%")
(:name "URL"))
:objects-function #'eww--list-buffers-get-data
;; use fixed-font face
:face 'default)))
(defun eww--list-buffers-get-data ()
"Return the eww-data of BUF, assumed to be a eww buffer.
The format of the data is (title url buffer), for use in of
`eww-buffers-mode'."
(mapcar (lambda (buf)
(let ((buf-eww-data (buffer-local-value 'eww-data buf)))
(list (plist-get buf-eww-data :title)
(plist-get buf-eww-data :url)
buf)))
(eww-buffer-list)))
(defun eww-buffer-select ()
"Switch to eww buffer."
(interactive nil eww-buffers-mode)
(let ((buffer (nth 2 (vtable-current-object))))
(unless buffer
(error "No buffer on current line"))
(quit-window)
(pop-to-buffer-same-window buffer)))
(defun eww-buffer-show ()
"Display buffer under point in eww buffer list."
(let ((buffer (nth 2 (vtable-current-object))))
(unless buffer
(error "No buffer on current line"))
(other-window -1)
(pop-to-buffer-same-window buffer)
(other-window 1)))
(defun eww-buffer-show-next ()
"Move to next eww buffer in the list and display it."
(interactive nil eww-buffers-mode)
(forward-line)
(when (eobp)
(goto-char (point-min)))
(eww-buffer-show))
(defun eww-buffer-show-previous ()
"Move to previous eww buffer in the list and display it."
(interactive nil eww-buffers-mode)
(beginning-of-line)
(when (bobp)
(goto-char (point-max)))
(forward-line -1)
(eww-buffer-show))
(defun eww-buffer-kill ()
"Kill buffer from eww list."
(interactive nil eww-buffers-mode)
(let* ((start (line-beginning-position))
(buffer (nth 2 (vtable-current-object)))
(inhibit-read-only t))
(unless buffer
(user-error "No buffer on the current line"))
(kill-buffer buffer)
(forward-line 1)
(delete-region start (point)))
(when (eobp)
(forward-line -1))
(eww-buffer-show))
(defvar-keymap eww-buffers-mode-map
"C-k" #'eww-buffer-kill
"RET" #'eww-buffer-select
"n" #'eww-buffer-show-next
"p" #'eww-buffer-show-previous
:menu '("Eww Buffers"
["Exit" quit-window t]
["Select" eww-buffer-select
:active (nth 2 (vtable-current-object))]
["Kill" eww-buffer-kill
:active (nth 2 (vtable-current-object))]))
(define-derived-mode eww-buffers-mode special-mode "eww buffers"
"Mode for listing buffers.
\\{eww-buffers-mode-map}"
:interactive nil
(buffer-disable-undo)
(setq truncate-lines t
;; This is set so that pressing "g" with point just below the
;; table will still update the listing.
revert-buffer-function #'eww--list-buffers-display-table))
;;; Desktop support
(defvar eww-desktop-data-save
'(:url :title :point)
"List of `eww-data' properties to preserve in the desktop file.
Also used when saving `eww-history'.")
(defun eww-desktop-data-1 (alist)
(let ((acc nil)
(tail alist))
(while tail
(let ((k (car tail))
(v (cadr tail)))
(when (memq k eww-desktop-data-save)
(setq acc (cons k (cons v acc)))))
(setq tail (cddr tail)))
acc))
(defun eww-desktop-history-duplicate (a b)
(let ((tail a) (r t))
(while tail
(if (or (memq (car tail) '(:point)) ; ignore :point
(equal (cadr tail)
(plist-get b (car tail))))
(setq tail (cddr tail))
(setq tail nil
r nil)))
;; .
r))
(defun eww-desktop-misc-data (_directory)
"Return a property list with data used to restore eww buffers.
This list will contain, as :history, the list, whose first element is
the value of `eww-data', and the tail is `eww-history'.
If `eww-desktop-remove-duplicates' is non-nil, duplicate
entries (if any) will be removed from the list.
Only the properties listed in `eww-desktop-data-save' are included.
Generally, the list should not include the (usually overly large)
:dom, :source and :text properties."
(let ((history (mapcar #'eww-desktop-data-1
(cons eww-data eww-history)))
(posn eww-history-position) rval)
(list :history
(if eww-desktop-remove-duplicates
(prog1
(setq
rval (cl-remove-duplicates
history :test #'eww-desktop-history-duplicate))
(setq posn
(cl-position
(elt history eww-history-position)
rval :test #'eq)))
history)
:history-position posn)))
(defun eww-restore-desktop (file-name buffer-name misc-data)
"Restore an eww buffer from its desktop file record.
If `eww-restore-desktop' is t or `auto', this function will also
initiate the retrieval of the respective URI in the background.
Otherwise, the restored buffer will contain a prompt to do so by using
\\[eww-reload]."
(with-current-buffer (get-buffer-create buffer-name)
(eww-mode)
;; NB: eww-history, eww-data are buffer-local per (eww-mode)
(setq eww-history (cdr (plist-get misc-data :history))
eww-data (or (car (plist-get misc-data :history))
;; backwards compatibility
(list :url (plist-get misc-data :uri)))
eww-history-position (plist-get misc-data :history-position))
(unless file-name
(when (plist-get eww-data :url)
(cl-case eww-restore-desktop
((t auto) (eww (plist-get eww-data :url)))
((nil) (when (zerop (buffer-size))
(let ((inhibit-read-only t))
(insert (substitute-command-keys
eww-restore-reload-prompt))))))))
;; .
(current-buffer)))
(add-to-list 'desktop-buffer-mode-handlers
'(eww-mode . eww-restore-desktop))
;;; Isearch support
(defun eww-isearch-next-buffer (&optional _buffer wrap)
"Go to the next page to search using `rel' attribute for navigation."
(let ((eww-retrieve-command 'sync))
(if wrap
(condition-case nil
(eww-top-url)
(error nil))
(if isearch-forward
(eww-next-url)
(eww-previous-url))))
(current-buffer))
;;; bookmark.el support
(declare-function bookmark-make-record-default
"bookmark" (&optional no-file no-context posn))
(declare-function bookmark-prop-get "bookmark" (bookmark prop))
(defun eww-bookmark-name ()
"Create a default bookmark name for the current EWW buffer."
(plist-get eww-data :title))
(defun eww-bookmark-make-record ()
"Create a bookmark for the current EWW buffer."
`(,(eww-bookmark-name)
,@(bookmark-make-record-default t)
(location . ,(plist-get eww-data :url))
(handler . eww-bookmark-jump)))
;;;###autoload
(defun eww-bookmark-jump (bookmark)
"Default bookmark handler for EWW buffers."
(eww (bookmark-prop-get bookmark 'location)))
(put 'eww-bookmark-jump 'bookmark-handler-type "EWW")
(provide 'eww)
;;; Alternate links (RSS and Atom feeds, etc.)
(defun eww--alternate-urls (dom &optional base)
"Return an alist of alternate links in DOM.
Each element is a list of the form (URL TYPE TITLE) where URL is
the href attribute of the link expanded relative to BASE, TYPE is
its type attribute, and TITLE is its title attribute. If any of
these attributes is absent, the corresponding element is nil."
(let ((alternates
(seq-filter
(lambda (attrs) (string= (alist-get 'rel attrs)
"alternate"))
(mapcar #'dom-attributes (dom-by-tag dom 'link)))))
(mapcar (lambda (alternate)
(list (url-expand-file-name (alist-get 'href alternate)
base)
(alist-get 'type alternate)
(alist-get 'title alternate)))
alternates)))
(defun eww-read-alternate-url ()
"Get the URL of an alternate link of this page.
If there is just one alternate link, return its URL. If there
are multiple alternate links, prompt for one in the minibuffer
with completion. If there are none, return nil."
(when-let* ((alternates (eww--alternate-urls
(plist-get eww-data :dom)
(plist-get eww-data :url))))
(let ((url-max-width
(seq-max (mapcar #'string-pixel-width
(mapcar #'car alternates))))
(title-max-width
(seq-max (mapcar #'string-pixel-width
(mapcar #'caddr alternates))))
(sep-width (string-pixel-width " ")))
(if (cdr alternates)
(let ((completion-extra-properties
(list :annotation-function
(lambda (feed)
(let* ((attrs (alist-get feed
alternates
nil
nil
#'string=))
(type (car attrs))
(title (cadr attrs)))
(concat
(propertize " " 'display
`(space :align-to
(,(+ sep-width
url-max-width))))
title
(when type
(concat
(propertize " " 'display
`(space :align-to
(,(+ (* 2 sep-width)
url-max-width
title-max-width))))
"[" type "]"))))))))
(completing-read "Alternate URL: " alternates nil t))
(caar alternates)))))
(defun eww-copy-alternate-url ()
"Copy the alternate URL of the current page into the kill ring.
If there are multiple alternate links on the current page, prompt
for one in the minibuffer, with completion.
Alternate links are references that an HTML page may include to
point to its alternative representations, such as a translated
version or an RSS feed."
(interactive nil eww-mode)
(if-let* ((url (eww-read-alternate-url)))
(progn
(kill-new url)
(message "Copied %s to kill ring" url))
(user-error "No alternate links found on this page!")))
;;; eww.el ends here
Reference in New Issue View Git Blame Copy Permalink