X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=mel-q.el;h=a86b24ee9f8968e3d8e5f1691b09c3e938a7e02f;hb=4d9c85cce61c5f3a0e1746a885b57b667f3843d8;hp=72a22761631f3b873ab1805748aac81097ec4499;hpb=89a2910b4ad0458a9670fffb54ac4a760c2abf56;p=elisp%2Fflim.git

diff --git a/mel-q.el b/mel-q.el
index 72a2276..a86b24e 100644
--- a/mel-q.el
+++ b/mel-q.el
@@ -1,10 +1,9 @@
 ;;; mel-q.el: Quoted-Printable and Q-encoding encoder/decoder for GNU Emacs
 
-;; Copyright (C) 1995,1996,1997 Free Software Foundation, Inc.
+;; Copyright (C) 1995,1996,1997,1998 Free Software Foundation, Inc.
 
 ;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
 ;; Created: 1995/6/25
-;; Version: $Id: mel-q.el,v 7.1 1997/11/06 16:09:25 morioka Exp $
 ;; Keywords: MIME, Quoted-Printable, Q-encoding
 
 ;; This file is part of MEL (MIME Encoding Library).
@@ -27,13 +26,12 @@
 ;;; Code:
 
 (require 'emu)
+(require 'mime-def)
 
 
 ;;; @ Quoted-Printable encoder
 ;;;
 
-(defconst quoted-printable-hex-chars "0123456789ABCDEF")
-
 (defsubst quoted-printable-quote-char (character)
   (concat
    "="
@@ -46,19 +44,18 @@
     (save-restriction
       (narrow-to-region start end)
       (goto-char start)
-      (let ((col 0)
-	    enable-multibyte-characters)
+      (let ((col 0))
 	(while (< (point)(point-max))
 	  (cond ((>= col 75)
 		 (insert "=\n")
 		 (setq col 0)
 		 )
-		((looking-at "^From ")
+		((looking-at-as-unibyte "^From ")
 		 (replace-match "=46rom ")
 		 (backward-char 1)
 		 (setq col (+ col 6))
 		 )
-		((looking-at "[ \t]\n")
+		((looking-at-as-unibyte "[ \t]\n")
 		 (forward-char 1)
 		 (insert "=\n")
 		 (forward-char 1)
@@ -88,6 +85,7 @@
 		   )))
 	  )))))
 
+
 (defvar quoted-printable-external-encoder '("mmencode" "-q")
   "*list of quoted-printable encoder program name and its arguments.")
 
@@ -108,42 +106,23 @@
 	)
       )))
 
