Mercurial > hg > xemacs-beta

comparison lisp/vm/vm-menu.el @ 102:a145efe76779 r20-1b3

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-1b3
author cvs
date Mon, 13 Aug 2007 09:15:49 +0200
parents 4be1180a9e89
children 360340f9fd5f
comparison
equal deleted inserted replaced
101:a0ec055d74dd 102:a145efe76779
267 title 267 title
268 (list ["Send and Exit" vm-mail-send-and-exit (vm-menu-can-send-mail-p)] 268 (list ["Send and Exit" vm-mail-send-and-exit (vm-menu-can-send-mail-p)]
269 ["Send, Keep Composing" vm-mail-send (vm-menu-can-send-mail-p)] 269 ["Send, Keep Composing" vm-mail-send (vm-menu-can-send-mail-p)]
270 ["Cancel" kill-buffer t] 270 ["Cancel" kill-buffer t]
271 "----" 271 "----"
272 "Go to Field:" 272 ["Yank Original" vm-menu-yank-original vm-reply-list]
273 "----" 273 "----"
274 [" To:" mail-to t] 274 (append
275 [" Subject:" mail-subject t] 275 (if (vm-menu-fsfemacs-menus-p)
276 [" CC:" mail-cc t] 276 (list "Send Using MIME..."
277 [" BCC:" mail-bcc t] 277 "Send Using MIME..."
278 [" Reply-To:" mail-replyto t] 278 "---"
279 [" Text" mail-text t] 279 "---")
280 (list "Send Using MIME..."))
281 (list
282 ["Use MIME"
283 (set (make-local-variable 'vm-send-using-mime) t)
284 :active t
285 :style radio
286 :selected vm-send-using-mime]
287 ["Don't use MIME"
288 (set (make-local-variable 'vm-send-using-mime) nil)
289 :active t
290 :style radio
291 :selected (not vm-send-using-mime)]))
292 (append
293 (if (vm-menu-fsfemacs-menus-p)
294 (list "Fragment Messages Larger Than ..."
295 "Fragment Messages Larger Than ..."
296 "---"
297 "---")
298 (list "Fragment Messages Larger Than ..."))
299 (list ["Infinity, i.e., don't fragment"
300 (set (make-local-variable 'vm-mime-max-message-size) nil)
301 :active vm-send-using-mime
302 :style radio
303 :selected (eq vm-mime-max-message-size nil)]
304 ["50000 bytes"
305 (set (make-local-variable 'vm-mime-max-message-size)
306 50000)
307 :active vm-send-using-mime
308 :style radio
309 :selected (eq vm-mime-max-message-size 50000)]
310 ["100000 bytes"
311 (set (make-local-variable 'vm-mime-max-message-size)
312 100000)
313 :active vm-send-using-mime
314 :style radio
315 :selected (eq vm-mime-max-message-size 100000)]
316 ["200000 bytes"
317 (set (make-local-variable 'vm-mime-max-message-size)
318 200000)
319 :active vm-send-using-mime
320 :style radio
321 :selected (eq vm-mime-max-message-size 200000)]
322 ["500000 bytes"
323 (set (make-local-variable 'vm-mime-max-message-size)
324 500000)
325 :active vm-send-using-mime
326 :style radio
327 :selected (eq vm-mime-max-message-size 500000)]
328 ["1000000 bytes"
329 (set (make-local-variable 'vm-mime-max-message-size)
330 1000000)
331 :active vm-send-using-mime
332 :style radio
333 :selected (eq vm-mime-max-message-size 1000000)]
334 ["2000000 bytes"
335 (set (make-local-variable 'vm-mime-max-message-size)
336 2000000)
337 :active vm-send-using-mime
338 :style radio
339 :selected (eq vm-mime-max-message-size 2000000)]))
340 (append
341 (if (vm-menu-fsfemacs-menus-p)
342 (list "Encode 8-bit Characters Using ..."
343 "Encode 8-bit Characters Using ..."
344 "---"
345 "---")
346 (list "Encode 8-bit Characters Using ..."))
347 (list
348 ["Nothing, i.e., send unencoded"
349 (set (make-local-variable 'vm-mime-8bit-text-transfer-encoding)
350 '8bit)
351 :active vm-send-using-mime
352 :style radio
353 :selected (eq vm-mime-8bit-text-transfer-encoding '8bit)]
354 ["Quoted-Printable"
355 (set (make-local-variable 'vm-mime-8bit-text-transfer-encoding)
356 'quoted-printable)
357 :active vm-send-using-mime
358 :style radio
359 :selected (eq vm-mime-8bit-text-transfer-encoding
360 'quoted-printable)]
361 ["BASE64"
362 (set (make-local-variable 'vm-mime-8bit-text-transfer-encoding)
363 'base64)
364 :active vm-send-using-mime
365 :style radio
366 :selected (eq vm-mime-8bit-text-transfer-encoding 'base64)]))
280 "----" 367 "----"
281 ["Yank Original" vm-menu-yank-original vm-reply-list] 368 ["Attach File..." vm-mime-attach-file vm-send-using-mime]
282 ["Fill Yanked Message" mail-fill-yanked-message t] 369 ["Attach MIME File..." vm-mime-attach-mime-file vm-send-using-mime]
283 ["Insert Signature" mail-signature t] 370 ["Encode MIME, But Don't Send" vm-mime-encode-composition
284 ["Insert File..." insert-file t]
285 ["Insert Buffer..." insert-buffer t]
286 "----"
287 "MIME:"
288 "----"
289 [" Attach File..." vm-mime-attach-file vm-send-using-mime]
290 [" Attach MIME File..." vm-mime-attach-mime-file vm-send-using-mime]
291 [" Encode MIME, But Don't Send" vm-mime-encode-composition
292 (and vm-send-using-mime 371 (and vm-send-using-mime
293 (null (vm-mail-mode-get-header-contents "MIME-Version:")))] 372 (null (vm-mail-mode-get-header-contents "MIME-Version:")))]
294 [" Preview MIME Before Sending" vm-mime-preview-composition 373 ["Preview MIME Before Sending" vm-mime-preview-composition
295 vm-send-using-mime] 374 vm-send-using-mime]
296 )))) 375 ))))
297 376
298 (defconst vm-menu-mime-dispose-menu 377 (defconst vm-menu-mime-dispose-menu
299 (let ((title (if (vm-menu-fsfemacs-menus-p) 378 (let ((title (if (vm-menu-fsfemacs-menus-p)
473 (save-match-data 552 (save-match-data
474 (catch 'done 553 (catch 'done
475 (let ((headers '("to" "cc" "bcc" "resent-to" "resent-cc" "resent-bcc")) 554 (let ((headers '("to" "cc" "bcc" "resent-to" "resent-cc" "resent-bcc"))
476 h) 555 h)
477 (while headers 556 (while headers
478 (setq h (mail-fetch-field (car headers))) 557 (setq h (vm-mail-mode-get-header-contents (car headers)))
479 (and (stringp h) (string-match "[^ \t\n,]" h) 558 (and (stringp h) (string-match "[^ \t\n,]" h)
480 (throw 'done t)) 559 (throw 'done t))
481 (setq headers (cdr headers))) 560 (setq headers (cdr headers)))
482 nil )))) 561 nil ))))
483 562
837 ;; I'd like to do this, but the result is a combination 916 ;; I'd like to do this, but the result is a combination
838 ;; of the Emacs and VM Mail menus glued together. 917 ;; of the Emacs and VM Mail menus glued together.
839 ;; Poorly. 918 ;; Poorly.
840 ;;(define-key vm-mail-mode-map [menu-bar mail] 919 ;;(define-key vm-mail-mode-map [menu-bar mail]
841 ;; (cons "Mail" vm-menu-fsfemacs-mail-menu)) 920 ;; (cons "Mail" vm-menu-fsfemacs-mail-menu))
921 (defvar mail-mode-map)
922 (define-key mail-mode-map [menu-bar mail]
923 (cons "Mail" vm-menu-fsfemacs-mail-menu))
842 (if vm-popup-menu-on-mouse-3 924 (if vm-popup-menu-on-mouse-3
843 (define-key vm-mail-mode-map [down-mouse-3] 925 (define-key vm-mail-mode-map [down-mouse-3]
844 'vm-menu-popup-mode-menu)) 926 'vm-menu-popup-mode-menu)))))
845 ;; replace some FSF Emacs menubar menu commands so the
846 ;; user gets the VM version. Catch errors; we don't
847 ;; care enough about this to make VM crash if the
848 ;; menubar entry names change.
849 (condition-case nil
850 (progn
851 (define-key vm-mail-mode-map [menubar mail send]
852 'vm-mail-send-and-exit)
853 (define-key vm-mail-mode-map [menubar mail send-stay]
854 'vm-mail-send))
855 (error nil)))))
856 927
857 (defun vm-menu-install-menus () 928 (defun vm-menu-install-menus ()
858 (cond ((consp vm-use-menus) 929 (cond ((consp vm-use-menus)
859 (vm-menu-install-vm-mode-menu) 930 (vm-menu-install-vm-mode-menu)
860 (vm-menu-install-menubar) 931 (vm-menu-install-menubar)
1006 1077
1007 1078
1008 (defun vm-menu-hm-make-folder-menu () 1079 (defun vm-menu-hm-make-folder-menu ()
1009 "Makes a menu with the mail folders of the directory `vm-folder-directory'." 1080 "Makes a menu with the mail folders of the directory `vm-folder-directory'."
1010 (interactive) 1081 (interactive)
1011 (vm-unsaved-message "Building folders menu...") 1082 (message "Building folders menu...")
1012 (let ((folder-list (vm-menu-hm-tree-make-file-list vm-folder-directory)) 1083 (let ((folder-list (vm-menu-hm-tree-make-file-list vm-folder-directory))
1013 (inbox-list (if (listp (car vm-spool-files)) 1084 (inbox-list (if (listp (car vm-spool-files))
1014 (mapcar 'car vm-spool-files) 1085 (mapcar 'car vm-spool-files)
1015 (list vm-primary-inbox)))) 1086 (list vm-primary-inbox))))
1016 (setq vm-menu-folders-menu 1087 (setq vm-menu-folders-menu
1063 t 1134 t
1064 )) 1135 ))
1065 "----" 1136 "----"
1066 ["Rebuild Folders Menu" vm-menu-hm-make-folder-menu vm-folder-directory] 1137 ["Rebuild Folders Menu" vm-menu-hm-make-folder-menu vm-folder-directory]
1067 )))) 1138 ))))
1068 (vm-unsaved-message "Building folders menu... done") 1139 (message "Building folders menu... done")
1069 (vm-menu-hm-install-menu)) 1140 (vm-menu-hm-install-menu))
1070 1141
1071 (defun vm-menu-hm-install-menu () 1142 (defun vm-menu-hm-install-menu ()
1072 (cond ((vm-menu-xemacs-menus-p) 1143 (cond ((vm-menu-xemacs-menus-p)
1073 (cond ((car (find-menu-item current-menubar '("VM"))) 1144 (cond ((car (find-menu-item current-menubar '("VM")))