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