From 0824cd555b61fc20bac91cd1a6469881aff53215 Mon Sep 17 00:00:00 2001 From: yoichi Date: Thu, 13 Feb 2003 20:35:37 +0000 Subject: [PATCH] * 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. --- wl/ChangeLog | 14 +++++++++++++ wl/wl-e21.el | 6 ++++-- wl/wl-fldmgr.el | 24 +++++++++++++-------- wl/wl-folder.el | 62 ++++++++++++++++++++++++++++++++----------------------- wl/wl-mule.el | 6 ++++-- wl/wl-xmas.el | 6 ++++-- 6 files changed, 77 insertions(+), 41 deletions(-) diff --git a/wl/ChangeLog b/wl/ChangeLog index 09ca5f3..06feec7 100644 --- a/wl/ChangeLog +++ b/wl/ChangeLog @@ -1,5 +1,19 @@ 2003-02-14 Yoichi NAKAYAMA + * 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 + * Version number is increased to 2.11.3. 2003-02-13 Yoichi NAKAYAMA diff --git a/wl/wl-e21.el b/wl/wl-e21.el index 84259de..591cce3 100644 --- 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 --- 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 --- 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 --- 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 --- 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)) -- 1.7.10.4