mel-b.el

   1 ;;; mel-b.el: Base64 encoder/decoder for GNU Emacs
   2
   3 ;; Copyright (C) 1992,1995,1996,1997,1998 Free Software Foundation, Inc.
   4
   5 ;; Author: ENAMI Tsugutomo <enami@sys.ptg.sony.co.jp>
   6 ;;         MORIOKA Tomohiko <morioka@jaist.ac.jp>
   7 ;; Created: 1995/6/24
   8 ;; Keywords: MIME, Base64
   9
  10 ;; This file is part of MEL (MIME Encoding Library).
  11
  12 ;; This program is free software; you can redistribute it and/or
  13 ;; modify it under the terms of the GNU General Public License as
  14 ;; published by the Free Software Foundation; either version 2, or (at
  15 ;; your option) any later version.
  16
  17 ;; This program is distributed in the hope that it will be useful, but
  18 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  20 ;; General Public License for more details.
  21
  22 ;; You should have received a copy of the GNU General Public License
  23 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  24 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  25 ;; Boston, MA 02111-1307, USA.
  26
  27 ;;; Code:
  28
  29 (require 'emu)
  30
  31
  32 ;;; @ variables
  33 ;;;
  34
  35 (defvar base64-external-encoder '("mmencode")
  36   "*list of base64 encoder program name and its arguments.")
  37
  38 (defvar base64-external-decoder '("mmencode" "-u")
  39   "*list of base64 decoder program name and its arguments.")
  40
  41 (defvar base64-external-decoder-option-to-specify-file '("-o")
  42   "*list of options of base64 decoder program to specify file.")
  43
  44 (defvar base64-internal-encoding-limit 1000
  45   "*limit size to use internal base64 encoder.
  46 If size of input to encode is larger than this limit,
  47 external encoder is called.")
  48
  49 (defvar base64-internal-decoding-limit 1000
  50   "*limit size to use internal base64 decoder.
  51 If size of input to decode is larger than this limit,
  52 external decoder is called.")
  53
  54
  55 ;;; @ internal base64 decoder/encoder
  56 ;;;     based on base64 decoder by Enami Tsugutomo
  57
  58 ;;; @@ convert from/to base64 char
  59 ;;;
  60
  61 (defun base64-num-to-char (n)
  62   (cond ((eq n nil) ?=)
  63         ((< n 26) (+ ?A n))
  64         ((< n 52) (+ ?a (- n 26)))
  65         ((< n 62) (+ ?0 (- n 52)))
  66         ((= n 62) ?+)
  67         ((= n 63) ?/)
  68         (t (error "not a base64 integer %d" n))))
  69
  70 (defun base64-char-to-num (c)
  71   (cond ((and (<= ?A c) (<= c ?Z)) (- c ?A))
  72         ((and (<= ?a c) (<= c ?z)) (+ (- c ?a) 26))
  73         ((and (<= ?0 c) (<= c ?9)) (+ (- c ?0) 52))
  74         ((= c ?+) 62)
  75         ((= c ?/) 63)
  76         ((= c ?=) nil)
  77         (t (error "not a base64 character %c" c))))
  78
  79
  80 ;;; @@ encode/decode one base64 unit
  81 ;;;
  82
  83 (defun base64-encode-1 (pack)
  84   (let ((a (car pack))
  85         (b (nth 1 pack))
  86         (c (nth 2 pack)))
  87     (concat
  88      (char-to-string (base64-num-to-char (ash a -2)))
  89      (if b
  90          (concat
  91           (char-to-string
  92            (base64-num-to-char (logior (ash (logand a 3) 4) (ash b -4))))
  93           (if c
  94               (concat
  95                (char-to-string
  96                 (base64-num-to-char (logior (ash (logand b 15) 2) (ash c -6))))
  97                (char-to-string (base64-num-to-char (logand c 63)))
  98                )
  99             (concat (char-to-string
 100                      (base64-num-to-char (ash (logand b 15) 2))) "=")
 101             ))
 102        (concat (char-to-string
 103                 (base64-num-to-char (ash (logand a 3) 4))) "==")
 104        ))))
 105
 106 (defun base64-decode-1 (pack)
 107   (let ((a (base64-char-to-num (car pack)))
 108         (b (base64-char-to-num (nth 1 pack)))
 109         (c (nth 2 pack))
 110         (d (nth 3 pack)))
 111     (concat (char-to-string (logior (ash a 2) (ash b -4)))
 112             (if (and c (setq c (base64-char-to-num c)))
 113                 (concat (char-to-string
 114                          (logior (ash (logand b 15) 4) (ash c -2)))
 115                         (if (and d (setq d (base64-char-to-num d)))
 116                             (char-to-string (logior (ash (logand c 3) 6) d))
 117                           ))))))
 118
 119
 120 ;;; @@ base64 encoder/decoder for string
 121 ;;;
 122
 123 (defun base64-encode-string (string)
 124   "Encode STRING to base64, and return the result."
 125   (let ((len (length string))
 126         (b 0)(e 57)
 127         dest)
 128     (while (< e len)
 129       (setq dest
 130             (concat dest
 131                     (mapconcat
 132                      (function base64-encode-1)
 133                      (pack-sequence (substring string b e) 3)
 134                      "")
 135                     "\n"))
 136       (setq b e
 137             e (+ e 57)
 138             )
 139       )
 140     (let* ((es (mapconcat
 141                 (function base64-encode-1)
 142                 (pack-sequence (substring string b) 3)
 143                 ""))
 144            (m (mod (length es) 4))
 145            )
 146       (concat dest es (cond ((= m 3) "=")
 147                             ((= m 2) "==")
 148                             ))
 149       )))
 150
 151 (defun base64-decode-string (string)
 152   "Decode STRING which is encoded in base64, and return the result."
 153   (mapconcat (function base64-decode-1)
 154              (pack-sequence string 4)
 155              ""))
 156
 157
 158 ;;; @ base64 encoder/decoder for region
 159 ;;;
 160
 161 (defun base64-internal-encode-region (beg end)
 162   (save-excursion
 163     (save-restriction
 164       (narrow-to-region beg end)
 165       (let ((str (buffer-substring beg end)))
 166         (delete-region beg end)
 167         (insert (base64-encode-string str))
 168         )
 169       (or (bolp)
 170           (insert "\n")
 171           )
 172       )))
 173
 174 (defun base64-internal-decode-region (beg end)
 175   (save-excursion
 176     (save-restriction
 177       (narrow-to-region beg end)
 178       (goto-char (point-min))
 179       (while (looking-at ".*\n")
 180         (condition-case err
 181             (replace-match
 182              (base64-decode-string
 183               (buffer-substring (match-beginning 0) (1- (match-end 0))))
 184              t t)
 185           (error
 186            (prog1
 187                (message (nth 1 err))
 188              (replace-match "")))))
 189       (if (looking-at ".*$")
 190           (condition-case err
 191               (replace-match
 192                (base64-decode-string
 193                 (buffer-substring (match-beginning 0) (match-end 0)))
 194                t t)
 195             (error
 196              (prog1
 197                  (message (nth 1 err))
 198                (replace-match "")))
 199             ))
 200       )))
 201
 202 (defun base64-external-encode-region (beg end)
 203   (save-excursion
 204     (save-restriction
 205       (narrow-to-region beg end)
 206       (as-binary-process (apply (function call-process-region)
 207                                 beg end (car base64-external-encoder)
 208                                 t t nil (cdr base64-external-encoder))
 209                          )
 210       ;; for OS/2
 211       ;;   regularize line break code
 212       (goto-char (point-min))
 213       (while (re-search-forward "\r$" nil t)
 214         (replace-match "")
 215         )
 216       )))
 217
 218 (defun base64-external-decode-region (beg end)
 219   (save-excursion
 220     (as-binary-process (apply (function call-process-region)
 221                               beg end (car base64-external-decoder)
 222                               t t nil (cdr base64-external-decoder))
 223                        )))
 224
 225 (defun base64-encode-region (start end)
 226   "Encode current region by base64.
 227 START and END are buffer positions.
 228 This function calls internal base64 encoder if size of region is
 229 smaller than `base64-internal-encoding-limit', otherwise it calls
 230 external base64 encoder specified by `base64-external-encoder'.  In
 231 this case, you must install the program (maybe mmencode included in
 232 metamail or XEmacs package)."
 233   (interactive "r")
 234   (if (and base64-internal-encoding-limit
 235            (> (- end start) base64-internal-encoding-limit))
 236       (base64-external-encode-region start end)
 237     (base64-internal-encode-region start end)
 238     ))
 239
 240 (defun base64-decode-region (start end)
 241   "Decode current region by base64.
 242 START and END are buffer positions.
 243 This function calls internal base64 decoder if size of region is
 244 smaller than `base64-internal-decoding-limit', otherwise it calls
 245 external base64 decoder specified by `base64-external-decoder'.  In
 246 this case, you must install the program (maybe mmencode included in
 247 metamail or XEmacs package)."
 248   (interactive "r")
 249   (if (and base64-internal-decoding-limit
 250            (> (- end start) base64-internal-decoding-limit))
 251       (base64-external-decode-region start end)
 252     (base64-internal-decode-region start end)
 253     ))
 254
 255
 256 ;;; @ base64 encoder/decoder for file
 257 ;;;
 258
 259 (defun base64-insert-encoded-file (filename)
 260   "Encode contents of file FILENAME to base64, and insert the result.
 261 It calls external base64 encoder specified by
 262 `base64-external-encoder'.  So you must install the program (maybe
 263 mmencode included in metamail or XEmacs package)."
 264   (interactive (list (read-file-name "Insert encoded file: ")))
 265   (apply (function call-process) (car base64-external-encoder)
 266          filename t nil (cdr base64-external-encoder))
 267   )
 268
 269 (defun base64-write-decoded-region (start end filename)
 270   "Decode and write current region encoded by base64 into FILENAME.
 271 START and END are buffer positions."
 272   (interactive
 273    (list (region-beginning) (region-end)
 274          (read-file-name "Write decoded region to file: ")))
 275   (as-binary-process
 276    (apply (function call-process-region)
 277           start end (car base64-external-decoder)
 278           nil nil nil
 279           (append (cdr base64-external-decoder)
 280                   base64-external-decoder-option-to-specify-file
 281                   (list filename))
 282           )))
 283
 284
 285 ;;; @ etc
 286 ;;;
 287
 288 (defun base64-encoded-length (string)
 289   (let ((len (length string)))
 290     (* (+ (/ len 3)
 291           (if (= (mod len 3) 0) 0 1)
 292           ) 4)
 293     ))
 294
 295 (defun pack-sequence (seq size)
 296   "Split sequence SEQ into SIZE elements packs,
 297 and return list of packs. [mel-b; tl-seq function]"
 298   (let ((len (length seq)) (p 0) obj
 299         unit (i 0)
 300         dest)
 301     (while (< p len)
 302       (setq obj (elt seq p))
 303       (setq unit (cons obj unit))
 304       (setq i (1+ i))
 305       (if (= i size)
 306           (progn
 307             (setq dest (cons (reverse unit) dest))
 308             (setq unit nil)
 309             (setq i 0)
 310             ))
 311       (setq p (1+ p))
 312       )
 313     (if unit
 314         (setq dest (cons (reverse unit) dest))
 315       )
 316     (reverse dest)
 317     ))
 318
 319
 320 ;;; @ end
 321 ;;;
 322
 323 (provide 'mel-b)
 324
 325 ;;; mel-b.el ends here.