tm 5.21.3

diff --git a/Makefile b/Makefile
index e7893b4..34dcff3 100644 (file)
--- a/Makefile
+++ b/Makefile
@@ -8,7 +8,7 @@ GOMI    = $(UTILS) *.elc
 FILES  = README.eng Makefile Makefile.18 Makefile.19 *.el *.c methods \
                doc/Makefile doc/*.pln doc/*.ol doc/*.tex doc/*.texi
 
-TARFILE = tm5.21.2.tar
+TARFILE = tm5.21.3.tar
 
 all:   $(UTILS) $(DVI)
 

diff --git a/Makefile.19 b/Makefile.19
index bac316c..9b7756e 100644 (file)
--- a/Makefile.19
+++ b/Makefile.19
@@ -8,7 +8,7 @@ TMEL    = tm-misc.el
 TMELC  = ${TMEL:el=elc}
 TMMEL  = tm-view.el tm-rmail.el tm-comp.el tm-gnus4.el
 TMMELC = ${TMMEL:el=elc}
-TMVEL  = tm-rich.el tm-vm.el
+TMVEL  = tm-rich.el
 TMVELC = ${TMVEL:el=elc}
 
 TLDIR  = $(HOME)/lib/emacs19/lisp

diff --git a/README.eng b/README.eng
index 4ddc0f2..1376444 100644 (file)
--- a/README.eng
+++ b/README.eng
@@ -1,6 +1,6 @@
 [README for tm (English Version)]
 by MORIOKA Tomohiko <morioka@jaist.ac.jp>
-1994/10/17
+1994/12/6
 
 1 What's tm?
 
@@ -48,15 +48,38 @@ Tm has following modules:
 
 4 Install
 
-(1) Edit Makefile for your environment.
+4.1 Makefile
 
-(2) Edit methods in `methods/' directory for your environment.
+  Edit Makefiles for your environment. In this package, there are
+following Makefiles:
 
-(3) Run `make all'.
+       Makefile :      main Makefile
+       Makefile.18 :   Makefile for Emacs 18 (NEmacs, Mule 1.x)
+       Makefile.19 :   Makefile for Emacs 19 (Mule 2.x, XEmacs)
 
-(4) Run `make install'.
 
-(5) Copy *.el to your emacs lisp directory.
+4.2 External methods
+
+  Edit external methods in `methods/' directory for your environment.
+
+
+4.3 make
+
+  Run `make all'.
+
+
+4.4 install
+
+  Run `make install'.
+
+
+4.5 Emacs Lisp modules
+
+  Run `make install-18', if you use Emacs 18 (NEmacs, Mule 1.x).
+
+  Run `make install-19', if you use Emacs 19 (Mule 2.x, XEmacs).
+
+  Or copy *.el to your emacs lisp directory.
 
 
 5 .emacs
@@ -71,9 +94,10 @@ If you want use vm, please insert following in .vm or .emacs:
 
 6 How to use mime/viewer-mode
 
-In tm-MUAs, you can use mime/viewer-mode if you press `v' key in
-Summary mode. mime/viewer-mode has following functions:
+In tm-MUAs, you can use mime/viewer-mode if you press `v' key (in VM,
+`Z' key) in Summary mode. mime/viewer-mode has following functions:
 
+       q       quit from mime/viewer-mode
        u       move to the upper content
        p       move to the previous content
        n       move to the next content

diff --git a/methods/tm-au b/methods/tm-au
index 1561030..7e3b7eb 100755 (executable)
--- a/methods/tm-au
+++ b/methods/tm-au
@@ -1,14 +1,18 @@
 #!/bin/csh -f
 
+if (! $?TM_TMP_DIR) then
+    setenv TM_TMP_DIR /tmp
+endif
+
 switch( $4 )
 case "play":
        set filename = /dev/audio
        breaksw
 case "extract":
        if( $5 == "" ) then
-               set filename = "/tmp/mime$$.au"
+               set filename = "$TM_TMP_DIR/mime$$.au"
        else
-               set filename = "/tmp/$5"
+               set filename = "$TM_TMP_DIR/$5"
        endif
        breaksw
 default:
@@ -17,21 +21,4 @@ endsw
 
 echo "$2; $3 -> $filename"
 
-switch( $3 )
-case "7bit":
-case "8bit":
-case "binary":
-       /bin/cp $1 $filename
-       breaksw
-case "base64":
-       decode-b < $1 > $filename
-       breaksw
-case "quoted-printable":
-       mmencode -q -u $1 > $filename
-       breaksw
-default:
-       echo "unknown encoding"
-       exit -1
-endsw
-
-/bin/rm $1
+tmdecode $3 $1 $filename

diff --git a/methods/tm-file b/methods/tm-file
index 99d939c..4433fab 100755 (executable)
--- a/methods/tm-file
+++ b/methods/tm-file
@@ -1,7 +1,7 @@
 #!/bin/csh -f
 
 if (! $?TM_TMP_DIR) then
-    set TM_TMP_DIR=/tmp
+    setenv TM_TMP_DIR /tmp
 endif
 
 if( $5 == "" ) then
@@ -12,27 +12,4 @@ endif
 
 echo "$2; $3 -> $filename"
 
-switch ( $3 )
-case "7bit":
-case "8bit":
-case "binary":
-       /bin/cp $1 $filename
-       breaksw
-case "base64":
-       decode-b < $1 > $filename
-       breaksw
-case "quoted-printable":
-       mmencode -q -u $1 > $filename
-       breaksw
-case "x-uue":
-       pushd $TM_TMP_DIR
-       uudecode $1
-       popd
-       breaksw
-default:
-       echo "unknown encoding"
-       exit -1
-endsw
-
-/bin/rm $1
-echo "$1 was removed."
+tmdecode $3 $1 $filename

diff --git a/methods/tm-image b/methods/tm-image
index d05dfe3..325a982 100755 (executable)
--- a/methods/tm-image
+++ b/methods/tm-image
@@ -1,7 +1,7 @@
 #!/bin/csh -f
 
 if (! $?TM_TMP_DIR) then
-    set TM_TMP_DIR=/tmp
+    setenv TM_TMP_DIR /tmp
 endif
 
 if( $5 == "" ) then
@@ -34,24 +34,7 @@ endif
 
 echo "$2; $3 -> $filename"
 
-switch( $3 )
-case "7bit":
-case "8bit":
-case "binary":
-       /bin/cp $1 $filename
-       breaksw
-case "base64":
-       decode-b < $1 > $filename
-       breaksw
-case "quoted-printable":
-       mmencode -u -q $1 > $filename
-       breaksw
-default:
-       echo "unknown encoding"
-       exit -1
-endsw
-
-/bin/rm $1
+tmdecode $3 $1 $filename
 
 switch( $4 )
 case "play":

diff --git a/methods/tm-mpeg b/methods/tm-mpeg
index c4e085e..dec5cbf 100755 (executable)
--- a/methods/tm-mpeg
+++ b/methods/tm-mpeg
@@ -1,35 +1,26 @@
 #!/bin/csh -f
 
+if (! $?TM_TMP_DIR) then
+    setenv TM_TMP_DIR /tmp
+endif
+
 if( $5 == "" ) then
-       set filename = /tmp/mime$$.mpg
+       set filename = $TM_TMP_DIR/mime$$.mpg
 else
-       set filename = /tmp/$5
+       set filename = $TM_TMP_DIR/$5
 endif
 
 echo "$2; $3 -> $filename"
 
-switch( $3 )
-case "7bit":
-case "8bit":
-case "binary":
-       /bin/cp $1 $filename
-       breaksw
-case "base64":
-       decode-b < $1 > $filename
-       breaksw
-case "quoted-printable":
-       mmencode -q -u $1 > $filename
-       breaksw
-default:
-       echo "unknown encoding"
-       exit -1
-endsw
-
-/bin/rm $1
+tmdecode $3 $1 $filename
 
 switch( $4 )
 case "play":
-       mpeg_play -dither gray $filename
+       if (! $?VIDEO_DITHER) then
+               setenv VIDEO_DITHER gray
+       endif
+       
+       mpeg_play -dither $VIDEO_DITHER $filename
        /bin/rm $filename
        breaksw
 case "extract":

diff --git a/methods/tm-plain b/methods/tm-plain
index ae2e66a..88c5304 100755 (executable)
--- a/methods/tm-plain
+++ b/methods/tm-plain
@@ -1,31 +1,18 @@
 #!/bin/csh -f
 
+if (! $?TM_TMP_DIR) then
+    setenv TM_TMP_DIR /tmp
+endif
+
 if( $5 == "" ) then
-       set filename="/tmp/mime$$.pln"
+       set filename = "$TM_TMP_DIR/mime$$.pln"
 else
-       set filename = /tmp/$5
+       set filename = $TM_TMP_DIR/$5
 endif
 
 echo "$2; $3 -> $filename"
 
-switch ( $3 )
-case "7bit":
-case "8bit":
-case "binary":
-       cp $1 $filename
-       breaksw
-case "base64":
-       decode-b < $1 > $filename
-       breaksw
-case "quoted-printable":
-       mmencode -q -u $1 > $filename
-       breaksw
-default:
-       echo "unknown encoding"
-       exit -1
-endsw
-
-/bin/rm $1
+tmdecode $3 $1 $filename
 
 switch( $4 )
 case "play":

diff --git a/methods/tmdecode b/methods/tmdecode
new file mode 100755 (executable)
index 0000000..b09d8ae
--- /dev/null
+++ b/methods/tmdecode
@@ -0,0 +1,27 @@
+#!/bin/csh -f
+
+switch ( $1 )
+case "7bit":
+case "8bit":
+case "binary":
+       /bin/cp $2 $3
+       breaksw
+case "base64":
+       #decode-b < $2 > $3
+       mmencode -u $2 > $3
+       breaksw
+case "quoted-printable":
+       mmencode -q -u $2 > $3
+       breaksw
+case "x-uue":
+       pushd $TM_TMP_DIR
+       uudecode $2
+       popd
+       breaksw
+default:
+       echo "unknown encoding"
+       exit -1
+endsw
+
+/bin/rm $2
+echo "$2 was removed."

diff --git a/tiny-mime.el b/tiny-mime.el
index 07bbbb1..0255017 100644 (file)
--- a/tiny-mime.el
+++ b/tiny-mime.el
@@ -21,7 +21,7 @@
 ;;; @ version
 ;;;
 (defconst mime/RCS-ID
-  "$Id: tiny-mime.el,v 5.5 1994/10/26 18:36:38 morioka Exp $")
+  "$Id: tiny-mime.el,v 5.7 1994/12/05 09:09:23 morioka Exp $")
 
 (defconst mime/tiny-mime-version (get-version-string mime/RCS-ID))
 
@@ -474,88 +474,91 @@
     ))
 
 (defun mime/encode-header-string (n string &optional mode)
-  (let ((ssl (mime/separate-string-for-encoder string))
-       i len cell et w ew (dest "") b l)
-    (setq len (length ssl))
-    (setq cell (nth 0 ssl))
-    (setq et (car cell))
-    (setq w (cdr cell))
-    (if (eq et nil)
-       (progn
-         (if (> (+ n (string-width w)) 76)
-             (progn
-               (setq dest (concat dest "\n "))
-               (setq b 1)
-               )
-           (setq b n))
-         (setq dest (concat dest w))
-         (setq b (+ b (string-width w)))
-         )
-      (progn
-       (setq ew (mime/encode-header-word n (cdr cell) (car et) (cdr et)))
-       (setq dest (nth 1 ew))
-       (setq b (car ew))
-       ))
-    (setq i 1)
-    (while (< i len)
-      (setq cell (nth i ssl))
+  (if (string= string "")
+      (list n "")
+    (let ((ssl (mime/separate-string-for-encoder string))
+         i len cell et w ew (dest "") b l)
+      (setq len (length ssl))
+      (setq cell (nth 0 ssl))
       (setq et (car cell))
       (setq w (cdr cell))
-      (cond ((string-match "^[ \t]*$" w)
-            (setq b (+ b (string-width (cdr cell))))
-            (setq dest (concat dest (cdr cell)))
-            )
-           ((eq et nil)
-            (if (> (+ b (string-width w)) 76)
-                (progn
-                  (if (eq (elt dest (- (length dest) 1)) 32)
-                      (setq dest (substring dest 0 (- (length dest) 1)))
+      (if (eq et nil)
+         (progn
+           (if (> (+ n (string-width w)) 76)
+               (progn
+                 (setq dest (concat dest "\n "))
+                 (setq b 1)
+                 )
+             (setq b n))
+           (setq dest (concat dest w))
+           (setq b (+ b (string-width w)))
+           )
+       (progn
+         (setq ew (mime/encode-header-word n (cdr cell) (car et) (cdr et)))
+         (setq dest (nth 1 ew))
+         (setq b (car ew))
+         ))
+      (setq i 1)
+      (while (< i len)
+       (setq cell (nth i ssl))
+       (setq et (car cell))
+       (setq w (cdr cell))
+       (cond ((string-match "^[ \t]*$" w)
+              (setq b (+ b (string-width (cdr cell))))
+              (setq dest (concat dest (cdr cell)))
+              )
+             ((eq et nil)
+              (if (> (+ b (string-width w)) 76)
+                  (progn
+                    (if (eq (elt dest (- (length dest) 1)) 32)
+                        (setq dest (substring dest 0 (- (length dest) 1)))
+                      )
+                    (setq dest (concat dest "\n " w))
+                    (setq b (+ (length w) 1))
                     )
-                  (setq dest (concat dest "\n " w))
-                  (setq b (+ (length w) 1))
-                  )
-              (setq l (length dest))
-              (if (and (>= l 2)
-                       (eq (elt dest (- l 2)) ?\?)
-                       (eq (elt dest (- l 1)) ?=)
-                       )
+                (setq l (length dest))
+                (if (and (>= l 2)
+                         (eq (elt dest (- l 2)) ?\?)
+                         (eq (elt dest (- l 1)) ?=)
+                         )
+                    (progn
+                      (setq dest (concat dest " "))
+                      (setq b (+ b 1))
+                      ))
+                (setq dest (concat dest w))
+                (setq b (+ b (string-width w)))
+                ))
+             (t
+              (if (not (eq (elt dest (- (length dest) 1)) 32))
                   (progn
                     (setq dest (concat dest " "))
                     (setq b (+ b 1))
                     ))
-              (setq dest (concat dest w))
-              (setq b (+ b (string-width w)))
+              (setq ew
+                    (mime/encode-header-word b (cdr cell) (car et) (cdr et)))
+              (setq b (car ew)) 
+              (if (string-match "^\n" (nth 1 ew))
+                  (setq dest (concat (substring dest 0 (- (length dest) 1))
+                                     (nth 1 ew)))
+                (setq dest (concat dest (nth 1 ew)))
+                )
               ))
-           (t
-            (if (not (eq (elt dest (- (length dest) 1)) 32))
-                (progn
-                  (setq dest (concat dest " "))
-                  (setq b (+ b 1))
-                  ))
-            (setq ew (mime/encode-header-word b (cdr cell) (car et) (cdr et)))
-            (setq b (car ew)) 
-            (if (string-match "^\n" (nth 1 ew))
-                (setq dest (concat (substring dest 0 (- (length dest) 1))
-                                   (nth 1 ew)))
-              (setq dest (concat dest (nth 1 ew)))
-              )
-            ))
-      (setq i (+ i 1))
-      )
-    (list b dest)))
+       (setq i (+ i 1))
+       )
+      (list b dest)
+      )))
 
 (defun mime/encode-address-list (n str)
-  (let ((ret (message/parse-addresses str))
-       len (i 0) cell en-ret j cl (dest "") s)
-    (setq len (length ret))
-    (while (< i len)
-      (setq cell (nth i ret))
+  (let* ((ret (message/parse-addresses str))
+        (r ret) cell en-ret j cl (dest "") s)
+    (while r
+      (setq cell (car r))
       (cond ((string= (nth 1 cell) "<")
             (setq en-ret (mime/encode-header-string n (nth 0 cell) 'phrase))
             (setq dest (concat dest (nth 1 en-ret)))
             (setq n (car en-ret))
-            (if (< i (- len 1))
-                (setq en-ret 
+            (if (> (length r) 1)
+                (setq en-ret
                       (mime/encode-header-string
                        n (concat (nth 1 cell)(nth 2 cell)(nth 3 cell) ", "))) 
               (setq en-ret (mime/encode-header-string
@@ -573,35 +576,40 @@
             (setq dest (concat dest (nth 1 en-ret)))
             (setq n (car en-ret))
             
-            (setq en-ret (mime/encode-header-string (+ n 2) (nth 2 cell) 'comment))
+            (setq en-ret (mime/encode-header-string (+ n 2) (nth 2 cell)
+                                                    'comment))
             (if (eq (elt (nth 1 en-ret) 0) ?\n)
                 (progn
                   (setq dest (concat dest "\n ("))
-                  (setq en-ret (mime/encode-header-string 2 (nth 2 cell) 'comment))
+                  (setq en-ret (mime/encode-header-string 2 (nth 2 cell)
+                                                          'comment))
                   )
               (progn
                 (setq dest (concat dest " ("))
                 ))
             (setq dest (concat dest (nth 1 en-ret)))
             (setq n (car en-ret))
-            (if (< i (- len 1))
+            (if (> (length r) 1)
                 (setq en-ret
-                      (mime/encode-header-string n (concat (nth 3 cell) ", ")))
+                      (mime/encode-header-string n (concat (nth 3 cell) ", "))
+                      )
               (setq en-ret (mime/encode-header-string n (nth 3 cell)))
               )
             (setq dest (concat dest (nth 1 en-ret)))
             (setq n (car en-ret))
             )
            (t
-            (if (< i (- len 1))
+            (if (> (length r) 1)
                 (setq en-ret
-                      (mime/encode-header-string n (concat (nth 0 cell) ", ")))
+                      (mime/encode-header-string n (concat (nth 0 cell) ", "))
+                      )
               (setq en-ret (mime/encode-header-string n (nth 0 cell)))
               )
             (setq dest (concat dest (nth 1 en-ret)))
             (setq n (car en-ret))
             ))
-      (setq i (+ i 1)) )
+      (setq r (cdr r))
+      )
     dest))
 
 ;;; @ utility functions
@@ -669,26 +677,27 @@
        (dest nil) (ds "") s
        pcs i j cs chr)
     (if (= len 0) nil
-      (progn (setq chr (elt string 0))
-            (setq pcs (mime/char-type chr))
-            (setq i (char-bytes chr))
-            (setq ds (substring string 0 i))
-            (while (< i len)
-              (setq chr (elt string i))
-              (setq cs (mime/char-type chr))
-              (setq j (+ i (char-bytes chr)))
-              (setq s (substring string i j))
-              (setq i j)
-              (if (= cs pcs)
-                  (setq ds (concat ds s))
-                (progn (setq dest (append dest (list (cons pcs ds))))
-                       (setq pcs cs)
-                       (setq ds s)
-                       ))
-              )
-            (if (not (string= ds ""))
-                (setq dest (append dest (list (cons pcs ds)))))
-            dest)
+      (progn
+       (setq chr (elt string 0))
+       (setq pcs (mime/char-type chr))
+       (setq i (char-bytes chr))
+       (setq ds (substring string 0 i))
+       (while (< i len)
+         (setq chr (elt string i))
+         (setq cs (mime/char-type chr))
+         (setq j (+ i (char-bytes chr)))
+         (setq s (substring string i j))
+         (setq i j)
+         (if (= cs pcs)
+             (setq ds (concat ds s))
+           (progn (setq dest (append dest (list (cons pcs ds))))
+                  (setq pcs cs)
+                  (setq ds s)
+                  ))
+         )
+       (if (not (string= ds ""))
+           (setq dest (append dest (list (cons pcs ds)))))
+       dest)
       )))
 
 (defun mime/separate-string-by-charset (str)

diff --git a/tl-header.el b/tl-header.el
index ef696df..fe37fec 100644 (file)
--- a/tl-header.el
+++ b/tl-header.el
@@ -1,5 +1,5 @@
 ;;;
-;;; $Id: tl-header.el,v 4.6 1994/11/08 10:30:11 morioka Exp $
+;;; $Id: tl-header.el,v 5.2 1994/12/07 07:29:33 morioka Exp $
 ;;;
 
 (provide 'tl-header)
@@ -66,15 +66,46 @@
       nil)
     ))
 
+(defun message::match-ctexts (str)
+  (if (string-match "^[^()\\\\]+" str)
+      (let ((e (match-end 0)))
+       (list (substring str 0 e)(substring str e))
+       )))
+
+(defun message::match-comment (str)
+  (catch 'tag
+    (if (and (>= (length str) 2)
+            (= (elt str 0) ?\()
+            )
+       (let ((dest "") ret)
+         (setq str (substring str 1))
+         (while (cond ((string= str "")
+                       (throw 'tag nil)
+                       )
+                      ((not (= (elt str 0) ?\)))
+                       (setq ret (or (message::match-ctexts str)
+                                     (message::match-comment str)
+                                     ))
+                       ))
+           (setq dest (concat dest (car ret)))
+           (setq str (nth 1 ret))
+           )
+         (if (= (elt str 0) ?\))
+             (list (concat "(" dest ")") (substring str 1))
+           )
+         ))))
+
 (defun message/parse-comment (str)
   (if (string-match "^\\s +" str)
       (setq str (substring str (match-end 0)))
     )
-  (if (string-match "^([^,]*)" str)
-      (list (list "(" (substring str 1 (- (match-end 0) 1)) ")")
-           (substring str (match-end 0))
-           )
-    ))
+  (let ((ret (message::match-comment str)))
+    (if ret
+       (list (list "(" (substring (car ret) 1 (- (length (car ret)) 1))
+                   ")")
+             (nth 1 ret)
+             )
+      )))
 
 (defun message/parse-address (str)
   (let ((ret (or

diff --git a/tl-list.el b/tl-list.el
index 9bb08b1..0f9ab91 100644 (file)
--- a/tl-list.el
+++ b/tl-list.el
@@ -1,5 +1,5 @@
 ;;;
-;;; $Id: tl-list.el,v 2.0 1994/11/08 11:14:20 morioka Exp $
+;;; $Id: tl-list.el,v 2.2 1994/12/11 08:25:35 morioka Exp $
 ;;;
 
 (provide 'tl-list)
@@ -79,11 +79,30 @@ return new alist whose car is the new pair and cdr is <ALIST>.
 ;;;
 
 (defun fetch-field (key alist)
-  (assoc key alist)) 
+  (assoc key alist)
+  )
+
+(defun fetch-field-value (key alist)
+  (cdr (assoc key alist))
+  )
 
 (fset 'put-field 'put-alist)
 (fset 'delete-field 'del-alist)
 
+(defun put-fields (tp c)
+  (catch 'tag
+    (let ((r tp) f ret)
+      (while r
+       (setq f (car r))
+       (if (not (if (setq ret (fetch-field (car f) c))
+                    (equal (cdr ret)(cdr f))
+                  (setq c (cons f c))
+                  ))
+           (throw 'tag 'error))
+       (setq r (cdr r))
+       ))
+    c))
+
 
 ;;; @ field unifier
 ;;;

diff --git a/tl-str.el b/tl-str.el
index deeddb4..e4f60b3 100644 (file)
--- a/tl-str.el
+++ b/tl-str.el
@@ -1,5 +1,5 @@
 ;;;
-;;; $Id: tl-str.el,v 3.1 1994/10/29 09:48:46 morioka Exp $
+;;; $Id: tl-str.el,v 3.2 1994/12/19 10:03:57 morioka Exp $
 ;;;
 
 (provide 'tl-str)
@@ -104,18 +104,16 @@
 ;;; @@ jinn compatible functions
 ;;;
 
-(defun symbol-concat (a b)
-  (intern (concat
-          (cond ((symbolp a)
-                 (symbol-name a)
-                 )
-                ((stringp a) a)
-                )
-          (cond ((symbolp b)
-                 (symbol-name b)
-                 )
-                ((stringp b) b)
-                ))))
+(defun symbol-concat (&rest args)
+  (intern (apply (function concat)
+                (mapcar (function
+                         (lambda (s)
+                           (cond ((symbolp s) (symbol-name s))
+                                 ((stringp s) s)
+                                 )
+                           ))
+                        args)))
+  )
 
 (defun top-string-match (pat str)
   (if (string-match

diff --git a/tm-comp.el b/tm-comp.el
index f94ff7e..4bc5212 100644 (file)
--- a/tm-comp.el
+++ b/tm-comp.el
@@ -1,8 +1,10 @@
 ;;;
-;;; tm-comp.el
+;;; tm-comp.el: attachment for MIME composer
 ;;;
 ;;; by  MORIOKA Tomohiko <morioka@jaist.ac.jp>
 ;;; and   OKABE Yasuo    <okabe@kudpc.kyoto-u.ac.jp>
+;;; modified by MORITA Masahiro <hiro@isl.ntt.JP>
+;;;         and MORIOKA Tomohiko
 ;;;
 
 (provide 'tm-comp)
@@ -15,7 +17,7 @@
 ;;;
 
 (defconst mime/composer-RCS-ID
-  "$Id: tm-comp.el,v 3.2 1994/12/02 05:56:20 morioka Exp $")
+  "$Id: tm-comp.el,v 3.3 1994/12/16 12:54:23 morioka Exp $")
 
 (defconst mime/composer-version (get-version-string mime/composer-RCS-ID))
 
@@ -168,7 +170,69 @@
     ))
 
 
-;;; @ functions
+;;; @ edit
+;;;
+
+;; Insert the binary content after MIME tag.
+;;     modified by MORITA Masahiro <hiro@isl.ntt.JP>
+;;     for x-uue
+(defun tm-comp::mime-insert-binary-file (file &optional encoding)
+  "Insert binary FILE at point.
+Optional argument ENCODING specifies an encoding method such as base64."
+  (let ((tmpbuf (get-buffer-create " *MIME insert*")))
+    (save-excursion
+      (set-buffer tmpbuf)
+      (erase-buffer)
+      (let ((mc-flag nil)              ;Mule
+           (file-coding-system-for-read
+            (if (featurep 'mule) *noconv*))
+           (kanji-flag nil))           ;NEmacs
+       (insert-file-contents file)))
+    (prog1
+       (if (string-equal (downcase encoding) "x-uue")
+           (let ((mime-transfer-encoders
+                  (copy-alist (cons (list "x-uue" "uuencode"
+                                          (file-name-nondirectory file))
+                                    mime-transfer-encoders))))
+             (mime-insert-binary-buffer tmpbuf encoding))
+         (mime-insert-binary-buffer tmpbuf encoding))
+      (kill-buffer tmpbuf))))
+
+;; Insert the binary content after MIME tag.
+;;     modified by MORITA Masahiro <hiro@isl.ntt.JP>
+;;     for x-uue
+(defun tm-comp::mime-insert-binary-buffer (buffer &optional encoding)
+  "Insert binary BUFFER at point.
+Optional argument ENCODING specifies an encoding method such as base64."
+  (let* ((tagend (1- (point)))         ;End of the tag
+        (hide-p (and mime-auto-hide-body
+                     (stringp encoding)
+                     (let ((en (downcase encoding)))
+                       (or (string-equal en "base64")
+                           (string-equal en "x-uue")
+                           ))))
+        )
+    (save-restriction
+      (narrow-to-region (1- (point)) (point))
+      (let ((start (point)))
+       (insert-buffer-substring buffer)
+       ;; Encode binary message if necessary.
+       (if encoding
+           (mime-encode-region encoding start (point-max))))
+      (if hide-p
+         (progn
+           (mime-flag-region (point-min) (1- (point-max)) ?\^M)
+           (goto-char (point-max)))
+       ))
+    ;; Define encoding even if it is 7bit.
+    (if (stringp encoding)
+       (save-excursion
+         (goto-char tagend)            ;Make sure which line the tag is on.
+         (mime-define-encoding encoding)))
+    ))
+
+
+;;; @ split
 ;;;
 
 (defun mime/split-and-send (&optional cmd)
@@ -267,21 +331,41 @@
        (message "")
        ))))
 
-(defun mime/mime-mode-exit-and-run ()
+(defun tm-comp::mime-mode-exit-and-run ()
   (interactive)
   (mime-mode-exit)
-  (call-interactively 'mime/split-and-send))
+  (call-interactively 'mime/split-and-send)
+  )
+
+
+;;; @ set up
+;;;
 
 (add-hook 'mime-mode-hook
          (function
           (lambda ()
-            (if (not (fboundp 'default-mime-mode-exit-and-run))
+            (if (not (fboundp 'original::mime-insert-binary-file))
+                (progn
+                  (fset 'original::mime-insert-binary-file
+                        (symbol-function 'mime-insert-binary-file))
+                  (fset 'mime-insert-binary-file
+                        'tm-comp::mime-insert-binary-file)
+                  ))
+            (if (not (fboundp 'original::mime-insert-binary-buffer))
+                (progn
+                  (fset 'original::mime-insert-binary-buffer
+                        (symbol-function 'mime-insert-binary-buffer))
+                  (fset 'mime-insert-binary-buffer
+                        'tm-comp::mime-insert-binary-buffer)
+                  ))
+            (if (not (fboundp 'original::mime-mode-exit-and-run))
                 (progn
-                  (fset 'default-mime-mode-exit-and-run
+                  (fset 'original::mime-mode-exit-and-run
                         (symbol-function 'mime-mode-exit-and-run))
                   (fset 'mime-mode-exit-and-run
-                        'mime/mime-mode-exit-and-run)
-                  )))))
+                        'tm-comp::mime-mode-exit-and-run)
+                  ))
+            )))
 
 (autoload 'mime/viewer-mode "tm-view" nil t)
 
@@ -320,4 +404,4 @@
                 (if (= arg 32)
                     ?_
                   arg)))) str "")
-  )
\ No newline at end of file
+  )

diff --git a/tm-vm.el b/tm-vm.el
index 321e5a8..3f630ac 100644 (file)
--- a/tm-vm.el
+++ b/tm-vm.el
@@ -12,9 +12,10 @@
 
 (require 'tl-list)
 (require 'tm-view)
+(require 'vm)
 
 (defconst tm-vm/RCS-ID
-  "$Id: tm-vm.el,v 1.6 1994/12/05 07:12:14 morioka Exp $")
+  "$Id: tm-vm.el,v 1.7 1994/12/08 14:48:55 morioka Exp $")
 (defconst tm-vm/version (get-version-string tm-vm/RCS-ID))
 
 (define-key vm-mode-map "Z" 'tm-vm/view-message)