* wl-folder.el (wl-make-plugged-alist): Add `wl-smtp-posting-port'.
[elisp/wanderlust.git] / wl / wl-folder.el
index 2a16631..4e1be53 100644 (file)
   (define-key wl-folder-mode-map "?"    'wl-folder-pick)
   (define-key wl-folder-mode-map "q"    'wl-exit)
   (define-key wl-folder-mode-map "z"    'wl-folder-suspend)
-  (define-key wl-folder-mode-map "x"    'wl-folder-save-and-exec-marks)
+  (define-key wl-folder-mode-map "x"    'wl-execute-temp-marks)
   (define-key wl-folder-mode-map "\M-t" 'wl-toggle-plugged)
   (define-key wl-folder-mode-map "\C-t" 'wl-plugged-change)
   (define-key wl-folder-mode-map "<"    'beginning-of-buffer)
 
 (defun wl-folder-buffer-search-entity (folder &optional searchname)
   (let ((search (or searchname (wl-folder-get-petname folder)))
-       case-fold-search)
-    (re-search-forward
-     (concat
-      "^[ \t]*"
-      (regexp-quote search) ":[-0-9\\*-]+/[0-9\\*-]+/[0-9\\*-]+") nil t)))
+       case-fold-search
+       result)
+    (catch 'found
+      (while (setq result
+                  (re-search-forward
+                   (concat
+                    "^[ \t]*"
+                    (regexp-quote search) ":[-0-9\\*-]+/[0-9\\*-]+/[0-9\\*-]+")
+                   nil t))
+       (when (string= (wl-folder-get-entity-from-buffer) folder)
+         (throw 'found result))))))
 
 (defsubst wl-folder-get-folder-name-by-id (entity-id &optional hashtb)
   (and (numberp entity-id)
@@ -330,22 +336,30 @@ Default HASHTB is `wl-folder-elmo-folder-hashtb'."
           (string= (elmo-folder-name-internal wl-draft-folder-internal)
                    wl-draft-folder))
       wl-draft-folder-internal
-    (setq wl-draft-folder-internal (elmo-make-folder wl-draft-folder))
+    (setq wl-draft-folder-internal (wl-folder-make-elmo-folder
+                                   wl-draft-folder))
     (wl-folder-confirm-existence wl-draft-folder-internal)
     (elmo-folder-open wl-draft-folder-internal 'load-msgdb)
     wl-draft-folder-internal))
 
-(defmacro wl-folder-get-elmo-folder (entity &optional no-cache)
+(defun wl-folder-mime-charset (folder-name)
+  (or (wl-get-assoc-list-value wl-folder-mime-charset-alist folder-name)
+      wl-mime-charset))
+
+(defun wl-folder-make-elmo-folder (folder-name)
+  (elmo-make-folder folder-name nil (wl-folder-mime-charset folder-name)))
+
+(defsubst wl-folder-get-elmo-folder (entity &optional no-cache)
   "Get elmo folder structure from ENTITY."
-  `(if ,no-cache
-       (elmo-make-folder (elmo-string ,entity))
-     (if (string= (elmo-string ,entity) wl-draft-folder)
-        (wl-draft-get-folder)
-       (or (wl-folder-elmo-folder-cache-get ,entity)
-          (let* ((name (elmo-string ,entity))
-                 (folder (elmo-make-folder name)))
-            (wl-folder-elmo-folder-cache-put name folder)
-            folder)))))
+  (let ((name (elmo-string entity)))
+    (if no-cache
+       (wl-folder-make-elmo-folder name)
+      (if (string= name wl-draft-folder)
+         (wl-draft-get-folder)
+       (or (wl-folder-elmo-folder-cache-get name)
+           (let ((folder (wl-folder-make-elmo-folder name)))
+             (wl-folder-elmo-folder-cache-put name folder)
+             folder))))))
 
 (defsubst wl-folder-put-folder-property (beg end id is-group &optional object)
   (put-text-property beg end 'wl-folder-entity-id id object)
@@ -505,6 +519,20 @@ Default HASHTB is `wl-folder-elmo-folder-hashtb'."
            (wl-folder-toggle-disp-summary 'off wl-queue-folder)
          (switch-to-buffer cur-buf))))))
 
