annotate lisp/gnus/mm-uu.el @ 42866:03dd2df2b595

(Mode Line Format): Short windows can suppress the mode line and header line.
author Richard M. Stallman <rms@gnu.org>
date Sun, 20 Jan 2002 23:17:16 +0000
parents eafbae0b1100
children ee6f8dc4fe37
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
38413
a26d9b55abb6 Some fixes to follow coding conventions in files from Gnus.
Pavel Janík <Pavel@Janik.cz>
parents: 34752
diff changeset
1 ;;; mm-uu.el --- return uu stuff as mm handles
38727
eafbae0b1100 (mm-uu-dissect, mm-uu-test): Fix autoload cookies.
Gerd Moellmann <gerd@gnu.org>
parents: 38413
diff changeset
2 ;; Copyright (c) 1998, 1999, 2000, 2001 Free Software Foundation, Inc.
31717
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 ;;; Code:
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
27
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
28 (eval-when-compile (require 'cl))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
29 (require 'mail-parse)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
30 (require 'nnheader)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
31 (require 'mm-decode)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
32 (require 'mailcap)
33820
962073a4240a (uudecode): Require.
Dave Love <fx@gnu.org>
parents: 33265
diff changeset
33 (require 'uudecode)
34752
f04f551e94ce * message.el (message-narrow-to-head-1): New function.
ShengHuo ZHU <zsh@cs.rochester.edu>
parents: 33888
diff changeset
34 (require 'binhex)
31717
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
35
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
36 (defun mm-uu-copy-to-buffer (from to)
33820
962073a4240a (uudecode): Require.
Dave Love <fx@gnu.org>
parents: 33265
diff changeset
37 "Copy the contents of the current buffer to a fresh buffer.
962073a4240a (uudecode): Require.
Dave Love <fx@gnu.org>
parents: 33265
diff changeset
38 Return that buffer."
31717
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
39 (save-excursion
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
40 (let ((obuf (current-buffer)))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
41 (set-buffer (generate-new-buffer " *mm-uu*"))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
42 (insert-buffer-substring obuf from to)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
43 (current-buffer))))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
44
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
45 ;;; postscript
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
46
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
47 (defconst mm-uu-postscript-begin-line "^%!PS-")
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
48 (defconst mm-uu-postscript-end-line "^%%EOF$")
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
49
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
50 (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
51 (defconst mm-uu-uu-end-line "^end[ \t]*$")
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
52
33820
962073a4240a (uudecode): Require.
Dave Love <fx@gnu.org>
parents: 33265
diff changeset
53 ;; This is not the right place for this. uudecode.el should decide
962073a4240a (uudecode): Require.
Dave Love <fx@gnu.org>
parents: 33265
diff changeset
54 ;; 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
55 ;; 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
56 ;; for the program. -- fx
31717
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
57 (defcustom mm-uu-decode-function 'uudecode-decode-region
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
58 "*Function to uudecode.
33820
962073a4240a (uudecode): Require.
Dave Love <fx@gnu.org>
parents: 33265
diff changeset
59 Internal function is done in Lisp by default, therefore decoding may
962073a4240a (uudecode): Require.
Dave Love <fx@gnu.org>
parents: 33265
diff changeset
60 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
61 decoder, such as uudecode."
33820
962073a4240a (uudecode): Require.
Dave Love <fx@gnu.org>
parents: 33265
diff changeset
62 :type '(choice
962073a4240a (uudecode): Require.
Dave Love <fx@gnu.org>
parents: 33265
diff changeset
63 (function-item :tag "Internal" uudecode-decode-region)
962073a4240a (uudecode): Require.
Dave Love <fx@gnu.org>
parents: 33265
diff changeset
64 (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
65 :group 'gnus-article-mime)
31717
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
66
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
67 (defconst mm-uu-binhex-begin-line
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
68 "^:...............................................................$")
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
69 (defconst mm-uu-binhex-end-line ":$")
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
70
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
71 (defcustom mm-uu-binhex-decode-function 'binhex-decode-region
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
72 "*Function to binhex decode.
33820
962073a4240a (uudecode): Require.
Dave Love <fx@gnu.org>
parents: 33265
diff changeset
73 Internal function is done in Lisp by default, therefore decoding may
962073a4240a (uudecode): Require.
Dave Love <fx@gnu.org>
parents: 33265
diff changeset
74 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
75 decoder, such as hexbin."
33820
962073a4240a (uudecode): Require.
Dave Love <fx@gnu.org>
parents: 33265
diff changeset
76 :type '(choice
962073a4240a (uudecode): Require.
Dave Love <fx@gnu.org>
parents: 33265
diff changeset
77 (function-item :tag "Internal" binhex-decode-region)
962073a4240a (uudecode): Require.
Dave Love <fx@gnu.org>
parents: 33265
diff changeset
78 (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
79 :group 'gnus-article-mime)
31717
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
80
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
81 (defconst mm-uu-shar-begin-line "^#! */bin/sh")
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
82 (defconst mm-uu-shar-end-line "^exit 0\\|^$")
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
83
33120
5d37eed2a6e2 (mm-uu-decode-function, mm-uu-binhex-decode-function):
Dave Love <fx@gnu.org>
parents: 31717
diff changeset
84 ;;; Thanks to Edward J. Sabol <sabol@alderaan.gsfc.nasa.gov> and
31717
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
85 ;;; Peter von der Ah\'e <pahe@daimi.au.dk>
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
86 (defconst mm-uu-forward-begin-line "^-+ \\(Start of \\)?Forwarded message")
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
87 (defconst mm-uu-forward-end-line "^-+ End \\(of \\)?forwarded message")
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
88
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
89 (defvar mm-uu-begin-line nil)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
90
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
91 (defconst mm-uu-identifier-alist
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
92 '((?% . postscript) (?b . uu) (?: . binhex) (?# . shar)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
93 (?- . forward)))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
94
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
95 (defvar mm-dissect-disposition "inline"
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
96 "The default disposition of uu parts.
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
97 This can be either \"inline\" or \"attachment\".")
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
98
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
99 (defun mm-uu-configure-p (key val)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
100 (member (cons key val) mm-uu-configure-list))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
101
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
102 (defun mm-uu-configure (&optional symbol value)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
103 (if symbol (set-default symbol value))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
104 (setq mm-uu-begin-line nil)
33265
191c9629d653 (mm-uu-configure): Unquote lambda.
Dave Love <fx@gnu.org>
parents: 33141
diff changeset
105 (mapcar (lambda (type)
191c9629d653 (mm-uu-configure): Unquote lambda.
Dave Love <fx@gnu.org>
parents: 33141
diff changeset
106 (if (mm-uu-configure-p type 'disabled)
191c9629d653 (mm-uu-configure): Unquote lambda.
Dave Love <fx@gnu.org>
parents: 33141
diff changeset
107 nil
191c9629d653 (mm-uu-configure): Unquote lambda.
Dave Love <fx@gnu.org>
parents: 33141
diff changeset
108 (setq mm-uu-begin-line
191c9629d653 (mm-uu-configure): Unquote lambda.
Dave Love <fx@gnu.org>
parents: 33141
diff changeset
109 (concat mm-uu-begin-line
191c9629d653 (mm-uu-configure): Unquote lambda.
Dave Love <fx@gnu.org>
parents: 33141
diff changeset
110 (if mm-uu-begin-line "\\|")
191c9629d653 (mm-uu-configure): Unquote lambda.
Dave Love <fx@gnu.org>
parents: 33141
diff changeset
111 (symbol-value
191c9629d653 (mm-uu-configure): Unquote lambda.
Dave Love <fx@gnu.org>
parents: 33141
diff changeset
112 (intern (concat "mm-uu-" (symbol-name type)
191c9629d653 (mm-uu-configure): Unquote lambda.
Dave Love <fx@gnu.org>
parents: 33141
diff changeset
113 "-begin-line")))))))
31717
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
114 '(uu postscript binhex shar forward)))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
115
33265
191c9629d653 (mm-uu-configure): Unquote lambda.
Dave Love <fx@gnu.org>
parents: 33141
diff changeset
116 ;; 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
117 (defcustom mm-uu-configure-list nil
33265
191c9629d653 (mm-uu-configure): Unquote lambda.
Dave Love <fx@gnu.org>
parents: 33141
diff changeset
118 "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
119 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
120 `(shar . disabled)' to this list."
66b0773e0877 (mm-uu-configure-list): Move back to old location,
Miles Bader <miles@gnu.org>
parents: 33120
diff changeset
121 :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
122 (const :tag "uu" (uu . disabled))
33888
2c4faf64d4ca (mm-uu-configure-list): Fix typo in :type.
Dave Love <fx@gnu.org>
parents: 33820
diff changeset
123 (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
124 (const :tag "shar" (shar . disabled))
66b0773e0877 (mm-uu-configure-list): Move back to old location,
Miles Bader <miles@gnu.org>
parents: 33120
diff changeset
125 (const :tag "forward" (forward . disabled))))
66b0773e0877 (mm-uu-configure-list): Move back to old location,
Miles Bader <miles@gnu.org>
parents: 33120
diff changeset
126 :group 'gnus-article-mime
66b0773e0877 (mm-uu-configure-list): Move back to old location,
Miles Bader <miles@gnu.org>
parents: 33120
diff changeset
127 :set 'mm-uu-configure)
66b0773e0877 (mm-uu-configure-list): Move back to old location,
Miles Bader <miles@gnu.org>
parents: 33120
diff changeset
128
31717
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
129 (mm-uu-configure)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
130
38727
eafbae0b1100 (mm-uu-dissect, mm-uu-test): Fix autoload cookies.
Gerd Moellmann <gerd@gnu.org>
parents: 38413
diff changeset
131 ;;;###autoload
31717
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
132 (defun mm-uu-dissect ()
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
133 "Dissect the current buffer and return a list of uu handles."
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
134 (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
135 type file-name end-line result text-plain-type
31717
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
136 start-char-1 end-char-1
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
137 (case-fold-search t))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
138 (save-excursion
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
139 (save-restriction
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
140 (mail-narrow-to-head)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
141 (goto-char (point-max)))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
142 (forward-line)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
143 ;;; gnus-decoded is a fake charset, which means no further
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
144 ;;; decoding.
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
145 (setq text-start (point)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
146 text-plain-type '("text/plain" (charset . gnus-decoded)))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
147 (while (re-search-forward mm-uu-begin-line nil t)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
148 (setq start-char (match-beginning 0))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
149 (setq type (cdr (assq (aref (match-string 0) 0)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
150 mm-uu-identifier-alist)))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
151 (setq file-name
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
152 (if (and (eq type 'uu)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
153 (looking-at "\\(.+\\)$"))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
154 (and (match-string 1)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
155 (let ((nnheader-file-name-translation-alist
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
156 '((?/ . ?,) (? . ?_) (?* . ?_) (?$ . ?_))))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
157 (nnheader-translate-file-chars (match-string 1))))))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
158 (forward-line);; in case of failure
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
159 (setq start-char-1 (point))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
160 (setq end-line (symbol-value
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
161 (intern (concat "mm-uu-" (symbol-name type)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
162 "-end-line"))))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
163 (when (and (re-search-forward end-line nil t)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
164 (not (eq (match-beginning 0) (match-end 0))))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
165 (setq end-char-1 (match-beginning 0))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
166 (forward-line)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
167 (setq end-char (point))
33120
5d37eed2a6e2 (mm-uu-decode-function, mm-uu-binhex-decode-function):
Dave Love <fx@gnu.org>
parents: 31717
diff changeset
168 (when (cond
31717
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
169 ((eq type 'binhex)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
170 (setq file-name
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
171 (ignore-errors
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
172 (binhex-decode-region start-char end-char t))))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
173 ((eq type 'forward)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
174 (save-excursion
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
175 (goto-char start-char-1)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
176 (looking-at "[\r\n]*[a-zA-Z][a-zA-Z0-9-]*:")))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
177 (t t))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
178 (if (> start-char text-start)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
179 (push
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
180 (mm-make-handle (mm-uu-copy-to-buffer text-start start-char)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
181 text-plain-type)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
182 result))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
183 (push
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
184 (cond
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
185 ((eq type 'postscript)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
186 (mm-make-handle (mm-uu-copy-to-buffer start-char end-char)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
187 '("application/postscript")))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
188 ((eq type 'forward)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
189 (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
190 '("message/rfc822" (charset . gnus-decoded))))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
191 ((eq type 'uu)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
192 (mm-make-handle (mm-uu-copy-to-buffer start-char end-char)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
193 (list (or (and file-name
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
194 (string-match "\\.[^\\.]+$"
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
195 file-name)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
196 (mailcap-extension-to-mime
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
197 (match-string 0 file-name)))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
198 "application/octet-stream"))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
199 'x-uuencode nil
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
200 (if (and file-name (not (equal file-name "")))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
201 (list mm-dissect-disposition
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
202 (cons 'filename file-name)))))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
203 ((eq type 'binhex)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
204 (mm-make-handle (mm-uu-copy-to-buffer start-char end-char)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
205 (list (or (and file-name
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
206 (string-match "\\.[^\\.]+$" file-name)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
207 (mailcap-extension-to-mime
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
208 (match-string 0 file-name)))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
209 "application/octet-stream"))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
210 'x-binhex nil
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
211 (if (and file-name (not (equal file-name "")))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
212 (list mm-dissect-disposition
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
213 (cons 'filename file-name)))))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
214 ((eq type 'shar)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
215 (mm-make-handle (mm-uu-copy-to-buffer start-char end-char)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
216 '("application/x-shar"))))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
217 result)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
218 (setq text-start end-char))))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
219 (when result
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
220 (if (> (point-max) (1+ text-start))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
221 (push
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
222 (mm-make-handle (mm-uu-copy-to-buffer text-start (point-max))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
223 text-plain-type)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
224 result))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
225 (setq result (cons "multipart/mixed" (nreverse result))))
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
38727
eafbae0b1100 (mm-uu-dissect, mm-uu-test): Fix autoload cookies.
Gerd Moellmann <gerd@gnu.org>
parents: 38413
diff changeset
228 ;;;###autoload
31717
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
229 (defun mm-uu-test ()
33120
5d37eed2a6e2 (mm-uu-decode-function, mm-uu-binhex-decode-function):
Dave Love <fx@gnu.org>
parents: 31717
diff changeset
230 "Check whether the current buffer contains uu stuff."
31717
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
231 (save-excursion
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
232 (goto-char (point-min))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
233 (let (type end-line result
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
234 (case-fold-search t))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
235 (while (and mm-uu-begin-line
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
236 (not result) (re-search-forward mm-uu-begin-line nil t))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
237 (forward-line)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
238 (setq type (cdr (assq (aref (match-string 0) 0)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
239 mm-uu-identifier-alist)))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
240 (setq end-line (symbol-value
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
241 (intern (concat "mm-uu-" (symbol-name type)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
242 "-end-line"))))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
243 (if (and (re-search-forward end-line nil t)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
244 (not (eq (match-beginning 0) (match-end 0))))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
245 (setq result t)))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
246 result)))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
247
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
248 (provide 'mm-uu)
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 ;;; mm-uu.el ends here