X-Git-Url: http://cgit.sxemacs.org/?p=gnus;a=blobdiff_plain;f=lisp%2Fuudecode.el;h=7ab2fcd1c620bd289325b088cfeb7322c9eb546f;hp=19eb5adb1c833252eee980f9e23d7991c8863ed8;hb=123adcf9b783e574789164bc5e3df6a1a4528c31;hpb=dabc252c2d414f8a2d9924785c39e1f4f1dabc38 diff --git a/lisp/uudecode.el b/lisp/uudecode.el index 19eb5adb1..7ab2fcd1c 100644 --- a/lisp/uudecode.el +++ b/lisp/uudecode.el @@ -1,15 +1,17 @@ ;;; uudecode.el -- elisp native uudecode -;; Copyright (c) 1998,99 Free Software Foundation, Inc. + +;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, +;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. ;; Author: Shenghuo Zhu ;; Keywords: uudecode news -;; This file is a part of GNU Emacs. +;; This file is part of GNU Emacs. -;; GNU Emacs is free software; you can redistribute it and/or modify +;; GNU Emacs is free software: you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 2, or (at your option) -;; any later version. +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of @@ -17,32 +19,44 @@ ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. +;; along with GNU Emacs. If not, see . ;;; Commentary: -;; Lots of codes are stolen from mm-decode.el, gnus-uu.el and -;; base64.el - ;;; Code: -(if (not (fboundp 'char-int)) - (defalias 'char-int 'identity)) +(eval-when-compile (require 'cl)) + +(eval-and-compile + (defalias 'uudecode-char-int + (if (fboundp 'char-int) + 'char-int + 'identity))) + +(defgroup uudecode nil + "Decoding of uuencoded data." + :group 'mail + :group 'news) (defcustom uudecode-decoder-program "uudecode" "*Non-nil value should be a string that names a uu decoder. The program should expect to read uu data on its standard input and write the converted data to its standard output." :type 'string - :group 'gnus-extract) + :group 'uudecode) (defcustom uudecode-decoder-switches nil "*List of command line flags passed to `uudecode-decoder-program'." - :group 'gnus-extract + :group 'uudecode :type '(repeat string)) +(defcustom uudecode-use-external + (executable-find uudecode-decoder-program) + "*Use external uudecode program." + :version "22.1" + :group 'uudecode + :type 'boolean) + (defconst uudecode-alphabet "\040-\140") (defconst uudecode-begin-line "^begin[ \t]+[0-7][0-7][0-7][ \t]+\\(.*\\)$") @@ -61,11 +75,11 @@ input and write the converted data to its standard output." ;;;###autoload (defun uudecode-decode-region-external (start end &optional file-name) - "Uudecode region between START and END with external decoder. - -If FILE-NAME is non-nil, save the result to FILE-NAME." + "Uudecode region between START and END using external program. +If FILE-NAME is non-nil, save the result to FILE-NAME. The program +used is specified by `uudecode-decoder-program'." (interactive "r\nP") - (let ((cbuf (current-buffer)) tempfile firstline work-buffer status) + (let ((cbuf (current-buffer)) tempfile firstline status) (save-excursion (goto-char start) (when (re-search-forward uudecode-begin-line nil t) @@ -79,16 +93,21 @@ If FILE-NAME is non-nil, save the result to FILE-NAME." (match-string 1))))) (setq tempfile (if file-name (expand-file-name file-name) - (make-temp-name - ;; /tmp/uu... - (expand-file-name - "uu" uudecode-temporary-file-directory)))) - (let ((cdir default-directory) default-process-coding-system) + (if (fboundp 'make-temp-file) + (let ((temporary-file-directory + uudecode-temporary-file-directory)) + (make-temp-file "uu")) + (expand-file-name + (make-temp-name "uu") + uudecode-temporary-file-directory)))) + (let ((cdir default-directory) + (default-process-coding-system + (if (featurep 'xemacs) + ;; In XEmacs, `nil' is not a valid coding system. + '(binary . binary) + nil))) (unwind-protect - (progn - (set-buffer (setq work-buffer - (generate-new-buffer " *uudecode-work*"))) - (buffer-disable-undo work-buffer) + (with-temp-buffer (insert "begin 600 " (file-name-nondirectory tempfile) "\n") (insert-buffer-substring cbuf firstline end) (cd (file-name-directory tempfile)) @@ -108,98 +127,112 @@ If FILE-NAME is non-nil, save the result to FILE-NAME." (let (format-alist) (insert-file-contents-literally tempfile))) (message "Can not uudecode"))) - (and work-buffer (kill-buffer work-buffer)) (ignore-errors (or file-name (delete-file tempfile)))))) -(if (string-match "XEmacs" emacs-version) - (defalias 'uudecode-insert-char 'insert-char) - (defun uudecode-insert-char (char &optional count ignored buffer) - (if (or (null buffer) (eq buffer (current-buffer))) - (insert-char char count) - (with-current-buffer buffer - (insert-char char count))))) +(eval-and-compile + (defalias 'uudecode-string-to-multibyte + (cond + ((featurep 'xemacs) + 'identity) + ((fboundp 'string-to-multibyte) + 'string-to-multibyte) + (t + (lambda (string) + "Return a multibyte string with the same individual chars as string." + (mapconcat + (lambda (ch) (string-as-multibyte (char-to-string ch))) + string "")))))) ;;;###autoload - -(defun uudecode-decode-region (start end &optional file-name) - "Uudecode region between START and END. +(defun uudecode-decode-region-internal (start end &optional file-name) + "Uudecode region between START and END without using an external program. If FILE-NAME is non-nil, save the result to FILE-NAME." (interactive "r\nP") - (let ((work-buffer nil) - (done nil) + (let ((done nil) (counter 0) (remain 0) (bits 0) - (lim 0) inputpos + (lim 0) inputpos result (non-data-chars (concat "^" uudecode-alphabet))) - (unwind-protect - (save-excursion + (save-excursion + (goto-char start) + (when (re-search-forward uudecode-begin-line nil t) + (cond ((null file-name)) + ((stringp file-name)) + (t + (setq file-name (expand-file-name + (read-file-name "File to Name:" + nil nil nil + (match-string 1)))))) + (forward-line 1) + (skip-chars-forward non-data-chars end) + (while (not done) + (setq inputpos (point)) + (setq remain 0 bits 0 counter 0) + (cond + ((> (skip-chars-forward uudecode-alphabet end) 0) + (setq lim (point)) + (setq remain + (logand (- (uudecode-char-int (char-after inputpos)) 32) + 63)) + (setq inputpos (1+ inputpos)) + (if (= remain 0) (setq done t)) + (while (and (< inputpos lim) (> remain 0)) + (setq bits (+ bits + (logand + (- + (uudecode-char-int (char-after inputpos)) 32) + 63))) + (if (/= counter 0) (setq remain (1- remain))) + (setq counter (1+ counter) + inputpos (1+ inputpos)) + (cond ((= counter 4) + (setq result (cons + (concat + (char-to-string (lsh bits -16)) + (char-to-string (logand (lsh bits -8) 255)) + (char-to-string (logand bits 255))) + result)) + (setq bits 0 counter 0)) + (t (setq bits (lsh bits 6))))))) + (cond + (done) + ((> 0 remain) + (error "uucode line ends unexpectly") + (setq done t)) + ((and (= (point) end) (not done)) + ;;(error "uucode ends unexpectly") + (setq done t)) + ((= counter 3) + (setq result (cons + (concat + (char-to-string (logand (lsh bits -16) 255)) + (char-to-string (logand (lsh bits -8) 255))) + result))) + ((= counter 2) + (setq result (cons + (char-to-string (logand (lsh bits -10) 255)) + result)))) + (skip-chars-forward non-data-chars end)) + (if file-name + (with-temp-file file-name + (unless (featurep 'xemacs) (set-buffer-multibyte nil)) + (insert (apply 'concat (nreverse result)))) + (or (markerp end) (setq end (set-marker (make-marker) end))) (goto-char start) - (when (re-search-forward uudecode-begin-line nil t) - (cond ((null file-name)) - ((stringp file-name)) - (t - (setq file-name (expand-file-name - (read-file-name "File to Name:" - nil nil nil - (match-string 1)))))) - (setq work-buffer (generate-new-buffer " *uudecode-work*")) - (buffer-disable-undo work-buffer) - (forward-line 1) - (skip-chars-forward non-data-chars end) - (while (not done) - (setq inputpos (point)) - (setq remain 0 bits 0 counter 0) - (cond - ((> (skip-chars-forward uudecode-alphabet end) 0) - (setq lim (point)) - (setq remain - (logand (- (char-int (char-after inputpos)) 32) 63)) - (setq inputpos (1+ inputpos)) - (if (= remain 0) (setq done t)) - (while (and (< inputpos lim) (> remain 0)) - (setq bits (+ bits - (logand - (- - (char-int (char-after inputpos)) 32) 63))) - (if (/= counter 0) (setq remain (1- remain))) - (setq counter (1+ counter) - inputpos (1+ inputpos)) - (cond ((= counter 4) - (uudecode-insert-char - (lsh bits -16) 1 nil work-buffer) - (uudecode-insert-char - (logand (lsh bits -8) 255) 1 nil work-buffer) - (uudecode-insert-char (logand bits 255) 1 nil - work-buffer) - (setq bits 0 counter 0)) - (t (setq bits (lsh bits 6))))))) - (cond - (done) - ((> 0 remain) - (error "uucode line ends unexpectly") - (setq done t)) - ((and (= (point) end) (not done)) - ;;(error "uucode ends unexpectly") - (setq done t)) - ((= counter 3) - (uudecode-insert-char (logand (lsh bits -16) 255) 1 nil - work-buffer) - (uudecode-insert-char (logand (lsh bits -8) 255) 1 nil - work-buffer)) - ((= counter 2) - (uudecode-insert-char (logand (lsh bits -10) 255) 1 nil - work-buffer))) - (skip-chars-forward non-data-chars end)) - (if file-name - (save-excursion - (set-buffer work-buffer) - (write-file file-name)) - (or (markerp end) (setq end (set-marker (make-marker) end))) - (goto-char start) - (insert-buffer-substring work-buffer) - (delete-region (point) end)))) - (and work-buffer (kill-buffer work-buffer))))) + (if enable-multibyte-characters + (dolist (x (nreverse result)) + (insert (uudecode-string-to-multibyte x))) + (insert (apply 'concat (nreverse result)))) + (delete-region (point) end)))))) + +;;;###autoload +(defun uudecode-decode-region (start end &optional file-name) + "Uudecode region between START and END. +If FILE-NAME is non-nil, save the result to FILE-NAME." + (if uudecode-use-external + (uudecode-decode-region-external start end file-name) + (uudecode-decode-region-internal start end file-name))) (provide 'uudecode)