X-Git-Url: http://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Feww.el;h=fc6f591e0ce6deb9aca9d375efbfa651a41fec36;hb=6c74b53e357ecec4f6e48c1dbba4d60129d874dc;hp=3f0399ed2581c54dff7e17d1e2fe4425631021e6;hpb=ba7366475d45e7dad36fd53c42175ada2529710c;p=gnus diff --git a/lisp/eww.el b/lisp/eww.el index 3f0399ed2..fc6f591e0 100644 --- a/lisp/eww.el +++ b/lisp/eww.el @@ -25,11 +25,35 @@ ;;; Code: (eval-when-compile (require 'cl)) +(require 'format-spec) (require 'shr) (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) + +(defface eww-button + '((((type x w32 ns) (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) + (defvar eww-current-url nil) +(defvar eww-current-title "" + "Title of current page.") (defvar eww-history nil) ;;;###autoload @@ -53,7 +77,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 +104,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 +137,55 @@ (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 + (add-face-text-property start end + (list :foreground (cadr new-colors)))) + (when bg + (add-face-text-property start end + (list :background (car new-colors)))))))) + (defun eww-display-raw (charset) (let ((data (buffer-substring (point) (point-max)))) (eww-setup-buffer) @@ -137,8 +213,8 @@ (suppress-keymap map) (define-key map "q" 'eww-quit) (define-key map "g" 'eww-reload) - (define-key map [tab] 'widget-forward) - (define-key map [backtab] 'widget-backward) + (define-key map [tab] 'shr-next-link) + (define-key map [backtab] 'shr-previous-link) (define-key map [delete] 'scroll-down-command) (define-key map "\177" 'scroll-down-command) (define-key map " " 'scroll-up-command) @@ -189,7 +265,9 @@ (start (point))) (shr-ensure-paragraph) (shr-generic cont) - (shr-ensure-paragraph) + (unless (bolp) + (insert "\n")) + (insert "\n") (when (> (point) start) (put-text-property start (1+ start) 'eww-form eww-form)))) @@ -198,45 +276,63 @@ (let* ((start (point)) (type (downcase (or (cdr (assq :type cont)) "text"))) + (value (cdr (assq :value cont))) (widget (cond ((equal type "submit") - (list - 'push-button - :notify 'eww-submit - :name (cdr (assq :name cont)) - :eww-form eww-form - (or (cdr (assq :value cont)) "Submit"))) + (list 'push-button + :notify 'eww-submit + :name (cdr (assq :name cont)) + :value (if (zerop (length value)) + "Submit" + value) + :eww-form eww-form + (or (if (zerop (length value)) + "Submit" + value)))) ((or (equal type "radio") (equal type "checkbox")) (list 'checkbox :notify 'eww-click-radio :name (cdr (assq :name cont)) - :checkbox-value (cdr (assq :value cont)) + :checkbox-value value :checkbox-type type :eww-form eww-form (cdr (assq :checked cont)))) ((equal type "hidden") (list 'hidden :name (cdr (assq :name cont)) - :value (cdr (assq :value cont)))) + :value value)) (t - (list - 'editable-field - :size (string-to-number - (or (cdr (assq :size cont)) - "40")) - :value (or (cdr (assq :value cont)) "") - :secret (and (equal type "password") ?*) - :action 'eww-submit - :name (cdr (assq :name cont)) - :eww-form eww-form))))) - (if (eq (car widget) 'hidden) - (when shr-final-table-render - (nconc eww-form (list widget))) - (apply 'widget-create widget)) - (put-text-property start (point) 'eww-widget widget) - (insert " "))) + (list 'editable-field + :size (string-to-number + (or (cdr (assq :size cont)) + "40")) + :value (or value "") + :secret (and (equal type "password") ?*) + :action 'eww-submit + :name (cdr (assq :name cont)) + :eww-form eww-form))))) + (nconc eww-form (list widget)) + (unless (eq (car widget) 'hidden) + (apply 'widget-create widget) + (put-text-property start (point) 'eww-widget widget) + (insert " ")))) + +(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) @@ -254,10 +350,14 @@ :value (cdr (assq :value (cdr elem))) :tag (cdr (assq 'text (cdr elem)))) options))) - (nconc menu options) - (apply 'widget-create menu) - (put-text-property start (point) 'eww-widget menu) - (shr-ensure-paragraph))) + (when options + ;; If we have no selected values, default to the first value. + (unless (plist-get (cdr menu) :value) + (nconc menu (list :value (nth 2 (car options))))) + (nconc menu options) + (apply 'widget-create menu) + (put-text-property start (point) 'eww-widget menu) + (shr-ensure-paragraph)))) (defun eww-click-radio (widget &rest ignore) (let ((form (plist-get (cdr widget) :eww-form)) @@ -276,14 +376,12 @@ (defun eww-submit (widget &rest ignore) (let ((form (plist-get (cdr widget) :eww-form)) - (first-button t) values) (dolist (overlay (sort (overlays-in (point-min) (point-max)) (lambda (o1 o2) (< (overlay-start o1) (overlay-start o2))))) (let ((field (or (plist-get (overlay-properties overlay) 'field) - (plist-get (overlay-properties overlay) 'button) - (plist-get (overlay-properties overlay) 'eww-hidden)))) + (plist-get (overlay-properties overlay) 'button)))) (when (eq (plist-get (cdr field) :eww-form) form) (let ((name (plist-get (cdr field) :name))) (when name @@ -292,19 +390,12 @@ (when (widget-value field) (push (cons name (plist-get (cdr field) :checkbox-value)) values))) - ((eq (car field) 'eww-hidden) - (push (cons name (plist-get (cdr field) :value)) - values)) ((eq (car field) 'push-button) ;; We want the values from buttons if we hit a button, - ;; or we're submitting something and this is the first - ;; button displayed. - (when (or (and (eq (car widget) 'push-button) - (eq widget field)) - (and (not (eq (car widget) 'push-button)) - (eq (car field) 'push-button) - first-button)) - (setq first-button nil) + ;; if it's the first button in the DOM after the field + ;; hit ENTER on. + (when (and (eq (car widget) 'push-button) + (eq widget field)) (push (cons name (widget-value field)) values))) (t @@ -316,20 +407,40 @@ (push (cons (plist-get (cdr elem) :name) (plist-get (cdr elem) :value)) 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 - (shr-expand-url - (concat - (cdr (assq :action form)) - "?" - (mm-url-encode-www-form-urlencoded values)))))))) + ;; If we hit ENTER in a non-button field, include the value of the + ;; first submit button after it. + (unless (eq (car widget) 'push-button) + (let ((rest form) + (name (plist-get (cdr widget) :name))) + (when rest + (while (and rest + (or (not (consp (car rest))) + (not (equal name (plist-get (cdar rest) :name))))) + (pop rest))) + (while rest + (let ((elem (pop rest))) + (when (and (consp (car rest)) + (eq (car elem) 'push-button)) + (push (cons (plist-get (cdr elem) :name) + (plist-get (cdr elem) :value)) + values) + (setq rest nil)))))) + (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)) @@ -338,7 +449,9 @@ ;; so we need to nix out the list of widgets and recreate them. (setq widget-field-list nil widget-field-new nil) - (while (setq start (next-single-property-change start 'eww-widget)) + (while (setq start (if (get-text-property start 'eww-widget) + start + (next-single-property-change start 'eww-widget))) (setq widget (get-text-property start 'eww-widget)) (goto-char start) (let ((end (next-single-property-change start 'eww-widget))) @@ -347,7 +460,15 @@ (plist-get (overlay-properties overlay) 'field)) (delete-overlay overlay))) (delete-region start end)) - (apply 'widget-create widget)) + (when (and widget + (not (eq (car widget) 'hidden))) + (apply 'widget-create widget) + (put-text-property start (point) 'help-echo + (if (memq (car widget) '(text editable-field)) + "Input field" + "Button")) + (when (eq (car widget) 'push-button) + (add-face-text-property start (point) 'eww-button t)))) (widget-setup) (eww-fix-widget-keymap)))