annotate lisp/gnus/uudecode.el @ 45322:2c69a55a358c

Format John Paul Wallington's changes correctly.
author Colin Walters <walters@gnu.org>
date Thu, 16 May 2002 19:28:54 +0000
parents a26d9b55abb6
children 695cf19ef79e d7ddb3e565de
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
38413
a26d9b55abb6 Some fixes to follow coding conventions in files from Gnus.
Pavel Janík <Pavel@Janik.cz>
parents: 33813
diff changeset
1 ;;; uudecode.el --- elisp native uudecode
31717
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3 ;; Copyright (c) 1998, 1999, 2000 Free Software Foundation, Inc.
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5 ;; Author: Shenghuo Zhu <zsh@cs.rochester.edu>
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
6 ;; Keywords: uudecode news
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
7
38413
a26d9b55abb6 Some fixes to follow coding conventions in files from Gnus.
Pavel Janík <Pavel@Janik.cz>
parents: 33813
diff changeset
8 ;; This file is part of GNU Emacs.
31717
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
9
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
10 ;; GNU Emacs is free software; you can redistribute it and/or modify
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
11 ;; it under the terms of the GNU General Public License as published by
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
12 ;; the Free Software Foundation; either version 2, or (at your option)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
13 ;; any later version.
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
14
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
15 ;; GNU Emacs is distributed in the hope that it will be useful,
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
18 ;; GNU General Public License for more details.
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
19
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
20 ;; You should have received a copy of the GNU General Public License
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
21 ;; along with GNU Emacs; see the file COPYING. If not, write to the
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
23 ;; Boston, MA 02111-1307, USA.
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
24
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
25 ;;; Commentary:
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
26
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
27 ;; Lots of codes are stolen from mm-decode.el, gnus-uu.el and
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
28 ;; base64.el
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
29
33566
cef397782e2e (uudecode-insert-char): Fix bogus feature test.
Dave Love <fx@gnu.org>
parents: 33298
diff changeset
30 ;; This looks as though it could be made rather more efficient for
cef397782e2e (uudecode-insert-char): Fix bogus feature test.
Dave Love <fx@gnu.org>
parents: 33298
diff changeset
31 ;; internal working. Encoding could use a lookup table and decoding
cef397782e2e (uudecode-insert-char): Fix bogus feature test.
Dave Love <fx@gnu.org>
parents: 33298
diff changeset
32 ;; should presumably use a vector or list buffer for partial results
cef397782e2e (uudecode-insert-char): Fix bogus feature test.
Dave Love <fx@gnu.org>
parents: 33298
diff changeset
33 ;; rather than with-current-buffer. -- fx
33263
71a0b3b3c21c Use (featurep 'xemacs).
Dave Love <fx@gnu.org>
parents: 31717
diff changeset
34
33813
03ae5e62feb4 comment
Dave Love <fx@gnu.org>
parents: 33566
diff changeset
35 ;; Only `uudecode-decode-region' should be advertised, and whether or
03ae5e62feb4 comment
Dave Love <fx@gnu.org>
parents: 33566
diff changeset
36 ;; not that uses a program should be customizable, but I guess it's
03ae5e62feb4 comment
Dave Love <fx@gnu.org>
parents: 33566
diff changeset
37 ;; too late now. -- fx
03ae5e62feb4 comment
Dave Love <fx@gnu.org>
parents: 33566
diff changeset
38
31717
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
39 ;;; Code:
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
40
33264
88e6276ee7b6 Require cl when compiling.
Dave Love <fx@gnu.org>
parents: 33263
diff changeset
41 (eval-when-compile (require 'cl))
88e6276ee7b6 Require cl when compiling.
Dave Love <fx@gnu.org>
parents: 33263
diff changeset
42
33298
8a75bc99cf0b Avoid compiler warnings.
Dave Love <fx@gnu.org>
parents: 33264
diff changeset
43 (eval-and-compile
8a75bc99cf0b Avoid compiler warnings.
Dave Love <fx@gnu.org>
parents: 33264
diff changeset
44 (defalias 'uudecode-char-int
8a75bc99cf0b Avoid compiler warnings.
Dave Love <fx@gnu.org>
parents: 33264
diff changeset
45 (if (fboundp 'char-int)
8a75bc99cf0b Avoid compiler warnings.
Dave Love <fx@gnu.org>
parents: 33264
diff changeset
46 'char-int
8a75bc99cf0b Avoid compiler warnings.
Dave Love <fx@gnu.org>
parents: 33264
diff changeset
47 'identity))
8a75bc99cf0b Avoid compiler warnings.
Dave Love <fx@gnu.org>
parents: 33264
diff changeset
48
33566
cef397782e2e (uudecode-insert-char): Fix bogus feature test.
Dave Love <fx@gnu.org>
parents: 33298
diff changeset
49 (if (featurep 'xemacs)
33298
8a75bc99cf0b Avoid compiler warnings.
Dave Love <fx@gnu.org>
parents: 33264
diff changeset
50 (defalias 'uudecode-insert-char 'insert-char)
8a75bc99cf0b Avoid compiler warnings.
Dave Love <fx@gnu.org>
parents: 33264
diff changeset
51 (defun uudecode-insert-char (char &optional count ignored buffer)
8a75bc99cf0b Avoid compiler warnings.
Dave Love <fx@gnu.org>
parents: 33264
diff changeset
52 (if (or (null buffer) (eq buffer (current-buffer)))
8a75bc99cf0b Avoid compiler warnings.
Dave Love <fx@gnu.org>
parents: 33264
diff changeset
53 (insert-char char count)
8a75bc99cf0b Avoid compiler warnings.
Dave Love <fx@gnu.org>
parents: 33264
diff changeset
54 (with-current-buffer buffer
8a75bc99cf0b Avoid compiler warnings.
Dave Love <fx@gnu.org>
parents: 33264
diff changeset
55 (insert-char char count))))))
31717
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
56
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
57 (defcustom uudecode-decoder-program "uudecode"
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
58 "*Non-nil value should be a string that names a uu decoder.
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
59 The program should expect to read uu data on its standard
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
60 input and write the converted data to its standard output."
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
61 :type 'string
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
62 :group 'gnus-extract)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
63
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
64 (defcustom uudecode-decoder-switches nil
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
65 "*List of command line flags passed to `uudecode-decoder-program'."
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
66 :group 'gnus-extract
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
67 :type '(repeat string))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
68
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
69 (defconst uudecode-alphabet "\040-\140")
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
70
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
71 (defconst uudecode-begin-line "^begin[ \t]+[0-7][0-7][0-7][ \t]+\\(.*\\)$")
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
72 (defconst uudecode-end-line "^end[ \t]*$")
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
73
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
74 (defconst uudecode-body-line
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
75 (let ((i 61) (str "^M"))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
76 (while (> (setq i (1- i)) 0)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
77 (setq str (concat str "[^a-z]")))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
78 (concat str ".?$")))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
79
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
80 (defvar uudecode-temporary-file-directory
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
81 (cond ((fboundp 'temp-directory) (temp-directory))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
82 ((boundp 'temporary-file-directory) temporary-file-directory)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
83 ("/tmp")))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
84
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
85 ;;;###autoload
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
86 (defun uudecode-decode-region-external (start end &optional file-name)
33566
cef397782e2e (uudecode-insert-char): Fix bogus feature test.
Dave Love <fx@gnu.org>
parents: 33298
diff changeset
87 "Uudecode region between START and END using external program.
cef397782e2e (uudecode-insert-char): Fix bogus feature test.
Dave Love <fx@gnu.org>
parents: 33298
diff changeset
88 If FILE-NAME is non-nil, save the result to FILE-NAME. The program
cef397782e2e (uudecode-insert-char): Fix bogus feature test.
Dave Love <fx@gnu.org>
parents: 33298
diff changeset
89 used is specified by `uudecode-decoder-program'."
31717
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
90 (interactive "r\nP")
33566
cef397782e2e (uudecode-insert-char): Fix bogus feature test.
Dave Love <fx@gnu.org>
parents: 33298
diff changeset
91 (let ((cbuf (current-buffer)) tempfile firstline status)
31717
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
92 (save-excursion
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
93 (goto-char start)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
94 (when (re-search-forward uudecode-begin-line nil t)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
95 (forward-line 1)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
96 (setq firstline (point))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
97 (cond ((null file-name))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
98 ((stringp file-name))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
99 (t
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
100 (setq file-name (read-file-name "File to Name:"
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
101 nil nil nil
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
102 (match-string 1)))))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
103 (setq tempfile (if file-name
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
104 (expand-file-name file-name)
33566
cef397782e2e (uudecode-insert-char): Fix bogus feature test.
Dave Love <fx@gnu.org>
parents: 33298
diff changeset
105 (let ((temporary-file-directory
cef397782e2e (uudecode-insert-char): Fix bogus feature test.
Dave Love <fx@gnu.org>
parents: 33298
diff changeset
106 uudecode-temporary-file-directory))
cef397782e2e (uudecode-insert-char): Fix bogus feature test.
Dave Love <fx@gnu.org>
parents: 33298
diff changeset
107 (make-temp-file "uu"))))
cef397782e2e (uudecode-insert-char): Fix bogus feature test.
Dave Love <fx@gnu.org>
parents: 33298
diff changeset
108 (let ((cdir default-directory)
cef397782e2e (uudecode-insert-char): Fix bogus feature test.
Dave Love <fx@gnu.org>
parents: 33298
diff changeset
109 default-process-coding-system)
31717
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
110 (unwind-protect
33566
cef397782e2e (uudecode-insert-char): Fix bogus feature test.
Dave Love <fx@gnu.org>
parents: 33298
diff changeset
111 (with-temp-buffer
31717
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
112 (insert "begin 600 " (file-name-nondirectory tempfile) "\n")
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
113 (insert-buffer-substring cbuf firstline end)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
114 (cd (file-name-directory tempfile))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
115 (apply 'call-process-region
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
116 (point-min)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
117 (point-max)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
118 uudecode-decoder-program
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
119 nil
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
120 nil
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
121 nil
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
122 uudecode-decoder-switches))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
123 (cd cdir) (set-buffer cbuf)))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
124 (if (file-exists-p tempfile)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
125 (unless file-name
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
126 (goto-char start)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
127 (delete-region start end)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
128 (let (format-alist)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
129 (insert-file-contents-literally tempfile)))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
130 (message "Can not uudecode")))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
131 (ignore-errors (or file-name (delete-file tempfile))))))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
132
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
133 ;;;###autoload
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
134 (defun uudecode-decode-region (start end &optional file-name)
33566
cef397782e2e (uudecode-insert-char): Fix bogus feature test.
Dave Love <fx@gnu.org>
parents: 33298
diff changeset
135 "Uudecode region between START and END without using an external program.
31717
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
136 If FILE-NAME is non-nil, save the result to FILE-NAME."
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
137 (interactive "r\nP")
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
138 (let ((work-buffer nil)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
139 (done nil)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
140 (counter 0)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
141 (remain 0)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
142 (bits 0)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
143 (lim 0) inputpos
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
144 (non-data-chars (concat "^" uudecode-alphabet)))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
145 (unwind-protect
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
146 (save-excursion
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
147 (goto-char start)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
148 (when (re-search-forward uudecode-begin-line nil t)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
149 (cond ((null file-name))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
150 ((stringp file-name))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
151 (t
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
152 (setq file-name (expand-file-name
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
153 (read-file-name "File to Name:"
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
154 nil nil nil
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
155 (match-string 1))))))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
156 (setq work-buffer (generate-new-buffer " *uudecode-work*"))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
157 (forward-line 1)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
158 (skip-chars-forward non-data-chars end)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
159 (while (not done)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
160 (setq inputpos (point))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
161 (setq remain 0 bits 0 counter 0)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
162 (cond
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
163 ((> (skip-chars-forward uudecode-alphabet end) 0)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
164 (setq lim (point))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
165 (setq remain
33263
71a0b3b3c21c Use (featurep 'xemacs).
Dave Love <fx@gnu.org>
parents: 31717
diff changeset
166 (logand (- (uudecode-char-int (char-after inputpos)) 32)
71a0b3b3c21c Use (featurep 'xemacs).
Dave Love <fx@gnu.org>
parents: 31717
diff changeset
167 63))
31717
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
168 (setq inputpos (1+ inputpos))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
169 (if (= remain 0) (setq done t))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
170 (while (and (< inputpos lim) (> remain 0))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
171 (setq bits (+ bits
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
172 (logand
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
173 (-
33263
71a0b3b3c21c Use (featurep 'xemacs).
Dave Love <fx@gnu.org>
parents: 31717
diff changeset
174 (uudecode-char-int (char-after inputpos)) 32)
71a0b3b3c21c Use (featurep 'xemacs).
Dave Love <fx@gnu.org>
parents: 31717
diff changeset
175 63)))
31717
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
176 (if (/= counter 0) (setq remain (1- remain)))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
177 (setq counter (1+ counter)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
178 inputpos (1+ inputpos))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
179 (cond ((= counter 4)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
180 (uudecode-insert-char
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
181 (lsh bits -16) 1 nil work-buffer)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
182 (uudecode-insert-char
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
183 (logand (lsh bits -8) 255) 1 nil work-buffer)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
184 (uudecode-insert-char (logand bits 255) 1 nil
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
185 work-buffer)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
186 (setq bits 0 counter 0))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
187 (t (setq bits (lsh bits 6)))))))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
188 (cond
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
189 (done)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
190 ((> 0 remain)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
191 (error "uucode line ends unexpectly")
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
192 (setq done t))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
193 ((and (= (point) end) (not done))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
194 ;;(error "uucode ends unexpectly")
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
195 (setq done t))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
196 ((= counter 3)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
197 (uudecode-insert-char (logand (lsh bits -16) 255) 1 nil
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
198 work-buffer)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
199 (uudecode-insert-char (logand (lsh bits -8) 255) 1 nil
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
200 work-buffer))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
201 ((= counter 2)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
202 (uudecode-insert-char (logand (lsh bits -10) 255) 1 nil
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
203 work-buffer)))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
204 (skip-chars-forward non-data-chars end))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
205 (if file-name
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
206 (save-excursion
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
207 (set-buffer work-buffer)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
208 (write-file file-name))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
209 (or (markerp end) (setq end (set-marker (make-marker) end)))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
210 (goto-char start)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
211 (insert-buffer-substring work-buffer)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
212 (delete-region (point) end))))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
213 (and work-buffer (kill-buffer work-buffer)))))
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
214
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
215 (provide 'uudecode)
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
216
6b20b7e85e3c *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
217 ;;; uudecode.el ends here