-(defvar quoted-printable-internal-encoding-limit
-  (if (and (featurep 'xemacs)(featurep 'mule))
-      0
-    (require 'path-util)
-    (if (exec-installed-p "mmencode")
-	1000
-      (message "Don't found external encoder for Quoted-Printable!")
-      nil))
-  "*limit size to use internal quoted-printable encoder.
-If size of input to encode is larger than this limit,
-external encoder is called.")
-
-(defun quoted-printable-encode-region (start 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 start) quoted-printable-internal-encoding-limit))
-      (quoted-printable-external-encode-region start end)
-    (quoted-printable-internal-encode-region start end)
+(defun quoted-printable-internal-encode-string (string)
+  "Encode STRING to quoted-printable, and return the result."
+  (with-temp-buffer
+    (insert string)
+    (quoted-printable-internal-encode-region (point-min)(point-max))
+    (buffer-string)
     ))
 
-(defun quoted-printable-encode-string (string)
+(defun quoted-printable-external-encode-string (string)
   "Encode STRING to quoted-printable, and return the result."
   (with-temp-buffer
     (insert string)
-    (quoted-printable-encode-region (point-min)(point-max))
+    (quoted-printable-external-encode-region (point-min)(point-max))
     (buffer-string)
     ))
 
-(defun quoted-printable-insert-encoded-file (filename)
+(defun quoted-printable-external-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
@@ -157,56 +136,37 @@ It calls external quoted-printable encoder specified by
 ;;; @ Quoted-Printable decoder
 ;;;
 
-(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)
-		  (cond ((eq chr ?=)
-			 (setq q t)
-			 "")
-			(q (setq h
-				 (cond ((<= ?a chr) (+ (- chr ?a) 10))
-				       ((<= ?A chr) (+ (- chr ?A) 10))
-				       ((<= ?0 chr) (- chr ?0))
-				       ))
-			   (setq q nil)
-			   "")
-			(h (setq l (cond ((<= ?a chr) (+ (- chr ?a) 10))
-					 ((<= ?A chr) (+ (- chr ?A) 10))
-					 ((<= ?0 chr) (- chr ?0))
-					 ))
-			   (prog1
-			       (char-to-string (logior (ash h 4) l))
-			     (setq h nil)
-			     )
-			   )
-			(t (char-to-string chr))
-			)))
-	       string "")))
-
-(defconst quoted-printable-octet-regexp
-  (concat "=[" quoted-printable-hex-chars
-	  "][" quoted-printable-hex-chars "]"))
+(defsubst quoted-printable-hex-char-to-num (chr)
+  (cond ((<= ?a chr) (+ (- chr ?a) 10))
+	((<= ?A chr) (+ (- chr ?A) 10))
+	((<= ?0 chr) (- chr ?0))
+	))
 
 (defun quoted-printable-internal-decode-region (start end)
   (save-excursion
     (save-restriction
       (narrow-to-region start end)
       (goto-char (point-min))
-      (while (re-search-forward "=\n" nil t)
-	(replace-match "")
-	)
-      (goto-char (point-min))
-      (let (b e str)
-	(while (re-search-forward quoted-printable-octet-regexp nil t)
-	  (setq b (match-beginning 0))
-	  (setq e (match-end 0))
-	  (setq str (buffer-substring b e))
-	  (delete-region b e)
-	  (insert (quoted-printable-decode-string str))
-	  ))
-      )))
+      (while (search-forward "=" nil t)
+	(let ((beg (match-beginning 0)))
+	  (cond ((looking-at "\n")
+		 (delete-region beg (match-end 0))
+		 )
+		((looking-at
+		  `,(concat "[" quoted-printable-hex-chars
+			    "][" quoted-printable-hex-chars "]"))
+		 (let* ((end (match-end 0))
+			(hex (buffer-substring (match-beginning 0) end)))
+		   (delete-region beg end)
+		   (insert
+		    (logior
+		     (ash (quoted-printable-hex-char-to-num (aref hex 0)) 4)
+		     (quoted-printable-hex-char-to-num (aref hex 1))))
+		   ))
+		(t
+		 ;; invalid
+		 ))
+	  )))))
 
 (defvar quoted-printable-external-decoder '("mmencode" "-q" "-u")
   "*list of quoted-printable decoder program name and its arguments.")
@@ -219,25 +179,37 @@ It calls external quoted-printable encoder specified by
 	    t t nil (cdr quoted-printable-external-decoder))
      )))
 
-(defvar quoted-printable-internal-decoding-limit nil
-  "*limit size to use internal quoted-printable decoder.
-If size of input to decode is larger than this limit,
-external decoder is called.")
-
-(defun quoted-printable-decode-region (start 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 start) quoted-printable-internal-decoding-limit))
-      (quoted-printable-external-decode-region start end)
-    (quoted-printable-internal-decode-region start end)
-    ))
+(defun quoted-printable-internal-decode-string (string)
+  "Decode STRING which is encoded in quoted-printable, and return the result."
+  (with-temp-buffer
+    (insert string)
+    (quoted-printable-internal-decode-region (point-min)(point-max))
+    (buffer-string)))
+
+(defun quoted-printable-external-decode-string (string)
+  "Decode STRING which is encoded in quoted-printable, and return the result."
+  (with-temp-buffer
+    (insert string)
+    (quoted-printable-external-decode-region (point-min)(point-max))
+    (buffer-string)))
+
+(defvar quoted-printable-external-decoder-option-to-specify-file '("-o")
+  "*list of options of quoted-printable decoder program to specify file.")
+
+(defun quoted-printable-external-write-decoded-region (start end filename)
+  "Decode and write current region encoded by quoted-printable into FILENAME.
+START and END are buffer positions."
+  (interactive
+   (list (region-beginning) (region-end)
+	 (read-file-name "Write decoded region to file: ")))
+  (as-binary-process
+   (apply (function call-process-region)
+	  start end (car quoted-printable-external-decoder)
+	  nil nil nil
+	  (append (cdr quoted-printable-external-decoder)
+		  quoted-printable-external-decoder-option-to-specify-file
+		  (list filename))
+	  )))
 
 
 ;;; @ Q-encoding encode/decode string
@@ -250,7 +222,7 @@ the program (maybe mmencode included in metamail or XEmacs package)."
 		?: ?\; ?< ?> ?@ ?\[ ?\] ?^ ?` ?{ ?| ?} ?~)
     ))
 
-(defun q-encoding-encode-string (string &optional mode)
+(defun q-encoding-internal-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'."
@@ -272,7 +244,7 @@ MODE allows `text', `comment', `phrase' or nil.  Default value is
 	       string "")
     ))
 
-(defun q-encoding-decode-string (string)
+(defun q-encoding-internal-decode-string (string)
   "Decode STRING which is encoded in Q-encoding and return the result."
   (let (q h l)
     (mapconcat (function
@@ -281,16 +253,10 @@ MODE allows `text', `comment', `phrase' or nil.  Default value is
 			((eq chr ?=)
 			 (setq q t)
 			 "")
-			(q (setq h (cond ((<= ?a chr) (+ (- chr ?a) 10))
-					 ((<= ?A chr) (+ (- chr ?A) 10))
-					 ((<= ?0 chr) (- chr ?0))
-					 ))
+			(q (setq h (quoted-printable-hex-char-to-num chr))
 			   (setq q nil)
 			   "")
-			(h (setq l (cond ((<= ?a chr) (+ (- chr ?a) 10))
-					 ((<= ?A chr) (+ (- chr ?A) 10))
-					 ((<= ?0 chr) (- chr ?0))
-					 ))
+			(h (setq l (quoted-printable-hex-char-to-num chr))
 			   (prog1
 			       (char-to-string (logior (ash h 4) l))
 			     (setq h nil)
@@ -315,7 +281,7 @@ MODE allows `text', `comment', `phrase' or nil.  Default value is
 	      (string-match "[A-Za-z0-9!*+/=_---]" (char-to-string chr))
 	      ))))
 
-(defun q-encoding-encoded-length (string &optional mode)
+(defun q-encoding-internal-encoded-length (string &optional mode)
   (let ((l 0)(i 0)(len (length string)) chr)
     (while (< i len)
       (setq chr (elt string i))