/[emacs]/emacs/lisp/gnus/mm-uu.el
ViewVC logotype

Diff of /emacs/lisp/gnus/mm-uu.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.9.8.2 by miles, Tue Oct 14 23:34:51 2003 UTC revision 1.9.8.3 by miles, Thu Sep 16 00:12:16 2004 UTC
# Line 1  Line 1 
1  ;;; mm-uu.el --- return uu stuff as mm handles  ;;; mm-uu.el --- Return uu stuff as mm handles
2  ;; Copyright (c) 1998, 1999, 2000, 2001 Free Software Foundation, Inc.  ;; Copyright (c) 1998, 1999, 2000, 2001, 2002, 2003 Free Software Foundation, Inc.
3    
4  ;; Author: Shenghuo Zhu <zsh@cs.rochester.edu>  ;; Author: Shenghuo Zhu <zsh@cs.rochester.edu>
5  ;; Keywords: postscript uudecode binhex shar forward news  ;; Keywords: postscript uudecode binhex shar forward gnatsweb pgp
6    
7  ;; This file is part of GNU Emacs.  ;; This file is part of GNU Emacs.
8    
# Line 30  Line 30 
30  (require 'nnheader)  (require 'nnheader)
31  (require 'mm-decode)  (require 'mm-decode)
32  (require 'mailcap)  (require 'mailcap)
33  (require 'uudecode)  (require 'mml2015)
 (require 'binhex)  
34    
35  (defun mm-uu-copy-to-buffer (from to)  (autoload 'uudecode-decode-region "uudecode")
36    "Copy the contents of the current buffer to a fresh buffer.  (autoload 'uudecode-decode-region-external "uudecode")
37  Return that buffer."  (autoload 'uudecode-decode-region-internal "uudecode")
38    (save-excursion  
39      (let ((obuf (current-buffer)))  (autoload 'binhex-decode-region "binhex")
40        (set-buffer (generate-new-buffer " *mm-uu*"))  (autoload 'binhex-decode-region-external "binhex")
41        (insert-buffer-substring obuf from to)  (autoload 'binhex-decode-region-internal "binhex")
       (current-buffer))))  
   
 ;;; postscript  
42    
43  (defconst mm-uu-postscript-begin-line "^%!PS-")  (autoload 'yenc-decode-region "yenc")
44  (defconst mm-uu-postscript-end-line "^%%EOF$")  (autoload 'yenc-extract-filename "yenc")
45    
 (defconst mm-uu-uu-begin-line "^begin[ \t]+[0-7][0-7][0-7][ \t]+")  
 (defconst mm-uu-uu-end-line "^end[ \t]*$")  
   
 ;; This is not the right place for this.  uudecode.el should decide  
 ;; whether or not to use a program with a single interface, but I  
 ;; guess it's too late now.  Also the default should depend on a test  
 ;; for the program.  -- fx  
46  (defcustom mm-uu-decode-function 'uudecode-decode-region  (defcustom mm-uu-decode-function 'uudecode-decode-region
47    "*Function to uudecode.    "*Function to uudecode.
48  Internal function is done in Lisp by default, therefore decoding may  Internal function is done in Lisp by default, therefore decoding may
49  appear to be horribly slow.  You can make Gnus use an external  appear to be horribly slow.  You can make Gnus use an external
50  decoder, such as uudecode."  decoder, such as uudecode."
51    :type '(choice    :type '(choice
52            (function-item :tag "Internal" uudecode-decode-region)            (function-item :tag "Auto detect" uudecode-decode-region)
53              (function-item :tag "Internal" uudecode-decode-region-internal)
54            (function-item :tag "External" uudecode-decode-region-external))            (function-item :tag "External" uudecode-decode-region-external))
55    :group 'gnus-article-mime)    :group 'gnus-article-mime)
56    
 (defconst mm-uu-binhex-begin-line  
   "^:...............................................................$")  
 (defconst mm-uu-binhex-end-line ":$")  
   
57  (defcustom mm-uu-binhex-decode-function 'binhex-decode-region  (defcustom mm-uu-binhex-decode-function 'binhex-decode-region
58    "*Function to binhex decode.    "*Function to binhex decode.
59  Internal function is done in Lisp by default, therefore decoding may  Internal function is done in elisp by default, therefore decoding may
60  appear to be horribly slow.  You can make Gnus use an external  appear to be horribly slow . You can make Gnus use the external Unix
61  decoder, such as hexbin."  decoder, such as hexbin."
62    :type '(choice    :type '(choice (function-item :tag "Auto detect" binhex-decode-region)
63            (function-item :tag "Internal" binhex-decode-region)                   (function-item :tag "Internal" binhex-decode-region-internal)
64            (function-item :tag "External" binhex-decode-region-external))                   (function-item :tag "External" binhex-decode-region-external))
65    :group 'gnus-article-mime)    :group 'gnus-article-mime)
66    
67  (defconst mm-uu-shar-begin-line "^#! */bin/sh")  (defvar mm-uu-yenc-decode-function 'yenc-decode-region)
 (defconst mm-uu-shar-end-line "^exit 0\\|^$")  
68    
69  ;;; Thanks to Edward J. Sabol <sabol@alderaan.gsfc.nasa.gov> and  (defvar mm-uu-pgp-beginning-signature
70  ;;; Peter von der Ah\'e <pahe@daimi.au.dk>       "^-----BEGIN PGP SIGNATURE-----")
 (defconst mm-uu-forward-begin-line "^-+ \\(Start of \\)?Forwarded message")  
 (defconst mm-uu-forward-end-line "^-+ End \\(of \\)?forwarded message")  
   
 (defvar mm-uu-begin-line nil)  
71    
72  (defconst mm-uu-identifier-alist  (defvar mm-uu-beginning-regexp nil)
   '((?% . postscript) (?b . uu) (?: . binhex) (?# . shar)  
     (?- . forward)))  
73    
74  (defvar mm-dissect-disposition "inline"  (defvar mm-dissect-disposition "inline"
75    "The default disposition of uu parts.    "The default disposition of uu parts.
76  This can be either \"inline\" or \"attachment\".")  This can be either \"inline\" or \"attachment\".")
77    
78    (defvar mm-uu-emacs-sources-regexp "gnu\\.emacs\\.sources"
79      "The regexp of Emacs sources groups.")
80    
81    (defcustom mm-uu-diff-groups-regexp "gnus\\.commits"
82      "*Regexp matching diff groups."
83      :type 'regexp
84      :group 'gnus-article-mime)
85    
86    (defvar mm-uu-type-alist
87      '((postscript
88         "^%!PS-"
89         "^%%EOF$"
90         mm-uu-postscript-extract
91         nil)
92        (uu
93         "^begin[ \t]+0?[0-7][0-7][0-7][ \t]+"
94         "^end[ \t]*$"
95         mm-uu-uu-extract
96         mm-uu-uu-filename)
97        (binhex
98         "^:...............................................................$"
99         ":$"
100         mm-uu-binhex-extract
101         nil
102         mm-uu-binhex-filename)
103        (yenc
104         "^=ybegin.*size=[0-9]+.*name=.*$"
105         "^=yend.*size=[0-9]+"
106         mm-uu-yenc-extract
107         mm-uu-yenc-filename)
108        (shar
109         "^#! */bin/sh"
110         "^exit 0$"
111         mm-uu-shar-extract)
112        (forward
113    ;;; Thanks to Edward J. Sabol <sabol@alderaan.gsfc.nasa.gov> and
114    ;;; Peter von der Ah\'e <pahe@daimi.au.dk>
115         "^-+ \\(Start of \\)?Forwarded message"
116         "^-+ End \\(of \\)?forwarded message"
117         mm-uu-forward-extract
118         nil
119         mm-uu-forward-test)
120        (gnatsweb
121         "^----gnatsweb-attachment----"
122         nil
123         mm-uu-gnatsweb-extract)
124        (pgp-signed
125         "^-----BEGIN PGP SIGNED MESSAGE-----"
126         "^-----END PGP SIGNATURE-----"
127         mm-uu-pgp-signed-extract
128         nil
129         nil)
130        (pgp-encrypted
131         "^-----BEGIN PGP MESSAGE-----"
132         "^-----END PGP MESSAGE-----"
133         mm-uu-pgp-encrypted-extract
134         nil
135         nil)
136        (pgp-key
137         "^-----BEGIN PGP PUBLIC KEY BLOCK-----"
138         "^-----END PGP PUBLIC KEY BLOCK-----"
139         mm-uu-pgp-key-extract
140         mm-uu-gpg-key-skip-to-last
141         nil)
142        (emacs-sources
143         "^;;;?[ \t]*[^ \t]+\\.el[ \t]*--"
144         "^;;;?[ \t]*\\([^ \t]+\\.el\\)[ \t]+ends here"
145         mm-uu-emacs-sources-extract
146         nil
147         mm-uu-emacs-sources-test)
148        (diff
149         "^Index: "
150         nil
151         mm-uu-diff-extract
152         nil
153         mm-uu-diff-test)))
154    
155    (defcustom mm-uu-configure-list '((shar . disabled))
156      "A list of mm-uu configuration.
157    To disable dissecting shar codes, for instance, add
158    `(shar . disabled)' to this list."
159      :type 'alist
160      :options (mapcar (lambda (entry)
161                         (list (car entry) '(const disabled)))
162                       mm-uu-type-alist)
163      :group 'gnus-article-mime)
164    
165    ;; functions
166    
167    (defsubst mm-uu-type (entry)
168      (car entry))
169    
170    (defsubst mm-uu-beginning-regexp (entry)
171      (nth 1 entry))
172    
173    (defsubst mm-uu-end-regexp (entry)
174      (nth 2 entry))
175    
176    (defsubst mm-uu-function-extract (entry)
177      (nth 3 entry))
178    
179    (defsubst mm-uu-function-1 (entry)
180      (nth 4 entry))
181    
182    (defsubst mm-uu-function-2 (entry)
183      (nth 5 entry))
184    
185    (defun mm-uu-copy-to-buffer (&optional from to)
186      "Copy the contents of the current buffer to a fresh buffer.
187    Return that buffer."
188      (save-excursion
189        (let ((obuf (current-buffer))
190              (coding-system
191               ;; Might not exist in non-MULE XEmacs
192               (when (boundp 'buffer-file-coding-system)
193                 buffer-file-coding-system)))
194          (set-buffer (generate-new-buffer " *mm-uu*"))
195          (setq buffer-file-coding-system coding-system)
196          (insert-buffer-substring obuf from to)
197          (current-buffer))))
198    
199  (defun mm-uu-configure-p  (key val)  (defun mm-uu-configure-p  (key val)
200    (member (cons key val) mm-uu-configure-list))    (member (cons key val) mm-uu-configure-list))
201    
202  (defun mm-uu-configure (&optional symbol value)  (defun mm-uu-configure (&optional symbol value)
203    (if symbol (set-default symbol value))    (if symbol (set-default symbol value))
204    (setq mm-uu-begin-line nil)    (setq mm-uu-beginning-regexp nil)
205    (mapcar (lambda (type)    (mapcar (lambda (entry)
206              (if (mm-uu-configure-p type 'disabled)               (if (mm-uu-configure-p (mm-uu-type entry) 'disabled)
207                  nil                   nil
208                (setq mm-uu-begin-line                 (setq mm-uu-beginning-regexp
209                      (concat mm-uu-begin-line                       (concat mm-uu-beginning-regexp
210                              (if mm-uu-begin-line "\\|")                               (if mm-uu-beginning-regexp "\\|")
211                              (symbol-value                               (mm-uu-beginning-regexp entry)))))
212                               (intern (concat "mm-uu-" (symbol-name type)            mm-uu-type-alist))
                                              "-begin-line")))))))  
           '(uu postscript binhex shar forward)))  
   
 ;; Needs to come after mm-uu-configure.  
 (defcustom mm-uu-configure-list nil  
   "Alist of mm-uu configurations to disable.  
 To disable dissecting shar codes, for instance, add  
 `(shar . disabled)' to this list."  
   :type '(repeat (choice (const :tag "postscript" (postscript . disabled))  
                          (const :tag "uu" (uu . disabled))  
                          (const :tag "binhex" (binhex . disabled))  
                          (const :tag "shar" (shar . disabled))  
                          (const :tag "forward" (forward . disabled))))  
   :group 'gnus-article-mime  
   :set 'mm-uu-configure)  
213    
214  (mm-uu-configure)  (mm-uu-configure)
215    
216    (eval-when-compile
217      (defvar file-name)
218      (defvar start-point)
219      (defvar end-point)
220      (defvar entry))
221    
222    (defun mm-uu-uu-filename ()
223      (if (looking-at ".+")
224          (setq file-name
225                (let ((nnheader-file-name-translation-alist
226                       '((?/ . ?,) (?\  . ?_) (?* . ?_) (?$ . ?_))))
227                  (nnheader-translate-file-chars (match-string 0))))))
228    
229    (defun mm-uu-binhex-filename ()
230      (setq file-name
231            (ignore-errors
232              (binhex-decode-region start-point end-point t))))
233    
234    (defun mm-uu-yenc-filename ()
235      (goto-char start-point)
236      (setq file-name
237            (ignore-errors
238              (yenc-extract-filename))))
239    
240    (defun mm-uu-forward-test ()
241      (save-excursion
242        (goto-char start-point)
243        (forward-line)
244        (looking-at "[\r\n]*[a-zA-Z][a-zA-Z0-9-]*:")))
245    
246    (defun mm-uu-postscript-extract ()
247      (mm-make-handle (mm-uu-copy-to-buffer start-point end-point)
248                      '("application/postscript")))
249    
250    (defun mm-uu-emacs-sources-extract ()
251      (mm-make-handle (mm-uu-copy-to-buffer start-point end-point)
252                      '("application/emacs-lisp")
253                      nil nil
254                      (list mm-dissect-disposition
255                            (cons 'filename file-name))))
256    
257    (eval-when-compile
258      (defvar gnus-newsgroup-name))
259    
260    (defun mm-uu-emacs-sources-test ()
261      (setq file-name (match-string 1))
262      (and gnus-newsgroup-name
263           mm-uu-emacs-sources-regexp
264           (string-match mm-uu-emacs-sources-regexp gnus-newsgroup-name)))
265    
266    (defun mm-uu-diff-extract ()
267      (mm-make-handle (mm-uu-copy-to-buffer start-point end-point)
268                      '("text/x-patch")))
269    
270    (defun mm-uu-diff-test ()
271      (and gnus-newsgroup-name
272           mm-uu-diff-groups-regexp
273           (string-match mm-uu-diff-groups-regexp gnus-newsgroup-name)))
274    
275    (defun mm-uu-forward-extract ()
276      (mm-make-handle (mm-uu-copy-to-buffer
277                       (progn (goto-char start-point) (forward-line) (point))
278                       (progn (goto-char end-point) (forward-line -1) (point)))
279                      '("message/rfc822" (charset . gnus-decoded))))
280    
281    (defun mm-uu-uu-extract ()
282      (mm-make-handle (mm-uu-copy-to-buffer start-point end-point)
283                      (list (or (and file-name
284                                     (string-match "\\.[^\\.]+$"
285                                                   file-name)
286                                     (mailcap-extension-to-mime
287                                      (match-string 0 file-name)))
288                                "application/octet-stream"))
289                      'x-uuencode nil
290                      (if (and file-name (not (equal file-name "")))
291                          (list mm-dissect-disposition
292                                (cons 'filename file-name)))))
293    
294    (defun mm-uu-binhex-extract ()
295      (mm-make-handle (mm-uu-copy-to-buffer start-point end-point)
296                      (list (or (and file-name
297                                     (string-match "\\.[^\\.]+$" file-name)
298                                     (mailcap-extension-to-mime
299                                      (match-string 0 file-name)))
300                                "application/octet-stream"))
301                      'x-binhex nil
302                      (if (and file-name (not (equal file-name "")))
303                          (list mm-dissect-disposition
304                                (cons 'filename file-name)))))
305    
306    (defun mm-uu-yenc-extract ()
307      (mm-make-handle (mm-uu-copy-to-buffer start-point end-point)
308                      (list (or (and file-name
309                                     (string-match "\\.[^\\.]+$" file-name)
310                                     (mailcap-extension-to-mime
311                                      (match-string 0 file-name)))
312                                "application/octet-stream"))
313                      'x-yenc nil
314                      (if (and file-name (not (equal file-name "")))
315                          (list mm-dissect-disposition
316                                (cons 'filename file-name)))))
317    
318    
319    (defun mm-uu-shar-extract ()
320      (mm-make-handle (mm-uu-copy-to-buffer start-point end-point)
321                      '("application/x-shar")))
322    
323    (defun mm-uu-gnatsweb-extract ()
324      (save-restriction
325        (goto-char start-point)
326        (forward-line)
327        (narrow-to-region (point) end-point)
328        (mm-dissect-buffer t)))
329    
330    (defun mm-uu-pgp-signed-test (&rest rest)
331      (and
332       mml2015-use
333       (mml2015-clear-verify-function)
334       (cond
335        ((eq mm-verify-option 'never) nil)
336        ((eq mm-verify-option 'always) t)
337        ((eq mm-verify-option 'known) t)
338        (t (y-or-n-p "Verify pgp signed part? ")))))
339    
340    (eval-when-compile
341      (defvar gnus-newsgroup-charset))
342    
343    (defun mm-uu-pgp-signed-extract-1 (handles ctl)
344      (let ((buf (mm-uu-copy-to-buffer (point-min) (point-max))))
345        (with-current-buffer buf
346          (if (mm-uu-pgp-signed-test)
347              (progn
348                (mml2015-clean-buffer)
349                (let ((coding-system-for-write (or gnus-newsgroup-charset
350                                                   'iso-8859-1)))
351                  (funcall (mml2015-clear-verify-function))))
352            (when (and mml2015-use (null (mml2015-clear-verify-function)))
353              (mm-set-handle-multipart-parameter
354               mm-security-handle 'gnus-details
355               (format "Clear verification not supported by `%s'.\n" mml2015-use))))
356          (goto-char (point-min))
357          (if (search-forward "\n\n" nil t)
358              (delete-region (point-min) (point)))
359          (if (re-search-forward mm-uu-pgp-beginning-signature nil t)
360              (delete-region (match-beginning 0) (point-max)))
361          (goto-char (point-min))
362          (while (re-search-forward "^- " nil t)
363            (replace-match "" t t)
364            (forward-line 1)))
365        (list (mm-make-handle buf '("text/plain" (charset . gnus-decoded))))))
366    
367    (defun mm-uu-pgp-signed-extract ()
368      (let ((mm-security-handle (list (format "multipart/signed"))))
369        (mm-set-handle-multipart-parameter
370         mm-security-handle 'protocol "application/x-gnus-pgp-signature")
371        (save-restriction
372          (narrow-to-region start-point end-point)
373          (add-text-properties 0 (length (car mm-security-handle))
374                               (list 'buffer (mm-uu-copy-to-buffer))
375                               (car mm-security-handle))
376          (setcdr mm-security-handle
377                  (mm-uu-pgp-signed-extract-1 nil
378                                              mm-security-handle)))
379        mm-security-handle))
380    
381    (defun mm-uu-pgp-encrypted-test (&rest rest)
382      (and
383       mml2015-use
384       (mml2015-clear-decrypt-function)
385       (cond
386        ((eq mm-decrypt-option 'never) nil)
387        ((eq mm-decrypt-option 'always) t)
388        ((eq mm-decrypt-option 'known) t)
389        (t (y-or-n-p "Decrypt pgp encrypted part? ")))))
390    
391    (defun mm-uu-pgp-encrypted-extract-1 (handles ctl)
392      (let ((buf (mm-uu-copy-to-buffer (point-min) (point-max))))
393        (if (mm-uu-pgp-encrypted-test)
394            (with-current-buffer buf
395              (mml2015-clean-buffer)
396              (funcall (mml2015-clear-decrypt-function))))
397        (list
398         (mm-make-handle buf
399                         '("text/plain"  (charset . gnus-decoded))))))
400    
401    (defun mm-uu-pgp-encrypted-extract ()
402      (let ((mm-security-handle (list (format "multipart/encrypted"))))
403        (mm-set-handle-multipart-parameter
404         mm-security-handle 'protocol "application/x-gnus-pgp-encrypted")
405        (save-restriction
406          (narrow-to-region start-point end-point)
407          (add-text-properties 0 (length (car mm-security-handle))
408                               (list 'buffer (mm-uu-copy-to-buffer))
409                               (car mm-security-handle))
410          (setcdr mm-security-handle
411                  (mm-uu-pgp-encrypted-extract-1 nil
412                                                 mm-security-handle)))
413        mm-security-handle))
414    
415    (defun mm-uu-gpg-key-skip-to-last ()
416      (let ((point (point))
417            (end-regexp (mm-uu-end-regexp entry))
418            (beginning-regexp (mm-uu-beginning-regexp entry)))
419        (when (and end-regexp
420                   (not (mm-uu-configure-p (mm-uu-type entry) 'disabled)))
421          (while (re-search-forward end-regexp nil t)
422            (skip-chars-forward " \t\n\r")
423            (if (looking-at beginning-regexp)
424                (setq point (match-end 0)))))
425        (goto-char point)))
426    
427    (defun mm-uu-pgp-key-extract ()
428      (let ((buf (mm-uu-copy-to-buffer start-point end-point)))
429        (mm-make-handle buf
430                        '("application/pgp-keys"))))
431    
432  ;;;###autoload  ;;;###autoload
433  (defun mm-uu-dissect ()  (defun mm-uu-dissect ()
434    "Dissect the current buffer and return a list of uu handles."    "Dissect the current buffer and return a list of uu handles."
435    (let (text-start start-char end-char    (let ((case-fold-search t)
436                     type file-name end-line result text-plain-type          text-start start-point end-point file-name result
437                     start-char-1 end-char-1          text-plain-type entry func)
                    (case-fold-search t))  
438      (save-excursion      (save-excursion
439        (save-restriction        (goto-char (point-min))
440          (mail-narrow-to-head)        (cond
441          (goto-char (point-max)))         ((looking-at "\n")
442        (forward-line)          (forward-line))
443           ((search-forward "\n\n" nil t)
444            t)
445           (t (goto-char (point-max))))
446        ;;; gnus-decoded is a fake charset, which means no further        ;;; gnus-decoded is a fake charset, which means no further
447        ;;; decoding.        ;;; decoding.
448        (setq text-start (point)        (setq text-start (point)
449              text-plain-type '("text/plain"  (charset . gnus-decoded)))              text-plain-type '("text/plain"  (charset . gnus-decoded)))
450        (while (re-search-forward mm-uu-begin-line nil t)        (while (re-search-forward mm-uu-beginning-regexp nil t)
451          (setq start-char (match-beginning 0))          (setq start-point (match-beginning 0))
452          (setq type (cdr (assq (aref (match-string 0) 0)          (let ((alist mm-uu-type-alist)
453                                mm-uu-identifier-alist)))                (beginning-regexp (match-string 0)))
454          (setq file-name            (while (not entry)
455                (if (and (eq type 'uu)              (if (string-match (mm-uu-beginning-regexp (car alist))
456                         (looking-at "\\(.+\\)$"))                                beginning-regexp)
457                    (and (match-string 1)                  (setq entry (car alist))
458                         (let ((nnheader-file-name-translation-alist                (pop alist))))
459                                '((?/ . ?,) (?\  . ?_) (?* . ?_) (?$ . ?_))))          (if (setq func (mm-uu-function-1 entry))
460                           (nnheader-translate-file-chars (match-string 1))))))              (funcall func))
461          (forward-line);; in case of failure          (forward-line);; in case of failure
462          (setq start-char-1 (point))          (when (and (not (mm-uu-configure-p (mm-uu-type entry) 'disabled))
463          (setq end-line (symbol-value                     (let ((end-regexp (mm-uu-end-regexp entry)))
464                          (intern (concat "mm-uu-" (symbol-name type)                       (if (not end-regexp)
465                                          "-end-line"))))                           (or (setq end-point (point-max)) t)
466          (when (and (re-search-forward end-line nil t)                         (prog1
467                     (not (eq (match-beginning 0) (match-end 0))))                             (re-search-forward end-regexp nil t)
468            (setq end-char-1 (match-beginning 0))                           (forward-line)
469            (forward-line)                           (setq end-point (point)))))
470            (setq end-char (point))                     (or (not (setq func (mm-uu-function-2 entry)))
471            (when (cond                         (funcall func)))
472                   ((eq type 'binhex)            (if (and (> start-point text-start)
473                    (setq file-name                     (progn
474                          (ignore-errors                       (goto-char text-start)
475                            (binhex-decode-region start-char end-char t))))                       (re-search-forward "." start-point t)))
476                   ((eq type 'forward)                (push
477                    (save-excursion                 (mm-make-handle (mm-uu-copy-to-buffer text-start start-point)
478                      (goto-char start-char-1)                                 text-plain-type)
479                      (looking-at "[\r\n]*[a-zA-Z][a-zA-Z0-9-]*:")))                 result))
480                   (t t))            (push
481              (if (> start-char text-start)             (funcall (mm-uu-function-extract entry))
482                  (push             result)
483                   (mm-make-handle (mm-uu-copy-to-buffer text-start start-char)            (goto-char (setq text-start end-point))))
                                  text-plain-type)  
                  result))  
             (push  
              (cond  
               ((eq type 'postscript)  
                (mm-make-handle (mm-uu-copy-to-buffer start-char end-char)  
                                '("application/postscript")))  
               ((eq type 'forward)  
                (mm-make-handle (mm-uu-copy-to-buffer start-char-1 end-char-1)  
                                '("message/rfc822" (charset . gnus-decoded))))  
               ((eq type 'uu)  
                (mm-make-handle (mm-uu-copy-to-buffer start-char end-char)  
                                (list (or (and file-name  
                                               (string-match "\\.[^\\.]+$"  
                                                             file-name)  
                                               (mailcap-extension-to-mime  
                                                (match-string 0 file-name)))  
                                          "application/octet-stream"))  
                                'x-uuencode nil  
                                (if (and file-name (not (equal file-name "")))  
                                    (list mm-dissect-disposition  
                                          (cons 'filename file-name)))))  
               ((eq type 'binhex)  
                (mm-make-handle (mm-uu-copy-to-buffer start-char end-char)  
                                (list (or (and file-name  
                                               (string-match "\\.[^\\.]+$" file-name)  
                                               (mailcap-extension-to-mime  
                                                (match-string 0 file-name)))  
                                          "application/octet-stream"))  
                                'x-binhex nil  
                                (if (and file-name (not (equal file-name "")))  
                                    (list mm-dissect-disposition  
                                          (cons 'filename file-name)))))  
               ((eq type 'shar)  
                (mm-make-handle (mm-uu-copy-to-buffer start-char end-char)  
                                '("application/x-shar"))))  
              result)  
             (setq text-start end-char))))  
484        (when result        (when result
485          (if (> (point-max) (1+ text-start))          (if (and (> (point-max) (1+ text-start))
486                     (save-excursion
487                       (goto-char text-start)
488                       (re-search-forward "." nil t)))
489              (push              (push
490               (mm-make-handle (mm-uu-copy-to-buffer text-start (point-max))               (mm-make-handle (mm-uu-copy-to-buffer text-start (point-max))
491                               text-plain-type)                               text-plain-type)
# Line 225  To disable dissecting shar codes, for in Line 493  To disable dissecting shar codes, for in
493          (setq result (cons "multipart/mixed" (nreverse result))))          (setq result (cons "multipart/mixed" (nreverse result))))
494        result)))        result)))
495    
 ;;;###autoload  
 (defun mm-uu-test ()  
   "Check whether the current buffer contains uu stuff."  
   (save-excursion  
     (goto-char (point-min))  
     (let (type end-line result  
                (case-fold-search t))  
       (while (and mm-uu-begin-line  
                   (not result) (re-search-forward mm-uu-begin-line nil t))  
         (forward-line)  
         (setq type (cdr (assq (aref (match-string 0) 0)  
                               mm-uu-identifier-alist)))  
         (setq end-line (symbol-value  
                         (intern (concat "mm-uu-" (symbol-name type)  
                                         "-end-line"))))  
         (if (and (re-search-forward end-line nil t)  
                  (not (eq (match-beginning 0) (match-end 0))))  
             (setq result t)))  
       result)))  
   
496  (provide 'mm-uu)  (provide 'mm-uu)
497    
498  ;;; arch-tag: 7db076bf-53db-4320-aa19-ca76a1d2ab2c  ;;; arch-tag: 7db076bf-53db-4320-aa19-ca76a1d2ab2c

Legend:
Removed from v.1.9.8.2  
changed lines
  Added in v.1.9.8.3

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26