annotate lisp/gnus/mm-uu.el @ 36419:50998d3dd0bb

(lpr-page-header-switches, print-region-1): Undo 2000-07-06 change.
author Richard M. Stallman <rms@gnu.org>
date Tue, 27 Feb 2001 19:07:09 +0000
parents f04f551e94ce
children a26d9b55abb6
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
33120
5d37eed2a6e2 (mm-uu-decode-function, mm-uu-binhex-decode-function):
Dave Love <fx@gnu.org>
parents: 31717
diff changeset
1 ;;; mm-uu.el -- Return uu stuff as mm handles
31717
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2 ;; Copyright (c) 1998, 1999, 2000 Free Software Foundation, Inc.
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4 ;; Author: Shenghuo Zhu <zsh@cs.rochester.edu>
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5 ;; Keywords: postscript uudecode binhex shar forward news
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
6
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
7 ;; This file is part of GNU Emacs.
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
8
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
9 ;; GNU Emacs is free software; you can redistribute it and/or modify
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
10 ;; it under the terms of the GNU General Public License as published by
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
11 ;; the Free Software Foundation; either version 2, or (at your option)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
12 ;; any later version.
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
13 ;;
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
14 ;; GNU Emacs is distributed in the hope that it will be useful,
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
17 ;; GNU General Public License for more details.
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
18
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
19 ;; You should have received a copy of the GNU General Public License
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
20 ;; along with GNU Emacs; see the file COPYING. If not, write to the
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
21 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
22 ;; Boston, MA 02111-1307, USA.
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
23
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
24 ;;; Commentary:
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
25
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
26
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
27 ;;; Code:
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
28
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
29 (eval-when-compile (require 'cl))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
30 (require 'mail-parse)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
31 (require 'nnheader)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
32 (require 'mm-decode)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
33 (require 'mailcap)
33820
962073a4240a (uudecode): Require.
Dave Love <fx@gnu.org>
parents: 33265
diff changeset
34 (require 'uudecode)
34752
f04f551e94ce * message.el (message-narrow-to-head-1): New function.
ShengHuo ZHU <zsh@cs.rochester.edu>
parents: 33888
diff changeset
35 (require 'binhex)
31717
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
36
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
37 (defun mm-uu-copy-to-buffer (from to)
33820
962073a4240a (uudecode): Require.
Dave Love <fx@gnu.org>
parents: 33265
diff changeset
38 "Copy the contents of the current buffer to a fresh buffer.
962073a4240a (uudecode): Require.
Dave Love <fx@gnu.org>
parents: 33265
diff changeset
39 Return that buffer."
31717
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
40 (save-excursion
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
41 (let ((obuf (current-buffer)))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
42 (set-buffer (generate-new-buffer " *mm-uu*"))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
43 (insert-buffer-substring obuf from to)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
44 (current-buffer))))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
45
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
46 ;;; postscript
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
47
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
48 (defconst mm-uu-postscript-begin-line "^%!PS-")
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
49 (defconst mm-uu-postscript-end-line "^%%EOF$")
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
50
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
51 (defconst mm-uu-uu-begin-line "^begin[ \t]+[0-7][0-7][0-7][ \t]+")
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
52 (defconst mm-uu-uu-end-line "^end[ \t]*$")
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
53
33820
962073a4240a (uudecode): Require.
Dave Love <fx@gnu.org>
parents: 33265
diff changeset
54 ;; This is not the right place for this. uudecode.el should decide
962073a4240a (uudecode): Require.
Dave Love <fx@gnu.org>
parents: 33265
diff changeset
55 ;; whether or not to use a program with a single interface, but I
962073a4240a (uudecode): Require.
Dave Love <fx@gnu.org>
parents: 33265
diff changeset
56 ;; guess it's too late now. Also the default should depend on a test
962073a4240a (uudecode): Require.
Dave Love <fx@gnu.org>
parents: 33265
diff changeset
57 ;; for the program. -- fx
31717
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
58 (defcustom mm-uu-decode-function 'uudecode-decode-region
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
59 "*Function to uudecode.
33820
962073a4240a (uudecode): Require.
Dave Love <fx@gnu.org>
parents: 33265
diff changeset
60 Internal function is done in Lisp by default, therefore decoding may
962073a4240a (uudecode): Require.
Dave Love <fx@gnu.org>
parents: 33265
diff changeset
61 appear to be horribly slow. You can make Gnus use an external
31717
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
62 decoder, such as uudecode."
33820
962073a4240a (uudecode): Require.
Dave Love <fx@gnu.org>
parents: 33265
diff changeset
63 :type '(choice
962073a4240a (uudecode): Require.
Dave Love <fx@gnu.org>
parents: 33265
diff changeset
64 (function-item :tag "Internal" uudecode-decode-region)
962073a4240a (uudecode): Require.
Dave Love <fx@gnu.org>
parents: 33265
diff changeset
65 (function-item :tag "External" uudecode-decode-region-external))
33120
5d37eed2a6e2 (mm-uu-decode-function, mm-uu-binhex-decode-function):
Dave Love <fx@gnu.org>
parents: 31717
diff changeset
66 :group 'gnus-article-mime)
31717
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
67
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
68 (defconst mm-uu-binhex-begin-line
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
69 "^:...............................................................$")
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
70 (defconst mm-uu-binhex-end-line ":$")
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
71
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
72 (defcustom mm-uu-binhex-decode-function 'binhex-decode-region
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
73 "*Function to binhex decode.
33820
962073a4240a (uudecode): Require.
Dave Love <fx@gnu.org>
parents: 33265
diff changeset
74 Internal function is done in Lisp by default, therefore decoding may
962073a4240a (uudecode): Require.
Dave Love <fx@gnu.org>
parents: 33265
diff changeset
75 appear to be horribly slow. You can make Gnus use an external
31717
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
76 decoder, such as hexbin."
33820
962073a4240a (uudecode): Require.
Dave Love <fx@gnu.org>
parents: 33265
diff changeset
77 :type '(choice
962073a4240a (uudecode): Require.
Dave Love <fx@gnu.org>
parents: 33265
diff changeset
78 (function-item :tag "Internal" binhex-decode-region)
962073a4240a (uudecode): Require.
Dave Love <fx@gnu.org>
parents: 33265
diff changeset
79 (function-item :tag "External" binhex-decode-region-external))
33120
5d37eed2a6e2 (mm-uu-decode-function, mm-uu-binhex-decode-function):
Dave Love <fx@gnu.org>
parents: 31717
diff changeset
80 :group 'gnus-article-mime)
31717
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
81
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
82 (defconst mm-uu-shar-begin-line "^#! */bin/sh")
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
83 (defconst mm-uu-shar-end-line "^exit 0\\|^$")
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
84
33120
5d37eed2a6e2 (mm-uu-decode-function, mm-uu-binhex-decode-function):
Dave Love <fx@gnu.org>
parents: 31717
diff changeset
85 ;;; Thanks to Edward J. Sabol <sabol@alderaan.gsfc.nasa.gov> and
31717
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
86 ;;; Peter von der Ah\'e <pahe@daimi.au.dk>
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
87 (defconst mm-uu-forward-begin-line "^-+ \\(Start of \\)?Forwarded message")
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
88 (defconst mm-uu-forward-end-line "^-+ End \\(of \\)?forwarded message")
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
89
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
90 (defvar mm-uu-begin-line nil)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
91
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
92 (defconst mm-uu-identifier-alist
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
93 '((?% . postscript) (?b . uu) (?: . binhex) (?# . shar)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
94 (?- . forward)))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
95
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
96 (defvar mm-dissect-disposition "inline"
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
97 "The default disposition of uu parts.
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
98 This can be either \"inline\" or \"attachment\".")
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
99
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
100 (defun mm-uu-configure-p (key val)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
101 (member (cons key val) mm-uu-configure-list))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
102
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
103 (defun mm-uu-configure (&optional symbol value)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
104 (if symbol (set-default symbol value))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
105 (setq mm-uu-begin-line nil)
33265
191c9629d653 (mm-uu-configure): Unquote lambda.
Dave Love <fx@gnu.org>
parents: 33141
diff changeset
106 (mapcar (lambda (type)
191c9629d653 (mm-uu-configure): Unquote lambda.
Dave Love <fx@gnu.org>
parents: 33141
diff changeset
107 (if (mm-uu-configure-p type 'disabled)
191c9629d653 (mm-uu-configure): Unquote lambda.
Dave Love <fx@gnu.org>
parents: 33141
diff changeset
108 nil
191c9629d653 (mm-uu-configure): Unquote lambda.
Dave Love <fx@gnu.org>
parents: 33141
diff changeset
109 (setq mm-uu-begin-line
191c9629d653 (mm-uu-configure): Unquote lambda.
Dave Love <fx@gnu.org>
parents: 33141
diff changeset
110 (concat mm-uu-begin-line
191c9629d653 (mm-uu-configure): Unquote lambda.
Dave Love <fx@gnu.org>
parents: 33141
diff changeset
111 (if mm-uu-begin-line "\\|")
191c9629d653 (mm-uu-configure): Unquote lambda.
Dave Love <fx@gnu.org>
parents: 33141
diff changeset
112 (symbol-value
191c9629d653 (mm-uu-configure): Unquote lambda.
Dave Love <fx@gnu.org>
parents: 33141
diff changeset
113 (intern (concat "mm-uu-" (symbol-name type)
191c9629d653 (mm-uu-configure): Unquote lambda.
Dave Love <fx@gnu.org>
parents: 33141
diff changeset
114 "-begin-line")))))))
31717
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
115 '(uu postscript binhex shar forward)))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
116
33265
191c9629d653 (mm-uu-configure): Unquote lambda.
Dave Love <fx@gnu.org>
parents: 33141
diff changeset
117 ;; Needs to come after mm-uu-configure.
33141
66b0773e0877 (mm-uu-configure-list): Move back to old location,
Miles Bader <miles@gnu.org>
parents: 33120
diff changeset
118 (defcustom mm-uu-configure-list nil
33265
191c9629d653 (mm-uu-configure): Unquote lambda.
Dave Love <fx@gnu.org>
parents: 33141
diff changeset
119 "Alist of mm-uu configurations to disable.
33141
66b0773e0877 (mm-uu-configure-list): Move back to old location,
Miles Bader <miles@gnu.org>
parents: 33120
diff changeset
120 To disable dissecting shar codes, for instance, add
66b0773e0877 (mm-uu-configure-list): Move back to old location,
Miles Bader <miles@gnu.org>
parents: 33120
diff changeset
121 `(shar . disabled)' to this list."
66b0773e0877 (mm-uu-configure-list): Move back to old location,
Miles Bader <miles@gnu.org>
parents: 33120
diff changeset
122 :type '(repeat (choice (const :tag "postscript" (postscript . disabled))
66b0773e0877 (mm-uu-configure-list): Move back to old location,
Miles Bader <miles@gnu.org>
parents: 33120
diff changeset
123 (const :tag "uu" (uu . disabled))
33888
2c4faf64d4ca (mm-uu-configure-list): Fix typo in :type.
Dave Love <fx@gnu.org>
parents: 33820
diff changeset
124 (const :tag "binhex" (binhex . disabled))
33141
66b0773e0877 (mm-uu-configure-list): Move back to old location,
Miles Bader <miles@gnu.org>
parents: 33120
diff changeset
125 (const :tag "shar" (shar . disabled))
66b0773e0877 (mm-uu-configure-list): Move back to old location,
Miles Bader <miles@gnu.org>
parents: 33120
diff changeset
126 (const :tag "forward" (forward . disabled))))
66b0773e0877 (mm-uu-configure-list): Move back to old location,
Miles Bader <miles@gnu.org>
parents: 33120
diff changeset
127 :group 'gnus-article-mime
66b0773e0877 (mm-uu-configure-list): Move back to old location,
Miles Bader <miles@gnu.org>
parents: 33120
diff changeset
128 :set 'mm-uu-configure)
66b0773e0877 (mm-uu-configure-list): Move back to old location,
Miles Bader <miles@gnu.org>
parents: 33120
diff changeset
129
31717
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
130 (mm-uu-configure)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
131
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
132 ;;;### autoload
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
133
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
134 (defun mm-uu-dissect ()
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
135 "Dissect the current buffer and return a list of uu handles."
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
136 (let (text-start start-char end-char
33120
5d37eed2a6e2 (mm-uu-decode-function, mm-uu-binhex-decode-function):
Dave Love <fx@gnu.org>
parents: 31717
diff changeset
137 type file-name end-line result text-plain-type
31717
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
138 start-char-1 end-char-1
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
139 (case-fold-search t))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
140 (save-excursion
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
141 (save-restriction
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
142 (mail-narrow-to-head)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
143 (goto-char (point-max)))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
144 (forward-line)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
145 ;;; gnus-decoded is a fake charset, which means no further
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
146 ;;; decoding.
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
147 (setq text-start (point)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
148 text-plain-type '("text/plain" (charset . gnus-decoded)))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
149 (while (re-search-forward mm-uu-begin-line nil t)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
150 (setq start-char (match-beginning 0))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
151 (setq type (cdr (assq (aref (match-string 0) 0)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
152 mm-uu-identifier-alist)))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
153 (setq file-name
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
154 (if (and (eq type 'uu)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
155 (looking-at "\\(.+\\)$"))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
156 (and (match-string 1)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
157 (let ((nnheader-file-name-translation-alist
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
158 '((?/ . ?,) (? . ?_) (?* . ?_) (?$ . ?_))))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
159 (nnheader-translate-file-chars (match-string 1))))))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
160 (forward-line);; in case of failure
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
161 (setq start-char-1 (point))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
162 (setq end-line (symbol-value
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
163 (intern (concat "mm-uu-" (symbol-name type)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
164 "-end-line"))))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
165 (when (and (re-search-forward end-line nil t)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
166 (not (eq (match-beginning 0) (match-end 0))))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
167 (setq end-char-1 (match-beginning 0))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
168 (forward-line)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
169 (setq end-char (point))
33120
5d37eed2a6e2 (mm-uu-decode-function, mm-uu-binhex-decode-function):
Dave Love <fx@gnu.org>
parents: 31717
diff changeset
170 (when (cond
31717
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
171 ((eq type 'binhex)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
172 (setq file-name
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
173 (ignore-errors
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
174 (binhex-decode-region start-char end-char t))))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
175 ((eq type 'forward)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
176 (save-excursion
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
177 (goto-char start-char-1)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
178 (looking-at "[\r\n]*[a-zA-Z][a-zA-Z0-9-]*:")))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
179 (t t))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
180 (if (> start-char text-start)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
181 (push
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
182 (mm-make-handle (mm-uu-copy-to-buffer text-start start-char)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
183 text-plain-type)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
184 result))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
185 (push
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
186 (cond
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
187 ((eq type 'postscript)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
188 (mm-make-handle (mm-uu-copy-to-buffer start-char end-char)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
189 '("application/postscript")))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
190 ((eq type 'forward)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
191 (mm-make-handle (mm-uu-copy-to-buffer start-char-1 end-char-1)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
192 '("message/rfc822" (charset . gnus-decoded))))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
193 ((eq type 'uu)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
194 (mm-make-handle (mm-uu-copy-to-buffer start-char end-char)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
195 (list (or (and file-name
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
196 (string-match "\\.[^\\.]+$"
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
197 file-name)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
198 (mailcap-extension-to-mime
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
199 (match-string 0 file-name)))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
200 "application/octet-stream"))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
201 'x-uuencode nil
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
202 (if (and file-name (not (equal file-name "")))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
203 (list mm-dissect-disposition
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
204 (cons 'filename file-name)))))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
205 ((eq type 'binhex)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
206 (mm-make-handle (mm-uu-copy-to-buffer start-char end-char)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
207 (list (or (and file-name
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
208 (string-match "\\.[^\\.]+$" file-name)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
209 (mailcap-extension-to-mime
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
210 (match-string 0 file-name)))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
211 "application/octet-stream"))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
212 'x-binhex nil
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
213 (if (and file-name (not (equal file-name "")))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
214 (list mm-dissect-disposition
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
215 (cons 'filename file-name)))))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
216 ((eq type 'shar)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
217 (mm-make-handle (mm-uu-copy-to-buffer start-char end-char)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
218 '("application/x-shar"))))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
219 result)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
220 (setq text-start end-char))))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
221 (when result
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
222 (if (> (point-max) (1+ text-start))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
223 (push
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
224 (mm-make-handle (mm-uu-copy-to-buffer text-start (point-max))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
225 text-plain-type)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
226 result))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
227 (setq result (cons "multipart/mixed" (nreverse result))))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
228 result)))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
229
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
230 ;;;### autoload
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
231 (defun mm-uu-test ()
33120
5d37eed2a6e2 (mm-uu-decode-function, mm-uu-binhex-decode-function):
Dave Love <fx@gnu.org>
parents: 31717
diff changeset
232 "Check whether the current buffer contains uu stuff."
31717
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
233 (save-excursion
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
234 (goto-char (point-min))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
235 (let (type end-line result
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
236 (case-fold-search t))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
237 (while (and mm-uu-begin-line
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
238 (not result) (re-search-forward mm-uu-begin-line nil t))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
239 (forward-line)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
240 (setq type (cdr (assq (aref (match-string 0) 0)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
241 mm-uu-identifier-alist)))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
242 (setq end-line (symbol-value
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
243 (intern (concat "mm-uu-" (symbol-name type)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
244 "-end-line"))))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
245 (if (and (re-search-forward end-line nil t)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
246 (not (eq (match-beginning 0) (match-end 0))))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
247 (setq result t)))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
248 result)))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
249
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
250 (provide 'mm-uu)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
251
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
252 ;;; mm-uu.el ends here