Add "Write for current folder" entry to the toolbar.
[elisp/wanderlust.git] / wl / wl-e21.el
index a3db349..8f7c028 100644 (file)
@@ -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 <yamaoka@jpl.org>
 ;; Copyright (C) 2000,2001 Yuuichi Teranishi <teranisi@gohome.org>
@@ -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.
   (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))
-
 (add-hook 'wl-folder-mode-hook 'wl-setup-folder)
 (add-hook 'wl-folder-mode-hook 'wl-folder-init-icons)
 
@@ -89,6 +80,8 @@ corresponding to the mode line clicked."
 
 (add-hook 'wl-summary-mode-hook 'wl-setup-summary)
 
+(add-hook 'wl-message-display-internal-hook 'wl-setup-message)
+
 (defvar wl-use-toolbar (image-type-available-p 'xpm))
 (defvar wl-plugged-image nil)
 (defvar wl-unplugged-image nil)
@@ -104,12 +97,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-write-current-folder
+     wl-folder-write-current-folder t "Write for Current Folder"]
     [wl-folder-empty-trash
      wl-folder-empty-trash t "Empty Trash"]
     [wl-exit
@@ -134,6 +127,8 @@ corresponding to the mode line clicked."
      wl-summary-mark-as-important t "Mark Current Message as Important"]
     [wl-draft
      wl-draft t "Write a New Message"]
+    [wl-write-current-folder
+     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,18 +172,18 @@ corresponding to the mode line clicked."
 
 (eval-when-compile
   (defmacro wl-e21-display-image-p ()
-    '(and (display-graphic-p)
+    '(and (display-images-p)
          (image-type-available-p 'xpm))))
 
 (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))
          (success t)
-         icon up down disabled name success)
+         icon up down disabled name)
       (while bar
        (setq icon (aref (pop bar) 0))
        (unless (boundp icon)
@@ -205,7 +200,7 @@ 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)))
@@ -240,14 +235,14 @@ corresponding to the mode line clicked."
     (wl-e21-make-toolbar-buttons wl-summary-mode-map wl-summary-toolbar)))
 
 (eval-when-compile
-  (defsubst wl-e21-setup-message-toolbar (keymap)
-    (when (wl-e21-setup-toolbar wl-message-toolbar)
-      (wl-e21-make-toolbar-buttons keymap wl-message-toolbar)))
-
   (defsubst wl-e21-setup-draft-toolbar ()
     (when (wl-e21-setup-toolbar wl-draft-toolbar)
       (wl-e21-make-toolbar-buttons wl-draft-mode-map wl-draft-toolbar))))
 
+(defun wl-e21-setup-message-toolbar ()
+  (when (wl-e21-setup-toolbar wl-message-toolbar)
+    (wl-e21-make-toolbar-buttons (current-local-map) wl-message-toolbar)))
+
 (defvar wl-folder-toggle-icon-list
   '((wl-folder-opened-image       . wl-opened-group-folder-icon)
     (wl-folder-closed-image       . wl-closed-group-folder-icon)))
@@ -267,7 +262,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
@@ -287,7 +282,7 @@ corresponding to the mode line clicked."
       (let ((inhibit-read-only t))
        (if (and wl-highlight-folder-by-numbers
                 numbers (nth 0 numbers) (nth 1 numbers)
-                (re-search-forward "[0-9-]+/[0-9-]+/[0-9-]+"
+                (re-search-forward "[-[:digit:]]+/[-[:digit:]]+/[-[:digit:]]+"
                                    (line-end-position) t))
            (let* ((unsync (nth 0 numbers))
                   (unread (nth 1 numbers))
@@ -339,7 +334,7 @@ corresponding to the mode line clicked."
        (;; basic folder
        (and (setq fld-name (wl-folder-get-folder-name-by-id
                             (get-text-property (point) 'wl-folder-entity-id)))
-            (looking-at "[\t ]+\\([^\t\n ]+\\)"))
+            (looking-at "[[:blank:]]+\\([^[:blank:]\n]+\\)"))
        (setq start (match-beginning 1)
              end (match-end 1))
        (let (image)
@@ -382,7 +377,7 @@ corresponding to the mode line clicked."
        (when (display-color-p)
          (wl-e21-highlight-folder-by-numbers
           start end
-          (if (looking-at (format "^[\t ]*\\(%s\\|%s\\)"
+          (if (looking-at (format "^[[:blank:]]*\\(?:%s\\|%s\\)"
                                   wl-folder-unsubscribe-mark
                                   wl-folder-removed-mark))
               'wl-highlight-folder-killed-face
@@ -394,7 +389,7 @@ corresponding to the mode line clicked."
   (when (wl-e21-display-image-p)
     (save-excursion
       (beginning-of-line)
-      (when (looking-at "[\t ]*\\(\\[\\([^]]+\\)\\]\\)")
+      (when (looking-at "[[:blank:]]*\\(\\[\\([^]]+\\)\\]\\)")
        (let* ((start (match-beginning 1))
               (end (match-end 1))
               (status (match-string-no-properties 2))
@@ -451,7 +446,7 @@ corresponding to the mode line clicked."
 
 (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))
@@ -469,7 +464,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
@@ -500,7 +495,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
@@ -531,19 +526,19 @@ corresponding to the mode line clicked."
 
 (defalias 'wl-setup-summary 'wl-e21-setup-summary-toolbar)
 
-(defun wl-message-overload-functions ()
-  (let ((keymap (current-local-map)))
-    (when keymap
-      (wl-e21-setup-message-toolbar keymap)
-      (define-key keymap "l" 'wl-message-toggle-disp-summary)
-      (define-key keymap [mouse-2] 'wl-message-refer-article-or-url)
-      (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)
-      (set-keymap-parent wl-message-button-map keymap)
-      (define-key wl-message-button-map
-       [mouse-2] 'wl-message-button-dispatcher))))
+(defun wl-message-define-keymap ()
+  (let ((keymap (make-sparse-keymap)))
+    (define-key keymap "l" 'wl-message-toggle-disp-summary)
+    (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)
+    (set-keymap-parent wl-message-button-map keymap)
+    (define-key wl-message-button-map
+      [mouse-2] 'wl-message-button-dispatcher)
+    keymap))
+
+(defalias 'wl-setup-message 'wl-e21-setup-message-toolbar)
 
 (defun wl-message-wheel-up (event)
   (interactive "e")
@@ -616,8 +611,9 @@ 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))
 
 (defun wl-draft-overload-functions ()
   (wl-mode-line-buffer-identification)