+(defun wl-folder-set-persistent-mark (folder number flag)
+  "Set a persistent mark which corresponds to the specified flag on message."
+  (let ((buffer (wl-summary-get-buffer folder)))
+    (if (and buffer
+            (with-current-buffer buffer
+              (string= wl-summary-buffer-folder-name folder)))
+       (with-current-buffer buffer
+         (wl-summary-set-persistent-mark flag number))
+      ;; Parent buffer does not exist.
+      (let ((elmo-folder (wl-folder-get-elmo-folder folder)))
+       (elmo-folder-open elmo-folder 'load-msgdb)
+       (elmo-folder-set-flag elmo-folder (list wl-draft-parent-number) flag)
+       (elmo-folder-close elmo-folder)))))
+
 (defun wl-folder-empty-trash ()
   "Empty trash."
   (interactive)
@@ -561,7 +589,7 @@ Optional argument ARG is repeart count."
        (throw 'done t))
       (goto-char (point-max))))
 
-(defsubst wl-folder-update-group (entity diffs &optional is-group)
+(defun wl-folder-update-group (entity diffs &optional is-group)
   (save-excursion
     (let ((path (wl-folder-get-path
                 wl-folder-entity
@@ -868,7 +896,8 @@ Optional argument ARG is repeart count."
              all    (and all    (max 0 all))))
       (setq unread (or (and unread (- unread (or new 0)))
                       (elmo-folder-get-info-unread folder)
-                      (nth 1 (elmo-folder-count-flags folder))))
+                      (or (cdr (assq 'unread
+                                     (elmo-folder-count-flags folder))) 0)))
       (wl-folder-entity-hashtb-set wl-folder-entity-hashtb entity
                                   (list new unread all)
                                   (get-buffer wl-folder-buffer-name)))
@@ -1326,7 +1355,8 @@ If current line is group folder, all subfolders are marked."
           'is-group
           (car entity))
          (wl-folder-set-id-name wl-folder-entity-id
-                                (car entity) hashtb))
+                                (car entity) hashtb)
+         (setq wl-folder-entity-id (+ 1 wl-folder-entity-id)))
        (and entities
             (wl-push entities entity-stack))
        (setq entities (nth 2 entity)))
@@ -1341,8 +1371,8 @@ If current line is group folder, all subfolders are marked."
           nil
           entity)
          (wl-folder-set-id-name wl-folder-entity-id
-                                entity hashtb))))
-      (setq wl-folder-entity-id (+ 1 wl-folder-entity-id))
+                                entity hashtb)
+         (setq wl-folder-entity-id (+ 1 wl-folder-entity-id)))))
       (unless entities
        (setq entities (wl-pop entity-stack))))))
 
