Commit | Line | Data |
---|---|---|
b0a07187 GM |
1 | ;;; uudecode.el -- elisp native uudecode |
2 | ||
ba318903 | 3 | ;; Copyright (C) 1998-2014 Free Software Foundation, Inc. |
b0a07187 GM |
4 | |
5 | ;; Author: Shenghuo Zhu <zsh@cs.rochester.edu> | |
6 | ;; Keywords: uudecode news | |
7 | ||
8 | ;; This file is part of GNU Emacs. | |
9 | ||
b1fc2b50 | 10 | ;; GNU Emacs is free software: you can redistribute it and/or modify |
b0a07187 | 11 | ;; it under the terms of the GNU General Public License as published by |
b1fc2b50 GM |
12 | ;; the Free Software Foundation, either version 3 of the License, or |
13 | ;; (at your option) any later version. | |
b0a07187 GM |
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 | |
b1fc2b50 | 21 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
b0a07187 GM |
22 | |
23 | ;;; Commentary: | |
24 | ||
25 | ;;; Code: | |
26 | ||
27 | (eval-when-compile (require 'cl)) | |
28 | ||
29 | (eval-and-compile | |
30 | (defalias 'uudecode-char-int | |
31 | (if (fboundp 'char-int) | |
32 | 'char-int | |
33 | 'identity))) | |
34 | ||
1ac4605f GM |
35 | (defgroup uudecode nil |
36 | "Decoding of uuencoded data." | |
37 | :group 'mail | |
38 | :group 'news) | |
39 | ||
b0a07187 | 40 | (defcustom uudecode-decoder-program "uudecode" |
fb7ada5f | 41 | "Non-nil value should be a string that names a uu decoder. |
b0a07187 GM |
42 | The program should expect to read uu data on its standard |
43 | input and write the converted data to its standard output." | |
44 | :type 'string | |
1ac4605f | 45 | :group 'uudecode) |
b0a07187 GM |
46 | |
47 | (defcustom uudecode-decoder-switches nil | |
fb7ada5f | 48 | "List of command line flags passed to `uudecode-decoder-program'." |
1ac4605f | 49 | :group 'uudecode |
b0a07187 GM |
50 | :type '(repeat string)) |
51 | ||
52 | (defcustom uudecode-use-external | |
53 | (executable-find uudecode-decoder-program) | |
fb7ada5f | 54 | "Use external uudecode program." |
b0a07187 | 55 | :version "22.1" |
1ac4605f | 56 | :group 'uudecode |
b0a07187 GM |
57 | :type 'boolean) |
58 | ||
59 | (defconst uudecode-alphabet "\040-\140") | |
60 | ||
61 | (defconst uudecode-begin-line "^begin[ \t]+[0-7][0-7][0-7][ \t]+\\(.*\\)$") | |
62 | (defconst uudecode-end-line "^end[ \t]*$") | |
63 | ||
64 | (defconst uudecode-body-line | |
65 | (let ((i 61) (str "^M")) | |
66 | (while (> (setq i (1- i)) 0) | |
67 | (setq str (concat str "[^a-z]"))) | |
68 | (concat str ".?$"))) | |
69 | ||
70 | (defvar uudecode-temporary-file-directory | |
71 | (cond ((fboundp 'temp-directory) (temp-directory)) | |
72 | ((boundp 'temporary-file-directory) temporary-file-directory) | |
73 | ("/tmp"))) | |
74 | ||
75 | ;;;###autoload | |
76 | (defun uudecode-decode-region-external (start end &optional file-name) | |
77 | "Uudecode region between START and END using external program. | |
78 | If FILE-NAME is non-nil, save the result to FILE-NAME. The program | |
79 | used is specified by `uudecode-decoder-program'." | |
80 | (interactive "r\nP") | |
81 | (let ((cbuf (current-buffer)) tempfile firstline status) | |
82 | (save-excursion | |
83 | (goto-char start) | |
84 | (when (re-search-forward uudecode-begin-line nil t) | |
85 | (forward-line 1) | |
86 | (setq firstline (point)) | |
87 | (cond ((null file-name)) | |
88 | ((stringp file-name)) | |
89 | (t | |
90 | (setq file-name (read-file-name "File to Name:" | |
91 | nil nil nil | |
92 | (match-string 1))))) | |
93 | (setq tempfile (if file-name | |
94 | (expand-file-name file-name) | |
95 | (if (fboundp 'make-temp-file) | |
96 | (let ((temporary-file-directory | |
97 | uudecode-temporary-file-directory)) | |
98 | (make-temp-file "uu")) | |
99 | (expand-file-name | |
100 | (make-temp-name "uu") | |
101 | uudecode-temporary-file-directory)))) | |
102 | (let ((cdir default-directory) | |
103 | (default-process-coding-system | |
104 | (if (featurep 'xemacs) | |
105 | ;; In XEmacs, `nil' is not a valid coding system. | |
106 | '(binary . binary) | |
107 | nil))) | |
108 | (unwind-protect | |
109 | (with-temp-buffer | |
110 | (insert "begin 600 " (file-name-nondirectory tempfile) "\n") | |
111 | (insert-buffer-substring cbuf firstline end) | |
112 | (cd (file-name-directory tempfile)) | |
113 | (apply 'call-process-region | |
114 | (point-min) | |
115 | (point-max) | |
116 | uudecode-decoder-program | |
117 | nil | |
118 | nil | |
119 | nil | |
120 | uudecode-decoder-switches)) | |
121 | (cd cdir) (set-buffer cbuf))) | |
122 | (if (file-exists-p tempfile) | |
123 | (unless file-name | |
124 | (goto-char start) | |
125 | (delete-region start end) | |
126 | (let (format-alist) | |
127 | (insert-file-contents-literally tempfile))) | |
128 | (message "Can not uudecode"))) | |
129 | (ignore-errors (or file-name (delete-file tempfile)))))) | |
130 | ||
131 | (eval-and-compile | |
132 | (defalias 'uudecode-string-to-multibyte | |
133 | (cond | |
134 | ((featurep 'xemacs) | |
135 | 'identity) | |
136 | ((fboundp 'string-to-multibyte) | |
137 | 'string-to-multibyte) | |
138 | (t | |
139 | (lambda (string) | |
140 | "Return a multibyte string with the same individual chars as string." | |
141 | (mapconcat | |
142 | (lambda (ch) (string-as-multibyte (char-to-string ch))) | |
143 | string "")))))) | |
144 | ||
145 | ;;;###autoload | |
146 | (defun uudecode-decode-region-internal (start end &optional file-name) | |
147 | "Uudecode region between START and END without using an external program. | |
148 | If FILE-NAME is non-nil, save the result to FILE-NAME." | |
149 | (interactive "r\nP") | |
150 | (let ((done nil) | |
151 | (counter 0) | |
152 | (remain 0) | |
153 | (bits 0) | |
154 | (lim 0) inputpos result | |
155 | (non-data-chars (concat "^" uudecode-alphabet))) | |
156 | (save-excursion | |
157 | (goto-char start) | |
158 | (when (re-search-forward uudecode-begin-line nil t) | |
159 | (cond ((null file-name)) | |
160 | ((stringp file-name)) | |
161 | (t | |
162 | (setq file-name (expand-file-name | |
163 | (read-file-name "File to Name:" | |
164 | nil nil nil | |
165 | (match-string 1)))))) | |
166 | (forward-line 1) | |
167 | (skip-chars-forward non-data-chars end) | |
168 | (while (not done) | |
169 | (setq inputpos (point)) | |
170 | (setq remain 0 bits 0 counter 0) | |
171 | (cond | |
172 | ((> (skip-chars-forward uudecode-alphabet end) 0) | |
173 | (setq lim (point)) | |
174 | (setq remain | |
175 | (logand (- (uudecode-char-int (char-after inputpos)) 32) | |
176 | 63)) | |
177 | (setq inputpos (1+ inputpos)) | |
178 | (if (= remain 0) (setq done t)) | |
179 | (while (and (< inputpos lim) (> remain 0)) | |
180 | (setq bits (+ bits | |
181 | (logand | |
182 | (- | |
183 | (uudecode-char-int (char-after inputpos)) 32) | |
184 | 63))) | |
185 | (if (/= counter 0) (setq remain (1- remain))) | |
186 | (setq counter (1+ counter) | |
187 | inputpos (1+ inputpos)) | |
188 | (cond ((= counter 4) | |
189 | (setq result (cons | |
190 | (concat | |
191 | (char-to-string (lsh bits -16)) | |
192 | (char-to-string (logand (lsh bits -8) 255)) | |
193 | (char-to-string (logand bits 255))) | |
194 | result)) | |
195 | (setq bits 0 counter 0)) | |
196 | (t (setq bits (lsh bits 6))))))) | |
197 | (cond | |
198 | (done) | |
199 | ((> 0 remain) | |
22bcf204 | 200 | (error "uucode line ends unexpectedly") |
b0a07187 GM |
201 | (setq done t)) |
202 | ((and (= (point) end) (not done)) | |
22bcf204 | 203 | ;;(error "uucode ends unexpectedly") |
b0a07187 GM |
204 | (setq done t)) |
205 | ((= counter 3) | |
206 | (setq result (cons | |
207 | (concat | |
208 | (char-to-string (logand (lsh bits -16) 255)) | |
209 | (char-to-string (logand (lsh bits -8) 255))) | |
210 | result))) | |
211 | ((= counter 2) | |
212 | (setq result (cons | |
213 | (char-to-string (logand (lsh bits -10) 255)) | |
214 | result)))) | |
215 | (skip-chars-forward non-data-chars end)) | |
216 | (if file-name | |
058f4002 | 217 | (with-temp-file file-name |
765d4319 | 218 | (unless (featurep 'xemacs) (set-buffer-multibyte nil)) |
058f4002 | 219 | (insert (apply 'concat (nreverse result)))) |
b0a07187 GM |
220 | (or (markerp end) (setq end (set-marker (make-marker) end))) |
221 | (goto-char start) | |
222 | (if enable-multibyte-characters | |
058f4002 SM |
223 | (dolist (x (nreverse result)) |
224 | (insert (uudecode-string-to-multibyte x))) | |
b0a07187 GM |
225 | (insert (apply 'concat (nreverse result)))) |
226 | (delete-region (point) end)))))) | |
227 | ||
228 | ;;;###autoload | |
229 | (defun uudecode-decode-region (start end &optional file-name) | |
230 | "Uudecode region between START and END. | |
231 | If FILE-NAME is non-nil, save the result to FILE-NAME." | |
232 | (if uudecode-use-external | |
233 | (uudecode-decode-region-external start end file-name) | |
234 | (uudecode-decode-region-internal start end file-name))) | |
235 | ||
236 | (provide 'uudecode) | |
237 | ||
b0a07187 | 238 | ;;; uudecode.el ends here |