[bpt/emacs.git] / lisp / gnus / mm-url.el

;;; mm-url.el --- a wrapper of url functions/commands for Gnus

;; Copyright (C) 2001-2012  Free Software Foundation, Inc.

;; Author: Shenghuo Zhu <zsh@cs.rochester.edu>

;; This file is part of GNU Emacs.

;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.

;;; Commentary:

;; Some codes are stolen from w3 and url packages. Some are moved from
;; nnweb.

;; TODO: Support POST, cookie.

;;; Code:

(eval-when-compile (require 'cl))

(require 'mm-util)
(require 'gnus)

(defvar url-current-object)
(defvar url-package-name)
(defvar url-package-version)

(defgroup mm-url nil
  "A wrapper of url package and external url command for Gnus."
  :group 'gnus)

(defcustom mm-url-use-external (not
				(condition-case nil
				    (require 'url)
				  (error nil)))
  "*If non-nil, use external grab program `mm-url-program'."
  :version "22.1"
  :type 'boolean
  :group 'mm-url)

(defvar mm-url-predefined-programs
  '((wget "wget" "--user-agent=mm-url" "-q" "-O" "-")
    (w3m  "w3m" "-dump_source")
    (lynx "lynx" "-source")
    (curl "curl" "--silent" "--user-agent" "mm-url" "--location")))

(defcustom mm-url-program
  (cond
   ((executable-find "wget") 'wget)
   ((executable-find "w3m") 'w3m)
   ((executable-find "lynx") 'lynx)
   ((executable-find "curl") 'curl)
   (t "GET"))
  "The url grab program.
Likely values are `wget', `w3m', `lynx' and `curl'."
  :version "22.1"
  :type '(choice
	  (symbol :tag "wget" wget)
	  (symbol :tag "w3m" w3m)
	  (symbol :tag "lynx" lynx)
	  (symbol :tag "curl" curl)
	  (string :tag "other"))
  :group 'mm-url)

(defcustom mm-url-arguments nil
  "The arguments for `mm-url-program'."
  :version "22.1"
  :type '(repeat string)
  :group 'mm-url)

\f
;;; Internal variables

;; Stolen from w3.
(defvar mm-url-html-entities
  '(
    ;;(excl        .  33)
    (quot        .  34)
    ;;(num         .  35)
    ;;(dollar      .  36)
    ;;(percent     .  37)
    (amp         .  38)
    (rsquo       .  39)			; should be U+8217
    ;;(apos        .  39)
    ;;(lpar        .  40)
    ;;(rpar        .  41)
    ;;(ast         .  42)
    ;;(plus        .  43)
    ;;(comma       .  44)
    ;;(period      .  46)
    ;;(colon       .  58)
    ;;(semi        .  59)
    (lt          .  60)
    ;;(equals      .  61)
    (gt          .  62)
    ;;(quest       .  63)
    ;;(commat      .  64)
    ;;(lsqb        .  91)
    ;;(rsqb        .  93)
    (uarr        .  94)			; should be U+8593
    ;;(lowbar      .  95)
    (lsquo       .  96)			; should be U+8216
    (lcub        . 123)
    ;;(verbar      . 124)
    (rcub        . 125)
    (tilde       . 126)
    (nbsp        . 160)
    (iexcl       . 161)
    (cent        . 162)
    (pound       . 163)
    (curren      . 164)
    (yen         . 165)
    (brvbar      . 166)
    (sect        . 167)
    (uml         . 168)
    (copy        . 169)
    (ordf        . 170)
    (laquo       . 171)
    (not         . 172)
    (shy         . 173)
    (reg         . 174)
    (macr        . 175)
    (deg         . 176)
    (plusmn      . 177)
    (sup2        . 178)
    (sup3        . 179)
    (acute       . 180)
    (micro       . 181)
    (para        . 182)
    (middot      . 183)
    (cedil       . 184)
    (sup1        . 185)
    (ordm        . 186)
    (raquo       . 187)
    (frac14      . 188)
    (frac12      . 189)
    (frac34      . 190)
    (iquest      . 191)
    (Agrave      . 192)
    (Aacute      . 193)
    (Acirc       . 194)
    (Atilde      . 195)
    (Auml        . 196)
    (Aring       . 197)
    (AElig       . 198)
    (Ccedil      . 199)
    (Egrave      . 200)
    (Eacute      . 201)
    (Ecirc       . 202)
    (Euml        . 203)
    (Igrave      . 204)
    (Iacute      . 205)
    (Icirc       . 206)
    (Iuml        . 207)
    (ETH         . 208)
    (Ntilde      . 209)
    (Ograve      . 210)
    (Oacute      . 211)
    (Ocirc       . 212)
    (Otilde      . 213)
    (Ouml        . 214)
    (times       . 215)
    (Oslash      . 216)
    (Ugrave      . 217)
    (Uacute      . 218)
    (Ucirc       . 219)
    (Uuml        . 220)
    (Yacute      . 221)
    (THORN       . 222)
    (szlig       . 223)
    (agrave      . 224)
    (aacute      . 225)
    (acirc       . 226)
    (atilde      . 227)
    (auml        . 228)
    (aring       . 229)
    (aelig       . 230)
    (ccedil      . 231)
    (egrave      . 232)
    (eacute      . 233)
    (ecirc       . 234)
    (euml        . 235)
    (igrave      . 236)
    (iacute      . 237)
    (icirc       . 238)
    (iuml        . 239)
    (eth         . 240)
    (ntilde      . 241)
    (ograve      . 242)
    (oacute      . 243)
    (ocirc       . 244)
    (otilde      . 245)
    (ouml        . 246)
    (divide      . 247)
    (oslash      . 248)
    (ugrave      . 249)
    (uacute      . 250)
    (ucirc       . 251)
    (uuml        . 252)
    (yacute      . 253)
    (thorn       . 254)
    (yuml        . 255)

    ;; Special handling of these
    (frac56      . "5/6")
    (frac16      . "1/6")
    (frac45      . "4/5")
    (frac35      . "3/5")
    (frac25      . "2/5")
    (frac15      . "1/5")
    (frac23      . "2/3")
    (frac13      . "1/3")
    (frac78      . "7/8")
    (frac58      . "5/8")
    (frac38      . "3/8")
    (frac18      . "1/8")

    ;; The following 5 entities are not mentioned in the HTML 2.0
    ;; standard, nor in any other HTML proposed standard of which I
    ;; am aware.  I am not even sure they are ISO entity names.  ***
    ;; Hence, some arrangement should be made to give a bad HTML
    ;; message when they are seen.
    (ndash       .  45)
    (mdash       .  45)
    (emsp        .  32)
    (ensp        .  32)
    (sim         . 126)
    (le          . "<=")
    (agr         . "alpha")
    (rdquo       . "''")
    (ldquo       . "``")
    (trade       . "(TM)")
    ;; To be done
    ;; (shy      . ????) ; soft hyphen
    )
  "*An assoc list of entity names and how to actually display them.")

(defconst mm-url-unreserved-chars
  '(
    ?a ?b ?c ?d ?e ?f ?g ?h ?i ?j ?k ?l ?m ?n ?o ?p ?q ?r ?s ?t ?u ?v ?w ?x ?y ?z
    ?A ?B ?C ?D ?E ?F ?G ?H ?I ?J ?K ?L ?M ?N ?O ?P ?Q ?R ?S ?T ?U ?V ?W ?X ?Y ?Z
    ?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9
    ?- ?_ ?. ?! ?~ ?* ?' ?\( ?\))
  "A list of characters that are _NOT_ reserved in the URL spec.
This is taken from RFC 2396.")

(defun mm-url-load-url ()
  "Load `url-insert-file-contents'."
  (unless (condition-case ()
	      (progn
		(require 'url-handlers)
		(require 'url-parse)
		(require 'url-vars))
	    (error nil))
    ;; w3-4.0pre0.46 or earlier version.
    (require 'w3-vars)
    (require 'url)))

;;;###autoload
(defun mm-url-insert-file-contents (url)
  "Insert file contents of URL.
If `mm-url-use-external' is non-nil, use `mm-url-program'."
  (if mm-url-use-external
      (progn
	(if (string-match "^file:/+" url)
	    (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)))
	(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
	(goto-char (point-min))
	(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))))
      result)))

;;;###autoload
(defun mm-url-insert-file-contents-external (url)
  "Insert file contents of URL using `mm-url-program'."
  (let (program args)
    (if (symbolp mm-url-program)
	(let ((item (cdr (assq mm-url-program mm-url-predefined-programs))))
	  (setq program (car item)
		args (append (cdr item) (list url))))
      (setq program mm-url-program
	    args (append mm-url-arguments (list url))))
    (unless (eq 0 (apply 'call-process program nil t nil args))
      (error "Couldn't fetch %s" url))))

(defvar mm-url-timeout 30
  "The number of seconds before timing out an URL fetch.")

(defvar mm-url-retries 10
  "The number of retries after timing out when fetching an URL.")

(defun mm-url-insert (url &optional follow-refresh)
  "Insert the contents from an URL in the current buffer.
If FOLLOW-REFRESH is non-nil, redirect refresh url in META."
  (let ((times mm-url-retries)
	(done nil)
	(first t)
	result)
    (while (and (not (zerop (decf times)))
		(not done))
      (with-timeout (mm-url-timeout)
	(unless first
	  (message "Trying again (%s)..." (- mm-url-retries times)))
	(setq first nil)
	(if follow-refresh
	    (save-restriction
	      (narrow-to-region (point) (point))
	      (mm-url-insert-file-contents url)
	      (goto-char (point-min))
	      (when (re-search-forward
		     "<meta[ \t\r\n]*http-equiv=\"Refresh\"[^>]*URL=\\([^\"]+\\)\"" nil t)
		(let ((url (match-string 1)))
		  (delete-region (point-min) (point-max))
		  (setq result (mm-url-insert url t)))))
	  (setq result (mm-url-insert-file-contents url)))
	(setq done t)))
    result))

(defun mm-url-decode-entities ()
  "Decode all HTML entities."
  (goto-char (point-min))
  (while (re-search-forward "&\\(#[0-9]+\\|#x[0-9a-f]+\\|[a-z]+[0-9]*\\);"
			    nil t)
    (let* ((entity (match-string 1))
	   (elem (if (eq (aref entity 0) ?\#)
		     (let ((c
			    ;; Hex number: &#x3212
			    (if (eq (aref entity 1) ?x)
				(string-to-number (substring entity 2)
						  16)
			      ;; Decimal number: &#23
			      (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 ?#))
		   (or (cdr (assq (intern entity)
				  mm-url-html-entities))
		       ?#))))
      (unless (stringp elem)
	(setq elem (char-to-string elem)))
      (replace-match elem t t))))

(defun mm-url-decode-entities-nbsp ()
  "Decode all HTML entities and &nbsp; to a space."
  (let ((mm-url-html-entities (cons '(nbsp . 32) mm-url-html-entities)))
    (mm-url-decode-entities)))

(defun mm-url-decode-entities-string (string)
  (with-temp-buffer
    (insert string)
    (mm-url-decode-entities)
    (buffer-string)))

(defun mm-url-form-encode-xwfu (chunk)
  "Escape characters in a string for application/x-www-form-urlencoded.
Blasphemous crap because someone didn't think %20 was good enough for encoding
spaces.  Die Die Die."
  ;; This will get rid of the 'attributes' specified by the file type,
  ;; which are useless for an application/x-www-form-urlencoded form.
  (if (consp chunk)
      (setq chunk (cdr chunk)))

  (mapconcat
   (lambda (char)
     (cond
      ((= 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))
   ""))

(defun mm-url-encode-www-form-urlencoded (pairs)
  "Return PAIRS encoded for forms."
  (mapconcat
   (lambda (data)
     (concat (mm-url-form-encode-xwfu (car data)) "="
	     (mm-url-form-encode-xwfu (cdr data))))
   pairs "&"))

(autoload 'mml-compute-boundary "mml")

(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))))
  (goto-char (point-min))
  (while (re-search-forward "<[^>]+>" nil t)
    (replace-match "" t t)))

(provide 'mm-url)

;;; mm-url.el ends here
Commit	Line	Data
23f87bed	1	;;; mm-url.el --- a wrapper of url functions/commands for Gnus
e84b4b86	2
acaf905b	3	;; Copyright (C) 2001-2012 Free Software Foundation, Inc.
23f87bed MB	4
	5	;; Author: Shenghuo Zhu <zsh@cs.rochester.edu>
	6
	7	;; This file is part of GNU Emacs.
	8
5e809f55 GM	9	;; GNU Emacs is free software: you can redistribute it and/or modify
	10	;; it under the terms of the GNU General Public License as published by
	11	;; the Free Software Foundation, either version 3 of the License, or
	12	;; (at your option) any later version.
23f87bed	13
5e809f55 GM	14	;; GNU Emacs is distributed in the hope that it will be useful,
	15	;; but WITHOUT ANY WARRANTY; without even the implied warranty of
	16	;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
	17	;; GNU General Public License for more details.
23f87bed MB	18
23f87bed MB	19	;; You should have received a copy of the GNU General Public License
5e809f55	20	;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
23f87bed MB	21
	22	;;; Commentary:
	23
	24	;; Some codes are stolen from w3 and url packages. Some are moved from
	25	;; nnweb.
	26
	27	;; TODO: Support POST, cookie.
	28
	29	;;; Code:
	30
	31	(eval-when-compile (require 'cl))
	32
	33	(require 'mm-util)
	34	(require 'gnus)
	35
8d892d7f JB	36	(defvar url-current-object)
	37	(defvar url-package-name)
	38	(defvar url-package-version)
	39
23f87bed MB	40	(defgroup mm-url nil
	41	"A wrapper of url package and external url command for Gnus."
	42	:group 'gnus)
	43
	44	(defcustom mm-url-use-external (not
	45	(condition-case nil
	46	(require 'url)
	47	(error nil)))
	48	"*If non-nil, use external grab program `mm-url-program'."
bf247b6e	49	:version "22.1"
23f87bed MB	50	:type 'boolean
	51	:group 'mm-url)
	52
	53	(defvar mm-url-predefined-programs
	54	'((wget "wget" "--user-agent=mm-url" "-q" "-O" "-")
	55	(w3m "w3m" "-dump_source")
	56	(lynx "lynx" "-source")
3aa84d30	57	(curl "curl" "--silent" "--user-agent" "mm-url" "--location")))
23f87bed MB	58
	59	(defcustom mm-url-program
	60	(cond
	61	((executable-find "wget") 'wget)
	62	((executable-find "w3m") 'w3m)
	63	((executable-find "lynx") 'lynx)
	64	((executable-find "curl") 'curl)
	65	(t "GET"))
	66	"The url grab program.
	67	Likely values are `wget', `w3m', `lynx' and `curl'."
bf247b6e	68	:version "22.1"
23f87bed MB	69	:type '(choice
	70	(symbol :tag "wget" wget)
	71	(symbol :tag "w3m" w3m)
	72	(symbol :tag "lynx" lynx)
	73	(symbol :tag "curl" curl)
	74	(string :tag "other"))
	75	:group 'mm-url)
	76
	77	(defcustom mm-url-arguments nil
	78	"The arguments for `mm-url-program'."
bf247b6e	79	:version "22.1"
23f87bed MB	80	:type '(repeat string)
	81	:group 'mm-url)
	82
	83	\f
	84	;;; Internal variables
	85
23f87bed MB	86	;; Stolen from w3.
	87	(defvar mm-url-html-entities
	88	'(
	89	;;(excl . 33)
	90	(quot . 34)
	91	;;(num . 35)
	92	;;(dollar . 36)
	93	;;(percent . 37)
	94	(amp . 38)
	95	(rsquo . 39) ; should be U+8217
	96	;;(apos . 39)
	97	;;(lpar . 40)
	98	;;(rpar . 41)
	99	;;(ast . 42)
	100	;;(plus . 43)
	101	;;(comma . 44)
	102	;;(period . 46)
	103	;;(colon . 58)
	104	;;(semi . 59)
	105	(lt . 60)
	106	;;(equals . 61)
	107	(gt . 62)
	108	;;(quest . 63)
	109	;;(commat . 64)
	110	;;(lsqb . 91)
	111	;;(rsqb . 93)
	112	(uarr . 94) ; should be U+8593
	113	;;(lowbar . 95)
	114	(lsquo . 96) ; should be U+8216
	115	(lcub . 123)
	116	;;(verbar . 124)
	117	(rcub . 125)
	118	(tilde . 126)
	119	(nbsp . 160)
	120	(iexcl . 161)
	121	(cent . 162)
	122	(pound . 163)
	123	(curren . 164)
	124	(yen . 165)
	125	(brvbar . 166)
	126	(sect . 167)
	127	(uml . 168)
	128	(copy . 169)
	129	(ordf . 170)
	130	(laquo . 171)
	131	(not . 172)
	132	(shy . 173)
	133	(reg . 174)
	134	(macr . 175)
	135	(deg . 176)
	136	(plusmn . 177)
	137	(sup2 . 178)
	138	(sup3 . 179)
	139	(acute . 180)
	140	(micro . 181)
	141	(para . 182)
	142	(middot . 183)
	143	(cedil . 184)
	144	(sup1 . 185)
	145	(ordm . 186)
	146	(raquo . 187)
	147	(frac14 . 188)
	148	(frac12 . 189)
	149	(frac34 . 190)
150	(iquest . 191)
151	(Agrave . 192)
152	(Aacute . 193)
153	(Acirc . 194)
154	(Atilde . 195)
155	(Auml . 196)
156	(Aring . 197)
157	(AElig . 198)
158	(Ccedil . 199)
159	(Egrave . 200)
160	(Eacute . 201)
161	(Ecirc . 202)
162	(Euml . 203)
163	(Igrave . 204)
164	(Iacute . 205)
165	(Icirc . 206)
166	(Iuml . 207)
167	(ETH . 208)
168	(Ntilde . 209)
169	(Ograve . 210)
170	(Oacute . 211)
171	(Ocirc . 212)
172	(Otilde . 213)
173	(Ouml . 214)
174	(times . 215)
175	(Oslash . 216)
176	(Ugrave . 217)
177	(Uacute . 218)
178	(Ucirc . 219)
179	(Uuml . 220)
180	(Yacute . 221)
181	(THORN . 222)
182	(szlig . 223)
183	(agrave . 224)
184	(aacute . 225)
185	(acirc . 226)
186	(atilde . 227)
187	(auml . 228)
188	(aring . 229)
189	(aelig . 230)
190	(ccedil . 231)
191	(egrave . 232)
192	(eacute . 233)
193	(ecirc . 234)
194	(euml . 235)
195	(igrave . 236)
196	(iacute . 237)
197	(icirc . 238)
198	(iuml . 239)
199	(eth . 240)
200	(ntilde . 241)
201	(ograve . 242)
202	(oacute . 243)
203	(ocirc . 244)
204	(otilde . 245)
205	(ouml . 246)
206	(divide . 247)
207	(oslash . 248)
208	(ugrave . 249)
209	(uacute . 250)
210	(ucirc . 251)
211	(uuml . 252)
212	(yacute . 253)
213	(thorn . 254)
214	(yuml . 255)
215
216	;; Special handling of these
217	(frac56 . "5/6")
218	(frac16 . "1/6")
219	(frac45 . "4/5")
220	(frac35 . "3/5")
221	(frac25 . "2/5")
222	(frac15 . "1/5")
223	(frac23 . "2/3")
224	(frac13 . "1/3")
225	(frac78 . "7/8")
226	(frac58 . "5/8")
227	(frac38 . "3/8")
228	(frac18 . "1/8")
229
230	;; The following 5 entities are not mentioned in the HTML 2.0
231	;; standard, nor in any other HTML proposed standard of which I
232	;; am aware. I am not even sure they are ISO entity names. ***
233	;; Hence, some arrangement should be made to give a bad HTML
234	;; message when they are seen.
235	(ndash . 45)
236	(mdash . 45)
237	(emsp . 32)
238	(ensp . 32)
239	(sim . 126)
240	(le . "<=")
241	(agr . "alpha")
242	(rdquo . "''")
243	(ldquo . "``")
244	(trade . "(TM)")
245	;; To be done
246	;; (shy . ????) ; soft hyphen
247	)
248	"*An assoc list of entity names and how to actually display them.")
249
250	(defconst mm-url-unreserved-chars
251	'(
252	?a ?b ?c ?d ?e ?f ?g ?h ?i ?j ?k ?l ?m ?n ?o ?p ?q ?r ?s ?t ?u ?v ?w ?x ?y ?z
253	?A ?B ?C ?D ?E ?F ?G ?H ?I ?J ?K ?L ?M ?N ?O ?P ?Q ?R ?S ?T ?U ?V ?W ?X ?Y ?Z
254	?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9
255	?- ?_ ?. ?! ?~ ?* ?' ?\( ?\))
256	"A list of characters that are _NOT_ reserved in the URL spec.
257	This is taken from RFC 2396.")
258
259	(defun mm-url-load-url ()
260	"Load `url-insert-file-contents'."
261	(unless (condition-case ()
e2328c7a RS	262	(progn
	263	(require 'url-handlers)
	264	(require 'url-parse)
	265	(require 'url-vars))
23f87bed MB	266	(error nil))
	267	;; w3-4.0pre0.46 or earlier version.
	268	(require 'w3-vars)
	269	(require 'url)))
	270
	271	;;;###autoload
	272	(defun mm-url-insert-file-contents (url)
	273	"Insert file contents of URL.
	274	If `mm-url-use-external' is non-nil, use `mm-url-program'."
	275	(if mm-url-use-external
	276	(progn
	277	(if (string-match "^file:/+" url)
	278	(insert-file-contents (substring url (1- (match-end 0))))
	279	(mm-url-insert-file-contents-external url))
	280	(goto-char (point-min))
	281	(if (fboundp 'url-generic-parse-url)
	282	(setq url-current-object
	283	(url-generic-parse-url url)))
	284	(list url (buffer-size)))
	285	(mm-url-load-url)
	286	(let ((name buffer-file-name)
bd876f90 MB	287	(url-request-extra-headers
	288	;; ISTM setting a Connection header was a workaround for
	289	;; older versions of url included with w3, but it does more
	290	;; harm than good with the one shipped with Emacs. --ansel
	291	(if (not (and (boundp 'url-version)
	292	(equal url-version "Emacs")))
	293	(list (cons "Connection" "Close"))))
23f87bed MB	294	result)
	295	(setq result (url-insert-file-contents url))
	296	(save-excursion
	297	(goto-char (point-min))
	298	(while (re-search-forward "\r 1000\r ?" nil t)
	299	(replace-match "")))
	300	(setq buffer-file-name name)
	301	(if (and (fboundp 'url-generic-parse-url)
	302	(listp result))
	303	(setq url-current-object (url-generic-parse-url
	304	(car result))))
	305	result)))
	306
	307	;;;###autoload
	308	(defun mm-url-insert-file-contents-external (url)
	309	"Insert file contents of URL using `mm-url-program'."
	310	(let (program args)
	311	(if (symbolp mm-url-program)
	312	(let ((item (cdr (assq mm-url-program mm-url-predefined-programs))))
	313	(setq program (car item)
	314	args (append (cdr item) (list url))))
	315	(setq program mm-url-program
	316	args (append mm-url-arguments (list url))))
	317	(unless (eq 0 (apply 'call-process program nil t nil args))
	318	(error "Couldn't fetch %s" url))))
	319
	320	(defvar mm-url-timeout 30
	321	"The number of seconds before timing out an URL fetch.")
	322
	323	(defvar mm-url-retries 10
	324	"The number of retries after timing out when fetching an URL.")
	325
	326	(defun mm-url-insert (url &optional follow-refresh)
	327	"Insert the contents from an URL in the current buffer.
	328	If FOLLOW-REFRESH is non-nil, redirect refresh url in META."
	329	(let ((times mm-url-retries)
	330	(done nil)
	331	(first t)
	332	result)
	333	(while (and (not (zerop (decf times)))
	334	(not done))
	335	(with-timeout (mm-url-timeout)
	336	(unless first
	337	(message "Trying again (%s)..." (- mm-url-retries times)))
	338	(setq first nil)
	339	(if follow-refresh
	340	(save-restriction
	341	(narrow-to-region (point) (point))
	342	(mm-url-insert-file-contents url)
	343	(goto-char (point-min))
	344	(when (re-search-forward
	345	"<meta[ \t\r\n]http-equiv=\"Refresh\"[^>]URL=\\([^\"]+\\)\"" nil t)
	346	(let ((url (match-string 1)))
	347	(delete-region (point-min) (point-max))
	348	(setq result (mm-url-insert url t)))))
	349	(setq result (mm-url-insert-file-contents url)))
	350	(setq done t)))
	351	result))
	352
	353	(defun mm-url-decode-entities ()
	354	"Decode all HTML entities."
	355	(goto-char (point-min))
c912b478 KY	356	(while (re-search-forward "&\\(#[0-9]+\\\|#x[0-9a-f]+\\\|[a-z]+[0-9]*\\);"
c912b478 KY	357	nil t)
8bff7c00 KY	358	(let* ((entity (match-string 1))
8bff7c00 KY	359	(elem (if (eq (aref entity 0) ?\#)
c912b478 KY	360	(let ((c
	361	;; Hex number: &#x3212
	362	(if (eq (aref entity 1) ?x)
	363	(string-to-number (substring entity 2)
	364	16)
	365	;; Decimal number: &#23
	366	(string-to-number (substring entity 1)))))
	367	(setq c (or (cdr (assq c mm-extra-numeric-entities))
	368	(mm-ucs-to-char c)))
8bff7c00 KY	369	(if (mm-char-or-char-int-p c) c ?#))
	370	(or (cdr (assq (intern entity)
	371	mm-url-html-entities))
	372	?#))))
23f87bed MB	373	(unless (stringp elem)
	374	(setq elem (char-to-string elem)))
	375	(replace-match elem t t))))
	376
	377	(defun mm-url-decode-entities-nbsp ()
	378	"Decode all HTML entities and   to a space."
	379	(let ((mm-url-html-entities (cons '(nbsp . 32) mm-url-html-entities)))
	380	(mm-url-decode-entities)))
	381
	382	(defun mm-url-decode-entities-string (string)
	383	(with-temp-buffer
	384	(insert string)
	385	(mm-url-decode-entities)
	386	(buffer-string)))
	387
	388	(defun mm-url-form-encode-xwfu (chunk)
	389	"Escape characters in a string for application/x-www-form-urlencoded.
	390	Blasphemous crap because someone didn't think %20 was good enough for encoding
	391	spaces. Die Die Die."
	392	;; This will get rid of the 'attributes' specified by the file type,
	393	;; which are useless for an application/x-www-form-urlencoded form.
	394	(if (consp chunk)
	395	(setq chunk (cdr chunk)))
	396
	397	(mapconcat
	398	(lambda (char)
	399	(cond
	400	((= char ? ) "+")
	401	((memq char mm-url-unreserved-chars) (char-to-string char))
	402	(t (upcase (format "%%%02x" char)))))
765d4319 KY	403	(mm-encode-coding-string chunk
	404	(if (fboundp 'find-coding-systems-string)
	405	(car (find-coding-systems-string chunk))
	406	buffer-file-coding-system))
23f87bed MB	407	""))
	408
	409	(defun mm-url-encode-www-form-urlencoded (pairs)
	410	"Return PAIRS encoded for forms."
	411	(mapconcat
	412	(lambda (data)
	413	(concat (mm-url-form-encode-xwfu (car data)) "="
	414	(mm-url-form-encode-xwfu (cdr data))))
	415	pairs "&"))
	416
8e7d4ca1 GM	417	(autoload 'mml-compute-boundary "mml")
8e7d4ca1 GM	418
23f87bed MB	419	(defun mm-url-remove-markup ()
	420	"Remove all HTML markup, leaving just plain text."
	421	(goto-char (point-min))
	422	(while (search-forward "<!--" nil t)
	423	(delete-region (match-beginning 0)
	424	(or (search-forward "-->" nil t)
	425	(point-max))))
	426	(goto-char (point-min))
	427	(while (re-search-forward "<[^>]+>" nil t)
	428	(replace-match "" t t)))
	429
	430	(provide 'mm-url)
	431
23f87bed	432	;;; mm-url.el ends here