Mercurial > emacs

comparison lisp/gnus/uudecode.el @ 56927:55fd4f77387a after-merge-gnus-5_10

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523 Merge from emacs--gnus--5.10, gnus--rel--5.10 Patches applied: * miles@gnu.org--gnu-2004/emacs--gnus--5.10--base-0 tag of miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-464 * miles@gnu.org--gnu-2004/emacs--gnus--5.10--patch-1 Import from CVS branch gnus-5_10-branch * miles@gnu.org--gnu-2004/emacs--gnus--5.10--patch-2 Merge from lorentey@elte.hu--2004/emacs--multi-tty--0, emacs--cvs-trunk--0 * miles@gnu.org--gnu-2004/emacs--gnus--5.10--patch-3 Merge from gnus--rel--5.10 * miles@gnu.org--gnu-2004/emacs--gnus--5.10--patch-4 Merge from gnus--rel--5.10 * miles@gnu.org--gnu-2004/gnus--rel--5.10--patch-18 Update from CVS * miles@gnu.org--gnu-2004/gnus--rel--5.10--patch-19 Remove autoconf-generated files from archive * miles@gnu.org--gnu-2004/gnus--rel--5.10--patch-20 Update from CVS
author Miles Bader <miles@gnu.org>
date Sat, 04 Sep 2004 13:13:48 +0000
parents 695cf19ef79e
children 497f0d2ca551 cce1c0ee76ee
comparison
equal deleted inserted replaced
56926:f8e248e9a717 56927:55fd4f77387a
1 ;;; uudecode.el --- elisp native uudecode 1 ;;; uudecode.el -- elisp native uudecode
2 2
3 ;; Copyright (c) 1998, 1999, 2000 Free Software Foundation, Inc. 3 ;; Copyright (c) 1998, 1999, 2000, 2001, 2003 Free Software Foundation, Inc.
4 4
5 ;; Author: Shenghuo Zhu <zsh@cs.rochester.edu> 5 ;; Author: Shenghuo Zhu <zsh@cs.rochester.edu>
6 ;; Keywords: uudecode news 6 ;; Keywords: uudecode news
7 7
8 ;; This file is part of GNU Emacs. 8 ;; This file is part of GNU Emacs.
22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, 22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
23 ;; Boston, MA 02111-1307, USA. 23 ;; Boston, MA 02111-1307, USA.
24 24
25 ;;; Commentary: 25 ;;; Commentary:
26 26
27 ;; Lots of codes are stolen from mm-decode.el, gnus-uu.el and
28 ;; base64.el
29
30 ;; This looks as though it could be made rather more efficient for
31 ;; internal working. Encoding could use a lookup table and decoding
32 ;; should presumably use a vector or list buffer for partial results
33 ;; rather than with-current-buffer. -- fx
34
35 ;; Only `uudecode-decode-region' should be advertised, and whether or
36 ;; not that uses a program should be customizable, but I guess it's
37 ;; too late now. -- fx
38
39 ;;; Code: 27 ;;; Code:
28
29 (autoload 'executable-find "executable")
40 30
41 (eval-when-compile (require 'cl)) 31 (eval-when-compile (require 'cl))
42 32
43 (eval-and-compile 33 (eval-and-compile
44 (defalias 'uudecode-char-int 34 (defalias 'uudecode-char-int
45 (if (fboundp 'char-int) 35 (if (fboundp 'char-int)
46 'char-int 36 'char-int
47 'identity)) 37 'identity)))
48
49 (if (featurep 'xemacs)
50 (defalias 'uudecode-insert-char 'insert-char)
51 (defun uudecode-insert-char (char &optional count ignored buffer)
52 (if (or (null buffer) (eq buffer (current-buffer)))
53 (insert-char char count)
54 (with-current-buffer buffer
55 (insert-char char count))))))
56 38
57 (defcustom uudecode-decoder-program "uudecode" 39 (defcustom uudecode-decoder-program "uudecode"
58 "*Non-nil value should be a string that names a uu decoder. 40 "*Non-nil value should be a string that names a uu decoder.
59 The program should expect to read uu data on its standard 41 The program should expect to read uu data on its standard
60 input and write the converted data to its standard output." 42 input and write the converted data to its standard output."
63 45
64 (defcustom uudecode-decoder-switches nil 46 (defcustom uudecode-decoder-switches nil
65 "*List of command line flags passed to `uudecode-decoder-program'." 47 "*List of command line flags passed to `uudecode-decoder-program'."
66 :group 'gnus-extract 48 :group 'gnus-extract
67 :type '(repeat string)) 49 :type '(repeat string))
50
51 (defcustom uudecode-use-external
52 (executable-find uudecode-decoder-program)
53 "*Use external uudecode program."
54 :group 'gnus-extract
55 :type 'boolean)
68 56
69 (defconst uudecode-alphabet "\040-\140") 57 (defconst uudecode-alphabet "\040-\140")
70 58
71 (defconst uudecode-begin-line "^begin[ \t]+[0-7][0-7][0-7][ \t]+\\(.*\\)$") 59 (defconst uudecode-begin-line "^begin[ \t]+[0-7][0-7][0-7][ \t]+\\(.*\\)$")
72 (defconst uudecode-end-line "^end[ \t]*$") 60 (defconst uudecode-end-line "^end[ \t]*$")
100 (setq file-name (read-file-name "File to Name:" 88 (setq file-name (read-file-name "File to Name:"
101 nil nil nil 89 nil nil nil
102 (match-string 1))))) 90 (match-string 1)))))
103 (setq tempfile (if file-name 91 (setq tempfile (if file-name
104 (expand-file-name file-name) 92 (expand-file-name file-name)
105 (let ((temporary-file-directory 93 (if (fboundp 'make-temp-file)
106 uudecode-temporary-file-directory)) 94 (let ((temporary-file-directory
107 (make-temp-file "uu")))) 95 uudecode-temporary-file-directory))
96 (make-temp-file "uu"))
97 (expand-file-name
98 (make-temp-name "uu")
99 uudecode-temporary-file-directory))))
108 (let ((cdir default-directory) 100 (let ((cdir default-directory)
109 default-process-coding-system) 101 default-process-coding-system)
110 (unwind-protect 102 (unwind-protect
111 (with-temp-buffer 103 (with-temp-buffer
112 (insert "begin 600 " (file-name-nondirectory tempfile) "\n") 104 (insert "begin 600 " (file-name-nondirectory tempfile) "\n")
129 (insert-file-contents-literally tempfile))) 121 (insert-file-contents-literally tempfile)))
130 (message "Can not uudecode"))) 122 (message "Can not uudecode")))
131 (ignore-errors (or file-name (delete-file tempfile)))))) 123 (ignore-errors (or file-name (delete-file tempfile))))))
132 124
133 ;;;###autoload 125 ;;;###autoload
134 (defun uudecode-decode-region (start end &optional file-name) 126 (defun uudecode-decode-region-internal (start end &optional file-name)
135 "Uudecode region between START and END without using an external program. 127 "Uudecode region between START and END without using an external program.
136 If FILE-NAME is non-nil, save the result to FILE-NAME." 128 If FILE-NAME is non-nil, save the result to FILE-NAME."
137 (interactive "r\nP") 129 (interactive "r\nP")
138 (let ((work-buffer nil) 130 (let ((done nil)
139 (done nil)
140 (counter 0) 131 (counter 0)
141 (remain 0) 132 (remain 0)
142 (bits 0) 133 (bits 0)
143 (lim 0) inputpos 134 (lim 0) inputpos result
144 (non-data-chars (concat "^" uudecode-alphabet))) 135 (non-data-chars (concat "^" uudecode-alphabet)))
145 (unwind-protect 136 (save-excursion
146 (save-excursion 137 (goto-char start)
138 (when (re-search-forward uudecode-begin-line nil t)
139 (cond ((null file-name))
140 ((stringp file-name))
141 (t
142 (setq file-name (expand-file-name
143 (read-file-name "File to Name:"
144 nil nil nil
145 (match-string 1))))))
146 (forward-line 1)
147 (skip-chars-forward non-data-chars end)
148 (while (not done)
149 (setq inputpos (point))
150 (setq remain 0 bits 0 counter 0)
151 (cond
152 ((> (skip-chars-forward uudecode-alphabet end) 0)
153 (setq lim (point))
154 (setq remain
155 (logand (- (uudecode-char-int (char-after inputpos)) 32)
156 63))
157 (setq inputpos (1+ inputpos))
158 (if (= remain 0) (setq done t))
159 (while (and (< inputpos lim) (> remain 0))
160 (setq bits (+ bits
161 (logand
162 (-
163 (uudecode-char-int (char-after inputpos)) 32)
164 63)))
165 (if (/= counter 0) (setq remain (1- remain)))
166 (setq counter (1+ counter)
167 inputpos (1+ inputpos))
168 (cond ((= counter 4)
169 (setq result (cons
170 (concat
171 (char-to-string (lsh bits -16))
172 (char-to-string (logand (lsh bits -8) 255))
173 (char-to-string (logand bits 255)))
174 result))
175 (setq bits 0 counter 0))
176 (t (setq bits (lsh bits 6)))))))
177 (cond
178 (done)
179 ((> 0 remain)
180 (error "uucode line ends unexpectly")
181 (setq done t))
182 ((and (= (point) end) (not done))
183 ;;(error "uucode ends unexpectly")
184 (setq done t))
185 ((= counter 3)
186 (setq result (cons
187 (concat
188 (char-to-string (logand (lsh bits -16) 255))
189 (char-to-string (logand (lsh bits -8) 255)))
190 result)))
191 ((= counter 2)
192 (setq result (cons
193 (char-to-string (logand (lsh bits -10) 255))
194 result))))
195 (skip-chars-forward non-data-chars end))
196 (if file-name
197 (let (default-enable-multibyte-characters)
198 (with-temp-file file-name
199 (insert (apply 'concat (nreverse result)))))
200 (or (markerp end) (setq end (set-marker (make-marker) end)))
147 (goto-char start) 201 (goto-char start)
148 (when (re-search-forward uudecode-begin-line nil t) 202 (insert (apply 'concat (nreverse result)))
149 (cond ((null file-name)) 203 (delete-region (point) end))))))
150 ((stringp file-name)) 204
151 (t 205 ;;;###autoload
152 (setq file-name (expand-file-name 206 (defun uudecode-decode-region (start end &optional file-name)
153 (read-file-name "File to Name:" 207 "Uudecode region between START and END.
154 nil nil nil 208 If FILE-NAME is non-nil, save the result to FILE-NAME."
155 (match-string 1)))))) 209 (if uudecode-use-external
156 (setq work-buffer (generate-new-buffer " *uudecode-work*")) 210 (uudecode-decode-region-external start end file-name)
157 (forward-line 1) 211 (uudecode-decode-region-internal start end file-name)))
158 (skip-chars-forward non-data-chars end)
159 (while (not done)
160 (setq inputpos (point))
161 (setq remain 0 bits 0 counter 0)
162 (cond
163 ((> (skip-chars-forward uudecode-alphabet end) 0)
164 (setq lim (point))
165 (setq remain
166 (logand (- (uudecode-char-int (char-after inputpos)) 32)
167 63))
168 (setq inputpos (1+ inputpos))
169 (if (= remain 0) (setq done t))
170 (while (and (< inputpos lim) (> remain 0))
171 (setq bits (+ bits
172 (logand
173 (-
174 (uudecode-char-int (char-after inputpos)) 32)
175 63)))
176 (if (/= counter 0) (setq remain (1- remain)))
177 (setq counter (1+ counter)
178 inputpos (1+ inputpos))
179 (cond ((= counter 4)
180 (uudecode-insert-char
181 (lsh bits -16) 1 nil work-buffer)
182 (uudecode-insert-char
183 (logand (lsh bits -8) 255) 1 nil work-buffer)
184 (uudecode-insert-char (logand bits 255) 1 nil
185 work-buffer)
186 (setq bits 0 counter 0))
187 (t (setq bits (lsh bits 6)))))))
188 (cond
189 (done)
190 ((> 0 remain)
191 (error "uucode line ends unexpectly")
192 (setq done t))
193 ((and (= (point) end) (not done))
194 ;;(error "uucode ends unexpectly")
195 (setq done t))
196 ((= counter 3)
197 (uudecode-insert-char (logand (lsh bits -16) 255) 1 nil
198 work-buffer)
199 (uudecode-insert-char (logand (lsh bits -8) 255) 1 nil
200 work-buffer))
201 ((= counter 2)
202 (uudecode-insert-char (logand (lsh bits -10) 255) 1 nil
203 work-buffer)))
204 (skip-chars-forward non-data-chars end))
205 (if file-name
206 (save-excursion
207 (set-buffer work-buffer)
208 (write-file file-name))
209 (or (markerp end) (setq end (set-marker (make-marker) end)))
210 (goto-char start)
211 (insert-buffer-substring work-buffer)
212 (delete-region (point) end))))
213 (and work-buffer (kill-buffer work-buffer)))))
214 212
215 (provide 'uudecode) 213 (provide 'uudecode)
216 214
217 ;;; arch-tag: e1f09ed5-62b4-4677-9f13-4e81c4fe8ce3 215 ;;; arch-tag: e1f09ed5-62b4-4677-9f13-4e81c4fe8ce3
218 ;;; uudecode.el ends here 216 ;;; uudecode.el ends here