Mercurial > hg > xemacs-beta

comparison lisp/tm/tm-vm.el @ 20:859a2309aef8 r19-15b93

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-15b93
author cvs
date Mon, 13 Aug 2007 08:50:05 +0200
parents 0293115a14e9
children 8fc7fe29b841
comparison
equal deleted inserted replaced
19:ac1f612d5250 20:859a2309aef8
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.3 $ 12 ;; Version: $Revision: 1.4 $
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
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 38 (eval-when-compile
39 (require 'tm-edit)
40 (require 'tm-mail) 39 (require 'tm-mail)
41 (require 'vm) 40 (require 'vm)
42 (require 'vm-window)) 41 (require 'vm-window))
43 42
43 (require 'tm-edit)
44 (require 'tm-view) 44 (require 'tm-view)
45 (require 'vm-reply)
46 (require 'vm-summary)
45 (require 'vm-menu) 47 (require 'vm-menu)
48 (require 'vm-toolbar)
46 49
47 50
48 ;;; @ Variables 51 ;;; @ Variables
49 52
50 ;;; @@ User customization variables 53 ;;; @@ User customization variables
58 "*If t append MIME specific commands to VM's popup menus.") 61 "*If t append MIME specific commands to VM's popup menus.")
59 62
60 (defvar tm-vm/use-original-url-button nil 63 (defvar tm-vm/use-original-url-button nil
61 "*If it is t, use original URL button instead of tm's.") 64 "*If it is t, use original URL button instead of tm's.")
62 65
63 (defvar tm-vm/automatic-mime-preview t 66 (defvar tm-vm/automatic-mime-preview (or (and (boundp 'vm-display-using-mime)
67 vm-display-using-mime)
68 t)
64 "*If non-nil, automatically process and show MIME messages.") 69 "*If non-nil, automatically process and show MIME messages.")
65 70
66 (defvar tm-vm/strict-mime t 71 (defvar tm-vm/strict-mime t
67 "*If nil, do MIME processing even if there is no MIME-Version field.") 72 "*If nil, do MIME processing even if there is no MIME-Version field.")
68 73
89 "*List of functions called after a Mail mode buffer has been 94 "*List of functions called after a Mail mode buffer has been
90 created to send a digest in multipart/digest type format. 95 created to send a digest in multipart/digest type format.
91 If `vm-digest-send-type' is \"rfc1521\", tm-vm runs this hook 96 If `vm-digest-send-type' is \"rfc1521\", tm-vm runs this hook
92 instead of `vm-send-digest-hook'.") 97 instead of `vm-send-digest-hook'.")
93 98
99 (defvar tm-vm/build-mime-preview-buffer-hook nil
100 "*List of functions called each time a MIME Preview buffer is built.
101 These hooks are run in the MIME-Preview buffer.")
94 102
95 ;;; @@ System/Information variables 103 ;;; @@ System/Information variables
96 104
97 (defconst tm-vm/RCS-ID 105 (defconst tm-vm/RCS-ID
98 "$Id: tm-vm.el,v 1.3 1997/02/02 05:06:20 steve Exp $") 106 "$Id: tm-vm.el,v 1.4 1997/02/09 23:51:48 steve Exp $")
99 (defconst tm-vm/version (get-version-string tm-vm/RCS-ID)) 107 (defconst tm-vm/version (get-version-string tm-vm/RCS-ID))
108
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
111 (setq vm-menu-mail-menu
112 (let ((title (if (vm-menu-fsfemacs-menus-p)
113 (list "Mail Commands"
114 "Mail Commands"
115 "---"
116 "---")
117 (list "Mail Commands"))))
118 (append
119 title
120 (list ["Send and Exit" vm-mail-send-and-exit (vm-menu-can-send-mail-p)]
121 ["Send, Keep Composing" vm-mail-send (vm-menu-can-send-mail-p)]
122 ["Cancel" kill-buffer t]
123 "----"
124 "Go to Field:"
125 "----"
126 [" To:" mail-to t]
127 [" Subject:" mail-subject t]
128 [" CC:" mail-cc t]
129 [" BCC:" mail-bcc t]
130 [" Reply-To:" mail-replyto t]
131 [" Text" mail-text t]
132 "----"
133 ["Yank Original" vm-menu-yank-original vm-reply-list]
134 ["Fill Yanked Message" mail-fill-yanked-message t]
135 ["Insert Signature" mail-signature t]
136 ["Insert File..." insert-file t]
137 ["Insert Buffer..." insert-buffer t])
138 (if tm-vm/attach-to-popup-menus
139 (list "----"
140 (cons "MIME Commands"
141 (mapcar (function (lambda (item)
142 (vector (nth 1 item)
143 (nth 2 item)
144 t)))
145 mime-editor/menu-list))))
146 )))
100 147
101 (defvar tm-vm/vm-emulation-map 148 (defvar tm-vm/vm-emulation-map
102 (let ((map (make-sparse-keymap))) 149 (let ((map (make-sparse-keymap)))
103 (define-key map "h" 'vm-summarize) 150 (define-key map "h" 'vm-summarize)
104 ;(define-key map "\M-n" 'vm-next-unread-message) 151 ;(define-key map "\M-n" 'vm-next-unread-message)
109 (define-key map "P" 'vm-previous-message-no-skip) 156 (define-key map "P" 'vm-previous-message-no-skip)
110 ;(define-key map "\C-\M-n" 'vm-move-message-forward) 157 ;(define-key map "\C-\M-n" 'vm-move-message-forward)
111 ;(define-key map "\C-\M-p" 'vm-move-message-backward) 158 ;(define-key map "\C-\M-p" 'vm-move-message-backward)
112 ;(define-key map "\t" 'vm-goto-message-last-seen) 159 ;(define-key map "\t" 'vm-goto-message-last-seen)
113 ;(define-key map "\r" 'vm-goto-message) 160 ;(define-key map "\r" 'vm-goto-message)
114 ;(define-key map "^" 'vm-goto-parent-message) 161 (define-key map "^" 'vm-goto-parent-message)
115 (define-key map "t" 'vm-expose-hidden-headers) 162 (define-key map "t" 'vm-expose-hidden-headers)
116 (define-key map " " 'vm-scroll-forward) 163 (define-key map " " 'vm-scroll-forward)
117 (define-key map "b" 'vm-scroll-backward) 164 (define-key map "b" 'vm-scroll-backward)
118 (define-key map "\C-?" 'vm-scroll-backward) 165 (define-key map "\C-?" 'vm-scroll-backward)
119 ;(define-key map "d" 'vm-delete-message) 166 (define-key map "d" 'vm-delete-message)
120 ;(define-key map "\C-d" 'vm-delete-message-backward) 167 (define-key map "\C-d" 'vm-delete-message-backward)
121 ;(define-key map "u" 'vm-undelete-message) 168 (define-key map "u" 'vm-undelete-message)
122 ;(define-key map "U" 'vm-unread-message) 169 (define-key map "U" 'vm-unread-message)
123 ;(define-key map "e" 'vm-edit-message) 170 (define-key map "e" 'vm-edit-message)
124 ;(define-key map "a" 'vm-set-message-attributes) 171 ;(define-key map "a" 'vm-set-message-attributes)
125 ;(define-key map "j" 'vm-discard-cached-data) 172 ;(define-key map "j" 'vm-discard-cached-data)
126 ;(define-key map "k" 'vm-kill-subject) 173 ;(define-key map "k" 'vm-kill-subject)
127 (define-key map "f" 'vm-followup) 174 (define-key map "f" 'vm-followup)
128 (define-key map "F" 'vm-followup-include-text) 175 (define-key map "F" 'vm-followup-include-text)
136 ;(define-key map "*" 'vm-burst-digest) 183 ;(define-key map "*" 'vm-burst-digest)
137 (define-key map "m" 'vm-mail) 184 (define-key map "m" 'vm-mail)
138 (define-key map "g" 'vm-get-new-mail) 185 (define-key map "g" 'vm-get-new-mail)
139 ;(define-key map "G" 'vm-sort-messages) 186 ;(define-key map "G" 'vm-sort-messages)
140 (define-key map "v" 'vm-visit-folder) 187 (define-key map "v" 'vm-visit-folder)
141 ;(define-key map "s" 'vm-save-message) 188 (define-key map "s" 'vm-save-message)
142 ;(define-key map "w" 'vm-save-message-sans-headers) 189 ;(define-key map "w" 'vm-save-message-sans-headers)
143 ;(define-key map "A" 'vm-auto-archive-messages) 190 ;(define-key map "A" 'vm-auto-archive-messages)
144 ;(define-key map "S" 'vm-save-folder) 191 (define-key map "S" 'vm-save-folder)
145 ;(define-key map "|" 'vm-pipe-message-to-command) 192 ;(define-key map "|" 'vm-pipe-message-to-command)
146 ;(define-key map "#" 'vm-expunge-folder) 193 (define-key map "#" 'vm-expunge-folder)
147 (define-key map "q" 'vm-quit) 194 (define-key map "q" 'vm-quit)
148 (define-key map "x" 'vm-quit-no-change) 195 (define-key map "x" 'vm-quit-no-change)
149 (define-key map "i" 'vm-iconify-frame) 196 (define-key map "i" 'vm-iconify-frame)
150 (define-key map "?" 'vm-help) 197 (define-key map "?" 'vm-help)
151 (define-key map "\C-_" 'vm-undo) 198 (define-key map "\C-_" 'vm-undo)
153 (define-key map "!" 'shell-command) 200 (define-key map "!" 'shell-command)
154 (define-key map "<" 'vm-beginning-of-message) 201 (define-key map "<" 'vm-beginning-of-message)
155 (define-key map ">" 'vm-end-of-message) 202 (define-key map ">" 'vm-end-of-message)
156 ;(define-key map "\M-s" 'vm-isearch-forward) 203 ;(define-key map "\M-s" 'vm-isearch-forward)
157 (define-key map "=" 'vm-summarize) 204 (define-key map "=" 'vm-summarize)
158 ;(define-key map "L" 'vm-load-init-file) 205 (define-key map "L" 'vm-load-init-file)
159 ;(define-key map "l" (make-sparse-keymap)) 206 ;(define-key map "l" (make-sparse-keymap))
160 ;(define-key map "la" 'vm-add-message-labels) 207 ;(define-key map "la" 'vm-add-message-labels)
161 ;(define-key map "ld" 'vm-delete-message-labels) 208 ;(define-key map "ld" 'vm-delete-message-labels)
162 ;(define-key map "V" (make-sparse-keymap)) 209 ;(define-key map "V" (make-sparse-keymap))
163 ;(define-key map "VV" 'vm-visit-virtual-folder) 210 ;(define-key map "VV" 'vm-visit-virtual-folder)
184 ;(define-key map "W" (make-sparse-keymap)) 231 ;(define-key map "W" (make-sparse-keymap))
185 ;(define-key map "WW" 'vm-apply-window-configuration) 232 ;(define-key map "WW" 'vm-apply-window-configuration)
186 ;(define-key map "WS" 'vm-save-window-configuration) 233 ;(define-key map "WS" 'vm-save-window-configuration)
187 ;(define-key map "WD" 'vm-delete-window-configuration) 234 ;(define-key map "WD" 'vm-delete-window-configuration)
188 ;(define-key map "W?" 'vm-window-help) 235 ;(define-key map "W?" 'vm-window-help)
189 ;(define-key map "\C-t" 'vm-toggle-threads-display) 236 (define-key map "\C-t" 'vm-toggle-threads-display)
190 ;(define-key map "\C-x\C-s" 'vm-save-buffer) 237 (define-key map "\C-x\C-s" 'vm-save-buffer)
191 ;(define-key map "\C-x\C-w" 'vm-write-file) 238 (define-key map "\C-x\C-w" 'vm-write-file)
192 ;(define-key map "\C-x\C-q" 'vm-toggle-read-only) 239 (define-key map "\C-x\C-q" 'vm-toggle-read-only)
193 ;(define-key map "%" 'vm-change-folder-type) 240 ;(define-key map "%" 'vm-change-folder-type)
194 ;(define-key map "\M-C" 'vm-show-copying-restrictions) 241 (define-key map "\M-C" 'vm-show-copying-restrictions)
195 ;(define-key map "\M-W" 'vm-show-no-warranty) 242 (define-key map "\M-W" 'vm-show-no-warranty)
196 ;; suppress-keymap provides these, but now that we don't use 243 ;; suppress-keymap provides these, but now that we don't use
197 ;; suppress-keymap anymore... 244 ;; suppress-keymap anymore...
198 (define-key map "0" 'digit-argument) 245 (define-key map "0" 'digit-argument)
199 (define-key map "1" 'digit-argument) 246 (define-key map "1" 'digit-argument)
200 (define-key map "2" 'digit-argument) 247 (define-key map "2" 'digit-argument)
230 menu 277 menu
231 (vm-easy-menu-define fsfmenu (list dummy) nil menu) 278 (vm-easy-menu-define fsfmenu (list dummy) nil menu)
232 fsfmenu)) 279 fsfmenu))
233 "VM's popup menu + MIME specific commands") 280 "VM's popup menu + MIME specific commands")
234 281
282
283
235 (define-key vm-mode-map "Z" 'tm-vm/view-message) 284 (define-key vm-mode-map "Z" 'tm-vm/view-message)
236 (define-key vm-mode-map "T" 'tm-vm/decode-message-header) 285 (define-key vm-mode-map "T" 'tm-vm/decode-message-header)
237 (define-key vm-mode-map "\et" 'tm-vm/toggle-preview-mode) 286 (define-key vm-mode-map "\et" 'tm-vm/toggle-preview-mode)
238 287
288 ; Disable VM 6 built-in MIME handling
289 (setq vm-display-using-mime nil)
290 (setq vm-send-using-mime nil)
239 291
240 ;;; @ MIME encoded-words 292 ;;; @ MIME encoded-words
241 293
242 (defvar tm-vm/use-tm-patch nil 294 (defvar tm-vm/use-tm-patch nil
243 "Does not decode encoded-words in summary buffer if it is t. 295 "Does not decode encoded-words in summary buffer if it is t.
257 (if (stringp full-name) 309 (if (stringp full-name)
258 (cons (mime-eword/decode-string full-name) 310 (cons (mime-eword/decode-string full-name)
259 (cdr ret)) 311 (cdr ret))
260 ret))) 312 ret)))
261 313
262 (require 'vm-summary)
263 (or (fboundp 'tm:vm-su-subject) 314 (or (fboundp 'tm:vm-su-subject)
264 (fset 'tm:vm-su-subject (symbol-function 'vm-su-subject)) 315 (fset 'tm:vm-su-subject (symbol-function 'vm-su-subject))
265 ) 316 )
266 (defun vm-su-subject (m) 317 (defun vm-su-subject (m)
267 (mime-eword/decode-string (tm:vm-su-subject m)) 318 (mime-eword/decode-string (tm:vm-su-subject m))
411 ;; Energize URLs and buttons 462 ;; Energize URLs and buttons
412 (if (and tm-vm/use-original-url-button 463 (if (and tm-vm/use-original-url-button
413 vm-use-menus (vm-menu-support-possible-p)) 464 vm-use-menus (vm-menu-support-possible-p))
414 (progn 465 (progn
415 (vm-energize-urls) 466 (vm-energize-urls)
416 (vm-energize-headers))))))) 467 (vm-energize-headers)))
468 (run-hooks 'tm-vm/build-mime-preview-buffer-hook)
469 ))))
417 470
418 (defun tm-vm/sync-preview-buffer () 471 (defun tm-vm/sync-preview-buffer ()
419 "Ensure that the MIME preview buffer, if it exists, actually corresponds to the current message. 472 "Ensure that the MIME preview buffer, if it exists, actually corresponds to the current message.
420 If no MIME Preview buffer is needed then kill it. If no 473 If no MIME Preview buffer is needed then kill it. If no
421 MIME Preview buffer exists nothing is done." 474 MIME Preview buffer exists nothing is done."
966 1019
967 ;;; @ MIME Editor 1020 ;;; @ MIME Editor
968 1021
969 ;;; @@ vm-yank-message 1022 ;;; @@ vm-yank-message
970 1023
971 (require 'vm-reply)
972 1024
973 (defvar tm-vm/yank:message-to-restore nil 1025 (defvar tm-vm/yank:message-to-restore nil
974 "For internal use by tm-vm only.") 1026 "For internal use by tm-vm only.")
975 1027
976 (defun vm-yank-message (&optional message) 1028 (defun vm-yank-message (&optional message)
1235 (substitute-key-definition 'vm-send-digest 1287 (substitute-key-definition 'vm-send-digest
1236 'tm-vm/send-digest vm-mode-map) 1288 'tm-vm/send-digest vm-mode-map)
1237 1289
1238 ;;; @@@ Menus 1290 ;;; @@@ Menus
1239 1291
1240 ;;; modified by Steven L. Baur <steve@miranova.com>
1241 ;;; 1995/12/6 (c.f. [tm-en:209])
1242 (defun mime-editor/attach-to-vm-mode-menu ()
1243 "Arrange to attach MIME editor's popup menu to VM's"
1244 (if (boundp 'vm-menu-mail-menu)
1245 (progn
1246 (setq vm-menu-mail-menu
1247 (append vm-menu-mail-menu
1248 (list "----"
1249 mime-editor/popup-menu-for-xemacs)))
1250 (remove-hook 'vm-mail-mode-hook 'mime-editor/attach-to-vm-mode-menu)
1251 ))
1252 )
1253 1292
1254 (call-after-loaded 1293 (call-after-loaded
1255 'tm-edit 1294 'tm-edit
1256 (function 1295 (function
1257 (lambda () 1296 (lambda ()
1262 'mail-mode (function 1301 'mail-mode (function
1263 (lambda () 1302 (lambda ()
1264 (interactive) 1303 (interactive)
1265 (funcall send-mail-function) 1304 (funcall send-mail-function)
1266 ))) 1305 )))
1267 (if (and (string-match "XEmacs\\|Lucid" emacs-version)
1268 tm-vm/attach-to-popup-menus)
1269 (add-hook 'vm-mail-mode-hook 'mime-editor/attach-to-vm-mode-menu)
1270 )
1271 ))) 1306 )))
1272 1307
1273 1308
1274 1309
1275 ;;; @ VM Integration 1310 ;;; @ VM Integration
1310 vm-use-menus 1345 vm-use-menus
1311 (eq major-mode 'mime/viewer-mode)) 1346 (eq major-mode 'mime/viewer-mode))
1312 (vm-menu-popup-mode-menu event)))) 1347 (vm-menu-popup-mode-menu event))))
1313 ) 1348 )
1314 1349
1315 1350 (defadvice vm-save-message (around tm-aware activate)
1351 "Made TM aware. Callable from the MIME Preview buffer."
1352 (if mime::preview/article-buffer
1353 (save-excursion
1354 (set-buffer mime::preview/article-buffer)
1355 ad-do-it)
1356 ad-do-it))
1357
1358 (defadvice vm-expunge-folder (around tm-aware activate)
1359 "Made TM aware. Callable from the MIME Preview buffer."
1360 (if mime::preview/article-buffer
1361 (save-excursion
1362 (set-buffer mime::preview/article-buffer)
1363 ad-do-it)
1364 ad-do-it))
1365
1366 (defadvice vm-save-folder (around tm-aware activate)
1367 "Made TM aware. Callable from the MIME Preview buffer."
1368 (if mime::preview/article-buffer
1369 (save-excursion
1370 (set-buffer mime::preview/article-buffer)
1371 ad-do-it)
1372 ad-do-it))
1373
1374 (defadvice vm-goto-parent-message (around tm-aware activate)
1375 "Made TM aware. Callable from the MIME Preview buffer."
1376 (if mime::preview/article-buffer
1377 (save-excursion
1378 (set-buffer mime::preview/article-buffer)
1379 ad-do-it)
1380 ad-do-it))
1381
1382 (defadvice vm-delete-message (around tm-aware activate)
1383 "Made TM aware. Callable from the MIME Preview buffer."
1384 (interactive "p")
1385 (if (interactive-p)
1386 (vm-follow-summary-cursor))
1387 (if mime::preview/article-buffer
1388 (save-excursion
1389 (set-buffer mime::preview/article-buffer)
1390 ad-do-it)
1391 ad-do-it))
1392
1393 (defadvice vm-delete-message-backward (around tm-aware activate)
1394 "Made TM aware. Callable from the MIME Preview buffer."
1395 (interactive "p")
1396 (if (interactive-p)
1397 (vm-follow-summary-cursor))
1398 (if mime::preview/article-buffer
1399 (save-excursion
1400 (set-buffer mime::preview/article-buffer)
1401 ad-do-it)
1402 ad-do-it))
1403
1404 (defadvice vm-undelete-message (around tm-aware activate)
1405 "Made TM aware. Callable from the MIME Preview buffer."
1406 (interactive "p")
1407 (if (interactive-p)
1408 (vm-follow-summary-cursor))
1409 (if mime::preview/article-buffer
1410 (save-excursion
1411 (set-buffer mime::preview/article-buffer)
1412 ad-do-it)
1413 ad-do-it))
1414
1415 (defadvice vm-unread-message (around tm-aware activate)
1416 "Made TM aware. Callable from the MIME Preview buffer."
1417 (if mime::preview/article-buffer
1418 (save-excursion
1419 (set-buffer mime::preview/article-buffer)
1420 ad-do-it)
1421 ad-do-it))
1422
1423 (defadvice vm-edit-message (around tm-aware activate)
1424 "Made TM aware. Callable from the MIME Preview buffer."
1425 (if mime::preview/article-buffer
1426 (save-excursion
1427 (set-buffer mime::preview/article-buffer)
1428 ad-do-it)
1429 ad-do-it))
1430
1431
1432
1316 ;;; @@ VM Toolbar Integration 1433 ;;; @@ VM Toolbar Integration
1317
1318 (require 'vm-toolbar)
1319 1434
1320 ;;; based on vm-toolbar-any-messages-p [vm-toolbar.el] 1435 ;;; based on vm-toolbar-any-messages-p [vm-toolbar.el]
1321 (defun tm-vm/check-for-toolbar () 1436 (defun tm-vm/check-for-toolbar ()
1322 "Install VM toolbar if necessary." 1437 "Install VM toolbar if necessary."
1323 (if (and running-xemacs 1438 (if (and running-xemacs