X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=tm-vm.el;h=f0effa640254f7026980719075c3c1da54130a14;hb=20d8199d314548d935020ae3ea90d7031e9c007c;hp=574b5a831c2f84ed99e61a34453d9555578a9198;hpb=7ea8c7377706103d8f9afc39e3f29e5454ef6404;p=elisp%2Ftm.git diff --git a/tm-vm.el b/tm-vm.el index 574b5a8..f0effa6 100644 --- a/tm-vm.el +++ b/tm-vm.el @@ -1,51 +1,67 @@ ;;; -;;; tm-vm.el : tm-MUA for vm +;;; tm-vm.el --- tm-MUA for VM ;;; -;;; by MASUTANI Yasuhiro -;;; modified by SHIONO +;;; Copyright (C) 1995 Free Software Foundation, Inc. +;;; +;;; Author: MASUTANI Yasuhiro +;;; and Kenji Wakamiya +;;; modified by SHIONO , +;;; Steinar Bang , +;;; and MORIOKA Tomohiko +;;; Keywords: news, MIME, multimedia, multilingual, encoded-word ;;; -;;; Plese insert (load "tm-vm") in .vm or .emacs. +;;; This file is part of tm (Tools for MIME). +;;; +;;; This version is tested under VM-5.76 with tm-6.20. +;;; +;;; Plese insert (require 'tm-vm) in your .vm or .emacs. ;;; -(provide 'tm-vm) - -(require 'tl-list) (require 'tm-view) +(require 'vm) (defconst tm-vm/RCS-ID - "$Id: tm-vm.el,v 1.5 1994/11/01 16:30:12 morioka Exp $") + "$Id: tm-vm.el,v 7.0 1995/10/03 05:04:35 morioka Exp $") (defconst tm-vm/version (get-version-string tm-vm/RCS-ID)) (define-key vm-mode-map "Z" 'tm-vm/view-message) +(define-key vm-mode-map "T" 'tm-vm/decode-message-header) -(set-alist 'mime/go-to-top-node-method-alist +(set-alist 'mime-viewer/quitting-method-alist 'vm-mode 'tm-vm/quit-view-message) -(set-alist 'mime/go-to-top-node-method-alist +(set-alist 'mime-viewer/quitting-method-alist 'vm-virtual-mode 'tm-vm/quit-view-message) -(defun tm-vm/quit-view-message() - (mime/exit-view-mode) - (let ((w (get-buffer-window mime/output-buffer-name))) - (if w (delete-window w))) - (vm-display vm-summary-buffer t - '(mime/exit-view-mode) - '(this-command)) - (vm-widen-page) - (goto-char (point-max)) - (widen) - (narrow-to-region (point) - (vm-vheaders-of - (car vm-message-pointer))) - (goto-char (point-min)) - (if vm-honor-page-delimiters - (vm-narrow-to-page)) - (select-window (get-buffer-window vm-summary-buffer))) + +;;; @ for MIME header +;;; +;; If you don't use tiny-mime patch for VM (by RIKITAKE Kenji +;; ), please use following definition: + +;; (setq vm-summary-format "%n %*%a %-17.17F %-3.3m %2d %4l/%-5c, %I\"%UA\"\n") +;; (defun vm-summary-function-A (m) +;; (mime/decode-encoded-words-string (vm-su-subject m))) + + +;;; @ functions +;;; + +(defun tm-vm/quit-view-message () + "Quit MIME-viewer and go back to VM. +This function is called by `mime-viewer/quit' command via +`mime-viewer/quitting-method-alist'." + (mime-viewer/kill-buffer) + (if (get-buffer mime/output-buffer-name) + (bury-buffer mime/output-buffer-name)) + (vm-select-folder-buffer) + (vm-display (current-buffer) t '(mime-viewer/quit mime-viewer/up-content) + '(mime-viewer/quit reading-message))) (defun tm-vm/view-message () - "Decode and view MIME message for VM" + "Decode and view MIME encoded message, under VM." (interactive) (vm-follow-summary-cursor) (vm-select-folder-buffer) @@ -53,10 +69,75 @@ (vm-error-if-folder-empty) (vm-display (current-buffer) t '(tm-vm/view-message) '(tm-vm/view-mesage reading-message)) - (vm-widen-page) - (goto-char (point-max)) - (widen) - (narrow-to-region (point) (vm-start-of (car vm-message-pointer))) - (goto-char (point-min)) - (select-window (vm-get-buffer-window (current-buffer))) - (mime/viewer-mode)) + (let* ((mp (car vm-message-pointer)) + (ct (vm-get-header-contents mp "Content-Type:")) + (cte (vm-get-header-contents mp "Content-Transfer-Encoding:")) + (exposed (= (point-min) (vm-start-of mp)))) + (save-restriction + (vm-widen-page) + ;; vm-widen-page hides exposed header if pages are delimited. + ;; So, here we expose it again. + (if exposed + (narrow-to-region (vm-start-of mp) (point-max))) + (select-window (vm-get-buffer-window (current-buffer))) + (mime/viewer-mode nil + (mime/parse-Content-Type (or ct "")) + cte) + ))) + +(defun tm-vm/decode-message-header (&optional count) + "Decode MIME header of current message through tiny-mime. +Numeric prefix argument COUNT means to decode the current message plus +the next COUNT-1 messages. A negative COUNT means decode the current +message and the previous COUNT-1 messages. +When invoked on marked messages (via vm-next-command-uses-marks), +all marked messages are affected, other messages are ignored." + (interactive "p") + (or count (setq count 1)) + (vm-follow-summary-cursor) + (vm-select-folder-buffer) + (vm-check-for-killed-summary) + (vm-error-if-folder-empty) + (vm-error-if-folder-read-only) + (let ((mlist (vm-select-marked-or-prefixed-messages count)) + (realm nil) + (vlist nil) + (vbufs nil)) + (save-excursion + (while mlist + (setq realm (vm-real-message-of (car mlist))) + ;; Go to real folder of this message. + ;; But maybe this message is already real message... + (set-buffer (vm-buffer-of realm)) + (let ((buffer-read-only nil)) + (vm-save-restriction + (narrow-to-region (vm-headers-of realm) (vm-text-of realm)) + (mime/decode-message-header)) + (let ((vm-message-pointer (list realm)) + (last-command nil)) + (vm-discard-cached-data)) + ;; Mark each virtual and real message for later summary + ;; update. + (setq vlist (cons realm (vm-virtual-messages-of realm))) + (while vlist + (vm-mark-for-summary-update (car vlist)) + ;; Remember virtual and real folders related this message, + ;; for later display update. + (or (memq (vm-buffer-of (car vlist)) vbufs) + (setq vbufs (cons (vm-buffer-of (car vlist)) vbufs))) + (setq vlist (cdr vlist))) + (if (eq vm-flush-interval t) + (vm-stuff-virtual-attributes realm) + (vm-set-modflag-of realm t))) + (setq mlist (cdr mlist))) + ;; Update mail-buffers and summaries. + (while vbufs + (set-buffer (car vbufs)) + (vm-preview-current-message) + (setq vbufs (cdr vbufs)))))) + + +;;; @ end +;;; + +(provide 'tm-vm)