From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!not-for-mail From: Kenjiro NAKAYAMA Newsgroups: gmane.emacs.bugs Subject: bug#16199: 24.3.50; [PATCH 2/2] eww: Does not support file upload. Date: Wed, 25 Dec 2013 13:31:55 +0900 Message-ID: <87mwjp7dqc.fsf@dhcp-193-97.nrt.redhat.com> References: <87eh57zx66.fsf@dhcp-193-97.nrt.redhat.com> NNTP-Posting-Host: plane.gmane.org Mime-Version: 1.0 Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: 8bit X-Trace: ger.gmane.org 1387945991 29088 80.91.229.3 (25 Dec 2013 04:33:11 GMT) X-Complaints-To: usenet@ger.gmane.org NNTP-Posting-Date: Wed, 25 Dec 2013 04:33:11 +0000 (UTC) Cc: 16199@debbugs.gnu.org To: Kenjiro NAKAYAMA Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane.org@gnu.org Wed Dec 25 05:33:17 2013 Return-path: Envelope-to: geb-bug-gnu-emacs@m.gmane.org Original-Received: from lists.gnu.org ([208.118.235.17]) by plane.gmane.org with esmtp (Exim 4.69) (envelope-from ) id 1Vvg9l-0001jr-DC for geb-bug-gnu-emacs@m.gmane.org; Wed, 25 Dec 2013 05:33:17 +0100 Original-Received: from localhost ([::1]:41240 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1Vvg9l-0003gA-04 for geb-bug-gnu-emacs@m.gmane.org; Tue, 24 Dec 2013 23:33:17 -0500 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:47519) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1Vvg9c-0003g1-TT for bug-gnu-emacs@gnu.org; Tue, 24 Dec 2013 23:33:14 -0500 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1Vvg9W-00064p-Vd for bug-gnu-emacs@gnu.org; Tue, 24 Dec 2013 23:33:08 -0500 Original-Received: from debbugs.gnu.org ([140.186.70.43]:54423) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1Vvg9W-00064l-RP for bug-gnu-emacs@gnu.org; Tue, 24 Dec 2013 23:33:02 -0500 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.80) (envelope-from ) id 1Vvg9W-0003bo-G8 for bug-gnu-emacs@gnu.org; Tue, 24 Dec 2013 23:33:02 -0500 X-Loop: help-debbugs@gnu.org Resent-From: Kenjiro NAKAYAMA Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Wed, 25 Dec 2013 04:33:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 16199 X-GNU-PR-Package: emacs X-GNU-PR-Keywords: pending patch Original-Received: via spool by 16199-submit@debbugs.gnu.org id=B16199.138794592513768 (code B ref 16199); Wed, 25 Dec 2013 04:33:02 +0000 Original-Received: (at 16199) by debbugs.gnu.org; 25 Dec 2013 04:32:05 +0000 Original-Received: from localhost ([127.0.0.1]:40209 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.80) (envelope-from ) id 1Vvg8a-0003Zz-Nl for submit@debbugs.gnu.org; Tue, 24 Dec 2013 23:32:05 -0500 Original-Received: from mail-pd0-f170.google.com ([209.85.192.170]:61503) by debbugs.gnu.org with esmtp (Exim 4.80) (envelope-from ) id 1Vvg8X-0003Zb-OU for 16199@debbugs.gnu.org; Tue, 24 Dec 2013 23:32:03 -0500 Original-Received: by mail-pd0-f170.google.com with SMTP id g10so6876874pdj.15 for <16199@debbugs.gnu.org>; Tue, 24 Dec 2013 20:32:01 -0800 (PST) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20120113; h=references:user-agent:from:to:cc:subject:in-reply-to:date :message-id:mime-version:content-type:content-transfer-encoding; bh=idDwSebHXOF9ifTkCBTZBomZ8Z5AQFa5kW4WPmSECrE=; b=XaECnWEUEIhjeWup6RhfJvUw1pb8CBedOdtxnEGKZx7LVUEvSB+HSc+ic3e1yS0dxa 2u6HruiR92znTBGuj/OnIFAQpD2IjrKDoCaI/IwIN0cjqr0OREt8iPYeGhfhYVHzatsq yl99VownoeR8xG9ABmHcDiHAvmE0fBlr9Zlpals4Mfe0OP987uA4dnnoLpBCrnRECbUm Ul92LknwDW7XSqOpa6nNdVNdhYD0Z3sPtkvys3G/b0Hj6LAWZTFL5cuWVOuIPoOgzGam pveYgwEAKQZAROgb8ZwNidsp86OXzdzmn+erK+vzXJoJ5vpIbhjkAKjUa/nLEziCfokP pJsQ== X-Received: by 10.67.5.131 with SMTP id cm3mr36294692pad.92.1387945921022; Tue, 24 Dec 2013 20:32:01 -0800 (PST) Original-Received: from dhcp-193-97.nrt.redhat.com (nat-pool-nrt-u1.redhat.com. [66.187.238.11]) by mx.google.com with ESMTPSA id iu7sm45303338pbc.45.2013.12.24.20.31.58 for (version=TLSv1.2 cipher=ECDHE-RSA-AES128-GCM-SHA256 bits=128/128); Tue, 24 Dec 2013 20:31:59 -0800 (PST) User-agent: mu4e 0.9.9.6pre2; emacs 24.3.50.2 In-reply-to: <87eh57zx66.fsf@dhcp-193-97.nrt.redhat.com> X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.15 Precedence: list X-detected-operating-system: by eggs.gnu.org: GNU/Linux 3.x X-Received-From: 140.186.70.43 X-BeenThere: bug-gnu-emacs@gnu.org List-Id: "Bug reports for GNU Emacs, the Swiss army knife of text editors" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane.org@gnu.org Original-Sender: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane.org@gnu.org Xref: news.gmane.org gmane.emacs.bugs:82565 Archived-At: diff --git a/lisp/net/eww.el b/lisp/net/eww.el index 02c93a0..80eba2f 100644 --- a/lisp/net/eww.el +++ b/lisp/net/eww.el @@ -91,6 +91,15 @@ See also `eww-form-checkbox-selected-symbol'." :version "24.4" :group 'eww) +(defface eww-form-file + '((((type x w32 ns) (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 + :type "Browse") + (defface eww-form-checkbox '((((type x w32 ns) (class color)) ; Like default mode line :box (:line-width 2 :style released-button) @@ -568,6 +577,12 @@ appears in a or tag." (define-key map [(control c) (control c)] 'eww-submit) map)) +(defvar eww-submit-file + (let ((map (make-sparse-keymap))) + (define-key map "\r" 'eww-select-file) + (define-key map [(control c) (control c)] 'eww-submit) + map)) + (defvar eww-checkbox-map (let ((map (make-sparse-keymap))) (define-key map " " 'eww-toggle-checkbox) @@ -678,6 +693,34 @@ appears in a or tag." (put-text-property start (point) 'keymap eww-checkbox-map) (insert " "))) +(defun eww-form-file (cont) + (let ((start (point)) + (value (cdr (assq :value cont)))) + (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 (cdr (assq :value cont)) ;; value を interactive に + :type (downcase (cdr (assq :type cont))) + :name (cdr (assq :name cont)))) + (put-text-property start (point) 'keymap eww-submit-file) + (insert " "))) + +(defun eww-select-file () + "Change the value of the upload file menu under point." + (interactive) + (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 (cont) (let ((start (point)) (type (downcase (or (cdr (assq :type cont)) @@ -794,6 +837,8 @@ See URL `https://developer.mozilla.org/en-US/docs/Web/HTML/Element/Input'.") ((or (equal type "checkbox") (equal type "radio")) (eww-form-checkbox cont)) + ((equal type "file") + (eww-form-file cont)) ((equal type "submit") (eww-form-submit cont)) ((equal type "hidden") @@ -886,14 +931,17 @@ See URL `https://developer.mozilla.org/en-US/docs/Web/HTML/Element/Input'.") (goto-char (eww-update-field display)))) -(defun eww-update-field (string) +(defun eww-update-field (string &optional offset) + (if (not offset) (setq offset 0)) (let ((properties (text-properties-at (point))) - (start (eww-beginning-of-field)) - (end (1+ (eww-end-of-field)))) - (delete-region start end) + (start (+ (eww-beginning-of-field) offset)) + (current-end (1+ (eww-end-of-field))) + (new-end (1+ (+ (eww-beginning-of-field) (length string))))) + (delete-region start current-end) + (forward-char offset) (insert string - (make-string (- (- end start) (length string)) ? )) - (set-text-properties start end properties) + (make-string (- (- (+ new-end offset) start) (length string)) ? )) + (if (= 0 offset) (set-text-properties start new-end properties)) start)) (defun eww-toggle-checkbox () @@ -961,8 +1009,8 @@ See URL `https://developer.mozilla.org/en-US/docs/Web/HTML/Element/Input'.") (form (plist-get this-input :eww-form)) values next-submit) (dolist (elem (sort (eww-inputs form) - (lambda (o1 o2) - (< (car o1) (car o2))))) + (lambda (o1 o2) + (< (car o1) (car o2))))) (let* ((input (cdr elem)) (input-start (car elem)) (name (plist-get input :name))) @@ -972,6 +1020,13 @@ See URL `https://developer.mozilla.org/en-US/docs/Web/HTML/Element/Input'.") (when (plist-get input :checked) (push (cons name (plist-get input :value)) values))) + ((equal (plist-get input :type) "file") + (push (cons "file" (list (cons "filedata" (with-temp-buffer (insert-file-contents + (plist-get input :filename)) + (buffer-string))) + (cons "name" (plist-get input :name)) + (cons "filename" (plist-get input :filename)))) + 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 @@ -994,12 +1049,26 @@ See URL `https://developer.mozilla.org/en-US/docs/Web/HTML/Element/Input'.") 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))) + (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)) + eww-current-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)) + eww-current-url)))))) (eww-browse-url (concat (if (cdr (assq :action form)) --- 1.8.3.1 --- [2/2] --- Regards, Kenjiro nakayamakenjiro@gmail.com writes: > Signed-off-by: Kenjiro NAKAYAMA > > diff --git a/lisp/net/eww.el b/lisp/net/eww.el > index bff5cd8..22a9023 100644 > --- a/lisp/net/eww.el > +++ b/lisp/net/eww.el > @@ -91,6 +91,15 @@ See also `eww-form-checkbox-selected-symbol'." > :version "24.4" > :group 'eww) > > +(defface eww-form-file > + '((((type x w32 ns) (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 > + :type "Browse") > + > (defface eww-form-checkbox > '((((type x w32 ns) (class color)) ; Like default mode line > :box (:line-width 2 :style released-button) > @@ -565,6 +574,12 @@ appears in a or tag." > (define-key map [(control c) (control c)] 'eww-submit) > map)) > > +(defvar eww-submit-file > + (let ((map (make-sparse-keymap))) > + (define-key map "\r" 'eww-select-file) > + (define-key map [(control c) (control c)] 'eww-submit) > + map)) > + > (defvar eww-checkbox-map > (let ((map (make-sparse-keymap))) > (define-key map [space] 'eww-toggle-checkbox) > @@ -675,6 +690,37 @@ appears in a or tag." > (put-text-property start (point) 'keymap eww-checkbox-map) > (insert " "))) > > +(defun eww-form-file (cont) > + (let ((start (point)) > + (value (cdr (assq :value cont))) > + ) > + (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 (cdr (assq :value cont)) > + :type (downcase (cdr (assq :type cont))) > + :name (cdr (assq :name cont)))) > + (put-text-property start (point) 'keymap eww-submit-file) > + (insert " "))) > + > +(defun eww-select-file () > + "Change the value of the upload file menu under point." > + (interactive) > + (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 (cont) > (let ((start (point)) > (type (downcase (or (cdr (assq :type cont)) > @@ -787,6 +833,8 @@ See URL `https://developer.mozilla.org/en-US/docs/Web/HTML/Element/Input'.") > ((or (equal type "checkbox") > (equal type "radio")) > (eww-form-checkbox cont)) > + ((equal type "file") > + (eww-form-file cont)) > ((equal type "submit") > (eww-form-submit cont)) > ((equal type "hidden") > @@ -845,6 +893,8 @@ See URL `https://developer.mozilla.org/en-US/docs/Web/HTML/Element/Input'.") > (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) > + (unless (= start (point)) > + (put-text-property start (1+ start) 'help-echo "select field")) > (shr-ensure-paragraph)))) > > (defun eww-select-display (select) > @@ -877,14 +927,18 @@ See URL `https://developer.mozilla.org/en-US/docs/Web/HTML/Element/Input'.") > (goto-char > (eww-update-field display)))) > > -(defun eww-update-field (string) > +(defun eww-update-field (string &optional offset) > + (if (not offset) (setq offset 0)) > (let ((properties (text-properties-at (point))) > - (start (eww-beginning-of-field)) > - (end (1+ (eww-end-of-field)))) > - (delete-region start end) > + (start (+ (eww-beginning-of-field) offset)) > + (current-end (1+ (eww-end-of-field))) > + (new-end (1+ (+ (eww-beginning-of-field) (length string))))) > + (delete-region start current-end) > + (forward-char offset) > (insert string > - (make-string (- (- end start) (length string)) ? )) > - (set-text-properties start end properties) > + (make-string (- (- (+ new-end offset) start) (length string)) ? )) > + > + (if (= 0 offset) (set-text-properties start new-end properties)) > start)) > > (defun eww-toggle-checkbox () > @@ -952,8 +1006,8 @@ See URL `https://developer.mozilla.org/en-US/docs/Web/HTML/Element/Input'.") > (form (plist-get this-input :eww-form)) > values next-submit) > (dolist (elem (sort (eww-inputs form) > - (lambda (o1 o2) > - (< (car o1) (car o2))))) > + (lambda (o1 o2) > + (< (car o1) (car o2))))) > (let* ((input (cdr elem)) > (input-start (car elem)) > (name (plist-get input :name))) > @@ -963,6 +1017,13 @@ See URL `https://developer.mozilla.org/en-US/docs/Web/HTML/Element/Input'.") > (when (plist-get input :checked) > (push (cons name (plist-get input :value)) > values))) > + ((equal (plist-get input :type) "file") > + (push (cons "file" (list (cons "filedata" (with-temp-buffer (insert-file-contents > + (plist-get input :filename)) > + (buffer-string))) > + (cons "name" (plist-get input :name)) > + (cons "filename" (plist-get input :filename)))) > + 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 > @@ -985,12 +1046,31 @@ See URL `https://developer.mozilla.org/en-US/docs/Web/HTML/Element/Input'.") > 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))) > + (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)) > + eww-current-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)) > + eww-current-url))) > + ))) > (eww-browse-url > (concat > (if (cdr (assq :action form))