* wl-vars.el (wl-folder-use-frame): New user option.
[elisp/wanderlust.git] / wl / wl-folder.el
index 78290b3..7afc18d 100644 (file)
@@ -840,7 +840,7 @@ Optional argument ARG is repeart count."
                                             (elmo-msgdb-expand-path entity))
                                            entity)))
                                         (cdr nums))
-                                  (current-buffer)))
+                                  (get-buffer wl-folder-buffer-name)))
     (setq wl-folder-info-alist-modified t)
     (sit-for 0)
     (list (if wl-folder-notify-deleted
@@ -981,12 +981,17 @@ If current line is group folder, check all sub entries."
       (setq unread (or (cadr nums) 0))
       (if (or (not unread-only)
              (or (< 0 new) (< 0 unread)))
-         (save-window-excursion
-           (save-excursion
-             (wl-summary-goto-folder-subr entity
-                                          (wl-summary-get-sync-range entity)
-                                          nil nil nil t)
-             (wl-summary-exit))))))))
+         (let ((wl-summary-buffer-name (concat
+                                        wl-summary-buffer-name
+                                        (symbol-name this-command)))
+               (wl-message-buf-name (concat wl-message-buf-name
+                                            (symbol-name this-command))))
+           (save-window-excursion
+             (save-excursion
+               (wl-summary-goto-folder-subr entity
+                                            (wl-summary-get-sync-range entity)
+                                            nil nil nil t)
+               (wl-summary-exit)))))))))
 
 (defun wl-folder-sync-current-entity (&optional unread-only)
   "Synchronize the folder at position.
@@ -1023,13 +1028,18 @@ If current line is group folder, check all subfolders."
       (setq new (or (car nums) 0))
       (setq unread (or (cadr nums) 0))
       (if (or (< 0 new) (< 0 unread))
-       (save-window-excursion
-         (save-excursion
-           (wl-summary-goto-folder-subr entity
-                                        (wl-summary-get-sync-range entity)
-                                        nil)
-           (wl-summary-mark-as-read-all)
-           (wl-summary-exit)))
+         (let ((wl-summary-buffer-name (concat
+                                        wl-summary-buffer-name
+                                        (symbol-name this-command)))
+               (wl-message-buf-name (concat wl-message-buf-name
+                                            (symbol-name this-command))))
+           (save-window-excursion
+             (save-excursion
+               (wl-summary-goto-folder-subr entity
+                                          (wl-summary-get-sync-range entity)
+                                          nil)
+               (wl-summary-mark-as-read-all)
+               (wl-summary-exit))))
        (sit-for 0))))))
 
 (defun wl-folder-mark-as-read-all-current-entity ()
@@ -1276,19 +1286,21 @@ If current line is group folder, all subfolders are marked."
 
 (defun wl-folder-select-buffer (buffer)
   (let ((gbw (get-buffer-window buffer))
-       ret-val)
+       exists)
     (if gbw
        (progn (select-window gbw)
-              (setq ret-val t))
-      (condition-case ()
-         (unwind-protect
-             (split-window-horizontally wl-folder-window-width)
-           (other-window 1))
-       (error nil)))
+              (setq exists t))
+      (unless wl-folder-use-frame
+       (condition-case ()
+           (unwind-protect
+               (split-window-horizontally wl-folder-window-width)
+             (other-window 1))
+         (error nil))))
     (set-buffer buffer)
-    (switch-to-buffer buffer)
-    ret-val
-    ))
+    (if wl-folder-use-frame
+       (switch-to-buffer-other-frame buffer)
+      (switch-to-buffer buffer))
+    exists))
 
 (defun wl-folder-toggle-disp-summary (&optional arg folder)
   (interactive)
@@ -1386,7 +1398,7 @@ If current line is group folder, all subfolders are marked."
 
 (defun wl-folder-mode ()
   "Major mode for Wanderlust Folder.
-See info under Wanderlust for full documentation.
+See Info under Wanderlust for full documentation.
 
 Special commands:
 \\{wl-folder-mode-map}
@@ -2038,12 +2050,8 @@ Don't care multi."
                                                 'case-ignore)))
            (setq toalist (append toalist (cdr (car rules)))))
        (setq rules (cdr rules)))
