X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=mel-b.el;h=ad34a378d5bcf7b373488ea68f1c5ad6c923ba53;hb=eb9783f46dee7de4c9372e428a26e384e04d60f8;hp=5a0eda23a4c957db983714b4b2d0081d26815b85;hpb=b0992046db3ec7fb35057615ceb7c371d29198c1;p=elisp%2Fflim.git diff --git a/mel-b.el b/mel-b.el index 5a0eda2..ad34a37 100644 --- a/mel-b.el +++ b/mel-b.el @@ -1,205 +1,381 @@ -;;; -;;; $Id: mel-b.el,v 1.6 1995/08/05 00:30:53 morioka Exp $ -;;; +;;; mel-b.el: Base64 encoder/decoder for GNU Emacs + +;; Copyright (C) 1992,1995,1996,1997,1998 Free Software Foundation, Inc. + +;; Author: ENAMI Tsugutomo +;; MORIOKA Tomohiko +;; Created: 1995/6/24 +;; Keywords: MIME, Base64 + +;; This file is part of MEL (MIME Encoding Library). + +;; This program 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. + +;; This program 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. + +;;; Code: + +(require 'emu) +(require 'mime-def) + ;;; @ variables ;;; -(defvar base64-external-encoder '("mmencode") - "*list of base64 encoder program name and its arguments.") +(defgroup base64 nil + "Base64 encoder/decoder" + :group 'mime) + +(defcustom base64-external-encoder '("mmencode") + "*list of base64 encoder program name and its arguments." + :group 'base64 + :type '(cons (file :tag "Command")(repeat :tag "Arguments" string))) -(defvar base64-external-decoder '("mmencode" "-u") - "*list of base64 decoder program name and its arguments.") +(defcustom base64-external-decoder '("mmencode" "-u") + "*list of base64 decoder program name and its arguments." + :group 'base64 + :type '(cons (file :tag "Command")(repeat :tag "Arguments" string))) -(defvar base64-internal-encoding-limit 1000 +(defcustom base64-external-decoder-option-to-specify-file '("-o") + "*list of options of base64 decoder program to specify file." + :group 'base64 + :type '(repeat :tag "Arguments" string)) + +(defcustom base64-internal-encoding-limit 1000 "*limit size to use internal base64 encoder. If size of input to encode is larger than this limit, -external encoder is called.") - -(defvar base64-internal-decoding-limit 1000 +external encoder is called." + :group 'base64 + :type '(choice (const :tag "Always use internal encoder" nil) + (integer :tag "Size"))) + +(defcustom base64-internal-decoding-limit (if (and (featurep 'xemacs) + (featurep 'mule)) + 1000 + 7600) "*limit size to use internal base64 decoder. If size of input to decode is larger than this limit, -external decoder is called.") +external decoder is called." + :group 'base64 + :type '(choice (const :tag "Always use internal decoder" nil) + (integer :tag "Size"))) -;;; @ internal base64 decoder/encoder +;;; @ internal base64 encoder ;;; based on base64 decoder by Enami Tsugutomo -;;; @@ convert from/to base64 char -;;; +(eval-and-compile + (defconst base64-characters + "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/") + ) + +(defmacro base64-num-to-char (n) + `(aref base64-characters ,n)) + +(defun base64-encode-1 (pack) + (let ((a (car pack)) + (b (nth 1 pack)) + (c (nth 2 pack))) + (concat + (char-to-string (base64-num-to-char (ash a -2))) + (if b + (concat + (char-to-string + (base64-num-to-char (logior (ash (logand a 3) 4) (ash b -4)))) + (if c + (concat + (char-to-string + (base64-num-to-char (logior (ash (logand b 15) 2) (ash c -6)))) + (char-to-string (base64-num-to-char (logand c 63))) + ) + (concat (char-to-string + (base64-num-to-char (ash (logand b 15) 2))) "=") + )) + (concat (char-to-string + (base64-num-to-char (ash (logand a 3) 4))) "==") + )))) -(defun base64-num-to-char (n) - (cond ((eq n nil) ?=) - ((< n 26) (+ ?A n)) - ((< n 52) (+ ?a (- n 26))) - ((< n 62) (+ ?0 (- n 52))) - ((= n 62) ?+) - ((= n 63) ?/) - (t (error "not a base64 integer %d" n)))) - -(defun base64-char-to-num (c) - (cond ((and (<= ?A c) (<= c ?Z)) (- c ?A)) - ((and (<= ?a c) (<= c ?z)) (+ (- c ?a) 26)) - ((and (<= ?0 c) (<= c ?9)) (+ (- c ?0) 52)) - ((= c ?+) 62) - ((= c ?/) 63) - ((= c ?=) nil) - (t (error "not a base64 character %c" c)))) - - -;;; @@ encode/decode one base64 unit -;;; +(defun base64-encode-string (string) + "Encode STRING to base64, and return the result." + (let ((len (length string)) + (b 0)(e 57) + dest) + (while (< e len) + (setq dest + (concat dest + (mapconcat + (function base64-encode-1) + (pack-sequence (substring string b e) 3) + "") + "\n")) + (setq b e + e (+ e 57) + ) + ) + (let* ((es (mapconcat + (function base64-encode-1) + (pack-sequence (substring string b) 3) + "")) + (m (mod (length es) 4)) + ) + (concat dest es (cond ((= m 3) "=") + ((= m 2) "==") + )) + ))) -(defun base64-mask (i n) (logand i (1- (ash 1 n)))) +(defun base64-internal-encode-region (beg end) + (save-excursion + (save-restriction + (narrow-to-region beg end) + (let ((str (buffer-substring beg end))) + (delete-region beg end) + (insert (base64-encode-string str)) + ) + (or (bolp) + (insert "\n") + ) + ))) -(defun base64-encode-1 (a &optional b &optional c) - (cons (ash a -2) - (cons (logior (ash (base64-mask a 2) (- 6 2)) - (if b (ash b -4) 0)) - (if b - (cons (logior (ash (base64-mask b 4) (- 6 4)) - (if c (ash c -6) 0)) - (if c - (cons (base64-mask c (- 6 0)) - nil))))))) -(defun base64-decode-1 (a b &optional c &optional d) - (cons (logior (ash a 2) (ash b (- 2 6))) - (if c (cons (logior (ash (base64-mask b 4) 4) - (base64-mask (ash c (- 4 6)) 4)) - (if d (cons (logior (ash (base64-mask c 2) 6) d) - nil)))))) +;;; @ internal base64 decoder +;;; -(defun base64-encode-chars (a &optional b &optional c) - (mapcar (function base64-num-to-char) (base64-encode-1 a b c))) +(defconst base64-numbers + (eval-when-compile + (let ((len (length base64-characters)) + (vec (make-vector 123 nil)) + (i 0)) + (while (< i len) + (aset vec (aref base64-characters i) i) + (setq i (1+ i))) + vec))) + +(defmacro base64-char-to-num (c) + `(aref base64-numbers ,c)) + +(defsubst base64-internal-decode (string buffer) + (let* ((len (length string)) + (i 0) + (j 0) + v1 v2 v3) + (catch 'tag + (while (< i len) + (when (prog1 (setq v1 (base64-char-to-num (aref string i))) + (setq i (1+ i))) + (setq v2 (base64-char-to-num (aref string i)) + i (1+ i) + v3 (base64-char-to-num (aref string i)) + i (1+ i)) + (aset buffer j (logior (lsh v1 2)(lsh v2 -4))) + (setq j (1+ j)) + (if v3 + (let ((v4 (base64-char-to-num (aref string i)))) + (setq i (1+ i)) + (aset buffer j (logior (lsh (logand v2 15) 4)(lsh v3 -2))) + (setq j (1+ j)) + (if v4 + (aset buffer (prog1 j (setq j (1+ j))) + (logior (lsh (logand v3 3) 6) v4)) + (throw 'tag nil) + )) + (throw 'tag nil) + )))) + (substring buffer 0 j) + )) -(defun base64-decode-chars (&rest args) - (apply (function base64-decode-1) - (mapcar (function base64-char-to-num) args) - )) +(defun base64-internal-decode-string (string) + (base64-internal-decode string (make-string (length string) 0))) +;; (defsubst base64-decode-string! (string) +;; (setq string (string-as-unibyte string)) +;; (base64-internal-decode string string)) -;;; @@ encode/decode base64 string -;;; +(defun base64-internal-decode-region (beg end) + (save-excursion + (let ((str (string-as-unibyte (buffer-substring beg end)))) + (delete-region beg end) + (goto-char beg) + (insert (base64-internal-decode str str))))) -(defun base64-encode-string (string) - (let* ((es (mapconcat - (function - (lambda (pack) - (mapconcat (function char-to-string) - (apply (function base64-encode-chars) pack) - "") - )) - (pack-sequence string 3) - "")) - (m (mod (length es) 4)) - ) - (concat es (cond ((= m 3) "=") - ((= m 2) "==") - )) - )) +;; (defun base64-internal-decode-region2 (beg end) +;; (save-excursion +;; (let ((str (buffer-substring beg end))) +;; (delete-region beg end) +;; (goto-char beg) +;; (insert (base64-decode-string! str))))) -(defun base64-decode-string (string) - (mapconcat (function - (lambda (pack) - (mapconcat (function char-to-string) - (apply (function base64-decode-chars) pack) - "") - )) - (pack-sequence string 4) - "")) +;; (defun base64-internal-decode-region3 (beg end) +;; (save-excursion +;; (let ((str (buffer-substring beg end))) +;; (delete-region beg end) +;; (goto-char beg) +;; (insert (base64-internal-decode-string str))))) -;;; @ encode/decode base64 region +;;; @ external encoder/decoder ;;; -(defun base64-internal-decode-region (beg end) +(defun base64-external-encode-region (beg end) (save-excursion (save-restriction (narrow-to-region beg end) + (as-binary-process + (apply (function call-process-region) + beg end (car base64-external-encoder) + t t nil (cdr base64-external-encoder))) + ;; for OS/2 + ;; regularize line break code (goto-char (point-min)) - (while (search-forward "\n" nil t) - (replace-match "") - ) - (let ((str (buffer-substring (point-min)(point-max)))) - (delete-region (point-min)(point-max)) - (insert (base64-decode-string str)) - )))) - -(defun base64-internal-encode-region (beg end) - (save-excursion - (let* ((str (base64-encode-string (buffer-substring beg end))) - (len (length str)) - (i 0) - (j (if (>= len 76) - 76 - len)) - ) - (delete-region beg end) - (goto-char beg) - (while (< j len) - (insert (substring str i j)) - (insert "\n") - (setq i j) - (setq j (+ i 76)) - ) - (insert (substring str i)) + (while (re-search-forward "\r$" nil t) + (replace-match "")) ))) -(cond ((boundp 'MULE) - (define-program-coding-system - nil (car base64-external-encoder) *noconv*) - (define-program-coding-system - nil (car base64-external-decoder) *noconv*) - ) - ((boundp 'NEMACS) - (define-program-kanji-code - nil (car base64-external-encoder) 0) - (define-program-kanji-code - nil (car base64-external-decoder) 0) - )) - -(defun base64-external-encode-region (beg end) - (save-excursion - (apply (function call-process-region) - beg end (car base64-external-encoder) - t t nil (cdr base64-external-encoder)) - )) - (defun base64-external-decode-region (beg end) (save-excursion - (apply (function call-process-region) - beg end (car base64-external-decoder) - t t nil (cdr base64-external-decoder)) + (as-binary-process + (apply (function call-process-region) + beg end (car base64-external-decoder) + t t nil (cdr base64-external-decoder))) )) -(defun base64-encode-region (beg end) +(defun base64-external-decode-string (string) + (with-temp-buffer + (insert string) + (as-binary-process + (apply (function call-process-region) + (point-min) (point-max) + (car base64-external-decoder) + t t nil (cdr base64-external-decoder))) + (buffer-string))) + + +;;; @ application interfaces +;;; + +(defun base64-encode-region (start end) + "Encode current region by base64. +START and END are buffer positions. +This function calls internal base64 encoder if size of region is +smaller than `base64-internal-encoding-limit', otherwise it calls +external base64 encoder specified by `base64-external-encoder'. In +this case, you must install the program (maybe mmencode included in +metamail or XEmacs package)." (interactive "r") (if (and base64-internal-encoding-limit - (> (- end beg) base64-internal-encoding-limit)) - (base64-external-encode-region beg end) - (base64-internal-encode-region beg end) - )) + (> (- end start) base64-internal-encoding-limit)) + (base64-external-encode-region start end) + (base64-internal-encode-region start end))) + +(defun base64-decode-region (start end) + "Decode current region by base64. +START and END are buffer positions. +This function calls internal base64 decoder if size of region is +smaller than `base64-internal-decoding-limit', otherwise it calls +external base64 decoder specified by `base64-external-decoder'. In +this case, you must install the program (maybe mmencode included in +metamail or XEmacs package)." + (interactive "r") + (if (and base64-internal-decoding-limit + (> (- end start) base64-internal-decoding-limit)) + (base64-external-decode-region start end) + (base64-internal-decode-region start end))) -(defun base64-decode-region (beg end) +(defun base64-decode-string (string) + "Decode STRING which is encoded in base64, and return the result. +This function calls internal base64 decoder if size of STRING is +smaller than `base64-internal-decoding-limit', otherwise it calls +external base64 decoder specified by `base64-external-decoder'. In +this case, you must install the program (maybe mmencode included in +metamail or XEmacs package)." (interactive "r") (if (and base64-internal-decoding-limit - (> (- end beg) base64-internal-decoding-limit)) - (base64-external-decode-region beg end) - (base64-internal-decode-region beg end) - )) + (> (length string) base64-internal-decoding-limit)) + (base64-external-decode-string string) + (base64-internal-decode-string string))) + + +(mel-define-method-function (mime-encode-string string (nil "base64")) + 'base64-encode-string) +(mel-define-method-function (mime-decode-string string (nil "base64")) + 'base64-decode-string) +(mel-define-method-function (mime-encode-region start end (nil "base64")) + 'base64-encode-region) +(mel-define-method-function (mime-decode-region start end (nil "base64")) + 'base64-decode-region) + +(mel-define-method-function (encoded-text-encode-string string (nil "B")) + 'base64-encode-string) + +(mel-define-method encoded-text-decode-string (string (nil "B")) + (if (and (string-match B-encoded-text-regexp string) + (string= string (match-string 0 string))) + (base64-decode-string string) + (error "Invalid encoded-text %s" string))) + +(defun base64-insert-encoded-file (filename) + "Encode contents of file FILENAME to base64, and insert the result. +It calls external base64 encoder specified by +`base64-external-encoder'. So you must install the program (maybe +mmencode included in metamail or XEmacs package)." + (interactive (list (read-file-name "Insert encoded file: "))) + (if (and base64-internal-encoding-limit + (> (nth 7 (file-attributes filename)) + base64-internal-encoding-limit)) + (apply (function call-process) (car base64-external-encoder) + filename t nil (cdr base64-external-encoder)) + (insert + (base64-encode-string + (with-temp-buffer + (set-buffer-multibyte nil) + (insert-file-contents-as-binary filename) + (buffer-string)))) + (or (bolp) + (insert "\n")) + )) + +(mel-define-method-function (mime-insert-encoded-file filename (nil "base64")) + 'base64-insert-encoded-file) + +(defun base64-write-decoded-region (start end filename) + "Decode and write current region encoded by base64 into FILENAME. +START and END are buffer positions." + (interactive + (list (region-beginning) (region-end) + (read-file-name "Write decoded region to file: "))) + (if (and base64-internal-decoding-limit + (> (- end start) base64-internal-decoding-limit)) + (as-binary-process + (apply (function call-process-region) + start end (car base64-external-decoder) + nil nil nil + (append (cdr base64-external-decoder) + base64-external-decoder-option-to-specify-file + (list filename)))) + (let ((str (buffer-substring start end))) + (with-temp-buffer + (insert (base64-internal-decode-string str)) + (write-region-as-binary (point-min) (point-max) filename) + )))) +(mel-define-method-function + (mime-write-decoded-region start end filename (nil "base64")) + 'base64-write-decoded-region) + ;;; @ etc ;;; -(defun base64-encoded-length (string) - (let ((len (length string))) - (* (+ (/ len 3) - (if (= (mod len 3) 0) 0 1) - ) 4) - )) - (defun pack-sequence (seq size) "Split sequence SEQ into SIZE elements packs, and return list of packs. [mel-b; tl-seq function]" @@ -224,4 +400,10 @@ and return list of packs. [mel-b; tl-seq function]" (reverse dest) )) + +;;; @ end +;;; + (provide 'mel-b) + +;;; mel-b.el ends here.