cgit.sxemacs.org Git - gnus/blob - lisp/uudecode.el

   1 ;;; uudecode.el -- elisp native uudecode
   2 ;; Copyright (c) 1998 by Shenghuo Zhu <zsh@cs.rochester.edu>
   3
   4 ;; Author: Shenghuo Zhu <zsh@cs.rochester.edu>
   5 ;; $Revision: 1.3 $
   6 ;; Keywords: uudecode
   7
   8 ;; This file is not part of GNU Emacs, but the same permissions
   9 ;; apply.
  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 2, or (at your option)
  14 ;; 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; see the file COPYING.  If not, write to the
  23 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  24 ;; Boston, MA 02111-1307, USA.
  25
  26 ;;; Commentary:
  27
  28 ;;     Lots of codes are stolen from mm-decode.el, gnus-uu.el and
  29 ;;     base64.el
  30
  31 ;;; Code:
  32
  33 (if (not (fboundp 'char-int))
  34     (fset 'char-int 'identity))
  35
  36 (defvar uudecode-decoder-program "uudecode"
  37   "*Non-nil value should be a string that names a uu decoder.
  38 The program should expect to read uu data on its standard
  39 input and write the converted data to its standard output.")
  40
  41 (defvar uudecode-decoder-switches nil
  42   "*List of command line flags passed to the command named by uudecode-decoder-program.")
  43
  44 (defconst uudecode-alphabet "\040-\140")
  45
  46 (defconst uudecode-begin-line "^begin[ \t]+[0-7][0-7][0-7][ \t]+\\(.*\\)$")
  47 (defconst uudecode-end-line "^end[ \t]*$")
  48
  49 (defconst uudecode-body-line
  50   (let ((i 61) (str "^M"))
  51     (while (> (setq i (1- i)) 0)
  52       (setq str (concat str "[^a-z]")))
  53     (concat str ".?$")))
  54
  55 (defvar uudecode-temporary-file-directory "/tmp/")
  56
  57 ;;;###autoload
  58 (defun uudecode-decode-region-external (start end &optional file-name)
  59   "uudecode region between START and END with external decoder.
  60
  61 If FILE-NAME is non-nil, save the result to FILE-NAME."
  62   (interactive "r\nP")
  63   (let ((cbuf (current-buffer)) tempfile firstline work-buffer status)
  64     (save-excursion
  65       (goto-char start)
  66       (when (re-search-forward uudecode-begin-line nil t)
  67         (forward-line 1)
  68         (setq firstline (point))
  69         (cond ((null file-name))
  70               ((stringp file-name))
  71               (t
  72                (setq file-name (read-file-name "File to Name:"
  73                                                nil nil nil
  74                                                (match-string 1)))))
  75         (setq tempfile (expand-file-name
  76                         (or file-name (concat uudecode-temporary-file-directory
  77                                               (make-temp-name "uu")))))
  78         (let ((cdir default-directory) default-process-coding-system)
  79           (unwind-protect
  80               (progn
  81                 (set-buffer (setq work-buffer
  82                                   (generate-new-buffer " *uudecode-work*")))
  83                 (buffer-disable-undo work-buffer)
  84                 (insert "begin 600 " (file-name-nondirectory tempfile) "\n")
  85                 (insert-buffer-substring cbuf firstline end)
  86                 (cd (file-name-directory tempfile))
  87                 (apply 'call-process-region
  88                        (point-min)
  89                        (point-max)
  90                        uudecode-decoder-program
  91                        nil
  92                        nil
  93                        nil
  94                        uudecode-decoder-switches))
  95             (cd cdir) (set-buffer cbuf)))
  96         (if (file-exists-p tempfile)
  97             (unless file-name
  98               (goto-char start)
  99               (delete-region start end)
 100               (let (format-alist)
 101                 (insert-file-contents-literally tempfile)))
 102           (message "Can not uudecode")))
 103       (and work-buffer (kill-buffer work-buffer))
 104       (condition-case ()
 105           (or file-name (delete-file tempfile))
 106         (error))
 107       )))
 108
 109 (defun uudecode-insert-char (char &optional count ignored buffer)
 110   (condition-case nil
 111       (progn
 112         (insert-char char count ignored buffer)
 113         (fset 'uudecode-insert-char 'insert-char))
 114     (wrong-number-of-arguments
 115      (fset 'uudecode-insert-char 'uudecode-xemacs-insert-char)
 116      (uudecode-insert-char char count ignored buffer))))
 117
 118 (defun uudecode-xemacs-insert-char (char &optional count ignored buffer)
 119   (if (or (null buffer) (eq buffer (current-buffer)))
 120       (insert-char char count)
 121     (save-excursion
 122       (set-buffer buffer)
 123       (insert-char char count))))
 124
 125 ;;;###autoload
 126
 127 (defun uudecode-decode-region (start end &optional file-name)
 128   "uudecode region between START and END.
 129 If FILE-NAME is non-nil, save the result to FILE-NAME."
 130   (interactive "r\nP")
 131   (let ((work-buffer nil)
 132         (done nil)
 133         (counter 0)
 134         (remain 0)
 135         (bits 0)
 136         (lim 0) inputpos
 137         (non-data-chars (concat "^" uudecode-alphabet)))
 138     (unwind-protect
 139         (save-excursion
 140           (goto-char start)
 141           (when (re-search-forward uudecode-begin-line nil t)
 142             (cond ((null file-name))
 143                   ((stringp file-name))
 144                   (t
 145                    (setq file-name (expand-file-name
 146                                     (read-file-name "File to Name:"
 147                                                     nil nil nil
 148                                                     (match-string 1))))))
 149             (setq work-buffer (generate-new-buffer " *uudecode-work*"))
 150             (buffer-disable-undo work-buffer)
 151             (forward-line 1)
 152             (skip-chars-forward non-data-chars end)
 153             (while (not done)
 154               (setq inputpos (point))
 155               (setq remain 0 bits 0 counter 0)
 156               (cond
 157                ((> (skip-chars-forward uudecode-alphabet end) 0)
 158                 (setq lim (point))
 159                 (setq remain
 160                       (logand (- (char-int (char-after inputpos)) 32) 63))
 161                 (setq inputpos (1+ inputpos))
 162                 (if (= remain 0) (setq done t))
 163                 (while (and (< inputpos lim) (> remain 0))
 164                   (setq bits (+ bits
 165                                 (logand
 166                                  (-
 167                                   (char-int (char-after inputpos)) 32) 63)))
 168                   (if (/= counter 0) (setq remain (1- remain)))
 169                   (setq counter (1+ counter)
 170                         inputpos (1+ inputpos))
 171                   (cond ((= counter 4)
 172                          (uudecode-insert-char
 173                           (lsh bits -16) 1 nil work-buffer)
 174                          (uudecode-insert-char
 175                           (logand (lsh bits -8) 255) 1 nil work-buffer)
 176                          (uudecode-insert-char (logand bits 255) 1 nil
 177                                          work-buffer)
 178                          (setq bits 0 counter 0))
 179                         (t (setq bits (lsh bits 6)))))))
 180               (cond
 181                  (done)
 182                  ((> 0 remain)
 183                   (error "uucode line ends unexpectly")
 184                   (setq done t))
 185                  ((and (= (point) end) (not done))
 186                   ;(error "uucode ends unexpectly")
 187                   (setq done t))
 188                  ((= counter 3)
 189                   (uudecode-insert-char (logand (lsh bits -16) 255) 1 nil
 190                                   work-buffer)
 191                   (uudecode-insert-char (logand (lsh bits -8) 255) 1 nil
 192                                   work-buffer))
 193                  ((= counter 2)
 194                   (uudecode-insert-char (logand (lsh bits -10) 255) 1 nil
 195                                   work-buffer)))
 196               (skip-chars-forward non-data-chars end))
 197             (if file-name
 198                 (save-excursion
 199                   (set-buffer work-buffer)
 200                   (write-file file-name))
 201               (or (markerp end) (setq end (set-marker (make-marker) end)))
 202               (goto-char start)
 203               (insert-buffer-substring work-buffer)
 204               (delete-region (point) end))))
 205       (and work-buffer (kill-buffer work-buffer)))))
 206
 207 (provide 'uudecode)
 208
 209 ;;; uudecode.el ends here