Commit | Line | Data |
---|---|---|
715a2ca2 | 1 | ;;; uudecode.el --- elisp native uudecode |
c113de23 GM |
2 | |
3 | ;; Copyright (c) 1998, 1999, 2000 Free Software Foundation, Inc. | |
4 | ||
5 | ;; Author: Shenghuo Zhu <zsh@cs.rochester.edu> | |
6 | ;; Keywords: uudecode news | |
7 | ||
715a2ca2 | 8 | ;; This file is part of GNU Emacs. |
c113de23 GM |
9 | |
10 | ;; GNU Emacs is free software; you can redistribute it and/or modify | |
11 | ;; it under the terms of the GNU General Public License as published by | |
12 | ;; the Free Software Foundation; either version 2, or (at your option) | |
13 | ;; any later version. | |
14 | ||
15 | ;; GNU Emacs is distributed in the hope that it will be useful, | |
16 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
17 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
18 | ;; GNU General Public License for more details. | |
19 | ||
20 | ;; You should have received a copy of the GNU General Public License | |
21 | ;; along with GNU Emacs; see the file COPYING. If not, write to the | |
22 | ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, | |
23 | ;; Boston, MA 02111-1307, USA. | |
24 | ||
25 | ;;; Commentary: | |
26 | ||
27 | ;; Lots of codes are stolen from mm-decode.el, gnus-uu.el and | |
28 | ;; base64.el | |
29 | ||
96403ac1 DL |
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 | |
456d9635 | 34 | |
086ba806 DL |
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 | ||
c113de23 GM |
39 | ;;; Code: |
40 | ||
117b4b78 DL |
41 | (eval-when-compile (require 'cl)) |
42 | ||
05c2a83c DL |
43 | (eval-and-compile |
44 | (defalias 'uudecode-char-int | |
45 | (if (fboundp 'char-int) | |
46 | 'char-int | |
47 | 'identity)) | |
48 | ||
96403ac1 | 49 | (if (featurep 'xemacs) |
05c2a83c DL |
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)))))) | |
c113de23 GM |
56 | |
57 | (defcustom uudecode-decoder-program "uudecode" | |
58 | "*Non-nil value should be a string that names a uu decoder. | |
59 | The program should expect to read uu data on its standard | |
60 | input and write the converted data to its standard output." | |
61 | :type 'string | |
62 | :group 'gnus-extract) | |
63 | ||
64 | (defcustom uudecode-decoder-switches nil | |
65 | "*List of command line flags passed to `uudecode-decoder-program'." | |
66 | :group 'gnus-extract | |
67 | :type '(repeat string)) | |
68 | ||
69 | (defconst uudecode-alphabet "\040-\140") | |
70 | ||
71 | (defconst uudecode-begin-line "^begin[ \t]+[0-7][0-7][0-7][ \t]+\\(.*\\)$") | |
72 | (defconst uudecode-end-line "^end[ \t]*$") | |
73 | ||
74 | (defconst uudecode-body-line | |
75 | (let ((i 61) (str "^M")) | |
76 | (while (> (setq i (1- i)) 0) | |
77 | (setq str (concat str "[^a-z]"))) | |
78 | (concat str ".?$"))) | |
79 | ||
80 | (defvar uudecode-temporary-file-directory | |
81 | (cond ((fboundp 'temp-directory) (temp-directory)) | |
82 | ((boundp 'temporary-file-directory) temporary-file-directory) | |
83 | ("/tmp"))) | |
84 | ||
85 | ;;;###autoload | |
86 | (defun uudecode-decode-region-external (start end &optional file-name) | |
96403ac1 DL |
87 | "Uudecode region between START and END using external program. |
88 | If FILE-NAME is non-nil, save the result to FILE-NAME. The program | |
89 | used is specified by `uudecode-decoder-program'." | |
c113de23 | 90 | (interactive "r\nP") |
96403ac1 | 91 | (let ((cbuf (current-buffer)) tempfile firstline status) |
c113de23 GM |
92 | (save-excursion |
93 | (goto-char start) | |
94 | (when (re-search-forward uudecode-begin-line nil t) | |
95 | (forward-line 1) | |
96 | (setq firstline (point)) | |
97 | (cond ((null file-name)) | |
98 | ((stringp file-name)) | |
99 | (t | |
100 | (setq file-name (read-file-name "File to Name:" | |
101 | nil nil nil | |
102 | (match-string 1))))) | |
103 | (setq tempfile (if file-name | |
104 | (expand-file-name file-name) | |
96403ac1 DL |
105 | (let ((temporary-file-directory |
106 | uudecode-temporary-file-directory)) | |
107 | (make-temp-file "uu")))) | |
108 | (let ((cdir default-directory) | |
109 | default-process-coding-system) | |
c113de23 | 110 | (unwind-protect |
96403ac1 | 111 | (with-temp-buffer |
c113de23 GM |
112 | (insert "begin 600 " (file-name-nondirectory tempfile) "\n") |
113 | (insert-buffer-substring cbuf firstline end) | |
114 | (cd (file-name-directory tempfile)) | |
115 | (apply 'call-process-region | |
116 | (point-min) | |
117 | (point-max) | |
118 | uudecode-decoder-program | |
119 | nil | |
120 | nil | |
121 | nil | |
122 | uudecode-decoder-switches)) | |
123 | (cd cdir) (set-buffer cbuf))) | |
124 | (if (file-exists-p tempfile) | |
125 | (unless file-name | |
126 | (goto-char start) | |
127 | (delete-region start end) | |
128 | (let (format-alist) | |
129 | (insert-file-contents-literally tempfile))) | |
130 | (message "Can not uudecode"))) | |
c113de23 GM |
131 | (ignore-errors (or file-name (delete-file tempfile)))))) |
132 | ||
c113de23 | 133 | ;;;###autoload |
c113de23 | 134 | (defun uudecode-decode-region (start end &optional file-name) |
96403ac1 | 135 | "Uudecode region between START and END without using an external program. |
c113de23 GM |
136 | If FILE-NAME is non-nil, save the result to FILE-NAME." |
137 | (interactive "r\nP") | |
138 | (let ((work-buffer nil) | |
139 | (done nil) | |
140 | (counter 0) | |
141 | (remain 0) | |
142 | (bits 0) | |
143 | (lim 0) inputpos | |
144 | (non-data-chars (concat "^" uudecode-alphabet))) | |
145 | (unwind-protect | |
146 | (save-excursion | |
147 | (goto-char start) | |
148 | (when (re-search-forward uudecode-begin-line nil t) | |
149 | (cond ((null file-name)) | |
150 | ((stringp file-name)) | |
151 | (t | |
152 | (setq file-name (expand-file-name | |
153 | (read-file-name "File to Name:" | |
154 | nil nil nil | |
155 | (match-string 1)))))) | |
156 | (setq work-buffer (generate-new-buffer " *uudecode-work*")) | |
c113de23 GM |
157 | (forward-line 1) |
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 | |
456d9635 DL |
166 | (logand (- (uudecode-char-int (char-after inputpos)) 32) |
167 | 63)) | |
c113de23 GM |
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 | (- | |
456d9635 DL |
174 | (uudecode-char-int (char-after inputpos)) 32) |
175 | 63))) | |
c113de23 GM |
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 | ||
215 | (provide 'uudecode) | |
216 | ||
ab5796a9 | 217 | ;;; arch-tag: e1f09ed5-62b4-4677-9f13-4e81c4fe8ce3 |
c113de23 | 218 | ;;; uudecode.el ends here |