1 ;;; uudecode.el -- elisp native uudecode
3 ;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004,
4 ;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
6 ;; Author: Shenghuo Zhu <zsh@cs.rochester.edu>
7 ;; Keywords: uudecode news
9 ;; This file is part of GNU Emacs.
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)
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.
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.
30 (eval-when-compile (require 'cl))
33 (defalias 'uudecode-char-int
34 (if (fboundp 'char-int)
38 (defgroup uudecode nil
39 "Decoding of uuencoded data."
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."
50 (defcustom uudecode-decoder-switches nil
51 "*List of command line flags passed to `uudecode-decoder-program'."
53 :type '(repeat string))
55 (defcustom uudecode-use-external
56 (executable-find uudecode-decoder-program)
57 "*Use external uudecode program."
62 (defconst uudecode-alphabet "\040-\140")
64 (defconst uudecode-begin-line "^begin[ \t]+[0-7][0-7][0-7][ \t]+\\(.*\\)$")
65 (defconst uudecode-end-line "^end[ \t]*$")
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]")))
73 (defvar uudecode-temporary-file-directory
74 (cond ((fboundp 'temp-directory) (temp-directory))
75 ((boundp 'temporary-file-directory) temporary-file-directory)
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'."
84 (let ((cbuf (current-buffer)) tempfile firstline status)
87 (when (re-search-forward uudecode-begin-line nil t)
89 (setq firstline (point))
90 (cond ((null file-name))
93 (setq file-name (read-file-name "File to Name:"
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"))
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.
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
119 uudecode-decoder-program
123 uudecode-decoder-switches))
124 (cd cdir) (set-buffer cbuf)))
125 (if (file-exists-p tempfile)
128 (delete-region start end)
130 (insert-file-contents-literally tempfile)))
131 (message "Can not uudecode")))
132 (ignore-errors (or file-name (delete-file tempfile))))))
135 (defalias 'uudecode-string-to-multibyte
139 ((fboundp 'string-to-multibyte)
140 'string-to-multibyte)
143 "Return a multibyte string with the same individual chars as string."
145 (lambda (ch) (string-as-multibyte (char-to-string ch)))
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."
157 (lim 0) inputpos result
158 (non-data-chars (concat "^" uudecode-alphabet)))
161 (when (re-search-forward uudecode-begin-line nil t)
162 (cond ((null file-name))
163 ((stringp file-name))
165 (setq file-name (expand-file-name
166 (read-file-name "File to Name:"
168 (match-string 1))))))
170 (skip-chars-forward non-data-chars end)
172 (setq inputpos (point))
173 (setq remain 0 bits 0 counter 0)
175 ((> (skip-chars-forward uudecode-alphabet end) 0)
178 (logand (- (uudecode-char-int (char-after inputpos)) 32)
180 (setq inputpos (1+ inputpos))
181 (if (= remain 0) (setq done t))
182 (while (and (< inputpos lim) (> remain 0))
186 (uudecode-char-int (char-after inputpos)) 32)
188 (if (/= counter 0) (setq remain (1- remain)))
189 (setq counter (1+ counter)
190 inputpos (1+ inputpos))
194 (char-to-string (lsh bits -16))
195 (char-to-string (logand (lsh bits -8) 255))
196 (char-to-string (logand bits 255)))
198 (setq bits 0 counter 0))
199 (t (setq bits (lsh bits 6)))))))
203 (error "uucode line ends unexpectly")
205 ((and (= (point) end) (not done))
206 ;;(error "uucode ends unexpectly")
211 (char-to-string (logand (lsh bits -16) 255))
212 (char-to-string (logand (lsh bits -8) 255)))
216 (char-to-string (logand (lsh bits -10) 255))
218 (skip-chars-forward non-data-chars end))
220 (let (default-enable-multibyte-characters)
221 (with-temp-file file-name
222 (insert (apply 'concat (nreverse result)))))
223 (or (markerp end) (setq end (set-marker (make-marker) end)))
225 (if enable-multibyte-characters
226 (mapc #'(lambda (x) (insert (uudecode-string-to-multibyte x)))
228 (insert (apply 'concat (nreverse result))))
229 (delete-region (point) end))))))
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)))
241 ;;; arch-tag: e1f09ed5-62b4-4677-9f13-4e81c4fe8ce3
242 ;;; uudecode.el ends here