Mercurial > emacs
annotate lisp/mail/uudecode.el @ 93866:1f769203aa6c
*** empty log message ***
author | Juanma Barranquero <lekktu@gmail.com> |
---|---|
date | Tue, 08 Apr 2008 14:57:02 +0000 |
parents | b643f53a57c5 |
children | ef65fa4dca3b |
rev | line source |
---|---|
86959 | 1 ;;; uudecode.el -- elisp native uudecode |
2 | |
3 ;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, | |
87649 | 4 ;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc. |
86959 | 5 |
6 ;; Author: Shenghuo Zhu <zsh@cs.rochester.edu> | |
7 ;; Keywords: uudecode news | |
8 | |
9 ;; This file is part of GNU Emacs. | |
10 | |
11 ;; GNU Emacs is free software; you can redistribute it and/or modify | |
12 ;; it under the terms of the GNU General Public License as published by | |
13 ;; the Free Software Foundation; either version 3, or (at your option) | |
14 ;; any later version. | |
15 | |
16 ;; GNU Emacs is distributed in the hope that it will be useful, | |
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
19 ;; GNU General Public License for more details. | |
20 | |
21 ;; You should have received a copy of the GNU General Public License | |
22 ;; along with GNU Emacs; see the file COPYING. If not, write to the | |
23 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, | |
24 ;; Boston, MA 02110-1301, USA. | |
25 | |
26 ;;; Commentary: | |
27 | |
28 ;;; Code: | |
29 | |
30 (eval-when-compile (require 'cl)) | |
31 | |
32 (eval-and-compile | |
33 (defalias 'uudecode-char-int | |
34 (if (fboundp 'char-int) | |
35 'char-int | |
36 'identity))) | |
37 | |
86962 | 38 (defgroup uudecode nil |
39 "Decoding of uuencoded data." | |
40 :group 'mail | |
41 :group 'news) | |
42 | |
86959 | 43 (defcustom uudecode-decoder-program "uudecode" |
44 "*Non-nil value should be a string that names a uu decoder. | |
45 The program should expect to read uu data on its standard | |
46 input and write the converted data to its standard output." | |
47 :type 'string | |
86962 | 48 :group 'uudecode) |
86959 | 49 |
50 (defcustom uudecode-decoder-switches nil | |
51 "*List of command line flags passed to `uudecode-decoder-program'." | |
86962 | 52 :group 'uudecode |
86959 | 53 :type '(repeat string)) |
54 | |
55 (defcustom uudecode-use-external | |
56 (executable-find uudecode-decoder-program) | |
57 "*Use external uudecode program." | |
58 :version "22.1" | |
86962 | 59 :group 'uudecode |
86959 | 60 :type 'boolean) |
61 | |
62 (defconst uudecode-alphabet "\040-\140") | |
63 | |
64 (defconst uudecode-begin-line "^begin[ \t]+[0-7][0-7][0-7][ \t]+\\(.*\\)$") | |
65 (defconst uudecode-end-line "^end[ \t]*$") | |
66 | |
67 (defconst uudecode-body-line | |
68 (let ((i 61) (str "^M")) | |
69 (while (> (setq i (1- i)) 0) | |
70 (setq str (concat str "[^a-z]"))) | |
71 (concat str ".?$"))) | |
72 | |
73 (defvar uudecode-temporary-file-directory | |
74 (cond ((fboundp 'temp-directory) (temp-directory)) | |
75 ((boundp 'temporary-file-directory) temporary-file-directory) | |
76 ("/tmp"))) | |
77 | |
78 ;;;###autoload | |
79 (defun uudecode-decode-region-external (start end &optional file-name) | |
80 "Uudecode region between START and END using external program. | |
81 If FILE-NAME is non-nil, save the result to FILE-NAME. The program | |
82 used is specified by `uudecode-decoder-program'." | |
83 (interactive "r\nP") | |
84 (let ((cbuf (current-buffer)) tempfile firstline status) | |
85 (save-excursion | |
86 (goto-char start) | |
87 (when (re-search-forward uudecode-begin-line nil t) | |
88 (forward-line 1) | |
89 (setq firstline (point)) | |
90 (cond ((null file-name)) | |
91 ((stringp file-name)) | |
92 (t | |
93 (setq file-name (read-file-name "File to Name:" | |
94 nil nil nil | |
95 (match-string 1))))) | |
96 (setq tempfile (if file-name | |
97 (expand-file-name file-name) | |
98 (if (fboundp 'make-temp-file) | |
99 (let ((temporary-file-directory | |
100 uudecode-temporary-file-directory)) | |
101 (make-temp-file "uu")) | |
102 (expand-file-name | |
103 (make-temp-name "uu") | |
104 uudecode-temporary-file-directory)))) | |
105 (let ((cdir default-directory) | |
106 (default-process-coding-system | |
107 (if (featurep 'xemacs) | |
108 ;; In XEmacs, `nil' is not a valid coding system. | |
109 '(binary . binary) | |
110 nil))) | |
111 (unwind-protect | |
112 (with-temp-buffer | |
113 (insert "begin 600 " (file-name-nondirectory tempfile) "\n") | |
114 (insert-buffer-substring cbuf firstline end) | |
115 (cd (file-name-directory tempfile)) | |
116 (apply 'call-process-region | |
117 (point-min) | |
118 (point-max) | |
119 uudecode-decoder-program | |
120 nil | |
121 nil | |
122 nil | |
123 uudecode-decoder-switches)) | |
124 (cd cdir) (set-buffer cbuf))) | |
125 (if (file-exists-p tempfile) | |
126 (unless file-name | |
127 (goto-char start) | |
128 (delete-region start end) | |
129 (let (format-alist) | |
130 (insert-file-contents-literally tempfile))) | |
131 (message "Can not uudecode"))) | |
132 (ignore-errors (or file-name (delete-file tempfile)))))) | |
133 | |
134 (eval-and-compile | |
135 (defalias 'uudecode-string-to-multibyte | |
136 (cond | |
137 ((featurep 'xemacs) | |
138 'identity) | |
139 ((fboundp 'string-to-multibyte) | |
140 'string-to-multibyte) | |
141 (t | |
142 (lambda (string) | |
143 "Return a multibyte string with the same individual chars as string." | |
144 (mapconcat | |
145 (lambda (ch) (string-as-multibyte (char-to-string ch))) | |
146 string "")))))) | |
147 | |
148 ;;;###autoload | |
149 (defun uudecode-decode-region-internal (start end &optional file-name) | |
150 "Uudecode region between START and END without using an external program. | |
151 If FILE-NAME is non-nil, save the result to FILE-NAME." | |
152 (interactive "r\nP") | |
153 (let ((done nil) | |
154 (counter 0) | |
155 (remain 0) | |
156 (bits 0) | |
157 (lim 0) inputpos result | |
158 (non-data-chars (concat "^" uudecode-alphabet))) | |
159 (save-excursion | |
160 (goto-char start) | |
161 (when (re-search-forward uudecode-begin-line nil t) | |
162 (cond ((null file-name)) | |
163 ((stringp file-name)) | |
164 (t | |
165 (setq file-name (expand-file-name | |
166 (read-file-name "File to Name:" | |
167 nil nil nil | |
168 (match-string 1)))))) | |
169 (forward-line 1) | |
170 (skip-chars-forward non-data-chars end) | |
171 (while (not done) | |
172 (setq inputpos (point)) | |
173 (setq remain 0 bits 0 counter 0) | |
174 (cond | |
175 ((> (skip-chars-forward uudecode-alphabet end) 0) | |
176 (setq lim (point)) | |
177 (setq remain | |
178 (logand (- (uudecode-char-int (char-after inputpos)) 32) | |
179 63)) | |
180 (setq inputpos (1+ inputpos)) | |
181 (if (= remain 0) (setq done t)) | |
182 (while (and (< inputpos lim) (> remain 0)) | |
183 (setq bits (+ bits | |
184 (logand | |
185 (- | |
186 (uudecode-char-int (char-after inputpos)) 32) | |
187 63))) | |
188 (if (/= counter 0) (setq remain (1- remain))) | |
189 (setq counter (1+ counter) | |
190 inputpos (1+ inputpos)) | |
191 (cond ((= counter 4) | |
192 (setq result (cons | |
193 (concat | |
194 (char-to-string (lsh bits -16)) | |
195 (char-to-string (logand (lsh bits -8) 255)) | |
196 (char-to-string (logand bits 255))) | |
197 result)) | |
198 (setq bits 0 counter 0)) | |
199 (t (setq bits (lsh bits 6))))))) | |
200 (cond | |
201 (done) | |
202 ((> 0 remain) | |
203 (error "uucode line ends unexpectly") | |
204 (setq done t)) | |
205 ((and (= (point) end) (not done)) | |
206 ;;(error "uucode ends unexpectly") | |
207 (setq done t)) | |
208 ((= counter 3) | |
209 (setq result (cons | |
210 (concat | |
211 (char-to-string (logand (lsh bits -16) 255)) | |
212 (char-to-string (logand (lsh bits -8) 255))) | |
213 result))) | |
214 ((= counter 2) | |
215 (setq result (cons | |
216 (char-to-string (logand (lsh bits -10) 255)) | |
217 result)))) | |
218 (skip-chars-forward non-data-chars end)) | |
219 (if file-name | |
92782
b643f53a57c5
(uudecode-decode-region-internal): Use set-buffer-multibyte rather than
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
87649
diff
changeset
|
220 (with-temp-file file-name |
b643f53a57c5
(uudecode-decode-region-internal): Use set-buffer-multibyte rather than
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
87649
diff
changeset
|
221 (set-buffer-multibyte nil) |
b643f53a57c5
(uudecode-decode-region-internal): Use set-buffer-multibyte rather than
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
87649
diff
changeset
|
222 (insert (apply 'concat (nreverse result)))) |
86959 | 223 (or (markerp end) (setq end (set-marker (make-marker) end))) |
224 (goto-char start) | |
225 (if enable-multibyte-characters | |
92782
b643f53a57c5
(uudecode-decode-region-internal): Use set-buffer-multibyte rather than
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
87649
diff
changeset
|
226 (dolist (x (nreverse result)) |
b643f53a57c5
(uudecode-decode-region-internal): Use set-buffer-multibyte rather than
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
87649
diff
changeset
|
227 (insert (uudecode-string-to-multibyte x))) |
86959 | 228 (insert (apply 'concat (nreverse result)))) |
229 (delete-region (point) end)))))) | |
230 | |
231 ;;;###autoload | |
232 (defun uudecode-decode-region (start end &optional file-name) | |
233 "Uudecode region between START and END. | |
234 If FILE-NAME is non-nil, save the result to FILE-NAME." | |
235 (if uudecode-use-external | |
236 (uudecode-decode-region-external start end file-name) | |
237 (uudecode-decode-region-internal start end file-name))) | |
238 | |
239 (provide 'uudecode) | |
240 | |
92782
b643f53a57c5
(uudecode-decode-region-internal): Use set-buffer-multibyte rather than
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
87649
diff
changeset
|
241 ;; arch-tag: e1f09ed5-62b4-4677-9f13-4e81c4fe8ce3 |
86959 | 242 ;;; uudecode.el ends here |