From 512f3ae410a64c797aee755730d693750b232e6c Mon Sep 17 00:00:00 2001 From: morioka Date: Mon, 2 Mar 1998 15:02:47 +0000 Subject: [PATCH] tm 6.50 --- Makefile | 26 +- Makefile.bc | 4 +- base64.el | 105 ++++++++ gnus/Makefile | 10 + gnus/tm-dgnus.el | 85 +++++++ gnus/tm-gnus.el | 95 ++------ gnus/tm-gnus3.el | 7 +- gnus/tm-gnus4.el | 6 +- gnus/tm-ognus.el | 82 +++++++ inst-el | 6 +- inst-elc | 8 +- mh-e/Makefile | 16 +- mh-e/tm-mh-e.el | 212 ++++++++++++++--- mh-e/tm-mh-e3.el | 56 +---- mime-setup.el | 7 +- qprint.el | 139 +++++++++++ rel-7jp.ol | 67 ++++++ tiny-mime.el | 23 +- tm-comp.el | 92 +++---- tm-evs.el | 172 ++++++++++++++ tm-eword.el | 699 ++++++++++++++++++++++++++++++++++++++++++++++++++++++ tm-mule.el | 17 +- tm-nemacs.el | 12 +- tm-orig.el | 12 +- tm-partial.el | 21 +- tm-rich.el | 50 ++-- tm-setup.el | 7 +- tm-view.el | 564 ++++++++++++++++++++++++------------------- 28 files changed, 2044 insertions(+), 556 deletions(-) create mode 100644 base64.el create mode 100644 gnus/tm-dgnus.el create mode 100644 gnus/tm-ognus.el create mode 100644 qprint.el create mode 100644 rel-7jp.ol create mode 100644 tm-evs.el create mode 100644 tm-eword.el diff --git a/Makefile b/Makefile index 797137a..5f4b818 100644 --- a/Makefile +++ b/Makefile @@ -17,11 +17,11 @@ MULE2 = mule2 # TMDIR18 = for Emacs 18.* (NEMACS, NEpoch or MULE 1) # TMDIR19 = for Emacs 19.* (FSF original, XEmacs or MULE 2) -TMDIR18 = /usr/local/lib/emacs/local.lisp/tm -TMDIR19 = /usr/local/lib/mule/site-lisp +#TMDIR18 = /usr/local/lib/emacs/local.lisp/tm +#TMDIR19 = /usr/local/lib/mule/site-lisp -# TMDIR18 = $(HOME)/lib/emacs18/lisp -# TMDIR19 = $(HOME)/lib/emacs19/lisp +TMDIR18 = $(HOME)/lib/emacs18/lisp +TMDIR19 = $(HOME)/lib/emacs19/lisp # Please specify GNUS type (`gnus3' or `gnus4') if you use Emacs 18.* EMACS18_GNUS = gnus3 @@ -53,7 +53,7 @@ FILES = tm/README.eng tm/rel-*.ol \ tl/Makefile tl/Makefile.bc tl/loadpath \ tl/*.el tl/doc/*.texi -TARFILE = tm6.22.3.tar +TARFILE = tm6.50.tar lpath-nemacs: @@ -61,8 +61,8 @@ lpath-nemacs: nemacs: lpath-nemacs make -f Makefile.bc all EMACS=$(NEMACS) EMACS_TYPE=nemacs - cd gnus; PWD=`pwd` \ - make nemacs NEMACS=$(NEMACS) EMACS18_GNUS=$(EMACS18_GNUS) +# cd gnus; PWD=`pwd` \ +# make nemacs NEMACS=$(NEMACS) EMACS18_GNUS=$(EMACS18_GNUS) cd mh-e; PWD=`pwd` \ make nemacs NEMACS=$(NEMACS) NEMACS_MH_E=$(NEMACS_MH_E) @@ -78,8 +78,8 @@ lpath-mule1: mule1: lpath-mule1 make -f Makefile.bc all EMACS=$(MULE1) EMACS_TYPE=mule - cd gnus; PWD=`pwd` \ - make mule1 MULE1=$(MULE1) EMACS18_GNUS=$(EMACS18_GNUS) +# cd gnus; PWD=`pwd` \ +# make mule1 MULE1=$(MULE1) EMACS18_GNUS=$(EMACS18_GNUS) cd mh-e; PWD=`pwd` \ make mule1 MULE1=$(MULE1) NEMACS_MH_E=$(MULE1_MH_E) @@ -90,7 +90,7 @@ install-mule1: mule1 install-mua-18 make -f Makefile.bc install TMDIR=$(TMDIR18) EMACS_TYPE=mule install-mua-18: - cd gnus; PWD=`pwd` make install-18 TMDIR18=$(TMDIR18) +# cd gnus; PWD=`pwd` make install-18 TMDIR18=$(TMDIR18) cd mh-e; PWD=`pwd` make install-18 TMDIR18=$(TMDIR18) make -f Makefile.bc install-tm-vm TMDIR=$(TMDIR18) @@ -100,7 +100,7 @@ lpath-orig19: orig19: lpath-orig19 make -f Makefile.bc all EMACS=$(ORIG19) EMACS_TYPE=orig - cd gnus; PWD=`pwd` make orig19 ORIG19=$(ORIG19) +# cd gnus; PWD=`pwd` make orig19 ORIG19=$(ORIG19) cd mh-e; PWD=`pwd` make orig19 ORIG19=$(ORIG19) orig19-vm: lpath-nemacs @@ -115,7 +115,7 @@ lpath-mule2: mule2: lpath-mule2 make -f Makefile.bc all EMACS=$(MULE2) EMACS_TYPE=mule - cd gnus; PWD=`pwd` make mule2 MULE2=$(MULE2) +# cd gnus; PWD=`pwd` make mule2 MULE2=$(MULE2) cd mh-e; PWD=`pwd` make mule2 MULE2=$(MULE2) mule2-vm: lpath-nemacs @@ -125,7 +125,7 @@ install-mule2: mule2 install-mua-19 make -f Makefile.bc install TMDIR=$(TMDIR19) EMACS_TYPE=mule install-mua-19: - cd gnus; PWD=`pwd` make install-19 TMDIR19=$(TMDIR19) +# cd gnus; PWD=`pwd` make install-19 TMDIR19=$(TMDIR19) cd mh-e; PWD=`pwd` make install-19 TMDIR19=$(TMDIR19) make -f Makefile.bc install-tm-vm TMDIR=$(TMDIR19) diff --git a/Makefile.bc b/Makefile.bc index 89d8113..269f3a6 100644 --- a/Makefile.bc +++ b/Makefile.bc @@ -1,12 +1,12 @@ # -# $Id: Makefile.bc,v 6.4 1995/05/18 16:46:28 morioka Exp $ +# $Id: Makefile.bc,v 6.4 1995/05/18 16:46:28 morioka Exp morioka $ # TM_EL = signature.el \ tiny-mime.el tm-misc.el tm-$(EMACS_TYPE).el \ tm-view.el tm-rich.el tm-ftp.el tm-latex.el tm-partial.el \ tm-rmail.el \ - tm-comp.el + tm-comp.el # tm-evs.el TM_ELC = ${TM_EL:el=elc} ALL_EL = $(TM_EL) tm-setup.el mime-setup.el diff --git a/base64.el b/base64.el new file mode 100644 index 0000000..52a1765 --- /dev/null +++ b/base64.el @@ -0,0 +1,105 @@ +;;; +;;; $Id$ +;;; + +(require 'tl-seq) + +;;; @ internal base64 decoder/encoder +;;; based on base64 decoder by Enami Tsugutomo + +;;; @@ convert from/to base64 char +;;; + +(defun base64-num-to-char (n) + (cond ((eq n nil) ?=) + ((< n 26) (+ ?A n)) + ((< n 52) (+ ?a (- n 26))) + ((< n 62) (+ ?0 (- n 52))) + ((= n 62) ?+) + ((= n 63) ?/) + (t (error "not a base64 integer %d" n)))) + +(defun base64-char-to-num (c) + (cond ((and (<= ?A c) (<= c ?Z)) (- c ?A)) + ((and (<= ?a c) (<= c ?z)) (+ (- c ?a) 26)) + ((and (<= ?0 c) (<= c ?9)) (+ (- c ?0) 52)) + ((= c ?+) 62) + ((= c ?/) 63) + ((= c ?=) nil) + (t (error "not a base64 character %c" c)))) + + +;;; @@ 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-string (string) + (let* ((es (mapconcat + (function + (lambda (pack) + (mapconcat (function char-to-string) + (apply (function base64-encode-chars) pack) + "") + )) + (pack-sequence string 3) + "")) + (m (mod (length es) 4)) + ) + (concat es (cond ((= m 3) "=") + ((= m 2) "==") + )) + )) + +(defun base64-decode-string (string) + (mapconcat (function + (lambda (pack) + (mapconcat (function char-to-string) + (apply (function base64-decode-chars) pack) + "") + )) + (pack-sequence string 4) + "")) + + +;;; @ etc +;;; + +(defun base64-encoded-length (string) + (let ((len (length string))) + (* (+ (/ len 3) + (if (= (mod len 3) 0) 0 1) + ) 4) + )) + +(provide 'base64) diff --git a/gnus/Makefile b/gnus/Makefile index eb28c64..b28bc05 100644 --- a/gnus/Makefile +++ b/gnus/Makefile @@ -34,6 +34,12 @@ EMACS18_NNTP4 = /usr/local/lib/emacs/local.lisp/gnus-4.1/lisp/nntp EMACS19_GNUS = gnus EMACS19_NNTP = nntp + +FILES = tm/gnus/*.el + +TARFILE = tm-gnus6.3.tar + + nemacs: nemacs-$(EMACS18_GNUS) nemacs-gnus3: @@ -80,3 +86,7 @@ install-19: clean: -rm *.elc + + +tar: + cd ../..; tar cvf $(TARFILE) $(FILES); gzip -9 $(TARFILE) diff --git a/gnus/tm-dgnus.el b/gnus/tm-dgnus.el new file mode 100644 index 0000000..5f1e3fd --- /dev/null +++ b/gnus/tm-dgnus.el @@ -0,0 +1,85 @@ +;;; +;;; tm-dgnus.el --- tm-gnus module for (ding) GNUS +;;; + +;;; @ version +;;; +(defconst tm-gnus/RCS-ID + "$Id: tm-dgnus.el,v 6.3 1995/05/31 04:34:43 morioka Exp $") + +(defconst tm-gnus/version + (concat (get-version-string tm-gnus/RCS-ID) " (ding)")) + + +;;; @ autoload +;;; + +(autoload 'mime/viewer-mode "tm-view" "View MIME message." t) +(autoload 'mime/decode-message-header + "tiny-mime" "Decode MIME encoded-word." t) +(autoload 'mime/decode-string "tiny-mime" "Decode MIME encoded-word." t) + + +;;; @ command functions +;;; + +(defun tm-gnus/view-message (arg) + "MIME decode and play this message." + (interactive "P") + (let ((gnus-break-pages nil)) + (gnus-summary-select-article t t) + ) + (pop-to-buffer gnus-article-buffer t) + (mime/viewer-mode) + ) + +(defun tm-gnus/summary-scroll-down () + "Scroll down one line current article." + (interactive) + (gnus-summary-scroll-up -1) + ) + +(define-key gnus-summary-mode-map "v" (function tm-gnus/view-message)) +(define-key gnus-summary-mode-map + "\e\r" (function tm-gnus/summary-scroll-down)) + + +;;; @ summary filter +;;; + +(defun tm-gnus/decode-summary-from-and-subjects () + (mapcar (function + (lambda (header) + (header-set-from + header + (mime/decode-string (or (header-from header) "")) + ) + (header-set-subject + header + (mime/decode-string (or (header-subject header) "")) + ) + )) + gnus-newsgroup-headers) + ) + +(add-hook 'gnus-select-group-hook + (function tm-gnus/decode-summary-from-and-subjects)) + + +;;; @ article filter +;;; + +(setq gnus-show-mime-method + (function + (lambda () + (let (buffer-read-only) + (mime/decode-message-header) + )))) + +(setq gnus-show-mime t) + + +;;; @ end +;;; + +(provide 'tm-dgnus) diff --git a/gnus/tm-gnus.el b/gnus/tm-gnus.el index 7caa3ac..08f5762 100644 --- a/gnus/tm-gnus.el +++ b/gnus/tm-gnus.el @@ -3,95 +3,28 @@ ;;; ;;; by Morioka Tomohiko, 1993/11/20 ;;; - -(provide 'tm-gnus) - - -;;; @ require modules -;;; -(require 'tm-misc) -(require 'tl-str) -(require 'gnus) - - -;;; @ version +;;; $Id: tm-gnus.el,v 6.1 1995/05/31 04:38:12 morioka Exp $ ;;; -(defconst tm-gnus/RCS-ID - "$Id: tm-gnus.el,v 5.2 1995/01/27 15:55:18 morioka Exp $") - -(defconst tm-gnus/version (get-version-string tm-gnus/RCS-ID)) +(require 'gnus) ;;; @ variables ;;; (defvar tm-gnus/startup-hook nil) -;;; @ to decode subjects in mode-line -;;; -;; This function imported from gnus.el. -;; -;; New implementation in gnus 3.14.3 -;; -(defun tm-gnus/article-set-mode-line () - "Set Article mode line string. -If you don't like it, define your own gnus-article-set-mode-line." - (let ((maxlen 15) ;Maximum subject length - (subject - (if gnus-current-headers - (mime/decode-string (nntp-header-subject gnus-current-headers)) - "") - )) - ;; The value must be a string to escape %-constructs because of subject. - (setq mode-line-buffer-identification - (format "GNUS: %s%s %s%s%s" - gnus-newsgroup-name - (if gnus-current-article - (format "/%d" gnus-current-article) "") - (rightful-boundary-short-string subject - (min (string-width subject) - maxlen)) - (if (> (string-width subject) maxlen) "..." "") - (make-string (max 0 (- 17 (string-width subject))) ? ) - ))) - (set-buffer-modified-p t)) - - -;;; @ to decode subjects in Summary buffer -;;; -(defun tm-gnus/decode-summary-subjects () - (mapcar (function - (lambda (header) - (let ((subj (or (gnus-header-subject header) ""))) - (nntp-set-header-subject header (mime/decode-string subj)) - ))) - gnus-newsgroup-headers) - ) - - -;;; @ change MIME header decoding mode, decoding or non decoding. -;;; - -(defun tm-gnus/set-mime-header-decoding-mode (arg) - "Set MIME header processing. -With arg, turn MIME processing on iff arg is positive." - (setq mime/header-decoding-mode arg) - (setq gnus-have-all-headers (not gnus-have-all-headers)) - (gnus-summary-select-article (not gnus-have-all-headers) t) - ) - -(defun tm-gnus/toggle-mime-header-decoding-mode () - "Toggle MIME header processing. -With arg, turn MIME processing on iff arg is positive." - (interactive) - (tm-gnus/set-mime-header-decoding-mode (not mime/header-decoding-mode)) - ) - ;;; @ set up ;;; -(if (string-match "^GNUS [0-3]" gnus-version) - (require 'tm-gnus3) - (require 'tm-gnus4) - ) - +(cond ((string-match "^GNUS [0-3]" gnus-version) + (require 'tm-gnus3) + ) + ((string-match "^GNUS 4" gnus-version) + (require 'tm-gnus4) + ) + ((string-match "(ding)" gnus-version) + (require 'tm-dgnus) + )) + (run-hooks 'tm-gnus/startup-hook) + +(provide 'tm-gnus) diff --git a/gnus/tm-gnus3.el b/gnus/tm-gnus3.el index d820b41..ac33a2d 100644 --- a/gnus/tm-gnus3.el +++ b/gnus/tm-gnus3.el @@ -1,11 +1,10 @@ ;;; -;;; $Id: tm-gnus3.el,v 6.0 1995/03/11 22:51:37 morioka Exp $ +;;; $Id: tm-gnus3.el,v 6.0 1995/03/11 22:51:37 morioka Exp morioka $ ;;; -(provide 'tm-gnus3) - (require 'tm-view) (require 'tl-list) +(require 'tm-ognus) (set-alist 'mime-viewer/quitting-method-alist 'gnus-Article-mode @@ -58,3 +57,5 @@ (add-hook 'gnus-Article-mode-hook (function mime/add-header-decoding-mode-to-mode-line)) )) + +(provide 'tm-gnus3) diff --git a/gnus/tm-gnus4.el b/gnus/tm-gnus4.el index 76f61fb..50cca72 100644 --- a/gnus/tm-gnus4.el +++ b/gnus/tm-gnus4.el @@ -1,8 +1,8 @@ ;;; -;;; $Id: tm-gnus4.el,v 5.5 1995/01/13 20:48:16 morioka Exp $ +;;; $Id: tm-gnus4.el,v 5.5 1995/01/13 20:48:16 morioka Exp morioka $ ;;; -(provide 'tm-gnus4) +(require 'tm-ognus) (autoload 'mime/viewer-mode "tm-view" "View MIME message." t) @@ -36,3 +36,5 @@ (add-hook 'gnus-article-prepare-hook (function mime/decode-message-header-if-you-need) t) + +(provide 'tm-gnus4) diff --git a/gnus/tm-ognus.el b/gnus/tm-ognus.el new file mode 100644 index 0000000..46fdfa7 --- /dev/null +++ b/gnus/tm-ognus.el @@ -0,0 +1,82 @@ +;;; +;;; tm-ognus.el --- tm-gnus module for Original GNUS +;;; + +;;; @ require modules +;;; +(require 'tm-misc) +(require 'tl-str) +(require 'gnus) + + +;;; @ version +;;; +(defconst tm-gnus/RCS-ID + "$Id: tm-ognus.el,v 6.0 1995/05/23 13:23:31 morioka Exp $") + +(defconst tm-gnus/version + (concat (get-version-string tm-gnus/RCS-ID) " (for ORIGINAL GNUS)")) + + +;;; @ change MIME header decoding mode, decoding or non decoding. +;;; + +(defun tm-gnus/set-mime-header-decoding-mode (arg) + "Set MIME header processing. +With arg, turn MIME processing on iff arg is positive." + (setq mime/header-decoding-mode arg) + (setq gnus-have-all-headers (not gnus-have-all-headers)) + (gnus-summary-select-article (not gnus-have-all-headers) t) + ) + +(defun tm-gnus/toggle-mime-header-decoding-mode () + "Toggle MIME header processing. +With arg, turn MIME processing on iff arg is positive." + (interactive) + (tm-gnus/set-mime-header-decoding-mode (not mime/header-decoding-mode)) + ) + + +;;; @ to decode subjects in mode-line +;;; +;; This function imported from gnus.el. +;; +;; New implementation in gnus 3.14.3 +;; +(defun tm-gnus/article-set-mode-line () + "Set Article mode line string. +If you don't like it, define your own gnus-article-set-mode-line." + (let ((maxlen 15) ;Maximum subject length + (subject + (if gnus-current-headers + (mime/decode-string (nntp-header-subject gnus-current-headers)) + "") + )) + ;; The value must be a string to escape %-constructs because of subject. + (setq mode-line-buffer-identification + (format "GNUS: %s%s %s%s%s" + gnus-newsgroup-name + (if gnus-current-article + (format "/%d" gnus-current-article) "") + (rightful-boundary-short-string subject + (min (string-width subject) + maxlen)) + (if (> (string-width subject) maxlen) "..." "") + (make-string (max 0 (- 17 (string-width subject))) ? ) + ))) + (set-buffer-modified-p t)) + + +;;; @ to decode subjects in Summary buffer +;;; +(defun tm-gnus/decode-summary-subjects () + (mapcar (function + (lambda (header) + (let ((subj (or (gnus-header-subject header) ""))) + (nntp-set-header-subject header (mime/decode-string subj)) + ))) + gnus-newsgroup-headers) + ) + + +(provide 'tm-ognus) diff --git a/inst-el b/inst-el index 3a06c00..be0d038 100755 --- a/inst-el +++ b/inst-el @@ -1,16 +1,16 @@ #!/bin/csh -f set MKDIR=mkdirhier # for X -#set MKDIR=mkdir -p # for SunOS 4.* or Solaris 2.* +#set MKDIR="mkdir -p" # for SunOS 4.* or Solaris 2.* #set MKDIR=mkdir set dir = $1 set files = ($argv[2-]) if ( -d $dir ) then - echo $dir is already exists. + echo $dir has already existed. else - echo $dir is not exists, so I make it. + echo $dir does not exist, so I make it. $MKDIR $dir endif diff --git a/inst-elc b/inst-elc index 3304d60..ba36e01 100755 --- a/inst-elc +++ b/inst-elc @@ -1,19 +1,19 @@ #!/bin/csh -f set MKDIR=mkdirhier # for X -#set MKDIR=mkdir -p # for SunOS 4.* or Solaris 2.* +#set MKDIR="mkdir -p" # for SunOS 4.* or Solaris 2.* #set MKDIR=mkdir set dir = $1 set files = ($argv[2-]) if ( -d $dir ) then - echo $dir is already exists. + echo $dir has already existed. else - echo $dir is not exists, so I make it. + echo $dir does not exist, so I make it. $MKDIR $dir endif -(mv -f $files $dir) +mv -f $files $dir exit 0 diff --git a/mh-e/Makefile b/mh-e/Makefile index 4f589d7..e673615 100644 --- a/mh-e/Makefile +++ b/mh-e/Makefile @@ -18,8 +18,16 @@ MULE2 = mule2 # TMDIR18 = for Emacs 18.* (NEMACS, NEpoch or MULE 1) # TMDIR19 = for Emacs 19.* (FSF original, XEmacs or MULE 2) -TMDIR18 = /usr/local/lib/emacs/local.lisp/tm -TMDIR19 = /usr/local/lib/mule/site-lisp +# TMDIR18 = /usr/local/lib/emacs/local.lisp/tm +# TMDIR19 = /usr/local/lib/mule/site-lisp + +TMDIR18 = $(HOME)/lib/emacs18/lisp +TMDIR19 = $(HOME)/lib/emacs19/lisp + + +FILES = tm/mh-e/*.el tm/mh-e/Makefile* +TARFILE = tm-mh-e6.5.tar + nemacs: make -f Makefile.bc tm-mh-e.elc EMACS=$(NEMACS) @@ -45,3 +53,7 @@ install-19: clean: -rm *.elc + + +tar: + cd ../..; tar cvf $(TARFILE) $(FILES); gzip -9 $(TARFILE) diff --git a/mh-e/tm-mh-e.el b/mh-e/tm-mh-e.el index 48d700f..2d38dcd 100644 --- a/mh-e/tm-mh-e.el +++ b/mh-e/tm-mh-e.el @@ -15,49 +15,172 @@ (if (not (boundp 'mh-e-version)) (require 'tm-mh-e3) ) -(autoload 'mime/viewer-mode "tm-view" "View MIME message." t) +(require 'tm-view) ;;; @ version ;;; (defconst tm-mh-e/RCS-ID - "$Id: tm-mh-e.el,v 6.3 1995/04/23 20:59:27 morioka Exp $") + "$Id: tm-mh-e.el,v 6.10 1995/06/12 01:53:19 morioka Exp $") (defconst tm-mh-e/version (get-version-string tm-mh-e/RCS-ID)) -;;; @ MIME header decoding mode +;;; @ variable ;;; -(defun tm-mh-e/toggle-header-decoding-mode (arg) - "Toggle MIME header processing. +(defvar tm-mh-e/decode-all t + "*If t, decode all of the message. Otherwise decode header only.") + + +;;; @ functions +;;; + +(defun tm-mh-e/display-msg (msg-num folder &optional show-buffer mode) + (or mode + (setq mode tm-mh-e/decode-all) + ) + ;; Display message NUMBER of FOLDER. + ;; Sets the current buffer to the show buffer. + (set-buffer folder) + (or show-buffer + (setq show-buffer mh-show-buffer)) + ;; Bind variables in folder buffer in case they are local + (let ((msg-filename (mh-msg-filename msg-num))) + (if (not (file-exists-p msg-filename)) + (error "Message %d does not exist" msg-num)) + (set-buffer show-buffer) + (cond ((not (equal msg-filename buffer-file-name)) + ;; Buffer does not yet contain message. + (clear-visited-file-modtime) + (unlock-buffer) + (setq buffer-file-name nil) ; no locking during setup + (let (buffer-read-only) + (erase-buffer) + (if mode + (progn + (let ((file-coding-system-for-read + (if (boundp 'MULE) *noconv*)) + kanji-fileio-code) + (insert-file-contents msg-filename) + ) + (set-buffer-modified-p nil) + (mh-show-mode) + (mime/viewer-mode) + (goto-char (point-min)) + ) + (let ((clean-message-header mh-clean-message-header) + (invisible-headers mh-invisible-headers) + (visible-headers mh-visible-headers) + ) + (insert-file-contents msg-filename) + (goto-char (point-min)) + (cond (clean-message-header + (mh-clean-msg-header (point-min) + invisible-headers + visible-headers) + (goto-char (point-min))) + (t + (mh-start-of-uncleaned-message))) + (mime/decode-message-header) + (set-buffer-modified-p nil) + (mh-show-mode) + ))) + (or (eq buffer-undo-list t) ;don't save undo info for prev msgs + (setq buffer-undo-list nil)) + (setq buffer-file-name msg-filename) + (set-mark nil) + (setq mode-line-buffer-identification + (list (format mh-show-buffer-mode-line-buffer-id + folder msg-num))) + (set-buffer folder) + (setq mh-showing-with-headers nil))))) + +(fset 'mh-display-msg (symbol-function 'tm-mh-e/display-msg)) + +(defun tm-mh-e/view-message (&optional msg) + "MIME decode and play this message." + (interactive) + (mh-invalidate-show-buffer) + (let ((tm-mh-e/decode-all t)) + (mh-show-msg msg) + ) + (pop-to-buffer (save-window-excursion + (switch-to-buffer mh-show-buffer) + mime::article/preview-buffer)) + ) + +(defun tm-mh-e/toggle-decoding-mode (arg) + "Toggle MIME processing mode. With arg, turn MIME processing on if arg is positive." (interactive "P") - (setq mime/header-decoding-mode + (setq tm-mh-e/decode-all (if (null arg) - (not mime/header-decoding-mode) + (not tm-mh-e/decode-all) arg)) - (mh-invalidate-show-buffer) - (mh-show-msg (mh-get-msg-num t)) - ) + (mh-show (mh-get-msg-num t)) + (if tm-mh-e/decode-all + (let ((the-buf (current-buffer))) + (pop-to-buffer (save-excursion + (switch-to-buffer mh-show-buffer) + mime::article/preview-buffer)) + (pop-to-buffer the-buf) + ))) + +(defun tm-mh-e/cite () + (interactive) + (if tm-mh-e/decode-all + (save-excursion + (save-restriction + (insert-buffer + (save-window-excursion + (switch-to-buffer (concat "show-" mh-sent-from-folder)) + mime::article/preview-buffer)) + (if (looking-at "^\\[.+\\]\n") + (replace-match "")) + (run-hooks 'mail-citation-hook) + )) + (mh-yank-cur-msg) + )) -;;; @ MIME body players +;;; @ for tm-view ;;; -(defun tm-mh-e/view-message (arg) - "MIME decode and play this message." - (interactive "P") - (mh-invalidate-show-buffer) - (mh-show-msg (mh-get-msg-num t)) - (pop-to-buffer mh-show-buffer t) - ;; patch for mh-narrow.el - ;; by YAMAOKA Katsumi - (if (featurep 'mh-narrow) - (widen) - ) - ;; end of patch - (mime/viewer-mode) + +(defun tm-mh-e/content-header-filter () + (goto-char (point-min)) + (while (and (re-search-forward + (concat "^" mime-viewer/ignored-field-regexp ":") + nil t) + (progn + (delete-region + (match-beginning 0) + (save-excursion + (and + (re-search-forward "^\\([^ \t]\\|$\\)" nil t) + (match-beginning 0) + ))) + t))) + (mime/code-convert-region-to-emacs (point-min)(point-max) + mime/default-coding-system) + (mime/decode-message-header) ) +(defun tm-mh-e/quitting-method () + (let ((win (get-buffer-window + mime/output-buffer-name)) + (buf mime::preview/article-buffer) + ) + (if win + (delete-window win) + ) + (pop-to-buffer + (let ((name (buffer-name buf))) + (substring name 5) + )) + (if (not tm-mh-e/decode-all) + (mh-show (mh-get-msg-num t)) + ))) + ;;; @ for tm-comp ;;; @@ -121,18 +244,10 @@ With arg, turn MIME processing on if arg is positive." ;;; @ set up ;;; -(defun tm-mh-e/decode-message-header () - (make-local-variable 'minor-mode-alist) - (mime/add-header-decoding-mode-to-mode-line) - (let ((buffer-read-only nil)) - (mime/decode-message-header-if-you-need) - (set-buffer-modified-p nil) - )) -(add-hook 'mh-show-mode-hook - (function tm-mh-e/decode-message-header)) +;;(add-hook 'mh-show-mode-hook (function mime/viewer-mode)) -(define-key mh-folder-mode-map "\et" 'tm-mh-e/toggle-header-decoding-mode) -(define-key mh-folder-mode-map "v" 'tm-mh-e/view-message) +(define-key mh-folder-mode-map "v" (function tm-mh-e/view-message)) +(define-key mh-folder-mode-map "\et" (function tm-mh-e/toggle-decoding-mode)) (define-key mh-folder-mode-map "\r" (function (lambda () (interactive) @@ -143,6 +258,33 @@ With arg, turn MIME processing on if arg is positive." (interactive) (scroll-other-window -1) ))) +(define-key mh-folder-mode-map " " + (function (lambda () + (interactive) + (scroll-other-window) + ))) +(define-key mh-folder-mode-map "\177" + (function (lambda () + (interactive) + (scroll-other-window (- (save-window-excursion + (other-window 1) + (window-height)))) + ))) + +(add-hook 'mh-letter-mode-hook + (function + (lambda () + (define-key mh-letter-mode-map "\C-c\C-y" (function tm-mh-e/cite)) + ))) + +(set-alist 'mime-viewer/quitting-method-alist + 'mh-show-mode + (function tm-mh-e/quitting-method)) + +(set-alist 'mime-viewer/content-header-filter-alist + 'mh-show-mode + (function tm-mh-e/content-header-filter)) +(run-hooks 'tm-mh-e-load-hook) (provide 'tm-mh-e) diff --git a/mh-e/tm-mh-e3.el b/mh-e/tm-mh-e3.el index a5b3d6d..4aaa8f0 100644 --- a/mh-e/tm-mh-e3.el +++ b/mh-e/tm-mh-e3.el @@ -1,5 +1,5 @@ ;;; -;;; $Id: tm-mh-e3.el,v 1.2 1994/11/01 18:06:16 morioka Exp $ +;;; $Id: tm-mh-e3.el,v 3.0 1995/06/11 13:25:56 morioka Exp $ ;;; ;;; This is a part of tm-mh-e.el which is a module for old mh-e ;;; to emulate mh-e 4.0. @@ -7,7 +7,7 @@ ;;; This module imports from mh-e 3.8 and 4.0. ;;; -(provide 'tm-mh-e3) +(require 'mh-e) ;;; Ensure new buffers won't get this mode if default-major-mode is nil. (put 'mh-show-mode 'mode-class 'special) @@ -20,54 +20,6 @@ The value of mh-show-mode-hook is called when a new message is displayed." (mh-set-mode-name "MH-Show") (run-hooks 'mh-show-mode-hook)) -(defun mh-display-msg (msg-num folder &optional show-buffer) - ;; Display message NUMBER of FOLDER. - ;; Sets the current buffer to the show buffer. - (set-buffer folder) - (or show-buffer - (setq show-buffer mh-show-buffer)) - ;; Bind variables in folder buffer in case they are local - (let ((formfile mhl-formfile) - (clean-message-header mh-clean-message-header) - (invisible-headers mh-invisible-headers) - (visible-headers mh-visible-headers) - (msg-filename (mh-msg-filename msg-num)) - (folder mh-current-folder)) - (if (not (file-exists-p msg-filename)) - (error "Message %d does not exist" msg-num)) - (switch-to-buffer show-buffer) - (if mh-bury-show-buffer (bury-buffer (current-buffer))) - (mh-when (or (not (equal msg-filename buffer-file-name))) - ;; Buffer does not yet contain message. - (clear-visited-file-modtime) - (unlock-buffer) - (setq buffer-file-name nil) ; no locking during setup - (erase-buffer) - (if formfile - (if (stringp formfile) - (mh-exec-lib-cmd-output "mhl" "-nobell" "-noclear" - "-form" formfile msg-filename) - (mh-exec-lib-cmd-output "mhl" "-nobell" "-noclear" - msg-filename)) - (insert-file-contents msg-filename)) - (goto-char (point-min)) - (cond (clean-message-header - (mh-clean-msg-header (point-min) - invisible-headers - visible-headers) - (goto-char (point-min))) - (t - (let ((case-fold-search t)) - (re-search-forward - "^To:\\|^From:\\|^Subject:\\|^Date:" nil t) - (beginning-of-line) - (mh-recenter 0)))) - (set-buffer-modified-p nil) - (setq buffer-file-name msg-filename) - (set-mark nil) - (mh-show-mode) - (setq mode-line-buffer-identification - (list (format mh-show-buffer-mode-line-buffer-id - folder msg-num)))))) +(fset 'mh-show-msg (symbol-function 'mh-show)) -(fset 'mh-show-msg 'mh-show) +(provide 'tm-mh-e3) diff --git a/mime-setup.el b/mime-setup.el index 86fc4da..a1d8148 100644 --- a/mime-setup.el +++ b/mime-setup.el @@ -1,5 +1,5 @@ ;;; -;;; $Id: mime-setup.el,v 5.1 1994/11/29 16:10:15 morioka Exp $ +;;; $Id: mime-setup.el,v 6.0 1995/05/30 12:49:34 morioka Exp $ ;;; (provide 'mime-setup) @@ -82,6 +82,10 @@ ("x-latex" ("x-name") ;;("charset" "" "ISO-2022-JP" "US-ASCII" "ISO-8859-1" "ISO-8859-8") + ) + ("html" + ("x-name") + ;;("charset" "" "ISO-2022-JP" "US-ASCII" "ISO-8859-1" "ISO-8859-8") )) ("message" ("external-body" @@ -131,6 +135,7 @@ (setq mime-file-types '(("\\.rtf$" "text" "richtext" nil nil) + ("\\.html$" "text" "html" nil nil) ("\\.ps$" "application" "postscript" nil "quoted-printable") ("\\.gif$" "image" "gif" nil "base64") ("\\.jpg$" "image" "jpeg" nil "base64") diff --git a/qprint.el b/qprint.el new file mode 100644 index 0000000..c43486c --- /dev/null +++ b/qprint.el @@ -0,0 +1,139 @@ +;;; +;;; $Id$ +;;; + +(require 'tl-num) + +;;; @ Quoted-Printable (Q-encode) encoder/decoder +;;; + +(defun quoted-printable-quote-char (chr) + (concat "=" + (char-to-string (number-to-hex-char (ash chr -4))) + (char-to-string (number-to-hex-char (logand chr 15))) + )) + +(defun quoted-printable-encode-string-for-body (str) + (mapconcat (function + (lambda (chr) + (cond ((or (< chr 32) (< 126 chr) (eq chr ?=)) + (quoted-printable-quote-char chr) + ) + (t (char-to-string chr)) + ))) + str "")) + +(defun quoted-printable-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 quoted-printable-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 quoted-printable-encode-string-for-phrase (str) + (mapconcat (function + (lambda (chr) + (cond ((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 quoted-printable-encode-string (str &optional mode) + (cond ((eq mode 'text) + (quoted-printable-encode-string-for-text str) + ) + ((eq mode 'comment) + (quoted-printable-encode-string-for-comment str) + ) + ((eq mode 'phrase) + (quoted-printable-encode-string-for-phrase str) + ) + (t (quoted-printable-encode-string-for-body str)) + )) + +(defun quoted-printable-decode-string-for-body (str) + (let (q h l) + (mapconcat (function + (lambda (chr) + (cond ((eq chr ?=) + (setq q t) + "") + (q (setq h (hex-char-to-number chr)) + (setq q nil) + "") + (h (setq l (hex-char-to-number chr)) + (prog1 + (char-to-string (logior (ash h 4) l)) + (setq h nil) + ) + ) + (t (char-to-string chr)) + ))) + str ""))) + +(defun quoted-printable-decode-string-for-header (str) + (let (q h l) + (mapconcat (function + (lambda (chr) + (cond ((eq chr ?_) " ") + ((eq chr ?=) + (setq q t) + "") + (q (setq h (hex-char-to-number chr)) + (setq q nil) + "") + (h (setq l (hex-char-to-number chr)) + (prog1 + (char-to-string (logior (ash h 4) l)) + (setq h nil) + ) + ) + (t (char-to-string chr)) + ))) + str ""))) + +(defun quoted-printable-decode-string (str &optional mode) + (if (eq mode 'header) + (quoted-printable-decode-string-for-header str) + (quoted-printable-decode-string-for-body str) + )) + + +;;; @ etc +;;; + +(defun quoted-printable-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)) + (setq l (+ l 1)) + (setq l (+ l 3)) + ) + (setq i (+ i 1)) ) + l)) + +(provide 'qprint) diff --git a/rel-7jp.ol b/rel-7jp.ol new file mode 100644 index 0000000..e0a2033 --- /dev/null +++ b/rel-7jp.ol @@ -0,0 +1,67 @@ +* tm-view + + tm-view の preview buffer に対する表示を設定するための機構が変更され +た。また、charset による code 変換を考慮して major-mode 毎に filter を +切替えれるようにした。 + +** content subject + +*** 変数 mime-viewer/content-subject-omitting-Content-Type-list + + この変数 (list) に設定された content-type の content subject は表示 +されない。 + +*** 関数 mime-viewer/default-content-subject-function + + 引数が変更されているので注意。 + +*** 変数 mime-viewer/content-subject-function + + この変数に、関数 mime-viewer/default-content-subject-function 以外の +関数を設定した場合、変数 +mime-viewer/content-subject-omitting-Content-Type-list の有効性は保証 +されないので注意すること。 + + +** content header + + 関数 mime-viewer/header-visible-p が t になる content の content +header が表示される。この条件を変えたい場合は、この関数を再定義するこ +と。標準では、変数 +mime-viewer/childrens-header-showing-Content-Type-list を参照するが再 +定義した場合、この変数の有効性は保証されないので注意すること。 + + content header が表示される場合、content-header-filter によって整形 +される。呼ばれる content-header-filter は article buffer の major-mode +を key として変数 mime-viewer/content-header-filter-alist から探される。 +もし、この変数に登録されていなかった場合、関数 +mime-viewer/default-content-header-filter が呼ばれる。 + + +** content body + + ある content の body を表示するかどうかは、関数 +mime-viewer/body-visible-p が t になるかどうかで決まる。標準では、変数 +mime-viewer/default-showing-Content-Type-list に存在している content +type の content が表示される。 + + body が表示される時、content-filter によって整形される。呼ばれる +content-filter は article buffer の major-mode を key として変数 +mime-viewer/content-filter-alist から探される。もし、この変数に登録さ +れていなかった場合、関数 mime-viewer/default-content-filter が呼ばれる。 + + 従来、content filter は header も整形していたが、body のみの整形に改 +められたので注意すること。 + + +** content separator + + content の最後に content separator というものを表示できるようにした。 +これは、関数 mime-viewer/default-content-separator によって表示される。 +標準では、header も body も表示されない場合のみ、改行を入れることにし +ている。変更したい場合は、この関数を再定義すること。 + + +* tm-mh-e + + charset による code 変換を行なうようにした。 diff --git a/tiny-mime.el b/tiny-mime.el index d017434..0f87421 100644 --- a/tiny-mime.el +++ b/tiny-mime.el @@ -6,13 +6,11 @@ ;;; mime.el,v 1.5 1992/07/18 07:52:08 by Enami Tsugutomo ;;; -(provide 'tiny-mime) - - ;;; @ require modules ;;; (require 'tl-header) (require 'tl-str) +(require 'tl-num) (if (not (fboundp 'member)) (require 'tl-18) ) @@ -21,7 +19,7 @@ ;;; @ version ;;; (defconst mime/RCS-ID - "$Id: tiny-mime.el,v 5.11 1995/04/18 12:28:22 morioka Exp $") + "$Id: tiny-mime.el,v 5.12 1995/05/21 16:06:27 morioka Exp $") (defconst mime/tiny-mime-version (get-version-string mime/RCS-ID)) @@ -617,21 +615,6 @@ ) dest)) -;;; @ utility functions -;;; - -;; by mol. 1993/10/4 -(defun hex-char-to-number (chr) - (cond ((and (<= ?0 chr)(<= chr ?9)) (- chr ?0)) - ((and (<= ?A chr)(<= chr ?F)) (+ (- chr ?A) 10)) - ((and (<= ?a chr)(<= chr ?f)) (+ (- chr ?a) 10)) - )) - -(defun number-to-hex-char (n) - (if (< n 10) - (+ ?0 n) - (+ ?A (- n 10)))) - ;;; @ utility for encoder ;;; @@ -843,6 +826,8 @@ (run-hooks 'mime/tiny-mime-load-hook) +(provide 'tiny-mime) + ;;; @ ;;; Local Variables: ;;; mode: emacs-lisp diff --git a/tm-comp.el b/tm-comp.el index 32ff347..a1157cb 100644 --- a/tm-comp.el +++ b/tm-comp.el @@ -22,7 +22,7 @@ ;;; (defconst mime/composer-RCS-ID - "$Id: tm-comp.el,v 6.3 1995/04/18 16:38:42 morioka Exp $") + "$Id: tm-comp.el,v 6.7 1995/06/12 05:33:22 morioka Exp $") (defconst mime/composer-version (get-version-string mime/composer-RCS-ID)) @@ -113,49 +113,58 @@ (defvar mime/window-config-alist '((mail-mode . nil) (mh-letter-mode . mh-previous-window-config) - (news-reply-mode . (prog1 - gnus-winconf-post-news - (setq gnus-winconf-post-news nil) - )) + (news-reply-mode . (cond ((boundp 'gnus-winconf-post-news) + (prog1 + gnus-winconf-post-news + (setq gnus-winconf-post-news nil) + )) + ((boundp 'gnus-prev-winconf) + (prog1 + gnus-prev-winconf + (setq gnus-prev-winconf nil) + )) + )) )) (defvar mime/news-reply-mode-server-running nil) +(defun tm-gnus4/message-before-send () + (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-news-server) + (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-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]+" ",") - )) - )))) - )) + '((mh-letter-mode . mh-before-send-letter-hook) + (news-reply-mode . tm-gnus4/message-before-send) + )) (defvar mime/message-after-send-hook-alist '((mh-letter-mode . '(lambda () @@ -276,8 +285,9 @@ Optional argument ENCODING specifies an encoding method such as base64." (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 ((hook (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 diff --git a/tm-evs.el b/tm-evs.el new file mode 100644 index 0000000..fb96726 --- /dev/null +++ b/tm-evs.el @@ -0,0 +1,172 @@ +;;; +;;; $Id: tm-evs.el,v 2.0 1995/06/10 19:33:26 morioka Exp $ +;;; +;;; a tm-view internal method +;;; for JAIST-Course-Evaluation questionnaire +;;; + +(require 'tm-view) + +(defvar questionnaire-result-alist nil) + +(defun mime-viewer/filter-questionnaire (ctype params &optional encoding) + (goto-char (point-min)) + (while (re-search-forward "^(" nil t) + (replace-match " (") + )) + +(set-alist 'mime-viewer/content-filter-alist + "application/x-selection" + (function mime-viewer/filter-questionnaire)) + +(defun mime-preview/reset-mark (cnum) + (let* ((cinfo (mime::preview-content-info/content-info + (car mime::preview/content-list))) + (ccinfo (mime-article/cnum-to-cinfo cnum cinfo)) + (pcinfo (mime-preview/cinfo-to-pcinfo ccinfo)) + (p (mime::preview-content-info/point-min pcinfo)) + ) + (save-excursion + (let (buffer-read-only) + (goto-char p) + (delete-char 1) + (insert " ") + )))) + +(defun mime-preview/set-mark (cnum) + (let* ((cinfo (mime::preview-content-info/content-info + (car mime::preview/content-list))) + (ccinfo (mime-article/cnum-to-cinfo cnum cinfo)) + (pcinfo (mime-preview/cinfo-to-pcinfo ccinfo)) + (p (mime::preview-content-info/point-min pcinfo)) + ) + (save-excursion + (let (buffer-read-only) + (goto-char p) + (delete-char 1) + (insert "*") + )))) + +(defun mime-viewer/questionnaire-select (beg end cal) + (let* ((cnum (mime::get-point-content-number beg)) + (rcinfo mime::article/content-info) + (mother-cnum (butlast cnum)) + (mother-cinfo (mime-article/cnum-to-cinfo mother-cnum)) + (mother-params (mime::content-info/parameters mother-cinfo)) + (number (assoc-value "x-part-number" mother-params)) + ) + (if number + (setq number (string-to-int number)) + ) + (save-window-excursion + (switch-to-buffer mime::article/preview-buffer) + (let ((pa (assoc number questionnaire-result-alist))) + (if pa + (progn + (setq pa (nth 1 pa)) + (mime-preview/reset-mark (list (car cnum) pa)) + ))) + (mime-preview/set-mark cnum) + ) + (set-alist 'questionnaire-result-alist + number + (list (nth 1 cnum) + (save-restriction + (narrow-to-region + (mime::content-info/point-min mother-cinfo) + (mime::content-info/point-max mother-cinfo)) + (message/get-field-body "Content-Description") + ))) + (let ((nc (append (butlast mother-cnum) + (list (1+ (last-element mother-cnum)) 0))) + (the-buf (current-buffer)) + next-cinfo) + (setq next-cinfo (mime-article/cnum-to-cinfo nc)) + (setq mime-preview/after-decoded-position + (save-window-excursion + (if next-cinfo + (progn + (switch-to-buffer mime::article/preview-buffer) + (mime::preview-content-info/point-min + (mime-preview/cinfo-to-pcinfo next-cinfo)) + ) + (point-max) + ))) + ))) + +(set-atype 'mime/content-decoding-condition + '((type . "application/x-selection") + (method . mime-viewer/questionnaire-select) + )) + +(defvar evs-course-id nil) +(defvar evs-teachers-name nil) +(defvar evs-message-buffer nil) + +(defun jaist-evs-send-message () + (interactive) + (if (not (equal (sort (mapcar (function car) questionnaire-result-alist) + (function <)) + '(1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 + 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38))) + (message "全ての選択肢に答えて下さい") + (mail nil "evs-answer@jaist.ac.jp") + (goto-char (point-max)) + (let ((rest (sort questionnaire-result-alist + (function + (lambda (a b) + (< (car a)(car b)) + )))) + ret) + (insert (format "%s %s \n" evs-course-id evs-teachers-name)) + (while rest + (setq ret (car rest)) + (insert (format "[%d] %s\n %d\n" + (car ret) + (or (nth 2 ret) "") + (or (nth 1 ret) 0) + )) + (setq rest (cdr rest)) + ) + (insert "[39] この授業の良い点、欠けた点を挙げて下さい。\n\n\n") + (insert "[40] この授業の担当教官の教え方の良い点、欠けた点を指摘して下さい。\n\n\n") + (insert "[41] 君はこの授業を受けて、プラスとなったものは何でしょうか?\n") + (if evs-message-buffer + (progn + (switch-to-buffer evs-message-buffer) + (if mime::article/preview-buffer + (kill-buffer mime::article/preview-buffer) + ) + (kill-buffer evs-message-buffer) + )) + ))) + +(define-key mime/viewer-mode-map "\C-c\C-c" (function jaist-evs-send-message)) + +(defun jaist-evs () + (interactive) + (setq questionnaire-result-alist nil) + (setq evs-course-id + (read-string "Please input course id > ")) + (setq evs-teachers-name + (read-string "Please input teacher's name > ")) + (setq evs-message-buffer + (get-buffer "questionnaire.mime")) + (if (null evs-message-buffer) + (progn + (setq evs-message-buffer + (get-buffer-create "questionnaire.mime")) + (switch-to-buffer evs-message-buffer) + ) + (progn + (switch-to-buffer evs-message-buffer) + (erase-buffer) + )) + (insert-file "/usr/local/lecture/EVS/questionnaire.mime") + (goto-char (point-min)) + (re-search-forward "^=+\n") + (insert (format "%s %s\n" evs-course-id evs-teachers-name)) + (mime/viewer-mode) + ) + +(provide 'tm-evs) diff --git a/tm-eword.el b/tm-eword.el new file mode 100644 index 0000000..fcedc33 --- /dev/null +++ b/tm-eword.el @@ -0,0 +1,699 @@ +;;; +;;; A multilingual MIME message header encoder/decoder. +;;; by Morioka Tomohiko (morioka@jaist.ac.jp) +;;; +;;; original MIME decoder is +;;; mime.el,v 1.5 1992/07/18 07:52:08 by Enami Tsugutomo +;;; + +;;; @ require modules +;;; +(require 'tl-misc) +(require 'tl-822) +(require 'tl-num) +(require 'base64) +(require 'qprint) + + +;;; @ version +;;; +(defconst mime/RCS-ID + "$Id: tm-eword.el,v 5.12 1995/05/21 16:06:27 morioka Exp morioka $") + +(defconst mime/tiny-mime-version (get-version-string mime/RCS-ID)) + + +;;; @ MIME encoded-word definition +;;; + +(defconst mime/charset-regexp "[A-Za-z0-9!#$%&'*+---^_`{}|~]") +(defconst mime/encoded-text-regexp "[!->@-~]+") + +(defconst mime/Base64-token-regexp "[A-Za-z0-9+/=]") +(defconst mime/Base64-encoded-text-regexp + (concat "\\(" + mime/Base64-token-regexp + mime/Base64-token-regexp + mime/Base64-token-regexp + mime/Base64-token-regexp + "\\)+")) +(defconst mime/Base64-encoding-and-encoded-text-regexp + (concat "\\(B\\)\\?" mime/Base64-encoded-text-regexp)) + +(defconst mime/Quoted-Printable-hex-char-regexp "[0123456789ABCDEF]") +(defconst mime/Quoted-Printable-octet-regexp + (concat "=" + mime/Quoted-Printable-hex-char-regexp + mime/Quoted-Printable-hex-char-regexp)) +(defconst mime/Quoted-Printable-encoded-text-regexp + (concat "\\([^=?]\\|" mime/Quoted-Printable-octet-regexp "\\)+")) +(defconst mime/Quoted-Printable-encoding-and-encoded-text-regexp + (concat "\\(Q\\)\\?" mime/Quoted-Printable-encoded-text-regexp)) + +(defconst mime/encoded-word-regexp (concat (regexp-quote "=?") + "\\(" + mime/charset-regexp + "+\\)" + (regexp-quote "?") + "\\(B\\|Q\\)" + (regexp-quote "?") + "\\(" + mime/encoded-text-regexp + "\\)" + (regexp-quote "?="))) + +(defun mime/nth-string (s n) + (if (stringp s) + (substring s (match-beginning n) (match-end n)) + (buffer-substring (match-beginning n) (match-end n)))) + +(defun mime/encoded-word-charset (str) + (mime/nth-string str 1)) + +(defun mime/encoded-word-encoding (str) + (mime/nth-string str 2)) + +(defun mime/encoded-word-encoded-text (str) + (mime/nth-string str 3)) + +(defun mime/rest-of-string (str) + (if (stringp str) + (substring str (match-end 0)) + (buffer-substring (match-end 0)(point-max)) + )) + + +;;; @ variables +;;; + +(defvar mime/no-encoding-header-fields '("X-Nsubject")) + +(defvar mime/use-X-Nsubject nil) + + +;;; @ compatible module among Mule, NEmacs and NEpoch +;;; +(cond ((boundp 'MULE) (require 'tm-mule)) + ((boundp 'NEMACS)(require 'tm-nemacs)) + (t (require 'tm-orig)) + ) + + +;;; @ Application Interface +;;; + +;;; @@ MIME header decoders +;;; + +;; by mol. 1993/10/4 +(defun mime/decode-encoded-word (word) + (if (string-match mime/encoded-word-regexp word) + (let ((charset (upcase (mime/encoded-word-charset word))) + (encoding (mime/encoded-word-encoding word)) + (text (mime/encoded-word-encoded-text word))) + (mime/decode-encoded-text charset encoding text)) + word)) + +(defun mime/decode-region (beg end) + (interactive "*r") + (save-excursion + (save-restriction + (narrow-to-region beg end) + (goto-char (point-min)) + (let (charset encoding text) + (while (re-search-forward mime/encoded-word-regexp nil t) + (insert (mime/decode-encoded-word + (prog1 + (buffer-substring (match-beginning 0) (match-end 0)) + (delete-region (match-beginning 0) (match-end 0)) + ) + )) + )) + ))) + +(defun mime/decode-message-header () + (interactive "*") + (save-excursion + (save-restriction + (narrow-to-region (goto-char (point-min)) + (progn (re-search-forward "^$" nil t) (point))) + (mime/prepare-decode-message-header) + (mime/decode-region (point-min) (point-max)) + ))) + +(defun mime/decode-string (str) + (let ((dest "")(ew nil) + beg end) + (while (setq beg (string-match mime/encoded-word-regexp str)) + (if (> beg 0) + (if (not (and (eq ew t) (string= (substring str 0 beg) " "))) + (setq dest (concat dest (substring str 0 beg) + )) + ) + ) + (setq end (match-end 0)) + (setq dest (concat dest (mime/decode-encoded-word (substring str beg end)) + )) + (setq str (substring str end)) + (setq ew t) + ) + (concat dest str) + )) + +;;; @@ MIME header encoders +;;; + +(defun mime/encode-string (string encoding &optional mode) + (cond ((equal encoding "B") + (base64-encode-string string) + ) + ((equal encoding "Q") + (quoted-printable-encode-string string (or mode 'phrase)) + ) + )) + +(defun mime/encode-field (str) + (setq str (rfc822/unfolding-string str)) + (let ((ret (message/divide-field str)) + field-name field-body) + (setq field-name (car ret)) + (setq field-body (nth 1 ret)) + (concat field-name " " + (cond ((string= field-body "") "") + ((or (string-match "^Reply-To:$" field-name) + (string-match "^From:$" field-name) + (string-match "^Sender:$" field-name) + (string-match "^Resent-Reply-To:$" field-name) + (string-match "^Resent-From:$" field-name) + (string-match "^Resent-Sender:$" field-name) + (string-match "^To:$" field-name) + (string-match "^Resent-To:$" field-name) + (string-match "^cc:$" field-name) + (string-match "^Resent-cc:$" field-name) + (string-match "^bcc:$" field-name) + (string-match "^Resent-bcc:$" field-name) + ) + (mime/encode-address-list + (+ (length field-name) 1) field-body) + ) + (t + (catch 'tag + (let ((r mime/no-encoding-header-fields) fn) + (while r + (setq fn (car r)) + (if (string-match (concat "^" fn ":$") field-name) + (throw 'tag field-body) + ) + (setq r (cdr r)) + )) + (nth 1 (mime/encode-header-string + (+ (length field-name) 1) field-body)) + )) + )) + )) + +(defun mime/encode-message-header () + (interactive "*") + (save-excursion + (save-restriction + (narrow-to-region (goto-char (point-min)) + (progn + (re-search-forward + (concat "^" (regexp-quote mail-header-separator) "$") + nil t) + (match-beginning 0) + )) + (goto-char (point-min)) + (let (beg end field) + (while (re-search-forward "^.+:.*\\(\n\\s +.*\\)*" nil t) + (setq beg (match-beginning 0)) + (setq end (match-end 0)) + (setq field (buffer-substring beg end)) + (insert (mime/encode-field + (prog1 + (buffer-substring beg end) + (delete-region beg end) + ))) + )) + (if mime/use-X-Nsubject + (progn + (goto-char (point-min)) + (if (re-search-forward "^Subject:.*\\(\n\\s +.*\\)*" nil t) + (let ((str (buffer-substring (match-beginning 0)(match-end 0)))) + (if (string-match mime/encoded-word-regexp str) + (insert (concat + "\nX-Nsubject: " + (nth 1 (message/divide-field + (mime/decode-string + (rfc822/unfolding-string str)) + )))) + )) + ))) + ))) + + +;;; @ functions for message header encoding +;;; + +(defun mime/encode-and-split-string (n string charset encoding) + (let ((i 0) (j 0) + (len (length string)) + (js (mime/convert-string-from-emacs string charset)) + (cesl (+ (length charset) (length encoding) 6 )) + ewl m rest) + (setq ewl (mime/encoded-word-length js encoding)) + (if (null ewl) nil + (progn + (setq m (+ n ewl cesl)) + (if (> m 76) + (progn + (while (and (< i len) + (setq js (mime/convert-string-from-emacs + (substring string 0 i) charset)) + (setq m (+ n (mime/encoded-word-length js encoding) cesl)) + (< m 76)) + (setq j i) + (setq i (+ i (char-bytes (elt string i)))) + ) + (setq js (mime/convert-string-from-emacs + (substring string 0 j) charset)) + (setq m (+ n (mime/encoded-word-length js encoding) cesl)) + (setq rest (substring string j)) + ) + (setq rest nil)) + (if (string= js "") + (list 1 "" string) + (list m (concat "=?" charset "?" encoding "?" + (mime/encode-string js encoding) + "?=") rest)) + )) + )) + +(defun mime/encode-header-word (n string charset encoding) + (let (dest str ret m) + (if (null (setq ret (mime/encode-and-split-string n string charset encoding))) + nil + (progn + (setq dest (nth 1 ret)) + (setq m (car ret)) + (setq str (nth 2 ret)) + (while (and (stringp str) + (setq ret (mime/encode-and-split-string 1 str charset encoding)) + ) + (setq dest (concat dest "\n " (nth 1 ret))) + (setq m (car ret)) + (setq str (nth 2 ret)) + ) + (list m dest) + )) + )) + +(defun mime/encode-header-string (n string &optional mode) + (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)) + ;; string-width crashes when the argument is nil, + ;; so replace the argument + ;; (original modification by Kenji Rikitake 9-JAN-1995) + (setq w (or (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)) + (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 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 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) + ))) + +(defun mime/encode-address-list (n str) + (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 (> (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 + n (concat (nth 1 cell)(nth 2 cell)(nth 3 cell)))) + ) + (if (and (eq (elt (nth 1 en-ret) 0) ?\n) + (eq (elt dest (- (length dest) 1)) 32)) + (setq dest (substring dest 0 (- (length dest) 1))) + ) + (setq dest (concat dest (nth 1 en-ret))) + (setq n (car en-ret)) + ) + ((= (length cell) 4) + (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 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)) + ) + (progn + (setq dest (concat dest " (")) + )) + (setq dest (concat dest (nth 1 en-ret))) + (setq n (car en-ret)) + (if (> (length r) 1) + (setq en-ret + (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 (> (length r) 1) + (setq en-ret + (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 r (cdr r)) + ) + dest)) + + +;;; @ utility for encoder +;;; + +;;; @@ encoded-word length +;;; + +(defun mime/encoded-word-length (string encoding) + (cond ((equal encoding "B") (base64-encoded-length string)) + ((equal encoding "Q") (quoted-printable-encoded-length string)) + )) + +;;; @@ separate by character set +;;; + +;; by mol. 1993/11/2 +(defconst LC-space 2) + +;; by mol. 1993/10/16 +(defun mime/char-type (chr) + (if (or (= chr 32)(= chr ?\t)) + LC-space + (get-lc chr) + )) + +(defun mime/separate-string-by-chartype (string) + (let ((len (length string)) + (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) + ))) + +(defun mime/separate-string-by-charset (str) + (let ((rl (mime/separate-string-by-chartype str)) + (i 1) len (pcell nil) cell ncell dpcell (dest nil) LC) + (setq len (length rl)) + (setq dpcell (list (nth 0 rl))) + (setq cell (nth 1 rl)) + (setq ncell (nth 2 rl)) + (while (< i len) + (setq LC (car (car dpcell))) + (cond ((and (not (eq LC lc-ascii)) + (eq (car cell) LC-space) + (not (eq (car ncell) lc-ascii))) + (setq dpcell (list (cons LC + (concat (cdr (car dpcell)) (cdr cell)) + ))) + ) + ((and (not (eq LC lc-ascii)) + (eq LC (car cell))) + (setq dpcell (list (cons LC + (concat (cdr (car dpcell)) (cdr cell)) + ))) + ) + ((and (eq LC lc-ascii) + (member (car cell) mime/latin-lc-list)) + (setq dpcell (list (cons (car cell) + (concat (cdr (car dpcell)) (cdr cell)) + ))) + ) + ((and (member LC mime/latin-lc-list) + (eq (car cell) lc-ascii)) + (setq dpcell (list (cons LC + (concat (cdr (car dpcell)) (cdr cell)) + ))) + ) + (t + (setq dest (append dest dpcell)) + (setq dpcell (list cell)) + )) + (setq i (+ i 1)) + (setq cell ncell) + (setq ncell (nth (+ i 1) rl)) + ) + (setq dest (append dest dpcell)) + )) + +(defun mime/separate-string-for-encoder (string) + (let (lastspace) + (if (string-match "[ \t]+$" string) + (progn + (setq lastspace (substring string + (match-beginning 0) + (match-end 0))) + (setq string (substring string 0 (match-beginning 0))) + )) + (let ((rl (mime/separate-string-by-charset string)) + (i 0) len cell0 cell1 cell2 (dest nil)) + (setq len (length rl)) + (setq cell0 (nth 0 rl)) + (setq cell1 (nth 1 rl)) + (setq cell2 (nth 2 rl)) + (while (< i len) + (cond ((and (not (eq (car cell0) lc-ascii)) + (eq (car cell1) LC-space) + (not (eq (car cell2) lc-ascii)) + ) + (setq dest + (append dest (list + (cons + (cdr (assoc (car cell0) + mime/lc-charset-and-encoding-alist)) + (concat (cdr cell0) (cdr cell1)) + )))) + (setq i (+ i 2)) + (setq cell0 (nth i rl)) + (setq cell1 (nth (+ i 1) rl)) + (setq cell2 (nth (+ i 2) rl)) + ) + (t + (setq dest + (append dest (list + (cons + (cdr (assoc (car cell0) + mime/lc-charset-and-encoding-alist)) + (cdr cell0))))) + (setq i (+ i 1)) + (setq cell0 cell1) + (setq cell1 cell2) + (setq cell2 (nth (+ i 2) rl)) + )) + ) + (append dest + (if lastspace + (list (cons nil lastspace)))) + ))) + + + +;;; +;;; basic functions for MIME header decoder +;;; + +;;; @ utility for decoder +;;; + +(defun mime/unfolding () + (goto-char (point-min)) + (let (field beg end) + (while (re-search-forward message/field-regexp nil t) + (setq beg (match-beginning 0)) + (setq end (match-end 0)) + (setq field (buffer-substring beg end)) + (if (string-match mime/encoded-word-regexp field) + (progn + (save-excursion + (save-restriction + (narrow-to-region (goto-char beg) end) + (while (re-search-forward "\n[ \t]+" nil t) + (replace-match " ") + ) + )) + )) + )) + ) + +(defun mime/prepare-decode-message-header () + (mime/unfolding) + (goto-char (point-min)) + (while (re-search-forward + (concat (regexp-quote "?=") + "\\s +" + (regexp-quote "=?")) + nil t) + (replace-match "?==?") + ) + ) + +(setq mime-charset-list + (list (list "US-ASCII" lc-ascii) + (list "ISO-8859-1" lc-ascii lc-ltn1) + (list "ISO-8859-2" lc-ascii lc-ltn2) + (list "ISO-8859-3" lc-ascii lc-ltn3) + (list "ISO-8859-4" lc-ascii lc-ltn4) + (list "ISO-8859-5" lc-ascii lc-crl) + (list "ISO-8859-7" lc-ascii lc-grk) + (list "ISO-8859-9" lc-ascii lc-ltn5) + (list "ISO-2022-JP" lc-ascii lc-jp) + (list "ISO-2022-KR" lc-ascii lc-kr) + (list "ISO-2022-JP-2" lc-ascii lc-ltn1 lc-grk + lc-jp lc-cn lc-kr lc-jp2) + (list "ISO-2022-INT-1" lc-ascii lc-ltn1 lc-grk + lc-jp lc-cn lc-kr lc-jp2 lc-cns1 lc-cns2) + )) + +(setq eword-field-body-separator-regexp " / ") + +(if (string-match eword-field-body-separator-regexp str) + (list (substring str 0 (match-beginning 0)) + (substring str (match-beginning 0)(match-end 0)) + (substring str (match-end 0)) + )) + +(defun find-lc-set-string (str) + (let (dest (len (length str))(i 0) chr lc) + (while (< i len) + (setq chr (elt str i)) + (setq lc (get-lc chr)) + (if (not (memq lc dest)) + (setq dest (cons lc dest)) + ) + (setq i (+ i (char-bytes chr))) + ) + dest)) + +(defun mime/lc-set-to-charset (lc-set) + (let ((rest mime-charset-list) cell) + (catch 'tag + (while rest + (setq cell (car rest)) + (if (subsetp lc-set (cdr cell)) + (throw 'tag (car cell)) + ) + (setq rest (cdr rest)) + )))) + +(run-hooks 'mime/tiny-mime-load-hook) + +(provide 'tiny-mime) + +;;; @ +;;; Local Variables: +;;; mode: emacs-lisp +;;; mode: outline-minor +;;; outline-regexp: ";;; @+\\|(......" +;;; End: diff --git a/tm-mule.el b/tm-mule.el index dfc6241..cd406f9 100644 --- a/tm-mule.el +++ b/tm-mule.el @@ -1,9 +1,7 @@ ;;; -;;; $Id: tm-mule.el,v 5.4 1995/04/20 13:57:31 morioka Exp $ +;;; $Id: tm-mule.el,v 6.1 1995/06/11 13:28:21 morioka Exp $ ;;; -(provide 'tm-mule) - (require 'tl-list) (require 'tl-mule) @@ -14,7 +12,7 @@ ;;; @ variables ;;; -(defvar mime/default-charset *ctext*) +(defvar mime/default-coding-system *ctext*) (defvar mime/lc-charset-and-encoding-alist (list @@ -152,7 +150,7 @@ ))) -(defun mime/code-convert-region-to-emacs (beg end charset) +(defun mime/code-convert-region-to-emacs (beg end charset &optional encoding) (if (stringp charset) (progn (setq charset (upcase charset)) @@ -160,6 +158,11 @@ (if ct (code-convert beg end ct *internal*) ))) - (if mime/default-charset - (code-convert beg end mime/default-charset *internal*) + (if mime/default-coding-system + (code-convert beg end mime/default-coding-system *internal*) ))) + + +(run-hooks 'tm-mule-load-hook) + +(provide 'tm-mule) diff --git a/tm-nemacs.el b/tm-nemacs.el index b95ec98..4371342 100644 --- a/tm-nemacs.el +++ b/tm-nemacs.el @@ -1,9 +1,7 @@ ;;; -;;; $Id: tm-nemacs.el,v 5.1 1994/10/26 15:08:12 morioka Exp $ +;;; $Id: tm-nemacs.el,v 6.0 1995/06/11 13:27:23 morioka Exp $ ;;; -(provide 'tm-nemacs) - (require 'tl-18) (require 'tl-nemacs) @@ -11,6 +9,8 @@ ;;; @ variables ;;; +(defvar mime/default-coding-system 2) + (defvar mime/lc-charset-and-encoding-alist (list (cons lc-ascii nil) @@ -55,10 +55,14 @@ (concat "=?" charset "?" encoding "?" str "?=")) )) -(defun mime/code-convert-region-to-emacs (beg end charset) +(defun mime/code-convert-region-to-emacs (beg end charset &optional encoding) (if (stringp charset) (progn (setq charset (upcase charset)) (if (string= charset "ISO-2022-JP") (convert-region-kanji-code beg end 2 3) )))) + +(run-hooks 'tm-nemacs-load-hook) + +(provide 'tm-nemacs) diff --git a/tm-orig.el b/tm-orig.el index 16dd343..39e401a 100644 --- a/tm-orig.el +++ b/tm-orig.el @@ -1,15 +1,15 @@ ;;; -;;; $Id: tm-orig.el,v 5.2 1994/10/26 14:44:58 morioka Exp $ +;;; $Id: tm-orig.el,v 6.0 1995/06/11 13:48:54 morioka Exp $ ;;; (provide 'tm-orig) -(require 'tl-orig) - ;;; @ variables ;;; +(defvar mime/default-coding-system nil) + (defvar mime/lc-charset-and-encoding-alist (list (cons lc-ascii nil) @@ -50,5 +50,9 @@ )) -(defun mime/code-convert-region-to-emacs (beg end charset) +(defun mime/code-convert-region-to-emacs (beg end charset &optional encoding) ) + +(run-hooks 'tm-orig-load-hook) + +(require 'tl-orig) diff --git a/tm-partial.el b/tm-partial.el index 6412261..7e06d9a 100644 --- a/tm-partial.el +++ b/tm-partial.el @@ -9,7 +9,7 @@ ;; original file is ;; gif.el written by Art Mellor @ Cayman Systems, Inc. 1991 -;;; $Id: tm-partial.el,v 3.1 1995/03/26 17:13:20 morioka Exp $ +;;; $Id: tm-partial.el,v 5.0 1995/05/22 17:06:31 morioka Exp $ (require 'tm-view) @@ -33,8 +33,9 @@ (save-excursion (cond ((eq target 'gnus4) - (gnus-summary-display-article (gnus-summary-article-number)) - ) + (let ((gnus-show-all-headers t)) + (gnus-summary-display-article (gnus-summary-article-number)) + )) ((eq target 'mh-e) (mh-show) ) @@ -132,15 +133,11 @@ (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))) + (let ((params (cdr (mime/Content-Type)))) + (and (equal (assoc-value "id" params) id) + (= (string-to-int (assoc-value "number" params)) + part-num) + ))) (progn (kill-buffer buffer) (error "Couldn't find part %d" part-num))) diff --git a/tm-rich.el b/tm-rich.el index b5ed5b3..8c2bfc3 100644 --- a/tm-rich.el +++ b/tm-rich.el @@ -1,5 +1,5 @@ ;;; -;;; $Id: tm-rich.el,v 4.0 1995/03/12 14:31:58 morioka Exp $ +;;; $Id: tm-rich.el,v 6.0 1995/06/11 10:33:34 morioka Exp $ ;;; ;;; by MORIOKA Tomohiko ;;; modified by YAMATE Keiichirou @@ -96,17 +96,19 @@ ) )))) -(defun mime-viewer/filter-text/richtext (&optional ctype params) - (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) - )))) +(defun mime-viewer/filter-text/richtext (ctype params encoding) + (let* ((mode mime::preview/original-major-mode) + (m (assq mode mime-viewer/code-converter-alist)) + (charset (assoc "charset" params)) + (beg (point-min)) + ) + (if (and m (fboundp (setq m (cdr m)))) + (funcall m beg (point-max) charset encoding) + (mime-viewer/default-code-convert-region beg (point-max) + charset encoding) + ) + (mime/decode-text/richtext-region beg (point-max)) + )) ;;; @ text/enriched @@ -166,17 +168,19 @@ ) )))) -(defun mime-viewer/filter-text/enriched (&optional ctype params) - (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/enriched-region beg end) - )))) +(defun mime-viewer/filter-text/enriched (ctype params encoding) + (let* ((mode mime::preview/original-major-mode) + (m (assq mode mime-viewer/code-converter-alist)) + (charset (assoc "charset" params)) + (beg (point-min)) + ) + (if (and m (fboundp (setq m (cdr m)))) + (funcall m beg (point-max) charset encoding) + (mime/code-convert-region-to-emacs beg (point-max) + charset encoding) + ) + (mime/decode-text/enriched-region beg (point-max)) + )) ;;; @ setting diff --git a/tm-setup.el b/tm-setup.el index 0bd479a..73c24a7 100644 --- a/tm-setup.el +++ b/tm-setup.el @@ -1,5 +1,5 @@ ;;; -;;; $Id: tm-setup.el,v 6.1 1995/04/23 18:09:07 morioka Exp $ +;;; $Id: tm-setup.el,v 6.2 1995/05/30 05:48:22 morioka Exp $ ;;; (require 'tl-misc) @@ -67,12 +67,15 @@ ;;; @ for GNUS ;;; + +(defvar tm-setup/use-gnusutil nil) + (let ((le (function (lambda () (require 'tm-gnus) )) )) - (if (boundp 'MULE) + (if (and (boundp 'MULE) tm-setup/use-gnusutil) (progn (add-hook 'gnus-Group-mode-hook (function gnusutil-initialize)) (add-hook 'gnus-group-mode-hook (function gnusutil-initialize)) diff --git a/tm-view.el b/tm-view.el index 4cd8b6f..3b6874f 100644 --- a/tm-view.el +++ b/tm-view.el @@ -22,7 +22,7 @@ ;;; (defconst mime-viewer/RCS-ID - "$Id: tm-view.el,v 6.22 1995/05/17 08:02:31 morioka Exp $") + "$Id: tm-view.el,v 6.50 1995/06/12 01:51:49 morioka Exp $") (defconst mime-viewer/version (get-version-string mime-viewer/RCS-ID)) (defconst mime/viewer-version mime-viewer/version) @@ -49,7 +49,6 @@ ;;; (defvar mime/content-decoding-condition -;;(setq mime/content-decoding-condition '(((type . "text/plain") (method "tm-plain" nil 'file 'type 'encoding 'mode 'name)) ;;((type . "text/x-latex") @@ -84,87 +83,121 @@ "-m" "tm" "-x" "-d" "-z" "-e" 'file)(mode . "play")) )) +(defvar mime-viewer/childrens-header-showing-Content-Type-list + '("message/rfc822")) + +(defvar mime-viewer/default-showing-Content-Type-list + '("text/plain" "text/richtext" "text/enriched" + "text/x-latex" "application/x-latex" + "application/octet-stream" nil + "application/x-selection" "application/x-comment")) + (defvar mime-viewer/content-filter-alist - '(("text/plain" . mime-viewer/filter-text/plain))) + '(("text/plain" . mime-viewer/filter-text/plain) + (nil . mime-viewer/filter-text/plain))) -(defvar mime-viewer/content-subject-function - (function - (lambda (cnum subj ctype params) - (insert - (format "[%s %s (%s)]\n" - (if (listp cnum) - (mapconcat (function - (lambda (num) - (format "%s" (+ num 1)) - )) - cnum ".") - "0") - subj ctype)) - ))) - -(defvar mime-viewer/content-header-filter-function - (function mime-viewer/default-content-header-filter-function)) +(defun mime-viewer/header-visible-p (cnum cinfo &optional ctype) + (or (eq cnum t) + (progn + (setq ctype + (mime::content-info/type + (mime-article/cnum-to-cinfo (butlast cnum) cinfo) + )) + (member ctype mime-viewer/childrens-header-showing-Content-Type-list) + ))) + +(defun mime-viewer/body-visible-p (cnum cinfo &optional ctype) + (or ctype + (setq ctype + (mime::content-info/type + (mime-article/cnum-to-cinfo cnum cinfo))) + ) + (member ctype mime-viewer/default-showing-Content-Type-list) + ) -(defvar mime-viewer/childrens-header-showing-Content-Type-list - '("message/rfc822")) +(defun mime-viewer/default-content-filter (cnum cinfo ctype params subj) + ) + +(defun mime-viewer/default-content-separator (cnum cinfo ctype params subj) + (if (and (not (mime-viewer/header-visible-p cnum cinfo ctype)) + (not (mime-viewer/body-visible-p cnum cinfo ctype)) + ) + (progn + (goto-char (point-max)) + (insert "\n") + ))) + +(defvar mime-viewer/content-subject-omitting-Content-Type-list + '("application/x-selection")) + +(defun mime-viewer/default-content-subject-function + (cnum cinfo ctype params subj) + (if (not (member + ctype + mime-viewer/content-subject-omitting-Content-Type-list)) + (insert + (format "[%s %s (%s)]\n" + (or (assoc-value "x-part-number" params) + (if (listp cnum) + (mapconcat (function + (lambda (num) + (format "%s" (+ num 1)) + )) + cnum ".") + "0")) + subj ctype)) + )) + +(defvar mime-viewer/content-subject-function + (function mime-viewer/default-content-subject-function)) (defvar mime-viewer/ignored-field-list - '("Received")) + '("Received" "Return-Path" "Replied" "Errors-To" + "Lines" "Sender" "Path" "Nntp-Posting-Host" + "Content-Type")) -(defun mime-viewer/default-content-header-filter-function (cnum cinfo) - (if (and (listp cnum) - (not (member - (mime::content-info/type - (mime::article/get-content-region (butlast cnum) cinfo) - ) - mime-viewer/childrens-header-showing-Content-Type-list) - )) - (delete-region (goto-char (point-min)) - (or (and (re-search-forward "^$" nil t) - (match-end 0)) - (point-max)) - ) - (save-excursion - (save-restriction - (narrow-to-region (goto-char (point-min)) - (or (and (re-search-forward "^$" nil t) - (match-end 0)) - (point-max)) - ) - (mapcar (function - (lambda (field) - (goto-char (point-min)) - (while (and (re-search-forward - (concat "^" (regexp-quote field) ":") - nil t) - (progn - (delete-region - (match-beginning 0) - (and - (re-search-forward - (concat message/field-body-regexp "\n") - nil t) - (match-end 0) - )) - t)) - ) - )) mime-viewer/ignored-field-list) - )))) +(defvar mime-viewer/ignored-field-regexp) -(defvar mime-viewer/default-showing-Content-Type-list - '("text/plain" "text/richtext" "text/enriched" - "text/x-latex" "application/x-latex" - "application/octet-stream" nil)) +(defun mime-viewer/default-content-header-filter () + (goto-char (point-min)) + (while (and (re-search-forward + (concat "^" mime-viewer/ignored-field-regexp ":") + nil t) + (progn + (delete-region + (match-beginning 0) + (save-excursion + (and + (re-search-forward "^\\([^ \t]\\|$\\)" nil t) + (match-beginning 0) + ))) + t))) + (mime/decode-message-header) + ) + +(defvar mime-viewer/content-header-filter-alist nil) (defvar mime-viewer/decoding-mode "play" "MIME body decoding mode") +(defvar mime-viewer/file-name-char-regexp "[A-Za-z0-9+_-]") + +(defvar mime-viewer/file-name-regexp-1 + (concat mime-viewer/file-name-char-regexp "+\\." + mime-viewer/file-name-char-regexp "+")) + +(defvar mime-viewer/file-name-regexp-2 + (concat (regexp-* mime-viewer/file-name-char-regexp) + "\\(\\." mime-viewer/file-name-char-regexp "+\\)*")) + + ;;; @@ buffer local variables ;;; -(defvar mime::article/content-info) -(defvar mime::article/preview-buffer) +(defvar mime::article/content-info nil) +(defvar mime::article/preview-buffer nil) +(defvar mime::preview/article-buffer nil) (defvar mime::preview/content-list nil) (defvar mime::preview/original-major-mode nil) @@ -186,36 +219,9 @@ (delete-other-windows) ) -(defun mime::viewer/quitting-method-for-mh-e () - (let ((win (get-buffer-window - mime/output-buffer-name)) - (buf - (mime::preview-content-info/buffer - (car mime::preview/content-list))) - ) - (if win - (delete-window win) - ) - (mime-viewer/kill-buffer) - (pop-to-buffer - (let ((name (buffer-name buf))) - (string-match "show-" name) - (substring name (match-end 0)) - )) - ;; patch for mh-narrow.el - ;; by YAMAOKA Katsumi - (if (and (featurep 'mh-narrow) - (fboundp 'mh-narrow-to-page)) - (save-excursion - (set-buffer mh-show-buffer) - (mh-narrow-to-page))) - ;; end of patch - )) - (defvar mime-viewer/quitting-method-alist '((gnus-article-mode . mime::viewer/quitting-method-for-gnus4) (rmail-mode . mime::viewer/quitting-method-for-rmail) - (mh-show-mode . mime::viewer/quitting-method-for-mh-e) (mime/show-message-mode . (lambda () (set-window-configuration @@ -277,7 +283,8 @@ (message/strip-quoted-string (cdr boundary))) (narrow-to-region (point-min) - (if (search-forward (concat "--" boundary "--\n") nil t) + (if (re-search-forward + (concat "^--" (regexp-quote boundary) "--$") nil t) (match-beginning 0) (point-max) )) @@ -397,9 +404,9 @@ "Read field-body of Content-Type field from PORT and parse it. PORT must be buffer or string. If PORT is omitted, it is regarded as current-buffer. [tm-view]" - (if (null port) + (or port (setq port (current-buffer)) - ) + ) (let ((str (if (get-buffer port) (save-window-excursion (switch-to-buffer port) @@ -419,7 +426,7 @@ it is regarded as current-buffer. [tm-view]" default-encoding) )) -(defun mime/get-subject (param) +(defun mime-viewer/get-subject (param) (save-excursion (save-restriction (let (ret) @@ -442,28 +449,47 @@ it is regarded as current-buffer. [tm-view]" "")) ))) -(defun mime/get-name (param) - (replace-as-filename (mime/get-subject param)) - ) +(defun mime-viewer/get-name (param) + (let ((str (mime-viewer/get-subject param))) + (if (string-match " " str) + (if (or (string-match mime-viewer/file-name-regexp-1 str) + (string-match mime-viewer/file-name-regexp-2 str)) + (substring str (match-beginning 0)(match-end 0)) + ) + (replace-as-filename str) + ))) (defun mime-viewer/make-preview-buffer (&optional buf cinfo obuf) - (let ((the-buf (current-buffer)) pcl dest) + (let ((the-buf (current-buffer)) + (mode major-mode) + pcl dest) (setq buf (if (null buf) (current-buffer) - (get-buffer buf) - )) - (if (null cinfo) - (progn - (switch-to-buffer buf) - (setq cinfo mime::article/content-info) - )) - (if (null obuf) + (prog1 + (get-buffer buf) + (switch-to-buffer buf) + ))) + (or cinfo + (setq cinfo mime::article/content-info) + ) + (or obuf (setq obuf (concat "*Preview-" (buffer-name buf) "*")) - ) + ) (setq pcl (mime::make-flat-content-list cinfo)) - (if (get-buffer obuf) - (kill-buffer obuf) + (save-window-excursion + (let ((bf (get-buffer obuf))) + (switch-to-buffer obuf) + (setq buffer-read-only nil) + (if bf + (erase-buffer) + )) + (make-variable-buffer-local 'mime::preview/article-buffer) + (setq mime::preview/article-buffer the-buf) + (make-variable-buffer-local 'mime::preview/original-major-mode) + (setq mime::preview/original-major-mode mode) + (setq major-mode 'mime/viewer-mode) + (setq mode-name "MIME-View") ) (setq dest (mapcar @@ -473,54 +499,76 @@ it is regarded as current-buffer. [tm-view]" (end (mime::content-info/point-max cell)) (ctype (mime::content-info/type cell)) (params (mime::content-info/parameters cell)) - cnum e nb ne subj str) + he cnum e nb ne subj str) (setq cnum (mime::get-point-content-number beg cinfo)) - (switch-to-buffer buf) - (setq e - (if (not - (member - ctype - mime-viewer/default-showing-Content-Type-list)) - (save-excursion - (save-restriction - (goto-char beg) - (re-search-forward "^$" nil t) - (+ (match-end 0) 1) + (setq he (save-excursion + (goto-char beg) + (re-search-forward "^$" nil t) + (+ (match-end 0) 1) + )) + (save-window-excursion + (switch-to-buffer obuf) + (setq nb (point)) + (narrow-to-region nb nb) + ) + (if (mime-viewer/header-visible-p cnum cinfo ctype) + (progn + (setq str (buffer-substring beg he)) + (save-window-excursion + (switch-to-buffer obuf) + (insert str) + (let ((f (assq + mode + mime-viewer/content-header-filter-alist)) + ) + (if (and f (setq f (cdr f))) + (funcall f) + (mime-viewer/default-content-header-filter) + ) + )))) + (if (mime-viewer/body-visible-p cnum cinfo ctype) + (let (be) + (setq str (buffer-substring he end)) + (save-window-excursion + (switch-to-buffer obuf) + (save-restriction + (setq be (point-max)) + (narrow-to-region be be) + (insert str) + (setq ne (point-max)) + (let ((f (or (assoc-value + ctype + mime-viewer/content-filter-alist) + ))) + (if (and f (fboundp f)) + (funcall f ctype params encoding) + (mime-viewer/default-content-filter + cnum cinfo ctype params subj) )) - end)) - (if (> e (point-max)) - (setq e (point-max)) + (setq ne (point-max)) + )))) + (save-window-excursion + (switch-to-buffer obuf) + (mime-viewer/default-content-separator + cnum cinfo ctype params subj) ) - (setq str (buffer-substring beg e)) - (switch-to-buffer obuf) - (setq nb (point)) - (insert str) - (setq ne (point)) - (prog1 - (save-excursion - (save-restriction - (narrow-to-region nb ne) - (mime/decode-message-header) - (setq subj (mime/get-subject params)) - (let ((f - (cdr - (assoc ctype - mime-viewer/content-filter-alist)))) - (if (and f (fboundp f)) - (funcall f ctype params) - )) - (funcall mime-viewer/content-header-filter-function - cnum cinfo) + (save-window-excursion + (switch-to-buffer obuf) + (prog1 + (progn + (setq subj (mime-viewer/get-subject params)) (goto-char nb) (funcall mime-viewer/content-subject-function - cnum subj ctype params) + cnum cinfo ctype params subj) (setq ne (point-max)) + (widen) (mime::preview-content-info/create nb (- ne 1) - buf cell) - )) - (goto-char ne) - ) - ))) pcl)) + buf cell) + ) + (goto-char ne) + ))))) + pcl)) + (switch-to-buffer obuf) (set-buffer-modified-p nil) (setq buffer-read-only t) (switch-to-buffer the-buf) @@ -532,9 +580,9 @@ it is regarded as current-buffer. [tm-view]" ;;; (defun mime::get-point-content-number (p &optional cinfo) - (if (null cinfo) + (or cinfo (setq cinfo mime::article/content-info) - ) + ) (let ((b (mime::content-info/point-min cinfo)) (e (mime::content-info/point-max cinfo)) (c (mime::content-info/children cinfo)) @@ -553,10 +601,10 @@ it is regarded as current-buffer. [tm-view]" ))) t)))) -(defun mime::article/get-content-region (cn &optional cinfo) - (if (null cinfo) +(defun mime-article/cnum-to-cinfo (cn &optional cinfo) + (or cinfo (setq cinfo mime::article/content-info) - ) + ) (if (eq cn t) cinfo (let ((sn (car cn))) @@ -564,14 +612,14 @@ it is regarded as current-buffer. [tm-view]" cinfo (let ((rc (nth sn (mime::content-info/children cinfo)))) (if rc - (mime::article/get-content-region (cdr cn) rc) + (mime-article/cnum-to-cinfo (cdr cn) rc) )) )))) (defun mime::make-flat-content-list (&optional cinfo) - (if (null cinfo) + (or cinfo (setq cinfo mime::article/content-info) - ) + ) (let ((dest (list cinfo)) (rcl (mime::content-info/children cinfo)) ) @@ -582,9 +630,9 @@ it is regarded as current-buffer. [tm-view]" dest)) (defun mime::point-preview-content (p &optional pcl) - (if (null pcl) + (or pcl (setq pcl mime::preview/content-list) - ) + ) (catch 'tag (let ((r pcl) cell) (while r @@ -656,7 +704,7 @@ it is regarded as current-buffer. [tm-view]" (narrow-to-region beg end) (goto-char beg) (let ((method (cdr (assoc 'method cal))) - (name (mime/get-name cal)) + (name (mime-viewer/get-name cal)) ) (if method (let ((file (make-temp-name @@ -801,36 +849,37 @@ it is regarded as current-buffer. [tm-view]" ;;; @ content filter ;;; -(defun mime-viewer/filter-text/plain (ctype params) - (save-excursion - (save-restriction - (let ((charset (cdr (assoc "charset" params))) - (encoding - (save-excursion - (save-restriction - (goto-char (point-min)) - (narrow-to-region (point-min) - (or (and (search-forward "\n\n" nil t) - (match-beginning 0)) - (point-max))) - (goto-char (point-min)) - (mime/Content-Transfer-Encoding "7bit") - ))) - (beg (point-min)) (end (point-max)) - ) - (goto-char (point-min)) - (if (search-forward "\n\n" nil t) - (setq beg (match-end 0)) - ) - (if (cond ((string= encoding "quoted-printable") - (mime/Quoted-Printable-decode-region beg end) - t) - ((string= encoding "base64") - (mime/Base64-decode-region beg end) - t)) - (mime/code-convert-region-to-emacs beg (point-max) charset) - ) - )))) +(defvar mime-viewer/code-converter-alist + '((mh-show-mode . mime/code-convert-region-to-emacs)) + ) + +(defun mime-viewer/default-code-convert-region + (beg end charset &optional encoding) + (if (member charset '("quoted-printable" "base64")) + (mime/code-convert-region-to-emacs beg (point-max) charset) + )) + +(defun mime-viewer/filter-text/plain (ctype params encoding) + (let ((charset (cdr (assoc "charset" params))) + (beg (point-min)) (end (point-max)) + ) + (goto-char (point-min)) + (cond ((string= encoding "quoted-printable") + (mime/Quoted-Printable-decode-region beg end) + ) + ((string= encoding "base64") + (mime/Base64-decode-region beg end) + )) + (let* ((mode mime::preview/original-major-mode) + (m (assq mode mime-viewer/code-converter-alist)) + ) + (if (and m (fboundp (setq m (cdr m)))) + (funcall m beg (point-max) charset encoding) + (mime-viewer/default-code-convert-region beg (point-max) + charset encoding) + ))) + (run-hooks 'mime-viewer/plain-text-preview-hook) + ) ;;; @ MIME viewer mode @@ -886,6 +935,11 @@ C-c C-p Decode the content as `print mode' q Quit " (interactive) + (setq mime-viewer/ignored-field-regexp + (concat "\\(" + (mapconcat (function regexp-quote) + mime-viewer/ignored-field-list "\\|") + "\\)")) (let ((buf (get-buffer mime/output-buffer-name)) (the-buf (current-buffer)) ) @@ -895,70 +949,90 @@ q Quit (erase-buffer) (switch-to-buffer the-buf) ))) - (let ((ret (mime-viewer/parse-message ctl encoding)) - (mode major-mode)) - (switch-to-buffer (car ret)) - (setq major-mode 'mime/viewer-mode) - (setq mode-name "MIME-View") - (make-variable-buffer-local 'mime::preview/original-major-mode) - (setq mime::preview/original-major-mode - (if mother - (progn - (make-variable-buffer-local - 'mime/show-mode-old-window-configuration) - (setq mime/show-mode-old-window-configuration - (current-window-configuration)) - (make-variable-buffer-local 'mime/mother-buffer) - (setq mime/mother-buffer mother) - 'mime/show-message-mode) - mode)) - (use-local-map mime/viewer-mode-map) - (make-variable-buffer-local 'mime::preview/content-list) - (setq mime::preview/content-list (nth 1 ret)) - (goto-char - (let ((ce (mime::preview-content-info/point-max - (car mime::preview/content-list) - )) - e) - (goto-char (point-min)) - (search-forward "\n\n" nil t) - (setq e (match-end 0)) - (if (<= e ce) - e - ce))) - (run-hooks 'mime/viewer-mode-hook) - )) + (let ((ret (mime-viewer/parse-message ctl encoding))) + (prog1 + (switch-to-buffer (car ret)) + (if mother + (progn + (make-variable-buffer-local + 'mime/show-mode-old-window-configuration) + (setq mime/show-mode-old-window-configuration + (current-window-configuration)) + (make-variable-buffer-local 'mime/mother-buffer) + (setq mime/mother-buffer mother) + )) + (use-local-map mime/viewer-mode-map) + (make-variable-buffer-local 'mime::preview/content-list) + (setq mime::preview/content-list (nth 1 ret)) + (goto-char + (let ((ce (mime::preview-content-info/point-max + (car mime::preview/content-list) + )) + e) + (goto-char (point-min)) + (search-forward "\n\n" nil t) + (setq e (match-end 0)) + (if (<= e ce) + e + ce))) + (run-hooks 'mime/viewer-mode-hook) + ))) + +(defun mime-preview/point-content-number (point) + (save-window-excursion + (let ((pc (mime::point-preview-content (point))) + cinfo) + (switch-to-buffer (mime::preview-content-info/buffer pc)) + (setq cinfo (mime::preview-content-info/content-info pc)) + (mime::get-point-content-number (mime::content-info/point-min cinfo)) + ))) + +(defun mime-preview/cinfo-to-pcinfo (cinfo) + (let ((rpcl mime::preview/content-list) cell) + (catch 'tag + (while rpcl + (setq cell (car rpcl)) + (if (eq cinfo (mime::preview-content-info/content-info cell)) + (throw 'tag cell) + ) + (setq rpcl (cdr rpcl)) + )))) -(defun mime::preview/decode-content () +(defvar mime-preview/after-decoded-position nil) + +(defun mime-preview/decode-content () (interactive) (let ((pc (mime::point-preview-content (point)))) (if pc (let ((the-buf (current-buffer))) + (setq mime-preview/after-decoded-position (point)) (switch-to-buffer (mime::preview-content-info/buffer pc)) (mime::article/decode-content-region (mime::preview-content-info/content-info pc)) (if (eq (current-buffer) (mime::preview-content-info/buffer pc)) - (switch-to-buffer the-buf) - ) + (progn + (switch-to-buffer the-buf) + (goto-char mime-preview/after-decoded-position) + )) )))) (defun mime-viewer/play-content () (interactive) (let ((mime-viewer/decoding-mode "play")) - (mime::preview/decode-content) + (mime-preview/decode-content) )) (defun mime-viewer/extract-content () (interactive) (let ((mime-viewer/decoding-mode "extract")) - (mime::preview/decode-content) + (mime-preview/decode-content) )) (defun mime-viewer/print-content () (interactive) (let ((mime-viewer/decoding-mode "print")) - (mime::preview/decode-content) + (mime-preview/decode-content) )) (defun mime-viewer/up-content () @@ -974,7 +1048,7 @@ q Quit (mime-viewer/quit the-buf (mime::preview-content-info/buffer pc) ) - (setq r (mime::article/get-content-region (butlast cn))) + (setq r (mime-article/cnum-to-cinfo (butlast cn))) (switch-to-buffer the-buf) (catch 'tag (let ((rpcl mime::preview/content-list) cell) @@ -1022,9 +1096,9 @@ q Quit (defun mime-viewer/scroll-up-content (&optional h) (interactive) - (if (null h) + (or h (setq h (- (window-height) 1)) - ) + ) (let ((pcl mime::preview/content-list) (p (point)) np beg) @@ -1045,9 +1119,9 @@ q Quit (defun mime-viewer/scroll-down-content (&optional h) (interactive) - (if (null h) + (or h (setq h (- (window-height) 1)) - ) + ) (let ((pcl mime::preview/content-list) (p (point)) pp beg) @@ -1080,13 +1154,13 @@ q Quit (defun mime-viewer/quit (&optional the-buf buf) (interactive) - (if (null the-buf) + (or the-buf (setq the-buf (current-buffer)) - ) - (if (null buf) + ) + (or buf (setq buf (mime::preview-content-info/buffer (mime::point-preview-content (point)))) - ) + ) (let ((r (progn (switch-to-buffer buf) (assoc major-mode mime-viewer/quitting-method-alist) @@ -1103,6 +1177,4 @@ q Quit (kill-buffer (current-buffer)) ) -(fset 'mime/view-mode 'mime/viewer-mode) - (run-hooks 'tm-view-load-hook) -- 1.7.10.4