diff options
| author | Stefan Monnier | 2006-04-26 20:37:58 +0000 |
|---|---|---|
| committer | Stefan Monnier | 2006-04-26 20:37:58 +0000 |
| commit | 89a1fe7748c558e1dcd3725a87dcd0228fcc42d6 (patch) | |
| tree | fbf4b30956605d44d3c2cbab5358bfe255bc29e4 | |
| parent | a42beb53d349849bbdb0e6b5b64e0ff0bd1e1c81 (diff) | |
| download | emacs-89a1fe7748c558e1dcd3725a87dcd0228fcc42d6.tar.gz emacs-89a1fe7748c558e1dcd3725a87dcd0228fcc42d6.zip | |
(url-insert): New function.
(url-insert-file-contents): Use it.
| -rw-r--r-- | lisp/url/url-handlers.el | 56 |
1 files changed, 35 insertions, 21 deletions
diff --git a/lisp/url/url-handlers.el b/lisp/url/url-handlers.el index 00fc415659e..6c6d85a1e03 100644 --- a/lisp/url/url-handlers.el +++ b/lisp/url/url-handlers.el | |||
| @@ -216,33 +216,47 @@ accessible." | |||
| 216 | (url-copy-file url filename) | 216 | (url-copy-file url filename) |
| 217 | filename)) | 217 | filename)) |
| 218 | 218 | ||
| 219 | (defun url-insert (buffer &optional beg end) | ||
| 220 | "Insert the body of a URL object. | ||
| 221 | BUFFER should be a complete URL buffer as returned by `url-retrieve'. | ||
| 222 | If the headers specify a coding-system, it is applied to the body before it is inserted. | ||
| 223 | Returns a list of the form (SIZE CHARSET), where SIZE is the size in bytes | ||
| 224 | of the inserted text and CHARSET is the charset that was specified in the header, | ||
| 225 | or nil if none was found. | ||
| 226 | BEG and END can be used to only insert a subpart of the body. | ||
| 227 | They count bytes from the beginning of the body." | ||
| 228 | (let* ((handle (with-current-buffer buffer (mm-dissect-buffer t))) | ||
| 229 | (data (with-current-buffer (mm-handle-buffer handle) | ||
| 230 | (if beg | ||
| 231 | (buffer-substring (+ (point-min) beg) | ||
| 232 | (if end (+ (point-min) end) (point-max))) | ||
| 233 | (buffer-string)))) | ||
| 234 | (charset (mail-content-type-get (mm-handle-type handle) | ||
| 235 | 'charset))) | ||
| 236 | (mm-destroy-parts handle) | ||
| 237 | (if charset | ||
| 238 | (insert (mm-decode-string data (mm-charset-to-coding-system charset))) | ||
| 239 | (insert data)) | ||
| 240 | (list (length data) charset))) | ||
| 241 | |||
| 219 | ;;;###autoload | 242 | ;;;###autoload |
| 220 | (defun url-insert-file-contents (url &optional visit beg end replace) | 243 | (defun url-insert-file-contents (url &optional visit beg end replace) |
| 221 | (let ((buffer (url-retrieve-synchronously url)) | 244 | (let ((buffer (url-retrieve-synchronously url))) |
| 222 | (handle nil) | ||
| 223 | (charset nil) | ||
| 224 | (data nil)) | ||
| 225 | (if (not buffer) | 245 | (if (not buffer) |
| 226 | (error "Opening input file: No such file or directory, %s" url)) | 246 | (error "Opening input file: No such file or directory, %s" url)) |
| 227 | (if visit (setq buffer-file-name url)) | 247 | (if visit (setq buffer-file-name url)) |
| 228 | (with-current-buffer buffer | ||
| 229 | (setq handle (mm-dissect-buffer t)) | ||
| 230 | (set-buffer (mm-handle-buffer handle)) | ||
| 231 | (setq data (if beg (buffer-substring beg end) | ||
| 232 | (buffer-string)))) | ||
| 233 | (kill-buffer buffer) | ||
| 234 | (mm-destroy-parts handle) | ||
| 235 | (if replace (delete-region (point-min) (point-max))) | ||
| 236 | (save-excursion | 248 | (save-excursion |
| 237 | (setq charset (mail-content-type-get (mm-handle-type handle) | 249 | (let* ((start (point)) |
| 238 | 'charset)) | 250 | (size-and-charset (url-insert buffer beg end))) |
| 239 | (let ((start (point))) | 251 | (kill-buffer buffer) |
| 240 | (if charset | 252 | (when replace |
| 241 | (insert (mm-decode-string data (mm-charset-to-coding-system charset))) | 253 | (delete-region (point-min) start) |
| 242 | (progn | 254 | (delete-region (point) (point-max))) |
| 243 | (insert data) | 255 | (unless (cadr size-and-charset) |
| 244 | (decode-coding-inserted-region start (point) url visit beg end replace))))) | 256 | ;; If the headers don't specify any particular charset, use the |
| 245 | (list url (length data)))) | 257 | ;; usual heuristic/rules that we apply to files. |
| 258 | (decode-coding-inserted-region start (point) url visit beg end replace)) | ||
| 259 | (list url (car size-and-charset)))))) | ||
| 246 | 260 | ||
| 247 | (defun url-file-name-completion (url directory) | 261 | (defun url-file-name-completion (url directory) |
| 248 | (error "Unimplemented")) | 262 | (error "Unimplemented")) |