From: shuhei-k Date: Sat, 22 May 1999 16:52:18 +0000 (+0000) Subject: Update header. X-Git-Tag: flim-1_12_7~26 X-Git-Url: http://git.chise.org/gitweb/?a=commitdiff_plain;h=a774d9cb6a661989dce947091cf8b6e880060bb4;p=elisp%2Fflim.git Update header. Don't require 'poe; it is required implicitly via 'mime-def. (pack-sequence): Moved to top of the function definitions. (base64-encode-string): Calculate padding first. (base64-internal-encode-region): Changed order of evaluation to "encode, delete, then insert". (base64-internal-decode-string): Changed order of evaluation to "decode, delete, then insert". (base64-encode-region): Use read-only `interactive' spec. (base64-decode-region): Ditto. (base64-decode-string): Not interactive. (encoded-text-decode-string): Anchor regexp with "\\`" and "\\'". (base64-insert-encoded-file): Use built-in `interactive' spec. (base64-write-decoded-region): Ditto. --- diff --git a/mel-b-el.el b/mel-b-el.el index 7426cc5..859ee25 100644 --- a/mel-b-el.el +++ b/mel-b-el.el @@ -1,13 +1,13 @@ -;;; mel-b-el.el: Base64 encoder/decoder for GNU Emacs +;;; mel-b-el.el --- Base64 encoder/decoder. ;; Copyright (C) 1992,1995,1996,1997,1998 Free Software Foundation, Inc. ;; Author: ENAMI Tsugutomo -;; MORIOKA Tomohiko +;; MORIOKA Tomohiko ;; Created: 1995/6/24 ;; 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 @@ -20,13 +20,12 @@ ;; 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 +;; along with this program; 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 'poe) (require 'mime-def) @@ -72,6 +71,30 @@ external decoder is called." (integer :tag "Size"))) +;;; @ utility function +;;; + +(defun pack-sequence (seq size) + "Split sequence SEQ into SIZE elements packs, and return list of packs. +\[mel-b-el; tl-seq function]" + (let ((len (length seq)) + (i 0)(p 0) + dest unit) + (while (< p len) + (setq unit (cons (elt seq p) unit)) + (setq i (1+ i)) + (setq p (1+ p)) + (if (= i size) + (progn + (setq dest (cons (nreverse unit) dest)) + (setq unit nil) + (setq i 0)))) + (nreverse + (if unit + (cons (nreverse unit) dest) + dest)))) + + ;;; @ internal base64 encoder ;;; based on base64 decoder by Enami Tsugutomo @@ -97,20 +120,18 @@ external decoder is called." (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))) - ) + (char-to-string (base64-num-to-char (logand c 63)))) (concat (char-to-string - (base64-num-to-char (ash (logand b 15) 2))) "=") - )) + (base64-num-to-char (ash (logand b 15) 2))) "="))) (concat (char-to-string - (base64-num-to-char (ash (logand a 3) 4))) "==") - )))) + (base64-num-to-char (ash (logand a 3) 4))) "=="))))) (defun-maybe base64-encode-string (string) "Encode STRING to base64, and return the result." - (let ((len (length string)) - (b 0)(e 57) - dest) + (let* ((len (length string)) + (m (mod len 3)) + (b 0)(e 57) + dest) (while (< e len) (setq dest (concat dest @@ -120,32 +141,25 @@ external decoder is called." "") "\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) "==") - )) - ))) + e (+ e 57))) + (concat dest + (mapconcat + (function base64-encode-1) + (pack-sequence (substring string b) 3) + "") + (cond ((= m 2) "=") + ((= m 1) "=="))))) (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") - ) - ))) + (insert + (prog1 + (base64-encode-string + (buffer-substring beg end)) + (delete-region beg end))) + (or (bolp) (insert ?\n))))) ;;; @ internal base64 decoder @@ -166,8 +180,7 @@ external decoder is called." (defsubst base64-internal-decode (string buffer) (let* ((len (length string)) - (i 0) - (j 0) + (i 0)(j 0) v1 v2 v3) (catch 'tag (while (< i len) @@ -187,12 +200,9 @@ external decoder is called." (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) - )) + (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))) @@ -204,9 +214,10 @@ external decoder is called." (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))))) + (insert + (prog1 + (base64-internal-decode str str) + (delete-region beg end)))))) ;; (defun base64-internal-decode-region2 (beg end) ;; (save-excursion @@ -233,30 +244,30 @@ external decoder is called." (as-binary-process (apply (function call-process-region) beg end (car base64-external-encoder) - t t nil (cdr 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 "")) - ))) + (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))) - )) + 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))) + (point-min)(point-max) (car base64-external-decoder) + t t nil + (cdr base64-external-decoder))) (buffer-string))) @@ -271,7 +282,7 @@ 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") + (interactive "*r") (if (and base64-internal-encoding-limit (> (- end start) base64-internal-encoding-limit)) (base64-external-encode-region start end) @@ -285,7 +296,7 @@ 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") + (interactive "*r") (if (and base64-internal-decoding-limit (> (- end start) base64-internal-decoding-limit)) (base64-external-decode-region start end) @@ -298,7 +309,6 @@ 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) @@ -318,8 +328,9 @@ metamail or XEmacs package)." '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))) + (if (string-match (eval-when-compile + (concat "\\`" B-encoded-text-regexp "\\'")) + string) (base64-decode-string string) (error "Invalid encoded-text %s" string))) @@ -328,21 +339,21 @@ metamail or XEmacs package)." 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: "))) + (interactive "*fInsert 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)) + (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")) - )) + (or (bolp) (insert ?\n)))) (mel-define-method-function (mime-insert-encoded-file filename (nil "base64")) 'base64-insert-encoded-file) @@ -350,9 +361,7 @@ mmencode included in metamail or XEmacs package)." (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: "))) + (interactive "*r\nFWrite decoded region to file: ") (if (and base64-internal-decoding-limit (> (- end start) base64-internal-decoding-limit)) (as-binary-process @@ -365,42 +374,13 @@ START and END are buffer positions." (let ((str (buffer-substring start end))) (with-temp-buffer (insert (base64-internal-decode-string str)) - (write-region-as-binary (point-min) (point-max) filename) - )))) + (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 pack-sequence (seq size) - "Split sequence SEQ into SIZE elements packs, -and return list of packs. [mel-b-el; 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 ;;;