Mercurial > emacs
comparison lisp/url/url-cid.el @ 54695:3fb37923e567
Initial revision
author | Stefan Monnier <monnier@iro.umontreal.ca> |
---|---|
date | Sun, 04 Apr 2004 01:21:46 +0000 |
parents | |
children | 7784ae10206d |
comparison
equal
deleted
inserted
replaced
54694:253149f265f2 | 54695:3fb37923e567 |
---|---|
1 ;;; url-cid.el --- Content-ID URL loader | |
2 ;; Author: $Author: fx $ | |
3 ;; Created: $Date: 2001/05/05 16:35:58 $ | |
4 ;; Version: $Revision: 1.3 $ | |
5 ;; Keywords: comm, data, processes | |
6 | |
7 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
8 ;;; Copyright (c) 1998 - 1999 Free Software Foundation, Inc. | |
9 ;;; | |
10 ;;; This file is part of GNU Emacs. | |
11 ;;; | |
12 ;;; GNU Emacs is free software; you can redistribute it and/or modify | |
13 ;;; it under the terms of the GNU General Public License as published by | |
14 ;;; the Free Software Foundation; either version 2, or (at your option) | |
15 ;;; any later version. | |
16 ;;; | |
17 ;;; GNU Emacs is distributed in the hope that it will be useful, | |
18 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
19 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
20 ;;; GNU General Public License for more details. | |
21 ;;; | |
22 ;;; You should have received a copy of the GNU General Public License | |
23 ;;; along with GNU Emacs; see the file COPYING. If not, write to the | |
24 ;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, | |
25 ;;; Boston, MA 02111-1307, USA. | |
26 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
27 | |
28 (require 'url-vars) | |
29 (require 'url-parse) | |
30 | |
31 (require 'mm-decode) | |
32 | |
33 (defun url-cid-gnus (cid) | |
34 (let ((content-type nil) | |
35 (encoding nil) | |
36 (part nil) | |
37 (data nil)) | |
38 (setq part (mm-get-content-id cid)) | |
39 (if (not part) | |
40 (message "Unknown CID encountered: %s" cid) | |
41 (setq data (save-excursion | |
42 (set-buffer (mm-handle-buffer part)) | |
43 (buffer-string)) | |
44 content-type (mm-handle-type part) | |
45 encoding (symbol-name (mm-handle-encoding part))) | |
46 (if (= 0 (length content-type)) (setq content-type "text/plain")) | |
47 (if (= 0 (length encoding)) (setq encoding "8bit")) | |
48 (if (listp content-type) | |
49 (setq content-type (car content-type))) | |
50 (insert (format "Content-type: %d\r\n" (length data)) | |
51 "Content-type: " content-type "\r\n" | |
52 "Content-transfer-encoding: " encoding "\r\n" | |
53 "\r\n" | |
54 (or data ""))))) | |
55 | |
56 ;;;###autoload | |
57 (defun url-cid (url) | |
58 (cond | |
59 ((fboundp 'mm-get-content-id) | |
60 ;; Using Pterodactyl Gnus or later | |
61 (save-excursion | |
62 (set-buffer (generate-new-buffer " *url-cid*")) | |
63 (url-cid-gnus (url-filename url)))) | |
64 (t | |
65 (message "Unable to handle CID URL: %s" url)))) |