From 3f76edebc13080b6006c35524edfa33d7a92a2e9 Mon Sep 17 00:00:00 2001 From: morioka Date: Thu, 17 Sep 1998 03:29:34 +0000 Subject: [PATCH] Split into mel-b-el.el. --- mel-b.el | 345 ++++---------------------------------------------------------- 1 file changed, 19 insertions(+), 326 deletions(-) diff --git a/mel-b.el b/mel-b.el index ae5472a..8b9e763 100644 --- a/mel-b.el +++ b/mel-b.el @@ -1,13 +1,11 @@ ;;; mel-b.el: Base64 encoder/decoder for GNU Emacs -;; Copyright (C) 1992,1995,1996,1997,1998 Free Software Foundation, Inc. +;; Copyright (C) 1998 Free Software Foundation, Inc. -;; Author: ENAMI Tsugutomo -;; MORIOKA Tomohiko -;; Created: 1995/6/24 +;; Author: MORIOKA Tomohiko ;; Keywords: MIME, Base64 -;; This file is part of MEL (MIME Encoding Library). +;; This file is part of FLIM (Faithful Library about Internet Message). ;; This program is free software; you can redistribute it and/or ;; modify it under the terms of the GNU General Public License as @@ -26,307 +24,26 @@ ;;; Code: -(require 'emu) -(require 'mime-def) +(defvar base64-dl-module + (and (fboundp 'dynamic-link) + (let ((path (expand-file-name "base64.so" exec-directory))) + (and (file-exists-p path) + path)))) -;;; @ variables +;;; @ implementations ;;; -(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))) - -(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))) - -(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." - :group 'base64 - :type '(choice (const :tag "Always use internal encoder" nil) - (integer :tag "Size"))) - -(defcustom base64-internal-decoding-limit 70000 - "*limit size to use internal base64 decoder. -If size of input to decode is larger than this limit, -external decoder is called." - :group 'base64 - :type '(choice (const :tag "Always use internal decoder" nil) - (integer :tag "Size"))) - - -;;; @ internal base64 encoder -;;; based on base64 decoder by Enami Tsugutomo - -(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-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-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") - ) - ))) - - -;;; @ internal base64 decoder -;;; - -(defconst base64-numbers - `,(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-internal-decode-string (string) - (base64-internal-decode string (make-string (length string) 0))) - -(defsubst base64-decode-string! (string) - (base64-internal-decode string string)) - -(defun base64-internal-decode-region (beg end) - (save-excursion - (let ((str (buffer-substring beg end))) - (delete-region beg end) - (goto-char beg) - (insert (base64-decode-string! str))))) - - -;;; @ external encoder/decoder -;;; - -(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 (re-search-forward "\r$" nil t) - (replace-match "")) - ))) - -(defun base64-external-decode-region (beg end) - (save-excursion - (as-binary-process - (apply (function call-process-region) - beg end (car base64-external-decoder) - t t nil (cdr base64-external-decoder))) - )) - -(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 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-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 - (> (length string) base64-internal-decoding-limit)) - (base64-external-decode-string string) - (base64-internal-decode-string 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 - (insert-file-contents-as-binary filename) - (buffer-string)))) - (or (bolp) - (insert "\n")) - )) - -(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))))) - - -;;; @ etc -;;; +(cond (base64-dl-module + (require 'mel-b-dl) + ) + ((and (featurep 'mule) + (not (featurep 'xemacs))) + (require 'mel-b-ccl) + ) + (t + (require 'mel-b-el) + )) (defun base64-encoded-length (string) (let ((len (length string))) @@ -335,30 +52,6 @@ START and END are buffer positions." ) 4) )) -(defun pack-sequence (seq size) - "Split sequence SEQ into SIZE elements packs, -and return list of packs. [mel-b; tl-seq function]" - (let ((len (length seq)) (p 0) obj - unit (i 0) - dest) - (while (< p len) - (setq obj (elt seq p)) - (setq unit (cons obj unit)) - (setq i (1+ i)) - (if (= i size) - (progn - (setq dest (cons (reverse unit) dest)) - (setq unit nil) - (setq i 0) - )) - (setq p (1+ p)) - ) - (if unit - (setq dest (cons (reverse unit) dest)) - ) - (reverse dest) - )) - ;;; @ end ;;; -- 1.7.10.4