-      (when toalist
-       (setq tokey (car (rassoc folder toalist)))
+      (setq tokey (car (rassoc folder toalist)))
 ;;;     (setq histkey (car (rassoc folder wl-refile-alist)))
-       (elmo-string-matched-member tokey
-                                   wl-subscribed-mailing-list t))
-
       ;; case-ignore search `wl-subscribed-mailing-list'
       (if (stringp tokey)
          (list
@@ -2051,6 +2059,27 @@ Don't care multi."
           nil nil)
        nil))))
 
+(defun wl-folder-guess-mailing-list-by-folder-name (folder)
+  "Return ML address guess by FOLDER name's last hierarchy.
+Use `wl-subscribed-mailing-list'."
+  (setq folder (car (elmo-folder-get-primitive-folder-list folder)))
+  (when (memq (elmo-folder-get-type folder)
+             '(localdir imap4 maildir))
+    (let (key mladdress)
+      (setq folder                     ; make folder name simple
+           (if (eq 'imap4 (elmo-folder-get-type folder))
+               (elmo-imap4-spec-mailbox (elmo-imap4-get-spec folder))
+             (substring folder 1)))
+      (when (string-match "[^\\./]+$" folder) ; last hierarchy
+       (setq key (regexp-quote
+                  (concat (substring folder (match-beginning 0)) "@")))
+       (setq mladdress
+             (elmo-string-matched-member
+              key wl-subscribed-mailing-list 'case-ignore))
+       (if (stringp mladdress)
+           (list mladdress nil nil)
+         nil)))))
+
 (defun wl-folder-update-diff-line (diffs)
   (let ((inhibit-read-only t)
        (buffer-read-only nil)
@@ -2595,14 +2624,19 @@ Don't care multi."
       (setq count (+ count (wl-folder-count-incorporates entity)))
       (if (or (null (car nums)) ; unknown
              (< 0 count))
-         (save-window-excursion
-           (save-excursion
-             (wl-summary-goto-folder-subr entity
-                                          (wl-summary-get-sync-range entity)
-                                          nil)
-             (setq ret-val (wl-summary-incorporate))
-             (wl-summary-exit)
-             ret-val))
+         (let ((wl-summary-buffer-name (concat
+                                        wl-summary-buffer-name
+                                        (symbol-name this-command)))
+               (wl-message-buf-name (concat wl-message-buf-name
+                                            (symbol-name this-command))))
+           (save-window-excursion
+             (save-excursion
+               (wl-summary-goto-folder-subr entity
+                                            (wl-summary-get-sync-range entity)
+                                            nil)
+               (setq ret-val (wl-summary-incorporate))
+               (wl-summary-exit)
+               ret-val)))
        (cons 0 0))))))
 
 (defun wl-folder-count-incorporates (folder)
@@ -2647,11 +2681,16 @@ If current line is group folder, all subfolders are prefetched."
          wl-summary-highlight wl-auto-select-first new)
       (setq new (or (car nums) 0))
       (if (< 0 new)
-         (save-window-excursion
-           (save-excursion
-             (wl-summary-goto-folder-subr entity 'no-sync nil)
-             (wl-summary-drop-unsync)
-             (wl-summary-exit))))))))
+         (let ((wl-summary-buffer-name (concat
+                                        wl-summary-buffer-name
+                                        (symbol-name this-command)))
+               (wl-message-buf-name (concat wl-message-buf-name
+                                            (symbol-name this-command))))
+           (save-window-excursion
+             (save-excursion
+               (wl-summary-goto-folder-subr entity 'no-sync nil)
+               (wl-summary-drop-unsync)
+               (wl-summary-exit)))))))))
 
 (defun wl-folder-drop-unsync-current-entity (&optional force-check)
   "Drop all unsync messages in the folder at position.
@@ -2677,10 +2716,12 @@ If optional arg exists, don't check any folders."
        (message "All unsync messages in %s are dropped!" entity-name)))))
 
 (defun wl-folder-write-current-folder ()
-  ""
+  "Write message to current folder's newsgroup or mailing-list.
+Call `wl-summary-write-current-folder' with current folder name."
   (interactive)
   (unless (wl-folder-buffer-group-p)
-    (wl-summary-write-current-folder (wl-folder-entity-name))))
+    (wl-summary-write-current-folder
+     (wl-folder-get-realname (wl-folder-entity-name)))))
 
 (defun wl-folder-mimic-kill-buffer ()
   "Kill the current (Folder) buffer with query."