UTILS = ol2 decode-b
METHODS = tm-au tm-file tm-image tm-latex tm-mpeg
-OLFILES = README-jp.ol tiny-mime-jp.ol tm-body-jp.ol \
- tm-mh-e-jp.ol tm-gnus-jp.ol signature-jp.ol \
- README-eng.ol tiny-mime-eng.ol tm-body-eng.ol \
- tm-mh-e-eng.ol tm-gnus-eng.ol
-TEXFILES= README-jp.tex tiny-mime-jp.tex tm-body-jp.tex \
- tm-mh-e-jp.tex tm-gnus-jp.tex \
- README-eng.tex tiny-mime-eng.tex tm-body-eng.tex \
- tm-mh-e-eng.tex tm-gnus-eng.tex
-DVIFILES= README-jp.dvi tiny-mime-jp.dvi tm-body-jp.dvi \
- tm-mh-e-jp.dvi tm-gnus-jp.dvi \
- README-eng.dvi tiny-mime-eng.dvi tm-body-eng.dvi \
- tm-mh-e-eng.dvi tm-gnus-eng.dvi
-PSFILES = README-jp.ps tiny-mime-jp.ps tm-body-jp.ps \
- tm-mh-e-jp.ps tm-gnus-jp.ps signature-jp.ps \
- README-eng.ps tiny-mime-eng.ps tm-body-eng.ps \
- tm-mh-e-eng.ps tm-gnus-eng.ps
-GOMI = *.aux *.log *.tex $(DVIFILES) *.ps $(UTILS)
+OLFILES = tiny-mime-jp.ol signature-jp.ol \
+ tiny-mime-eng.ol
+TEXFILES= tiny-mime-jp.tex signature-jp.tex \
+ tiny-mime-eng.tex
+DVIFILES= tm-jp.dvi tiny-mime-jp.dvi signature-jp.dvi \
+ tiny-mime-eng.dvi
+PSFILES = tm-jp.ps tiny-mime-jp.ps signature-jp.ps \
+ tiny-mime-eng.ps
+GOMI = *.aux *.log $(TEXFILES) $(DVIFILES) *.ps $(UTILS)
FILES = *.ol Makefile *.el *.c methods $(TEXFILES)
-TARFILE = tm4.8.2.tar
+TARFILE = tm4.8.3.tar
.SUFFIXES: .ol .tex .dvi .ps
#!/bin/csh
+if (! $?TM_TMP_DIR) then
+ set TM_TMP_DIR=/tmp
+endif
+
if( $5 == "" ) then
- set filename="/tmp/mime$$"
+ set filename="$TM_TMP_DIR/mime$$"
else
- set filename = /tmp/$5
+ set filename = $TM_TMP_DIR/$5
endif
echo "$2; $3 -> $filename"
mmencode -q -u $1 > $filename
breaksw
case "x-uue":
- pushd /tmp
+ pushd $TM_TMP_DIR
uudecode $1
popd
breaksw
#!/bin/csh
+if (! $?TM_TMP_DIR) then
+ set TM_TMP_DIR=/tmp
+endif
+
if( $5 == "" ) then
switch ( $2 )
case "image/gif":
- set filename="/tmp/mime$$.gif"
+ set filename="$TM_TMP_DIR/mime$$.gif"
breaksw
case "image/jpeg":
- set filename="/tmp/mime$$.jpg"
+ set filename="$TM_TMP_DIR/mime$$.jpg"
breaksw
case "image/x-xwd":
- set filename="/tmp/mime$$.xwd"
+ set filename="$TM_TMP_DIR/mime$$.xwd"
breaksw
case "image/x-xbm":
- set filename="/tmp/mime$$.xbm"
+ set filename="$TM_TMP_DIR/mime$$.xbm"
breaksw
case "image/x-pic":
- set filename="/tmp/mime$$.pic"
+ set filename="$TM_TMP_DIR/mime$$.pic"
breaksw
default:
- set filename="/tmp/mime$$.img"
+ set filename="$TM_TMP_DIR/mime$$.img"
endsw
else
- set filename = /tmp/$5
+ set filename = $TM_TMP_DIR/$5
endif
echo "$2; $3 -> $filename"
case "base64":
decode-b < $1 > $filename
breaksw
+case "quoted-printable":
+ mmencode -u -q $1 > $filename
+ breaksw
endsw
/bin/rm $1
;;;
-;;; $Id: mime-setup.el,v 1.17 1994/08/20 12:06:34 morioka Exp $
+;;; $Id: mime-setup.el,v 3.0 1994/08/31 05:33:58 morioka Exp $
;;;
(provide 'mime-setup)
(setq gnus-signature-file nil)
-;;; @ for RMAIL
-;;;
-(autoload 'rmail-show-mime "rmailmime" "Show MIME messages." t)
-(autoload 'rmail-convert-mime-header "rmailmime" "Convert MIME header." nil)
-(setq rmail-message-filter (function mime/decode-message-header))
-(add-hook 'rmail-mode-hook
- (function
- (lambda ()
- ;; Forward mail using MIME.
- (require 'mime)
- (substitute-key-definition 'rmail-forward
- 'mime-forward-from-rmail-using-mail
- (current-local-map))
- (local-set-key "v" 'rmail-show-mime)
- )))
-
-
;;; @ for Mail mode (includes VM mode)
;;;
(add-hook 'mail-mode-hook (function mime-mode))
;;;
-;;; $Id: sc-setup.el,v 1.2 1994/08/20 12:12:59 morioka Exp $
+;;; $Id: sc-setup.el,v 1.3 1994/08/22 13:56:10 morioka Exp morioka $
;;;
(provide 'sc-setup)
;;; @ for Super Cite
;;;
-(autoload 'sc-cite-original "sc" nil t)
+(if (< (string-to-int emacs-version) 19)
+ (autoload 'sc-cite-original "sc" nil t)
+ (autoload 'sc-cite-original "supercite" "supercite 3.1" t)
+ (autoload 'sc-submit-bug-report "supercite" "Supercite 3.1" t))
(setq sc-citation-leader "")
(cond ((boundp 'MULE)
;; for MULE
(setq sc-cite-regexp
"\\s *\\([a-zA-Z0-9]\\|\\cc\\|\\cC\\|\\ch\\|\\cH\\|\\ck\\|\\cK\\)*>+\\s *")
))
-(defun my-sc-overload-hook ()
- (require 'sc-oloads)
- (sc-overload-functions)
- )
+(if (< (string-to-int emacs-version) 19)
+ (progn
+ (defun my-sc-overload-hook ()
+ (require 'sc-oloads)
+ (sc-overload-functions)
+ )
-;;; @@ for all but mh-e
-;;;
-(setq mail-yank-hooks (function sc-cite-original))
+ ;; @@ for all but mh-e
+ ;;
+ (setq mail-yank-hooks (function sc-cite-original))
-;;; @@ for RMAIL, PCMAIL, GNUS
-;;;
-(add-hook 'mail-setup-hook (function my-sc-overload-hook))
+ ;; @@ for RMAIL, PCMAIL, GNUS
+ ;;
+ (add-hook 'mail-setup-hook (function my-sc-overload-hook))
-;;; @@ for Gnus
-;;;
-(add-hook 'news-reply-mode-hook (function my-sc-overload-hook))
-(add-hook 'gnews-ready-hook (function my-sc-overload-hook))
+ ;; @@ for Gnus
+ ;;
+ (add-hook 'news-reply-mode-hook (function my-sc-overload-hook))
+ (add-hook 'gnews-ready-hook (function my-sc-overload-hook))
-;;; @@ for mh-e
-;;;
-(add-hook 'mh-letter-mode-hook (function my-sc-overload-hook))
-(setq mh-yank-hooks 'sc-cite-original) ; for MH-E only
+ ;; @@ for mh-e
+ ;;
+ (add-hook 'mh-letter-mode-hook (function my-sc-overload-hook))
+ (setq mh-yank-hooks 'sc-cite-original) ; for MH-E only
+ )
+ (add-hook 'mail-citation-hook 'sc-cite-original)
+ (setq news-reply-header-hook nil)
+ )
;;; @ for sc-register
;;;
-;;; $Id: tl-list.el,v 0.3 1994/07/16 04:08:52 morioka Exp morioka $
+;;; $Id: tl-list.el,v 0.6 1994/08/28 17:10:12 morioka Exp $
;;;
(provide 'tl-list)
+;;; @ list
+;;;
+
+(defun last (list)
+ "Returns the last element in the list <LIST>.
+[mol's Common Lisp emulating function]"
+ (nthcdr (- (length list) 1) list)
+ )
+
+(defun butlast (x &optional n)
+ "Returns a copy of LIST with the last N elements removed.
+[tl-list.el: imported from cl.el]"
+ (if (and n (<= n 0)) x
+ (nbutlast (copy-sequence x) n)))
+
+(defun nbutlast (x &optional n)
+ "Modifies LIST to remove the last N elements.
+[tl-list.el: imported from cl.el]"
+ (let ((m (length x)))
+ (or n (setq n 1))
+ (and (< n m)
+ (progn
+ (if (> n 0) (setcdr (nthcdr (- (1- m) n) x) nil))
+ x))))
+
+
;;; @ alist
;;;
(defun put-alist (item value alist)
- "\t(put-alist <ITEM> <VALUE> <ALIST>)\n
-If there is a pair whose car is <ITEM>, replace its cdr by <VALUE>.
+ "If there is a pair whose car is <ITEM>, replace its cdr by <VALUE>.
If there is not such pair, create new pair (<ITEM> . <VALUE>) and
return new alist whose car is the new pair and cdr is <ALIST>.
[mol's ELIS emulating function]"
))
(defun del-alist (item alist)
- "\t(del-alist <ITEM> <ALIST>)\n
-If there is a pair whose key is <ITEM>, delete it from <ALIST>.
+ "If there is a pair whose key is <ITEM>, delete it from <ALIST>.
[mol's ELIS emulating function]"
(if (equal item (car (car alist)))
(cdr alist)
--- /dev/null
+;;;
+;;; $Id: tl-str.el,v 1.3 1994/08/31 06:54:15 morioka Exp $
+;;;
+
+(provide 'tl-str)
+
+(defun fill-cited-region (beg end)
+ (interactive "*r")
+ (save-excursion
+ (save-restriction
+ (goto-char end)
+ (while (not (eolp))
+ (backward-char)
+ )
+ (setq end (point))
+ (narrow-to-region beg end)
+ (goto-char (point-min))
+ (let* ((fill-prefix
+ (and (re-search-forward "^[^ \t>]*[>|]+[ \t]*" nil t)
+ (buffer-substring (match-beginning 0)
+ (match-end 0)
+ )))
+ (pat (concat "\n" fill-prefix))
+ )
+ (goto-char (point-min))
+ (while (search-forward pat nil t)
+ (replace-match "")
+ )
+ (goto-char (point-min))
+ (fill-region (point-min) (point-max))
+ ))))
+
+(defun replace-top-string (&optional old new)
+ (interactive)
+ (if (null old)
+ (setq old (read-string "old string is ? "))
+ )
+ (if (null new)
+ (setq new (read-string "new string is ? "))
+ )
+ (while (re-search-forward (concat "^" (regexp-quote old)) nil t)
+ (replace-match new)
+ ))
+
+(defun replace-as-filename (str)
+ (let ((dest "")
+ (i 0)(len (length str))
+ chr)
+ (while (< i len)
+ (setq chr (elt str i))
+ (if (or (and (<= ?+ chr)(<= chr ?.))
+ (and (<= ?0 chr)(<= chr ?:))
+ (= chr ?=)
+ (and (<= ?@ chr)(<= chr ?\[))
+ (and (<= ?\] chr)(<= chr ?_))
+ (and (<= ?a chr)(<= chr ?{))
+ (and (<= ?} chr)(<= chr ?~))
+ )
+ (setq dest (concat dest
+ (char-to-string chr)))
+ )
+ (setq i (+ i 1))
+ )
+ dest))
--- /dev/null
+;;;
+;;; $Id: tm-comp.el,v 1.1 1994/08/21 22:00:44 morioka Exp morioka $
+;;;
+
+(provide 'tm-comp)
+
+(defvar mime/message-max-length 1000)
+(defvar mime/message-sender-alist
+ '((mail-mode . sendmail-send-it)
+ (mh-letter-mode . (lambda ()
+ (write-region (point-min) (point-max)
+ mime/draft-file-name)
+ (call-process
+ (expand-file-name mh-send-prog mh-progs)
+ nil nil nil mime/draft-file-name)
+ ))
+ (news-reply-mode . gnus-inews-article)
+ ))
+(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)
+ ))
+ ))
+
+(defun mime/split-and-send (&optional cmd)
+ (interactive)
+ (if (null cmd)
+ (setq cmd (cdr (assq major-mode mime/message-sender-alist)))
+ )
+ (let ((mime/draft-file-name (buffer-file-name))
+ (lines (count-lines (point-min)(point-max)))
+ (separator mail-header-separator)
+ (config (eval (cdr (assq major-mode mime/window-config-alist))))
+ )
+ (if (null mime/draft-file-name)
+ (setq mime/draft-file-name "/tmp/tm-draft")
+ )
+ (mime-mode-exit)
+ (if (<= lines mime/message-max-length)
+ (funcall cmd)
+ (let ((header (message/get-header-string-except
+ "^Content-" separator))
+ (id (concat "\""
+ (replace-space-with-underline (current-time-string))
+ "@" (system-name) "\""))
+ )
+ (goto-char (point-min))
+ (if (re-search-forward (concat "^" (regexp-quote separator) "$")
+ nil t)
+ (replace-match "")
+ )
+ (let* ((total (+ (/ lines mime/message-max-length)
+ (if (> (mod lines mime/message-max-length) 0)
+ 1)))
+ (i 0)(l mime/message-max-length)
+ (the-buf (current-buffer))
+ (buf (get-buffer "*tmp-send*"))
+ data)
+ (if buf
+ (progn
+ (switch-to-buffer buf)
+ (erase-buffer)
+ (switch-to-buffer the-buf)
+ )
+ (setq buf (get-buffer-create "*tmp-send*"))
+ )
+ (switch-to-buffer buf)
+ (make-variable-buffer-local 'mail-header-separator)
+ (setq mail-header-separator separator)
+ (switch-to-buffer the-buf)
+ (goto-char (point-min))
+ (while (< i total)
+ (setq buf (get-buffer "*tmp-send*"))
+
+ (setq data (buffer-substring
+ (point)
+ (progn
+ (goto-line l)
+ (point))
+ ))
+ (switch-to-buffer buf)
+ (insert header)
+ (insert
+ (format
+ "Content-Type: message/partial; id=%s; number=%d; total=%d\n%s\n"
+ id (+ i 1) total separator))
+ (insert data)
+ (funcall cmd)
+ (erase-buffer)
+ (switch-to-buffer the-buf)
+ (setq l (+ l mime/message-max-length))
+ (setq i (+ i 1))
+ )
+ )))
+ (set-buffer-modified-p nil)
+ (kill-buffer (current-buffer))
+ (if config
+ (set-window-configuration config)
+ )
+ ))
+
+(add-hook 'mime-mode-hook
+ (function
+ (lambda ()
+ (if (not (fboundp 'default-mime-mode-exit-and-run))
+ (progn
+ (make-variable-buffer-local 'mime/send-message-method)
+ (fset 'default-mime-mode-exit-and-run
+ 'mime-mode-exit-and-run)
+ (fset 'mime-mode-exit-and-run
+ 'mime/split-and-send)
+ )))))
+
+(defun message/get-header-string-except (pat boundary)
+ (save-excursion
+ (save-restriction
+ (narrow-to-region (goto-char (point-min))
+ (progn
+ (re-search-forward boundary nil t)
+ (match-beginning 0)
+ ))
+ (goto-char (point-min))
+ (let (field header)
+ (while (re-search-forward message/field-regexp nil t)
+ (setq field (buffer-substring (match-beginning 0)
+ (match-end 0)
+ ))
+ (if (not (string-match pat field))
+ (setq header (concat header field "\n"))
+ ))
+ header)
+ )))
+
+(defun replace-space-with-underline (str)
+ (mapconcat (function
+ (lambda (arg)
+ (char-to-string
+ (if (= arg 32)
+ ?_
+ arg)))) str "")
+ )
;;;
-;;; $Id: tm-gnus.el,v 2.0 1994/07/24 08:33:00 morioka Exp morioka $
+;;; $Id: tm-gnus.el,v 3.0 1994/08/28 16:22:16 morioka Exp $
;;;
;;; A MIME extension for GNUS
;;;
(set-buffer-modified-p t))
-;;; @ MIME full decode message
-;;;
-(defun tm-gnus/full-decode-message-old (arg)
- "MIME full-decode this article."
- (interactive "P")
- (let ((gnus-Article-prepare-hook mime/body-decoding-method))
- ;; The following is a trick
- ;; to force to read the current article again.
- (setq gnus-have-all-headers (not gnus-have-all-headers))
- (gnus-summary-select-article (not gnus-have-all-headers) t)
- ))
-
-(defun tm-gnus/full-decode-message-new (arg)
- "MIME full-decode this article."
- (interactive "P")
- (setq gnus-show-mime t)
- ;; The following is a trick to force to read the current article again.
- (setq gnus-have-all-headers (not gnus-have-all-headers))
- (gnus-summary-select-article (not gnus-have-all-headers) t)
- (setq gnus-show-mime nil))
-
-(defun tm-gnus/play-message (arg)
- "MIME decode and play this message."
- (interactive "P")
- (let ((mime/body-decoding-mode "play"))
- (tm-gnus/full-decode-message arg)
- )
- (mime/show-body-decoded-result)
- )
-
-(defun tm-gnus/extract-message (arg)
- "MIME decode and extract files from this message."
- (interactive "P")
- (let ((mime/body-decoding-mode "extract"))
- (tm-gnus/full-decode-message arg)
- )
- (mime/show-body-decoded-result)
- )
-
-(defun tm-gnus/print-message (arg)
- "MIME decode and print contents of this message."
- (interactive "P")
- (let ((mime/body-decoding-mode "print"))
- (tm-gnus/full-decode-message arg)
- )
- (mime/show-body-decoded-result)
- )
-
-
;;; @ 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."
;;;
-;;; $Id: tm-gnus3.el,v 2.0 1994/07/24 08:33:00 morioka Exp morioka $
+;;; $Id: tm-gnus3.el,v 3.2 1994/08/31 12:07:15 morioka Exp $
;;;
(provide 'tm-gnus3)
(require 'tm-gnus)
+(require 'tm-view)
+(require 'tl-list)
(if (and (null gnus-Startup-hook)
(boundp 'gnus-startup-hook))
(setq gnus-Article-prepare-hook gnus-article-prepare-hook)
)
-(defun tm-gnus/full-decode-message-old (arg)
- "MIME full-decode this article."
+(setq mime/go-to-top-node-method-alist
+ (put-alist 'gnus-Article-mode
+ (if (string-match (regexp-quote "3.14.4") gnus-version)
+ (function
+ (lambda ()
+ (gnus-Article-show-summary)
+ ))
+ (function
+ (lambda ()
+ (gnus-Article-show-subjects)
+ )))
+ mime/go-to-top-node-method-alist))
+
+(defun tm-gnus/view-message (arg)
+ "MIME decode and play this message."
(interactive "P")
- (let ((gnus-Article-prepare-hook mime/body-decoding-method))
- ;; The following is a trick
- ;; to force to read the current article again.
- (setq gnus-have-all-headers (not gnus-have-all-headers))
- (gnus-summary-select-article (not gnus-have-all-headers) t)
- ))
+ (let ((gnus-break-pages nil))
+ (gnus-Subject-select-article t t)
+ )
+ (pop-to-buffer gnus-Article-buffer t)
+ (mime/view-mode)
+ )
(add-hook 'gnus-Select-group-hook
(function
(define-key gnus-Subject-mode-map
"\et" 'tm-gnus/toggle-mime-header-decoding-mode)
-(define-key gnus-Subject-mode-map "v" 'tm-gnus/play-message)
-(define-key gnus-Subject-mode-map "e" 'tm-gnus/extract-message)
-(define-key gnus-Subject-mode-map "\C-cp" 'tm-gnus/print-message)
+(define-key gnus-Subject-mode-map "v" 'tm-gnus/view-message)
(fset 'gnus-summary-select-article 'gnus-Subject-select-article)
(make-local-variable 'minor-mode-alist)
(mime/add-header-decoding-mode-to-mode-line)
)))
-
- (fset 'tm-gnus/full-decode-message 'tm-gnus/full-decode-message-old)
)
(progn
(add-hook 'gnus-Article-mode-hook
(function mime/add-header-decoding-mode-to-mode-line))
-
- (fset 'tm-gnus/full-decode-message 'tm-gnus/full-decode-message-new)
- (setq gnus-show-mime-method mime/body-decoding-method)
))
;;;
-;;; $Id: tm-gnus4.el,v 2.0 1994/07/24 08:33:00 morioka Exp morioka $
+;;; $Id: tm-gnus4.el,v 3.1 1994/08/31 05:29:42 morioka Exp $
;;;
(provide 'tm-gnus4)
(require 'tm-gnus)
+(autoload 'mime/view-mode "tm-view" "View MIME message." t)
(if (and (null gnus-startup-hook)
(boundp 'gnus-Startup-hook))
(setq gnus-article-prepare-hook gnus-Article-prepare-hook)
)
+(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/view-mode)
+ )
+
(add-hook 'gnus-select-group-hook
(function
(lambda ()
(define-key gnus-summary-mode-map
"\et" 'tm-gnus/toggle-mime-header-decoding-mode)
-(define-key gnus-summary-mode-map "v" 'tm-gnus/play-message)
-(define-key gnus-summary-mode-map "e" 'tm-gnus/extract-message)
-(define-key gnus-summary-mode-map "\C-cp" 'tm-gnus/print-message)
+(define-key gnus-summary-mode-map "v" 'tm-gnus/view-message)
+(define-key gnus-summary-mode-map "\e\r"
+ (function (lambda ()
+ (interactive)
+ (gnus-summary-scroll-up -1)
+ )))
(fset 'gnus-article-set-mode-line 'tm-gnus/article-set-mode-line)
(add-hook 'gnus-article-mode-hook
(if mime/header-decoding-mode
(mime/decode-message-header)
))) t)
-
-(fset 'tm-gnus/full-decode-message 'tm-gnus/full-decode-message-new)
-(setq gnus-show-mime-method mime/body-decoding-method)
;;; @ version
;;;
(defconst tm-mh-e/RCS-ID
- "$Id: tm-mh-e.el,v 2.2 1994/07/25 16:13:03 morioka Exp $")
+ "$Id: tm-mh-e.el,v 3.1 1994/08/31 05:32:24 morioka Exp $")
(defconst tm-mh-e/version
(and (string-match "[0-9][0-9.]*" tm-mh-e/RCS-ID)
(if (not (boundp 'mh-e-version))
(require 'tm-mh-e3)
)
+(autoload 'mime/view-mode "tm-view" "View MIME message." t)
;;; @ MIME header decoding mode
;;; @ MIME body players
;;;
-(defun tm-mh-e/play-message (arg)
+(defun tm-mh-e/view-message (arg)
"MIME decode and play this message."
(interactive "P")
(mh-invalidate-show-buffer)
- (let ((mime/body-decoding-mode "play"))
- (mh-show-msg (mh-get-msg-num t))
- )
- (mime/show-body-decoded-result)
- )
-
-(defun tm-mh-e/extract-message (arg)
- "MIME decode and extract files from this message."
- (interactive "P")
- (mh-invalidate-show-buffer)
- (let ((mime/body-decoding-mode "extract"))
- (mh-show-msg (mh-get-msg-num t))
- )
- (mime/show-body-decoded-result)
- )
-
-(defun tm-mh-e/print-message (arg)
- "MIME decode and extract files from this message."
- (interactive "P")
- (mh-invalidate-show-buffer)
- (let ((mime/body-decoding-mode "print"))
- (mh-show-msg (mh-get-msg-num t))
- )
- (mime/show-body-decoded-result)
+ (mh-show-msg (mh-get-msg-num t))
+ (pop-to-buffer mh-show-buffer t)
+ (mime/view-mode)
)
(if mime/header-decoding-mode
(mime/decode-message-header)
)
- (if mime/body-decoding-mode
- (funcall mime/body-decoding-method)
- )
(set-buffer-modified-p nil)
))))
(define-key mh-folder-mode-map "\et" 'tm-mh-e/toggle-header-decoding-mode)
-(define-key mh-folder-mode-map "v" 'tm-mh-e/play-message)
-(define-key mh-folder-mode-map "e" 'tm-mh-e/extract-message)
-(define-key mh-folder-mode-map "\C-cp" 'tm-mh-e/print-message)
+(define-key mh-folder-mode-map "v" 'tm-mh-e/view-message)
+(define-key mh-folder-mode-map "\r"
+ (function (lambda ()
+ (interactive)
+ (scroll-other-window 1)
+ )))
+(define-key mh-folder-mode-map "\e\r"
+ (function (lambda ()
+ (interactive)
+ (scroll-other-window -1)
+ )))
;;;
-;;; $Id: tm-misc.el,v 2.1 1994/08/01 05:24:09 morioka Exp $
+;;; $Id: tm-misc.el,v 3.0 1994/08/31 07:15:08 morioka Exp $
;;;
;;; MIME utility for tm-*.el MIME user agent packages
;;;
(require 'tl-18)
)
(require 'tiny-mime)
-(require 'tm-body)
(defvar mime/header-decoding-mode t "*Decode MIME header if non-nil.")
minor-mode-alist))
))
-(defvar mime/body-decoding-mode nil "MIME body decoding mode")
-(defvar mime/body-decoding-method (function mime/decode-body)
- "MIME body decoding method to play")
-
;;; @ about rightful dividing for multi-octet string
;;;
i))
))
+
;;; @ functions to check field
;;;
(defun mime/exist-encoded-word-in-subject ()
--- /dev/null
+;;;
+;;; $Id: tm-rmail.el,v 3.1 1994/08/31 05:37:24 morioka Exp $
+;;;
+
+(provide 'tm-rmail)
+
+(if (< (string-to-int emacs-version) 19)
+ (require 'tl-18)
+ )
+(autoload 'mime/view-mode "tm-view" "View MIME message." t)
+(autoload 'mime/decode-message-header "tiny-mime" "Decode MIME header." t)
+
+(add-hook 'rmail-show-message-hook
+ (function
+ (lambda ()
+ (let ((buffer-read-only nil))
+ (mime/decode-message-header)
+ )
+ (set-buffer-modified-p nil)
+ )))
+
+(add-hook 'rmail-mode-hook
+ (function
+ (lambda ()
+ (local-set-key "v" 'mime/view-mode)
+ )))
+
+(add-hook 'rmail-summary-mode-hook
+ (function
+ (lambda ()
+ (local-set-key "v"
+ (function
+ (lambda ()
+ (interactive)
+ (pop-to-buffer "RMAIL")
+ (mime/view-mode)
+ )))
+ )))
;;;
-;;; $Id: tm-setup.el,v 1.2 1994/08/20 12:07:45 morioka Exp $
+;;; $Id: tm-setup.el,v 1.3 1994/08/30 04:26:05 morioka Exp $
;;;
(provide 'tm-setup)
))
+;;; @ for RMAIL
+;;;
+(require 'tm-rmail)
+
+
;;; @ for mh-e
;;;
(add-hook 'mh-folder-mode-hook
--- /dev/null
+;;;
+;;; A MIME viewer for GNU Emacs
+;;;
+;;; by Morioka Tomohiko, 1994/07/13
+
+(provide 'tm-view)
+
+
+;;; @ version
+;;;
+
+(defconst mime/viewer-RCS-ID
+ "$Id: tm-view.el,v 3.1 1994/08/31 07:16:10 morioka Exp $")
+
+(defconst mime/viewer-version
+ (and (string-match "[0-9][0-9.]*" mime/viewer-RCS-ID)
+ (substring mime/viewer-RCS-ID (match-beginning 0)(match-end 0))
+ ))
+
+
+;;; @ require modules
+;;;
+
+(require 'outline)
+(require 'tl-str)
+(require 'tl-list)
+(require 'tl-header)
+(require 'tiny-mime)
+
+
+;;; @ constants
+;;;
+
+(defconst mime/tspecials "\000-\040()<>@,;:\\\"/[\093?.=")
+(defconst mime/token-regexp
+ (concat "[^" mime/tspecials "]*"))
+(defconst mime/content-type-subtype-regexp
+ (concat mime/token-regexp "/" mime/token-regexp))
+(defconst mime/content-parameter-value-regexp
+ (concat "\\("
+ message/quoted-string-regexp
+ "\\|[^; \t\n]\\)*"))
+
+(defconst mime/output-buffer-name "*MIME-out*")
+(defconst mime/decoding-buffer-name "*MIME-decoding*")
+
+
+;;; @ variables
+;;;
+
+(defvar mime/content-decoding-method-alist
+ '(("text/plain" . "tm-plain")
+ ("text/x-latex" . "tm-latex")
+ ("audio/basic" . "tm-au")
+ ("image/gif" . "tm-image")
+ ("image/jpeg" . "tm-image")
+ ("image/tiff" . "tm-image")
+ ("image/x-tiff" . "tm-image")
+ ("image/x-xbm" . "tm-image")
+ ("image/x-pic" . "tm-image")
+ ("video/mpeg" . "tm-mpeg")
+ ("application/octet-stream" . "tm-file")
+ ))
+
+(defvar mime/default-showing-Content-Type-list
+ '("text/plain" "text/x-latex" "message/rfc822"))
+
+(setq mime/default-showing-Content-Type-list
+ '("text/plain" "text/x-latex" "message/rfc822"))
+
+(defvar mime/go-to-top-node-method-alist
+ '((gnus-article-mode . (lambda ()
+ (gnus-article-show-summary)
+ ))
+ (rmail-mode . (lambda ()
+ (mime/exit-view-mode)
+ (rmail-summary)
+ (delete-other-windows)
+ ))
+ (mh-show-mode . (lambda ()
+ (pop-to-buffer
+ (let ((name (buffer-name)))
+ (string-match "show-" name)
+ (substring name (match-end 0))
+ ))
+ ))
+ (mime/show-message-mode . (lambda ()
+ (set-window-configuration
+ mime/show-mode-old-window-configuration)
+ (let ((buf (current-buffer)))
+ (pop-to-buffer mime/mother-buffer)
+ (kill-buffer buf)
+ )))
+ ))
+
+(defvar mime/tmp-dir "/tmp/")
+
+(defvar mime/use-internal-decoder nil)
+
+(defvar mime/body-decoding-mode "play" "MIME body decoding mode")
+
+
+;;; @ parser
+;;;
+
+(defun mime/parse-content ()
+ (save-excursion
+ (save-restriction
+ (mime/decode-message-header)
+ (goto-char (point-min))
+ (let* ((ctl (mime/Content-Type))
+ (boundary (assoc "boundary" (cdr ctl)))
+ beg end dest)
+ (search-forward "\n\n" nil t)
+ (cond (boundary
+ (let ((sep (concat "\n--"
+ (setq boundary (read (cdr boundary)))
+ "\n"))
+ cb ce ct ret ncb)
+ (setq beg (match-end 0))
+ (search-forward (concat "\n--" boundary "--\n") nil t)
+ (setq end (match-beginning 0))
+ (save-excursion
+ (save-restriction
+ (narrow-to-region beg end)
+ (goto-char (point-min))
+ (search-forward (concat "--" boundary "\n") nil t)
+ (setq cb (match-end 0))
+ (while (search-forward sep nil t)
+ (setq ce (match-beginning 0))
+ (setq ncb (match-end 0))
+ (save-excursion
+ (save-restriction
+ (narrow-to-region cb ce)
+ (setq ret (mime/parse-content))
+ ))
+ (setq dest (append dest (list ret)))
+ (goto-char (nth 1 ret))
+ (search-forward (concat "--" boundary "\n") nil t)
+ (goto-char (setq cb (match-end 0)))
+ )
+ (setq ce (point-max))
+ (save-excursion
+ (save-restriction
+ (narrow-to-region cb ce)
+ (setq ret (mime/parse-content))
+ ))
+ (setq dest (append dest (list ret)))
+ ))
+ (setq beg (point-min))
+ (goto-char beg)
+ (search-forward (concat "\n--" boundary "--\n") nil t)
+ (setq end (match-beginning 0))
+ ))
+ ((string= (car ctl) "message/rfc822")
+ (save-excursion
+ (save-restriction
+ (narrow-to-region (match-end 0) (point-max))
+ (setq dest (list (mime/parse-content)))
+ ))
+ (setq beg (point-min))
+ (setq end (point-max))
+ )
+ (t
+ (setq beg (point-min))
+ (setq end (point-max))
+ ))
+ (list beg end dest)
+ ))))
+
+(defun mime/Content-Type ()
+ (save-excursion
+ (save-restriction
+ (if (and (re-search-forward "^Content-Type:[ \t]*" nil t)
+ (progn
+ (narrow-to-region
+ (point)
+ (and (re-search-forward ".*\\(\n[ \t].*\\)*" nil t)
+ (match-end 0))
+ )
+ (goto-char (point-min))
+ (re-search-forward mime/content-type-subtype-regexp nil t)
+ ))
+ (let ((ctype
+ (downcase
+ (buffer-substring (match-beginning 0) (match-end 0))
+ ))
+ dest attribute value)
+ (while (and (re-search-forward "[ \t\n]*;[ \t\n]*" nil t)
+ (re-search-forward mime/token-regexp nil t)
+ )
+ (setq attribute
+ (downcase
+ (buffer-substring (match-beginning 0) (match-end 0))
+ ))
+ (if (and (re-search-forward "=[ \t\n]*" nil t)
+ (re-search-forward mime/content-parameter-value-regexp
+ nil t)
+ )
+ (setq dest
+ (put-alist attribute
+ (buffer-substring (match-beginning 0)
+ (match-end 0))
+ dest))
+ )
+ )
+ (cons ctype dest)
+ )))))
+
+(defun mime/Content-Transfer-Encoding (&optional default-encoding)
+ (save-excursion
+ (save-restriction
+ (if (and (re-search-forward "^Content-Transfer-Encoding:[ \t]*" nil t)
+ (re-search-forward mime/token-regexp nil t)
+ )
+ (downcase (buffer-substring (match-beginning 0) (match-end 0)))
+ default-encoding)
+ )))
+
+(defun mime/get-name (ctype)
+ (save-excursion
+ (save-restriction
+ (replace-as-filename
+ (let (ret)
+ (or (and (setq ret (assoc "name" ctype))
+ (read (cdr ret))
+ )
+ (and (setq ret (assoc "x-name" ctype))
+ (read (cdr ret)))
+ (message/get-field-body "Content-Description")
+ ""))
+ ))))
+
+(defun mime/parse-message ()
+ (interactive)
+ (save-excursion
+ (save-restriction
+ (setq selective-display t)
+ (make-variable-buffer-local 'mime/content-list)
+ (let ((buffer-read-only nil))
+ (setq mime/content-list (mime/parse-content))
+ )
+ (mime/hide-all)
+ (set-buffer-modified-p nil)
+ )))
+
+
+;;; @ content information
+;;;
+
+(defun mime/get-point-content-number (p &optional cl)
+ (if (null cl)
+ (setq cl mime/content-list)
+ )
+ (let ((b (car cl))
+ (e (nth 1 cl))
+ (c (nth 2 cl))
+ )
+ (if (and (<= b p)(<= p e))
+ (or (let (co ret (sn 0))
+ (catch 'tag
+ (while c
+ (setq co (car c))
+ (setq ret (mime/get-point-content-number p co))
+ (cond ((eq ret t) (throw 'tag (list sn)))
+ (ret (throw 'tag (cons sn ret)))
+ )
+ (setq c (cdr c))
+ (setq sn (+ sn 1))
+ )))
+ t))))
+
+(defun mime/get-content-region (cn &optional cl)
+ (if (null cl)
+ (setq cl mime/content-list)
+ )
+ (if (eq cn t)
+ cl
+ (let ((sn (car cn)))
+ (if (null sn)
+ cl
+ (let ((rcl (nth sn (nth 2 cl))))
+ (if rcl
+ (mime/get-content-region (cdr cn) rcl)
+ ))
+ ))))
+
+(defun mime/make-flat-content-list (&optional cl)
+ (if (null cl)
+ (setq cl mime/content-list)
+ )
+ (let ((dest (list (car cl)))
+ (rcl (nth 2 cl))
+ )
+ (while rcl
+ (setq dest (append dest (mime/make-flat-content-list (car rcl))))
+ (setq rcl (cdr rcl))
+ )
+ dest))
+
+
+;;; @ decoder
+;;;
+
+(defun mime/base64-decode-region (beg end &optional buf filename)
+ (let ((the-buf (current-buffer)) ret)
+ (if (null buf)
+ (setq buf (get-buffer-create mime/decoding-buffer-name))
+ )
+ (save-excursion
+ (save-restriction
+ (switch-to-buffer buf)
+ (erase-buffer)
+ (switch-to-buffer the-buf)
+ (narrow-to-region beg end)
+ (goto-char (point-min))
+ (while (re-search-forward
+ (concat "^"
+ mime/Base64-encoded-text-regexp
+ "$") nil t)
+ (setq ret (mime/base64-decode-string
+ (buffer-substring (match-beginning 0)
+ (match-end 0)
+ )))
+ (switch-to-buffer buf)
+ (insert ret)
+ (switch-to-buffer the-buf)
+ )))
+ (if filename
+ (progn
+ (switch-to-buffer buf)
+ (let ((kanji-flag nil)
+ (mc-flag nil)
+ (file-coding-system
+ (if (featurep 'mule) *noconv*))
+ )
+ (write-file filename)
+ (kill-buffer buf)
+ (switch-to-buffer the-buf)
+ )))
+ ))
+
+(defun mime/start-external-method-region (beg end ctype ctl encoding)
+ (goto-char beg)
+ (let ((method (cdr (assoc ctype mime/content-decoding-method-alist)))
+ (name (mime/get-name ctl))
+ )
+ (if method
+ (progn
+ (search-forward "\n\n" nil t)
+ (let ((file (make-temp-name
+ (expand-file-name "TM" mime/tmp-dir)))
+ (b (match-end 0))
+ (e end))
+ (goto-char b)
+ (if (and (string= encoding "base64")
+ mime/use-internal-decoder)
+ (progn
+ (mime/base64-decode-region b e nil file)
+ (setq encoding "binary")
+ )
+ (write-region b e file)
+ )
+ (start-process method mime/output-buffer-name method file
+ ctype encoding
+ (if mime/body-decoding-mode
+ mime/body-decoding-mode
+ "play")
+ (replace-as-filename name)
+ )
+ (if (null (get-buffer-window mime/output-buffer-name))
+ (let ((the-buf (current-buffer)))
+ (split-window-vertically (/ (* (window-height) 3) 4))
+ (pop-to-buffer mime/output-buffer-name)
+ (pop-to-buffer the-buf)
+ ))
+ )))))
+
+(defun mime/decode-message/partial-region (beg end ctype default-encoding)
+ (goto-char beg)
+ (let ((root-dir (expand-file-name
+ (concat "m-prts-" (user-login-name)) mime/tmp-dir))
+ (id (cdr (assoc "id" ctype)))
+ (number (cdr (assoc "number" ctype)))
+ (total (cdr (assoc "total" ctype)))
+ (the-buf (current-buffer))
+ file)
+ (if (not (file-exists-p root-dir))
+ (shell-command (concat "mkdir " root-dir))
+ )
+ (setq id (replace-as-filename id))
+ (setq root-dir (concat root-dir "/" id))
+ (if (not (file-exists-p root-dir))
+ (shell-command (concat "mkdir " root-dir))
+ )
+ (setq file (concat root-dir "/FULL"))
+ (if (not (file-exists-p file))
+ (progn
+ (re-search-forward "^$")
+ (goto-char (+ (match-end 0) 1))
+ (setq file (concat root-dir "/" number))
+ (write-region (point) (point-max) file)
+ (if (get-buffer "*MIME-temp*")
+ (kill-buffer "*MIME-temp*")
+ )
+ (switch-to-buffer "*MIME-temp*")
+ (let ((i 1)
+ (max (string-to-int total))
+ )
+ (catch 'tag
+ (while (<= i max)
+ (setq file (concat root-dir "/" (int-to-string i)))
+ (if (not (file-exists-p file))
+ (progn
+ (switch-to-buffer the-buf)
+ (throw 'tag nil)
+ ))
+ (insert-file-contents file)
+ (goto-char (point-max))
+ (setq i (+ i 1))
+ )
+ (write-file (concat root-dir "/FULL"))
+ (delete-other-windows)
+ (pop-to-buffer (current-buffer))
+ (goto-char (point-min))
+ (mime/show-message-mode the-buf)
+ ))
+ )
+ (progn
+ (delete-other-windows)
+ (find-file file)
+ (mime/show-message-mode the-buf)
+ ))
+ ))
+
+(defun mime/decode-content-region (beg end)
+ (interactive "*r")
+ (save-excursion
+ (save-restriction
+ (narrow-to-region beg end)
+ (outline-flag-region beg end ?\n)
+ (goto-char beg)
+ (let ((ctl (mime/Content-Type)))
+ (if ctl
+ (let ((ctype (downcase (car ctl)))
+ (encoding (mime/Content-Transfer-Encoding "7bit"))
+ )
+ (setq ctl (cdr ctl))
+ (cond ((string= ctype "message/partial")
+ (mime/decode-message/partial-region beg end ctl encoding)
+ )
+ (t (mime/start-external-method-region beg end
+ ctype ctl encoding)
+ (if (not (member
+ ctype
+ mime/default-showing-Content-Type-list))
+ (mime/hide-region beg end)
+ )
+ ))
+ ))))))
+
+
+;;; @ hide
+;;;
+
+(defun mime/hide-region (beg end)
+ (save-excursion
+ (save-restriction
+ (goto-char beg)
+ (search-forward "\n\n" nil t)
+ (setq beg (match-end 0))
+ (outline-flag-region beg end ?\^M)
+ )))
+
+(defun mime/hide-all ()
+ (let ((fl (mime/make-flat-content-list))
+ p c)
+ (while fl
+ (setq p (car fl))
+ (setq c (mime/get-content-region (mime/get-point-content-number p)))
+ (if (null (nth 2 c))
+ (save-excursion
+ (save-restriction
+ (narrow-to-region (car c)(nth 1 c))
+ (goto-char (car c))
+ (let ((ctl (mime/Content-Type)))
+ (if (and ctl
+ (not (member
+ (car ctl)
+ mime/default-showing-Content-Type-list)))
+ (mime/hide-region (car c)(nth 1 c))
+ )))))
+ (setq fl (cdr fl))
+ )))
+
+
+;;; @ MIME show message mode (major-mode)
+;;;
+(defun mime/show-message-mode (mother)
+ (kill-all-local-variables)
+ (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)
+ (setq major-mode 'mime/show-message-mode)
+ (setq mode-name "MIME-View")
+ (mime/view-mode)
+ (run-hooks 'mime/show-message-mode-hook)
+ )
+
+
+;;; @ MIME view message mode (minor-mode)
+;;;
+
+(defun mime/view-mode ()
+ (interactive)
+ (make-local-variable 'mime/view-mode-old-local-map)
+ (let ((keymap (current-local-map)))
+ (if (null keymap)
+ (setq keymap (make-sparse-keymap))
+ (progn
+ (setq mime/view-mode-old-local-map keymap)
+ (setq keymap (copy-keymap keymap))
+ ))
+ (let ((buf (get-buffer mime/output-buffer-name)))
+ (if buf
+ (let ((the-buf (current-buffer)))
+ (switch-to-buffer buf)
+ (erase-buffer)
+ (switch-to-buffer the-buf)
+ )))
+ (use-local-map keymap)
+ (define-key keymap "u" 'mime/up-content)
+ (define-key keymap "p" 'mime/previous-content)
+ (define-key keymap "n" 'mime/next-content)
+ (define-key keymap "v" 'mime/play-content)
+ (define-key keymap "e" 'mime/extract-content)
+ (define-key keymap "\C-c\C-p" 'mime/print-content)
+ (define-key keymap "\C-c\C-x" 'mime/exit-view-mode)
+ )
+ (mime/parse-message)
+ (search-forward "\n\n" nil t)
+ )
+
+(defun mime/decode-content ()
+ (interactive)
+ (let ((cr (mime/get-content-region
+ (mime/get-point-content-number (point))))
+ )
+ (and cr
+ (null (nth 2 cr))
+ (mime/decode-content-region (car cr)(nth 1 cr))
+ )))
+
+(defun mime/play-content ()
+ (interactive)
+ (let ((mime/body-decoding-mode "play"))
+ (mime/decode-content)
+ ))
+
+(defun mime/extract-content ()
+ (interactive)
+ (let ((mime/body-decoding-mode "extract"))
+ (mime/decode-content)
+ ))
+
+(defun mime/print-content ()
+ (interactive)
+ (let ((mime/body-decoding-mode "print"))
+ (mime/decode-content)
+ ))
+
+(defun mime/up-content ()
+ (interactive)
+ (let ((cn (mime/get-point-content-number (point)))
+ r)
+ (if (eq cn t)
+ (and (setq r (assoc major-mode mime/go-to-top-node-method-alist))
+ (funcall (cdr r))
+ )
+ (if (setq r (mime/get-content-region (butlast cn)))
+ (goto-char (car r))
+ )
+ )))
+
+(defun mime/previous-content ()
+ (interactive)
+ (let* ((fcl (mime/make-flat-content-list))
+ (p (point))
+ (i (- (length fcl) 1))
+ )
+ (catch 'tag
+ (while (>= i 0)
+ (if (> p (nth i fcl))
+ (throw 'tag (goto-char (nth i fcl)))
+ )
+ (setq i (- i 1))
+ ))
+ ))
+
+(defun mime/next-content ()
+ (interactive)
+ (let ((fcl (mime/make-flat-content-list))
+ (p (point))
+ )
+ (catch 'tag
+ (while fcl
+ (if (< p (car fcl))
+ (throw 'tag (goto-char (car fcl)))
+ )
+ (setq fcl (cdr fcl))
+ ))
+ ))
+
+(defun mime/exit-view-mode ()
+ (interactive)
+ (if (and (boundp 'mime/view-mode-old-local-map)
+ (keymapp mime/view-mode-old-local-map))
+ (use-local-map mime/view-mode-old-local-map)
+ )
+ (show-all)
+ )
projects / elisp / tm.git / commitdiff