X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=wl%2Fwl-e21.el;h=ffabf4a04f1421ad3bf31050a499fd542428be67;hb=c46a4752aab3b3c1a6136e36104806d5d7dc9025;hp=cc48f90b209c48946a8cdb99c218a45e3a04299b;hpb=4c0926c573fd336d678d1795bd3ef84792e076da;p=elisp%2Fwanderlust.git diff --git a/wl/wl-e21.el b/wl/wl-e21.el index cc48f90..ffabf4a 100644 --- a/wl/wl-e21.el +++ b/wl/wl-e21.el @@ -1,4 +1,4 @@ -;;; wl-e21.el -- Wanderlust modules for Emacs 21. +;;; wl-e21.el --- Wanderlust modules for Emacs 21. ;; Copyright (C) 2000,2001 Katsumi Yamaoka ;; Copyright (C) 2000,2001 Yuuichi Teranishi @@ -33,7 +33,7 @@ ;;(let (image icon from to overlay) ;; ;; The function `find-image' will look for an image first on `load-path' ;; ;; and then in `data-directory'. -;; (let ((load-path (cons wl-icon-dir load-path))) +;; (let ((load-path (cons wl-icon-directory load-path))) ;; (setq image (find-image (list (list :type 'xpm :file wl-nntp-folder-icon ;; :ascent 'center))))) ;; ;; `propertize' is a convenient function in such a case. @@ -69,21 +69,8 @@ (require 'wl-draft) (require 'wl-message) (require 'wl-highlight) - (defvar-maybe wl-folder-mode-map (make-sparse-keymap)) (defvar-maybe wl-draft-mode-map (make-sparse-keymap))) -;; For Emacs 21.0.104 or earlier -(defun-maybe make-mode-line-mouse-map (mouse function) "\ -Return a keymap with single entry for mouse key MOUSE on the mode line. -MOUSE is defined to run function FUNCTION with no args in the buffer -corresponding to the mode line clicked." - (let ((map (make-sparse-keymap))) - (define-key map (vector 'mode-line mouse) function) - map)) - -;; `display-images-p' has not been available prior to Emacs 21.0.105. -(defalias-maybe 'display-images-p 'display-graphic-p) - (add-hook 'wl-folder-mode-hook 'wl-setup-folder) (add-hook 'wl-folder-mode-hook 'wl-folder-init-icons) @@ -109,12 +96,12 @@ corresponding to the mode line clicked." wl-folder-prev-entity t "Previous Folder"] [wl-folder-check-current-entity wl-folder-check-current-entity t "Check Current Folder"] - ;;[wl-draft - ;; wl-draft t "Write a New Message"] [wl-folder-sync-current-entity wl-folder-sync-current-entity t "Sync Current Folder"] [wl-draft wl-draft t "Write a New Message"] + [wl-folder-goto-draft-folder + wl-folder-goto-draft-folder t "Go to Draft Folder"] [wl-folder-empty-trash wl-folder-empty-trash t "Empty Trash"] [wl-exit @@ -133,12 +120,12 @@ corresponding to the mode line clicked." wl-summary-jump-to-current-message t "Jump to Current Message"] [wl-summary-sync-force-update wl-summary-sync-force-update t "Sync Current Folder"] - [wl-summary-delete - wl-summary-delete t "Delete Current Message"] - [wl-summary-mark-as-important - wl-summary-mark-as-important t "Mark Current Message as Important"] + [wl-summary-dispose + wl-summary-dispose t "Dispose Current Message"] + [wl-summary-set-flags + wl-summary-set-flags t "Set Flags"] [wl-draft - wl-draft t "Write a New Message"] + wl-summary-write-current-folder t "Write for Current Folder"] [wl-summary-reply wl-summary-reply t "Reply to Current Message" ] [wl-summary-reply-with-citation @@ -177,6 +164,8 @@ corresponding to the mode line clicked." wl-draft-insert-signature t "Insert Signature"] [wl-draft-kill wl-draft-kill t "Kill Current Draft"] + [wl-draft-save-and-exit + wl-draft-save-and-exit t "Save Draft and Exit"] ) "The Draft buffer toolbar.") @@ -188,7 +177,7 @@ corresponding to the mode line clicked." (defun wl-e21-setup-toolbar (bar) (when (and wl-use-toolbar (wl-e21-display-image-p)) - (let ((load-path (cons wl-icon-dir load-path)) + (let ((load-path (cons wl-icon-directory load-path)) (props '(:type xpm :ascent center :color-symbols (("backgroundToolBarColor" . "None")) :file)) @@ -210,10 +199,10 @@ corresponding to the mode line clicked." success))) (defvar wl-e21-toolbar-configurations - '((auto-resize-tool-bar . t) + '((auto-resize-tool-bars . t) (auto-raise-tool-bar-buttons . t) - (tool-bar-button-margin . 0) - (tool-bar-button-relief . 2))) + (tool-bar-button-margin . 2) + (tool-bar-button-relief . 1))) (defun wl-e21-make-toolbar-buttons (keymap defs) (let ((configs wl-e21-toolbar-configurations) @@ -272,7 +261,7 @@ corresponding to the mode line clicked." (unless image (let ((name (symbol-value (cdr (assq icon wl-folder-toggle-icon-list)))) - (load-path (cons wl-icon-dir load-path))) + (load-path (cons wl-icon-directory load-path))) (when (setq image (find-image `((:type xpm :file ,name :ascent center)))) (setq image (put icon 'image (propertize name @@ -322,7 +311,8 @@ corresponding to the mode line clicked." (let (fld-name start end) (cond (;; opened folder group - (looking-at wl-highlight-folder-opened-regexp) + (and (wl-folder-buffer-group-p) + (looking-at wl-highlight-folder-opened-regexp)) (setq start (match-beginning 1) end (match-end 1)) (wl-e21-highlight-folder-group-line start end @@ -332,7 +322,8 @@ corresponding to the mode line clicked." 'wl-highlight-folder-opened-face numbers)) (;; closed folder group - (looking-at wl-highlight-folder-closed-regexp) + (and (wl-folder-buffer-group-p) + (looking-at wl-highlight-folder-closed-regexp)) (setq start (match-beginning 1) end (match-end 1)) (wl-e21-highlight-folder-group-line start end @@ -372,7 +363,9 @@ corresponding to the mode line clicked." ((string= fld-name wl-queue-folder);; queue folder (get 'wl-folder-queue-image 'image)) (;; and one of many other folders - (setq type (elmo-folder-type fld-name)) + (setq type (or (elmo-folder-type fld-name) + (elmo-folder-type-internal + (elmo-make-folder fld-name)))) (get (intern (format "wl-folder-%s-image" type)) 'image))))) (overlay-put overlay 'before-string image))) @@ -436,27 +429,28 @@ corresponding to the mode line clicked." (defvar wl-folder-internal-icon-list ;; alist of (image . icon-file) - '((wl-folder-nntp-image . wl-nntp-folder-icon) - (wl-folder-imap4-image . wl-imap-folder-icon) - (wl-folder-pop3-image . wl-pop-folder-icon) + '((wl-folder-nntp-image . wl-nntp-folder-icon) + (wl-folder-imap4-image . wl-imap-folder-icon) + (wl-folder-pop3-image . wl-pop-folder-icon) (wl-folder-localdir-image . wl-localdir-folder-icon) (wl-folder-localnews-image . wl-localnews-folder-icon) (wl-folder-internal-image . wl-internal-folder-icon) - (wl-folder-multi-image . wl-multi-folder-icon) + (wl-folder-multi-image . wl-multi-folder-icon) (wl-folder-filter-image . wl-filter-folder-icon) (wl-folder-archive-image . wl-archive-folder-icon) - (wl-folder-pipe-image . wl-pipe-folder-icon) + (wl-folder-pipe-image . wl-pipe-folder-icon) (wl-folder-maildir-image . wl-maildir-folder-icon) - (wl-folder-nmz-image . wl-nmz-folder-icon) + (wl-folder-nmz-image . wl-nmz-folder-icon) (wl-folder-shimbun-image . wl-shimbun-folder-icon) + (wl-folder-file-image . wl-file-folder-icon) (wl-folder-trash-empty-image . wl-empty-trash-folder-icon) - (wl-folder-draft-image . wl-draft-folder-icon) - (wl-folder-queue-image . wl-queue-folder-icon) - (wl-folder-trash-image . wl-trash-folder-icon))) + (wl-folder-draft-image . wl-draft-folder-icon) + (wl-folder-queue-image . wl-queue-folder-icon) + (wl-folder-trash-image . wl-trash-folder-icon))) (defun wl-folder-init-icons () (when (wl-e21-display-image-p) - (let ((load-path (cons wl-icon-dir load-path)) + (let ((load-path (cons wl-icon-directory load-path)) (icons wl-folder-internal-icon-list) icon name image) (while (setq icon (pop icons)) @@ -474,7 +468,7 @@ corresponding to the mode line clicked." (if (wl-e21-display-image-p) (progn (unless wl-plugged-image - (let ((load-path (cons wl-icon-dir load-path))) + (let ((load-path (cons wl-icon-directory load-path))) (setq wl-plugged-image (find-image `((:type xpm :file ,wl-plugged-icon @@ -505,7 +499,7 @@ corresponding to the mode line clicked." (if (wl-e21-display-image-p) (progn (unless wl-biff-mail-image - (let ((load-path (cons wl-icon-dir load-path))) + (let ((load-path (cons wl-icon-directory load-path))) (setq wl-biff-mail-image (find-image `((:type xpm :file ,wl-biff-mail-icon @@ -536,17 +530,19 @@ corresponding to the mode line clicked." (defalias 'wl-setup-summary 'wl-e21-setup-summary-toolbar) -(defvar widget-keymap) (defun wl-message-define-keymap () (let ((keymap (make-sparse-keymap))) + (define-key keymap "D" 'wl-message-delete-current-part) (define-key keymap "l" 'wl-message-toggle-disp-summary) + (define-key keymap "\C-c:d" 'wl-message-decrypt-pgp-nonmime) + (define-key keymap "\C-c:v" 'wl-message-verify-pgp-nonmime) (define-key keymap [mouse-4] 'wl-message-wheel-down) (define-key keymap [mouse-5] 'wl-message-wheel-up) (define-key keymap [S-mouse-4] 'wl-message-wheel-down) (define-key keymap [S-mouse-5] 'wl-message-wheel-up) - (when (and (get 'mime-button 'widget-type) ; mime-button is defined. - (boundp 'widget-keymap)) - (set-keymap-parent keymap widget-keymap)) + ;; Meadow2 + (define-key keymap [mouse-wheel1] 'wl-message-wheel-dispatcher) + (define-key keymap [S-mouse-wheel1] 'wl-message-wheel-dispatcher) (set-keymap-parent wl-message-button-map keymap) (define-key wl-message-button-map [mouse-2] 'wl-message-button-dispatcher) @@ -554,9 +550,26 @@ corresponding to the mode line clicked." (defalias 'wl-setup-message 'wl-e21-setup-message-toolbar) +;; Wheel handling for Meadow2 +(defun wl-message-wheel-dispatcher (event) + (interactive "e") + (if (< (nth 4 (nth 1 event)) 0) + (wl-message-wheel-up event) + (wl-message-wheel-down event))) + +(defun wl-summary-wheel-dispatcher (event) + (interactive "e") + (if (< (nth 4 (nth 1 event)) 0) + (if (memq 'shift (event-modifiers event)) + (wl-summary-down) + (wl-summary-next)) + (if (memq 'shift (event-modifiers event)) + (wl-summary-up) + (wl-summary-prev)))) + (defun wl-message-wheel-up (event) (interactive "e") - (if (string-match (regexp-quote wl-message-buffer-cache-name) + (if (string-match (regexp-quote wl-message-buffer-name) (regexp-quote (buffer-name))) (wl-message-next-page) (let ((cur-buf (current-buffer)) @@ -572,7 +585,7 @@ corresponding to the mode line clicked." (defun wl-message-wheel-down (event) (interactive "e") - (if (string-match (regexp-quote wl-message-buffer-cache-name) + (if (string-match (regexp-quote wl-message-buffer-name) (regexp-quote (buffer-name))) (wl-message-prev-page) (let ((cur-buf (current-buffer)) @@ -592,8 +605,20 @@ corresponding to the mode line clicked." '("Send Message" . wl-draft-send-and-exit)) (define-key keymap [menu-bar mail send-stay] '("Send, Keep Editing" . wl-draft-send)) + (define-key-after (lookup-key keymap [menu-bar mail]) + [mail-sep-send] '("--") + 'send-stay) (define-key keymap [menu-bar mail cancel] '("Kill Current Draft" . wl-draft-kill)) + (define-key-after (lookup-key keymap [menu-bar mail]) + [save] '("Save Draft and Exit" . wl-draft-save-and-exit) + 'cancel) + (define-key-after (lookup-key keymap [menu-bar mail]) + [mail-sep-exit] '("--") + 'save) + (define-key-after (lookup-key keymap [menu-bar mail]) + [preview] '("Preview Message" . wl-draft-preview-message) + 'mail-sep-exit) (define-key keymap [menu-bar mail yank] '("Cite Message" . wl-draft-yank-original)) (define-key keymap [menu-bar mail signature] @@ -625,8 +650,12 @@ Special commands: (define-key wl-draft-mode-map "\C-c\C-j" 'wl-template-select) (define-key wl-draft-mode-map "\C-c\C-p" 'wl-draft-preview-message) (define-key wl-draft-mode-map "\C-c\C-a" 'wl-addrmgr) - (define-key wl-draft-mode-map "\C-x\C-s" 'wl-draft-save) - (define-key wl-draft-mode-map "\C-xk" 'wl-draft-mimic-kill-buffer)) +;; (define-key wl-draft-mode-map "\C-x\C-s" 'wl-draft-save) + (define-key wl-draft-mode-map "\C-xk" 'wl-draft-mimic-kill-buffer) + (define-key wl-draft-mode-map "\C-c\C-d" 'wl-draft-elide-region) + (define-key wl-draft-mode-map "\C-a" 'wl-draft-beginning-of-line) + (define-key wl-draft-mode-map "\M-p" 'wl-draft-previous-history-element) + (define-key wl-draft-mode-map "\M-n" 'wl-draft-next-history-element)) (defun wl-draft-overload-functions () (wl-mode-line-buffer-identification) @@ -641,6 +670,13 @@ Special commands: (let ((event (read-event))) (cons (and (numberp event) event) event))) +(defalias 'wl-completing-read-multiple 'completing-read-multiple) + +(put 'wl-modeline-biff-state-on 'risky-local-variable t) +(put 'wl-modeline-biff-state-off 'risky-local-variable t) +(put 'wl-modeline-plug-state-on 'risky-local-variable t) +(put 'wl-modeline-plug-state-off 'risky-local-variable t) + (require 'product) (product-provide (provide 'wl-e21) (require 'wl-version))