/[emacs]/emacs/lisp/gnus/uudecode.el
ViewVC logotype

Diff of /emacs/lisp/gnus/uudecode.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.7.8.1 by miles, Tue Oct 14 23:34:51 2003 UTC revision 1.7.8.2 by miles, Thu Sep 16 00:12:16 2004 UTC
# Line 1  Line 1 
1  ;;; uudecode.el --- elisp native uudecode  ;;; uudecode.el -- elisp native uudecode
2    
3  ;; Copyright (c) 1998, 1999, 2000 Free Software Foundation, Inc.  ;; Copyright (c) 1998, 1999, 2000, 2001, 2003 Free Software Foundation, Inc.
4    
5  ;; Author: Shenghuo Zhu <zsh@cs.rochester.edu>  ;; Author: Shenghuo Zhu <zsh@cs.rochester.edu>
6  ;; Keywords: uudecode news  ;; Keywords: uudecode news
# Line 24  Line 24 
24    
25  ;;; Commentary:  ;;; Commentary:
26    
 ;;     Lots of codes are stolen from mm-decode.el, gnus-uu.el and  
 ;;     base64.el  
   
 ;; This looks as though it could be made rather more efficient for  
 ;; internal working.  Encoding could use a lookup table and decoding  
 ;; should presumably use a vector or list buffer for partial results  
 ;; rather than with-current-buffer.  -- fx  
   
 ;; Only `uudecode-decode-region' should be advertised, and whether or  
 ;; not that uses a program should be customizable, but I guess it's  
 ;; too late now.  -- fx  
   
27  ;;; Code:  ;;; Code:
28    
29    (autoload 'executable-find "executable")
30    
31  (eval-when-compile (require 'cl))  (eval-when-compile (require 'cl))
32    
33  (eval-and-compile  (eval-and-compile
34    (defalias 'uudecode-char-int    (defalias 'uudecode-char-int
35      (if (fboundp 'char-int)      (if (fboundp 'char-int)
36          'char-int          'char-int
37        'identity))        'identity)))
   
   (if (featurep 'xemacs)  
       (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))))))  
38    
39  (defcustom uudecode-decoder-program "uudecode"  (defcustom uudecode-decoder-program "uudecode"
40    "*Non-nil value should be a string that names a uu decoder.    "*Non-nil value should be a string that names a uu decoder.
# Line 66  input and write the converted data to it Line 48  input and write the converted data to it
48    :group 'gnus-extract    :group 'gnus-extract
49    :type '(repeat string))    :type '(repeat string))
50    
51    (defcustom uudecode-use-external
52      (executable-find uudecode-decoder-program)
53      "*Use external uudecode program."
54      :group 'gnus-extract
55      :type 'boolean)
56    
57  (defconst uudecode-alphabet "\040-\140")  (defconst uudecode-alphabet "\040-\140")
58    
59  (defconst uudecode-begin-line "^begin[ \t]+[0-7][0-7][0-7][ \t]+\\(.*\\)$")  (defconst uudecode-begin-line "^begin[ \t]+[0-7][0-7][0-7][ \t]+\\(.*\\)$")
# Line 102  used is specified by `uudecode-decoder-p Line 90  used is specified by `uudecode-decoder-p
90                                                 (match-string 1)))))                                                 (match-string 1)))))
91          (setq tempfile (if file-name          (setq tempfile (if file-name
92                             (expand-file-name file-name)                             (expand-file-name file-name)
93                           (let ((temporary-file-directory                             (if (fboundp 'make-temp-file)
94                                  uudecode-temporary-file-directory))                                 (let ((temporary-file-directory
95                             (make-temp-file "uu"))))                                        uudecode-temporary-file-directory))
96                                     (make-temp-file "uu"))
97                                 (expand-file-name
98                                  (make-temp-name "uu")
99                                  uudecode-temporary-file-directory))))
100          (let ((cdir default-directory)          (let ((cdir default-directory)
101                default-process-coding-system)                default-process-coding-system)
102            (unwind-protect            (unwind-protect
# Line 131  used is specified by `uudecode-decoder-p Line 123  used is specified by `uudecode-decoder-p
123        (ignore-errors (or file-name (delete-file tempfile))))))        (ignore-errors (or file-name (delete-file tempfile))))))
124    
125  ;;;###autoload  ;;;###autoload
126  (defun uudecode-decode-region (start end &optional file-name)  (defun uudecode-decode-region-internal (start end &optional file-name)
127    "Uudecode region between START and END without using an external program.    "Uudecode region between START and END without using an external program.
128  If FILE-NAME is non-nil, save the result to FILE-NAME."  If FILE-NAME is non-nil, save the result to FILE-NAME."
129    (interactive "r\nP")    (interactive "r\nP")
130    (let ((work-buffer nil)    (let ((done nil)
         (done nil)  
131          (counter 0)          (counter 0)
132          (remain 0)          (remain 0)
133          (bits 0)          (bits 0)
134          (lim 0) inputpos          (lim 0) inputpos result
135          (non-data-chars (concat "^" uudecode-alphabet)))          (non-data-chars (concat "^" uudecode-alphabet)))
136      (unwind-protect      (save-excursion
137          (save-excursion        (goto-char start)
138          (when (re-search-forward uudecode-begin-line nil t)
139            (cond ((null file-name))
140                  ((stringp file-name))
141                  (t
142                   (setq file-name (expand-file-name
143                                    (read-file-name "File to Name:"
144                                                    nil nil nil
145                                                    (match-string 1))))))
146            (forward-line 1)
147            (skip-chars-forward non-data-chars end)
148            (while (not done)
149              (setq inputpos (point))
150              (setq remain 0 bits 0 counter 0)
151              (cond
152               ((> (skip-chars-forward uudecode-alphabet end) 0)
153                (setq lim (point))
154                (setq remain
155                      (logand (- (uudecode-char-int (char-after inputpos)) 32)
156                              63))
157                (setq inputpos (1+ inputpos))
158                (if (= remain 0) (setq done t))
159                (while (and (< inputpos lim) (> remain 0))
160                  (setq bits (+ bits
161                                (logand
162                                 (-
163                                  (uudecode-char-int (char-after inputpos)) 32)
164                                 63)))
165                  (if (/= counter 0) (setq remain (1- remain)))
166                  (setq counter (1+ counter)
167                        inputpos (1+ inputpos))
168                  (cond ((= counter 4)
169                         (setq result (cons
170                                       (concat
171                                        (char-to-string (lsh bits -16))
172                                        (char-to-string (logand (lsh bits -8) 255))
173                                        (char-to-string (logand bits 255)))
174                                       result))
175                         (setq bits 0 counter 0))
176                        (t (setq bits (lsh bits 6)))))))
177              (cond
178               (done)
179               ((> 0 remain)
180                (error "uucode line ends unexpectly")
181                (setq done t))
182               ((and (= (point) end) (not done))
183                ;;(error "uucode ends unexpectly")
184                (setq done t))
185               ((= counter 3)
186                (setq result (cons
187                              (concat
188                               (char-to-string (logand (lsh bits -16) 255))
189                               (char-to-string (logand (lsh bits -8) 255)))
190                              result)))
191               ((= counter 2)
192                (setq result (cons
193                              (char-to-string (logand (lsh bits -10) 255))
194                              result))))
195              (skip-chars-forward non-data-chars end))
196            (if file-name
197                (let (default-enable-multibyte-characters)
198                  (with-temp-file file-name
199                    (insert (apply 'concat (nreverse result)))))
200              (or (markerp end) (setq end (set-marker (make-marker) end)))
201            (goto-char start)            (goto-char start)
202            (when (re-search-forward uudecode-begin-line nil t)            (insert (apply 'concat (nreverse result)))
203              (cond ((null file-name))            (delete-region (point) end))))))
204                    ((stringp file-name))  
205                    (t  ;;;###autoload
206                     (setq file-name (expand-file-name  (defun uudecode-decode-region (start end &optional file-name)
207                                      (read-file-name "File to Name:"    "Uudecode region between START and END.
208                                                      nil nil nil  If FILE-NAME is non-nil, save the result to FILE-NAME."
209                                                      (match-string 1))))))    (if uudecode-use-external
210              (setq work-buffer (generate-new-buffer " *uudecode-work*"))        (uudecode-decode-region-external start end file-name)
211              (forward-line 1)      (uudecode-decode-region-internal start end file-name)))
             (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)  
                          (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)))))  
212    
213  (provide 'uudecode)  (provide 'uudecode)
214    

Legend:
Removed from v.1.7.8.1  
changed lines
  Added in v.1.7.8.2

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26