X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=wl%2Fwl.el;h=aae6edb402f4434afe74dd07ceae416e424927eb;hb=0dcb53ebdc57513ab012f9ee6c8e8d5e20bad437;hp=b78eceb2b30e2d1f93dae33a288a9145d738a398;hpb=5a954fe4158278866dd1c6b07e8b0ee39653c54c;p=elisp%2Fwanderlust.git

diff --git a/wl/wl.el b/wl/wl.el
index b78eceb..aae6edb 100644
--- a/wl/wl.el
+++ b/wl/wl.el
@@ -1,4 +1,4 @@
-;;; wl.el -- Wanderlust bootstrap.
+;;; wl.el --- Wanderlust bootstrap.
 
 ;; Copyright (C) 1998,1999,2000 Yuuichi Teranishi <teranisi@gohome.org>
 ;; Copyright (C) 1998,1999,2000 Masahiro MURATA <muse@ba2.so-net.ne.jp>
@@ -36,7 +36,7 @@
 
 ;; from x-face.el
 (unless (and (fboundp 'defgroup)
-             (fboundp 'defcustom))
+	     (fboundp 'defcustom))
   (require 'backquote)
   (defmacro defgroup (&rest args))
   (defmacro defcustom (symbol value &optional doc &rest args)
@@ -56,8 +56,10 @@
 (provide 'wl)				; circular dependency
 (require 'wl-folder)
 (require 'wl-summary)
+(require 'wl-action)
 (require 'wl-thread)
 (require 'wl-address)
+(require 'wl-news)
 
 (wl-draft-mode-setup)
 (require 'wl-draft)
@@ -71,7 +73,8 @@
   (require 'smtp)
   (require 'wl-score)
   (require 'wl-fldmgr)
-  (require 'wl-mime))
+  (require 'wl-mime)
+  (require 'wl-spam))
 
 (defun wl-plugged-init (&optional make-alist)
   (setq elmo-plugged wl-plugged)
@@ -94,7 +97,7 @@
       (setq wl-plugged t))
      ((eq arg 'off)
       (setq wl-plugged nil))
-     (t (setq wl-plugged (null wl-plugged))))
+     (t (setq wl-plugged (not wl-plugged))))
     (elmo-set-plugged wl-plugged))
   (setq elmo-plugged wl-plugged
 	wl-modeline-plug-status wl-plugged)
@@ -102,14 +105,17 @@
     (let ((summaries (wl-collect-summary)))
       (while summaries
 	(set-buffer (pop summaries))
-	(elmo-folder-commit wl-summary-buffer-elmo-folder)
-	(wl-summary-set-message-modified))))
+	(wl-summary-save-view)
+	(elmo-folder-commit wl-summary-buffer-elmo-folder))))
   (setq wl-biff-check-folders-running nil)
   (if wl-plugged
       (progn
 	;; flush queue!!
 	(elmo-dop-queue-flush)
-	(unless queue-flush-only (wl-biff-start))
+	(unless queue-flush-only
+	  (when wl-biff-check-folder-list
+	    (wl-biff-check-folders)
+	    (wl-biff-start)))
 	(if (and wl-draft-enable-queuing
 		 wl-auto-flush-queue)
 	    (wl-draft-queue-flush))
@@ -131,7 +137,8 @@
 (defvar wl-plugged-port-label-alist
   (list (cons 119 "nntp")
 	(cons 143 "imap4")
-	(cons 110 "pop3")))
+	(cons 110 "pop3")
+	(cons 25 "smtp")))
 	;;(cons elmo-pop-before-smtp-port "pop3")
 
 (defconst wl-plugged-switch-variables
@@ -308,12 +315,23 @@ Entering Plugged mode calls the value of `wl-plugged-mode-hook'."
 		 (car folder-ope)
 		 (wl-folder-get-petname (car folder-ope)))
 		"("
-		(mapconcat
-		 '(lambda (ope)
-		    (if (> (cdr ope) 0)
-			(format "%s:%d" (car ope) (cdr ope))
-		      (format "%s" (car ope))))
-		 (cdr folder-ope) ",")
+		(let ((opes (cdr folder-ope))
+		      pair shrinked)
+		  (while opes
+		    (if (setq pair (assoc (car (car opes)) shrinked))
+			(setcdr pair (+ (cdr pair)
+					(max (cdr (car opes)) 1)))
+		      (setq shrinked (cons
+				      (cons (car (car opes))
+					    (max (cdr (car opes)) 1))
+				      shrinked)))
+		    (setq opes (cdr opes)))
+		  (mapconcat
+		   '(lambda (ope)
+		      (if (> (cdr ope) 0)
+			  (format "%s:%d" (car ope) (cdr ope))
+			(format "%s" (car ope))))
+		   (nreverse shrinked) ","))
 		")"))
      operations
      (concat "\n" (wl-set-string-width column "")))))
@@ -480,7 +498,7 @@ Entering Plugged mode calls the value of `wl-plugged-mode-hook'."
     (save-excursion
       (beginning-of-line)
       (cond
-       ;; swtich variable
+       ;; switch variable
        ((bobp)
 	(let (variable switch name)
 	  (goto-char cur-point)
@@ -499,7 +517,7 @@ Entering Plugged mode calls the value of `wl-plugged-mode-hook'."
 	      (delete-region (match-beginning 2) (match-end 2))
 	      (insert (wl-plugged-string switch))
 	      (set-buffer-modified-p nil)))))
-       ;; swtich plug
+       ;; switch plug
        ((looking-at "^\\( *\\)\\[\\([^]]+\\)\\]\\([^ \n]*\\)")
 	(let* ((indent (length (elmo-match-buffer 1)))
 	       (switch (elmo-match-buffer 2))
@@ -618,32 +636,44 @@ Entering Plugged mode calls the value of `wl-plugged-mode-hook'."
   (wl-save-status 'keep-summary)
   (run-hooks 'wl-save-hook))
 
+(defun wl-execute-temp-marks ()
+  "Execute temporary marks in summary buffers."
+  (interactive)
+  (let ((summaries (wl-collect-summary)))
+    (while summaries
+      (with-current-buffer (car summaries)
+	(wl-summary-exec-with-confirmation)
+	(wl-summary-save-status))
+      (setq summaries (cdr summaries)))))
+
 (defun wl-save-status (&optional keep-summary)
   (message "Saving summary and folder status...")
-  (let (summary-buf)
-    (save-excursion
-      (let ((summaries (wl-collect-summary)))
-	(while summaries
-	  (with-current-buffer (car summaries)
-	    (unless keep-summary
-	      (wl-summary-cleanup-temp-marks))
-	    (wl-summary-save-view keep-summary)
-	    (elmo-folder-commit wl-summary-buffer-elmo-folder)
-	    (unless keep-summary
-	      (kill-buffer (car summaries))))
-	  (setq summaries (cdr summaries))))))
+  (save-excursion
+    (let ((summaries (wl-collect-summary)))
+      (while summaries
+	(with-current-buffer (car summaries)
+	  (unless keep-summary
+	    (wl-summary-cleanup-temp-marks))
+	  (wl-summary-save-view)
+	  (elmo-folder-commit wl-summary-buffer-elmo-folder)
+	  (unless keep-summary
+	    (kill-buffer (car summaries))))
+	(setq summaries (cdr summaries)))))
   (wl-refile-alist-save)
   (wl-folder-info-save)
   (and (featurep 'wl-fldmgr) (wl-fldmgr-exit))
+  (and (featurep 'wl-spam) (wl-spam-save-status))
   (elmo-crosspost-message-alist-save)
   (message "Saving summary and folder status...done"))
 
 (defun wl-exit ()
   (interactive)
   (when (or (not wl-interactive-exit)
-	    (y-or-n-p "Quit Wanderlust? "))
+	    (y-or-n-p "Do you really want to quit Wanderlust? "))
     (elmo-quit)
+    (when wl-use-acap (funcall (symbol-function 'wl-acap-exit)))
     (wl-biff-stop)
+    (elmo-clear-signal-slots)
     (run-hooks 'wl-exit-hook)
     (wl-save-status)
     (wl-folder-cleanup-variables)
@@ -654,19 +684,21 @@ Entering Plugged mode calls the value of `wl-plugged-mode-hook'."
 			(list wl-folder-buffer-name
 			      wl-plugged-buf-name)
 			"\\|")))
-    (if (and wl-folder-use-frame
-	     (> (length (visible-frame-list)) 1))
-	(delete-frame))
+    (when wl-delete-startup-frame-function
+      (funcall wl-delete-startup-frame-function))
+;;    (if (and wl-folder-use-frame
+;;	     (> (length (visible-frame-list)) 1))
+;;	(delete-frame))
     (setq wl-init nil)
     (remove-hook 'kill-emacs-hook 'wl-save-status)
+    (elmo-passwd-alist-clear)
     t)
   (message "") ; empty minibuffer.
   )
 
 (defun wl-init ()
   (when (not wl-init)
-    (unless (featurep 'mime-setup)
-      (require 'mime-setup))
+    (require 'mime-setup)
     (setq elmo-plugged wl-plugged)
     (add-hook 'kill-emacs-hook 'wl-save-status)
     (wl-address-init)
@@ -681,8 +713,31 @@ Entering Plugged mode calls the value of `wl-plugged-mode-hook'."
 	  (symbol-value 'wl-summary-subject-function))
     (fset 'wl-summary-subject-filter-func-internal
 	  (symbol-value 'wl-summary-subject-filter-function))
+    (wl-summary-define-sort-command)
+    (wl-summary-define-mark-action)
+    (dolist (spec wl-summary-flag-alist)
+      (set-face-foreground
+       (make-face (intern
+		   (format "wl-highlight-summary-%s-flag-face" (car spec))))
+       (nth 1 spec)))
+    (setq elmo-get-folder-function #'wl-folder-make-elmo-folder
+	  elmo-progress-callback-function #'wl-progress-callback-function)
     (setq elmo-no-from wl-summary-no-from-message)
     (setq elmo-no-subject wl-summary-no-subject-message)
+    (elmo-global-flags-initialize (mapcar 'car wl-summary-flag-alist))
+    (elmo-connect-signal
+     nil
+     'message-number-changed
+     'wl-draft
+     (elmo-define-signal-handler (listener folder old-number new-number)
+       (dolist (buffer (wl-collect-draft))
+	 (with-current-buffer buffer
+	   (wl-draft-buffer-change-number old-number new-number)))
+       (wl-draft-rename-saved-config old-number new-number))
+     (elmo-define-signal-filter (listener folder old-number new-number)
+       (and folder
+	    (string= (elmo-folder-name-internal folder) wl-draft-folder))))
+    (wl-news-check)
     (setq wl-init t)
     ;; This hook may contain the functions `wl-plugged-init-icons' and
     ;; `wl-biff-init-icons' for reasons of system internal to accord
@@ -690,33 +745,29 @@ Entering Plugged mode calls the value of `wl-plugged-mode-hook'."
     (run-hooks 'wl-init-hook)))
 
 (defun wl-check-environment (no-check-folder)
-  (unless wl-from (error "Please set `wl-from'"))
+  (unless wl-from (error "Please set `wl-from' to your mail address"))
   ;; Message-ID
-  (unless (string-match "[^.]\\.[^.]" (or wl-message-id-domain
-					  (if wl-local-domain
-					      (concat (system-name)
-						      "." wl-local-domain)
-					    (system-name))))
-    (error "Please set `wl-local-domain' to get valid FQDN"))
-  (if (string-match "@" (or wl-message-id-domain
-			    (if wl-local-domain
-				(concat (system-name)
-					"." wl-local-domain)
-			      (system-name))))
-      (error "Please remove `@' from `wl-message-id-domain'"))
-  (if (string= wl-local-domain "localdomain")
-      (error "Please set `wl-local-domain'"))
-  (if (string= wl-message-id-domain "localhost.localdomain")
-      (error "Please set `wl-message-id-domain'"))
+  (when wl-insert-message-id
+    (let ((message-id (funcall wl-message-id-function))
+	  domain)
+      (unless (string-match "^<\\([^@]*\\)@\\([^@]*\\)>$" message-id)
+	(cond
+	 ((string-match "@" wl-message-id-domain)
+	  (error "Please remove `@' from `wl-message-id-domain'"))
+	 (t
+	  (error
+	   "Check around `wl-message-id-function' to get valid Message-ID string"))))
+      (setq domain (match-string 2 message-id))
+      (if (or (not (string-match "[^.]\\.[^.]" domain))
+	      (string= domain "localhost.localdomain"))
+	  (elmo-warning
+	   "Please set `wl-message-id-domain' to get valid Message-ID string."))))
   ;; folders
   (when (not no-check-folder)
     (let ((draft-folder (wl-folder-get-elmo-folder wl-draft-folder))
 	  (queue-folder (wl-folder-get-elmo-folder wl-queue-folder))
-	  (trash-folder (wl-folder-get-elmo-folder wl-trash-folder))
 	  (lost+found-folder (wl-folder-get-elmo-folder
 			      elmo-lost+found-folder)))
-      (if (not (elmo-folder-message-file-p draft-folder))
-	  (error "%s is not allowed for draft folder" wl-draft-folder))
       (unless (elmo-folder-exists-p draft-folder)
 	(if (y-or-n-p
 	     (format "Draft Folder %s does not exist, create it? "
@@ -731,22 +782,48 @@ Entering Plugged mode calls the value of `wl-plugged-mode-hook'."
 	      (elmo-folder-create queue-folder)
 	    (error "Queue Folder is not created")))
       (when (not (eq no-check-folder 'wl-draft))
-	(unless (elmo-folder-exists-p trash-folder)
-	  (if (y-or-n-p
-	       (format "Trash Folder %s does not exist, create it? "
-		       wl-trash-folder))
-	      (elmo-folder-create trash-folder)
-	    (error "Trash Folder is not created")))
 	(unless (elmo-folder-exists-p lost+found-folder)
 	  (elmo-folder-create lost+found-folder)))
       ;; tmp dir
-      (unless (file-exists-p wl-tmp-dir)
+      (unless (file-exists-p wl-temporary-file-directory)
 	(if (y-or-n-p
 	     (format "Temp directory (to save multipart) %s does not exist, create it now? "
-		     wl-tmp-dir))
-	    (make-directory wl-tmp-dir)
+		     wl-temporary-file-directory))
+	    (make-directory wl-temporary-file-directory)
 	  (error "Temp directory is not created"))))))
 
+(defconst wl-check-variables-alist
+  '((numberp . elmo-pop3-default-port)
+    (symbolp . elmo-pop3-default-authenticate-type)
+    (numberp . elmo-imap4-default-port)
+    (symbolp . elmo-imap4-default-authenticate-type)
+    (numberp . elmo-nntp-default-port)
+    (numberp . wl-pop-before-smtp-port)
+    (symbolp . wl-pop-before-smtp-authenticate-type)))
+
+(defun wl-check-variables ()
+  (let ((type-variables wl-check-variables-alist)
+	type)
+    (while (setq type (car type-variables))
+      (if (and (eval (cdr type))
+	       (not (funcall (car type)
+			     (eval (cdr type)))))
+	  (error "%s must be %s: %S"
+		 (cdr type)
+		 (substring (format "%s" (car type)) 0 -1)
+		 (eval (cdr type))))
+      (setq type-variables (cdr type-variables)))))
+
+(defun wl-check-variables-2 ()
+  (if (< wl-message-buffer-cache-size 1)
+      (error "`wl-message-buffer-cache-size' must be larger than 0"))
+  (when wl-message-buffer-prefetch-depth
+    (if (not (< wl-message-buffer-prefetch-depth
+		wl-message-buffer-cache-size))
+	(error (concat
+		"`wl-message-buffer-prefetch-depth' must be smaller than "
+		"`wl-message-buffer-cache-size' - 1.")))))
+
 ;;;###autoload
 (defun wl (&optional arg)
   "Start Wanderlust -- Yet Another Message Interface On Emacsen.
@@ -754,7 +831,6 @@ If ARG (prefix argument) is specified, folder checkings are skipped."
   (interactive "P")
   (unless wl-init
     (wl-load-profile)
-    (wl-folder-init)
     (elmo-init))
   (let (demo-buf check)
     (unless wl-init
@@ -763,29 +839,68 @@ If ARG (prefix argument) is specified, folder checkings are skipped."
     (wl-init)
     (condition-case obj
 	(progn
-	  (wl-plugged-init (wl-folder arg))
 	  (if check
-	      (condition-case nil
-		  (progn
-		    (message "Checking environment...")
-		    (wl-check-environment arg)
-		    (message "Checking environment...done"))
-		(error)
-		(quit)))
+	      (progn
+		(message "Checking environment...")
+		(wl-check-environment arg)
+		(message "Checking environment...done")
+		(message "Checking type of variables...")
+		(wl-check-variables)
+		(wl-check-variables-2)
+		(message "Checking type of variables...done")))
+	  (let ((inhibit-quit t))
+	    (wl-plugged-init (wl-folder)))
 	  (unless arg
 	    (run-hooks 'wl-auto-check-folder-pre-hook)
 	    (wl-folder-auto-check)
-	    (run-hooks 'wl-auto-check-folder-hook))
-	  (unless arg (wl-biff-start)))
-      (error 
+	    (run-hooks 'wl-auto-check-folder-hook)))
+      (error
        (if (buffer-live-p demo-buf)
 	   (kill-buffer demo-buf))
        (signal (car obj)(cdr obj)))
       (quit))
+    (when wl-biff-check-folder-list
+      (unless arg (wl-biff-check-folders))
+      (wl-biff-start))
     (if (buffer-live-p demo-buf)
 	(kill-buffer demo-buf)))
   (run-hooks 'wl-hook))
 
+(defvar wl-delete-startup-frame-function nil)
+
+;;;###autoload
+(defun wl-other-frame (&optional arg)
+  "Pop up a frame to read messages via Wanderlust."
+  (interactive)
+  (if wl-folder-use-frame
+      (wl arg)
+    (let ((focusing-functions (append '(raise-frame select-frame)
+				      (if (fboundp 'x-focus-frame)
+					  '(x-focus-frame)
+					'(focus-frame))))
+	  (folder (get-buffer wl-folder-buffer-name))
+	  window frame wl-folder-use-frame)
+      (if (and folder
+	       (setq window (get-buffer-window folder t))
+	       (window-live-p window)
+	       (setq frame (window-frame window)))
+	  (progn
+	    (while focusing-functions
+	      (funcall (car focusing-functions) frame)
+	      (setq focusing-functions (cdr focusing-functions)))
+	    (wl arg))
+	(setq frame (make-frame))
+	(while focusing-functions
+	  (funcall (car focusing-functions) frame)
+	  (setq focusing-functions (cdr focusing-functions)))
+	(setq wl-delete-startup-frame-function
+	      `(lambda ()
+		 (setq wl-delete-startup-frame-function nil)
+		 (let ((frame ,frame))
+		   (if (eq (selected-frame) frame)
+		       (delete-frame frame)))))
+	(wl arg)))))
+
 ;; Define some autoload functions WL might use.
 (eval-and-compile
   ;; This little mapcar goes through the list below and marks the
@@ -831,7 +946,8 @@ If ARG (prefix argument) is specified, folder checkings are skipped."
       wl-score-change-score-file wl-score-edit-current-scores
       wl-score-edit-file wl-score-flush-cache wl-summary-rescore
       wl-score-set-mark-below wl-score-set-expunge-below
-      wl-summary-increase-score wl-summary-lower-score ))))
+      wl-summary-increase-score wl-summary-lower-score )
+     ("wl-draft" wl-draft-rename-saved-config))))
 
 ;; for backward compatibility
 (defalias 'wl-summary-from-func-petname 'wl-summary-default-from)