From: morioka Date: Mon, 2 Mar 1998 13:55:52 +0000 (+0000) Subject: tm 5.21 X-Git-Tag: tm5_21~1 X-Git-Url: http://git.chise.org/gitweb/?a=commitdiff_plain;h=f6b5737ac980aa191b15543d4481f4f5a5697bb9;p=elisp%2Ftm.git tm 5.21 --- diff --git a/Makefile b/Makefile index 680ffa7..6e85f9f 100644 --- 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.18.tar +TARFILE = tm5.21.tar all: $(UTILS) $(DVI) diff --git a/Makefile.19 b/Makefile.19 index f4814ae..51a2cd5 100644 --- a/Makefile.19 +++ b/Makefile.19 @@ -20,7 +20,7 @@ TMDIR = $(HOME)/lib/emacs19/lisp/tm .el.elc: $(EMACS) -batch -q . -f batch-byte-compile $< -all: $(TLELC) tl-orig.elc tl-mule.elc signature.elc \ +all: $(TLELC) tl-orig.elc tl-mule.elc tl-list.elc signature.elc \ tiny-mime.elc $(TMELC) tm-orig.elc tm-mule.elc $(TMMELC) \ tm-mh-e.elc tm-gnus.elc $(TMVELC) @@ -39,31 +39,31 @@ signature.elc: signature.el $(EMACS) -batch -q . -l tl-header.el -f batch-byte-compile $< tiny-mime.elc: tiny-mime.el - $(EMACS) -batch -q . -l tl-header.el -f batch-byte-compile $< + $(EMACS) -batch -q . -l tl-header.el -l tl-str.el -f batch-byte-compile $< $(TMELC): - $(EMACS) -batch -q . -l tiny-mime.el -f batch-byte-compile $< + $(EMACS) -batch -q . -l tl-str.el -l tl-list.el -l tl-mule.el -l tm-mule.el -l tl-header.el -l tiny-mime.el -f batch-byte-compile $< tm-orig.elc: tm-orig.el $(ORIG) -batch -q . -l tl-orig.el -f batch-byte-compile $< tm-mule.elc: tm-mule.el - $(MULE) -batch -q . -l tl-list.el -f batch-byte-compile $< + $(MULE) -batch -q . -l tl-str.el -l tl-list.el -l tl-mule.el -f batch-byte-compile $< $(TMMELC): - $(EMACS) -batch -q . -l tiny-mime.el -l tm-misc.el \ + $(EMACS) -batch -q . -l tl-str.el -l tl-list.el -l tl-mule.el -l tl-header.el -l tm-mule.el -l tiny-mime.el -l tm-misc.el \ -f batch-byte-compile $< tm-gnus.elc: tm-gnus.el - $(EMACS) -batch -q . -l tiny-mime.el -l tm-misc.el -l gnus \ + $(EMACS) -batch -q . -l tl-str.el -l tl-list.el -l tl-header.el -l tl-mule.el -l tm-mule.el -l tiny-mime.el -l tm-misc.el -l gnus \ -f batch-byte-compile $< tm-mh-e.elc: tm-mh-e.el - $(EMACS) -batch -q . -l tiny-mime.el -l tm-misc.el -l mh-e \ + $(EMACS) -batch -q . -l tl-str.el -l tl-list.el -l tl-header.el -l tl-mule.el -l tm-mule.el -l tiny-mime.el -l tm-misc.el -l mh-e \ -f batch-byte-compile $< $(TMVELC): - $(EMACS) -batch -q . -l tiny-mime.el -l tm-misc.el -l tm-view.el \ + $(EMACS) -batch -q . -l tl-str.el -l tl-list.el -l tl-header.el -l tl-mule.el -l tm-mule.el -l tiny-mime.el -l tm-misc.el -l tm-view.el \ -f batch-byte-compile $< install: all tl-install tm-install diff --git a/doc/signature-jp.ol b/doc/signature-jp.ol index 795362b..0941191 100644 --- a/doc/signature-jp.ol +++ b/doc/signature-jp.ol @@ -31,5 +31,5 @@ by. $B2,It(B $B, + $B writes: + +$B $B8= $B7A<0$KJ,3d$7$F$/$l$k$b$N$r=q$-$^$7$?!#(B + +$BJXMx$J$N$G!"$9$3$72~NI(B($B2~0-!)(B)$B$7$F$_$^$7$?!#(B + +1. mime-mode-exit $B$r>r7oIU$-$G8F$V$h$&$K$7!"(Bmime-mode $B0J30$G$b(B + $B;H$($k$h$&$K$7$?!#(B + + $B:G6a(B mh-e 4.1 $B$N(B mh-edit-mhn $B$b;H$C$F$_$F$$$k$N$G!"(Bmime-mode $B0J30$G$b(B + $B;H$($k$h$&$K$7$?$H$$$&$N$,F05!$G$9!#6KC<$K8@$($PIaCJ$O(B MIME $B$rA4A3;H$C$F(B + $B$$$J$$?M$G$b!"<+F0J,3d$K$O;H$($k$H;W$$$^$9!#(B + +$B!t(B mh-edit-mhn $B$GJQ49$7$?8e(B mime/view-mode $B$KF~$C$F%W%l%S%e!<$7!"(B + $B$&$^$/$$$C$F$J$+$C$?$i(B mh-revert-mhn-edit $B$G$d$jD>$9!"$H$$$&(B + $Bl9g$K$bBP1~$7$?!#(B + + mh-edit-mhn $B$N=PNO$O$3$N7A<0$J$N$G!"$d$`$rF@$:$=$&$7$^$7$?!#(B + +3. mime/draft-file-name $B$,(B nil $B$N$H$-$K;H$&%U%!%$%kL>$r0J2<$N$h$&$K$7$?!#(B + + (make-temp-name (expand-file-name "tm-draft" mime/tmp-dir)) + +4. $BJ,3d$7$?%a%C%;!<%8$K$O!"$b$H$N(B Subject $B$N$&$7$m$K(B (1/3) $B$J$I$H$D$/(B + $B$h$&$K$7$?!#(B + + $B6a$$>-Mh!"(Bsuper-pipe $B$d(B gnus-uu $B$N$h$&$K!"(Bmessage/partial $B$N$H$-$O$I(B + $B$l$+$R$H$D$N5-;v$r$_$l$PB>$N$rC5$7$K9T$/5!G=$,(B tm-view.el $B$Kl9g!"(BBcc:, Dcc: Fcc: $B$J$IK\MhAw$C$?;~$K>C$($k(B + $B$O$:$N$b$N$,FO$$$F$7$^$&(B($B$H$/$K(B Bcc: $B$,8+$($k$N$OLdBj(B)$B!#(B + $B1#$9%U%#!<%k%I$r;XDj$G$-$k$h$&$K$9$Y$-!#(B + +2. $B@8@.$5$l$k(B id $B$,D9$C$?$i$7$/$F$+$C$30-$$!#(B + ($BNc$($P(B GNUS $B$N(B message-id $B@8@.%k!<%A%s$rE>MQ$7$F$O$I$&$+(B) + +$B$J$I$,$"$j$^$9!#(B + +$B $B$^$?!"(Bmessage $B$N:GBg9T?t$rJQ?t(B mime/message-max-length $B$G;XDj$G$-$^(B +$B $B$9!#$H$j$"$($:!"(Bdefault $B$G$O(B 1000 $B9T$K$7$F$"$j$^$9$,!"$3$l$K4X$9$k0lHL(B +$B $BE*$JCM$O$"$k$s$G$7$g$&$+!)(B + +$B9T?t$h$j$O%P%$%H?t$,Bg;v$J$O$:$G!"$h$/8@$o$l$k$N$O(B1$BDL$"$?$j(B50KB$B$rD6$((B +$B$J$$$h$&$K$H$$$&@)Ls$G$9$M(B($B$&$A$N%;%s%?!<$NMxMQ$NAw$G!"Cf?H$O(B base64 +$B$G0l9T(B80$B;zDj$9$k$H!"(B600 $B9T6/$K$"$?$j$^$9!#$7$+$7(B50KB +$B0J>e$N$b$N$ODL$i$J$$$h$&$K$J$C$F$$$k$H$$$&$o$1$G$O$J$/C1$K0BA4$d8zN($r(B +$B9M$($F$NCM$G$7$g$&$+$i!"(Bsplit $B$NI8=`CM$G$b$"$k(B 1000 $B$GLdBj$J$$$H;W$$$^$9!#(B +----- +$B2,It, - $B writes: - -$B $B8= $B7A<0$KJ,3d$7$F$/$l$k$b$N$r=q$-$^$7$?!#(B - -$BJXMx$J$N$G!"$9$3$72~NI(B($B2~0-!)(B)$B$7$F$_$^$7$?!#(B - -1. mime-mode-exit $B$r>r7oIU$-$G8F$V$h$&$K$7!"(Bmime-mode $B0J30$G$b(B - $B;H$($k$h$&$K$7$?!#(B - - $B:G6a(B mh-e 4.1 $B$N(B mh-edit-mhn $B$b;H$C$F$_$F$$$k$N$G!"(Bmime-mode $B0J30$G$b(B - $B;H$($k$h$&$K$7$?$H$$$&$N$,F05!$G$9!#6KC<$K8@$($PIaCJ$O(B MIME $B$rA4A3;H$C$F(B - $B$$$J$$?M$G$b!"<+F0J,3d$K$O;H$($k$H;W$$$^$9!#(B - -$B!t(B mh-edit-mhn $B$GJQ49$7$?8e(B mime/view-mode $B$KF~$C$F%W%l%S%e!<$7!"(B - $B$&$^$/$$$C$F$J$+$C$?$i(B mh-revert-mhn-edit $B$G$d$jD>$9!"$H$$$&(B - $Bl9g$K$bBP1~$7$?!#(B - - mh-edit-mhn $B$N=PNO$O$3$N7A<0$J$N$G!"$d$`$rF@$:$=$&$7$^$7$?!#(B - -3. mime/draft-file-name $B$,(B nil $B$N$H$-$K;H$&%U%!%$%kL>$r0J2<$N$h$&$K$7$?!#(B - - (make-temp-name (expand-file-name "tm-draft" mime/tmp-dir)) - -4. $BJ,3d$7$?%a%C%;!<%8$K$O!"$b$H$N(B Subject $B$N$&$7$m$K(B (1/3) $B$J$I$H$D$/(B +message/partial $B$,4JC1$K(B decode $B$G$-$k$h$&$K$J$C$?$N$G!"(Btm-comp.el +$B$r$$$D$b;H$&$h$&$K$7$h$&$H;W$C$?$N$G$9$,!";H$$$O$8$a$F$_$k$H$$$m$$$m(B +$BITK~$,$G$F$-$^$7$?!#(B + +$B!&Aw?.$K<:GT$7$F$b!"$J$K$4$H$b$J$/=*$C$F$7$^$$!"$&$^$/Aw$l$?$+(B + $B$I$&$+3NG'$G$-$J$$(B($B%P%C%U%!$b$J$/$J$k(B) +$B!&(Bmh-letter-mode $B$+$i$NAw?.$N>l9g!"(Bmh-send-letter $B$,K\Mh$b$D(B + $B5!G=$G$"$k!"(Bprefix argument $B$K$h$k@ZBX$($d!"(Bannotate $B$N(B + $B5!G=$,;H$($J$/$J$k!#(B +$B!&(Bnews-reply-mode $B$N>l9g!"(Bnntp-server $B$,(B open $B$5$l$F$$$J$$$H(B + $B$3$1$k!#$3$l$O(B gnus-post-news $B$rC1FH$K5/F0$7$?>l9g$d(B + $B=q$$$F$$$k$&$A$K(B connection $B$,@Z$l$?>l9g$K:$$k!#(B +$B!&(Bnews-inews-hook $B$d(B mh-before-send-letter-hook $B$b8z$+$J$$!#(B +$B!&J,3d8e$N%a%C%;!<%8$N%\%G%#It$N@hF,$K!"J,3dA0$N%a%C%;!<%8$N(B + $B%X%C%@It$,F~$k$,!"$=$3$K(B Fcc: $B$d(B Dcc: $B$,8+$($F$+$C$30-$$!#(B + +$B$J$I$NLdBjE@$,$"$j$^$7$?!#$=$3$G$3$l$i$rF'$^$($FBgI}$K2~NI$7$F(B +$B$_$^$7$?!#2~NIE@$N$"$i$^$7$O!"(B + +1$B!"J,3d$5$l$J$$%a%C%;!<%8$N>l9g$K$O!"(Bmime/message-default-sender-alist + $B$K=q$+$l$?K\Mh$N4X?t(B(mh-letter-mode $B$J$i(B mh-send-letter)$B$,8F$P$l$k$h(B + $B$&$K$7$?(B($B$3$l$G(B tm-comp $B$rI8=`@_Dj$K$$$l$F$7$^$C$F$b$[$\LdBj$J$$$H(B + $B;W$$$^$9(B)$B!#(B + +2. $BJ,3d$7$?%a%C%;!<%8$r$=$l$>$lAw$kJ}K!(B mime/message-sender-alist $B$H$O(B + $BJL$K!"J,3dAw?.A0$HJ,3dAw?.8e$K$=$l$>$l0l2s$E$D-Mh!"(Bsuper-pipe $B$d(B gnus-uu $B$N$h$&$K!"(Bmessage/partial $B$N$H$-$O$I(B - $B$l$+$R$H$D$N5-;v$r$_$l$PB>$N$rC5$7$K9T$/5!G=$,(B tm-view.el $B$Kl9g!"(BBcc:, Dcc: Fcc: $B$J$IK\MhAw$C$?;~$K>C$($k(B - $B$O$:$N$b$N$,FO$$$F$7$^$&(B($B$H$/$K(B Bcc: $B$,8+$($k$N$OLdBj(B)$B!#(B - $B1#$9%U%#!<%k%I$r;XDj$G$-$k$h$&$K$9$Y$-!#(B - -2. $B@8@.$5$l$k(B id $B$,D9$C$?$i$7$/$F$+$C$30-$$!#(B - ($BNc$($P(B GNUS $B$N(B message-id $B@8@.%k!<%A%s$rE>MQ$7$F$O$I$&$+(B) +4. $B0l$D$N5-;v$N9T$N@)8B$r(B mime/message-default-max-length $B$H$7(B + $B$5$i$K!"(Bmode $B$4$H$N@)8B$b(B mime/message-max-length-alist $B$K(B + $B=q$1$k$h$&$K$7$?!#(B -$B$J$I$,$"$j$^$9!#(B +5. MIME $B$G=q$$$?5-;v$N(B preview $B$N$?$a$N4X?t$H$7$F!"(B + mime/draft-preview $B$H$$$&$N$rMQ0U$7$?(B($B$3$l$O$*$^$1(B)$B!#(B -$B $B$^$?!"(Bmessage $B$N:GBg9T?t$rJQ?t(B mime/message-max-length $B$G;XDj$G$-$^(B -$B $B$9!#$H$j$"$($:!"(Bdefault $B$G$O(B 1000 $B9T$K$7$F$"$j$^$9$,!"$3$l$K4X$9$k0lHL(B -$B $BE*$JCM$O$"$k$s$G$7$g$&$+!)(B +$B$J$I$G$9!#%Q%C%A$r$D$/$C$?$i$b$H$h$jBg$-$/$J$C$F$7$^$C$?$N$G!"(B +$BA4BN$r$*FO$1$7$^$9!#(B -$B9T?t$h$j$O%P%$%H?t$,Bg;v$J$O$:$G!"$h$/8@$o$l$k$N$O(B1$BDL$"$?$j(B50KB$B$rD6$((B -$B$J$$$h$&$K$H$$$&@)Ls$G$9$M(B($B$&$A$N%;%s%?!<$NMxMQ$NAw$G!"Cf?H$O(B base64 -$B$G0l9T(B80$B;zDj$9$k$H!"(B600 $B9T6/$K$"$?$j$^$9!#$7$+$7(B50KB -$B0J>e$N$b$N$ODL$i$J$$$h$&$K$J$C$F$$$k$H$$$&$o$1$G$O$J$/C1$K0BA4$d8zN($r(B -$B9M$($F$NCM$G$7$g$&$+$i!"(Bsplit $B$NI8=`CM$G$b$"$k(B 1000 $B$GLdBj$J$$$H;W$$$^$9!#(B ------ -$B2,It +;;; and OKABE Yasuo ;;; (provide 'tm-comp) @@ -7,19 +10,98 @@ (require 'tl-header) (require 'mail-utils) -(defvar mime/message-max-length 1000) + +;;; @ version +;;; + +(defconst mime/composer-RCS-ID + "$Id: tm-comp.el,v 3.2 1994/12/02 05:56:20 morioka Exp $") + +(defconst mime/composer-version (get-version-string mime/composer-RCS-ID)) + + +;;; @ variables +;;; + +(defvar mime/message-default-max-length 1000) + +(defvar mime/message-max-length-alist + '((news-reply-mode . 500))) + +(defconst mime/message-nuke-headers + "\$^[Cc]ontent-\\|^[Ss]ubject:\\|^[Mm][Ii][Mm][Ee]-[Vv]ersion:\$") +(defvar mime/message-blind-headers + "\$^[BDFbdf][Cc][Cc]:\\|^[Cc][Cc]:[ \t]*$\$") + +(defvar mime/message-default-sender-alist + '((mail-mode . mail-send-and-exit) + (mh-letter-mode . mh-send-letter) + (news-reply-mode . gnus-inews-news))) (defvar mime/message-sender-alist - '((mail-mode . sendmail-send-it) - (mh-letter-mode . (lambda () - (write-region (point-min) (point-max) + '((mail-mode . (lambda () + (interactive) + (sendmail-send-it) + )) + (mh-letter-mode . (lambda (&optional arg) + (interactive "P") + (write-region (point-min) (point-max) mime/draft-file-name) - (call-process - (expand-file-name mh-send-prog mh-progs) - nil nil nil mime/draft-file-name) - )) - (news-reply-mode . gnus-inews-article) + (message + (format "Sending %d/%d..." (+ i 1) total)) + (cond (arg + (pop-to-buffer "MH mail delivery") + (erase-buffer) + (mh-exec-cmd-output mh-send-prog t "-watch" "-nopush" + "-nodraftfolder" mh-send-args mime/draft-file-name) + (goto-char (point-max)) ; show the interesting part + (recenter -1) + (sit-for 1)) + (t + (apply 'mh-exec-cmd-quiet t mh-send-prog + (mh-list-to-string + (list "-nopush" "-nodraftfolder" "-noverbose" "-nowatch" mh-send-args mime/draft-file-name))))) + (message + (format "Sending %d/%d... done" (+ i 1) total)) + )) + (news-reply-mode . (lambda () + (interactive) + (widen) + (goto-char (point-min)) + (save-restriction + (narrow-to-region + (point-min) + (progn + (goto-char (point-min)) + (search-forward (concat "\n" mail-header-separator "\n")) + (point))) + ;; Mail the message too if To: or Cc: exists. + (if (or (mail-fetch-field "to" nil t) + (mail-fetch-field "cc" nil t)) + (if gnus-mail-send-method + (progn + (message + (format "Sending (%d/%d) via mail..." (+ i 1) total)) + (widen) + (funcall gnus-mail-send-method) + (message + (format "Sending (%d/%d) via mail... done" (+ i 1) total)) + (ding) + (message "No mailer defined. To: and/or Cc: fields ignored.") + (sit-for 1))))) + (message + (format "Posting %d/%d to USENET..." (+ i 1) total)) + (if (gnus-inews-article) + (message + (format "Posting %d/%d to USENET... done" (+ i 1) total)) + ;; We cannot signal an error. + (ding) + (message + (format "Article %d/%d rejected: %s" (+ i 1) total (gnus-status-message))) + (sit-for 3)) + )) )) + (defvar mime/window-config-alist '((mail-mode . nil) @@ -30,43 +112,108 @@ )) )) +(defvar mime/news-reply-mode-server-running nil) + +(defvar mime/message-before-send-hook-alist + '((mh-letter-mode . mh-before-send-letter-hook)) + (news-reply-mode . '(lambda () + (let ((case-fold-search nil)) + (or (boundp 'mime/news-reply-mode-server-running) + (make-variable-buffer-local 'mime/news-reply-mode-server-running)) + (setq mime/news-reply-mode-server-running (gnus-server-opened)) + (save-excursion + (gnus-start-server-process) + (widen) + (goto-char (point-min)) + (run-hooks 'news-inews-hook) + (save-restriction + (narrow-to-region + (point-min) + (progn + (goto-char (point-min)) + (search-forward (concat "\n" mail-header-separator "\n")) + (point))) + + (goto-char (point-min)) + (if (search-forward-regexp "^Newsgroups: +" nil t) + (save-restriction + (narrow-to-region + (point) + (if (re-search-forward "^[^ \t]" nil 'end) + (match-beginning 0) + (point-max))) + (goto-char (point-min)) + (replace-regexp "\n[ \t]+" " ") + (goto-char (point-min)) + (replace-regexp "[ \t\n]*,[ \t\n]*\\|[ \t]+" ",") + )) + )))) + )) + +(defvar mime/message-after-send-hook-alist + '((mh-letter-mode . '(lambda () + (if mh-annotate-char + (mh-annotate-msg mh-sent-from-msg + mh-sent-from-folder + mh-annotate-char + "-component" mh-annotate-field + "-text" + (format "\"%s %s\"" + (mh-get-field "To:") + (mh-get-field "Cc:")))))) + (news-reply-mode . '(lambda () + (or mime/news-reply-mode-server-running + (gnus-close-server)) + (and (fboundp 'bury-buffer) (bury-buffer)))) + )) + + +;;; @ functions +;;; + (defun mime/split-and-send (&optional cmd) (interactive) - (if (null cmd) - (setq cmd (cdr (assq major-mode mime/message-sender-alist))) - ) - (let ((mime/draft-file-name (buffer-file-name)) - (lines (count-lines (point-min)(point-max))) - (separator mail-header-separator) - (config (eval (cdr (assq major-mode mime/window-config-alist)))) + (let ((mime/message-max-length + (or (cdr (assq major-mode mime/message-max-length-alist)) + mime/message-default-max-length)) + (lines (count-lines (point-min) (point-max))) ) - (if (null mime/draft-file-name) - (setq mime/draft-file-name - (make-temp-name (expand-file-name "tm-draft" mime/tmp-dir))) - ) - (if (and (boundp 'mime-mode-flag) mime-mode-flag) - (mime-mode-exit)) (if (<= lines mime/message-max-length) - (funcall cmd) - (let ((header (message/get-header-string-except - "\$^[Cc]ontent-\\|^[Ss]ubject:\$" separator)) - (subject (mail-fetch-field "subject")) - (id (concat "\"" - (replace-space-with-underline (current-time-string)) - "@" (system-name) "\"")) - ) - (goto-char (point-min)) - (if (re-search-forward (concat "^" (regexp-quote separator) "$") - nil t) - (replace-match "") - ) - (let* ((total (+ (/ lines mime/message-max-length) + (call-interactively + (or cmd (cdr (assq major-mode mime/message-default-sender-alist)))) + (let* ((mime/draft-file-name + (or (buffer-file-name) + (make-temp-name (expand-file-name "tm-draft" mime/tmp-dir)))) + (separator mail-header-separator) + (config (eval (cdr (assq major-mode mime/window-config-alist)))) + (id (concat "\"" + (replace-space-with-underline (current-time-string)) + "@" (system-name) "\""))) + + (let ((hook (eval (cdr (assq major-mode mime/message-before-send-hook-alist))))) + (run-hooks 'hook)) + (let* ((header (message/get-header-string-except + mime/message-nuke-headers separator)) + (orig-header (message/get-header-string-except + mime/message-blind-headers separator)) + (subject (mail-fetch-field "subject")) + (total (+ (/ lines mime/message-max-length) (if (> (mod lines mime/message-max-length) 0) 1))) - (i 0)(l mime/message-max-length) + (i 0) + (l mime/message-max-length) (the-buf (current-buffer)) (buf (get-buffer "*tmp-send*")) + (command + (or cmd + (cdr (assq major-mode mime/message-sender-alist)) + (cdr (assq major-mode mime/message-default-sender-alist)))) data) + (goto-char (point-min)) + (if (re-search-forward (concat "^" (regexp-quote separator) "$") + nil t) + (replace-match "") + ) (if buf (progn (switch-to-buffer buf) @@ -80,9 +227,9 @@ (setq mail-header-separator separator) (switch-to-buffer the-buf) (goto-char (point-min)) + (re-search-forward "^$" nil t) (while (< i total) (setq buf (get-buffer "*tmp-send*")) - (setq data (buffer-substring (point) (progn @@ -94,36 +241,56 @@ (insert (format "Subject: %s (%d/%d)\n" subject (+ i 1) total)) (insert + (format "Mime-Version: 1.0\n")) + (insert (format "Content-Type: message/partial; id=%s; number=%d; total=%d\n%s\n" id (+ i 1) total separator)) + (if (eq i 0) + (insert orig-header)) (insert data) - (funcall cmd) + (save-excursion + (call-interactively command)) (erase-buffer) (switch-to-buffer the-buf) (setq l (+ l mime/message-max-length)) (setq i (+ i 1)) ) - ))) - (set-buffer-modified-p nil) - (kill-buffer (current-buffer)) - (if config - (set-window-configuration config) - ) - )) + ) + (let ((hook (eval (cdr (assq major-mode mime/message-after-send-hook-alist))))) + (run-hooks 'hook)) + (set-buffer-modified-p nil) + (cond ((y-or-n-p "Kill draft buffer? ") + (kill-buffer (current-buffer)) + (if config + (set-window-configuration config)))) + (message "") + )))) + +(defun mime/mime-mode-exit-and-run () + (interactive) + (mime-mode-exit) + (call-interactively 'mime/split-and-send)) (add-hook 'mime-mode-hook (function (lambda () (if (not (fboundp 'default-mime-mode-exit-and-run)) (progn - (make-variable-buffer-local 'mime/send-message-method) (fset 'default-mime-mode-exit-and-run - 'mime-mode-exit-and-run) + (symbol-function 'mime-mode-exit-and-run)) (fset 'mime-mode-exit-and-run - 'mime/split-and-send) + 'mime/mime-mode-exit-and-run) ))))) +(autoload 'mime/viewer-mode "tm-view" nil t) + +(defun mime/draft-preview () + (interactive) + (goto-char (point-min)) + (mime/viewer-mode) + (pop-to-buffer (current-buffer))) + (defun message/get-header-string-except (pat boundary) (save-excursion (save-restriction @@ -153,4 +320,4 @@ (if (= arg 32) ?_ arg)))) str "") - ) + ) \ No newline at end of file diff --git a/tm-ftp.el b/tm-ftp.el index 9044ed8..6907d13 100644 --- a/tm-ftp.el +++ b/tm-ftp.el @@ -1,9 +1,12 @@ ;;; ;;; tm-ftp: anonymous ftp processor for tm-view ;;; -;;; by MASUTANI Yasuhiro (1994/11/5) +;;; by MASUTANI Yasuhiro (1994/11/ 5) ;;; -;;; modified by MORIOKA Tomohiko (1994/11/8) +;;; modified by MORIOKA Tomohiko (1994/11/ 8) +;;; and OKABE Yasuo (1994/11/11) +;;; +;;; $Id: tm-ftp.el,v 5.0 1994/11/11 04:45:17 morioka Exp $ ;;; (provide 'tm-ftp) @@ -20,6 +23,7 @@ (setq pathname (concat "/anonymous@" site ":" directory)) (message (concat "Accessing " pathname "/" name "...")) + (switch-to-buffer mime/preview-buffer) (dired pathname) (goto-char (point-min)) (search-forward name) @@ -30,7 +34,3 @@ ("access-type" . "anon-ftp") (method . mime/decode-message/external-ftp) )) - - - - \ No newline at end of file diff --git a/tm-latex.el b/tm-latex.el new file mode 100644 index 0000000..1bdfb28 --- /dev/null +++ b/tm-latex.el @@ -0,0 +1,48 @@ +;;; +;;; tm-latex: tm-view internal decoder for tm-view +;;; +;;; by OKABE Yasuo (1994/11/11) +;;; +;;; modified by MORIOKA Tomohiko +;;; +;;; $Id: tm-latex.el,v 1.1 1994/11/29 18:20:07 morioka Exp $ +;;; + +(provide 'tm-latex) + +(defun mime/decode-text/latex (beg end cal) + (let* ((cur-buf (current-buffer)) + new-buf + (name (or (cdr (assoc "name" cal)) + (cdr (assoc "x-name" cal)) + (concat (make-temp-name "tm") ".tex")))) + (switch-to-buffer mime/preview-buffer) + (find-file (expand-file-name name mime/tmp-dir)) + (if (or (<= (buffer-size) 0) + (y-or-n-p "Replace the existing buffer?")) + (progn + (erase-buffer) + (setq new-buf (current-buffer)) + (save-excursion + (set-buffer cur-buf) + (goto-char beg) + (re-search-forward "^$") + (append-to-buffer new-buf (+ (match-end 0) 1) end) + ))) + )) + +(set-atype 'mime/content-decoding-condition + '((type . "text/x-latex") + (method . mime/decode-text/latex) + )) + +(set-atype 'mime/content-decoding-condition + '((type . "application/x-latex") + (method . mime/decode-text/latex) + )) + +(set-atype 'mime/content-decoding-condition + '((type . "application/octet-stream") + ("type" . "latex") + (method . mime/decode-text/latex) + )) diff --git a/tm-partial.el b/tm-partial.el new file mode 100644 index 0000000..805b26c --- /dev/null +++ b/tm-partial.el @@ -0,0 +1,163 @@ +;;; +;;; tm-partial.el +;;; +;;; Grabbing all MIME "message/partial"s. +;;; by Yasuo OKABE @ Kyoto University 1994 +;;; modified by MORIOKA Tomohiko + +;; original file is +;; gif.el written by Art Mellor @ Cayman Systems, Inc. 1991 + +(require 'tm-view) + +;; This regular expression controls what types of subject lines can be +;; parsed. Currently handles lines like: +;; foo [1/3] +;; foo (1/3) +;; foo 1/3 +;; foo [1 of 3] +;; foo (1 of 3) +;; foo 1 of 3 +;; foo1 of 3 + +(defvar mime/gp:subject-start-regexp "[ \t]*\$v[0-9]+i[0-9]+:[ \t]+\$?") + +(defvar mime/gp:subject-end-regexp "\$[[(]?\$\$[0-9]+\$\$/\\| [oO][fF] \$\$[0-9]+\$\$[])]?\$[ \t]*$") + +;; display Article at the cursor in Subject buffer. +(defun mime/gp:display-article () + (save-excursion + (cond + ((eq target 'gnus4) + (gnus-summary-display-article (gnus-summary-article-number))) + ((eq target 'mh-e) + (mh-show)) + (t + (error "Fatal. Unsupported mode"))))) + +(defun mime/decode-message/grab-partials (beg end cal) + (interactive) + (let* ((id (cdr (assoc "id" cal))) + (number (cdr (assoc "number" cal))) + (total (cdr (assoc "total" cal))) + (buffer (generate-new-buffer id)) + (mother mime/preview-buffer) + target + subject-buf + (article-buf (buffer-name (current-buffer))) + (subject-id nil) + (part-num 1) + (part-missing nil)) + (cond ((eq major-mode 'gnus-article-mode) + (progn + (setq subject-buf gnus-summary-buffer) + (setq target 'gnus4))) + ((eq major-mode 'mh-show-mode) + (progn + (string-match "^show-\$.+\$$" article-buf) + (setq subject-buf (substring article-buf (match-beginning 1) (match-end 1))) + (setq target 'mh-e))) + (t (error "%s is not supported. Sorry." major-mode))) + + (if (and (eq beg (point-min)) (eq end (point-max))) + (save-excursion + (goto-char (point-min)) + (re-search-forward "^$") + (let ((delim (match-beginning 0))) + (goto-char (point-min)) + (if (re-search-forward "^[Ss]ubject:.*$" delim t) + (let ((tail (match-end 0))) + (beginning-of-line) + (re-search-forward (concat "^[Ss]ubject:" mime/gp:subject-start-regexp) tail t) + (let ((start (point))) + (if (and (re-search-forward mime/gp:subject-end-regexp tail t) + (eq (string-to-int number) + (string-to-int (buffer-substring (match-beginning 2) (match-end 2)))) + (eq (string-to-int total) + (string-to-int (buffer-substring (match-beginning 4) (match-end 4))))) + (setq subject-id (buffer-substring start (match-end 1))) + (setq part-missing (string-to-int number))))) + (setq part-missing t)))) + (setq part-missing t)) + + ;; if you can't parse the subject line, try simple decoding method + (if (or part-missing + (not (y-or-n-p "Merge partials?"))) + (progn + (kill-buffer buffer) + (mime/decode-message/partial-region beg end cal)) + (progn + (set-buffer subject-buf) + (setq part-missing (mime/gp:part-missing-p subject-id (string-to-int total))) + (if part-missing + (progn + (kill-buffer buffer) + (error "Couldn't find part %d" part-missing))) + (save-excursion + (while (<= part-num (string-to-int total)) + (goto-char (point-min)) + (message "Grabbing part %d of %d" part-num (string-to-int total)) + (re-search-forward + (concat (regexp-quote subject-id) "0*" + (int-to-string part-num)) nil t) + (mime/gp:display-article) + (save-excursion + (set-buffer article-buf) + (goto-char (point-min)) + (re-search-forward "^$") + (let ((delimit (point))) + (goto-char (point-min)) + (if (not + (and + (re-search-forward + "^[Cc]ontent-[Tt]ype:[ \t]*message/partial;" delimit t) + (re-search-forward + (concat "[ \t]+id=[ \t]*\"" + (regexp-quote id) "\";") delimit) + (re-search-forward + (concat "[ \t]+number=[ \t]*" + (int-to-string part-num) ";") delimit))) + (progn + (kill-buffer buffer) + (error "Couldn't find part %d" part-num))) + (append-to-buffer buffer (+ delimit 1) (point-max)))) + (setq part-num (+ part-num 1)))) + (mime/gp:display-article) + (save-excursion + (set-buffer article-buf) + (make-variable-buffer-local 'mime/content-list) + (setq mime/content-list (mime/parse-contents))) + (delete-other-windows) + (switch-to-buffer buffer) + (goto-char (point-min)) + (setq major-mode 'mime/show-message-mode) + (mime/viewer-mode mother) + (pop-to-buffer (current-buffer)) + )))) + +;; Check if all the parts are there +(defun mime/gp:part-missing-p (subject-string num-parts) + (save-excursion + (let ((part-num 1) + (cant-find nil)) + + (while (and (<= part-num num-parts) (not cant-find)) + (goto-char (point-min)) + ;; If the parts are numbered 01/10, then chop off the leading 0 + (if (not (re-search-forward + (concat (regexp-quote subject-id) "0*" + (int-to-string part-num)) + nil t)) + (setq cant-find part-num) + (progn + (message "Found part %d of %d." part-num num-parts) + (setq part-num (+ part-num 1))))) + cant-find))) + + +(set-atype 'mime/content-decoding-condition + '((type . "message/partial") + (method . mime/decode-message/grab-partials) + )) + +(provide 'tm-partial) diff --git a/tm-rich.el b/tm-rich.el index e93e36a..5ac2d8b 100644 --- a/tm-rich.el +++ b/tm-rich.el @@ -1,5 +1,5 @@ ;;; -;;; $Id: tm-rich.el,v 2.2 1994/10/31 07:44:51 morioka Exp morioka $ +;;; $Id: tm-rich.el,v 3.0 1994/11/29 17:59:32 morioka Exp $ ;;; ;;; by MORIOKA Tomohiko ;;; modified by YAMATE Keiichirou @@ -9,9 +9,14 @@ (require 'tm-view) + +(defvar mime/text/richtext-face-list + '("bold" "italic" "fixed" "underline")) + (defvar mime/text/enriched-face-list '("bold" "italic" "fixed" "underline")) + (cond ((and (>= (string-to-int emacs-version) 19) window-system) (require 'hilit19) (defun mime/set-face-region (b e face) @@ -26,26 +31,30 @@ )))) ) ((and (boundp 'NEMACS) NEMACS) - (setq mime/text/enriched-face-list + (setq mime/available-face-list '("bold" "italic" "underline")) - (setq mime/text/enriched-face-attribute-alist + (setq mime/available-face-attribute-alist '(("bold" . inversed-region) ("italic" . underlined-region) ("underline" . underlined-region) )) (defun mime/set-face-region (beg end sym) (attribute-add-narrow-attribute - (cdr (assoc sym mime/text/enriched-face-attribute-alist)) + (cdr (assoc sym mime/available-face-attribute-alist)) beg end)) ) (t - (setq mime/text/enriched-face-list + (setq mime/text/richtext-face-list nil) (defun mime/set-face-region (beg end sym) ) )) -(defun mime/decode-text/enriched-region (beg end) + +;;; @ text/richtext +;;; + +(defun mime/decode-text/richtext-region (beg end) (interactive "*r") (save-excursion (save-restriction @@ -67,7 +76,7 @@ ) (setq fb (point)) ) - ((member (downcase cmd) mime/text/enriched-face-list) + ((member (downcase cmd) mime/text/richtext-face-list) (setq b (point)) (save-excursion (save-restriction @@ -87,6 +96,76 @@ ) )))) +(defun mime/decode-text/richtext (&optional ctl) + (interactive) + (save-excursion + (save-restriction + (let ((beg (point-min)) (end (point-max))) + (goto-char (point-min)) + (if (search-forward "\n\n" nil t) + (setq beg (match-end 0)) + ) + (mime/decode-text/richtext-region beg end) + )))) + + +;;; @ text/enriched +;;; + +(defun mime/decode-text/enriched-region (beg end) + (interactive "*r") + (save-excursion + (save-restriction + (narrow-to-region beg end) + (while (re-search-forward "[\n]+" nil t) + (let ((str (buffer-substring (match-beginning 0) + (match-end 0)))) + (if (string= str "\n") + (replace-match " ") + (replace-match (substring str 1)) + ))) + (goto-char beg) + (let (cmd str (fb (point)) fe b e) + (while (re-search-forward "<\$<\\|[^<>\n\r \t]+>\$" nil t) + (setq b (match-beginning 0)) + (setq cmd (buffer-substring b (match-end 0))) + (if (string= cmd "<<") + (replace-match "<") + (replace-match "") + (setq cmd (downcase (substring cmd 1 (- (length cmd) 1)))) + ) + (cond ((string= cmd "param") + (setq b (point)) + (save-excursion + (save-restriction + (if (search-forward "" nil t) + (progn + (replace-match "") + (setq e (point)) + ) + (setq e end) + ))) + (delete-region b e) + ) + ((member cmd mime/text/enriched-face-list) + (setq b (point)) + (save-excursion + (save-restriction + (if (re-search-forward (concat "") nil t) + (progn + (replace-match "") + (setq e (point)) + ) + (setq e end) + ))) + (mime/set-face-region b e cmd) + ))) + (goto-char (point-max)) + (if (not (eq (preceding-char) ?\n)) + (insert "\n") + ) + )))) + (defun mime/decode-text/enriched (&optional ctl) (interactive) (save-excursion @@ -100,9 +179,11 @@ )))) -(set-alist 'mime/content-filter-alist - "text/enriched" (function mime/decode-text/enriched)) +;;; @ setting +;;; (set-alist 'mime/content-filter-alist - "text/richtext" (function mime/decode-text/enriched)) + "text/richtext" (function mime/decode-text/richtext)) +(set-alist 'mime/content-filter-alist + "text/enriched" (function mime/decode-text/enriched)) diff --git a/tm-setup.el b/tm-setup.el index 73259da..75fe4ca 100644 --- a/tm-setup.el +++ b/tm-setup.el @@ -1,10 +1,46 @@ ;;; -;;; $Id: tm-setup.el,v 3.0 1994/09/01 05:37:13 morioka Exp $ +;;; $Id: tm-setup.el,v 4.0 1994/12/04 09:35:44 morioka Exp $ ;;; (provide 'tm-setup) +;;; @ for LaTeX +;;; +(add-hook 'tm-view-load-hook + (function + (lambda () + (set-atype 'mime/content-decoding-condition + '((type . "text/x-latex") + (method . mime/decode-text/latex) + )) + (set-atype 'mime/content-decoding-condition + '((type . "application/x-latex") + (method . mime/decode-text/latex) + )) + (set-atype 'mime/content-decoding-condition + '((type . "application/octet-stream") + ("type" . "latex") + (method . mime/decode-text/latex) + )) + (autoload 'mime/decode-text/latex "tm-latex") + ))) + + +;;; @ for Anonymous FTP (need of ange-ftp) +;;; +(add-hook 'tm-view-load-hook + (function + (lambda () + (set-atype 'mime/content-decoding-condition + '((type . "message/external-body") + ("access-type" . "anon-ftp") + (method . mime/decode-message/external-ftp) + )) + (autoload 'mime/decode-text/latex "tm-ftp") + ))) + + ;;; @ for Emacs 18 ;;; (if (< (string-to-int emacs-version) 19) diff --git a/tm-view.el b/tm-view.el index 0eb9369..24ca642 100644 --- a/tm-view.el +++ b/tm-view.el @@ -20,7 +20,7 @@ ;;; (defconst mime/viewer-RCS-ID - "$Id: tm-view.el,v 5.19 1994/11/08 11:13:12 morioka Exp $") + "$Id: tm-view.el,v 5.21 1994/11/21 18:38:48 morioka Exp morioka $") (defconst mime/viewer-version (get-version-string mime/viewer-RCS-ID)) @@ -49,8 +49,8 @@ ;;(setq mime/content-decoding-condition '(((type . "text/plain") (method "tm-plain" nil 'file 'type 'encoding 'mode 'name)) - ((type . "text/x-latex") - (method "tm-latex" nil 'file 'type 'encoding 'mode 'name)) + ;;((type . "text/x-latex") + ;; (method "tm-latex" nil 'file 'type 'encoding 'mode 'name)) ((type . "audio/basic") (method "tm-au" nil 'file 'type 'encoding 'mode 'name)) ((type . "image/gif") @@ -112,7 +112,9 @@ (defvar mime/default-showing-Content-Type-list ;;(setq mime/default-showing-Content-Type-list - '("text/plain" "text/richtext" "text/enriched" "text/x-latex" nil)) + '("text/plain" "text/richtext" "text/enriched" + "text/x-latex" "application/x-latex" + "application/octet-stream" nil)) (defvar mime/go-to-top-node-method-alist ;;(setq mime/go-to-top-node-method-alist @@ -629,6 +631,7 @@ (setq ctl (cdr ctl)) (setq cal (nconc (list (cons 'type ctype) (cons 'encoding encoding) + (cons 'major-mode major-mode) ) ctl)) (if mime/body-decoding-mode