* wl-folder.el (wl-folder-buffer-group-p): Rewritten.

(wl-folder-put-folder-property): New function to put text property.
(wl-folder-jump-to-current-entity, wl-folder-entity-assign-id)
(wl-folder-insert-entity, wl-folder-update-diff-line)
(wl-folder-update-diff-line, wl-folder-pick): Change accordingly.
* wl-e21.el, wl-xmas.el, wl-mule.el
(wl-highlight-folder-current-line): Ditto.
* wl-fldmgr.el (wl-fldmgr-get-path-from-buffer, wl-fldmgr-cut)
(wl-fldmgr-copy-region, wl-fldmgr-copy, wl-fldmgr-delete)
(wl-fldmgr-rename, wl-fldmgr-sort, wl-fldmgr-unsubscribe)
(wl-fldmgr-access-display-all, wl-fldmgr-set-petname): Ditto.

diff --git a/wl/ChangeLog b/wl/ChangeLog
index 09ca5f3..06feec7 100644 (file)
--- a/wl/ChangeLog
+++ b/wl/ChangeLog
@@ -1,5 +1,19 @@
 2003-02-14  Yoichi NAKAYAMA  <yoichi@eken.phys.nagoya-u.ac.jp>
 
+       * wl-folder.el (wl-folder-buffer-group-p): Rewritten.
+       (wl-folder-put-folder-property): New function to put text property.
+       (wl-folder-jump-to-current-entity, wl-folder-entity-assign-id)
+       (wl-folder-insert-entity, wl-folder-update-diff-line)
+       (wl-folder-update-diff-line, wl-folder-pick): Change accordingly.
+       * wl-e21.el, wl-xmas.el, wl-mule.el
+       (wl-highlight-folder-current-line): Ditto.
+       * wl-fldmgr.el (wl-fldmgr-get-path-from-buffer, wl-fldmgr-cut)
+       (wl-fldmgr-copy-region, wl-fldmgr-copy, wl-fldmgr-delete)
+       (wl-fldmgr-rename, wl-fldmgr-sort, wl-fldmgr-unsubscribe)
+       (wl-fldmgr-access-display-all, wl-fldmgr-set-petname): Ditto.
+
+2003-02-14  Yoichi NAKAYAMA  <yoichi@eken.phys.nagoya-u.ac.jp>
+
        * Version number is increased to 2.11.3.
 
 2003-02-13  Yoichi NAKAYAMA  <yoichi@eken.phys.nagoya-u.ac.jp>

diff --git a/wl/wl-e21.el b/wl/wl-e21.el
index 84259de..591cce3 100644 (file)
--- a/wl/wl-e21.el
+++ b/wl/wl-e21.el
@@ -311,7 +311,8 @@
     (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
@@ -321,7 +322,8 @@
                                            '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

diff --git a/wl/wl-fldmgr.el b/wl/wl-fldmgr.el
index 699c390..f4c1a45 100644 (file)
--- a/wl/wl-fldmgr.el
+++ b/wl/wl-fldmgr.el
@@ -458,6 +458,7 @@ return value is diffs '(-new -unread -all)."
 ;;;                     (wl-fldmgr-get-entity-id (cdr previous-entity))))))
        (wl-folder-prev-entity-skip-invalid))
       (if (and prev
+              (wl-folder-buffer-group-p)
               (looking-at wl-folder-group-regexp)
               (string= (wl-match-buffer 2) "-"))
          (setq group-target nil)
@@ -593,7 +594,8 @@ return value is diffs '(-new -unread -all)."
                    (wl-delete-entity path nil wl-folder-entity clear)))
          (setq wl-fldmgr-modified t)
          ;;
