Mercurial > emacs
comparison lisp/gnus/uudecode.el @ 31717:6b20b7e85e3c
*** empty log message ***
author | Gerd Moellmann <gerd@gnu.org> |
---|---|
date | Tue, 19 Sep 2000 13:40:08 +0000 |
parents | |
children | 71a0b3b3c21c |
comparison
equal
deleted
inserted
replaced
31716:9968f55ad26e | 31717:6b20b7e85e3c |
---|---|
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 |