Mercurial > hg > xemacs-beta

comparison lisp/url/url.el @ 2:ac2d302a0011 r19-15b2

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-15b2
author cvs
date Mon, 13 Aug 2007 08:46:35 +0200
parents 376386a54a3c
children
comparison
equal deleted inserted replaced
1:c0c6a60d29db 2:ac2d302a0011
84 (autoload 'url-file "url-file") 84 (autoload 'url-file "url-file")
85 (autoload 'url-ftp "url-file") 85 (autoload 'url-ftp "url-file")
86 (autoload 'url-gopher "url-gopher") 86 (autoload 'url-gopher "url-gopher")
87 (autoload 'url-irc "url-irc") 87 (autoload 'url-irc "url-irc")
88 (autoload 'url-http "url-http") 88 (autoload 'url-http "url-http")
89 (autoload 'url-nfs "url-nfs")
89 (autoload 'url-mailserver "url-mail") 90 (autoload 'url-mailserver "url-mail")
90 (autoload 'url-mailto "url-mail") 91 (autoload 'url-mailto "url-mail")
91 (autoload 'url-info "url-misc") 92 (autoload 'url-info "url-misc")
92 (autoload 'url-shttp "url-http") 93 (autoload 'url-shttp "url-http")
93 (autoload 'url-https "url-http") 94 (autoload 'url-https "url-http")
278 (/ (* x 100) y))) 279 (/ (* x 100) y)))
279 280
280 (defun url-after-change-function (&rest args) 281 (defun url-after-change-function (&rest args)
281 ;; The nitty gritty details of messaging the HTTP/1.0 status messages 282 ;; The nitty gritty details of messaging the HTTP/1.0 status messages
282 ;; in the minibuffer." 283 ;; in the minibuffer."
283 (save-excursion 284 (if (get-buffer url-working-buffer)
284 (set-buffer url-working-buffer) 285 (save-excursion
285 (let (status-message) 286 (set-buffer url-working-buffer)
286 (if url-current-content-length 287 (let (status-message)
287 nil 288 (if url-current-content-length
289 nil
290 (goto-char (point-min))
291 (skip-chars-forward " \t\n")
292 (if (not (looking-at "HTTP/[0-9]\.[0-9]"))
293 (setq url-current-content-length 0)
294 (setq url-current-isindex
295 (and (re-search-forward "$\r*$" nil t) (point)))
296 (if (re-search-forward
297 "^content-type:[ \t]*\\([^\r\n]+\\)\r*$"
298 url-current-isindex t)
299 (setq url-current-mime-type (downcase
300 (url-eat-trailing-space
301 (buffer-substring
302 (match-beginning 1)
303 (match-end 1))))))
304 (if (re-search-forward "^content-length:\\([^\r\n]+\\)\r*$"
305 url-current-isindex t)
306 (setq url-current-content-length
307 (string-to-int (buffer-substring (match-beginning 1)
308 (match-end 1))))
309 (setq url-current-content-length nil))))
310 (goto-char (point-min))
311 (if (re-search-forward "^status:\\([^\r]*\\)" url-current-isindex t)
312 (progn
313 (setq status-message (buffer-substring (match-beginning 1)
314 (match-end 1)))
315 (replace-match (concat "btatus:" status-message))))
316 (goto-char (point-max))
317 (cond
318 (status-message (url-lazy-message "%s" status-message))
319 ((and url-current-content-length (> url-current-content-length 1)
320 url-current-mime-type)
321 (url-lazy-message "Read %d of %d bytes (%d%%) [%s]"
322 (point-max) url-current-content-length
323 (url-percentage (point-max)
324 url-current-content-length)
325 url-current-mime-type))
326 ((and url-current-content-length (> url-current-content-length 1))
327 (url-lazy-message "Read %d of %d bytes (%d%%)"
328 (point-max) url-current-content-length
329 (url-percentage (point-max)
330 url-current-content-length)))
331 ((and (/= 1 (point-max)) url-current-mime-type)
332 (url-lazy-message "Read %d bytes. [%s]" (point-max)
333 url-current-mime-type))
334 ((/= 1 (point-max))
335 (url-lazy-message "Read %d bytes." (point-max)))
336 (t (url-lazy-message "Waiting for response.")))))))
337
338 (defun url-insert-entities-in-string (string)
339 "Convert HTML markup-start characters to entity references in STRING.
340 Also replaces the \" character, so that the result may be safely used as
341 an attribute value in a tag. Returns a new string with the result of the
342 conversion. Replaces these characters as follows:
343 & ==> &
344 < ==> &lt;
345 > ==> &gt;
346 \" ==> &quot;"
347 (if (string-match "[&<>\"]" string)
348 (save-excursion
349 (set-buffer (get-buffer-create " *entity*"))
350 (erase-buffer)
351 (buffer-disable-undo (current-buffer))
352 (insert string)
288 (goto-char (point-min)) 353 (goto-char (point-min))
289 (skip-chars-forward " \t\n") 354 (while (progn
290 (if (not (looking-at "HTTP/[0-9]\.[0-9]")) 355 (skip-chars-forward "^&<>\"")
291 (setq url-current-content-length 0) 356 (not (eobp)))
292 (setq url-current-isindex 357 (insert (cdr (assq (char-after (point))
293 (and (re-search-forward "$\r*$" nil t) (point))) 358 '((?\" . "&quot;")
294 (if (re-search-forward 359 (?& . "&amp;")
295 "^content-type:[ \t]*\\([^\r\n]+\\)\r*$" 360 (?< . "&lt;")
296 url-current-isindex t) 361 (?> . "&gt;")))))
297 (setq url-current-mime-type (downcase 362 (delete-char 1))
298 (url-eat-trailing-space 363 (buffer-string))
299 (buffer-substring 364 string))
300 (match-beginning 1)
301 (match-end 1))))))
302 (if (re-search-forward "^content-length:\\([^\r\n]+\\)\r*$"
303 url-current-isindex t)
304 (setq url-current-content-length
305 (string-to-int (buffer-substring (match-beginning 1)
306 (match-end 1))))
307 (setq url-current-content-length nil))))
308 (goto-char (point-min))
309 (if (re-search-forward "^status:\\([^\r]*\\)" url-current-isindex t)
310 (progn
311 (setq status-message (buffer-substring (match-beginning 1)
312 (match-end 1)))
313 (replace-match (concat "btatus:" status-message))))
314 (goto-char (point-max))
315 (cond
316 (status-message (url-lazy-message "%s" status-message))
317 ((and url-current-content-length (> url-current-content-length 1)
318 url-current-mime-type)
319 (url-lazy-message "Read %d of %d bytes (%d%%) [%s]"
320 (point-max) url-current-content-length
321 (url-percentage (point-max) url-current-content-length)
322 url-current-mime-type))
323 ((and url-current-content-length (> url-current-content-length 1))
324 (url-lazy-message "Read %d of %d bytes (%d%%)"
325 (point-max) url-current-content-length
326 (url-percentage (point-max)
327 url-current-content-length)))
328 ((and (/= 1 (point-max)) url-current-mime-type)
329 (url-lazy-message "Read %d bytes. [%s]" (point-max)
330 url-current-mime-type))
331 ((/= 1 (point-max))
332 (url-lazy-message "Read %d bytes." (point-max)))
333 (t (url-lazy-message "Waiting for response."))))))
334
335 365
336 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 366 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
337 ;;; Information information 367 ;;; Information information
338 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 368 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
339 (defvar url-process-lookup-table nil) 369 (defvar url-process-lookup-table nil)
560 accessible." 590 accessible."
561 nil) 591 nil)
562 592
563 (defun url-insert-file-contents (url &rest args) 593 (defun url-insert-file-contents (url &rest args)
564 "Insert the contents of the URL in this buffer." 594 "Insert the contents of the URL in this buffer."
595 (interactive "sURL: ")
565 (save-excursion 596 (save-excursion
566 (let ((old-asynch url-be-asynchronous)) 597 (let ((old-asynch url-be-asynchronous))
567 (setq-default url-be-asynchronous nil) 598 (setq-default url-be-asynchronous nil)
568 (url-retrieve url) 599 (url-retrieve url)
569 (setq-default url-be-asynchronous old-asynch))) 600 (setq-default url-be-asynchronous old-asynch)))
799 (progn 830 (progn
800 (if (featurep 'mule) 831 (if (featurep 'mule)
801 (save-excursion 832 (save-excursion
802 (set-buffer (get-buffer-create buffer)) 833 (set-buffer (get-buffer-create buffer))
803 (setq mc-flag nil) 834 (setq mc-flag nil)
804 (set-process-coding-system conn *noconv* *noconv*))) 835 (if (not url-running-xemacs)
836 (set-process-coding-system conn *noconv* *noconv*)
837 (set-process-input-coding-system conn 'noconv)
838 (set-process-output-coding-system conn 'noconv))))
805 conn) 839 conn)
806 (error "Unable to connect to %s:%s" host service)))) 840 (error "Unable to connect to %s:%s" host service))))
807 ((eq tmp-gateway-method 'program) 841 ((eq tmp-gateway-method 'program)
808 (let ((proc (start-process name buffer url-gateway-telnet-program host 842 (let ((proc (start-process name buffer url-gateway-telnet-program host
809 (int-to-string service))) 843 (int-to-string service)))
1469 (if (or (> char ?z) 1503 (if (or (> char ?z)
1470 (< char ?-) 1504 (< char ?-)
1471 (and (< char ?a) 1505 (and (< char ?a)
1472 (> char ?Z)) 1506 (> char ?Z))
1473 (and (< char ?@) 1507 (and (< char ?@)
1474 (> char ?:))) 1508 (>= char ?:)))
1475 (if (< char 16) 1509 (if (< char 16)
1476 (upcase (format "%%0%x" char)) 1510 (upcase (format "%%0%x" char))
1477 (upcase (format "%%%x" char))) 1511 (upcase (format "%%%x" char)))
1478 (char-to-string char)))) str ""))) 1512 (char-to-string char)))) str "")))
1479 1513
1541 (set-buffer url-working-buffer) 1575 (set-buffer url-working-buffer)
1542 (goto-char (point-min)) 1576 (goto-char (point-min))
1543 (url-replace-regexp "Connection closed by.*" "") 1577 (url-replace-regexp "Connection closed by.*" "")
1544 (goto-char (point-min)) 1578 (goto-char (point-min))
1545 (url-replace-regexp "Process WWW.*" "")) 1579 (url-replace-regexp "Process WWW.*" ""))
1580
1581 (defun url-remove-compressed-extensions (filename)
1582 (while (assoc (url-file-extension filename) url-uncompressor-alist)
1583 (setq filename (url-file-extension filename t)))
1584 filename)
1546 1585
1547 (defun url-uncompress () 1586 (defun url-uncompress ()
1548 "Do any necessary uncompression on `url-working-buffer'" 1587 "Do any necessary uncompression on `url-working-buffer'"
1549 (set-buffer url-working-buffer) 1588 (set-buffer url-working-buffer)
1550 (if (not url-inhibit-uncompression) 1589 (if (not url-inhibit-uncompression)
2199 (setq url-current-can-be-cached (not no-cache)) 2238 (setq url-current-can-be-cached (not no-cache))
2200 (set-buffer-modified-p nil))) 2239 (set-buffer-modified-p nil)))
2201 (let* ((urlobj (url-generic-parse-url url)) 2240 (let* ((urlobj (url-generic-parse-url url))
2202 (type (url-type urlobj)) 2241 (type (url-type urlobj))
2203 (url-using-proxy (and 2242 (url-using-proxy (and
2243 (url-host urlobj)
2204 (if (assoc "no_proxy" url-proxy-services) 2244 (if (assoc "no_proxy" url-proxy-services)
2205 (not (string-match 2245 (not (string-match
2206 (cdr 2246 (cdr
2207 (assoc "no_proxy" url-proxy-services)) 2247 (assoc "no_proxy" url-proxy-services))
2208 url)) 2248 (url-host urlobj)))
2209 t) 2249 t)
2210 (not
2211 (and
2212 (string-match "file:" url)
2213 (not (string-match "file://" url))))
2214 (cdr (assoc type url-proxy-services)))) 2250 (cdr (assoc type url-proxy-services))))
2215 (handler nil) 2251 (handler nil)
2216 (original-url url) 2252 (original-url url)
2217 (cached nil) 2253 (cached nil)
2218 (tmp url-current-file)) 2254 (tmp url-current-file))
2225 url-registered-protocols)))) 2261 url-registered-protocols))))
2226 url (if cached (url-create-cached-filename url) url)) 2262 url (if cached (url-create-cached-filename url) url))
2227 (save-excursion 2263 (save-excursion
2228 (set-buffer (get-buffer-create url-working-buffer)) 2264 (set-buffer (get-buffer-create url-working-buffer))
2229 (setq url-current-can-be-cached (not no-cache))) 2265 (setq url-current-can-be-cached (not no-cache)))
2230 (if url-be-asynchronous 2266 ; (if url-be-asynchronous
2231 (url-download-minor-mode t)) 2267 ; (url-download-minor-mode t))
2232 (if (and handler (fboundp handler)) 2268 (if (and handler (fboundp handler))
2233 (funcall handler url) 2269 (funcall handler url)
2234 (set-buffer (get-buffer-create url-working-buffer)) 2270 (set-buffer (get-buffer-create url-working-buffer))
2235 (setq url-current-file tmp) 2271 (setq url-current-file tmp)
2236 (erase-buffer) 2272 (erase-buffer)