Mercurial > hg > xemacs-beta

comparison lisp/w3/url-file.el @ 20:859a2309aef8 r19-15b93

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-15b93
author cvs
date Mon, 13 Aug 2007 08:50:05 +0200
parents 0293115a14e9
children 8fc7fe29b841
comparison
equal deleted inserted replaced
19:ac1f612d5250 20:859a2309aef8
1 ;;; url-file.el --- File retrieval code 1 ;;; url-file.el --- File retrieval code
2 ;; Author: wmperry 2 ;; Author: wmperry
3 ;; Created: 1997/01/24 14:32:50 3 ;; Created: 1997/02/07 14:29:24
4 ;; Version: 1.9 4 ;; Version: 1.10
5 ;; Keywords: comm, data, processes 5 ;; Keywords: comm, data, processes
6 6
7 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 7 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
8 ;;; Copyright (c) 1993-1996 by William M. Perry (wmperry@cs.indiana.edu) 8 ;;; Copyright (c) 1993-1996 by William M. Perry (wmperry@cs.indiana.edu)
9 ;;; Copyright (c) 1996, 1997 Free Software Foundation, Inc. 9 ;;; Copyright (c) 1996, 1997 Free Software Foundation, Inc.
42 (jam-zcat-filename-list nil) 42 (jam-zcat-filename-list nil)
43 (file-coding-system-for-read mule-no-coding-system) 43 (file-coding-system-for-read mule-no-coding-system)
44 (coding-system-for-read mule-no-coding-system)) 44 (coding-system-for-read mule-no-coding-system))
45 (setq compressed 45 (setq compressed
46 (cond 46 (cond
47 ((file-exists-p fname) nil) 47 ((file-exists-p fname)
48 (if (string-match "\\.\\(z\\|gz\\|Z\\)$" fname)
49 (case (intern (match-string 1 fname))
50 ((z gz)
51 (setq url-current-mime-headers (cons
52 (cons
53 "content-transfer-encoding"
54 "gzip")
55 url-current-mime-headers)))
56 (Z
57 (setq url-current-mime-headers (cons
58 (cons
59 "content-transfer-encoding"
60 "compress")
61 url-current-mime-headers))))
62 nil))
48 ((file-exists-p (concat fname ".Z")) 63 ((file-exists-p (concat fname ".Z"))
49 (setq fname (concat fname ".Z"))) 64 (setq fname (concat fname ".Z")
65 url-current-mime-headers (cons (cons
66 "content-transfer-encoding"
67 "compress")
68 url-current-mime-headers)))
50 ((file-exists-p (concat fname ".gz")) 69 ((file-exists-p (concat fname ".gz"))
51 (setq fname (concat fname ".gz"))) 70 (setq fname (concat fname ".gz")
71 url-current-mime-headers (cons (cons
72 "content-transfer-encoding"
73 "gzip")
74 url-current-mime-headers)))
52 ((file-exists-p (concat fname ".z")) 75 ((file-exists-p (concat fname ".z"))
53 (setq fname (concat fname ".z"))) 76 (setq fname (concat fname ".z")
77 url-current-mime-headers (cons (cons
78 "content-transfer-encoding"
79 "gzip")
80 url-current-mime-headers)))
54 (t 81 (t
55 (error "File not found %s" fname)))) 82 (error "File not found %s" fname))))
56 (if (or (not compressed) url-inhibit-uncompression) 83 (apply 'insert-file-contents fname args)
57 (apply 'insert-file-contents fname args) 84 (set-buffer-modified-p nil)))
58 (let* ((extn (url-file-extension fname))
59 (code (cdr-safe (assoc extn url-uncompressor-alist)))
60 (decoder (cdr-safe (assoc code mm-content-transfer-encodings))))
61 (cond
62 ((null decoder)
63 (apply 'insert-file-contents fname args))
64 ((stringp decoder)
65 (apply 'insert-file-contents fname args)
66 (message "Decoding...")
67 (call-process-region (point-min) (point-max) decoder t t nil)
68 (message "Decoding... done."))
69 ((listp decoder)
70 (apply 'call-process-region (point-min) (point-max)
71 (car decoder) t t t (cdr decoder)))
72 ((and (symbolp decoder) (fboundp decoder))
73 (apply 'insert-file-contents fname args)
74 (message "Decoding...")
75 (funcall decoder (point-min) (point-max))
76 (message "Decoding... done."))
77 (t
78 (error "Malformed entry for %s in `mm-content-transfer-encodings'"
79 code))))))
80 (set-buffer-modified-p nil))
81 85
82 (defun url-format-directory (dir) 86 (defun url-format-directory (dir)
83 ;; Format the files in DIR into hypertext 87 ;; Format the files in DIR into hypertext
84 (let ((files (directory-files dir nil)) file 88 (let ((files (directory-files dir nil)) file
85 div attr mod-time size typ title) 89 div attr mod-time size typ title)