Mercurial > hg > xemacs-beta

comparison lisp/tm/tm-vm.el @ 8:4b173ad71786 r19-15b5

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-15b5
author cvs
date Mon, 13 Aug 2007 08:47:35 +0200
parents b82b59fe008d
children 0293115a14e9
comparison
equal deleted inserted replaced
7:c153ca296910 8:4b173ad71786
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.1.1.1 $ 12 ;; Version: $Revision: 1.2 $
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
33 33
34 ;; Plese insert `(require 'tm-vm)' in your ~/.vm file. 34 ;; Plese insert `(require 'tm-vm)' in your ~/.vm file.
35 35
36 ;;; Code: 36 ;;; Code:
37 37
38 (eval-when-compile
39 (require 'tm-edit)
40 (require 'tm-mail)
41 (require 'vm)
42 (require 'vm-window))
43
38 (require 'tm-view) 44 (require 'tm-view)
39 (require 'vm)
40 (eval-when-compile
41 (require 'ps-print))
42 45
43 (defconst tm-vm/RCS-ID 46 (defconst tm-vm/RCS-ID
44 "$Id: tm-vm.el,v 1.1.1.1 1996/12/18 03:55:32 steve Exp $") 47 "$Id: tm-vm.el,v 1.2 1996/12/22 00:29:43 steve Exp $")
45 (defconst tm-vm/version (get-version-string tm-vm/RCS-ID)) 48 (defconst tm-vm/version (get-version-string tm-vm/RCS-ID))
46 49
47 (define-key vm-mode-map "Z" 'tm-vm/view-message) 50 (define-key vm-mode-map "Z" 'tm-vm/view-message)
48 (define-key vm-mode-map "T" 'tm-vm/decode-message-header) 51 (define-key vm-mode-map "T" 'tm-vm/decode-message-header)
49 (define-key vm-mode-map "\et" 'tm-vm/toggle-preview-mode) 52 (define-key vm-mode-map "\et" 'tm-vm/toggle-preview-mode)
313 (defun tm-vm/show-current-message () 316 (defun tm-vm/show-current-message ()
314 "Update current message display and summary. Remove 'unread' and 'new' flags. " 317 "Update current message display and summary. Remove 'unread' and 'new' flags. "
315 (if mime::preview/article-buffer 318 (if mime::preview/article-buffer
316 (set-buffer mime::preview/article-buffer) 319 (set-buffer mime::preview/article-buffer)
317 (vm-select-folder-buffer)) 320 (vm-select-folder-buffer))
318 (if mime::article/preview-buffer 321 (if (and mime::article/preview-buffer
322 (get-buffer mime::article/preview-buffer))
319 (save-excursion 323 (save-excursion
320 (set-buffer mime::article/preview-buffer) 324 (set-buffer mime::article/preview-buffer)
321 (goto-char (point-min)) 325 (goto-char (point-min))
322 (widen))) 326 (widen)))
323 (if (or (and mime::article/preview-buffer 327 (if (or (and mime::article/preview-buffer
328 (get-buffer mime::article/preview-buffer)
324 (vm-get-visible-buffer-window mime::article/preview-buffer)) 329 (vm-get-visible-buffer-window mime::article/preview-buffer))
325 (vm-get-visible-buffer-window (current-buffer))) 330 (vm-get-visible-buffer-window (current-buffer)))
326 (progn 331 (progn
327 (setq tm-vm/system-state 'reading) 332 (setq tm-vm/system-state 'reading)
328 (if (vm-new-flag (car vm-message-pointer)) 333 (if (vm-new-flag (car vm-message-pointer))
378 (get-buffer mime::article/preview-buffer))) 383 (get-buffer mime::article/preview-buffer)))
379 (pwin (and pbuf (vm-get-buffer-window pbuf))) 384 (pwin (and pbuf (vm-get-buffer-window pbuf)))
380 (was-invisible (and (null mwin) (null pwin))) 385 (was-invisible (and (null mwin) (null pwin)))
381 ) 386 )
382 ;; now current buffer is folder buffer. 387 ;; now current buffer is folder buffer.
383 (tm-vm/save-window-excursion 388 (if (or mp-changed was-invisible)
384 (if (or mp-changed was-invisible) 389 (vm-display mbuf t '(vm-scroll-forward vm-scroll-backward)
385 (vm-display mbuf t '(vm-scroll-forward vm-scroll-backward) 390 (list this-command 'reading-message)))
386 (list this-command 'reading-message))) 391 (tm-vm/display-preview-buffer)
387 (tm-vm/display-preview-buffer) 392 (setq mwin (vm-get-buffer-window mbuf)
388 (setq mwin (vm-get-buffer-window mbuf) 393 pwin (and pbuf (vm-get-buffer-window pbuf)))
389 pwin (and pbuf (vm-get-buffer-window pbuf))) 394 (cond
390 (cond 395 ((or mp-changed was-invisible)
391 ((or mp-changed was-invisible) 396 nil)
392 nil 397 ((null pbuf)
393 ) 398 ;; preview buffer is killed.
394 ((null pbuf) 399 (tm-vm/preview-current-message)
395 ;; preview buffer is killed. 400 (vm-update-summary-and-mode-line))
396 (tm-vm/preview-current-message) 401 ((eq (tm-vm/system-state) 'previewing)
397 (vm-update-summary-and-mode-line)) 402 (tm-vm/show-current-message))
398 ((eq (tm-vm/system-state) 'previewing) 403 (t
399 (tm-vm/show-current-message)) 404 (tm-vm/save-window-excursion
400 (t 405 (select-window pwin)
401 (select-window pwin) 406 (set-buffer pbuf)
402 (set-buffer pbuf) 407 (if (pos-visible-in-window-p (point-max) pwin)
403 (if (pos-visible-in-window-p (point-max) pwin) 408 (tm-vm/next-message)
404 (tm-vm/next-message) 409 ;; not end of message. scroll preview buffer only.
405 ;; not end of message. scroll preview buffer only. 410 (scroll-up)
406 (scroll-up) 411 (tm-vm/howl-if-eom)
407 (tm-vm/howl-if-eom) 412 (set-buffer mbuf))
408 (set-buffer mbuf)) 413 ))))
409 ))))
410 ))) 414 )))
411 415
412 ;;; based on vm-scroll-backward [vm-page.el] 416 ;;; based on vm-scroll-backward [vm-page.el]
413 (defun tm-vm/scroll-backward (&optional arg) 417 (defun tm-vm/scroll-backward (&optional arg)
414 (interactive "P") 418 (interactive "P")
425 ) 429 )
426 ;; now current buffer is folder buffer. 430 ;; now current buffer is folder buffer.
427 (if (or mp-changed was-invisible) 431 (if (or mp-changed was-invisible)
428 (vm-display mbuf t '(vm-scroll-forward vm-scroll-backward) 432 (vm-display mbuf t '(vm-scroll-forward vm-scroll-backward)
429 (list this-command 'reading-message))) 433 (list this-command 'reading-message)))
430 (tm-vm/save-window-excursion 434 (tm-vm/display-preview-buffer)
431 (tm-vm/display-preview-buffer) 435 (setq mwin (vm-get-buffer-window mbuf)
432 (setq mwin (vm-get-buffer-window mbuf) 436 pwin (and pbuf (vm-get-buffer-window pbuf)))
433 pwin (and pbuf (vm-get-buffer-window pbuf))) 437 (cond
434 (cond 438 (was-invisible
435 (was-invisible 439 nil
436 nil 440 )
437 ) 441 ((null pbuf)
438 ((null pbuf) 442 ;; preview buffer is killed.
439 ;; preview buffer is killed. 443 (tm-vm/preview-current-message)
440 (tm-vm/preview-current-message) 444 (vm-update-summary-and-mode-line))
441 (vm-update-summary-and-mode-line)) 445 ((eq (tm-vm/system-state) 'previewing)
442 ((eq (tm-vm/system-state) 'previewing) 446 (tm-vm/show-current-message))
443 (tm-vm/show-current-message)) 447 (t
444 (t 448 (tm-vm/save-window-excursion
445 (select-window pwin) 449 (select-window pwin)
446 (set-buffer pbuf) 450 (set-buffer pbuf)
447 (if (pos-visible-in-window-p (point-min) pwin) 451 (if (pos-visible-in-window-p (point-min) pwin)
448 nil 452 nil
449 ;; scroll preview buffer only. 453 ;; scroll preview buffer only.
450 (scroll-down) 454 (scroll-down)
451 (set-buffer mbuf)) 455 (set-buffer mbuf))
452 )))) 456 ))))
453 ))) 457 )))
454 458
455 ;;; based on vm-beginning-of-message [vm-page.el] 459 ;;; based on vm-beginning-of-message [vm-page.el]
456 (defun tm-vm/beginning-of-message () 460 (defun tm-vm/beginning-of-message ()
457 "Moves to the beginning of the current message." 461 "Moves to the beginning of the current message."
1057 'mail-mode (function tm-mail/insert-message)) 1061 'mail-mode (function tm-mail/insert-message))
1058 (set-alist 'mime-editor/split-message-sender-alist 1062 (set-alist 'mime-editor/split-message-sender-alist
1059 'mail-mode (function 1063 'mail-mode (function
1060 (lambda () 1064 (lambda ()
1061 (interactive) 1065 (interactive)
1062 (sendmail-send-it) 1066 (funcall send-mail-function)
1063 ))) 1067 )))
1064 (if (and (string-match "XEmacs\\|Lucid" emacs-version) 1068 (if (and (string-match "XEmacs\\|Lucid" emacs-version)
1065 tm-vm/use-xemacs-popup-menu) 1069 tm-vm/use-xemacs-popup-menu)
1066 (add-hook 'vm-mail-mode-hook 'mime-editor/attach-to-vm-mode-menu) 1070 (add-hook 'vm-mail-mode-hook 'mime-editor/attach-to-vm-mode-menu)
1067 ) 1071 )
1101 ))) 1105 )))
1102 1106
1103 ;;; @ for ps-print (Suggestted by Anders Stenman <stenman@isy.liu.se>) 1107 ;;; @ for ps-print (Suggestted by Anders Stenman <stenman@isy.liu.se>)
1104 ;;; 1108 ;;;
1105 1109
1106 (defvar tm-vm/use-ps-print (not (or running-mule-merged-emacs 1110 (defvar tm-vm/use-ps-print (not (featurep 'mule))
1107 running-xemacs-with-mule))
1108 "*Use Postscript printing (ps-print) to print MIME messages.") 1111 "*Use Postscript printing (ps-print) to print MIME messages.")
1109 1112
1110 (if tm-vm/use-ps-print 1113 (if tm-vm/use-ps-print
1111 (progn 1114 (progn
1112 (require 'ps-print) 1115 (autoload 'ps-print-buffer-with-faces "ps-print" "Postscript Print" t)
1113 (add-hook 'vm-mode-hook 'tm-vm/ps-print-setup) 1116 (add-hook 'vm-mode-hook 'tm-vm/ps-print-setup)
1114 (add-hook 'mime-viewer/define-keymap-hook 'tm-vm/ps-print-setup) 1117 (add-hook 'mime-viewer/define-keymap-hook 'tm-vm/ps-print-setup)
1115 (fset 'vm-toolbar-print-command 'tm-vm/print-message))) 1118 (fset 'vm-toolbar-print-command 'tm-vm/print-message)))
1116 1119
1117 (defun tm-vm/ps-print-setup () 1120 (defun tm-vm/ps-print-setup ()
1118 "Set things up for printing MIME messages with ps-print. Set binding to 1121 "Set things up for printing MIME messages with ps-print. Set binding to
1119 the [Print Screen] key." 1122 the [Print Screen] key."
1120 (local-set-key (ps-prsc) 'tm-vm/print-message) 1123 (local-set-key (if running-xemacs
1124 'f22
1125 [f22])
1126 'tm-vm/print-message)
1121 (setq ps-header-lines 3) 1127 (setq ps-header-lines 3)
1122 (setq ps-left-header 1128 (setq ps-left-header
1123 (list 'ps-article-subject 'ps-article-author 'buffer-name))) 1129 (list 'ps-article-subject 'ps-article-author 'buffer-name)))
1124 1130
1125 (defun tm-vm/print-message () 1131 (defun tm-vm/print-message ()