-         (if (looking-at wl-folder-group-regexp)
+         (if (and (wl-folder-buffer-group-p)
+                  (looking-at wl-folder-group-regexp))
              ;; group
              (let (beg end indent opened)
                (setq indent (wl-match-buffer 1))
@@ -647,7 +649,7 @@ return value is diffs '(-new -unread -all)."
        (while (< (point) to)
          (and (looking-at "^\\([ ]*\\)")
               (setq indent (wl-match-buffer 1)))
-         (if (looking-at wl-folder-group-regexp)
+         (if (wl-folder-buffer-group-p)
              (progn
                (setq errmes "can't copy group folder")
                (throw 'err t)))
@@ -685,7 +687,7 @@ return value is diffs '(-new -unread -all)."
     (beginning-of-line)
     (let ((ret-val nil))
       (if (and (not ename)
-              (looking-at wl-folder-group-regexp))
+              (wl-folder-buffer-group-p))
          (message "Can't copy group folder")
        (let* ((name (or ename (wl-folder-get-entity-from-buffer)))
               (entity (elmo-string name)))
@@ -840,7 +842,7 @@ return value is diffs '(-new -unread -all)."
   (interactive)
   (save-excursion
     (beginning-of-line)
-    (if (looking-at wl-folder-group-regexp)
+    (if (wl-folder-buffer-group-p)
        (error "Can't delete group folder"))
     (let* ((inhibit-read-only t)
           (tmp (wl-fldmgr-get-path-from-buffer))
@@ -863,7 +865,8 @@ return value is diffs '(-new -unread -all)."
     (if (bobp)
        (message "Can't rename desktop group")
       (cond
-       ((looking-at wl-folder-group-regexp) ;; group
+       ((and (wl-folder-buffer-group-p)
+            (looking-at wl-folder-group-regexp)) ;; group
        (let* ((indent (wl-match-buffer 1))
               (old-group (wl-folder-get-realname (wl-match-buffer 3)))
               (group-entity (wl-folder-search-group-entity-by-name
@@ -1043,7 +1046,8 @@ return value is diffs '(-new -unread -all)."
     (beginning-of-line)
     (let ((inhibit-read-only t)
          entity flist indent opened)
-      (when (looking-at wl-folder-group-regexp)
+      (when (and (wl-folder-buffer-group-p)
+                (looking-at wl-folder-group-regexp))
        (setq indent (wl-match-buffer 1))
        (setq opened (wl-match-buffer 2))
        (setq entity (wl-folder-search-group-entity-by-name
@@ -1146,7 +1150,7 @@ return value is diffs '(-new -unread -all)."
         (t
          (if (and type (< type 0))
              nil
-           (setq is-group (looking-at wl-folder-group-regexp))
+           (setq is-group (wl-folder-buffer-group-p))
            (setq tmp (wl-fldmgr-get-path-from-buffer))
            (setq indent (wl-fldmgr-make-indent (nth 1 tmp)))
            (if (eq (cdr (nth 2 tmp)) 'access)
@@ -1182,7 +1186,9 @@ return value is diffs '(-new -unread -all)."
     (let ((inhibit-read-only t)
          entity indent opened
          unsubscribes beg)
-      (when (not (looking-at wl-folder-group-regexp))
+      (when (not
+            (and (wl-folder-buffer-group-p)
+                 (looking-at wl-folder-group-regexp)))
        (wl-folder-goto-top-of-current-folder)
        (looking-at wl-folder-group-regexp))
       (setq indent (wl-match-buffer 1))
@@ -1227,7 +1233,7 @@ return value is diffs '(-new -unread -all)."
   (interactive)
   (save-excursion
     (beginning-of-line)
-      (let* ((is-group (looking-at wl-folder-group-regexp))
+      (let* ((is-group (wl-folder-buffer-group-p))
             (name (wl-folder-get-entity-from-buffer))
             (searchname (wl-folder-get-petname name))
             (pentry (wl-string-assoc name wl-folder-petname-alist))

diff --git a/wl/wl-folder.el b/wl/wl-folder.el
index ad8a1dd..8500617 100644 (file)
--- a/wl/wl-folder.el
+++ b/wl/wl-folder.el
@@ -227,8 +227,7 @@
               ""))))
 
 (defmacro wl-folder-buffer-group-p ()
-  (` (save-excursion (beginning-of-line)
-                    (looking-at wl-folder-group-regexp))))
+  (` (get-text-property (point) 'wl-folder-is-group)))
 
 (defmacro wl-folder-folder-name ()
   (` (save-excursion
@@ -606,7 +605,8 @@ Optional argument ARG is repeart count."
   (beginning-of-line)
   (let (entity beg end indent opened fname err fld-name)
     (cond
-     ((looking-at wl-folder-group-regexp)
+     ((and (wl-folder-buffer-group-p)
+          (looking-at wl-folder-group-regexp))
       (save-excursion
        (setq fname (wl-folder-get-realname (wl-match-buffer 3)))
        (setq indent (wl-match-buffer 1))
@@ -1298,10 +1298,11 @@ If current line is group folder, all subfolders are marked."
                        (get-text-property 0
                                           'wl-folder-entity-id
                                           (car entity))))
-         (put-text-property 0 (length (car entity))
-                            'wl-folder-entity-id
-                            wl-folder-entity-id
-                            (car entity))
+         (wl-folder-put-folder-property
+          0 (length (car entity))
+          wl-folder-entity-id
+          'is-group
+          (car entity))
          (wl-folder-set-id-name wl-folder-entity-id
                                 (car entity) hashtb))
        (and entities
@@ -1312,10 +1313,11 @@ If current line is group folder, all subfolders are marked."
                        (get-text-property 0
                                           'wl-folder-entity-id
                                           entity)))
-         (put-text-property 0 (length entity)
-                            'wl-folder-entity-id
-                            wl-folder-entity-id
-                            entity)
+         (wl-folder-put-folder-property
+          0 (length entity)
+          wl-folder-entity-id
+          nil
+          entity)
          (wl-folder-set-id-name wl-folder-entity-id
                                 entity hashtb))))
       (setq wl-folder-entity-id (+ 1 wl-folder-entity-id))
@@ -1703,9 +1705,10 @@ Entering Folder mode calls the value of `wl-folder-mode-hook'."
                      (wl-folder-get-petname (car entity)))
              (setq group-name-end (point))
              (insert ":0/0/0\n")
-             (put-text-property beg (point) 'wl-folder-entity-id
-                                (get-text-property 0 'wl-folder-entity-id
-                                                   (car entity)))
+             (wl-folder-put-folder-property
+              beg (point)
+              (get-text-property 0 'wl-folder-entity-id (car entity))
+              'is-group)
              (when removed
                (setq beg (point))
                (while removed
@@ -1752,9 +1755,10 @@ Entering Folder mode calls the value of `wl-folder-mode-hook'."
                          (or (nth 1 ret-val) 0)
                          (or (nth 2 ret-val) 0))
                  "\n")
-         (put-text-property beg (point) 'wl-folder-entity-id
-                            (get-text-property 0 'wl-folder-entity-id
-                                               (car entity)))
+         (wl-folder-put-folder-property
+          beg (point)
+          (get-text-property 0 'wl-folder-entity-id (car entity))
+          'is-group)
          (save-excursion (forward-line -1)
                          (wl-highlight-folder-current-line ret-val)))))
      ((stringp entity)
@@ -1770,8 +1774,10 @@ Entering Folder mode calls the value of `wl-folder-mode-hook'."
                                              (+ (nth 0 nums)(nth 1 nums))))
                            "*")
                        (or (setq all (nth 2 nums)) "*")))
-       (put-text-property beg (point) 'wl-folder-entity-id
-                          (get-text-property 0 'wl-folder-entity-id entity))
+       (wl-folder-put-folder-property
+        beg (point)
+        (get-text-property 0 'wl-folder-entity-id entity)
+        nil)
        (save-excursion (forward-line -1)
                        (wl-highlight-folder-current-line nums))
        (setq ret-val (list new unread all)))))
@@ -2151,10 +2157,11 @@ Use `wl-subscribed-mailing-list'."
        cur-new new-new
        cur-unread new-unread
        cur-all new-all
-       id)
+       id is-group)
     (save-excursion
       (beginning-of-line)
       (setq id (get-text-property (point) 'wl-folder-entity-id))
+      (setq is-group (get-text-property (point) 'wl-folder-is-group))
       (when (looking-at "^[ ]*\\(.*\\):\\([0-9\\*-]*\\)/\\([0-9\\*-]*\\)/\\([0-9\\*]*\\)")
        ;;(looking-at "^[ ]*\\([^\\[].+\\):\\([0-9\\*-]*/[0-9\\*-]*/[0-9\\*]*\\)")
        (setq cur-new (string-to-int
@@ -2170,8 +2177,7 @@ Use `wl-subscribed-mailing-list'."
                        (setq new-new (+ cur-new (nth 0 diffs)))
                        (setq new-unread (+ cur-unread (nth 1 diffs)))
                        (setq new-all (+ cur-all (nth 2 diffs)))))
-       (put-text-property (match-beginning 2) (point)
-                          'wl-folder-entity-id id)
+       (wl-folder-put-folder-property (match-beginning 2) (point) id is-group)
        (if wl-use-highlight-mouse-line
            (put-text-property (match-beginning 2) (point)
                               'mouse-face 'highlight))
@@ -2182,10 +2188,11 @@ Use `wl-subscribed-mailing-list'."
 (defun wl-folder-update-line (nums &optional is-group)
   (let ((inhibit-read-only t)
        (buffer-read-only nil)
-       id)
+       id is-group)
     (save-excursion
       (beginning-of-line)
       (setq id (get-text-property (point) 'wl-folder-entity-id))
+      (setq is-group (get-text-property (point) 'wl-folder-is-group))
       (if (looking-at "^[ ]*\\(.*\\):\\([0-9\\*-]*/[0-9\\*-]*/[0-9\\*]*\\)")
 ;;;      (looking-at "^[ ]*\\([^\\[].+\\):\\([0-9\\*-]*/[0-9\\*-]*/[0-9\\*]*\\)")
          (progn
@@ -2198,8 +2205,7 @@ Use `wl-subscribed-mailing-list'."
                                     (+ (nth 0 nums)(nth 1 nums)))
                                "*")
                            (or (nth 2 nums) "*")))
-           (put-text-property (match-beginning 2) (point)
-                              'wl-folder-entity-id id)
+           (put-text-property (match-beginning 2) (point) id is-group)
            (if is-group
                ;; update only colors
                (wl-highlight-folder-group-line nums)
@@ -2434,7 +2440,8 @@ Use `wl-subscribed-mailing-list'."
                       (car path))))))
        (beginning-of-line)
        (setq path (cdr path))
-       (if (and (looking-at wl-folder-group-regexp)
+       (if (and (wl-folder-buffer-group-p)
+                 (looking-at wl-folder-group-regexp)
                 (string= "+" (wl-match-buffer 2)));; closed group
            (save-excursion
              (setq indent (wl-match-buffer 1))
@@ -2982,6 +2989,9 @@ Call `wl-summary-write-current-folder' with current folder name."
          (try-completion string candidate)
        (all-completions string candidate))))))
 
+(defun wl-folder-put-folder-property (beg end id is-group &optional object)
+  (put-text-property beg end 'wl-folder-entity-id id object)
+  (put-text-property beg end 'wl-folder-is-group is-group object))
 
 (require 'product)
 (product-provide (provide 'wl-folder) (require 'wl-version))

diff --git a/wl/wl-mule.el b/wl/wl-mule.el
index 75038c0..8f3e799 100644 (file)
--- a/wl/wl-mule.el
+++ b/wl/wl-mule.el
@@ -57,9 +57,11 @@ Special commands:
          (start (progn (beginning-of-line) (point)))
          (inhibit-read-only t)
          (text-face
-          (cond ((looking-at wl-highlight-folder-opened-regexp)
+          (cond ((and (wl-folder-buffer-group-p)
+                      (looking-at wl-highlight-folder-opened-regexp))
                  'wl-highlight-folder-opened-face)
-                ((looking-at wl-highlight-folder-closed-regexp)
+                ((and (wl-folder-buffer-group-p)
+                      (looking-at wl-highlight-folder-closed-regexp))
                  'wl-highlight-folder-closed-face)
                 (t
                  (if (looking-at (format "^[ \t]*\\(%s\\|%s\\)"

diff --git a/wl/wl-xmas.el b/wl/wl-xmas.el
index 6667d89..a7f03ff 100644 (file)
--- a/wl/wl-xmas.el
+++ b/wl/wl-xmas.el
@@ -252,12 +252,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))