[Emacs-diffs] trunk r118358: Allow uploading files from eww

[Lars Ingebrigtsen]

------------------------------------------------------------
revno: 118358
revision-id: address@hidden
parent: address@hidden
author: Kenjiro NAKAYAMA  <address@hidden>
committer: Lars Magne Ingebrigtsen <address@hidden>
branch nick: trunk
timestamp: Mon 2014-11-10 22:33:55 +0100
message:
  Allow uploading files from eww
  
  2014-11-10  Kenjiro NAKAYAMA  <address@hidden>
  
          * net/eww.el(eww-form-file(defface)): New defface of file upload form.
          (eww-submit-file): New key map of file upload.
          (eww-form-file): New file upload button and file name context.
          (eww-select-file): Select file and display selected file name.
          (eww-tag-input): Handle input tag of file type.
          (eww-update-field): Add point offset.
          (eww-submit): Add submit with multipart/form-data.
  
          * gnus/mm-url.el (mm-url-encode-multipart-form-data):
          Restore to handle "multipart/form-data" by eww.
modified:
  lisp/ChangeLog                 changelog-20091113204419-o5vbwnq5f7feedwu-1432
  lisp/gnus/ChangeLog            changelog-20091113204419-o5vbwnq5f7feedwu-1433
  lisp/gnus/mm-url.el            mmurl.el-20091113204419-o5vbwnq5f7feedwu-3257
  lisp/net/eww.el                eww.el-20130610114603-80ap3gwnw4x4m5ix-1

=== modified file 'lisp/ChangeLog'
--- a/lisp/ChangeLog    2014-11-10 21:18:11 +0000
+++ b/lisp/ChangeLog    2014-11-10 21:33:55 +0000
@@ -1,3 +1,13 @@
+2014-11-10  Kenjiro NAKAYAMA  <address@hidden>
+
+        * net/eww.el(eww-form-file(defface)): New defface of file upload form.
+        (eww-submit-file): New key map of file upload.
+        (eww-form-file): New file upload button and file name context.
+        (eww-select-file): Select file and display selected file name.
+        (eww-tag-input): Handle input tag of file type.
+        (eww-update-field): Add point offset.
+        (eww-submit): Add submit with multipart/form-data.
+
 2014-11-10  Lars Magne Ingebrigtsen  <address@hidden>
 
        * net/eww.el (eww-render, eww-display-html, eww-setup-buffer):

=== modified file 'lisp/gnus/ChangeLog'
--- a/lisp/gnus/ChangeLog       2014-11-09 00:48:34 +0000
+++ b/lisp/gnus/ChangeLog       2014-11-10 21:33:55 +0000
@@ -1,3 +1,8 @@
+2014-11-10  Kenjiro NAKAYAMA  <address@hidden>
+
+        * gnus/mm-url.el (mm-url-encode-multipart-form-data):
+        Restore to handle "multipart/form-data" by eww.
+
 2014-11-07  Tassilo Horn  <address@hidden>
 
        * gnus-start.el (gnus-activate-group): Fix typo reported by Tim

=== modified file 'lisp/gnus/mm-url.el'
--- a/lisp/gnus/mm-url.el       2014-03-23 23:13:36 +0000
+++ b/lisp/gnus/mm-url.el       2014-11-10 21:33:55 +0000
@@ -414,13 +414,51 @@
 
 (autoload 'mml-compute-boundary "mml")
 
+(defun mm-url-encode-multipart-form-data (pairs &optional boundary)
+  "Return PAIRS encoded in multipart/form-data."
+  ;; RFC1867
+  ;; Get a good boundary
+  (unless boundary
+    (setq boundary (mml-compute-boundary '())))
+  (concat
+   ;; Start with the boundary
+   "--" boundary "\r\n"
+   ;; Create name value pairs
+   (mapconcat
+    'identity
+    ;; Delete any returned items that are empty
+    (delq nil
+          (mapcar (lambda (data)
+                    (cond ((equal (car data) "file")
+                           ;; For each pair
+                           (format
+                            ;; Encode the name
+                            "Content-Disposition: form-data; name=%S; 
filename=%S\r\nContent-Type: text/plain; 
charset=utf-8\r\nContent-Transfer-Encoding: binary\r\n\r\n%s"
+                            (cdr (assoc "name" (cdr data))) (cdr (assoc 
"filename" (cdr data)))
+                            (cond ((stringp (cdr (assoc "filedata" (cdr 
data))))
+                                   (cdr (assoc "filedata" (cdr data))))
+                                  ((integerp (cdr (assoc "filedata" (cdr 
data))))
+                                   (number-to-string (cdr (assoc "filedata" 
(cdr data))))))))
+                          ((equal (car data) "submit")
+                           "Content-Disposition: form-data; 
name=\"submit\"\r\n\r\nSubmit\r\n")
+                          (t
+                           (format
+                            "Content-Disposition: 
form-data;name=%S\r\n\r\n%s\r\n"
+                            (car data) (concat (mm-url-form-encode-xwfu (cdr 
data)))
+                            ))))
+                  pairs))
+    ;; use the boundary as a separator
+    (concat "\r\n--" boundary "\r\n"))
+   ;; put a boundary at the end.
+   "--" boundary "--\r\n"))
+
 (defun mm-url-remove-markup ()
   "Remove all HTML markup, leaving just plain text."
   (goto-char (point-min))
   (while (search-forward "<!--" nil t)
     (delete-region (match-beginning 0)
-                  (or (search-forward "-->" nil t)
-                      (point-max))))
+                   (or (search-forward "-->" nil t)
+                       (point-max))))
   (goto-char (point-min))
   (while (re-search-forward "<[^>]+>" nil t)
     (replace-match "" t t)))

=== modified file 'lisp/net/eww.el'
--- a/lisp/net/eww.el   2014-11-10 21:18:11 +0000
+++ b/lisp/net/eww.el   2014-11-10 21:33:55 +0000
@@ -100,6 +100,15 @@
   :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)
@@ -653,6 +662,12 @@
     (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)
@@ -763,6 +778,34 @@
     (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))
@@ -879,6 +922,8 @@
      ((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")
@@ -971,14 +1016,17 @@
     (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 ()
@@ -1046,8 +1094,8 @@
         (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)))
@@ -1057,6 +1105,16 @@
            (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
@@ -1079,12 +1137,33 @@
              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))
-                                         (plist-get eww-data :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))
+                                     (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))