From: morioka Date: Mon, 2 Mar 1998 15:05:11 +0000 (+0000) Subject: tm 6.54 X-Git-Tag: tm6_54~1 X-Git-Url: http://git.chise.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=be2e192c5cb1f8e850c67e419064c3cfff807722;p=elisp%2Ftm.git tm 6.54 --- diff --git a/Makefile b/Makefile index 5f4b818..2534416 100644 --- a/Makefile +++ b/Makefile @@ -1,5 +1,5 @@ # -# $Id: Makefile,v 6.10 1995/05/19 11:40:09 morioka Exp morioka $ +# $Id: Makefile,v 6.11 1995/06/17 18:54:23 morioka Exp morioka $ # # Please specify emacs executables: @@ -17,11 +17,11 @@ MULE2 = mule2 # TMDIR18 = for Emacs 18.* (NEMACS, NEpoch or MULE 1) # TMDIR19 = for Emacs 19.* (FSF original, XEmacs or MULE 2) -#TMDIR18 = /usr/local/lib/emacs/local.lisp/tm -#TMDIR19 = /usr/local/lib/mule/site-lisp +TMDIR18 = /usr/local/lib/emacs/local.lisp/tm +TMDIR19 = /usr/local/lib/mule/site-lisp -TMDIR18 = $(HOME)/lib/emacs18/lisp -TMDIR19 = $(HOME)/lib/emacs19/lisp +#TMDIR18 = $(HOME)/lib/emacs18/lisp +#TMDIR19 = $(HOME)/lib/emacs19/lisp # Please specify GNUS type (`gnus3' or `gnus4') if you use Emacs 18.* EMACS18_GNUS = gnus3 @@ -47,13 +47,13 @@ FILES = tm/README.eng tm/rel-*.ol \ tm/Makefile tm/Makefile.bc tm/make-lpath tm/inst-el tm/inst-elc \ tm/*.el tm/*.c tm/methods \ tm/doc/Makefile tm/doc/*.pln tm/doc/*.ol tm/doc/*.tex tm/doc/*.texi \ - tm/gnus/Makefile tm/gnus/Makefile.bc tm/gnus/*.el \ - tm/mh-e/Makefile tm/mh-e/Makefile.bc tm/mh-e/*.el \ + tm/gnus/Makefile tm/gnus/*-path tm/gnus/mk-tgnus tm/gnus/*.el \ + tm/mh-e/Makefile tm/mh-e/Makefile.bc code-jp.ol tm/mh-e/*.el \ tl/README.eng \ tl/Makefile tl/Makefile.bc tl/loadpath \ tl/*.el tl/doc/*.texi -TARFILE = tm6.50.tar +TARFILE = tm6.54.tar lpath-nemacs: @@ -61,8 +61,7 @@ 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 gnus3 EMACS=$(NEMACS) cd mh-e; PWD=`pwd` \ make nemacs NEMACS=$(NEMACS) NEMACS_MH_E=$(NEMACS_MH_E) @@ -71,15 +70,14 @@ nemacs-vm: lpath-nemacs install-nemacs: nemacs install-mua-18 make -f Makefile.bc install TMDIR=$(TMDIR18) EMACS_TYPE=nemacs - + cd gnus; PWD=`pwd` make install-18 EMACS=$(NEMACS) TMDIR18=$(TMDIR18) lpath-mule1: ./make-lpath $(MULE1_OPT) 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 gnus3 EMACS=$(MULE1) cd mh-e; PWD=`pwd` \ make mule1 MULE1=$(MULE1) NEMACS_MH_E=$(MULE1_MH_E) @@ -88,9 +86,9 @@ mule1-vm: lpath-nemacs install-mule1: mule1 install-mua-18 make -f Makefile.bc install TMDIR=$(TMDIR18) EMACS_TYPE=mule + cd gnus; PWD=`pwd` make install-18 EMACS=$(MULE1) TMDIR18=$(TMDIR18) install-mua-18: -# cd gnus; PWD=`pwd` make install-18 TMDIR18=$(TMDIR18) cd mh-e; PWD=`pwd` make install-18 TMDIR18=$(TMDIR18) make -f Makefile.bc install-tm-vm TMDIR=$(TMDIR18) @@ -100,7 +98,7 @@ lpath-orig19: orig19: lpath-orig19 make -f Makefile.bc all EMACS=$(ORIG19) EMACS_TYPE=orig -# cd gnus; PWD=`pwd` make orig19 ORIG19=$(ORIG19) + cd gnus; PWD=`pwd` make gnus4 EMACS=$(ORIG19) cd mh-e; PWD=`pwd` make orig19 ORIG19=$(ORIG19) orig19-vm: lpath-nemacs @@ -108,14 +106,14 @@ orig19-vm: lpath-nemacs install-orig19: orig19 install-mua-19 make -f Makefile.bc install TMDIR=$(TMDIR19) EMACS_TYPE=orig - + cd gnus; PWD=`pwd` make install-19 EMACS=$(ORIG19) TMDIR19=$(TMDIR19) lpath-mule2: ./make-lpath $(MULE2_OPT) 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 gnus4 EMACS=$(MULE2) cd mh-e; PWD=`pwd` make mule2 MULE2=$(MULE2) mule2-vm: lpath-nemacs @@ -123,9 +121,9 @@ mule2-vm: lpath-nemacs install-mule2: mule2 install-mua-19 make -f Makefile.bc install TMDIR=$(TMDIR19) EMACS_TYPE=mule + cd gnus; PWD=`pwd` make install-19 EMACS=$(MULE2) TMDIR19=$(TMDIR19) install-mua-19: -# cd gnus; PWD=`pwd` make install-19 TMDIR19=$(TMDIR19) cd mh-e; PWD=`pwd` make install-19 TMDIR19=$(TMDIR19) make -f Makefile.bc install-tm-vm TMDIR=$(TMDIR19) diff --git a/gnus/Makefile b/gnus/Makefile index b28bc05..7446373 100644 --- a/gnus/Makefile +++ b/gnus/Makefile @@ -1,17 +1,9 @@ # -# $Id: Makefile,v 6.2 1995/05/19 11:42:33 morioka Exp morioka $ +# $Id: Makefile,v 6.3 1995/06/17 18:54:48 morioka Exp morioka $ # # Please specify emacs executables: -# NEMACS = for NEMACS (or NEpoch) -# MULE1 = for Mule 1.* (based on Emacs 18.*) -# ORIG19 = for Emacs 19.* (FSF original or XEmacs) -# MULE2 = for MULE 2.* (based on Emacs 19.*) - -NEMACS = nemacs -MULE1 = mule -ORIG19 = emacs19 -MULE2 = mule2 +EMACS = mule2 # Please specfy Emacs Lisp install directory: @@ -19,70 +11,29 @@ MULE2 = mule2 # 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 +TMDIR19 = /usr/local/lib/mule/site-lisp TMDIR18 = $(HOME)/lib/emacs18/lisp -TMDIR19 = $(HOME)/lib/emacs19/lisp - -EMACS18_GNUS = gnus3 - -EMACS18_GNUS3 = gnus -EMACS18_NNTP3 = nntp - -EMACS18_GNUS4 = /usr/local/lib/emacs/local.lisp/gnus-4.1/lisp/gnus -EMACS18_NNTP4 = /usr/local/lib/emacs/local.lisp/gnus-4.1/lisp/nntp - -EMACS19_GNUS = gnus -EMACS19_NNTP = nntp - +# TMDIR19 = $(HOME)/lib/emacs19/lisp FILES = tm/gnus/*.el TARFILE = tm-gnus6.3.tar -nemacs: nemacs-$(EMACS18_GNUS) - -nemacs-gnus3: - make -f Makefile.bc all \ - EMACS=$(NEMACS) EMACS_TYPE=nemacs GNUS_TYPE=gnus3 \ - GNUS=$(EMACS18_GNUS3) NNTP=$(EMACS18_NNTP3) +gnus3: + $(EMACS) -batch -l g3-path -l mk-tgnus -f compile-tm-gnus -nemacs-gnus4: - make -f Makefile.bc all \ - EMACS=$(NEMACS) EMACS_TYPE=nemacs GNUS_TYPE=gnus4 \ - GNUS=$(EMACS18_GNUS4) NNTP=$(EMACS18_NNTP4) +gnus4: + $(EMACS) -batch -l g4-path -l mk-tgnus -f compile-tm-gnus -mule1: mule1-$(EMACS18_GNUS) - -mule1-gnus3: - make -f Makefile.bc all \ - EMACS=$(MULE1) EMACS_TYPE=mule GNUS_TYPE=gnus3 \ - GNUS=$(EMACS18_GNUS3) NNTP=$(EMACS18_NNTP3) - -mule1-gnus4: - make -f Makefile.bc all \ - EMACS=$(MULE1) EMACS_TYPE=mule GNUS_TYPE=gnus4 \ - GNUS=$(EMACS18_GNUS4) NNTP=$(EMACS18_NNTP4) +dgnus: + $(EMACS) -batch -l d-path -l mk-tgnus -f compile-tm-gnus install-18: - ../inst-el $(TMDIR18) tm-gnus*.el - ../inst-elc $(TMDIR18) tm-gnus*.elc - - -orig19: - make -f Makefile.bc all \ - EMACS=$(ORIG19) EMACS_TYPE=orig GNUS_TYPE=gnus4 \ - GNUS=$(EMACS19_GNUS) NNTP=$(EMACS19_NNTP) - -mule2: - make -f Makefile.bc all \ - EMACS=$(MULE2) EMACS_TYPE=mule GNUS_TYPE=gnus4 \ - GNUS=$(EMACS19_GNUS) NNTP=$(EMACS19_NNTP) + $(EMACS) -batch -l g3-path -l mk-tgnus -f install-tm-gnus $(TMDIR18) install-19: - ../inst-el $(TMDIR19) tm-gnus.el tm-gnus4.el - ../inst-elc $(TMDIR19) tm-gnus*.elc - + $(EMACS) -batch -l g4-path -l mk-tgnus -f install-tm-gnus $(TMDIR19) clean: -rm *.elc diff --git a/gnus/d-path b/gnus/d-path new file mode 100644 index 0000000..939a8a0 --- /dev/null +++ b/gnus/d-path @@ -0,0 +1,16 @@ +;;; -*-Emacs-Lisp-*- + +(setq load-path + (append + '("." ".." "../../tl" + ;; + ;; (ding) GNUS path + ;; + ;; please edit this + ;; + "/usr/local/lib/emacs/site-lisp/dgnus/lisp" + ;; + ) + load-path)) + + diff --git a/gnus/g3-path b/gnus/g3-path new file mode 100644 index 0000000..325f649 --- /dev/null +++ b/gnus/g3-path @@ -0,0 +1,17 @@ +;;; -*-Emacs-Lisp-*- + +;;; +;;; loadpath for GNUS 3 +;;; +(setq load-path + (append + '("." ".." "../../tl" + ;; + ;; (ding) GNUS path + ;; + ;; please edit this + ;; + ;;"/usr/local/lib/emacs/local.lisp/gnus-3.14.4" + ;; + ) + load-path)) diff --git a/gnus/g4-path b/gnus/g4-path new file mode 100644 index 0000000..00922bb --- /dev/null +++ b/gnus/g4-path @@ -0,0 +1,17 @@ +;;; -*-Emacs-Lisp-*- + +;;; +;;; loadpath for GNUS 4 +;;; +(setq load-path + (append + '("." ".." "../../tl" + ;; + ;; (ding) GNUS path + ;; + ;; please edit this + ;; + ;;"/usr/local/lib/emacs/local.lisp/gnus-4.1/lisp + ;; + ) + load-path)) diff --git a/gnus/mk-tgnus b/gnus/mk-tgnus new file mode 100644 index 0000000..2e9924c --- /dev/null +++ b/gnus/mk-tgnus @@ -0,0 +1,67 @@ +;;; -*-Emacs-Lisp-*- + +(defun compile-tm-gnus () + (require 'gnus) + (require 'tm-view) + (princ (format "%s\n" gnus-version)) + (if (string-match "(ding)" gnus-version) + (byte-compile-file "tm-dgnus.el") + (if (string-match "GNUS 3" gnus-version) + (byte-compile-file "tm-gnus3.el") + (byte-compile-file "tm-gnus4.el") + )) + (byte-compile-file "tm-gnus.el") + ) + +(defconst el-file-mode (+ (* 64 6)(* 8 4) 4)) + +(defun install-el (path file) + (let ((full-path (expand-file-name file path))) + (if (file-exists-p full-path) + (set-file-modes full-path el-file-mode) + ) + (copy-file file full-path t t) + (princ (format "%s -> %s\n" file path)) + )) + +(defun install-el-files (path &rest files) + (mapcar (function (lambda (file) + (if (file-exists-p file) + (install-el path file) + ))) + files)) + +(defun install-elc (path file) + (let ((full-path (expand-file-name file path))) + (copy-file file full-path t t) + (delete-file file) + (princ (format "%s -> %s\n" file path)) + )) + +(defun install-elc-files (path &rest files) + (mapcar (function (lambda (file) + (if (file-exists-p file) + (install-elc path file) + ))) + files)) + +(defun install-tm-gnus () + (let ((path (car command-line-args-left))) + (princ (format "%s\n" emacs-version)) + (if (< (string-to-int emacs-version) 19) + (progn + (install-el-files path + "tm-gnus.el" "tm-ognus.el" + "tm-gnus3.el" "tm-gnus4.el") + (install-elc-files path + "tm-gnus.elc" + "tm-gnus3.elc" "tm-gnus4.elc") + ) + (progn + (install-el-files path + "tm-gnus.el" "tm-dgnus.el" + "tm-ognus.el" "tm-gnus4.el") + (install-elc-files path + "tm-gnus.elc" "tm-dgnus.elc" + "tm-gnus4.elc") + )))) diff --git a/gnus/tgnus-bc.el b/gnus/tgnus-bc.el new file mode 100644 index 0000000..72b410b --- /dev/null +++ b/gnus/tgnus-bc.el @@ -0,0 +1,17 @@ +(require 'gnus) + +(setq load-path (append '("." ".." "../../tl") load-path)) + +(defun compile-tm-gnus () + (if (string-match "(ding)" gnus-version) + (byte-compile-file "tm-dgnus.el") + (if (string-match "GNUS 3" gnus-version) + (byte-compile-file "tm-gnus3.el") + (byte-compile-file "tm-gnus4.el") + )) + (byte-compile-file "tm-gnus.el") + ) + +(defun install-tm-gnus () + (print command-line-args-left) + ) diff --git a/gnus/tm-dgnus.el b/gnus/tm-dgnus.el index 5f1e3fd..e42a3e6 100644 --- a/gnus/tm-dgnus.el +++ b/gnus/tm-dgnus.el @@ -5,7 +5,7 @@ ;;; @ version ;;; (defconst tm-gnus/RCS-ID - "$Id: tm-dgnus.el,v 6.3 1995/05/31 04:34:43 morioka Exp $") + "$Id: tm-dgnus.el,v 6.4 1995/06/18 16:12:05 morioka Exp $") (defconst tm-gnus/version (concat (get-version-string tm-gnus/RCS-ID) " (ding)")) @@ -20,6 +20,16 @@ (autoload 'mime/decode-string "tiny-mime" "Decode MIME encoded-word." t) +;;; @ variables +;;; + +(defvar tm-gnus/original-article-display-hook gnus-article-display-hook) + +(defvar tm-gnus/decode-all t) + +(defvar tm-gnus/preview-buffer (concat "*Preview-" gnus-article-buffer "*")) + + ;;; @ command functions ;;; @@ -42,6 +52,110 @@ (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)) +(define-key gnus-summary-mode-map "\et" (function tm-gnus/toggle-mime)) + + +(defun gnus-summary-next-page (lines) + "Show next page of selected article. +If end of article, select next article. +Argument LINES specifies lines to be scrolled up." + (interactive "P") + (let ((article (gnus-summary-article-number)) + (endp nil)) + (if (or (null gnus-current-article) + (/= article gnus-current-article)) + ;; Selected subject is different from current article's. + (gnus-summary-display-article article) + (gnus-configure-windows 'article) + (pop-to-buffer gnus-summary-buffer) + (gnus-eval-in-buffer-window (cdr (assq 'article gnus-window-to-buffer)) + (setq endp (gnus-article-next-page lines))) + (cond ((and endp lines) + (message "End of message")) + ((and endp (null lines)) + (gnus-summary-next-unread-article))) + ))) + +(defun gnus-summary-scroll-up (lines) + "Scroll up (or down) one line current article. +Argument LINES specifies lines to be scrolled up (or down if negative)." + (interactive "p") + (gnus-set-global-variables) + (gnus-configure-windows 'article) + (or (gnus-summary-select-article nil nil 'pseudo) + (gnus-eval-in-buffer-window + (cdr (assq 'article gnus-window-to-buffer)) + (cond ((> lines 0) + (if (gnus-article-next-page lines) + (gnus-message 3 "End of message"))) + ((< lines 0) + (gnus-article-prev-page (- lines)))))) + (gnus-summary-recenter) + (gnus-summary-position-cursor)) + +(defun gnus-summary-prev-page (lines) + "Show previous page of selected article. +Argument LINES specifies lines to be scrolled down." + (interactive "P") + (gnus-set-global-variables) + (let ((article (gnus-summary-article-number))) + (gnus-configure-windows 'article) + (if (or (null gnus-current-article) + (null gnus-article-current) + (/= article (cdr gnus-article-current)) + (not (equal (car gnus-article-current) gnus-newsgroup-name))) + ;; Selected subject is different from current article's. + (gnus-summary-display-article article) + (gnus-summary-recenter) + (gnus-eval-in-buffer-window + (cdr (assq 'article gnus-window-to-buffer)) + (gnus-article-prev-page lines)))) + (gnus-summary-position-cursor)) + +(defun gnus-summary-toggle-header (arg) + "Show the headers if they are hidden, or hide them if they are shown. +If ARG is a positive number, show the entire header. +If ARG is a negative number, hide the unwanted header lines." + (interactive "P") + (gnus-set-global-variables) + (save-excursion + (set-buffer (cdr (assq 'article gnus-window-to-buffer))) + (let ((buffer-read-only nil)) + (if (numberp arg) + (if (> arg 0) (remove-text-properties (point-min) (point-max) + gnus-hidden-properties) + (if (< arg 0) (run-hooks 'gnus-article-display-hook))) + (if (text-property-any (point-min) (point-max) 'invisible t) + (if tm-gnus/decode-all + (let (mime-viewer/ignored-field-list) + (run-hooks 'gnus-article-display-hook) + ) + (remove-text-properties (point-min) (point-max) + gnus-hidden-properties) + ) + (let (gnus-have-all-headers) + (run-hooks 'gnus-article-display-hook) + )) + ) + (pop-to-buffer gnus-summary-buffer) + (set-window-point (get-buffer-window (current-buffer)) (point-min))))) + + +;; Set article window start at LINE, where LINE is the number of lines +;; from the head of the article. +(defun gnus-article-set-window-start (&optional line) + (let ((article-buffer (cdr (assq 'article gnus-window-to-buffer)))) + (set-window-start + (get-buffer-window article-buffer) + (save-excursion + (set-buffer article-buffer) + (goto-char (point-min)) + (if (not line) + (point-min) + (gnus-message 6 "Moved to bookmark") + (search-forward "\n\n" nil t) + (forward-line line) + (point)))))) ;;; @ summary filter @@ -70,13 +184,44 @@ ;;; (setq gnus-show-mime-method - (function - (lambda () - (let (buffer-read-only) - (mime/decode-message-header) - )))) - -(setq gnus-show-mime t) + (function + (lambda () + (let (buffer-read-only) + (mime/decode-message-header) + )))) + +(defun tm-gnus/set-mime-method (mode) + (if mode + (progn + (setq gnus-show-mime nil) + (setq gnus-article-display-hook + (list (function (lambda () + (mime/viewer-mode) + (gnus-set-mode-line 'article) + (set-buffer-modified-p nil) + (pop-to-buffer mime::preview/article-buffer) + )))) + (set-alist 'gnus-window-to-buffer 'article tm-gnus/preview-buffer) + ) + (setq gnus-show-mime t) + (setq gnus-article-display-hook tm-gnus/original-article-display-hook) + (set-alist 'gnus-window-to-buffer 'article gnus-article-buffer) + )) + +(tm-gnus/set-mime-method tm-gnus/decode-all) + +(defun tm-gnus/toggle-mime (arg) + "Toggle MIME processing mode. +With arg, turn MIME processing on if arg is positive." + (interactive "P") + (setq tm-gnus/decode-all + (if (null arg) + (not tm-gnus/decode-all) + arg)) + (gnus-set-global-variables) + (tm-gnus/set-mime-method tm-gnus/decode-all) + (gnus-summary-select-article gnus-show-all-headers 'force) + ) ;;; @ end diff --git a/gnus/tm-gnus4.el b/gnus/tm-gnus4.el index 50cca72..6ae4b5f 100644 --- a/gnus/tm-gnus4.el +++ b/gnus/tm-gnus4.el @@ -1,5 +1,5 @@ ;;; -;;; $Id: tm-gnus4.el,v 5.5 1995/01/13 20:48:16 morioka Exp morioka $ +;;; $Id: tm-gnus4.el,v 6.0 1995/06/19 21:33:39 morioka Exp $ ;;; (require 'tm-ognus) diff --git a/mh-e/tm-mh-e.el b/mh-e/tm-mh-e.el index 2d38dcd..5d14bfc 100644 --- a/mh-e/tm-mh-e.el +++ b/mh-e/tm-mh-e.el @@ -21,7 +21,7 @@ ;;; @ version ;;; (defconst tm-mh-e/RCS-ID - "$Id: tm-mh-e.el,v 6.10 1995/06/12 01:53:19 morioka Exp $") + "$Id: tm-mh-e.el,v 6.18 1995/06/20 21:07:39 morioka Exp $") (defconst tm-mh-e/version (get-version-string tm-mh-e/RCS-ID)) @@ -54,37 +54,43 @@ (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) + (setq buffer-read-only nil) + (erase-buffer) + (if mode + (progn + (let ((file-coding-system-for-read + (if (boundp 'MULE) *noconv*)) + kanji-fileio-code) + (insert-file-contents msg-filename) + ;; (goto-char (point-min)) + (while (re-search-forward "\r$" nil t) + (replace-match "") ) - (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) + (setq buffer-read-only t) (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) + (setq buffer-read-only t) + (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) @@ -117,15 +123,40 @@ With arg, turn MIME processing on if arg is positive." (if (null arg) (not tm-mh-e/decode-all) arg)) + (save-window-excursion + (switch-to-buffer mh-show-buffer) + (if (null tm-mh-e/decode-all) + (if (and mime::article/preview-buffer + (get-buffer mime::article/preview-buffer)) + (kill-buffer mime::article/preview-buffer) + ))) (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)) + (if mime::article/preview-buffer + (pop-to-buffer (save-excursion + (switch-to-buffer mh-show-buffer) + mime::article/preview-buffer)) + (tm-mh-e/view-message (mh-get-msg-num t))) (pop-to-buffer the-buf) ))) +(defun tm-mh-e/page-msg () + (interactive) + (if tm-mh-e/decode-all + (scroll-other-window) + (mh-page-msg) + )) + +(defun tm-mh-e/previous-page () + (interactive) + (if tm-mh-e/decode-all + (scroll-other-window (- (save-window-excursion + (other-window 1) + (window-height)))) + (mh-previous-page) + )) + (defun tm-mh-e/cite () (interactive) (if tm-mh-e/decode-all @@ -146,6 +177,9 @@ With arg, turn MIME processing on if arg is positive." ;;; @ for tm-view ;;; +(fset 'tm-mh-e/code-convert-region-to-emacs + (symbol-function 'mime/code-convert-region-to-emacs)) + (defun tm-mh-e/content-header-filter () (goto-char (point-min)) (while (and (re-search-forward @@ -160,8 +194,8 @@ With arg, turn MIME processing on if arg is positive." (match-beginning 0) ))) t))) - (mime/code-convert-region-to-emacs (point-min)(point-max) - mime/default-coding-system) + (tm-mh-e/code-convert-region-to-emacs (point-min)(point-max) + mime/default-coding-system) (mime/decode-message-header) ) @@ -258,18 +292,8 @@ With arg, turn MIME processing on if arg is positive." (interactive) (scroll-other-window -1) ))) -(define-key mh-folder-mode-map " " - (function (lambda () - (interactive) - (scroll-other-window) - ))) -(define-key mh-folder-mode-map "\177" - (function (lambda () - (interactive) - (scroll-other-window (- (save-window-excursion - (other-window 1) - (window-height)))) - ))) +(define-key mh-folder-mode-map " " (function tm-mh-e/page-msg)) +(define-key mh-folder-mode-map "\177" (function tm-mh-e/previous-page)) (add-hook 'mh-letter-mode-hook (function @@ -285,6 +309,10 @@ With arg, turn MIME processing on if arg is positive." 'mh-show-mode (function tm-mh-e/content-header-filter)) +(set-alist 'mime-viewer/code-converter-alist + 'mh-show-mode + (function tm-mh-e/code-convert-region-to-emacs)) + (run-hooks 'tm-mh-e-load-hook) (provide 'tm-mh-e) diff --git a/mh-e/tm-mh-e3.el b/mh-e/tm-mh-e3.el index 4aaa8f0..d4f65a7 100644 --- a/mh-e/tm-mh-e3.el +++ b/mh-e/tm-mh-e3.el @@ -1,10 +1,10 @@ ;;; -;;; $Id: tm-mh-e3.el,v 3.0 1995/06/11 13:25:56 morioka Exp $ +;;; $Id: tm-mh-e3.el,v 4.0 1995/06/18 16:26:37 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. +;;; to emulate mh-e 4.*. ;;; -;;; This module imports from mh-e 3.8 and 4.0. +;;; This module imports from mh-e 4.1. ;;; (require 'mh-e) @@ -20,6 +20,14 @@ The value of mh-show-mode-hook is called when a new message is displayed." (mh-set-mode-name "MH-Show") (run-hooks 'mh-show-mode-hook)) +(defun mh-start-of-uncleaned-message () + ;; position uninteresting headers off the top of the window + (let ((case-fold-search t)) + (re-search-forward + "^To:\\|^From:\\|^Subject:\\|^Date:" nil t) + (beginning-of-line) + (mh-recenter 0))) + (fset 'mh-show-msg (symbol-function 'mh-show)) (provide 'tm-mh-e3) diff --git a/tm-mule.el b/tm-mule.el index cd406f9..6acda3f 100644 --- a/tm-mule.el +++ b/tm-mule.el @@ -1,5 +1,5 @@ ;;; -;;; $Id: tm-mule.el,v 6.1 1995/06/11 13:28:21 morioka Exp $ +;;; $Id: tm-mule.el,v 6.2 1995/06/19 18:54:53 morioka Exp $ ;;; (require 'tl-list) @@ -49,6 +49,7 @@ ("ISO-8859-7" . *iso-8859-7*) ("ISO-8859-8" . *iso-8859-8*) ("ISO-8859-9" . *iso-8859-9*) + ("ISO-2022-INT-1" . *iso-2022-int-1*) )) (defvar mime/charset-lc-alist diff --git a/tm-view.el b/tm-view.el index 3b6874f..b1a33a3 100644 --- a/tm-view.el +++ b/tm-view.el @@ -22,7 +22,7 @@ ;;; (defconst mime-viewer/RCS-ID - "$Id: tm-view.el,v 6.50 1995/06/12 01:51:49 morioka Exp $") + "$Id: tm-view.el,v 6.54 1995/06/13 22:31:38 morioka Exp $") (defconst mime-viewer/version (get-version-string mime-viewer/RCS-ID)) (defconst mime/viewer-version mime-viewer/version) @@ -92,9 +92,33 @@ "application/octet-stream" nil "application/x-selection" "application/x-comment")) -(defvar mime-viewer/content-filter-alist - '(("text/plain" . mime-viewer/filter-text/plain) - (nil . mime-viewer/filter-text/plain))) +(defvar mime-viewer/content-subject-omitting-Content-Type-list + '("application/x-selection")) + +(defvar mime-viewer/uuencode-encoding-name-list '("x-uue" "x-uuencode")) + +(defvar mime-viewer/ignored-field-list + '("Received" "Return-Path" "Replied" "Errors-To" + "Lines" "Sender" "Path" "Nntp-Posting-Host" + "Content-Type" "Precedence")) + +(defvar mime-viewer/ignored-field-regexp) + +(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 "+\\)*")) + + +;;; @@ predicate functions +;;; (defun mime-viewer/header-visible-p (cnum cinfo &optional ctype) (or (eq cnum t) @@ -107,28 +131,28 @@ ))) (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) - ) - -(defun mime-viewer/default-content-filter (cnum cinfo ctype params subj) - ) + (let (ccinfo) + (or ctype + (setq ctype + (mime::content-info/type + (setq ccinfo (mime-article/cnum-to-cinfo cnum cinfo)) + )) + ) + (and (member ctype mime-viewer/default-showing-Content-Type-list) + (if (string-equal ctype "application/octet-stream") + (progn + (or ccinfo + (setq ccinfo (mime-article/cnum-to-cinfo cnum cinfo)) + ) + (member (mime::content-info/encoding ccinfo) + '(nil "7bit" "8bit")) + ) + t)) + )) -(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")) +;;; @@ content subject +;;; (defun mime-viewer/default-content-subject-function (cnum cinfo ctype params subj) @@ -151,12 +175,9 @@ (defvar mime-viewer/content-subject-function (function mime-viewer/default-content-subject-function)) -(defvar mime-viewer/ignored-field-list - '("Received" "Return-Path" "Replied" "Errors-To" - "Lines" "Sender" "Path" "Nntp-Posting-Host" - "Content-Type")) -(defvar mime-viewer/ignored-field-regexp) +;;; @ content header filter +;;; (defun mime-viewer/default-content-header-filter () (goto-char (point-min)) @@ -177,18 +198,29 @@ (defvar mime-viewer/content-header-filter-alist nil) -(defvar mime-viewer/decoding-mode "play" "MIME body decoding mode") +;;; @@ content filter +;;; -(defvar mime-viewer/file-name-char-regexp "[A-Za-z0-9+_-]") +(defvar mime-viewer/content-filter-alist + '(("text/plain" . mime-viewer/filter-text/plain) + (nil . mime-viewer/filter-text/plain))) -(defvar mime-viewer/file-name-regexp-1 - (concat mime-viewer/file-name-char-regexp "+\\." - mime-viewer/file-name-char-regexp "+")) +(defun mime-viewer/default-content-filter (cnum cinfo ctype params subj) + ) -(defvar mime-viewer/file-name-regexp-2 - (concat (regexp-* mime-viewer/file-name-char-regexp) - "\\(\\." mime-viewer/file-name-char-regexp "+\\)*")) + +;;; @@ content separator +;;; + +(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") + ))) ;;; @@ buffer local variables @@ -427,16 +459,24 @@ it is regarded as current-buffer. [tm-view]" )) (defun mime-viewer/get-subject (param) - (save-excursion - (save-restriction - (let (ret) - (or (and (setq ret (assoc "name" param)) - (message/strip-quoted-string (cdr ret)) - ) - (and (setq ret (assoc "x-name" param)) - (message/strip-quoted-string (cdr ret)) - ) - (progn + (if (member (cdr (assq 'encoding param)) + mime-viewer/uuencode-encoding-name-list) + (save-excursion + (or (if (re-search-forward "^begin [0-9]+ " nil t) + (if (looking-at ".+$") + (buffer-substring (match-beginning 0)(match-end 0)) + )) + "")) + (let (ret) + (or (and (setq ret (assoc "name" param)) + (message/strip-quoted-string (cdr ret)) + ) + (and (setq ret (assoc "x-name" param)) + (message/strip-quoted-string (cdr ret)) + ) + + (save-excursion + (save-restriction (narrow-to-region (point-min) (or (and (search-forward "\n\n" nil t) (match-beginning 0) @@ -849,9 +889,7 @@ it is regarded as current-buffer. [tm-view]" ;;; @ content filter ;;; -(defvar mime-viewer/code-converter-alist - '((mh-show-mode . mime/code-convert-region-to-emacs)) - ) +(defvar mime-viewer/code-converter-alist nil) (defun mime-viewer/default-code-convert-region (beg end charset &optional encoding)