Commit c74cb344 authored by Gnus developers's avatar Gnus developers Committed by Katsumi Yamaoka

2013-06-16 Lars Magne Ingebrigtsen <larsi@gnus.org>

* eww.el (eww-display-html): Default to using the entire window width.
* shr.el (shr-make-table): Cache the table rendering at the table level, and not the <td> level. This is a bit faster.
* eww.el (eww-render): Go to the correct ID when given URLs ending with #id.
* shr.el (shr-tag-li): Don't require a new paragraph, since other browsers don't.
(shr-expand-url): Respect #anchor links.
(shr-parse-base): Chop off the anchor before using.
(shr-descend): Respect display: none.
(shr-descend): Allow marking elements that have certain IDs.
* eww.el (eww-tag-textarea): Use `text' instead of `editable-field'.
* shr.el (shr-expand-url): Don't bug out on zero-length links.
* eww.el (eww-tag-textarea): Support <textarea>.

2013-06-16 Rüdiger Sonderfeld <ruediger@c-plusplus.de>
* shr.el (shr-dom-to-xml): Fixed function call.
* eww.el (eww): New group.
(eww-header-line-format): New custom variable.
(eww-current-title): New variable.
(eww-display-html): Update header and handle title tag.
(eww-update-header-line-format): New function.
(eww-tag-title): New function.
* shr.el (shr-dom-to-xml): (shr-dom-to-xml): New function.
(shr-tag-svg): Add support for the SVG tag.
(shr-bullet): New custom variable.
(shr-tag-li): Support custom bullet in unordered lists.
2013-06-16 Lars Magne Ingebrigtsen <larsi@gnus.org>
* shr.el (shr-expand-url): Respect // URLs.
* eww.el (eww-tag-body): Override the shr body rendering so that we can
put a background colour onto the entire buffer.
(eww-render): When being redirected, use the redirect URL as the new
base URL.
* shr.el (shr-parse-base): Fix parsing error.
* eww.el (eww-submit): Pass the base in to `shr-expand-url'.
* shr.el (shr-parse-base): New function.
(shr-expand-url): Use it to expand relative URLs reliably.
parent 28237e48
2013-06-16 Lars Magne Ingebrigtsen <larsi@gnus.org>
* eww.el (eww-display-html): Default to using the entire window width.
* shr.el (shr-make-table): Cache the table rendering at the table
level, and not the <td> level. This is a bit faster.
* eww.el (eww-render): Go to the correct ID when given URLs ending with
#id.
* shr.el (shr-tag-li): Don't require a new paragraph, since other
browsers don't.
(shr-expand-url): Respect #anchor links.
(shr-parse-base): Chop off the anchor before using.
(shr-descend): Respect display: none.
(shr-descend): Allow marking elements that have certain IDs.
* eww.el (eww-tag-textarea): Use `text' instead of `editable-field'.
* shr.el (shr-expand-url): Don't bug out on zero-length links.
* eww.el (eww-tag-textarea): Support <textarea>.
2013-06-16 Rüdiger Sonderfeld <ruediger@c-plusplus.de>
* shr.el (shr-dom-to-xml): Fixed function call.
* eww.el (eww): New group.
(eww-header-line-format): New custom variable.
(eww-current-title): New variable.
(eww-display-html): Update header and handle title tag.
(eww-update-header-line-format): New function.
(eww-tag-title): New function.
* shr.el (shr-dom-to-xml): (shr-dom-to-xml): New function.
(shr-tag-svg): Add support for the SVG tag.
(shr-bullet): New custom variable.
(shr-tag-li): Support custom bullet in unordered lists.
2013-06-16 Lars Magne Ingebrigtsen <larsi@gnus.org>
* shr.el (shr-expand-url): Respect // URLs.
* eww.el (eww-tag-body): Override the shr body rendering so that we can
put a background colour onto the entire buffer.
(eww-render): When being redirected, use the redirect URL as the new
base URL.
* shr.el (shr-parse-base): Fix parsing error.
* eww.el (eww-submit): Pass the base in to `shr-expand-url'.
* shr.el (shr-parse-base): New function.
(shr-expand-url): Use it to expand relative URLs reliably.
2013-06-15 Teodor Zlatanov <tzz@lifelogs.com>
* auth-source.el (auth-source-search-collection): Fix docstring.
......
......@@ -29,7 +29,22 @@
(require 'url)
(require 'mm-url)
(defgroup eww nil
"Emacs Web Wowser"
:version "24.4"
:group 'hypermedia
:prefix "eww-")
(defcustom eww-header-line-format "%t: %u"
"Header line format.
- %t is replaced by the title.
- %u is replaced by the URL."
:group 'eww
:type 'string)
(defvar eww-current-url nil)
(defvar eww-current-title ""
"Title of current page.")
(defvar eww-history nil)
;;;###autoload
......@@ -53,7 +68,13 @@
(match-string 1)))))
(defun eww-render (status url &optional point)
(let ((redirect (plist-get status :redirect)))
(when redirect
(setq url redirect)))
(let* ((headers (eww-parse-headers))
(shr-target-id
(and (string-match "#\\(.*\\)" url)
(match-string 1 url)))
(content-type
(mail-header-parse-content-type
(or (cdr (assoc "content-type" headers))
......@@ -74,8 +95,14 @@
(eww-display-image))
(t
(eww-display-raw charset)))
(when point
(goto-char point)))
(cond
(point
(goto-char point))
(shr-target-id
(let ((point (next-single-property-change
(point-min) 'shr-target-id)))
(when point
(goto-char (1+ point)))))))
(kill-buffer data-buffer))))
(defun eww-parse-headers ()
......@@ -101,15 +128,56 @@
(libxml-parse-html-region (point) (point-max)))))
(eww-setup-buffer)
(setq eww-current-url url)
(eww-update-header-line-format)
(let ((inhibit-read-only t)
(shr-width nil)
(shr-external-rendering-functions
'((form . eww-tag-form)
'((title . eww-tag-title)
(form . eww-tag-form)
(input . eww-tag-input)
(textarea . eww-tag-textarea)
(body . eww-tag-body)
(select . eww-tag-select))))
(shr-insert-document document)
(eww-convert-widgets))
(goto-char (point-min))))
(defun eww-update-header-line-format ()
(if eww-header-line-format
(setq header-line-format (format-spec eww-header-line-format
`((?u . ,eww-current-url)
(?t . ,eww-current-title))))
(setq header-line-format nil)))
(defun eww-tag-title (cont)
(setq eww-current-title "")
(dolist (sub cont)
(when (eq (car sub) 'text)
(setq eww-current-title (concat eww-current-title (cdr sub)))))
(eww-update-header-line-format))
(defun eww-tag-body (cont)
(let* ((start (point))
(fgcolor (cdr (or (assq :fgcolor cont)
(assq :text cont))))
(bgcolor (cdr (assq :bgcolor cont)))
(shr-stylesheet (list (cons 'color fgcolor)
(cons 'background-color bgcolor))))
(shr-generic cont)
(eww-colorize-region start (point) fgcolor bgcolor)))
(defun eww-colorize-region (start end fg &optional bg)
(when (or fg bg)
(let ((new-colors (shr-color-check fg bg)))
(when new-colors
(when fg
(eww-put-color start end :foreground (cadr new-colors)))
(when bg
(eww-put-color start end :background (car new-colors)))))))
(defun eww-put-color (start end type color)
(shr-put-color-1 start end type color))
(defun eww-display-raw (charset)
(let ((data (buffer-substring (point) (point-max))))
(eww-setup-buffer)
......@@ -240,6 +308,21 @@
(apply 'widget-create widget)
(put-text-property start (point) 'eww-widget widget))))
(defun eww-tag-textarea (cont)
(let* ((start (point))
(widget
(list 'text
:size (string-to-number
(or (cdr (assq :cols cont))
"40"))
:value (or (cdr (assq 'text cont)) "")
:action 'eww-submit
:name (cdr (assq :name cont))
:eww-form eww-form)))
(nconc eww-form (list widget))
(apply 'widget-create widget)
(put-text-property start (point) 'eww-widget widget)))
(defun eww-tag-select (cont)
(shr-ensure-paragraph)
(let ((menu (list 'menu-choice
......@@ -330,22 +413,22 @@
(plist-get (cdr elem) :value))
values)
(setq rest nil))))))
(debug values)
(let ((shr-base eww-current-url))
(if (and (stringp (cdr (assq :method form)))
(equal (downcase (cdr (assq :method form))) "post"))
(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)))))
(eww-browse-url
(concat
(if (cdr (assq :action form))
(shr-expand-url (cdr (assq :action form)))
eww-current-url)
"?"
(mm-url-encode-www-form-urlencoded values)))))))
(if (and (stringp (cdr (assq :method form)))
(equal (downcase (cdr (assq :method form))) "post"))
(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))
eww-current-url)))
(eww-browse-url
(concat
(if (cdr (assq :action form))
(shr-expand-url (cdr (assq :action form))
eww-current-url)
eww-current-url)
"?"
(mm-url-encode-www-form-urlencoded values))))))
(defun eww-convert-widgets ()
(let ((start (point-min))
......
......@@ -83,6 +83,14 @@ used."
(const :tag "Use the width of the window" nil))
:group 'shr)
(defcustom shr-bullet "* "
"Bullet used for unordered lists.
Alternative suggestions are:
- \" \"
- \" \""
:type 'string
:group 'shr)
(defvar shr-content-function nil
"If bound, this should be a function that will return the content.
This is used for cid: URLs, and the function is called with the
......@@ -115,6 +123,7 @@ cid: URL as the argument.")
(defvar shr-base nil)
(defvar shr-ignore-cache nil)
(defvar shr-external-rendering-functions nil)
(defvar shr-target-id nil)
(defvar shr-map
(let ((map (make-sparse-keymap)))
......@@ -303,18 +312,24 @@ size, and full-buffer size."
(shr-stylesheet shr-stylesheet)
(start (point)))
(when style
(if (string-match "color" style)
(if (string-match "color\\|display" style)
(setq shr-stylesheet (nconc (shr-parse-style style)
shr-stylesheet))
(setq style nil)))
(if (fboundp function)
(funcall function (cdr dom))
(shr-generic (cdr dom)))
;; If style is set, then this node has set the color.
(when style
(shr-colorize-region start (point)
(cdr (assq 'color shr-stylesheet))
(cdr (assq 'background-color shr-stylesheet))))))
;; If we have a display:none, then just ignore this part of the
;; DOM.
(unless (equal (cdr (assq 'display shr-stylesheet)) "none")
(if (fboundp function)
(funcall function (cdr dom))
(shr-generic (cdr dom)))
(when (and shr-target-id
(equal (cdr (assq :id (cdr dom))) shr-target-id))
(put-text-property start (1+ start) 'shr-target-id shr-target-id))
;; If style is set, then this node has set the color.
(when style
(shr-colorize-region start (point)
(cdr (assq 'color shr-stylesheet))
(cdr (assq 'background-color shr-stylesheet)))))))
(defun shr-generic (cont)
(dolist (sub cont)
......@@ -484,31 +499,51 @@ size, and full-buffer size."
(forward-char 1))))
(not failed)))
(defun shr-expand-url (url)
(if (or (not url)
(string-match "\\`[a-z]*:" url)
(not shr-base))
;; Absolute URL.
url
(let ((base shr-base))
;; Chop off query string.
(when (string-match "\\`\\([^?]+\\)[?]" base)
(setq base (match-string 1 base)))
;; Chop off the bit after the last slash.
(when (string-match "\\`\\(.*\\)[/][^/]+" base)
(setq base (match-string 1 base)))
(cond
((and (string-match "\\`//" url)
(string-match "\\`[a-z]*:" base))
(concat (match-string 0 base) url))
((and (not (string-match "/\\'" base))
(not (string-match "\\`/" url)))
(concat base "/" url))
((and (string-match "\\`/" url)
(string-match "\\(\\`[^:]*://[^/]+\\)/" base))
(concat (match-string 1 base) url))
(t
(concat base url))))))
(defun shr-parse-base (url)
;; Always chop off anchors.
(when (string-match "#.*" url)
(setq url (substring url 0 (match-beginning 0))))
(let* ((parsed (url-generic-parse-url url))
(local (url-filename parsed)))
(setf (url-filename parsed) "")
;; Chop off the bit after the last slash.
(when (string-match "\\`\\(.*/\\)[^/]+\\'" local)
(setq local (match-string 1 local)))
;; Always make the local bit end with a slash.
(when (and (not (zerop (length local)))
(not (eq (aref local (1- (length local))) ?/)))
(setq local (concat local "/")))
(list (url-recreate-url parsed)
local
(url-type parsed)
url)))
(defun shr-expand-url (url &optional base)
(setq base
(if base
(shr-parse-base base)
;; Bound by the parser.
shr-base))
(when (zerop (length url))
(setq url nil))
(cond ((or (not url)
(not base)
(string-match "\\`[a-z]*:" url))
;; Absolute URL.
(or url (car base)))
((eq (aref url 0) ?/)
(if (and (> (length url) 1)
(eq (aref url 1) ?/))
;; //host...; just use the protocol
(concat (nth 2 base) ":" url)
;; Just use the host name part.
(concat (car base) url)))
((eq (aref url 0) ?#)
;; A link to an anchor.
(concat (nth 3 base) url))
(t
;; Totally relative.
(concat (car base) (cadr base) url))))
(defun shr-ensure-newline ()
(unless (zerop (current-column))
......@@ -894,8 +929,31 @@ ones, in case fg and bg are nil."
(defun shr-tag-comment (cont)
)
(defun shr-dom-to-xml (dom)
"Convert DOM into a string containing the xml representation."
(let ((arg " ")
(text ""))
(dolist (sub (cdr dom))
(cond
((listp (cdr sub))
(setq text (concat text (shr-dom-to-xml sub))))
((eq (car sub) 'text)
(setq text (concat text (cdr sub))))
(t
(setq arg (concat arg (format "%s=\"%s\" "
(substring (symbol-name (car sub)) 1)
(cdr sub)))))))
(format "<%s%s>%s</%s>"
(car dom)
(substring arg 0 (1- (length arg)))
text
(car dom))))
(defun shr-tag-svg (cont)
)
(when (image-type-available-p 'svg)
(funcall shr-put-image-function
(shr-dom-to-xml (cons 'svg cont))
"SVG Image")))
(defun shr-tag-sup (cont)
(let ((start (point)))
......@@ -965,7 +1023,7 @@ ones, in case fg and bg are nil."
plist)))
(defun shr-tag-base (cont)
(setq shr-base (cdr (assq :href cont)))
(setq shr-base (shr-parse-base (cdr (assq :href cont))))
(shr-generic cont))
(defun shr-tag-a (cont)
......@@ -1087,14 +1145,14 @@ ones, in case fg and bg are nil."
(shr-ensure-paragraph))
(defun shr-tag-li (cont)
(shr-ensure-paragraph)
(shr-ensure-newline)
(shr-indent)
(let* ((bullet
(if (numberp shr-list-mode)
(prog1
(format "%d " shr-list-mode)
(setq shr-list-mode (1+ shr-list-mode)))
"* "))
shr-bullet))
(shr-indentation (+ shr-indentation (length bullet))))
(insert bullet)
(shr-generic cont)))
......@@ -1352,6 +1410,13 @@ ones, in case fg and bg are nil."
widths))
(defun shr-make-table (cont widths &optional fill)
(or (cadr (assoc (list cont widths fill) shr-content-cache))
(let ((data (shr-make-table-1 cont widths fill)))
(push (list (list cont widths fill) data)
shr-content-cache)
data)))
(defun shr-make-table-1 (cont widths &optional fill)
(let ((trs nil))
(dolist (row cont)
(when (eq (car row) 'tr)
......@@ -1385,32 +1450,16 @@ ones, in case fg and bg are nil."
(setq style (nconc (list (cons 'color fgcolor)) style)))
(when style
(setq shr-stylesheet (append style shr-stylesheet)))
(let ((cache (cdr (assoc (cons width cont) shr-content-cache))))
(if cache
(progn
(insert (car cache))
(let ((end (length (car cache))))
(dolist (overlay (cadr cache))
(let ((new-overlay
(shr-make-overlay (1+ (- end (nth 0 overlay)))
(1+ (- end (nth 1 overlay)))))
(properties (nth 2 overlay)))
(while properties
(overlay-put new-overlay
(pop properties) (pop properties)))))))
(let ((shr-width width)
(shr-indentation 0))
(shr-descend (cons 'td cont)))
;; Delete padding at the bottom of the TDs.
(delete-region
(point)
(progn
(skip-chars-backward " \t\n")
(end-of-line)
(point)))
(push (list (cons width cont) (buffer-string)
(shr-overlays-in-region (point-min) (point-max)))
shr-content-cache)))
(let ((shr-width width)
(shr-indentation 0))
(shr-descend (cons 'td cont)))
;; Delete padding at the bottom of the TDs.
(delete-region
(point)
(progn
(skip-chars-backward " \t\n")
(end-of-line)
(point)))
(goto-char (point-min))
(let ((max 0))
(while (not (eobp))
......
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment