Mercurial > emacs

comparison lisp/gnus/mm-uu.el @ 33120:5d37eed2a6e2

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
(mm-uu-decode-function, mm-uu-binhex-decode-function): Fix custom type. (mm-uu-configure-list): Move and fix custom type.
author Dave Love <fx@gnu.org>
date Wed, 01 Nov 2000 14:54:52 +0000
parents 6b20b7e85e3c
children 66b0773e0877
comparison
equal deleted inserted replaced
33119:e08be2ed6301 33120:5d37eed2a6e2
1 ;;; mm-uu.el -- Return uu stuffs as mm handles 1 ;;; mm-uu.el -- Return uu stuff as mm handles
2 ;; Copyright (c) 1998, 1999, 2000 Free Software Foundation, Inc. 2 ;; Copyright (c) 1998, 1999, 2000 Free Software Foundation, Inc.
3 3
4 ;; Author: Shenghuo Zhu <zsh@cs.rochester.edu> 4 ;; Author: Shenghuo Zhu <zsh@cs.rochester.edu>
5 ;; Keywords: postscript uudecode binhex shar forward news 5 ;; Keywords: postscript uudecode binhex shar forward news
6 6
55 (defconst mm-uu-uu-end-line "^end[ \t]*$") 55 (defconst mm-uu-uu-end-line "^end[ \t]*$")
56 56
57 (defcustom mm-uu-decode-function 'uudecode-decode-region 57 (defcustom mm-uu-decode-function 'uudecode-decode-region
58 "*Function to uudecode. 58 "*Function to uudecode.
59 Internal function is done in elisp by default, therefore decoding may 59 Internal function is done in elisp by default, therefore decoding may
60 appear to be horribly slow . You can make Gnus use the external Unix 60 appear to be horribly slow. You can make Gnus use the external Unix
61 decoder, such as uudecode." 61 decoder, such as uudecode."
62 :type '(choice (item :tag "internal" uudecode-decode-region) 62 :type '(choice (const :tag "internal" uudecode-decode-region)
63 (item :tag "external" uudecode-decode-region-external)) 63 (const :tag "external" uudecode-decode-region-external))
64 :group 'gnus-article-mime) 64 :group 'gnus-article-mime)
65 65
66 (defconst mm-uu-binhex-begin-line 66 (defconst mm-uu-binhex-begin-line
67 "^:...............................................................$") 67 "^:...............................................................$")
68 (defconst mm-uu-binhex-end-line ":$") 68 (defconst mm-uu-binhex-end-line ":$")
69 69
70 (defcustom mm-uu-binhex-decode-function 'binhex-decode-region 70 (defcustom mm-uu-binhex-decode-function 'binhex-decode-region
71 "*Function to binhex decode. 71 "*Function to binhex decode.
72 Internal function is done in elisp by default, therefore decoding may 72 Internal function is done in elisp by default, therefore decoding may
73 appear to be horribly slow . You can make Gnus use the external Unix 73 appear to be horribly slow. You can make Gnus use the external Unix
74 decoder, such as hexbin." 74 decoder, such as hexbin."
75 :type '(choice (item :tag "internal" binhex-decode-region) 75 :type '(choice (const :tag "internal" binhex-decode-region)
76 (item :tag "external" binhex-decode-region-external)) 76 (const :tag "external" binhex-decode-region-external))
77 :group 'gnus-article-mime) 77 :group 'gnus-article-mime)
78 78
79 (defconst mm-uu-shar-begin-line "^#! */bin/sh") 79 (defconst mm-uu-shar-begin-line "^#! */bin/sh")
80 (defconst mm-uu-shar-end-line "^exit 0\\|^$") 80 (defconst mm-uu-shar-end-line "^exit 0\\|^$")
81 81
82 ;;; Thanks to Edward J. Sabol <sabol@alderaan.gsfc.nasa.gov> and 82 ;;; Thanks to Edward J. Sabol <sabol@alderaan.gsfc.nasa.gov> and
83 ;;; Peter von der Ah\'e <pahe@daimi.au.dk> 83 ;;; Peter von der Ah\'e <pahe@daimi.au.dk>
84 (defconst mm-uu-forward-begin-line "^-+ \\(Start of \\)?Forwarded message") 84 (defconst mm-uu-forward-begin-line "^-+ \\(Start of \\)?Forwarded message")
85 (defconst mm-uu-forward-end-line "^-+ End \\(of \\)?forwarded message") 85 (defconst mm-uu-forward-end-line "^-+ End \\(of \\)?forwarded message")
86 86
87 (defvar mm-uu-begin-line nil) 87 (defvar mm-uu-begin-line nil)
91 (?- . forward))) 91 (?- . forward)))
92 92
93 (defvar mm-dissect-disposition "inline" 93 (defvar mm-dissect-disposition "inline"
94 "The default disposition of uu parts. 94 "The default disposition of uu parts.
95 This can be either \"inline\" or \"attachment\".") 95 This can be either \"inline\" or \"attachment\".")
96
97 (defcustom mm-uu-configure-list nil
98 "A list of mm-uu configuration.
99 To disable dissecting shar codes, for instance, add
100 `(shar . disabled)' to this list."
101 :type '(repeat (choice (const :tag "postscript" (postscript . disabled))
102 (const :tag "uu" (uu . disabled))
103 (const :tag "binhax" (binhex . disabled))
104 (const :tag "shar" (shar . disabled))
105 (const :tag "forward" (forward . disabled))))
106 :group 'gnus-article-mime
107 :set 'mm-uu-configure)
96 108
97 (defun mm-uu-configure-p (key val) 109 (defun mm-uu-configure-p (key val)
98 (member (cons key val) mm-uu-configure-list)) 110 (member (cons key val) mm-uu-configure-list))
99 111
100 (defun mm-uu-configure (&optional symbol value) 112 (defun mm-uu-configure (&optional symbol value)
101 (if symbol (set-default symbol value)) 113 (if symbol (set-default symbol value))
102 (setq mm-uu-begin-line nil) 114 (setq mm-uu-begin-line nil)
103 (mapcar '(lambda (type) 115 (mapcar '(lambda (type)
104 (if (mm-uu-configure-p type 'disabled) 116 (if (mm-uu-configure-p type 'disabled)
105 nil 117 nil
106 (setq mm-uu-begin-line 118 (setq mm-uu-begin-line
107 (concat mm-uu-begin-line 119 (concat mm-uu-begin-line
108 (if mm-uu-begin-line "\\|") 120 (if mm-uu-begin-line "\\|")
109 (symbol-value 121 (symbol-value
110 (intern (concat "mm-uu-" (symbol-name type) 122 (intern (concat "mm-uu-" (symbol-name type)
111 "-begin-line"))))))) 123 "-begin-line")))))))
112 '(uu postscript binhex shar forward))) 124 '(uu postscript binhex shar forward)))
113 125
114 (defcustom mm-uu-configure-list nil
115 "A list of mm-uu configuration.
116 To disable dissecting shar codes, for instance, add
117 `(shar . disabled)' to this list."
118 :type '(repeat (cons
119 (choice (item postscript)
120 (item uu)
121 (item binhex)
122 (item shar)
123 (item forward))
124 (choice (item disabled))))
125 :group 'gnus-article-mime
126 :set 'mm-uu-configure)
127
128 (mm-uu-configure) 126 (mm-uu-configure)
129 127
130 ;;;### autoload 128 ;;;### autoload
131 129
132 (defun mm-uu-dissect () 130 (defun mm-uu-dissect ()
133 "Dissect the current buffer and return a list of uu handles." 131 "Dissect the current buffer and return a list of uu handles."
134 (let (text-start start-char end-char 132 (let (text-start start-char end-char
135 type file-name end-line result text-plain-type 133 type file-name end-line result text-plain-type
136 start-char-1 end-char-1 134 start-char-1 end-char-1
137 (case-fold-search t)) 135 (case-fold-search t))
138 (save-excursion 136 (save-excursion
139 (save-restriction 137 (save-restriction
140 (mail-narrow-to-head) 138 (mail-narrow-to-head)
163 (when (and (re-search-forward end-line nil t) 161 (when (and (re-search-forward end-line nil t)
164 (not (eq (match-beginning 0) (match-end 0)))) 162 (not (eq (match-beginning 0) (match-end 0))))
165 (setq end-char-1 (match-beginning 0)) 163 (setq end-char-1 (match-beginning 0))
166 (forward-line) 164 (forward-line)
167 (setq end-char (point)) 165 (setq end-char (point))
168 (when (cond 166 (when (cond
169 ((eq type 'binhex) 167 ((eq type 'binhex)
170 (setq file-name 168 (setq file-name
171 (ignore-errors 169 (ignore-errors
172 (binhex-decode-region start-char end-char t)))) 170 (binhex-decode-region start-char end-char t))))
173 ((eq type 'forward) 171 ((eq type 'forward)
225 (setq result (cons "multipart/mixed" (nreverse result)))) 223 (setq result (cons "multipart/mixed" (nreverse result))))
226 result))) 224 result)))
227 225
228 ;;;### autoload 226 ;;;### autoload
229 (defun mm-uu-test () 227 (defun mm-uu-test ()
230 "Check whether the current buffer contains uu stuffs." 228 "Check whether the current buffer contains uu stuff."
231 (save-excursion 229 (save-excursion
232 (goto-char (point-min)) 230 (goto-char (point-min))
233 (let (type end-line result 231 (let (type end-line result
234 (case-fold-search t)) 232 (case-fold-search t))
235 (while (and mm-uu-begin-line 233 (while (and mm-uu-begin-line