X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=tm-view.el;h=1cb26dafa03eae37b46b8fbc89760e8cee360b9e;hb=c6b287dbd7789726678fcdc1ec497bdda703e8a6;hp=319ff98cc99652aef23b48b1aee357e79147bc9d;hpb=b5ecf144fab194dcdc3c2e339bf7d992ddb0d380;p=elisp%2Ftm.git diff --git a/tm-view.el b/tm-view.el index 319ff98..1cb26da 100644 --- a/tm-view.el +++ b/tm-view.el @@ -8,7 +8,7 @@ ;;; modified by Steven L. Baur ;;; Maintainer: MORIOKA Tomohiko ;;; Created: 1994/7/13 (1994/8/31 obsolete tm-body.el) -;;; Version: $Revision: 7.61 $ +;;; Version: $Revision: 7.66 $ ;;; Keywords: mail, news, MIME, multimedia ;;; ;;; This file is part of tm (Tools for MIME). @@ -45,7 +45,7 @@ ;;; (defconst mime-viewer/RCS-ID - "$Id: tm-view.el,v 7.61 1996/05/15 16:52:21 morioka Exp $") + "$Id: tm-view.el,v 7.66 1996/07/01 23:42:12 morioka Exp $") (defconst mime-viewer/version (get-version-string mime-viewer/RCS-ID)) (defconst mime/viewer-version mime-viewer/version) @@ -113,10 +113,10 @@ "application/octet-stream" "application/x-selection" "application/x-comment")) -(defvar mime-viewer/content-subject-omitting-Content-Type-list +(defvar mime-viewer/content-button-ignored-ctype-list '("application/x-selection")) -(defvar mime-viewer/content-subject-showing-Content-Type-list +(defvar mime-viewer/content-button-visible-ctype-list '("application/pgp")) (defvar mime-viewer/uuencode-encoding-name-list '("x-uue" "x-uuencode")) @@ -136,7 +136,7 @@ Each elements are regexp of field-name. [tm-view.el]") ":")) (defvar mime-viewer/visible-field-list - '("Dnas.*") + '("Dnas.*" "Message-Id") "All fields that match this list will be displayed in MIME preview buffer. Each elements are regexp of field-name. [tm-view.el]") @@ -193,65 +193,69 @@ Each elements are regexp of field-name. [tm-view.el]") )) -;;; @@ content subject +;;; @@ content button ;;; -(defun mime-preview/insert-content-subject +(defun mime-preview/insert-content-button (rcnum cinfo ctype params subj encoding) (save-restriction (narrow-to-region (point)(point)) - (insert - (let ((access-type (assoc "access-type" params)) - (charset (assoc "charset" params)) - (num (or (assoc-value "x-part-number" params) - (if (consp rcnum) - (mapconcat (function - (lambda (num) - (format "%s" (1+ num)) - )) - (reverse rcnum) ".") - "0")) - )) - (cond (access-type - (let ((server (assoc "server" params))) - (setq access-type (cdr access-type)) - (if server - (format "[%s %s ([%s] %s)]\n" num subj - access-type (cdr server)) - (let ((site (assoc-value "site" params)) - (dir (assoc-value "directory" params)) - ) - (format "[%s %s ([%s] %s:%s)]\n" num subj - access-type site dir) - ))) - ) - ((setq charset (cdr charset)) - (if encoding - (format "[%s %s (%s; %s <%s>)]\n" - num subj ctype charset encoding) - (format "[%s %s (%s; %s)]\n" num subj ctype charset) - ) - ) - (t - (format "[%s %s (%s)]\n" num subj ctype) - ) - ))) + (let ((access-type (assoc "access-type" params)) + (charset (assoc "charset" params)) + (num (or (assoc-value "x-part-number" params) + (if (consp rcnum) + (mapconcat (function + (lambda (num) + (format "%s" (1+ num)) + )) + (reverse rcnum) ".") + "0")) + )) + (cond (access-type + (let ((server (assoc "server" params))) + (setq access-type (cdr access-type)) + (if server + (insert (format "[%s %s ([%s] %s)]\n" num subj + access-type (cdr server))) + (let ((site (assoc-value "site" params)) + (dir (assoc-value "directory" params)) + ) + (insert (format "[%s %s ([%s] %s:%s)]\n" num subj + access-type site dir)) + ))) + ) + (t + (insert (concat "[" num " " subj)) + (let ((rest + (if (setq charset (cdr charset)) + (if encoding + (format " <%s; %s (%s)>]\n" + ctype charset encoding) + (format " <%s; %s>]\n" ctype charset) + ) + (format " <%s>]\n" ctype) + ))) + (if (>= (+ (current-column)(length rest))(window-width)) + (setq rest (concat "\n\t" rest)) + ) + (insert rest) + )))) (tm:add-button (point-min)(1- (point-max)) (function mime-viewer/play-content)) )) -(defun mime-preview/default-content-subject-function +(defun mime-preview/default-content-button-function (rcnum cinfo ctype params subj encoding) (if (and (consp rcnum) (not (member ctype - mime-viewer/content-subject-omitting-Content-Type-list))) - (mime-preview/insert-content-subject + mime-viewer/content-button-ignored-ctype-list))) + (mime-preview/insert-content-button rcnum cinfo ctype params subj encoding) )) -(defvar mime-preview/content-subject-function - (function mime-preview/default-content-subject-function)) +(defvar mime-preview/content-button-function + (function mime-preview/default-content-button-function)) ;;; @@ content header filter @@ -298,7 +302,7 @@ Each elements are regexp of field-name. [tm-view.el]") ;;; @@ content separator ;;; -(defun mime-viewer/default-content-separator (rcnum cinfo ctype params subj) +(defun mime-preview/default-content-separator (rcnum cinfo ctype params subj) (if (and (not (mime-viewer/header-visible-p rcnum cinfo ctype)) (not (mime-viewer/body-visible-p rcnum cinfo ctype)) ) @@ -471,17 +475,17 @@ The compressed face will be piped to this command.") (set-buffer obuf) (setq nb (point)) (narrow-to-region nb nb) - (funcall mime-preview/content-subject-function + (funcall mime-preview/content-button-function rcnum cinfo ctype params subj encoding) (if (mime-viewer/header-visible-p rcnum cinfo ctype) (mime-preview/display-header beg he) ) (if (and (null rcnum) (member - ctype mime-viewer/content-subject-showing-Content-Type-list)) + ctype mime-viewer/content-button-visible-ctype-list)) (save-excursion (goto-char (point-max)) - (mime-preview/insert-content-subject + (mime-preview/insert-content-button rcnum cinfo ctype params subj encoding) )) (cond ((mime-viewer/body-visible-p rcnum cinfo ctype) @@ -495,10 +499,10 @@ The compressed face will be piped to this command.") (null (mime::content-info/children cinfo)) ) (goto-char (point-max)) - (mime-preview/insert-content-subject + (mime-preview/insert-content-button rcnum cinfo ctype params subj encoding) )) - (mime-viewer/default-content-separator rcnum cinfo ctype params subj) + (mime-preview/default-content-separator rcnum cinfo ctype params subj) (prog1 (progn (setq ne (point-max)) @@ -676,85 +680,94 @@ The compressed face will be piped to this command.") ) "Menu for MIME Viewer") -(defvar mime/viewer-mode-map nil) -(if (null mime/viewer-mode-map) +(if running-xemacs (progn - (setq mime/viewer-mode-map (make-keymap)) - (suppress-keymap mime/viewer-mode-map) - (define-key mime/viewer-mode-map - "u" (function mime-viewer/up-content)) - (define-key mime/viewer-mode-map - "p" (function mime-viewer/previous-content)) - (define-key mime/viewer-mode-map - "n" (function mime-viewer/next-content)) - (define-key mime/viewer-mode-map - " " (function mime-viewer/scroll-up-content)) - (define-key mime/viewer-mode-map - "\M- " (function mime-viewer/scroll-down-content)) - (define-key mime/viewer-mode-map - "\177" (function mime-viewer/scroll-down-content)) - (define-key mime/viewer-mode-map - "\C-m" (function mime-viewer/next-line-content)) - (define-key mime/viewer-mode-map - "\C-\M-m" (function mime-viewer/previous-line-content)) - (define-key mime/viewer-mode-map - "v" (function mime-viewer/play-content)) - (define-key mime/viewer-mode-map - "e" (function mime-viewer/extract-content)) - (define-key mime/viewer-mode-map - "\C-c\C-p" (function mime-viewer/print-content)) - (define-key mime/viewer-mode-map - "x" (function mime-viewer/display-x-face)) - (define-key mime/viewer-mode-map - "a" (function mime-viewer/follow-content)) - (define-key mime/viewer-mode-map - "q" (function mime-viewer/quit)) - (define-key mime/viewer-mode-map - "h" (function mime-viewer/show-summary)) - (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)) - ) - (cond (running-xemacs - (defvar mime-viewer/xemacs-popup-menu - (cons mime-viewer/menu-title - (mapcar (function - (lambda (item) - (vector (nth 1 item)(nth 2 item) t) - )) - mime-viewer/menu-list))) - (defun mime-viewer/xemacs-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/xemacs-popup-menu)) - (define-key mime/viewer-mode-map - mouse-button-3 (function mime-viewer/xemacs-popup-menu)) - ) - ((>= emacs-major-version 19) - (define-key mime/viewer-mode-map [menu-bar mime-view] - (cons mime-viewer/menu-title - (make-sparse-keymap mime-viewer/menu-title))) - (mapcar (function - (lambda (item) - (define-key mime/viewer-mode-map - (vector 'menu-bar 'mime-view (car item)) - (cons (nth 1 item)(nth 2 item)) - ) - )) - (reverse mime-viewer/menu-list) - ) - )) + (defvar mime-viewer/xemacs-popup-menu + (cons mime-viewer/menu-title + (mapcar (function + (lambda (item) + (vector (nth 1 item)(nth 2 item) t) + )) + mime-viewer/menu-list))) + (defun mime-viewer/xemacs-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/xemacs-popup-menu)) )) -(defun mime/viewer-mode (&optional mother ctl encoding ibuf obuf) +(defun mime-viewer/define-keymap (&optional mother) + (let ((mime/viewer-mode-map (if mother + (copy-keymap mother) + (make-keymap)))) + (suppress-keymap mime/viewer-mode-map) + (define-key mime/viewer-mode-map + "u" (function mime-viewer/up-content)) + (define-key mime/viewer-mode-map + "p" (function mime-viewer/previous-content)) + (define-key mime/viewer-mode-map + "n" (function mime-viewer/next-content)) + (define-key mime/viewer-mode-map + " " (function mime-viewer/scroll-up-content)) + (define-key mime/viewer-mode-map + "\M- " (function mime-viewer/scroll-down-content)) + (define-key mime/viewer-mode-map + "\177" (function mime-viewer/scroll-down-content)) + (define-key mime/viewer-mode-map + "\C-m" (function mime-viewer/next-line-content)) + (define-key mime/viewer-mode-map + "\C-\M-m" (function mime-viewer/previous-line-content)) + (define-key mime/viewer-mode-map + "v" (function mime-viewer/play-content)) + (define-key mime/viewer-mode-map + "e" (function mime-viewer/extract-content)) + (define-key mime/viewer-mode-map + "\C-c\C-p" (function mime-viewer/print-content)) + (define-key mime/viewer-mode-map + "x" (function mime-viewer/display-x-face)) + (define-key mime/viewer-mode-map + "a" (function mime-viewer/follow-content)) + (define-key mime/viewer-mode-map + "q" (function mime-viewer/quit)) + (define-key mime/viewer-mode-map + "h" (function mime-viewer/show-summary)) + (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)) + (define-key mime/viewer-mode-map + "?" (function describe-mode)) + (if mouse-button-2 + (define-key mime/viewer-mode-map + mouse-button-2 (function tm:button-dispatcher)) + ) + (cond (running-xemacs + (define-key mime/viewer-mode-map + mouse-button-3 (function mime-viewer/xemacs-popup-menu)) + ) + ((>= emacs-major-version 19) + (define-key mime/viewer-mode-map [menu-bar mime-view] + (cons mime-viewer/menu-title + (make-sparse-keymap mime-viewer/menu-title))) + (mapcar (function + (lambda (item) + (define-key mime/viewer-mode-map + (vector 'menu-bar 'mime-view (car item)) + (cons (nth 1 item)(nth 2 item)) + ) + )) + (reverse mime-viewer/menu-list) + ) + )) + (use-local-map mime/viewer-mode-map) + (run-hooks 'mime-viewer/define-keymap-hook) + )) + +(defun mime/viewer-mode (&optional mother ctl encoding ibuf obuf + mother-keymap) "Major mode for viewing MIME message. Here is a list of the standard keys for mime/viewer-mode. @@ -773,16 +786,11 @@ M-RET Move to previous line v Decode current content as `play mode' e Decode current content as `extract mode' C-c C-p Decode current content as `print mode' -f Display X-Face +a Followup to current content. +x Display X-Face q Quit button-2 Move to point under the mouse cursor and decode current content as `play mode' - - -Here are all the commands with their current binding, -listed in key order: - -\\{mime/viewer-mode-map} " (interactive) (let ((buf (get-buffer mime/output-buffer-name))) @@ -801,7 +809,7 @@ listed in key order: (progn (setq mime::preview/mother-buffer mother) )) - (use-local-map mime/viewer-mode-map) + (mime-viewer/define-keymap mother-keymap) (setq mime::preview/content-list (nth 1 ret)) (goto-char (let ((ce (mime::preview-content-info/point-max