Mercurial > hg > xemacs-beta

comparison lisp/w3/base64.el @ 80:1ce6082ce73f r20-0b90

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-0b90
author cvs
date Mon, 13 Aug 2007 09:06:37 +0200
parents 9ee227acff29
children 0293115a14e9
comparison
equal deleted inserted replaced
79:5b0a5bbffab6 80:1ce6082ce73f
1 ;;; base64.el,v --- Base64 encoding functions
2 ;; Author: wmperry
3 ;; Created: 1996/04/22 15:08:08
4 ;; Version: 1.7
5 ;; Keywords: extensions
6
7 ;;; LCD Archive Entry:
8 ;;; base64.el|William M. Perry|wmperry@cs.indiana.edu|
9 ;;; Package for encoding/decoding base64 data (MIME)|
10 ;;; 1996/04/22 15:08:08|1.7|Location Undetermined
11 ;;;
12
13 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
14 ;;; Copyright (c) 1996 Free Software Foundation, Inc.
15 ;;; Copyright (c) 1995, 1996 by William M. Perry (wmperry@cs.indiana.edu)
16 ;;;
17 ;;; This file is not part of GNU Emacs, but the same permissions apply.
18 ;;;
19 ;;; GNU Emacs is free software; you can redistribute it and/or modify
20 ;;; it under the terms of the GNU General Public License as published by
21 ;;; the Free Software Foundation; either version 2, or (at your option)
22 ;;; any later version.
23 ;;;
24 ;;; GNU Emacs is distributed in the hope that it will be useful,
25 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
26 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
27 ;;; GNU General Public License for more details.
28 ;;;
29 ;;; You should have received a copy of the GNU General Public License
30 ;;; along with GNU Emacs; see the file COPYING. If not, write to the
31 ;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
32 ;;; Boston, MA 02111-1307, USA.
33 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
34
35 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
36 ;;; Base 64 encoding functions
37 ;;; This code was converted to lisp code by me from the C code in
38 ;;; ftp://cs.utk.edu/pub/MIME/b64encode.c
39 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
40
41 (defvar base64-code-string
42 "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
43 "Character set used for base64 decoding")
44
45 (defvar base64-decode-vector
46 (let ((vec (make-vector 256 nil))
47 (i 0)
48 (case-fold-search nil))
49 (while (< i 256)
50 (aset vec i (string-match (regexp-quote (char-to-string i))
51 base64-code-string))
52 (setq i (1+ i)))
53 vec))
54
55 (defvar base64-max-line-length 64)
56
57 ;(defun b0 (x) (aref base64-code-string (logand (lsh x -18) 63)))
58 ;(defun b1 (x) (aref base64-code-string (logand (lsh x -12) 63)))
59 ;(defun b2 (x) (aref base64-code-string (logand (lsh x -6) 63)))
60 ;(defun b3 (x) (aref base64-code-string (logand x 63)))
61
62 (defmacro b0 (x) (` (aref base64-code-string (logand (lsh (, x) -18) 63))))
63 (defmacro b1 (x) (` (aref base64-code-string (logand (lsh (, x) -12) 63))))
64 (defmacro b2 (x) (` (aref base64-code-string (logand (lsh (, x) -6) 63))))
65 (defmacro b3 (x) (` (aref base64-code-string (logand (, x) 63))))
66
67 (defun base64-encode (str)
68 "Do base64 encoding on string STR and return the encoded string.
69 This code was converted to lisp code by me from the C code in
70 ftp://cs.utk.edu/pub/MIME/b64encode.c. Returns a string that is
71 broken into `base64-max-line-length' byte lines."
72 (or str (setq str (buffer-string)))
73 (let ((x (base64-encode-internal str))
74 (y ""))
75 (while (> (length x) base64-max-line-length)
76 (setq y (concat y (substring x 0 base64-max-line-length) "\n")
77 x (substring x base64-max-line-length nil)))
78 (setq y (concat y x))
79 y))
80
81 (defun base64-encode-internal (str)
82 "Do base64 encoding on string STR and return the encoded string.
83 This code was converted to lisp code by me from the C code in
84 ftp://cs.utk.edu/pub/MIME/b64encode.c. Returns the entire string,
85 not broken up into `base64-max-line-length' byte lines."
86 (let (
87 (word 0) ; The word to translate
88 w1 w2 w3
89 )
90 (cond
91 ((> (length str) 3)
92 (concat
93 (base64-encode-internal (substring str 0 3))
94 (base64-encode-internal (substring str 3 nil))))
95 ((= (length str) 3)
96 (setq w1 (aref str 0)
97 w2 (aref str 1)
98 w3 (aref str 2)
99 word (logior
100 (lsh (logand w1 255) 16)
101 (lsh (logand w2 255) 8)
102 (logand w3 255)))
103 (format "%c%c%c%c" (b0 word) (b1 word) (b2 word) (b3 word)))
104 ((= (length str) 2)
105 (setq w1 (aref str 0)
106 w2 (aref str 1)
107 word (logior
108 (lsh (logand w1 255) 16)
109 (lsh (logand w2 255) 8)
110 0))
111 (format "%c%c%c=" (b0 word) (b1 word) (b2 word)))
112 ((= (length str) 1)
113 (setq w1 (aref str 0)
114 word (logior
115 (lsh (logand w1 255) 16)
116 0))
117 (format "%c%c==" (b0 word) (b1 word)))
118 (t ""))))
119
120 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
121 ;;; Base64 decoding functions
122 ;;; Most of the decoding code is courtesy Francesco Potorti`
123 ;;; <F.Potorti@cnuce.cnr.it>
124 ;;; this is much faster than my original code - thanks!
125 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
126 (defun base64-decode-region (beg end)
127 (interactive "r")
128 (barf-if-buffer-read-only)
129 (let
130 ((exchange (= (point) beg))
131 (endchars 0)
132 (list) (code))
133 (goto-char beg)
134 (while (< (point) end)
135 (setq list (mapcar
136 (function
137 (lambda (c)
138 (cond
139 ((aref base64-decode-vector c))
140 ((char-equal c ?=)
141 (setq endchars (1+ endchars))
142 0)
143 (nil
144 (error
145 "Character %c does not match Mime base64 coding" c)))))
146 (buffer-substring (point) (+ (point) 4))))
147 (setq code (+ (nth 3 list) (lsh (nth 2 list) 6)
148 (lsh (nth 1 list) 12) (lsh (car list) 18)))
149 (delete-char 4)
150 (cond
151 ((zerop endchars)
152 (insert (% (lsh code -16) 256) (% (lsh code -8) 256) (% code 256)))
153 ((= endchars 1)
154 (insert (% (lsh code -16) 256) (% (lsh code -8) 256))
155 (setq end (point)))
156 ((= endchars 2)
157 (insert (% (lsh code -16) 256))
158 (setq end (point))))
159 (if (char-equal (following-char) ?\n)
160 (progn (delete-char 1)
161 (setq end (- end 2)))
162 (setq end (1- end))))
163 ))
164 ; (if exchange
165 ; (exchange-point-and-mark))))
166
167 (defun base64-decode (st &optional nd)
168 "Do base64 decoding on string STR and return the original string.
169 If given buffer positions, destructively decodes that area of the
170 current buffer."
171 (let ((replace-p nil)
172 (retval nil))
173 (if (stringp st)
174 nil
175 (setq st (prog1
176 (buffer-substring st (or nd (point-max)))
177 (delete-region st (or nd (point-max))))
178 replace-p t))
179 (setq retval
180 (save-excursion
181 (set-buffer (get-buffer-create " *b64decode*"))
182 (erase-buffer)
183 (insert st)
184 (goto-char (point-min))
185 (while (re-search-forward "\r*\n" nil t)
186 (replace-match ""))
187 (goto-char (point-min))
188 (base64-decode-region (point-min) (point-max))
189 (buffer-string)))
190 (if replace-p (insert retval))
191 retval))
192
193 (provide 'base64)