From: morioka Date: Sun, 11 Jan 1998 17:21:05 +0000 (+0000) Subject: MEL 6.9. X-Git-Tag: mel-6_9 X-Git-Url: http://git.chise.org/gitweb/?a=commitdiff_plain;h=7bb0094f7461560877244e77534cde7dd41766cd;p=elisp%2Fflim.git MEL 6.9. --- diff --git a/mel-b.el b/mel-b.el index 6db350e..1ea0cb4 100644 --- a/mel-b.el +++ b/mel-b.el @@ -1,34 +1,35 @@ -;;; ;;; mel-b.el: Base64 encoder/decoder for GNU Emacs -;;; -;;; Copyright (C) 1995 Free Software Foundation, Inc. -;;; Copyright (C) 1995,1996 MORIOKA Tomohiko -;;; -;;; Author: MORIOKA Tomohiko -;;; Maintainer: MORIOKA Tomohiko -;;; Created: 1995/6/24 -;;; Version: -;;; $Id: mel-b.el,v 3.2 1996/01/09 18:25:22 morioka Exp $ -;;; 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 This program. If not, write to the Free Software -;;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. -;;; + +;; Copyright (C) 1992,1995,1996,1997 Free Software Foundation, Inc. + +;; Author: ENAMI Tsugutomo +;; MORIOKA Tomohiko +;; Maintainer: MORIOKA Tomohiko +;; Created: 1995/6/24 +;; Version: $Id: mel-b.el,v 6.3 1997/04/30 17:17:42 morioka Exp $ +;; 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) + ;;; @ variables ;;; @@ -78,39 +79,48 @@ external decoder is called.") ;;; @@ encode/decode one base64 unit ;;; -(defun base64-mask (i n) (logand i (1- (ash 1 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)))))) - -(defun base64-encode-chars (a &optional b &optional c) - (mapcar (function base64-num-to-char) (base64-encode-1 a b c))) - -(defun base64-decode-chars (&rest args) - (apply (function base64-decode-1) - (mapcar (function base64-char-to-num) args) - )) - - -;;; @@ encode/decode base64 string +(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-decode-1 (pack) + (let ((a (base64-char-to-num (car pack))) + (b (base64-char-to-num (nth 1 pack))) + (c (nth 2 pack)) + (d (nth 3 pack))) + (concat (char-to-string (logior (ash a 2) (ash b -4))) + (if (and c (setq c (base64-char-to-num c))) + (concat (char-to-string + (logior (ash (logand b 15) 4) (ash c -2))) + (if (and d (setq d (base64-char-to-num d))) + (char-to-string (logior (ash (logand c 3) 6) d)) + )))))) + + +;;; @@ base64 encoder/decoder for string ;;; (defun base64-encode-string (string) + "Encode STRING to base64, and return the result." (let ((len (length string)) (b 0)(e 57) dest) @@ -118,12 +128,7 @@ external decoder is called.") (setq dest (concat dest (mapconcat - (function - (lambda (pack) - (mapconcat (function char-to-string) - (apply (function base64-encode-chars) pack) - "") - )) + (function base64-encode-1) (pack-sequence (substring string b e) 3) "") "\n")) @@ -132,12 +137,7 @@ external decoder is called.") ) ) (let* ((es (mapconcat - (function - (lambda (pack) - (mapconcat (function char-to-string) - (apply (function base64-encode-chars) pack) - "") - )) + (function base64-encode-1) (pack-sequence (substring string b) 3) "")) (m (mod (length es) 4)) @@ -148,17 +148,13 @@ external decoder is called.") ))) (defun base64-decode-string (string) - (mapconcat (function - (lambda (pack) - (mapconcat (function char-to-string) - (apply (function base64-decode-chars) pack) - "") - )) + "Decode STRING which is encoded in base64, and return the result." + (mapconcat (function base64-decode-1) (pack-sequence string 4) "")) -;;; @ encode/decode base64 region +;;; @ base64 encoder/decoder for region ;;; (defun base64-internal-encode-region (beg end) @@ -179,38 +175,37 @@ external decoder is called.") (save-restriction (narrow-to-region beg end) (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)) - )))) - -(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) - )) + (while (looking-at ".*\n") + (condition-case err + (replace-match + (base64-decode-string + (buffer-substring (match-beginning 0) (1- (match-end 0)))) + t t) + (error + (prog1 + (message (nth 1 err)) + (replace-match ""))))) + (if (looking-at ".*$") + (condition-case err + (replace-match + (base64-decode-string + (buffer-substring (match-beginning 0) (match-end 0))) + t t) + (error + (prog1 + (message (nth 1 err)) + (replace-match ""))) + )) + ))) (defun base64-external-encode-region (beg end) (save-excursion (save-restriction (narrow-to-region beg end) - (let ((selective-display nil) ;Disable ^M to nl translation. - (mc-flag nil) ;Mule - (kanji-flag nil)) ;NEmacs - (apply (function call-process-region) - beg end (car base64-external-encoder) - t t nil (cdr base64-external-encoder)) - ) + (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)) @@ -221,31 +216,56 @@ external decoder is called.") (defun base64-external-decode-region (beg end) (save-excursion - (let ((selective-display nil) ;Disable ^M to nl translation. - (mc-flag nil) ;Mule - (kanji-flag nil)) ;NEmacs - (apply (function call-process-region) - beg end (car base64-external-decoder) - t t nil (cdr base64-external-decoder)) - ))) - -(defun base64-encode-region (beg end) + (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 (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 (beg 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 beg) base64-internal-decoding-limit)) - (base64-external-decode-region beg end) - (base64-internal-decode-region beg end) + (> (- end start) base64-internal-decoding-limit)) + (base64-external-decode-region start end) + (base64-internal-decode-region start end) )) +;;; @ base64 encoder/decoder for file +;;; + +(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: "))) + (apply (function call-process) (car base64-external-encoder) + filename t nil (cdr base64-external-encoder)) + ) + + ;;; @ etc ;;; @@ -285,3 +305,5 @@ and return list of packs. [mel-b; tl-seq function]" ;;; (provide 'mel-b) + +;;; mel-b.el ends here. diff --git a/mel-g.el b/mel-g.el index fdc5ddb..1f50bd0 100644 --- a/mel-g.el +++ b/mel-g.el @@ -1,86 +1,98 @@ -;;; ;;; mel-g.el: Gzip64 encoder/decoder for GNU Emacs -;;; -;;; Copyright (C) 1995,1996 MORIOKA Tomohiko -;;; Copyright (C) 1996 Shuhei KOBAYASHI -;;; -;;; Author: MORIOKA Tomohiko -;;; Shuhei KOBAYASHI -;;; Created: 1995/10/25 -;;; Version: -;;; $Id: mel-g.el,v 1.1 1996/03/11 17:01:45 shuhei Exp $ -;;; Keywords: MIME, base64, gzip -;;; -;;; This file is not part of MEL (MIME Encoding Library) yet. -;;; -;;; 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 This program. If not, write to the Free Software -;;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. -;;; + +;; Copyright (C) 1995,1996,1997 MORIOKA Tomohiko +;; Copyright (C) 1996 Shuhei KOBAYASHI + +;; Author: Shuhei KOBAYASHI +;; modified by MORIOKA Tomohiko +;; Maintainer: Shuhei KOBAYASHI +;; Created: 1995/10/25 +;; Version: $Id: mel-g.el,v 6.1 1997/03/10 13:06:34 morioka Exp $ +;; Keywords: Gzip64, base64, gzip, MIME + +;; This file is not part of MEL (MIME Encoding Library) yet. + +;; 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 'file-detect) + + ;;; @ variables ;;; -(defvar gzip64-external-encoder '("sh" "-c" "gzip -c | mmencode") +(defvar gzip64-external-encoder + (let ((file (exec-installed-p "mmencode"))) + (and file + (` ("sh" "-c" (, (concat "gzip -c | " file)))) + )) "*list of gzip64 encoder program name and its arguments.") -(defvar gzip64-external-decoder '("sh" "-c" "mmencode -u | gzip -dc") +(defvar gzip64-external-decoder + (let ((file (exec-installed-p "mmencode"))) + (and file + (` ("sh" "-c" (, (concat file " -u | gzip -dc")))) + )) "*list of gzip64 decoder program name and its arguments.") -;;; @ external encoder +;;; @ encoder/decoder for region ;;; -(cond ((boundp 'MULE) - (define-program-coding-system - nil (car gzip64-external-encoder) *noconv*) - (define-program-coding-system - nil (car gzip64-external-decoder) *noconv*) - ) - ((boundp 'NEMACS) - (define-program-kanji-code - nil (car gzip64-external-encoder) 0) - (define-program-kanji-code - nil (car gzip64-external-decoder) 0) - )) - (defun gzip64-external-encode-region (beg end) (interactive "*r") (save-excursion - (let (selective-display ; Disable ^M to nl translation. - mc-flag ; for Mule - kanji-flag) ; for NEmacs - (apply (function call-process-region) - beg end (car gzip64-external-encoder) - t t nil (cdr gzip64-external-encoder)) - ))) + (as-binary-process (apply (function call-process-region) + beg end (car gzip64-external-encoder) + t t nil (cdr gzip64-external-encoder)) + ) + ;; for OS/2 + ;; regularize line break code + (goto-char (point-min)) + (while (re-search-forward "\r$" nil t) + (replace-match "") + ) + )) (defun gzip64-external-decode-region (beg end) (interactive "*r") (save-excursion - (let ((selective-display nil) ; Disable ^M to nl translation. - (mc-flag nil) ; for Mule - (kanji-flag nil)) ; for NEmacs - (apply (function call-process-region) - beg end (car gzip64-external-decoder) - t t nil (cdr gzip64-external-decoder)) - ))) + (as-binary-process (apply (function call-process-region) + beg end (car gzip64-external-decoder) + t t nil (cdr gzip64-external-decoder)) + ) + )) (defalias 'gzip64-encode-region 'gzip64-external-encode-region) (defalias 'gzip64-decode-region 'gzip64-external-decode-region) +;;; @ encoder/decoder for file +;;; + +(defun gzip64-insert-encoded-file (filename) + (interactive (list (read-file-name "Insert encoded file: "))) + (apply (function call-process) (car gzip64-external-encoder) + filename t nil + (cdr gzip64-external-encoder)) + ) + + ;;; @ end ;;; diff --git a/mel-q.el b/mel-q.el index 486fa32..9a83f47 100644 --- a/mel-q.el +++ b/mel-q.el @@ -1,34 +1,34 @@ -;;; -;;; mel-q.el: Quoted-Printable encoder/decoder for GNU Emacs -;;; -;;; Copyright (C) 1995 Free Software Foundation, Inc. -;;; Copyright (C) 1995,1996 MORIOKA Tomohiko -;;; -;;; Author: MORIOKA Tomohiko -;;; Maintainer: MORIOKA Tomohiko -;;; Created: 1995/6/25 -;;; Version: -;;; $Id: mel-q.el,v 3.2 1996/03/11 14:29:31 morioka Exp $ -;;; Keywords: MIME, Quoted-Printable -;;; -;;; 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 This program. If not, write to the Free Software -;;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. -;;; +;;; mel-q.el: Quoted-Printable and Q-encoding encoder/decoder for GNU Emacs + +;; Copyright (C) 1995,1996,1997 Free Software Foundation, Inc. + +;; Author: MORIOKA Tomohiko +;; Created: 1995/6/25 +;; Version: $Id: mel-q.el,v 6.5 1997/04/30 17:23:04 morioka Exp $ +;; Keywords: MIME, Quoted-Printable, Q-encoding + +;; 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) + + ;;; @ constants ;;; @@ -73,10 +73,11 @@ external decoder is called.") )) -;;; @@ Quoted-Printable encode/decode string +;;; @@ Quoted-Printable encoder/decoder for string ;;; -(defun quoted-printable-encode-string (str) +(defun quoted-printable-encode-string (string) + "Encode STRING to quoted-printable, and return the result." (let ((i 0)) (mapconcat (function (lambda (chr) @@ -103,9 +104,10 @@ external decoder is called.") (char-to-string chr) ))) ))) - str ""))) + string ""))) -(defun quoted-printable-decode-string (str) +(defun quoted-printable-decode-string (string) + "Decode STRING which is encoded in quoted-printable, and return the result." (let (q h l) (mapconcat (function (lambda (chr) @@ -130,10 +132,10 @@ external decoder is called.") ) (t (char-to-string chr)) ))) - str ""))) + string ""))) -;;; @@ Quoted-Printable encode/decode region +;;; @@ Quoted-Printable encoder/decoder for region ;;; (defun quoted-printable-internal-encode-region (beg end) @@ -168,30 +170,15 @@ external decoder is called.") )) ))) -(cond ((boundp 'MULE) - (define-program-coding-system - nil (car quoted-printable-external-encoder) *noconv*) - (define-program-coding-system - nil (car quoted-printable-external-decoder) *noconv*) - ) - ((boundp 'NEMACS) - (define-program-kanji-code - nil (car quoted-printable-external-encoder) 0) - (define-program-kanji-code - nil (car quoted-printable-external-decoder) 0) - )) - (defun quoted-printable-external-encode-region (beg end) (save-excursion (save-restriction (narrow-to-region beg end) - (let ((selective-display nil) ;Disable ^M to nl translation. - (mc-flag nil) ;Mule - (kanji-flag nil)) ;NEmacs - (apply (function call-process-region) - beg end (car quoted-printable-external-encoder) - t t nil (cdr quoted-printable-external-encoder)) - ) + (as-binary-process + (apply (function call-process-region) + beg end (car quoted-printable-external-encoder) + t t nil (cdr quoted-printable-external-encoder)) + ) ;; for OS/2 ;; regularize line break code (goto-char (point-min)) @@ -202,15 +189,20 @@ external decoder is called.") (defun quoted-printable-external-decode-region (beg end) (save-excursion - (let ((selective-display nil) ;Disable ^M to nl translation. - (mc-flag nil) ;Mule - (kanji-flag nil)) ;NEmacs - (apply (function call-process-region) - beg end (car quoted-printable-external-decoder) - t t nil (cdr quoted-printable-external-decoder)) - ))) + (as-binary-process + (apply (function call-process-region) + beg end (car quoted-printable-external-decoder) + t t nil (cdr quoted-printable-external-decoder)) + ))) (defun quoted-printable-encode-region (beg end) + "Encode current region by quoted-printable. +START and END are buffer positions. +This function calls internal quoted-printable encoder if size of +region is smaller than `quoted-printable-internal-encoding-limit', +otherwise it calls external quoted-printable encoder specified by +`quoted-printable-external-encoder'. In this case, you must install +the program (maybe mmencode included in metamail or XEmacs package)." (interactive "r") (if (and quoted-printable-internal-encoding-limit (> (- end beg) quoted-printable-internal-encoding-limit)) @@ -219,6 +211,13 @@ external decoder is called.") )) (defun quoted-printable-decode-region (beg end) + "Decode current region by quoted-printable. +START and END are buffer positions. +This function calls internal quoted-printable decoder if size of +region is smaller than `quoted-printable-internal-decoding-limit', +otherwise it calls external quoted-printable decoder specified by +`quoted-printable-external-decoder'. In this case, you must install +the program (maybe mmencode included in metamail or XEmacs package)." (interactive "r") (if (and quoted-printable-internal-decoding-limit (> (- end beg) quoted-printable-internal-decoding-limit)) @@ -227,60 +226,54 @@ external decoder is called.") )) +;;; @@ Quoted-Printable encoder/decoder for file +;;; + +(defun quoted-printable-insert-encoded-file (filename) + "Encode contents of file FILENAME to quoted-printable, and insert the result. +It calls external quoted-printable encoder specified by +`quoted-printable-external-encoder'. So you must install the program +(maybe mmencode included in metamail or XEmacs package)." + (interactive (list (read-file-name "Insert encoded file: "))) + (apply (function call-process) (car quoted-printable-external-encoder) + filename t nil (cdr quoted-printable-external-encoder)) + ) + + ;;; @ Q-encoding encode/decode string ;;; -(defun q-encoding-encode-string-for-text (str) - (mapconcat (function - (lambda (chr) - (cond ((eq chr 32) "_") - ((or (< chr 32) (< 126 chr) (eq chr ?=)) - (quoted-printable-quote-char chr) - ) - (t (char-to-string chr)) - ))) - str "")) - -(defun q-encoding-encode-string-for-comment (str) - (mapconcat (function - (lambda (chr) - (cond ((eq chr 32) "_") - ((or (< chr 32) (< 126 chr) - (memq chr '(?= ?\( ?\) ?\\)) - ) - (quoted-printable-quote-char chr) - ) - (t (char-to-string chr)) - ))) - str "")) - -(defun q-encoding-encode-string-for-phrase (str) - (mapconcat (function - (lambda (chr) - (cond ((eq chr 32) "_") - ((or (and (<= ?A chr)(<= chr ?Z)) - (and (<= ?a chr)(<= chr ?z)) - (and (<= ?0 chr)(<= chr ?9)) - (memq chr '(?! ?* ?+ ?- ?/)) - ) - (char-to-string chr) - ) - (t (quoted-printable-quote-char chr)) - ))) - str "")) - -(defun q-encoding-encode-string (str &optional mode) - (cond ((eq mode 'text) - (q-encoding-encode-string-for-text str) - ) - ((eq mode 'comment) - (q-encoding-encode-string-for-comment str) - ) - (t - (q-encoding-encode-string-for-phrase str) - ))) - -(defun q-encoding-decode-string (str) +(defconst q-encoding-special-chars-alist + '((text ?= ?? ?_) + (comment ?= ?? ?_ ?\( ?\) ?\\) + (phrase ?= ?? ?_ ?\( ?\) ?\\ ?\" ?# ?$ ?% ?& ?' ?, ?. ?/ + ?: ?\; ?< ?> ?@ ?\[ ?\] ?^ ?` ?{ ?| ?} ?~) + )) + +(defun q-encoding-encode-string (string &optional mode) + "Encode STRING to Q-encoding of encoded-word, and return the result. +MODE allows `text', `comment', `phrase' or nil. Default value is +`phrase'." + (let ((specials (cdr (or (assq mode q-encoding-special-chars-alist) + (assq 'phrase q-encoding-special-chars-alist) + )))) + (mapconcat (function + (lambda (chr) + (cond ((eq chr 32) "_") + ((or (< chr 32) (< 126 chr) + (memq chr specials) + ) + (quoted-printable-quote-char chr) + ) + (t + (char-to-string chr) + )) + )) + string "") + )) + +(defun q-encoding-decode-string (string) + "Decode STRING which is encoded in Q-encoding and return the result." (let (q h l) (mapconcat (function (lambda (chr) @@ -305,17 +298,28 @@ external decoder is called.") ) (t (char-to-string chr)) ))) - str ""))) + string ""))) ;;; @@ etc ;;; +(defun q-encoding-printable-char-p (chr mode) + (and (not (memq chr '(?= ?? ?_))) + (<= ?\ chr)(<= chr ?~) + (cond ((eq mode 'text) t) + ((eq mode 'comment) + (not (memq chr '(?\( ?\) ?\\))) + ) + (t + (string-match "[A-Za-z0-9!*+/=_---]" (char-to-string chr)) + )))) + (defun q-encoding-encoded-length (string &optional mode) (let ((l 0)(i 0)(len (length string)) chr) (while (< i len) (setq chr (elt string i)) - (if (string-match "[A-Za-z0-9!*+/=_---]" (char-to-string chr)) + (if (q-encoding-printable-char-p chr mode) (setq l (+ l 1)) (setq l (+ l 3)) ) diff --git a/mel-u.el b/mel-u.el index 7573cb7..0fab184 100644 --- a/mel-u.el +++ b/mel-u.el @@ -1,115 +1,113 @@ -;;; ;;; mel-u.el: uuencode encoder/decoder for GNU Emacs -;;; -;;; Copyright (C) 1995 Free Software Foundation, Inc. -;;; Copyright (C) 1995,1996 MORIOKA Tomohiko -;;; -;;; Author: MORIOKA Tomohiko -;;; Maintainer: MORIOKA Tomohiko -;;; Created: 1995/10/25 -;;; Version: -;;; $Id: mel-u.el,v 3.2 1996/01/09 18:19:25 morioka Exp $ -;;; Keywords: uuencode -;;; -;;; 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 This program. If not, write to the Free Software -;;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. -;;; + +;; Copyright (C) 1995,1996,1997 Free Software Foundation, Inc. + +;; Author: MORIOKA Tomohiko +;; Created: 1995/10/25 +;; Version: $Id: mel-u.el,v 5.7 1997/03/10 15:15:09 morioka Exp $ +;; Keywords: uuencode + +;; 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 'mel) + + ;;; @ variables ;;; -(defvar mime/tmp-dir (or (getenv "TM_TMP_DIR") "/tmp/")) - (defvar uuencode-external-encoder '("uuencode" "-") "*list of uuencode encoder program name and its arguments.") (defvar uuencode-external-decoder - (list "sh" "-c" (format "(cd %s; uudecode)" mime/tmp-dir)) + (list "sh" "-c" (format "(cd %s; uudecode)" mime-temp-directory)) "*list of uuencode decoder program name and its arguments.") -;;; @ external encoder +;;; @ uuencode encoder/decoder for region ;;; -(cond ((boundp 'MULE) - (define-program-coding-system - nil (car uuencode-external-encoder) *noconv*) - (define-program-coding-system - nil (car uuencode-external-decoder) *noconv*) - ) - ((boundp 'NEMACS) - (define-program-kanji-code - nil (car uuencode-external-encoder) 0) - (define-program-kanji-code - nil (car uuencode-external-decoder) 0) - )) - -(defun uuencode-external-encode-region (beg end) +(defun uuencode-external-encode-region (start end) + "Encode current region by unofficial uuencode format. +This function uses external uuencode encoder which is specified by +variable `uuencode-external-encoder'." (interactive "*r") (save-excursion - (let (selective-display ; Disable ^M to nl translation. - mc-flag ; for Mule - kanji-flag) ; for NEmacs - (apply (function call-process-region) - beg end (car uuencode-external-encoder) - t t nil (cdr uuencode-external-encoder)) - ))) + (as-binary-process (apply (function call-process-region) + start end (car uuencode-external-encoder) + t t nil (cdr uuencode-external-encoder)) + ) + ;; for OS/2 + ;; regularize line break code + (goto-char (point-min)) + (while (re-search-forward "\r$" nil t) + (replace-match "") + ) + )) -(defun uuencode-external-decode-region (beg end) +(defun uuencode-external-decode-region (start end) + "Decode current region by unofficial uuencode format. +This function uses external uuencode decoder which is specified by +variable `uuencode-external-decoder'." (interactive "*r") (save-excursion - (let (selective-display ; Disable ^M to nl translation. - mc-flag ; for Mule - kanji-flag ; for NEmacs - (filename (save-excursion + (let ((filename (save-excursion (save-restriction - (narrow-to-region beg end) - (goto-char beg) + (narrow-to-region start end) + (goto-char start) (if (re-search-forward "^begin [0-9]+ " nil t) (if (looking-at ".+$") (buffer-substring (match-beginning 0) - (match-end 0) - ) - ))))) - ) + (match-end 0)) + )))))) (if filename - (progn - (apply (function call-process-region) - beg end (car uuencode-external-decoder) - t nil nil (cdr uuencode-external-decoder)) - (setq filename (expand-file-name filename mime/tmp-dir)) - (let ((file-coding-system-for-read - (if (boundp 'MULE) *noconv*)) ; for Mule - kanji-fileio-code ; for NEmacs - (emx-binary-mode t) ; for OS/2 - jka-compr-compression-info-list ; for jka-compr - jam-zcat-filename-list ; for jam-zcat - require-final-newline) - (insert-file-contents filename) - ) - (delete-file filename) - )) + (as-binary-process + (apply (function call-process-region) + start end (car uuencode-external-decoder) + t nil nil (cdr uuencode-external-decoder)) + (setq filename (expand-file-name filename mime-temp-directory)) + (as-binary-input-file (insert-file-contents filename)) + (delete-file filename) + )) ))) (defalias 'uuencode-encode-region 'uuencode-external-encode-region) (defalias 'uuencode-decode-region 'uuencode-external-decode-region) +;;; @ uuencode encoder/decoder for file +;;; + +(defun uuencode-insert-encoded-file (filename) + "Insert file encoded by unofficial uuencode format. +This function uses external uuencode encoder which is specified by +variable `uuencode-external-encoder'." + (interactive (list (read-file-name "Insert encoded file: "))) + (call-process (car uuencode-external-encoder) filename t nil + (file-name-nondirectory filename)) + ) + + ;;; @ end ;;; (provide 'mel-u) + +;;; mel-u.el ends here diff --git a/mel.el b/mel.el index 062a417..d208bb4 100644 --- a/mel.el +++ b/mel.el @@ -1,56 +1,52 @@ -;;; ;;; mel.el : a MIME encoding/decoding library -;;; -;;; Copyright (C) 1995 Free Software Foundation, Inc. -;;; Copyright (C) 1995,1996 MORIOKA Tomohiko -;;; -;;; Author: MORIOKA Tomohiko -;;; modified by Shuhei KOBAYASHI -;;; Maintainer: MORIOKA Tomohiko -;;; Created: 1995/6/25 -;;; Version: -;;; $Id: mel.el,v 3.5 1996/03/13 16:05:41 morioka Exp $ -;;; Keywords: MIME, Base64, Quoted-Printable, uuencode, gzip64 -;;; -;;; 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 This program. If not, write to the Free Software -;;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. -;;; + +;; Copyright (C) 1995,1996,1997 Free Software Foundation, Inc. + +;; Author: MORIOKA Tomohiko +;; modified by Shuhei KOBAYASHI +;; Created: 1995/6/25 +;; Version: $Id: mel.el,v 6.9 1997/04/30 17:24:32 morioka Exp $ +;; Keywords: MIME, Base64, Quoted-Printable, uuencode, gzip64 + +;; 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: -(autoload 'base64-encode-region "mel-b" nil t) -(autoload 'base64-decode-region "mel-b" nil t) -(autoload 'base64-encode-string "mel-b") -(autoload 'base64-decode-string "mel-b") -(autoload 'base64-encoded-length "mel-b") +;;; @ variable +;;; -(autoload 'quoted-printable-encode-region "mel-q" nil t) -(autoload 'quoted-printable-decode-region "mel-q" nil t) +(defvar mime-temp-directory (or (getenv "MIME_TMP_DIR") + (getenv "TM_TMP_DIR") + "/tmp/") + "*Directory for temporary files.") -(autoload 'q-encoding-encode-string-for-text "mel-q") -(autoload 'q-encoding-encode-string-for-comment "mel-q") -(autoload 'q-encoding-encode-string-for-phrase "mel-q") -(autoload 'q-encoding-encode-string "mel-q") -(autoload 'q-encoding-decode-string "mel-q") -(autoload 'q-encoding-encoded-length "mel-q") -(autoload 'uuencode-encode-region "mel-u" nil t) -(autoload 'uuencode-decode-region "mel-u" nil t) +;;; @ region +;;; -(autoload 'gzip64-encode-region "mel-g" nil t) -(autoload 'gzip64-decode-region "mel-g" nil t) +(autoload 'base64-encode-region + "mel-b" "Encode current region by base64." t) +(autoload 'quoted-printable-encode-region + "mel-q" "Encode current region by Quoted-Printable." t) +(autoload 'uuencode-encode-region + "mel-u" "Encode current region by unofficial uuencode format." t) +(autoload 'gzip64-encode-region + "mel-g" "Encode current region by unofficial x-gzip64 format." t) (defvar mime-encoding-method-alist '(("base64" . base64-encode-region) @@ -60,47 +56,121 @@ ("7bit") ("8bit") ("binary") - )) + ) + "Alist of encoding vs. corresponding method to encode region. +Each element looks like (STRING . FUNCTION) or (STRING . nil). +STRING is content-transfer-encoding. +FUNCTION is region encoder and nil means not to encode.") + + +(autoload 'base64-decode-region + "mel-b" "Decode current region by base64." t) +(autoload 'quoted-printable-decode-region + "mel-q" "Decode current region by Quoted-Printable." t) +(autoload 'uuencode-decode-region + "mel-u" "Decode current region by unofficial uuencode format." t) +(autoload 'gzip64-decode-region + "mel-g" "Decode current region by unofficial x-gzip64 format." t) (defvar mime-decoding-method-alist '(("base64" . base64-decode-region) ("quoted-printable" . quoted-printable-decode-region) ("x-uue" . uuencode-decode-region) + ("x-uuencode" . uuencode-decode-region) ("x-gzip64" . gzip64-decode-region) - )) + ) + "Alist of encoding vs. corresponding method to decode region. +Each element looks like (STRING . FUNCTION). +STRING is content-transfer-encoding. +FUNCTION is region decoder.") -;;; @ region -;;; - -(defun mime/encode-region (encoding beg end) - "Encode region BEG to END of current buffer using ENCODING. [mel.el]" +(defun mime-encode-region (start end encoding) + "Encode region START to END of current buffer using ENCODING." (interactive - (list (completing-read "encoding: " + (list (region-beginning) (region-end) + (completing-read "encoding: " mime-encoding-method-alist - nil t "base64") - (region-beginning) (region-end)) + nil t "base64")) ) (let ((f (cdr (assoc encoding mime-encoding-method-alist)))) (if f - (funcall f beg end) + (funcall f start end) ))) -(defun mime/decode-region (encoding beg end) - "Decode region BEG to END of current buffer using ENCODING. [mel.el]" +(defun mime-decode-region (start end encoding) + "Decode region START to END of current buffer using ENCODING." (interactive - (list (completing-read "encoding: " + (list (region-beginning) (region-end) + (completing-read "encoding: " mime-decoding-method-alist - nil t "base64") - (region-beginning) (region-end)) + nil t "base64")) ) (let ((f (cdr (assoc encoding mime-decoding-method-alist)))) (if f - (funcall f beg end) + (funcall f start end) ))) -(defalias 'mime-encode-region 'mime/encode-region) -(defalias 'mime-decode-region 'mime/decode-region) + +;;; @ file +;;; + +(autoload 'base64-insert-encoded-file "mel-b" + "Encode contents of file to base64, and insert the result." t) +(autoload 'quoted-printable-insert-encoded-file "mel-q" + "Encode contents of file to quoted-printable, and insert the result." t) +(autoload 'uuencode-insert-encoded-file + "mel-u" "Insert file encoded by unofficial uuencode format." t) +(autoload 'gzip64-insert-encoded-file + "mel-g" "Insert file encoded by unofficial gzip64 format." t) + +(defvar mime-file-encoding-method-alist + '(("base64" . base64-insert-encoded-file) + ("quoted-printable" . quoted-printable-insert-encoded-file) + ("x-uue" . uuencode-insert-encoded-file) + ("x-gzip64" . gzip64-insert-encoded-file) + ("7bit" . insert-binary-file-contents-literally) + ("8bit" . insert-binary-file-contents-literally) + ("binary" . insert-binary-file-contents-literally) + ) + "Alist of encoding vs. corresponding method to insert encoded file. +Each element looks like (STRING . FUNCTION). +STRING is content-transfer-encoding. +FUNCTION is function to insert encoded file.") + +(defun mime-insert-encoded-file (filename encoding) + "Insert file FILENAME encoded by ENCODING format." + (interactive + (list (read-file-name "Insert encoded file: ") + (completing-read "encoding: " + mime-encoding-method-alist + nil t "base64")) + ) + (let ((f (cdr (assoc encoding mime-file-encoding-method-alist)))) + (if f + (funcall f filename) + ))) + + +;;; @ string +;;; + +(autoload 'base64-encode-string "mel-b" + "Encode STRING to base64, and return the result.") +(autoload 'base64-decode-string "mel-b" + "Decode STRING which is encoded in base64, and return the result.") +(autoload 'quoted-printable-encode-string "mel-q" + "Encode STRING to quoted-printable, and return the result.") +(autoload 'quoted-printable-decode-string "mel-q" + "Decode STRING which is encoded in quoted-printable, and return the result.") + +(autoload 'q-encoding-encode-string "mel-q" + "Encode STRING to Q-encoding of encoded-word, and return the result.") +(autoload 'q-encoding-decode-string "mel-q" + "Decode STRING which is encoded in Q-encoding and return the result.") + +(autoload 'base64-encoded-length "mel-b") +(autoload 'q-encoding-encoded-length "mel-q") ;;; @ end