X-Git-Url: https://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fuudecode.el;h=3d6473413e35788370df72457ce222cff7613dde;hb=2bf2365af7e8015e3b3206b3610e17c5e8654018;hp=2be3e6aa8cbc492c022ded170f28ed8f548b7cb6;hpb=2eb41e16e469e2bbe61d50e219749e35452336bd;p=gnus diff --git a/lisp/uudecode.el b/lisp/uudecode.el index 2be3e6aa8..3d6473413 100644 --- a/lisp/uudecode.el +++ b/lisp/uudecode.el @@ -1,92 +1,123 @@ ;;; uudecode.el -- elisp native uudecode -;; Copyright (c) 1998 by Shenghuo Zhu + +;; Copyright (C) 1998-2014 Free Software Foundation, Inc. ;; Author: Shenghuo Zhu -;; $Revision: 1.1 $ -;; Keywords: uudecode +;; Keywords: uudecode news ;; 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 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; 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 +;;; Commentary: ;;; Code: -(if (not (fboundp 'char-int)) - (fset 'char-int 'identity)) +(eval-when-compile (require 'cl)) -(defvar uu-decoder-program "uudecode" - "*Non-nil value should be a string that names a uu decoder. +(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.") +input and write the converted data to its standard output." + :type 'string + :group 'uudecode) -(defvar uu-decoder-switches nil - "*List of command line flags passed to the command named by uu-decoder-program.") +(defcustom uudecode-decoder-switches nil + "List of command line flags passed to `uudecode-decoder-program'." + :group 'uudecode + :type '(repeat string)) -(defvar uu-alphabet "\040-\140") +(defcustom uudecode-use-external + (executable-find uudecode-decoder-program) + "Use external uudecode program." + :version "22.1" + :group 'uudecode + :type 'boolean) -(defvar uu-begin-string "^begin[ \t]+[0-7][0-7][0-7][ \t]+\\(.*\\)$") -(defvar uu-end-string "^end[ \t]*$") +(defconst uudecode-alphabet "\040-\140") -(defvar uu-body-line +(defconst uudecode-begin-line "^begin[ \t]+[0-7][0-7][0-7][ \t]+\\(.*\\)$") +(defconst uudecode-end-line "^end[ \t]*$") + +(defconst uudecode-body-line (let ((i 61) (str "^M")) (while (> (setq i (1- i)) 0) (setq str (concat str "[^a-z]"))) (concat str ".?$"))) -(defvar uu-temporary-file-directory "/tmp/") +(defvar uudecode-temporary-file-directory + (cond ((fboundp 'temp-directory) (temp-directory)) + ((boundp 'temporary-file-directory) temporary-file-directory) + ("/tmp"))) -(defun uu-decode-region-external (start end &optional file-name) - "Decode uuencoded files using an external program." +;;;###autoload +(defun uudecode-decode-region-external (start end &optional 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 uu-begin-string nil t) + (when (re-search-forward uudecode-begin-line nil t) (forward-line 1) (setq firstline (point)) (cond ((null file-name)) ((stringp file-name)) - (t - (setq file-name (read-file-name "File to Name:" - nil nil nil + (t + (setq file-name (read-file-name "File to Name:" + nil nil nil (match-string 1))))) - (setq tempfile (expand-file-name - (or file-name (concat uu-temporary-file-directory - (make-temp-name "uu"))))) - (let ((cdir default-directory) default-process-coding-system) + (setq tempfile (if file-name + (expand-file-name file-name) + (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)) (apply 'call-process-region (point-min) (point-max) - uu-decoder-program + uudecode-decoder-program nil nil nil - uu-decoder-switches)) + uudecode-decoder-switches)) (cd cdir) (set-buffer cbuf))) (if (file-exists-p tempfile) (unless file-name @@ -95,103 +126,112 @@ input and write the converted data to its standard output.") (let (format-alist) (insert-file-contents-literally tempfile))) (message "Can not uudecode"))) - (and work-buffer (kill-buffer work-buffer)) - (condition-case () - (or file-name (delete-file tempfile)) - (error))))) - -(defun uu-insert-char (char &optional count ignored buffer) - (condition-case nil - (progn - (insert-char char count ignored buffer) - (fset 'uu-insert-char 'insert-char)) - (wrong-number-of-arguments - (fset 'uu-insert-char 'uu-xemacs-insert-char) - (uu-insert-char char count ignored buffer)))) - -(defun uu-xemacs-insert-char (char &optional count ignored buffer) - (if (or (null buffer) (eq buffer (current-buffer))) - (insert-char char count) - (save-excursion - (set-buffer buffer) - (insert-char char count)))) - -(defun uu-decode-region (start end &optional file-name) + (ignore-errors (or file-name (delete-file tempfile)))))) + +(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-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 - (non-data-chars (concat "^" uu-alphabet))) - (unwind-protect - (save-excursion + (lim 0) inputpos result + (non-data-chars (concat "^" uudecode-alphabet))) + (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 unexpectedly") + (setq done t)) + ((and (= (point) end) (not done)) + ;;(error "uucode ends unexpectedly") + (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 uu-begin-string 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 uu-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) - (uu-insert-char (lsh bits -16) 1 nil work-buffer) - (uu-insert-char (logand (lsh bits -8) 255) 1 nil - work-buffer) - (uu-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) - (uu-insert-char (logand (lsh bits -16) 255) 1 nil - work-buffer) - (uu-insert-char (logand (lsh bits -8) 255) 1 nil - work-buffer)) - ((= counter 2) - (uu-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)