Mercurial > emacs
annotate lisp/url/url-cid.el @ 98017:4f69bd0a8c9f
(pmail-dont-reply-to, pmail-desc-get-marker-end)
(pmail-desc-get-marker-start): Remove declarations of undefined functions.
(pmail-select-correspondent): Use rmail-dont-reply-to from mail-utils
rather than non-existent pmail-dont-reply-to.
author | Glenn Morris <rgm@gnu.org> |
---|---|
date | Sat, 06 Sep 2008 02:50:14 +0000 |
parents | 8259d0d8e107 |
children | a9dc0e7c3f2b |
rev | line source |
---|---|
54695 | 1 ;;; url-cid.el --- Content-ID URL loader |
57612 | 2 |
79720 | 3 ;; Copyright (C) 1998, 1999, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc. |
57612 | 4 |
54695 | 5 ;; Keywords: comm, data, processes |
6 | |
57612 | 7 ;; This file is part of GNU Emacs. |
8 | |
94668
8259d0d8e107
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
93975
diff
changeset
|
9 ;; GNU Emacs is free software: you can redistribute it and/or modify |
57612 | 10 ;; it under the terms of the GNU General Public License as published by |
94668
8259d0d8e107
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
93975
diff
changeset
|
11 ;; the Free Software Foundation, either version 3 of the License, or |
8259d0d8e107
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
93975
diff
changeset
|
12 ;; (at your option) any later version. |
57612 | 13 |
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. | |
18 | |
19 ;; You should have received a copy of the GNU General Public License | |
94668
8259d0d8e107
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
93975
diff
changeset
|
20 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
57612 | 21 |
22 ;;; Code: | |
54695 | 23 |
24 (require 'url-vars) | |
25 (require 'url-parse) | |
26 | |
27 (require 'mm-decode) | |
28 | |
29 (defun url-cid-gnus (cid) | |
30 (let ((content-type nil) | |
31 (encoding nil) | |
32 (part nil) | |
33 (data nil)) | |
34 (setq part (mm-get-content-id cid)) | |
35 (if (not part) | |
36 (message "Unknown CID encountered: %s" cid) | |
37 (setq data (save-excursion | |
38 (set-buffer (mm-handle-buffer part)) | |
39 (buffer-string)) | |
40 content-type (mm-handle-type part) | |
41 encoding (symbol-name (mm-handle-encoding part))) | |
42 (if (= 0 (length content-type)) (setq content-type "text/plain")) | |
43 (if (= 0 (length encoding)) (setq encoding "8bit")) | |
44 (if (listp content-type) | |
45 (setq content-type (car content-type))) | |
46 (insert (format "Content-type: %d\r\n" (length data)) | |
47 "Content-type: " content-type "\r\n" | |
48 "Content-transfer-encoding: " encoding "\r\n" | |
49 "\r\n" | |
50 (or data ""))))) | |
51 | |
52 ;;;###autoload | |
53 (defun url-cid (url) | |
54 (cond | |
55 ((fboundp 'mm-get-content-id) | |
56 ;; Using Pterodactyl Gnus or later | |
57 (save-excursion | |
58 (set-buffer (generate-new-buffer " *url-cid*")) | |
59 (url-cid-gnus (url-filename url)))) | |
60 (t | |
61 (message "Unable to handle CID URL: %s" url)))) | |
54699 | 62 |
93975
1e3a407766b9
Fix up comment convention on the arch-tag lines.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
79720
diff
changeset
|
63 ;; arch-tag: 23d9ab74-fad4-4dba-b1e7-292871e8bda5 |
57612 | 64 ;;; url-cid.el ends here |