Mercurial > emacs
comparison lisp/gnus/uudecode.el @ 82951:0fde48feb604
Import Gnus 5.10 from the v5_10 branch of the Gnus repository.
author | Andreas Schwab <schwab@suse.de> |
---|---|
date | Thu, 22 Jul 2004 16:45:51 +0000 |
parents | 695cf19ef79e |
children | 497f0d2ca551 cce1c0ee76ee |
comparison
equal
deleted
inserted
replaced
56503:8bbd2323fbf2 | 82951:0fde48feb604 |
---|---|
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 |