1 |
;;; uudecode.el --- elisp native uudecode |
;;; uudecode.el -- elisp native uudecode |
2 |
|
|
3 |
;; Copyright (c) 1998, 1999, 2000 Free Software Foundation, Inc. |
;; Copyright (c) 1998, 1999, 2000, 2001, 2003 Free Software Foundation, Inc. |
4 |
|
|
5 |
;; Author: Shenghuo Zhu <zsh@cs.rochester.edu> |
;; Author: Shenghuo Zhu <zsh@cs.rochester.edu> |
6 |
;; Keywords: uudecode news |
;; Keywords: uudecode news |
24 |
|
|
25 |
;;; Commentary: |
;;; Commentary: |
26 |
|
|
|
;; Lots of codes are stolen from mm-decode.el, gnus-uu.el and |
|
|
;; base64.el |
|
|
|
|
|
;; This looks as though it could be made rather more efficient for |
|
|
;; internal working. Encoding could use a lookup table and decoding |
|
|
;; should presumably use a vector or list buffer for partial results |
|
|
;; rather than with-current-buffer. -- fx |
|
|
|
|
|
;; Only `uudecode-decode-region' should be advertised, and whether or |
|
|
;; not that uses a program should be customizable, but I guess it's |
|
|
;; too late now. -- fx |
|
|
|
|
27 |
;;; Code: |
;;; Code: |
28 |
|
|
29 |
|
(autoload 'executable-find "executable") |
30 |
|
|
31 |
(eval-when-compile (require 'cl)) |
(eval-when-compile (require 'cl)) |
32 |
|
|
33 |
(eval-and-compile |
(eval-and-compile |
34 |
(defalias 'uudecode-char-int |
(defalias 'uudecode-char-int |
35 |
(if (fboundp 'char-int) |
(if (fboundp 'char-int) |
36 |
'char-int |
'char-int |
37 |
'identity)) |
'identity))) |
|
|
|
|
(if (featurep 'xemacs) |
|
|
(defalias 'uudecode-insert-char 'insert-char) |
|
|
(defun uudecode-insert-char (char &optional count ignored buffer) |
|
|
(if (or (null buffer) (eq buffer (current-buffer))) |
|
|
(insert-char char count) |
|
|
(with-current-buffer buffer |
|
|
(insert-char char count)))))) |
|
38 |
|
|
39 |
(defcustom uudecode-decoder-program "uudecode" |
(defcustom uudecode-decoder-program "uudecode" |
40 |
"*Non-nil value should be a string that names a uu decoder. |
"*Non-nil value should be a string that names a uu decoder. |
48 |
:group 'gnus-extract |
:group 'gnus-extract |
49 |
:type '(repeat string)) |
: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) |
56 |
|
|
57 |
(defconst uudecode-alphabet "\040-\140") |
(defconst uudecode-alphabet "\040-\140") |
58 |
|
|
59 |
(defconst uudecode-begin-line "^begin[ \t]+[0-7][0-7][0-7][ \t]+\\(.*\\)$") |
(defconst uudecode-begin-line "^begin[ \t]+[0-7][0-7][0-7][ \t]+\\(.*\\)$") |
90 |
(match-string 1))))) |
(match-string 1))))) |
91 |
(setq tempfile (if file-name |
(setq tempfile (if file-name |
92 |
(expand-file-name file-name) |
(expand-file-name file-name) |
93 |
(let ((temporary-file-directory |
(if (fboundp 'make-temp-file) |
94 |
uudecode-temporary-file-directory)) |
(let ((temporary-file-directory |
95 |
(make-temp-file "uu")))) |
uudecode-temporary-file-directory)) |
96 |
|
(make-temp-file "uu")) |
97 |
|
(expand-file-name |
98 |
|
(make-temp-name "uu") |
99 |
|
uudecode-temporary-file-directory)))) |
100 |
(let ((cdir default-directory) |
(let ((cdir default-directory) |
101 |
default-process-coding-system) |
default-process-coding-system) |
102 |
(unwind-protect |
(unwind-protect |
123 |
(ignore-errors (or file-name (delete-file tempfile)))))) |
(ignore-errors (or file-name (delete-file tempfile)))))) |
124 |
|
|
125 |
;;;###autoload |
;;;###autoload |
126 |
(defun uudecode-decode-region (start end &optional file-name) |
(defun uudecode-decode-region-internal (start end &optional file-name) |
127 |
"Uudecode region between START and END without using an external program. |
"Uudecode region between START and END without using an external program. |
128 |
If FILE-NAME is non-nil, save the result to FILE-NAME." |
If FILE-NAME is non-nil, save the result to FILE-NAME." |
129 |
(interactive "r\nP") |
(interactive "r\nP") |
130 |
(let ((work-buffer nil) |
(let ((done nil) |
|
(done nil) |
|
131 |
(counter 0) |
(counter 0) |
132 |
(remain 0) |
(remain 0) |
133 |
(bits 0) |
(bits 0) |
134 |
(lim 0) inputpos |
(lim 0) inputpos result |
135 |
(non-data-chars (concat "^" uudecode-alphabet))) |
(non-data-chars (concat "^" uudecode-alphabet))) |
136 |
(unwind-protect |
(save-excursion |
137 |
(save-excursion |
(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))) |
201 |
(goto-char start) |
(goto-char start) |
202 |
(when (re-search-forward uudecode-begin-line nil t) |
(insert (apply 'concat (nreverse result))) |
203 |
(cond ((null file-name)) |
(delete-region (point) end)))))) |
204 |
((stringp file-name)) |
|
205 |
(t |
;;;###autoload |
206 |
(setq file-name (expand-file-name |
(defun uudecode-decode-region (start end &optional file-name) |
207 |
(read-file-name "File to Name:" |
"Uudecode region between START and END. |
208 |
nil nil nil |
If FILE-NAME is non-nil, save the result to FILE-NAME." |
209 |
(match-string 1)))))) |
(if uudecode-use-external |
210 |
(setq work-buffer (generate-new-buffer " *uudecode-work*")) |
(uudecode-decode-region-external start end file-name) |
211 |
(forward-line 1) |
(uudecode-decode-region-internal start end file-name))) |
|
(skip-chars-forward non-data-chars end) |
|
|
(while (not done) |
|
|
(setq inputpos (point)) |
|
|
(setq remain 0 bits 0 counter 0) |
|
|
(cond |
|
|
((> (skip-chars-forward uudecode-alphabet end) 0) |
|
|
(setq lim (point)) |
|
|
(setq remain |
|
|
(logand (- (uudecode-char-int (char-after inputpos)) 32) |
|
|
63)) |
|
|
(setq inputpos (1+ inputpos)) |
|
|
(if (= remain 0) (setq done t)) |
|
|
(while (and (< inputpos lim) (> remain 0)) |
|
|
(setq bits (+ bits |
|
|
(logand |
|
|
(- |
|
|
(uudecode-char-int (char-after inputpos)) 32) |
|
|
63))) |
|
|
(if (/= counter 0) (setq remain (1- remain))) |
|
|
(setq counter (1+ counter) |
|
|
inputpos (1+ inputpos)) |
|
|
(cond ((= counter 4) |
|
|
(uudecode-insert-char |
|
|
(lsh bits -16) 1 nil work-buffer) |
|
|
(uudecode-insert-char |
|
|
(logand (lsh bits -8) 255) 1 nil work-buffer) |
|
|
(uudecode-insert-char (logand bits 255) 1 nil |
|
|
work-buffer) |
|
|
(setq bits 0 counter 0)) |
|
|
(t (setq bits (lsh bits 6))))))) |
|
|
(cond |
|
|
(done) |
|
|
((> 0 remain) |
|
|
(error "uucode line ends unexpectly") |
|
|
(setq done t)) |
|
|
((and (= (point) end) (not done)) |
|
|
;;(error "uucode ends unexpectly") |
|
|
(setq done t)) |
|
|
((= counter 3) |
|
|
(uudecode-insert-char (logand (lsh bits -16) 255) 1 nil |
|
|
work-buffer) |
|
|
(uudecode-insert-char (logand (lsh bits -8) 255) 1 nil |
|
|
work-buffer)) |
|
|
((= counter 2) |
|
|
(uudecode-insert-char (logand (lsh bits -10) 255) 1 nil |
|
|
work-buffer))) |
|
|
(skip-chars-forward non-data-chars end)) |
|
|
(if file-name |
|
|
(save-excursion |
|
|
(set-buffer work-buffer) |
|
|
(write-file file-name)) |
|
|
(or (markerp end) (setq end (set-marker (make-marker) end))) |
|
|
(goto-char start) |
|
|
(insert-buffer-substring work-buffer) |
|
|
(delete-region (point) end)))) |
|
|
(and work-buffer (kill-buffer work-buffer))))) |
|
212 |
|
|
213 |
(provide 'uudecode) |
(provide 'uudecode) |
214 |
|
|