Commit d9ba097f authored by Lars Magne Ingebrigtsen's avatar Lars Magne Ingebrigtsen
Browse files

Use the new dom.el accessors in shr and eww

* net/shr.el: Ditto.

* net/eww.el: Use the new dom.el accessors throughout.
parent 115178cd
...@@ -406,38 +406,38 @@ See the `eww-search-prefix' variable for the search engine used." ...@@ -406,38 +406,38 @@ See the `eww-search-prefix' variable for the search engine used."
(setq eww-history-position 0) (setq eww-history-position 0)
(eww-update-header-line-format)))) (eww-update-header-line-format))))
(defun eww-handle-link (cont) (defun eww-handle-link (dom)
(let* ((rel (assq :rel cont)) (let* ((rel (dom-attr dom 'rel))
(href (assq :href cont)) (href (dom-attr dom 'href))
(where (assoc (where (assoc
;; The text associated with :rel is case-insensitive. ;; The text associated with :rel is case-insensitive.
(if rel (downcase (cdr rel))) (if rel (downcase rel))
'(("next" . :next) '(("next" . :next)
;; Texinfo uses "previous", but HTML specifies ;; Texinfo uses "previous", but HTML specifies
;; "prev", so recognize both. ;; "prev", so recognize both.
("previous" . :previous) ("previous" . :previous)
("prev" . :previous) ("prev" . :previous)
;; HTML specifies "start" but also "contents", ;; HTML specifies "start" but also "contents",
;; and Gtk seems to use "home". Recognize ;; and Gtk seems to use "home". Recognize
;; them all; but store them in different ;; them all; but store them in different
;; variables so that we can readily choose the ;; variables so that we can readily choose the
;; "best" one. ;; "best" one.
("start" . :start) ("start" . :start)
("home" . :home) ("home" . :home)
("contents" . :contents) ("contents" . :contents)
("up" . up))))) ("up" . up)))))
(and href (and href
where where
(plist-put eww-data (cdr where) (cdr href))))) (plist-put eww-data (cdr where) href))))
(defun eww-tag-link (cont) (defun eww-tag-link (dom)
(eww-handle-link cont) (eww-handle-link dom)
(shr-generic cont)) (shr-generic dom))
(defun eww-tag-a (cont) (defun eww-tag-a (dom)
(eww-handle-link cont) (eww-handle-link dom)
(let ((start (point))) (let ((start (point)))
(shr-tag-a cont) (shr-tag-a dom)
(put-text-property start (point) 'keymap eww-link-keymap))) (put-text-property start (point) 'keymap eww-link-keymap)))
(defun eww-update-header-line-format () (defun eww-update-header-line-format ()
...@@ -452,25 +452,24 @@ See the `eww-search-prefix' variable for the search engine used." ...@@ -452,25 +452,24 @@ See the `eww-search-prefix' variable for the search engine used."
(?t . ,(or (plist-get eww-data :title) "")))))) (?t . ,(or (plist-get eww-data :title) ""))))))
(setq header-line-format nil))) (setq header-line-format nil)))
(defun eww-tag-title (cont) (defun eww-tag-title (dom)
(let ((title "")) (let ((title ""))
(dolist (sub cont) (dolist (sub (dom-children dom))
(when (eq (car sub) 'text) (when (stringp sub)
(setq title (concat title (cdr sub))))) (setq title (concat title sub))))
(plist-put eww-data :title (plist-put eww-data :title
(replace-regexp-in-string (replace-regexp-in-string
"^ \\| $" "" "^ \\| $" ""
(replace-regexp-in-string "[ \t\r\n]+" " " title)))) (replace-regexp-in-string "[ \t\r\n]+" " " title))))
(eww-update-header-line-format)) (eww-update-header-line-format))
(defun eww-tag-body (cont) (defun eww-tag-body (dom)
(let* ((start (point)) (let* ((start (point))
(fgcolor (cdr (or (assq :fgcolor cont) (fgcolor (or (dom-attr dom 'fgcolor) (dom-attr dom 'text)))
(assq :text cont)))) (bgcolor (dom-attr dom 'bgcolor))
(bgcolor (cdr (assq :bgcolor cont)))
(shr-stylesheet (list (cons 'color fgcolor) (shr-stylesheet (list (cons 'color fgcolor)
(cons 'background-color bgcolor)))) (cons 'background-color bgcolor))))
(shr-generic cont) (shr-generic dom)
(shr-colorize-region start (point) fgcolor bgcolor))) (shr-colorize-region start (point) fgcolor bgcolor)))
(defun eww-display-raw (buffer &optional encode) (defun eww-display-raw (buffer &optional encode)
...@@ -550,18 +549,16 @@ contains the main textual portion, leaving out navigation menus and ...@@ -550,18 +549,16 @@ contains the main textual portion, leaving out navigation menus and
the like." the like."
(interactive) (interactive)
(let* ((old-data eww-data) (let* ((old-data eww-data)
(dom (shr-transform-dom (dom (with-temp-buffer
(with-temp-buffer (insert (plist-get old-data :source))
(insert (plist-get old-data :source)) (condition-case nil
(condition-case nil (decode-coding-region (point-min) (point-max) 'utf-8)
(decode-coding-region (point-min) (point-max) 'utf-8) (coding-system-error nil))
(coding-system-error nil)) (libxml-parse-html-region (point-min) (point-max)))))
(libxml-parse-html-region (point-min) (point-max))))))
(eww-score-readability dom) (eww-score-readability dom)
(eww-save-history) (eww-save-history)
(eww-display-html nil nil (eww-display-html nil nil
(shr-retransform-dom (eww-highest-readability dom)
(eww-highest-readability dom))
nil (current-buffer)) nil (current-buffer))
(dolist (elem '(:source :url :title :next :previous :up)) (dolist (elem '(:source :url :title :next :previous :up))
(plist-put eww-data elem (plist-get old-data elem))) (plist-put eww-data elem (plist-get old-data elem)))
...@@ -570,41 +567,35 @@ the like." ...@@ -570,41 +567,35 @@ the like."
(defun eww-score-readability (node) (defun eww-score-readability (node)
(let ((score -1)) (let ((score -1))
(cond (cond
((memq (car node) '(script head comment)) ((memq (dom-tag node) '(script head comment))
(setq score -2)) (setq score -2))
((eq (car node) 'meta) ((eq (dom-tag node) 'meta)
(setq score -1)) (setq score -1))
((eq (car node) 'img) ((eq (dom-tag node) 'img)
(setq score 2)) (setq score 2))
((eq (car node) 'a) ((eq (dom-tag node) 'a)
(setq score (- (length (split-string (setq score (- (length (split-string (dom-text node))))))
(or (cdr (assoc 'text (cdr node))) ""))))))
(t (t
(dolist (elem (cdr node)) (dolist (elem (dom-children node))
(cond (if (stringp elem)
((and (stringp (cdr elem)) (setq score (+ score (length (split-string elem))))
(eq (car elem) 'text))
(setq score (+ score (length (split-string (cdr elem))))))
((consp (cdr elem))
(setq score (+ score (setq score (+ score
(or (cdr (assoc :eww-readability-score (cdr elem))) (or (cdr (assoc :eww-readability-score (cdr elem)))
(eww-score-readability elem))))))))) (eww-score-readability elem))))))))
;; Cache the score of the node to avoid recomputing all the time. ;; Cache the score of the node to avoid recomputing all the time.
(setcdr node (cons (cons :eww-readability-score score) (cdr node))) (dom-set-attribute node :eww-readability-score score)
score)) score))
(defun eww-highest-readability (node) (defun eww-highest-readability (node)
(let ((result node) (let ((result node)
highest) highest)
(dolist (elem (cdr node)) (dolist (elem (dom-children node))
(when (and (consp (cdr elem)) (when (> (or (dom-attr
(> (or (cdr (assoc (setq highest (eww-highest-readability elem))
:eww-readability-score :eww-readability-score)
(setq highest most-negative-fixnum)
(eww-highest-readability elem)))) (or (dom-attr (cdr result) :eww-readability-score)
most-negative-fixnum) most-negative-fixnum))
(or (cdr (assoc :eww-readability-score (cdr result)))
most-negative-fixnum)))
(setq result highest))) (setq result highest)))
result)) result))
...@@ -864,13 +855,12 @@ appears in a <link> or <a> tag." ...@@ -864,13 +855,12 @@ appears in a <link> or <a> tag."
(1- (next-single-property-change (1- (next-single-property-change
(point) 'eww-form nil (point-max)))) (point) 'eww-form nil (point-max))))
(defun eww-tag-form (cont) (defun eww-tag-form (dom)
(let ((eww-form (let ((eww-form (list (cons :method (dom-attr dom 'method))
(list (assq :method cont) (cons :action (dom-attr dom 'action))))
(assq :action cont)))
(start (point))) (start (point)))
(shr-ensure-paragraph) (shr-ensure-paragraph)
(shr-generic cont) (shr-generic dom)
(unless (bolp) (unless (bolp)
(insert "\n")) (insert "\n"))
(insert "\n") (insert "\n")
...@@ -878,9 +868,9 @@ appears in a <link> or <a> tag." ...@@ -878,9 +868,9 @@ appears in a <link> or <a> tag."
(put-text-property start (1+ start) (put-text-property start (1+ start)
'eww-form eww-form)))) 'eww-form eww-form))))
(defun eww-form-submit (cont) (defun eww-form-submit (dom)
(let ((start (point)) (let ((start (point))
(value (cdr (assq :value cont)))) (value (dom-attr dom 'value)))
(setq value (setq value
(if (zerop (length value)) (if (zerop (length value))
"Submit" "Submit"
...@@ -891,28 +881,28 @@ appears in a <link> or <a> tag." ...@@ -891,28 +881,28 @@ appears in a <link> or <a> tag."
(list :eww-form eww-form (list :eww-form eww-form
:value value :value value
:type "submit" :type "submit"
:name (cdr (assq :name cont)))) :name (dom-attr dom 'name)))
(put-text-property start (point) 'keymap eww-submit-map) (put-text-property start (point) 'keymap eww-submit-map)
(insert " "))) (insert " ")))
(defun eww-form-checkbox (cont) (defun eww-form-checkbox (dom)
(let ((start (point))) (let ((start (point)))
(if (cdr (assq :checked cont)) (if (dom-attr dom 'checked)
(insert eww-form-checkbox-selected-symbol) (insert eww-form-checkbox-selected-symbol)
(insert eww-form-checkbox-symbol)) (insert eww-form-checkbox-symbol))
(add-face-text-property start (point) 'eww-form-checkbox) (add-face-text-property start (point) 'eww-form-checkbox)
(put-text-property start (point) 'eww-form (put-text-property start (point) 'eww-form
(list :eww-form eww-form (list :eww-form eww-form
:value (cdr (assq :value cont)) :value (dom-attr dom 'value)
:type (downcase (cdr (assq :type cont))) :type (downcase (dom-attr dom 'type))
:checked (cdr (assq :checked cont)) :checked (dom-attr dom 'checked)
:name (cdr (assq :name cont)))) :name (dom-attr dom 'name)))
(put-text-property start (point) 'keymap eww-checkbox-map) (put-text-property start (point) 'keymap eww-checkbox-map)
(insert " "))) (insert " ")))
(defun eww-form-file (cont) (defun eww-form-file (dom)
(let ((start (point)) (let ((start (point))
(value (cdr (assq :value cont)))) (value (dom-attr dom 'value)))
(setq value (setq value
(if (zerop (length value)) (if (zerop (length value))
" No file selected" " No file selected"
...@@ -922,9 +912,9 @@ appears in a <link> or <a> tag." ...@@ -922,9 +912,9 @@ appears in a <link> or <a> tag."
(insert value) (insert value)
(put-text-property start (point) 'eww-form (put-text-property start (point) 'eww-form
(list :eww-form eww-form (list :eww-form eww-form
:value (cdr (assq :value cont)) :value (dom-attr dom 'value)
:type (downcase (cdr (assq :type cont))) :type (downcase (dom-attr dom 'type))
:name (cdr (assq :name cont)))) :name (dom-attr dom 'name)))
(put-text-property start (point) 'keymap eww-submit-file) (put-text-property start (point) 'keymap eww-submit-file)
(insert " "))) (insert " ")))
...@@ -938,16 +928,13 @@ appears in a <link> or <a> tag." ...@@ -938,16 +928,13 @@ appears in a <link> or <a> tag."
(eww-update-field filename (length "Browse")) (eww-update-field filename (length "Browse"))
(plist-put input :filename filename)))) (plist-put input :filename filename))))
(defun eww-form-text (cont) (defun eww-form-text (dom)
(let ((start (point)) (let ((start (point))
(type (downcase (or (cdr (assq :type cont)) (type (downcase (or (dom-attr dom 'type) "text")))
"text"))) (value (or (dom-attr dom 'value) ""))
(value (or (cdr (assq :value cont)) "")) (width (string-to-number (or (dom-attr dom 'size) "40")))
(width (string-to-number (readonly-property (if (or (dom-attr dom 'disabled)
(or (cdr (assq :size cont)) (dom-attr dom 'readonly))
"40")))
(readonly-property (if (or (cdr (assq :disabled cont))
(cdr (assq :readonly cont)))
'read-only 'read-only
'inhibit-read-only))) 'inhibit-read-only)))
(insert value) (insert value)
...@@ -961,7 +948,7 @@ appears in a <link> or <a> tag." ...@@ -961,7 +948,7 @@ appears in a <link> or <a> tag."
(list :eww-form eww-form (list :eww-form eww-form
:value value :value value
:type type :type type
:name (cdr (assq :name cont)))) :name (dom-attr dom 'name)))
(insert " "))) (insert " ")))
(defconst eww-text-input-types '("text" "password" "textarea" (defconst eww-text-input-types '("text" "password" "textarea"
...@@ -1014,15 +1001,11 @@ See URL `https://developer.mozilla.org/en-US/docs/Web/HTML/Element/Input'.") ...@@ -1014,15 +1001,11 @@ See URL `https://developer.mozilla.org/en-US/docs/Web/HTML/Element/Input'.")
(put-text-property start (+ start (length value)) (put-text-property start (+ start (length value))
'display (make-string (length value) ?*)))))))) 'display (make-string (length value) ?*))))))))
(defun eww-tag-textarea (cont) (defun eww-tag-textarea (dom)
(let ((start (point)) (let ((start (point))
(value (or (cdr (assq :value cont)) "")) (value (or (dom-attr dom 'value) ""))
(lines (string-to-number (lines (string-to-number (or (dom-attr dom 'rows) "10")))
(or (cdr (assq :rows cont)) (width (string-to-number (or (dom-attr dom 'cols) "10")))
"10")))
(width (string-to-number
(or (cdr (assq :cols cont))
"10")))
end) end)
(shr-ensure-newline) (shr-ensure-newline)
(insert value) (insert value)
...@@ -1047,23 +1030,22 @@ See URL `https://developer.mozilla.org/en-US/docs/Web/HTML/Element/Input'.") ...@@ -1047,23 +1030,22 @@ See URL `https://developer.mozilla.org/en-US/docs/Web/HTML/Element/Input'.")
(list :eww-form eww-form (list :eww-form eww-form
:value value :value value
:type "textarea" :type "textarea"
:name (cdr (assq :name cont)))))) :name (dom-attr dom 'name)))))
(defun eww-tag-input (cont) (defun eww-tag-input (dom)
(let ((type (downcase (or (cdr (assq :type cont)) (let ((type (downcase (or (dom-attr dom 'type) "text")))
"text")))
(start (point))) (start (point)))
(cond (cond
((or (equal type "checkbox") ((or (equal type "checkbox")
(equal type "radio")) (equal type "radio"))
(eww-form-checkbox cont)) (eww-form-checkbox dom))
((equal type "file") ((equal type "file")
(eww-form-file cont)) (eww-form-file dom))
((equal type "submit") ((equal type "submit")
(eww-form-submit cont)) (eww-form-submit dom))
((equal type "hidden") ((equal type "hidden")
(let ((form eww-form) (let ((form eww-form)
(name (cdr (assq :name cont)))) (name (dom-attr dom 'name)))
;; Don't add <input type=hidden> elements repeatedly. ;; Don't add <input type=hidden> elements repeatedly.
(while (and form (while (and form
(or (not (consp (car form))) (or (not (consp (car form)))
...@@ -1075,34 +1057,33 @@ See URL `https://developer.mozilla.org/en-US/docs/Web/HTML/Element/Input'.") ...@@ -1075,34 +1057,33 @@ See URL `https://developer.mozilla.org/en-US/docs/Web/HTML/Element/Input'.")
(nconc eww-form (list (nconc eww-form (list
(list 'hidden (list 'hidden
:name name :name name
:value (cdr (assq :value cont)))))))) :value (dom-attr dom 'value)))))))
(t (t
(eww-form-text cont))) (eww-form-text dom)))
(unless (= start (point)) (unless (= start (point))
(put-text-property start (1+ start) 'help-echo "Input field")))) (put-text-property start (1+ start) 'help-echo "Input field"))))
(defun eww-tag-select (cont) (defun eww-tag-select (dom)
(shr-ensure-paragraph) (shr-ensure-paragraph)
(let ((menu (list :name (cdr (assq :name cont)) (let ((menu (list :name (dom-attr dom 'name)
:eww-form eww-form)) :eww-form eww-form))
(options nil) (options nil)
(start (point)) (start (point))
(max 0) (max 0)
opelem) opelem)
(if (eq (car (car cont)) 'optgroup) (if (eq (dom-tag dom) 'optgroup)
(dolist (groupelem cont) (dolist (groupelem (dom-children dom))
(unless (cdr (assq :disabled (cdr groupelem))) (unless (dom-attr groupelem 'disabled)
(setq opelem (append opelem (cdr (cdr groupelem)))))) (setq opelem (append opelem (list groupelem)))))
(setq opelem cont)) (setq opelem (list dom)))
(dolist (elem opelem) (dolist (elem opelem)
(when (eq (car elem) 'option) (when (eq (dom-tag elem) 'option)
(when (cdr (assq :selected (cdr elem))) (when (dom-attr elem 'selected)
(nconc menu (list :value (nconc menu (list :value (dom-attr elem 'value))))
(cdr (assq :value (cdr elem)))))) (let ((display (dom-text elem)))
(let ((display (or (cdr (assq 'text (cdr elem))) "")))
(setq max (max max (length display))) (setq max (max max (length display)))
(push (list 'item (push (list 'item
:value (cdr (assq :value (cdr elem))) :value (dom-attr elem 'value)
:display display) :display display)
options)))) options))))
(when options (when options
...@@ -1302,8 +1283,7 @@ See URL `https://developer.mozilla.org/en-US/docs/Web/HTML/Element/Input'.") ...@@ -1302,8 +1283,7 @@ See URL `https://developer.mozilla.org/en-US/docs/Web/HTML/Element/Input'.")
(eww-browse-url (eww-browse-url
(concat (concat
(if (cdr (assq :action form)) (if (cdr (assq :action form))
(shr-expand-url (cdr (assq :action form)) (shr-expand-url (cdr (assq :action form)) (plist-get eww-data :url))
(plist-get eww-data :url))
(plist-get eww-data :url)) (plist-get eww-data :url))
"?" "?"
(mm-url-encode-www-form-urlencoded values)))))) (mm-url-encode-www-form-urlencoded values))))))
......
This diff is collapsed.
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