code.delx.au - gnu-emacs/blob - lisp/mail/uudecode.el

   1 ;;; uudecode.el -- elisp native uudecode
   2
   3 ;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004,
   4 ;;   2005, 2006, 2007, 2008, 2009, 2010, 2011 Free Software Foundation, Inc.
   5
   6 ;; Author: Shenghuo Zhu <zsh@cs.rochester.edu>
   7 ;; Keywords: uudecode news
   8
   9 ;; This file is part of GNU Emacs.
  10
  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 of the License, or
  14 ;; (at your option) any later version.
  15
  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.
  20
  21 ;; You should have received a copy of the GNU General Public License
  22 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  23
  24 ;;; Commentary:
  25
  26 ;;; Code:
  27
  28 (eval-when-compile (require 'cl))
  29
  30 (eval-and-compile
  31   (defalias 'uudecode-char-int
  32     (if (fboundp 'char-int)
  33         'char-int
  34       'identity)))
  35
  36 (defgroup uudecode nil
  37   "Decoding of uuencoded data."
  38   :group 'mail
  39   :group 'news)
  40
  41 (defcustom uudecode-decoder-program "uudecode"
  42   "*Non-nil value should be a string that names a uu decoder.
  43 The program should expect to read uu data on its standard
  44 input and write the converted data to its standard output."
  45   :type 'string
  46   :group 'uudecode)
  47
  48 (defcustom uudecode-decoder-switches nil
  49   "*List of command line flags passed to `uudecode-decoder-program'."
  50   :group 'uudecode
  51   :type '(repeat string))
  52
  53 (defcustom uudecode-use-external
  54   (executable-find uudecode-decoder-program)
  55   "*Use external uudecode program."
  56   :version "22.1"
  57   :group 'uudecode
  58   :type 'boolean)
  59
  60 (defconst uudecode-alphabet "\040-\140")
  61
  62 (defconst uudecode-begin-line "^begin[ \t]+[0-7][0-7][0-7][ \t]+\\(.*\\)$")
  63 (defconst uudecode-end-line "^end[ \t]*$")
  64
  65 (defconst uudecode-body-line
  66   (let ((i 61) (str "^M"))
  67     (while (> (setq i (1- i)) 0)
  68       (setq str (concat str "[^a-z]")))
  69     (concat str ".?$")))
  70
  71 (defvar uudecode-temporary-file-directory
  72   (cond ((fboundp 'temp-directory) (temp-directory))
  73         ((boundp 'temporary-file-directory) temporary-file-directory)
  74         ("/tmp")))
  75
  76 ;;;###autoload
  77 (defun uudecode-decode-region-external (start end &optional file-name)
  78   "Uudecode region between START and END using external program.
  79 If FILE-NAME is non-nil, save the result to FILE-NAME.  The program
  80 used is specified by `uudecode-decoder-program'."
  81   (interactive "r\nP")
  82   (let ((cbuf (current-buffer)) tempfile firstline status)
  83     (save-excursion
  84       (goto-char start)
  85       (when (re-search-forward uudecode-begin-line nil t)
  86         (forward-line 1)
  87         (setq firstline (point))
  88         (cond ((null file-name))
  89               ((stringp file-name))
  90               (t
  91                (setq file-name (read-file-name "File to Name:"
  92                                                nil nil nil
  93                                                (match-string 1)))))
  94         (setq tempfile (if file-name
  95                            (expand-file-name file-name)
  96                            (if (fboundp 'make-temp-file)
  97                                (let ((temporary-file-directory
  98                                       uudecode-temporary-file-directory))
  99                                  (make-temp-file "uu"))
 100                              (expand-file-name
 101                               (make-temp-name "uu")
 102                               uudecode-temporary-file-directory))))
 103         (let ((cdir default-directory)
 104               (default-process-coding-system
 105                 (if (featurep 'xemacs)
 106                     ;; In XEmacs, `nil' is not a valid coding system.
 107                     '(binary . binary)
 108                   nil)))
 109           (unwind-protect
 110               (with-temp-buffer
 111                 (insert "begin 600 " (file-name-nondirectory tempfile) "\n")
 112                 (insert-buffer-substring cbuf firstline end)
 113                 (cd (file-name-directory tempfile))
 114                 (apply 'call-process-region
 115                        (point-min)
 116                        (point-max)
 117                        uudecode-decoder-program
 118                        nil
 119                        nil
 120                        nil
 121                        uudecode-decoder-switches))
 122             (cd cdir) (set-buffer cbuf)))
 123         (if (file-exists-p tempfile)
 124             (unless file-name
 125               (goto-char start)
 126               (delete-region start end)
 127               (let (format-alist)
 128                 (insert-file-contents-literally tempfile)))
 129           (message "Can not uudecode")))
 130       (ignore-errors (or file-name (delete-file tempfile))))))
 131
 132 (eval-and-compile
 133   (defalias 'uudecode-string-to-multibyte
 134     (cond
 135      ((featurep 'xemacs)
 136       'identity)
 137      ((fboundp 'string-to-multibyte)
 138       'string-to-multibyte)
 139      (t
 140       (lambda (string)
 141         "Return a multibyte string with the same individual chars as string."
 142         (mapconcat
 143          (lambda (ch) (string-as-multibyte (char-to-string ch)))
 144          string ""))))))
 145
 146 ;;;###autoload
 147 (defun uudecode-decode-region-internal (start end &optional file-name)
 148   "Uudecode region between START and END without using an external program.
 149 If FILE-NAME is non-nil, save the result to FILE-NAME."
 150   (interactive "r\nP")
 151   (let ((done nil)
 152         (counter 0)
 153         (remain 0)
 154         (bits 0)
 155         (lim 0) inputpos result
 156         (non-data-chars (concat "^" uudecode-alphabet)))
 157     (save-excursion
 158       (goto-char start)
 159       (when (re-search-forward uudecode-begin-line nil t)
 160         (cond ((null file-name))
 161               ((stringp file-name))
 162               (t
 163                (setq file-name (expand-file-name
 164                                 (read-file-name "File to Name:"
 165                                                 nil nil nil
 166                                                 (match-string 1))))))
 167         (forward-line 1)
 168         (skip-chars-forward non-data-chars end)
 169         (while (not done)
 170           (setq inputpos (point))
 171           (setq remain 0 bits 0 counter 0)
 172           (cond
 173            ((> (skip-chars-forward uudecode-alphabet end) 0)
 174             (setq lim (point))
 175             (setq remain
 176                   (logand (- (uudecode-char-int (char-after inputpos)) 32)
 177                           63))
 178             (setq inputpos (1+ inputpos))
 179             (if (= remain 0) (setq done t))
 180             (while (and (< inputpos lim) (> remain 0))
 181               (setq bits (+ bits
 182                             (logand
 183                              (-
 184                               (uudecode-char-int (char-after inputpos)) 32)
 185                              63)))
 186               (if (/= counter 0) (setq remain (1- remain)))
 187               (setq counter (1+ counter)
 188                     inputpos (1+ inputpos))
 189               (cond ((= counter 4)
 190                      (setq result (cons
 191                                    (concat
 192                                     (char-to-string (lsh bits -16))
 193                                     (char-to-string (logand (lsh bits -8) 255))
 194                                     (char-to-string (logand bits 255)))
 195                                    result))
 196                      (setq bits 0 counter 0))
 197                     (t (setq bits (lsh bits 6)))))))
 198           (cond
 199            (done)
 200            ((> 0 remain)
 201             (error "uucode line ends unexpectly")
 202             (setq done t))
 203            ((and (= (point) end) (not done))
 204             ;;(error "uucode ends unexpectly")
 205             (setq done t))
 206            ((= counter 3)
 207             (setq result (cons
 208                           (concat
 209                            (char-to-string (logand (lsh bits -16) 255))
 210                            (char-to-string (logand (lsh bits -8) 255)))
 211                           result)))
 212            ((= counter 2)
 213             (setq result (cons
 214                           (char-to-string (logand (lsh bits -10) 255))
 215                           result))))
 216           (skip-chars-forward non-data-chars end))
 217         (if file-name
 218             (with-temp-file file-name
 219               (unless (featurep 'xemacs) (set-buffer-multibyte nil))
 220               (insert (apply 'concat (nreverse result))))
 221           (or (markerp end) (setq end (set-marker (make-marker) end)))
 222           (goto-char start)
 223           (if enable-multibyte-characters
 224               (dolist (x (nreverse result))
 225                 (insert (uudecode-string-to-multibyte x)))
 226             (insert (apply 'concat (nreverse result))))
 227           (delete-region (point) end))))))
 228
 229 ;;;###autoload
 230 (defun uudecode-decode-region (start end &optional file-name)
 231   "Uudecode region between START and END.
 232 If FILE-NAME is non-nil, save the result to FILE-NAME."
 233   (if uudecode-use-external
 234       (uudecode-decode-region-external start end file-name)
 235     (uudecode-decode-region-internal start end file-name)))
 236
 237 (provide 'uudecode)
 238
 239 ;;; uudecode.el ends here