@@ -1491,15 +1521,12 @@ Entering Folder mode calls the value of `wl-folder-mode-hook'."
   (run-hooks 'wl-folder-mode-hook))
 
 (defun wl-folder-append-petname (realname petname)
-  (let (pentry)
-    ;; check group name.
-    (if (wl-folder-search-group-entity-by-name petname wl-folder-entity)
-       (error "%s already defined as group name" petname))
-    (when (setq pentry (wl-string-assoc realname wl-folder-petname-alist))
+  (let ((pentry (wl-string-assoc realname wl-folder-petname-alist)))
+    (when pentry
       (setq wl-folder-petname-alist
-           (delete pentry wl-folder-petname-alist)))
-    (wl-append wl-folder-petname-alist
-              (list (cons realname petname)))))
+           (delete pentry wl-folder-petname-alist))))
+  (wl-append wl-folder-petname-alist
+            (list (cons realname petname))))
 
 (defun wl-folder ()
   (let (initialize folder-buf)
@@ -1577,8 +1604,8 @@ Entering Folder mode calls the value of `wl-folder-mode-hook'."
 
 (defun wl-folder-set-folder-updated (name value)
   (save-excursion
-    (let (buf)
-      (if (setq buf (get-buffer wl-folder-buffer-name))
+    (let ((buf (get-buffer wl-folder-buffer-name)))
+      (if buf
          (wl-folder-entity-hashtb-set
           wl-folder-entity-hashtb name value buf))
       (setq wl-folder-info-alist-modified t))))
@@ -2044,7 +2071,8 @@ Entering Folder mode calls the value of `wl-folder-mode-hook'."
     (when wl-smtp-posting-server
       (elmo-set-plugged wl-plugged
                        wl-smtp-posting-server  ; server
-                       (or (and (boundp 'smtp-service) smtp-service)
+                       (or wl-smtp-posting-port
+                           (and (boundp 'smtp-service) smtp-service)
                            "smtp")     ; port
                        wl-smtp-connection-type
                        nil nil "smtp" add))
@@ -2052,8 +2080,8 @@ Entering Folder mode calls the value of `wl-folder-mode-hook'."
     (when wl-nntp-posting-server
       (elmo-set-plugged wl-plugged
                        wl-nntp-posting-server
-                       wl-nntp-posting-stream-type
                        wl-nntp-posting-port
+                       wl-nntp-posting-stream-type
                        nil nil "nntp" add))
     (run-hooks 'wl-make-plugged-hook)))
 
@@ -2288,10 +2316,6 @@ Use `wl-subscribed-mailing-list'."
                                  (wl-folder-get-elmo-folder fld-name))
                                 nil sticky t)))
 
-(defun wl-folder-save-and-exec-marks ()
-  (interactive)
-  (wl-save 'exec-marks))
-
 (defun wl-folder-suspend ()
   (interactive)
   (run-hooks 'wl-folder-suspend-hook)
@@ -2457,12 +2481,13 @@ Use `wl-subscribed-mailing-list'."
   (interactive)
   (if (not fld-name)
       (setq fld-name (wl-summary-read-folder wl-default-folder)))
-  (let* ((id (wl-folder-get-entity-id
-             (wl-folder-search-entity-by-name fld-name wl-folder-entity
-                                              'folder)))
-        (path (and id (wl-folder-get-path wl-folder-entity id))))
-      (if path
-         (wl-folder-open-folder-sub path))))
+  (let ((entity (wl-folder-search-entity-by-name
+                fld-name wl-folder-entity 'folder)))
+    (if entity
+       (let* ((id (wl-folder-get-entity-id entity))
+              (path (and id (wl-folder-get-path wl-folder-entity id))))
+         (if path (wl-folder-open-folder-sub path)))
+      (message "%s: not found" fld-name))))
 
 (defun wl-folder-open-folder-sub (path)
   (let ((inhibit-read-only t)
@@ -2870,19 +2895,16 @@ Call `wl-summary-write-current-folder' with current folder name."
       (kill-buffer bufname))))
 
 (defun wl-folder-create-subr (folder)
-  (if (elmo-folder-creatable-p folder)
-      (if (y-or-n-p (format "Folder %s does not exist, create it? "
-                           (elmo-folder-name-internal folder)))
-         (progn
-           (message "")
-           (setq wl-folder-entity-hashtb
-                 (wl-folder-create-entity-hashtb
-                  (elmo-folder-name-internal folder)
-                  wl-folder-entity-hashtb))
-           (unless (elmo-folder-create folder)
-             (error "Create folder failed")))
-       (error "Folder %s is not created" (elmo-folder-name-internal folder)))
-    (error "Folder %s does not exist" (elmo-folder-name-internal folder))))
+  (let ((name (elmo-folder-name-internal folder)))
+    (unless (elmo-folder-creatable-p folder)
+      (error "Folder %s does not exist" name))
+    (unless (y-or-n-p (format "Folder %s does not exist, create it? " name))
+      (error "Folder %s is not created" name))
+    (message "")
+    (setq wl-folder-entity-hashtb
+         (wl-folder-create-entity-hashtb name wl-folder-entity-hashtb))
+    (unless (elmo-folder-create folder)
+      (error "Create folder failed"))))
 
 (defun wl-folder-confirm-existence (folder &optional force)
   (if force
@@ -2910,7 +2932,7 @@ Call `wl-summary-write-current-folder' with current folder name."
     (unless entity (error "No folder"))
     (wl-folder-goto-folder-subr
      (concat "/"
-            (elmo-read-search-condition
+            (wl-read-search-condition
              wl-fldmgr-make-filter-default)
             "/" entity))))
 
@@ -2918,7 +2940,7 @@ Call `wl-summary-write-current-folder' with current folder name."
   (interactive)
   (save-excursion
     (let* ((condition (car (elmo-parse-search-condition
-                           (elmo-read-search-condition
+                           (wl-read-search-condition
                             wl-summary-pick-field-default))))
           (entity (wl-folder-get-entity-from-buffer))
           (folder-list
@@ -3022,7 +3044,8 @@ Call `wl-summary-write-current-folder' with current folder name."
           (mapcar (lambda (x) (list (concat (downcase x) ":")))
                   (append '("last" "first"
                             "from" "subject" "to" "cc" "body"
-                            "since" "before" "tocc")
+                            "since" "before" "tocc"
+                            "larger" "smaller")
                           elmo-msgdb-extra-fields))))
       (if (not flag)
          (try-completion string candidate)