Add arch taglines
[bpt/emacs.git] / lisp / gnus / uudecode.el
CommitLineData
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.
59The program should expect to read uu data on its standard
60input 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.
88If FILE-NAME is non-nil, save the result to FILE-NAME. The program
89used 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
136If 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