# 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
tl/Makefile tl/Makefile.bc tl/loadpath \
tl/*.el tl/doc/*.texi
-TARFILE = tm6.22.3.tar
+TARFILE = tm6.50.tar
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)
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)
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)
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
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
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)
#
-# $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
--- /dev/null
+;;;
+;;; $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)
EMACS19_GNUS = gnus
EMACS19_NNTP = nntp
+
+FILES = tm/gnus/*.el
+
+TARFILE = tm-gnus6.3.tar
+
+
nemacs: nemacs-$(EMACS18_GNUS)
nemacs-gnus3:
clean:
-rm *.elc
+
+
+tar:
+ cd ../..; tar cvf $(TARFILE) $(FILES); gzip -9 $(TARFILE)
--- /dev/null
+;;;
+;;; 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)
;;;
;;; 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)
;;;
-;;; $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
(add-hook 'gnus-Article-mode-hook
(function mime/add-header-decoding-mode-to-mode-line))
))
+
+(provide 'tm-gnus3)
;;;
-;;; $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)
(add-hook 'gnus-article-prepare-hook
(function mime/decode-message-header-if-you-need) t)
+
+(provide 'tm-gnus4)
--- /dev/null
+;;;
+;;; 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)
#!/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
#!/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
# 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)
clean:
-rm *.elc
+
+
+tar:
+ cd ../..; tar cvf $(TARFILE) $(FILES); gzip -9 $(TARFILE)
(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 <yamaoka@ga.sony.co.jp>
- (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
;;;
;;; @ 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)
(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)
;;;
-;;; $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.
;;; 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)
(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)
;;;
-;;; $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)
("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"
(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")
--- /dev/null
+;;;
+;;; $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)
--- /dev/null
+* tm-view
+
+ tm-view \e$B$N\e(B preview buffer \e$B$KBP$9$kI=<($r@_Dj$9$k$?$a$N5!9=$,JQ99$5$l\e(B
+\e$B$?!#$^$?!"\e(Bcharset \e$B$K$h$k\e(B code \e$BJQ49$r9MN8$7$F\e(B major-mode \e$BKh$K\e(B filter \e$B$r\e(B
+\e$B@ZBX$($l$k$h$&$K$7$?!#\e(B
+
+** content subject
+
+*** \e$BJQ?t\e(B mime-viewer/content-subject-omitting-Content-Type-list
+
+ \e$B$3$NJQ?t\e(B (list) \e$B$K@_Dj$5$l$?\e(B content-type \e$B$N\e(B content subject \e$B$OI=<(\e(B
+\e$B$5$l$J$$!#\e(B
+
+*** \e$B4X?t\e(B mime-viewer/default-content-subject-function
+
+ \e$B0z?t$,JQ99$5$l$F$$$k$N$GCm0U!#\e(B
+
+*** \e$BJQ?t\e(B mime-viewer/content-subject-function
+
+ \e$B$3$NJQ?t$K!"4X?t\e(B mime-viewer/default-content-subject-function \e$B0J30$N\e(B
+\e$B4X?t$r@_Dj$7$?>l9g!"JQ?t\e(B
+mime-viewer/content-subject-omitting-Content-Type-list \e$B$NM-8z@-$OJ]>Z\e(B
+\e$B$5$l$J$$$N$GCm0U$9$k$3$H!#\e(B
+
+
+** content header
+
+ \e$B4X?t\e(B mime-viewer/header-visible-p \e$B$,\e(B t \e$B$K$J$k\e(B content \e$B$N\e(B content
+header \e$B$,I=<($5$l$k!#$3$N>r7o$rJQ$($?$$>l9g$O!"$3$N4X?t$r:FDj5A$9$k$3\e(B
+\e$B$H!#I8=`$G$O!"JQ?t\e(B
+mime-viewer/childrens-header-showing-Content-Type-list \e$B$r;2>H$9$k$,:F\e(B
+\e$BDj5A$7$?>l9g!"$3$NJQ?t$NM-8z@-$OJ]>Z$5$l$J$$$N$GCm0U$9$k$3$H!#\e(B
+
+ content header \e$B$,I=<($5$l$k>l9g!"\e(Bcontent-header-filter \e$B$K$h$C$F@07A\e(B
+\e$B$5$l$k!#8F$P$l$k\e(B content-header-filter \e$B$O\e(B article buffer \e$B$N\e(B major-mode
+\e$B$r\e(B key \e$B$H$7$FJQ?t\e(B mime-viewer/content-header-filter-alist \e$B$+$iC5$5$l$k!#\e(B
+\e$B$b$7!"$3$NJQ?t$KEPO?$5$l$F$$$J$+$C$?>l9g!"4X?t\e(B
+mime-viewer/default-content-header-filter \e$B$,8F$P$l$k!#\e(B
+
+
+** content body
+
+ \e$B$"$k\e(B content \e$B$N\e(B body \e$B$rI=<($9$k$+$I$&$+$O!"4X?t\e(B
+mime-viewer/body-visible-p \e$B$,\e(B t \e$B$K$J$k$+$I$&$+$G7h$^$k!#I8=`$G$O!"JQ?t\e(B
+mime-viewer/default-showing-Content-Type-list \e$B$KB8:_$7$F$$$k\e(B content
+type \e$B$N\e(B content \e$B$,I=<($5$l$k!#\e(B
+
+ body \e$B$,I=<($5$l$k;~!"\e(Bcontent-filter \e$B$K$h$C$F@07A$5$l$k!#8F$P$l$k\e(B
+content-filter \e$B$O\e(B article buffer \e$B$N\e(B major-mode \e$B$r\e(B key \e$B$H$7$FJQ?t\e(B
+mime-viewer/content-filter-alist \e$B$+$iC5$5$l$k!#$b$7!"$3$NJQ?t$KEPO?$5\e(B
+\e$B$l$F$$$J$+$C$?>l9g!"4X?t\e(B mime-viewer/default-content-filter \e$B$,8F$P$l$k!#\e(B
+
+ \e$B=>Mh!"\e(Bcontent filter \e$B$O\e(B header \e$B$b@07A$7$F$$$?$,!"\e(Bbody \e$B$N$_$N@07A$K2~\e(B
+\e$B$a$i$l$?$N$GCm0U$9$k$3$H!#\e(B
+
+
+** content separator
+
+ content \e$B$N:G8e$K\e(B content separator \e$B$H$$$&$b$N$rI=<($G$-$k$h$&$K$7$?!#\e(B
+\e$B$3$l$O!"4X?t\e(B mime-viewer/default-content-separator \e$B$K$h$C$FI=<($5$l$k!#\e(B
+\e$BI8=`$G$O!"\e(Bheader \e$B$b\e(B body \e$B$bI=<($5$l$J$$>l9g$N$_!"2~9T$rF~$l$k$3$H$K$7\e(B
+\e$B$F$$$k!#JQ99$7$?$$>l9g$O!"$3$N4X?t$r:FDj5A$9$k$3$H!#\e(B
+
+
+* tm-mh-e
+
+ charset \e$B$K$h$k\e(B code \e$BJQ49$r9T$J$&$h$&$K$7$?!#\e(B
;;; 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)
)
;;; @ 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))
)
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
;;;
(run-hooks 'mime/tiny-mime-load-hook)
+(provide 'tiny-mime)
+
;;; @
;;; Local Variables:
;;; mode: emacs-lisp
;;;
(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))
(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 ()
(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
--- /dev/null
+;;;
+;;; $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 "\e$BA4$F$NA*Br;h$KEz$($F2<$5$$\e(B")
+ (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] \e$B$3$N<x6H$NNI$$E@!"7g$1$?E@$r5s$2$F2<$5$$!#\e(B\n\n\n")
+ (insert "[40] \e$B$3$N<x6H$NC4Ev6541$N65$(J}$NNI$$E@!"7g$1$?E@$r;XE&$7$F2<$5$$!#\e(B\n\n\n")
+ (insert "[41] \e$B7/$O$3$N<x6H$r<u$1$F!"%W%i%9$H$J$C$?$b$N$O2?$G$7$g$&$+!)\e(B\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)
--- /dev/null
+;;;
+;;; 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:
;;;
-;;; $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)
;;; @ variables
;;;
-(defvar mime/default-charset *ctext*)
+(defvar mime/default-coding-system *ctext*)
(defvar mime/lc-charset-and-encoding-alist
(list
)))
-(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 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)
;;;
-;;; $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)
;;; @ variables
;;;
+(defvar mime/default-coding-system 2)
+
(defvar mime/lc-charset-and-encoding-alist
(list
(cons lc-ascii nil)
(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)
;;;
-;;; $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)
))
-(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)
;; 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)
(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)
)
(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)))
;;;
-;;; $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 <morioka@jaist.ac.jp>
;;; modified by YAMATE Keiichirou <ics9118@sem1.info.osaka-cu.ac.jp>
)
))))
-(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
)
))))
-(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
;;;
-;;; $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)
;;; @ 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))
;;;
(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)
;;;
(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")
"-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)
(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 <yamaoka@ga.sony.co.jp>
- (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
(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)
))
"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)
default-encoding)
))
-(defun mime/get-subject (param)
+(defun mime-viewer/get-subject (param)
(save-excursion
(save-restriction
(let (ret)
""))
)))
-(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
(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)
;;;
(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))
)))
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)))
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))
)
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
(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
;;; @ 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
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))
)
(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 ()
(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)
(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)
(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)
(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)
(kill-buffer (current-buffer))
)
-(fset 'mime/view-mode 'mime/viewer-mode)
-
(run-hooks 'tm-view-load-hook)
projects / elisp / tm.git / commitdiff