1 ;;; uudecode.el -- elisp native uudecode
3 ;; Copyright (C) 1998-2014 Free Software Foundation, Inc.
5 ;; Author: Shenghuo Zhu <zsh@cs.rochester.edu>
6 ;; Keywords: uudecode news
8 ;; This file is part of GNU Emacs.
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 3 of the License, or
13 ;; (at your option) any later version.
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.
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
27 (eval-when-compile (require 'cl))
30 (defalias 'uudecode-char-int
31 (if (fboundp 'char-int)
35 (defgroup uudecode nil
36 "Decoding of uuencoded data."
40 (defcustom uudecode-decoder-program "uudecode"
41 "Non-nil value should be a string that names a uu decoder.
42 The program should expect to read uu data on its standard
43 input and write the converted data to its standard output."
47 (defcustom uudecode-decoder-switches nil
48 "List of command line flags passed to `uudecode-decoder-program'."
50 :type '(repeat string))
52 (defcustom uudecode-use-external
53 (executable-find uudecode-decoder-program)
54 "Use external uudecode program."
59 (defconst uudecode-alphabet "\040-\140")
61 (defconst uudecode-begin-line "^begin[ \t]+[0-7][0-7][0-7][ \t]+\\(.*\\)$")
62 (defconst uudecode-end-line "^end[ \t]*$")
64 (defconst uudecode-body-line
65 (let ((i 61) (str "^M"))
66 (while (> (setq i (1- i)) 0)
67 (setq str (concat str "[^a-z]")))
70 (defvar uudecode-temporary-file-directory
71 (cond ((fboundp 'temp-directory) (temp-directory))
72 ((boundp 'temporary-file-directory) temporary-file-directory)
76 (defun uudecode-decode-region-external (start end &optional file-name)
77 "Uudecode region between START and END using external program.
78 If FILE-NAME is non-nil, save the result to FILE-NAME. The program
79 used is specified by `uudecode-decoder-program'."
81 (let ((cbuf (current-buffer)) tempfile firstline status)
84 (when (re-search-forward uudecode-begin-line nil t)
86 (setq firstline (point))
87 (cond ((null file-name))
90 (setq file-name (read-file-name "File to Name:"
93 (setq tempfile (if file-name
94 (expand-file-name file-name)
95 (if (fboundp 'make-temp-file)
96 (let ((temporary-file-directory
97 uudecode-temporary-file-directory))
98 (make-temp-file "uu"))
100 (make-temp-name "uu")
101 uudecode-temporary-file-directory))))
102 (let ((cdir default-directory)
103 (default-process-coding-system
104 (if (featurep 'xemacs)
105 ;; In XEmacs, `nil' is not a valid coding system.
110 (insert "begin 600 " (file-name-nondirectory tempfile) "\n")
111 (insert-buffer-substring cbuf firstline end)
112 (cd (file-name-directory tempfile))
113 (apply 'call-process-region
116 uudecode-decoder-program
120 uudecode-decoder-switches))
121 (cd cdir) (set-buffer cbuf)))
122 (if (file-exists-p tempfile)
125 (delete-region start end)
127 (insert-file-contents-literally tempfile)))
128 (message "Can not uudecode")))
129 (ignore-errors (or file-name (delete-file tempfile))))))
132 (defalias 'uudecode-string-to-multibyte
136 ((fboundp 'string-to-multibyte)
137 'string-to-multibyte)
140 "Return a multibyte string with the same individual chars as string."
142 (lambda (ch) (string-as-multibyte (char-to-string ch)))
146 (defun uudecode-decode-region-internal (start end &optional file-name)
147 "Uudecode region between START and END without using an external program.
148 If FILE-NAME is non-nil, save the result to FILE-NAME."
154 (lim 0) inputpos result
155 (non-data-chars (concat "^" uudecode-alphabet)))
158 (when (re-search-forward uudecode-begin-line nil t)
159 (cond ((null file-name))
160 ((stringp file-name))
162 (setq file-name (expand-file-name
163 (read-file-name "File to Name:"
165 (match-string 1))))))
167 (skip-chars-forward non-data-chars end)
169 (setq inputpos (point))
170 (setq remain 0 bits 0 counter 0)
172 ((> (skip-chars-forward uudecode-alphabet end) 0)
175 (logand (- (uudecode-char-int (char-after inputpos)) 32)
177 (setq inputpos (1+ inputpos))
178 (if (= remain 0) (setq done t))
179 (while (and (< inputpos lim) (> remain 0))
183 (uudecode-char-int (char-after inputpos)) 32)
185 (if (/= counter 0) (setq remain (1- remain)))
186 (setq counter (1+ counter)
187 inputpos (1+ inputpos))
191 (char-to-string (lsh bits -16))
192 (char-to-string (logand (lsh bits -8) 255))
193 (char-to-string (logand bits 255)))
195 (setq bits 0 counter 0))
196 (t (setq bits (lsh bits 6)))))))
200 (error "uucode line ends unexpectedly")
202 ((and (= (point) end) (not done))
203 ;;(error "uucode ends unexpectedly")
208 (char-to-string (logand (lsh bits -16) 255))
209 (char-to-string (logand (lsh bits -8) 255)))
213 (char-to-string (logand (lsh bits -10) 255))
215 (skip-chars-forward non-data-chars end))
217 (with-temp-file file-name
218 (unless (featurep 'xemacs) (set-buffer-multibyte nil))
219 (insert (apply 'concat (nreverse result))))
220 (or (markerp end) (setq end (set-marker (make-marker) end)))
222 (if enable-multibyte-characters
223 (dolist (x (nreverse result))
224 (insert (uudecode-string-to-multibyte x)))
225 (insert (apply 'concat (nreverse result))))
226 (delete-region (point) end))))))
229 (defun uudecode-decode-region (start end &optional file-name)
230 "Uudecode region between START and END.
231 If FILE-NAME is non-nil, save the result to FILE-NAME."
232 (if uudecode-use-external
233 (uudecode-decode-region-external start end file-name)
234 (uudecode-decode-region-internal start end file-name)))
238 ;;; uudecode.el ends here