X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=tm-view.el;h=767e49bda8b402eee4d0b48f9f7c87e8ea4594df;hb=f94c46d394e1304bcc35fee20db5523746cf7a7a;hp=0d88b18f07444989a95f62c09acf9a9e47e9357b;hpb=01504f7f328c9ac49e9720c85c0d80ea776d8415;p=elisp%2Ftm.git diff --git a/tm-view.el b/tm-view.el index 0d88b18..767e49b 100644 --- a/tm-view.el +++ b/tm-view.el @@ -4,11 +4,30 @@ ;;; Copyright (C) 1995 Free Software Foundation, Inc. ;;; Copyright (C) 1994,1995 MORIOKA Tomohiko ;;; -;;; Author: MORIOKA Tomohiko +;;; Author: MORIOKA Tomohiko +;;; modified by Steven L. Baur +;;; Maintainer: MORIOKA Tomohiko +;;; Created: 1994/7/13 (1994/8/31 obsolete tm-body.el) +;;; Version: $Revision: 7.32.1.2 $ ;;; Keywords: mail, news, MIME, multimedia ;;; ;;; This file is part of tm (Tools for MIME). ;;; +;;; This program is free software; you can redistribute it and/or +;;; modify it under the terms of the GNU General Public License as +;;; published by the Free Software Foundation; either version 2, or +;;; (at your option) any later version. +;;; +;;; This program is distributed in the hope that it will be useful, +;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;;; General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with This program. If not, write to the Free Software +;;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. +;;; +;;; Code: (require 'tl-str) (require 'tl-list) @@ -25,7 +44,7 @@ ;;; (defconst mime-viewer/RCS-ID - "$Id: tm-view.el,v 7.25 1995/11/15 13:57:33 morioka Exp $") + "$Id: tm-view.el,v 7.32.1.2 1995/12/10 20:29:06 morioka Exp $") (defconst mime-viewer/version (get-version-string mime-viewer/RCS-ID)) (defconst mime/viewer-version mime-viewer/version) @@ -37,8 +56,9 @@ (defvar mime/content-decoding-condition '(((type . "text/plain") (method "tm-plain" nil 'file 'type 'encoding 'mode 'name)) - ;;((type . "text/x-latex") - ;; (method "tm-latex" nil 'file 'type 'encoding 'mode 'name)) + ((type . "text/html") + (method "tm-html" nil 'file 'type 'encoding 'mode 'name) + (mode . "play")) ((type . "text/x-rot13-47") (method . mime-article/decode-caesar)) @@ -92,10 +112,13 @@ (defvar mime-viewer/content-subject-omitting-Content-Type-list '("application/x-selection")) +(defvar mime-viewer/content-subject-showing-Content-Type-list + '("application/pgp")) + (defvar mime-viewer/uuencode-encoding-name-list '("x-uue" "x-uuencode")) (defvar mime-viewer/ignored-field-list - '("Received" "Return-Path" "Replied" "Errors-To" + '(".*Received" "Return-Path" "Replied" "Errors-To" "Lines" "Sender" "Path" "Nntp-Posting-Host" "Content-Type" "Precedence" "X-Face" "Status" "X-VM-.*") @@ -194,8 +217,7 @@ Each elements are regexp of field-name. [tm-view.el]") (if (and (consp rcnum) (not (member ctype - mime-viewer/content-subject-omitting-Content-Type-list)) - ) + mime-viewer/content-subject-omitting-Content-Type-list))) (mime-viewer/insert-content-subject rcnum cinfo ctype params subj) )) @@ -253,15 +275,19 @@ Each elements are regexp of field-name. [tm-view.el]") ;;; @@ buffer local variables ;;; -(defvar mime/show-mode-old-window-configuration nil) -(defvar mime::preview/mother-buffer nil) - -(defvar mime::article/content-info nil) +;; for XEmacs (defvar mime::article/preview-buffer nil) +(defvar mime::article/code-converter nil) + +(make-variable-buffer-local 'mime::article/content-info) +(make-variable-buffer-local 'mime::article/preview-buffer) +(make-variable-buffer-local 'mime::article/code-converter) -(defvar mime::preview/article-buffer nil) -(defvar mime::preview/content-list nil) -(defvar mime::preview/original-major-mode nil) +(make-variable-buffer-local 'mime::preview/mother-buffer) +(make-variable-buffer-local 'mime::preview/content-list) +(make-variable-buffer-local 'mime::preview/article-buffer) +(make-variable-buffer-local 'mime::preview/original-major-mode) +(make-variable-buffer-local 'mime::preview/original-window-configuration) ;;; @@ quitting method @@ -322,10 +348,8 @@ The compressed face will be piped to this command.") (get-buffer ibuf) (set-buffer ibuf) )) - (make-variable-buffer-local 'mime::article/content-info) (setq mime::article/content-info (mime/parse-message ctl encoding)) (let ((ret (mime-viewer/make-preview-buffer obuf))) - (make-variable-buffer-local 'mime::article/preview-buffer) (setq mime::article/preview-buffer (car ret)) ret)) @@ -348,9 +372,7 @@ The compressed face will be piped to this command.") (setq bf (get-buffer-create obuf)) (set-buffer obuf) )) - (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") @@ -398,6 +420,14 @@ The compressed face will be piped to this command.") (if (mime-viewer/header-visible-p rcnum cinfo ctype) (mime-viewer/display-header beg he obuf) ) + (if (and (null rcnum) + (member + ctype mime-viewer/content-subject-showing-Content-Type-list)) + (save-excursion + (set-buffer obuf) + (goto-char (point-max)) + (mime-viewer/insert-content-subject rcnum cinfo ctype params subj) + )) (cond ((mime-viewer/body-visible-p rcnum cinfo ctype) (mime-viewer/display-body he end obuf rcnum cinfo ctype params subj encoding) @@ -570,7 +600,7 @@ The compressed face will be piped to this command.") ) dest)) -(defun mime::point-preview-content (p &optional pcl) +(defun mime-preview/point-pcinfo (p &optional pcl) (or pcl (setq pcl mime::preview/content-list) ) @@ -605,9 +635,13 @@ The compressed face will be piped to this command.") (defun mime-preview/decode-text-region (beg end charset encoding) (mime/decode-region encoding beg end) (let* ((mode mime::preview/original-major-mode) - (m (assq mode mime-viewer/code-converter-alist)) + (m (or (save-excursion + (set-buffer mime::preview/article-buffer) + mime::article/code-converter) + (cdr (assq mode mime-viewer/code-converter-alist)) + )) ) - (if (and m (fboundp (setq m (cdr m)))) + (if (and m (fboundp m)) (funcall m beg (point-max) charset encoding) (mime-viewer/default-code-convert-region beg (point-max) charset encoding) @@ -670,12 +704,65 @@ The compressed face will be piped to this command.") "q" (function mime-viewer/quit)) (define-key mime/viewer-mode-map "\C-c\C-x" (function mime-viewer/kill-buffer)) + (define-key mime/viewer-mode-map + "<" (function beginning-of-buffer)) + (define-key mime/viewer-mode-map + ">" (function end-of-buffer)) (if mouse-button-2 (define-key mime/viewer-mode-map mouse-button-2 (function tm:button-dispatcher)) ) + (if mouse-button-3 + (define-key mime/viewer-mode-map + mouse-button-3 (function mime-viewer/popup-menu)) + ) )) +(defvar mime-viewer/popup-menu-title "MIME Viewer Commands") +(defvar mime-viewer/popup-menu-items + '(("Move to upper content" . mime-viewer/up-content) + ("Move to previous content" . mime-viewer/previous-content) + ("Move to next content" . mime-viewer/next-content) + ("Scroll to previous content" . mime-viewer/scroll-down-content) + ("Scroll to next content" . mime-viewer/scroll-up-content) + ("Play Content" . mime-viewer/play-content) + ("Extract Content" . mime-viewer/extract-content) + ("Print" . mime-viewer/print-content) + ("Show X Face" . mime-viewer/display-x-face) + ) + "Popup Menu for MIME Viewer") + +(cond ((string-match "XEmacs\\|Lucid" emacs-version) + (defvar mime-viewer/popup-menu + (cons mime-viewer/popup-menu-title + (mapcar (function + (lambda (item) + (vector (car item)(cdr item) t) + )) + mime-viewer/popup-menu-items))) + (defun mime-viewer/popup-menu (event) + "Popup the menu in the MIME Viewer buffer" + (interactive "e") + (select-window (event-window event)) + (set-buffer (event-buffer event)) + (popup-menu 'mime-viewer/popup-menu)) + ) + ((>= emacs-major-version 19) + (defun mime-viewer/popup-menu (event) + (interactive "e") + (mouse-set-point event) + (let ((menu + (cons mime-viewer/popup-menu-title + (list (cons "Menu Items" mime-viewer/popup-menu-items)) + ))) + (let ((func (x-popup-menu event menu))) + (if func + (funcall func) + )) + )) + )) + + (defun mime/viewer-mode (&optional mother ctl encoding ibuf obuf) "Major mode for viewing MIME message. @@ -713,20 +800,17 @@ listed in key order: (set-buffer buf) (erase-buffer) ))) - (let ((ret (mime-viewer/setup-buffer ctl encoding ibuf obuf))) + (let ((ret (mime-viewer/setup-buffer ctl encoding ibuf obuf)) + (win-conf (current-window-configuration)) + ) (prog1 (switch-to-buffer (car ret)) + (setq mime::preview/original-window-configuration win-conf) (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::preview/mother-buffer) (setq mime::preview/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 @@ -744,7 +828,7 @@ listed in key order: (defun mime-preview/point-content-number (point) (save-window-excursion - (let ((pc (mime::point-preview-content (point))) + (let ((pc (mime-preview/point-pcinfo (point))) cinfo) (switch-to-buffer (mime::preview-content-info/buffer pc)) (setq cinfo (mime::preview-content-info/content-info pc)) @@ -793,7 +877,7 @@ listed in key order: (defun mime-viewer/up-content () (interactive) - (let ((pc (mime::point-preview-content (point))) cinfo + (let ((pc (mime-preview/point-pcinfo (point))) cinfo (the-buf (current-buffer)) rcnum r) (switch-to-buffer (mime::preview-content-info/buffer pc)) @@ -866,50 +950,64 @@ listed in key order: (or h (setq h (- (window-height) 1)) ) - (let ((pcl mime::preview/content-list) - (p (point)) - np beg) - (setq np - (or (catch 'tag - (while pcl - (setq beg (mime::preview-content-info/point-min (car pcl))) - (if (< p beg) - (throw 'tag beg) - ) - (setq pcl (cdr pcl)) - )) - (point-max))) - (forward-line h) - (if (> (point) np) - (goto-char np) - ) - ;;(show-subtree) - )) + (if (= (point) (point-max)) + (let ((f (assq mime::preview/original-major-mode + mime-viewer/over-to-next-method-alist))) + (if f + (funcall (cdr f)) + )) + (let ((pcl mime::preview/content-list) + (p (point)) + np beg) + (setq np + (or (catch 'tag + (while pcl + (setq beg (mime::preview-content-info/point-min (car pcl))) + (if (< p beg) + (throw 'tag beg) + ) + (setq pcl (cdr pcl)) + )) + (point-max))) + (forward-line h) + (if (> (point) np) + (goto-char np) + ) + ;;(show-subtree) + )) + ) (defun mime-viewer/scroll-down-content (&optional h) (interactive) (or h (setq h (- (window-height) 1)) ) - (let ((pcl mime::preview/content-list) - (p (point)) - pp beg) - (setq pp - (or (let ((i (- (length pcl) 1))) - (catch 'tag - (while (> i 0) - (setq beg (mime::preview-content-info/point-min - (nth i pcl))) - (if (> p beg) - (throw 'tag beg) - ) - (setq i (- i 1)) - ))) - (point-min))) - (forward-line (- h)) - (if (< (point) pp) - (goto-char pp) - ))) + (if (= (point) (point-min)) + (let ((f (assq mime::preview/original-major-mode + mime-viewer/over-to-previous-method-alist))) + (if f + (funcall (cdr f)) + )) + (let ((pcl mime::preview/content-list) + (p (point)) + pp beg) + (setq pp + (or (let ((i (- (length pcl) 1))) + (catch 'tag + (while (> i 0) + (setq beg (mime::preview-content-info/point-min + (nth i pcl))) + (if (> p beg) + (throw 'tag beg) + ) + (setq i (- i 1)) + ))) + (point-min))) + (forward-line (- h)) + (if (< (point) pp) + (goto-char pp) + ))) + ) (defun mime-viewer/next-line-content () (interactive) @@ -928,7 +1026,7 @@ listed in key order: ) (or buf (setq buf (mime::preview-content-info/buffer - (mime::point-preview-content (point)))) + (mime-preview/point-pcinfo (point)))) ) (let ((r (progn (switch-to-buffer buf)