* wl.el (wl-init): Setup faces accoding to wl-summary-flag-alist.

[elisp/wanderlust.git] / wl / wl-xmas.el

diff --git a/wl/wl-xmas.el b/wl/wl-xmas.el
index d3d42b5..2994415 100644 (file)
--- a/wl/wl-xmas.el
+++ b/wl/wl-xmas.el
@@ -1,7 +1,8 @@
 ;;; wl-xmas.el --- Wanderlust modules for XEmacsen.
 
-;; Copyright (C) 1998,1999,2000 Yuuichi Teranishi <teranisi@gohome.org>
-;; Copyright (C) 2000 Katsumi Yamaoka <yamaoka@jpl.org>
+;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003
+;;  Yuuichi Teranishi <teranisi@gohome.org>
+;; Copyright (C) 2000, 2001, 2002, 2003 Katsumi Yamaoka <yamaoka@jpl.org>
 
 ;; Author: Yuuichi Teranishi <teranisi@gohome.org>
 ;;     Katsumi Yamaoka <yamaoka@jpl.org>
@@ -89,10 +90,10 @@
      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-summary-write-current-folder t "Write for Current Folder"]
     [wl-summary-reply
@@ -201,13 +202,13 @@
   (defsubst wl-xmas-highlight-folder-group-line (glyph text-face numbers)
     (let ((start (match-beginning 1))
          (end (match-end 1)))
-      (let (extent)
-       (while (and (setq extent (extent-at start nil nil extent 'at))
-                   (not (and (eq start (extent-start-position extent))
-                             (eq end (extent-end-position extent))
-                             (extent-end-glyph extent)))))
-       (unless extent
-         (setq extent (make-extent start end)))
+      (let ((extent (or (map-extents
+                        (lambda (extent maparg)
+                          (and (eq start (extent-start-position extent))
+                               (eq end (extent-end-position extent))
+                               extent))
+                        nil start start nil nil 'end-glyph)
+                       (make-extent start end))))
        (set-extent-properties extent `(end-open t start-closed t invisible t))
        (set-extent-end-glyph
         extent
@@ -252,12 +253,14 @@
     (let (fld-name)
       (cond
        (;; opened folder group
-       (looking-at wl-highlight-folder-opened-regexp)
+       (and (wl-folder-buffer-group-p)
+            (looking-at wl-highlight-folder-opened-regexp))
        (wl-xmas-highlight-folder-group-line 'wl-folder-opened-glyph
                                             '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))
        (wl-xmas-highlight-folder-group-line 'wl-folder-closed-glyph
                                             'wl-highlight-folder-closed-face
                                             numbers))
@@ -266,13 +269,13 @@
                             (get-text-property (point) 'wl-folder-entity-id)))
             (looking-at "[ \t]+\\([^ \t]+\\)"))
        (let ((start (match-beginning 1)))
-         (let (extent)
-           (while (and (setq extent (extent-at start nil nil extent 'at))
-                       (not (and (eq start (extent-start-position extent))
-                                 (eq start (extent-end-position extent))
-                                 (extent-begin-glyph extent)))))
-           (unless extent
-             (setq extent (make-extent start start)))
+         (let ((extent (or (map-extents
+                            (lambda (extent maparg)
+                              (and (eq start (extent-start-position extent))
+                                   (eq start (extent-end-position extent))
+                                   extent))
+                            nil start start nil nil 'begin-glyph)
+                           (make-extent start start))))
            (let (type)
              (set-extent-begin-glyph
               extent
@@ -377,6 +380,7 @@
     (wl-folder-maildir-glyph   . wl-maildir-folder-icon)
     (wl-folder-nmz-glyph       . wl-nmz-folder-icon)
     (wl-folder-shimbun-glyph   . wl-shimbun-folder-icon)
+    (wl-folder-file-glyph      . wl-file-folder-icon)
     (wl-folder-trash-empty-glyph . wl-empty-trash-folder-icon)
     (wl-folder-draft-glyph     . wl-draft-folder-icon)
     (wl-folder-queue-glyph     . wl-queue-folder-icon)
@@ -446,7 +450,10 @@
 
 (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 'button4 'wl-message-wheel-down)
     (define-key keymap 'button5 'wl-message-wheel-up)
     (define-key keymap [(shift button4)] 'wl-message-wheel-down)
@@ -531,7 +538,9 @@ Special commands:
   (define-key wl-draft-mode-map "\C-c\C-a" 'wl-addrmgr)
   (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 "\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)