comparison lisp/tm/tm-vm.el @ 22:8fc7fe29b841 r19-15b94

Import from CVS: tag r19-15b94
author cvs
date Mon, 13 Aug 2007 08:50:29 +0200
parents 859a2309aef8
children 7e54bd776075
comparison
equal deleted inserted replaced
21:b88636d63495 22:8fc7fe29b841
7 ;; MORIOKA Tomohiko <morioka@jaist.ac.jp> 7 ;; MORIOKA Tomohiko <morioka@jaist.ac.jp>
8 ;; Shuhei KOBAYASHI <shuhei-k@jaist.ac.jp> 8 ;; Shuhei KOBAYASHI <shuhei-k@jaist.ac.jp>
9 ;; Oscar Figueiredo <Oscar.Figueiredo@di.epfl.ch> 9 ;; Oscar Figueiredo <Oscar.Figueiredo@di.epfl.ch>
10 ;; Maintainer: Oscar Figueiredo <Oscar.Figueiredo@di.epfl.ch> 10 ;; Maintainer: Oscar Figueiredo <Oscar.Figueiredo@di.epfl.ch>
11 ;; Created: 1994/10/29 11 ;; Created: 1994/10/29
12 ;; Version: $Revision: 1.4 $ 12 ;; Version: $Revision: 1.5 $
13 ;; Keywords: mail, MIME, multimedia, multilingual, encoded-word 13 ;; Keywords: mail, MIME, multimedia, multilingual, encoded-word
14 14
15 ;; This file is part of tm (Tools for MIME). 15 ;; This file is part of tm (Tools for MIME).
16 16
17 ;; This program is free software; you can redistribute it and/or 17 ;; This program is free software; you can redistribute it and/or
101 These hooks are run in the MIME-Preview buffer.") 101 These hooks are run in the MIME-Preview buffer.")
102 102
103 ;;; @@ System/Information variables 103 ;;; @@ System/Information variables
104 104
105 (defconst tm-vm/RCS-ID 105 (defconst tm-vm/RCS-ID
106 "$Id: tm-vm.el,v 1.4 1997/02/09 23:51:48 steve Exp $") 106 "$Id: tm-vm.el,v 1.5 1997/02/16 01:29:35 steve Exp $")
107 (defconst tm-vm/version (get-version-string tm-vm/RCS-ID)) 107 (defconst tm-vm/version (get-version-string tm-vm/RCS-ID))
108 108
109 ; Ensure vm-menu-mail-menu gets properly defined *before* tm-vm/vm-emulation-map 109 ; Ensure vm-menu-mail-menu gets properly defined *before* tm-vm/vm-emulation-map
110 ; since it contains a call to vm-menu-initialize-vm-mode-menu-map 110 ; since it contains a call to vm-menu-initialize-vm-mode-menu-map
111 (setq vm-menu-mail-menu 111 (setq vm-menu-mail-menu
309 (if (stringp full-name) 309 (if (stringp full-name)
310 (cons (mime-eword/decode-string full-name) 310 (cons (mime-eword/decode-string full-name)
311 (cdr ret)) 311 (cdr ret))
312 ret))) 312 ret)))
313 313
314 (or (fboundp 'tm:vm-su-subject) 314 (defadvice vm-su-subject (after tm activate)
315 (fset 'tm:vm-su-subject (symbol-function 'vm-su-subject)) 315 "MIME decoding support through TM added."
316 ) 316 (setq ad-return-value (mime-eword/decode-string ad-return-value)))
317 (defun vm-su-subject (m) 317
318 (mime-eword/decode-string (tm:vm-su-subject m)) 318 (defadvice vm-su-full-name (after tm activate)
319 ) 319 "MIME decoding support through TM added."
320 320 (setq ad-return-value (mime-eword/decode-string ad-return-value)))
321 (or (fboundp 'tm:vm-su-full-name) 321
322 (fset 'tm:vm-su-full-name (symbol-function 'vm-su-full-name)) 322 (defadvice vm-su-to-names (after tm activate)
323 ) 323 "MIME decoding support through TM added."
324 (defun vm-su-full-name (m) 324 (setq ad-return-value (mime-eword/decode-string ad-return-value)))
325 (mime-eword/decode-string (tm:vm-su-full-name m)) 325
326 )
327
328 (or (fboundp 'tm:vm-su-to-names)
329 (fset 'tm:vm-su-to-names (symbol-function 'vm-su-to-names))
330 )
331 (defun vm-su-to-names (m)
332 (mime-eword/decode-string (tm:vm-su-to-names m))
333 )
334 ;;;
335 )) 326 ))
336 327
337 (defun tm-vm/decode-message-header (&optional count) 328 (defun tm-vm/decode-message-header (&optional count)
338 "Decode MIME header of current message. 329 "Decode MIME header of current message.
339 Numeric prefix argument COUNT means to decode the current message plus 330 Numeric prefix argument COUNT means to decode the current message plus
562 (mwin 553 (mwin
563 ;; folder buffer is already displayed. 554 ;; folder buffer is already displayed.
564 ) 555 )
565 (t 556 (t
566 ;; don't display if neither mwin nor pwin was displayed before. 557 ;; don't display if neither mwin nor pwin was displayed before.
567 ))) 558 )))))
568 (set-buffer mbuf)))
569 559
570 (defun tm-vm/preview-current-message () 560 (defun tm-vm/preview-current-message ()
571 "Either preview message (view first lines only) or MIME-Preview it. 561 "Either preview message (view first lines only) or MIME-Preview it.
572 The message is previewed if message previewing is enabled see vm-preview-lines. 562 The message is previewed if message previewing is enabled see vm-preview-lines.
573 If not, MIME-Preview current message (ie. parse MIME 563 If not, MIME-Preview current message (ie. parse MIME
821 (t 811 (t
822 (tm-vm/save-window-excursion 812 (tm-vm/save-window-excursion
823 (select-window pwin) 813 (select-window pwin)
824 (set-buffer pbuf) 814 (set-buffer pbuf)
825 (if (pos-visible-in-window-p (point-max) pwin) 815 (if (pos-visible-in-window-p (point-max) pwin)
826 (vm-next-message) 816 (if vm-auto-next-message
817 (vm-next-message))
827 ;; not at the end of message. scroll preview buffer only. 818 ;; not at the end of message. scroll preview buffer only.
828 (scroll-up) 819 (scroll-up)
829 (tm-vm/howl-if-eom)) 820 (tm-vm/howl-if-eom))
830 )))) 821 ))))
831 ) 822 )
885 ad-do-it 876 ad-do-it
886 (vm-follow-summary-cursor) 877 (vm-follow-summary-cursor)
887 (vm-select-folder-buffer) 878 (vm-select-folder-buffer)
888 (vm-check-for-killed-summary) 879 (vm-check-for-killed-summary)
889 (vm-error-if-folder-empty) 880 (vm-error-if-folder-empty)
890 (let ((mbuf (current-buffer)) 881 (let ((pbuf (and mime::article/preview-buffer
891 (pbuf (and mime::article/preview-buffer
892 (get-buffer mime::article/preview-buffer)))) 882 (get-buffer mime::article/preview-buffer))))
893 (if (null pbuf) 883 (if (null pbuf)
894 (progn 884 (progn
895 (tm-vm/preview-current-message) 885 (tm-vm/preview-current-message)
896 (setq pbuf (get-buffer mime::article/preview-buffer)) 886 (setq pbuf (get-buffer mime::article/preview-buffer))
897 )) 887 ))
898 (vm-display mbuf t '(vm-beginning-of-message) 888 (vm-display (current-buffer) t '(vm-beginning-of-message)
899 '(vm-beginning-of-message reading-message)) 889 '(vm-beginning-of-message reading-message))
900 (tm-vm/display-preview-buffer) 890 (tm-vm/display-preview-buffer)
901 (set-buffer pbuf)
902 (tm-vm/save-window-excursion 891 (tm-vm/save-window-excursion
903 (select-window (vm-get-buffer-window pbuf)) 892 (select-window (vm-get-visible-buffer-window pbuf))
904 (push-mark) 893 (push-mark)
905 (goto-char (point-min)) 894 (goto-char (point-min))
895 (vm-display (current-buffer) t '(vm-beginning-of-message)
896 '(vm-beginning-of-message reading-message))
906 )))) 897 ))))
907 898
908 (defadvice vm-end-of-message (around tm-aware activate) 899 (defadvice vm-end-of-message (around tm-aware activate)
909 "Made TM-aware, works properly in MIME-Preview buffers." 900 "Made TM-aware, works properly in MIME-Preview buffers."
910 (interactive) 901 (interactive)
912 ad-do-it 903 ad-do-it
913 (vm-follow-summary-cursor) 904 (vm-follow-summary-cursor)
914 (vm-select-folder-buffer) 905 (vm-select-folder-buffer)
915 (vm-check-for-killed-summary) 906 (vm-check-for-killed-summary)
916 (vm-error-if-folder-empty) 907 (vm-error-if-folder-empty)
917 (let ((mbuf (current-buffer)) 908 (let ((pbuf (and mime::article/preview-buffer
918 (pbuf (and mime::article/preview-buffer
919 (get-buffer mime::article/preview-buffer)))) 909 (get-buffer mime::article/preview-buffer))))
920 (if (null pbuf) 910 (if (null pbuf)
921 (progn 911 (progn
922 (tm-vm/preview-current-message) 912 (tm-vm/preview-current-message)
923 (setq pbuf (get-buffer mime::article/preview-buffer)) 913 (setq pbuf (get-buffer mime::article/preview-buffer))
924 )) 914 ))
925 (vm-display mbuf t '(vm-end-of-message) 915 (vm-display (current-buffer) t '(vm-end-of-message)
926 '(vm-end-of-message reading-message)) 916 '(vm-end-of-message reading-message))
927 (tm-vm/display-preview-buffer) 917 (tm-vm/display-preview-buffer)
928 (set-buffer pbuf)
929 (tm-vm/save-window-excursion 918 (tm-vm/save-window-excursion
930 (select-window (vm-get-buffer-window pbuf)) 919 (select-window (vm-get-buffer-window pbuf))
931 (push-mark) 920 (push-mark)
932 (goto-char (point-max)) 921 (goto-char (point-max))
922 (vm-display (current-buffer) t '(vm-end-of-message)
923 '(vm-end-of-message reading-message))
933 )))) 924 ))))
934 925
935 ;;; based on vm-howl-if-eom [vm-page.el] 926 ;;; based on vm-howl-if-eom [vm-page.el]
936 (defun tm-vm/howl-if-eom () 927 (defun tm-vm/howl-if-eom ()
937 (let* ((pbuf (or mime::article/preview-buffer (current-buffer))) 928 (let* ((pbuf (or mime::article/preview-buffer (current-buffer)))
1491 the [Print Screen] key." 1482 the [Print Screen] key."
1492 (local-set-key (if running-xemacs 1483 (local-set-key (if running-xemacs
1493 'f22 1484 'f22
1494 [f22]) 1485 [f22])
1495 'tm-vm/print-message) 1486 'tm-vm/print-message)
1487 (make-local-variable 'ps-header-lines)
1488 (make-local-variable 'ps-left-header)
1496 (setq ps-header-lines 3) 1489 (setq ps-header-lines 3)
1497 (setq ps-left-header 1490 (setq ps-left-header
1498 (list 'ps-article-subject 'ps-article-author 'buffer-name))) 1491 (list 'ps-article-subject 'ps-article-author 'buffer-name)))
1499 1492
1500 (defun tm-vm/print-message () 1493 (defun tm-vm/print-message ()