|
31717
|
1 ;;; uudecode.el -- elisp native uudecode
|
|
|
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
|
|
|
8 ;; This file is a part of GNU Emacs.
|
|
|
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
|
|
|
30 ;;; Code:
|
|
|
31
|
|
|
32 (if (not (fboundp 'char-int))
|
|
|
33 (defalias 'char-int 'identity))
|
|
|
34
|
|
|
35 (defcustom uudecode-decoder-program "uudecode"
|
|
|
36 "*Non-nil value should be a string that names a uu decoder.
|
|
|
37 The program should expect to read uu data on its standard
|
|
|
38 input and write the converted data to its standard output."
|
|
|
39 :type 'string
|
|
|
40 :group 'gnus-extract)
|
|
|
41
|
|
|
42 (defcustom uudecode-decoder-switches nil
|
|
|
43 "*List of command line flags passed to `uudecode-decoder-program'."
|
|
|
44 :group 'gnus-extract
|
|
|
45 :type '(repeat string))
|
|
|
46
|
|
|
47 (defconst uudecode-alphabet "\040-\140")
|
|
|
48
|
|
|
49 (defconst uudecode-begin-line "^begin[ \t]+[0-7][0-7][0-7][ \t]+\\(.*\\)$")
|
|
|
50 (defconst uudecode-end-line "^end[ \t]*$")
|
|
|
51
|
|
|
52 (defconst uudecode-body-line
|
|
|
53 (let ((i 61) (str "^M"))
|
|
|
54 (while (> (setq i (1- i)) 0)
|
|
|
55 (setq str (concat str "[^a-z]")))
|
|
|
56 (concat str ".?$")))
|
|
|
57
|
|
|
58 (defvar uudecode-temporary-file-directory
|
|
|
59 (cond ((fboundp 'temp-directory) (temp-directory))
|
|
|
60 ((boundp 'temporary-file-directory) temporary-file-directory)
|
|
|
61 ("/tmp")))
|
|
|
62
|
|
|
63 ;;;###autoload
|
|
|
64 (defun uudecode-decode-region-external (start end &optional file-name)
|
|
|
65 "Uudecode region between START and END with external decoder.
|
|
|
66
|
|
|
67 If FILE-NAME is non-nil, save the result to FILE-NAME."
|
|
|
68 (interactive "r\nP")
|
|
|
69 (let ((cbuf (current-buffer)) tempfile firstline work-buffer status)
|
|
|
70 (save-excursion
|
|
|
71 (goto-char start)
|
|
|
72 (when (re-search-forward uudecode-begin-line nil t)
|
|
|
73 (forward-line 1)
|
|
|
74 (setq firstline (point))
|
|
|
75 (cond ((null file-name))
|
|
|
76 ((stringp file-name))
|
|
|
77 (t
|
|
|
78 (setq file-name (read-file-name "File to Name:"
|
|
|
79 nil nil nil
|
|
|
80 (match-string 1)))))
|
|
|
81 (setq tempfile (if file-name
|
|
|
82 (expand-file-name file-name)
|
|
|
83 (make-temp-name
|
|
|
84 ;; /tmp/uu...
|
|
|
85 (expand-file-name
|
|
|
86 "uu" uudecode-temporary-file-directory))))
|
|
|
87 (let ((cdir default-directory) default-process-coding-system)
|
|
|
88 (unwind-protect
|
|
|
89 (progn
|
|
|
90 (set-buffer (setq work-buffer
|
|
|
91 (generate-new-buffer " *uudecode-work*")))
|
|
|
92 (buffer-disable-undo work-buffer)
|
|
|
93 (insert "begin 600 " (file-name-nondirectory tempfile) "\n")
|
|
|
94 (insert-buffer-substring cbuf firstline end)
|
|
|
95 (cd (file-name-directory tempfile))
|
|
|
96 (apply 'call-process-region
|
|
|
97 (point-min)
|
|
|
98 (point-max)
|
|
|
99 uudecode-decoder-program
|
|
|
100 nil
|
|
|
101 nil
|
|
|
102 nil
|
|
|
103 uudecode-decoder-switches))
|
|
|
104 (cd cdir) (set-buffer cbuf)))
|
|
|
105 (if (file-exists-p tempfile)
|
|
|
106 (unless file-name
|
|
|
107 (goto-char start)
|
|
|
108 (delete-region start end)
|
|
|
109 (let (format-alist)
|
|
|
110 (insert-file-contents-literally tempfile)))
|
|
|
111 (message "Can not uudecode")))
|
|
|
112 (and work-buffer (kill-buffer work-buffer))
|
|
|
113 (ignore-errors (or file-name (delete-file tempfile))))))
|
|
|
114
|
|
|
115 (if (string-match "XEmacs" emacs-version)
|
|
|
116 (defalias 'uudecode-insert-char 'insert-char)
|
|
|
117 (defun uudecode-insert-char (char &optional count ignored buffer)
|
|
|
118 (if (or (null buffer) (eq buffer (current-buffer)))
|
|
|
119 (insert-char char count)
|
|
|
120 (with-current-buffer buffer
|
|
|
121 (insert-char char count)))))
|
|
|
122
|
|
|
123 ;;;###autoload
|
|
|
124
|
|
|
125 (defun uudecode-decode-region (start end &optional file-name)
|
|
|
126 "Uudecode region between START and END.
|
|
|
127 If FILE-NAME is non-nil, save the result to FILE-NAME."
|
|
|
128 (interactive "r\nP")
|
|
|
129 (let ((work-buffer nil)
|
|
|
130 (done nil)
|
|
|
131 (counter 0)
|
|
|
132 (remain 0)
|
|
|
133 (bits 0)
|
|
|
134 (lim 0) inputpos
|
|
|
135 (non-data-chars (concat "^" uudecode-alphabet)))
|
|
|
136 (unwind-protect
|
|
|
137 (save-excursion
|
|
|
138 (goto-char start)
|
|
|
139 (when (re-search-forward uudecode-begin-line nil t)
|
|
|
140 (cond ((null file-name))
|
|
|
141 ((stringp file-name))
|
|
|
142 (t
|
|
|
143 (setq file-name (expand-file-name
|
|
|
144 (read-file-name "File to Name:"
|
|
|
145 nil nil nil
|
|
|
146 (match-string 1))))))
|
|
|
147 (setq work-buffer (generate-new-buffer " *uudecode-work*"))
|
|
|
148 (buffer-disable-undo work-buffer)
|
|
|
149 (forward-line 1)
|
|
|
150 (skip-chars-forward non-data-chars end)
|
|
|
151 (while (not done)
|
|
|
152 (setq inputpos (point))
|
|
|
153 (setq remain 0 bits 0 counter 0)
|
|
|
154 (cond
|
|
|
155 ((> (skip-chars-forward uudecode-alphabet end) 0)
|
|
|
156 (setq lim (point))
|
|
|
157 (setq remain
|
|
|
158 (logand (- (char-int (char-after inputpos)) 32) 63))
|
|
|
159 (setq inputpos (1+ inputpos))
|
|
|
160 (if (= remain 0) (setq done t))
|
|
|
161 (while (and (< inputpos lim) (> remain 0))
|
|
|
162 (setq bits (+ bits
|
|
|
163 (logand
|
|
|
164 (-
|
|
|
165 (char-int (char-after inputpos)) 32) 63)))
|
|
|
166 (if (/= counter 0) (setq remain (1- remain)))
|
|
|
167 (setq counter (1+ counter)
|
|
|
168 inputpos (1+ inputpos))
|
|
|
169 (cond ((= counter 4)
|
|
|
170 (uudecode-insert-char
|
|
|
171 (lsh bits -16) 1 nil work-buffer)
|
|
|
172 (uudecode-insert-char
|
|
|
173 (logand (lsh bits -8) 255) 1 nil work-buffer)
|
|
|
174 (uudecode-insert-char (logand bits 255) 1 nil
|
|
|
175 work-buffer)
|
|
|
176 (setq bits 0 counter 0))
|
|
|
177 (t (setq bits (lsh bits 6)))))))
|
|
|
178 (cond
|
|
|
179 (done)
|
|
|
180 ((> 0 remain)
|
|
|
181 (error "uucode line ends unexpectly")
|
|
|
182 (setq done t))
|
|
|
183 ((and (= (point) end) (not done))
|
|
|
184 ;;(error "uucode ends unexpectly")
|
|
|
185 (setq done t))
|
|
|
186 ((= counter 3)
|
|
|
187 (uudecode-insert-char (logand (lsh bits -16) 255) 1 nil
|
|
|
188 work-buffer)
|
|
|
189 (uudecode-insert-char (logand (lsh bits -8) 255) 1 nil
|
|
|
190 work-buffer))
|
|
|
191 ((= counter 2)
|
|
|
192 (uudecode-insert-char (logand (lsh bits -10) 255) 1 nil
|
|
|
193 work-buffer)))
|
|
|
194 (skip-chars-forward non-data-chars end))
|
|
|
195 (if file-name
|
|
|
196 (save-excursion
|
|
|
197 (set-buffer work-buffer)
|
|
|
198 (write-file file-name))
|
|
|
199 (or (markerp end) (setq end (set-marker (make-marker) end)))
|
|
|
200 (goto-char start)
|
|
|
201 (insert-buffer-substring work-buffer)
|
|
|
202 (delete-region (point) end))))
|
|
|
203 (and work-buffer (kill-buffer work-buffer)))))
|
|
|
204
|
|
|
205 (provide 'uudecode)
|
|
|
206
|
|
|
207 ;;; uudecode.el ends here
|
