diff options
Diffstat (limited to 'lisp/gnus/mm-url.el')
| -rw-r--r-- | lisp/gnus/mm-url.el | 108 |
1 files changed, 53 insertions, 55 deletions
diff --git a/lisp/gnus/mm-url.el b/lisp/gnus/mm-url.el index 2716a5bdc76..5c8f99b0483 100644 --- a/lisp/gnus/mm-url.el +++ b/lisp/gnus/mm-url.el @@ -45,7 +45,7 @@ (condition-case nil (require 'url) (error nil))) - "*If non-nil, use external grab program `mm-url-program'." + "If non-nil, use external grab program `mm-url-program'." :version "22.1" :type 'boolean :group 'mm-url) @@ -245,7 +245,7 @@ Likely values are `wget', `w3m', `lynx' and `curl'." ;; To be done ;; (shy . ????) ; soft hyphen ) - "*An assoc list of entity names and how to actually display them.") + "An assoc list of entity names and how to actually display them.") (defconst mm-url-unreserved-chars '( @@ -276,19 +276,10 @@ If `mm-url-use-external' is non-nil, use `mm-url-program'." (insert-file-contents (substring url (1- (match-end 0)))) (mm-url-insert-file-contents-external url)) (goto-char (point-min)) - (if (fboundp 'url-generic-parse-url) - (setq url-current-object - (url-generic-parse-url url))) + (setq url-current-object (url-generic-parse-url url)) (list url (buffer-size))) (mm-url-load-url) (let ((name buffer-file-name) - (url-request-extra-headers - ;; ISTM setting a Connection header was a workaround for - ;; older versions of url included with w3, but it does more - ;; harm than good with the one shipped with Emacs. --ansel - (if (not (and (boundp 'url-version) - (equal url-version "Emacs"))) - (list (cons "Connection" "Close")))) result) (setq result (url-insert-file-contents url)) (save-excursion @@ -296,10 +287,9 @@ If `mm-url-use-external' is non-nil, use `mm-url-program'." (while (re-search-forward "\r 1000\r ?" nil t) (replace-match ""))) (setq buffer-file-name name) - (if (and (fboundp 'url-generic-parse-url) - (listp result)) - (setq url-current-object (url-generic-parse-url - (car result)))) + (when (listp result) + (setq url-current-object + (url-generic-parse-url (car result)))) result))) ;;;###autoload @@ -364,7 +354,7 @@ If FOLLOW-REFRESH is non-nil, redirect refresh url in META." (string-to-number (substring entity 1))))) (setq c (or (cdr (assq c mm-extra-numeric-entities)) (mm-ucs-to-char c))) - (if (mm-char-or-char-int-p c) c ?#)) + (if (characterp c) c ?#)) (or (cdr (assq (intern entity) mm-url-html-entities)) ?#)))) @@ -399,10 +389,7 @@ spaces. Die Die Die." ((= char ? ) "+") ((memq char mm-url-unreserved-chars) (char-to-string char)) (t (upcase (format "%%%02x" char))))) - (mm-encode-coding-string chunk - (if (fboundp 'find-coding-systems-string) - (car (find-coding-systems-string chunk)) - buffer-file-coding-system)) + (encode-coding-string chunk (car (find-coding-systems-string chunk))) ""))) (defun mm-url-encode-www-form-urlencoded (pairs) @@ -415,43 +402,54 @@ spaces. Die Die Die." (autoload 'mml-compute-boundary "mml") -(defun mm-url-encode-multipart-form-data (pairs &optional boundary) - "Return PAIRS encoded in multipart/form-data." +(defun mm-url-encode-multipart-form-data (data &optional boundary) + "Return DATA encoded in multipart/form-data. +DATA is a list where the elements can have the following form: + (\"NAME\" . \"VALUE\") + (\"submit\") + (\"file\" . ((\"name\" . \"NAME\") + (\"filename\" . \"FILENAME\") + (\"content-type\" . \"CONTENT-TYPE\") + (\"filedata\" . \"FILEDATA\"))) +Lowercase strings above are literals and uppercase are not." ;; RFC1867 - ;; Get a good boundary + ;; 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")) + (with-temp-buffer + (set-buffer-multibyte nil) + (dolist (elem data) + (let ((name (car elem)) + (value (cdr elem))) + (insert "--" boundary "\r\n") + (cond + ((equal name "file") + (insert (format + "Content-Disposition: form-data; name=%S; filename=%S\r\n" + (or (cdr (assoc "name" value)) name) + (cdr (assoc "filename" value)))) + (insert "Content-Transfer-Encoding: binary\r\n") + (insert (format "Content-Type: %s\r\n\r\n" + (or (cdr (assoc "content-type" value)) + "text/plain"))) + (let ((filedata (cdr (assoc "filedata" value)))) + (cond + ((stringp filedata) + (insert filedata)) + ;; How can this possibly be useful? + ((integerp filedata) + (insert (number-to-string filedata)))))) + ((equal name "submit") + (insert + "Content-Disposition: form-data; name=\"submit\"\r\n\r\nSubmit\r\n")) + (t + (insert (format "Content-Disposition: form-data; name=%S\r\n\r\n" + name)) + (insert value))) + (unless (bolp) + (insert "\r\n")))) + (insert "--" boundary "--\r\n") + (buffer-string))) (defun mm-url-remove-markup () "Remove all HTML markup, leaving just plain text." |