;;; -*- Emacs-Lisp -*-
;;; procmail reader for Mew on GNU Emacs.
;;; $Id: prom-mew.el,v 2.48 1999/08/16 07:14:37 murata Exp $
;;; by Masahiro MURATA <muse@ba2.so-net.ne.jp>

(defconst prom-version "Prom-Mew 1.93.4")

;; !!! this version is required Mew version 1.93 or later !!!

;;; @ Document
;;; 

;; Please set in ~/.procmailrc 
;;
;; LOCKFILE=/home/hoge/Mail/.lock
;;
;; and set in ~/.emacs
;; (autoload 'prom-mew "prom-mew" "mew for using procmail" t)
;; (setq proc-log-list (list "~/Mail/from-log" "~/Mail/from-ML"))
;;					;; list of LOGFILE in ~/.procmailrc
;; (setq proc-keep-log "~/Mail/listlog")
;; (setq proc-lock-file "~/Mail/.lock")		;; LOCKFILE in ~/.procmailrc

;; for the rest, see the prom-usage.jis

;;; @ require
;;;

(require 'mew)
(require 'mew-summary)

;;; @ Customization:
;;;

(defvar proc-log-list nil
  "*Logfile list of procmailrc.

  (setq proc-log-list \'(\"~/Mail/from-log\" \"~/Mail/ml-log\"))
")

(defvar proc-keep-log nil
  "*Keeping logfile. If nil, not keeping.

  (setq proc-keep-log \"~/Mail/listlog\")
")

(defvar proc-lock-file "~/Mail/.lock"
  "*Global lockfile of procmail.")

(defvar prom-sort-folder-list '("+inbox")
  "*Order of folders.")

(defvar prom-sort-folder-list-2 nil
  "*Order of folders. Each elements are regexp. If non-nil, ignored
  prom-sort-folder-list.")

(defvar prom-auto-select-first t
  "*Select the first unread letter automatically if non-nil.
  But non-nil become problem for multipart letter.")

(defvar prom-auto-select-first-for-checked-folder t
  "*Select the first unread letter automagically if non-nil, 
  when read checked folder.")

(defvar prom-wait-auto-select-first t
  "*If non-nil, Wait for select the first unread letter automatically.")

(defvar prom-auto-select-next t
  "*If non-nil, offer to go to the next folder from the end of the previous.")

(defvar prom-auto-select-next-ignored-command-list
  (list
   'mew-summary-delete
   'mew-summary-refile
   'mew-summary-refile-again
   'exit-minibuffer)
  "*List of command in mew-summary-mode that don't go to the next folder.")

(defvar prom-full-window t
  "*If non-nil, use the entire Emacs screen.")

(defvar prom-kill-mew-buffer nil
  "*If non-nil, kill buffer of mew when exiting folder or going to other
folder.")

(defvar prom-exit-kill-all-mew-buffer t
  "*If non-nil, kill all folder buffers of mew when exiting prom.")

(defvar prom-get-new-mail-optional-method nil
  "*Optional method called at prom-get-new-mail.

  (setq prom-get-new-mail-optional-method \'prom-check-unread-folders)
    or
  (setq prom-get-new-mail-optional-method \'prom-check-list-folders)
")

(defvar prom-check-folders nil
  "*Folders list of check unread folder.

   (setq prom-check-folders \'(\"+inbox\" \"+private\"))
")

(defvar prom-ignore-no-mewcache-folders nil
  "*If non-nil, ignored folder that there is no `.mew-cache' file,
when check unread folders.  ")

(defvar prom-ignore-check-folders '("/$" "^\\+trash" "^\\+tmp" "^\\+draft")
  "*Ignored folders when check unread folders. Each elements are regexp.

   (setq prom-ignore-check-folders \'(\"/$\" \"^\\\\+drafts\" \"^\\\\+tmp$\"))
")

(defvar prom-highlight-folder t
  "*Use highlight folders in prom folder mode.")

(defvar prom-highlight-mouse-line t
  "*Use highlight folders in prom folder mode.")

(defvar prom-highlight-mouse-line-function
  (function mode-motion-highlight-line)
  "*A function to highlight the mouse line in Prom mode")

(defvar prom-mew-compatible nil
  "*If non-nil become same behavior when goto folder and exit
in mew summary mode. But, normally don't set `t', if prom-mew use.")

(defvar prom-list-display-header t
  "*If non-nil, display mail header at prom-list-folders.")

(defvar prom-list-display-from t
  "*If non-nil display \'from\' at prom-list-folders. 
 If `prom-list-display-header' is nil, ignored.")

(defvar prom-folder-toggle-move-key nil
  "*If non-nil, change move-function\'s key bind.")

(defvar prom-use-lockfile t
  "*If non-nil, use lockfile program of procmail package.")

(defvar prom-mew-xheader
  '(concat prom-version " (procmail reader for Mew)")
  "*A value or function inserted into X-Prom-Mew: field in draft mode.")

(defvar prom-init-no-get-new-mail nil
  "*If non-nil, don't get new mail on prom-mew init.")

(defvar prom-summary-ls-always-last nil
  "*If non-nil, always scan last in prom-summary-ls.")

(defvar prom-lock-optional-method t
  "*If non-nil, lock on `prom-get-new-mail-optional-method'.")

(defvar prom-lock-at-exist-log t)

(defvar prom-start-list-folders nil
  "Value is 'all or 'nomail-all or nil.")

(defvar prom-keep-log-max-size nil
  "*Max size of file that specified `proc-keep-log'.")

(defvar prom-mew-addrbook-for-prom 'nickname
  "*How to replace an address in folder list
with Addrbook. See \"mew-addrbook-switch\".")

;; Hooks

(defvar prom-previous-hook nil
  "*Hook called at previous initialize time.")
(defvar prom-hook nil
  "*Hook called at initialize time.")
(defvar prom-exit-hook nil
  "*Hook called when exiting prom.")
(defvar prom-list-folders-hook nil
  "*Hook called when listing folder.")
(defvar prom-select-folder-hook nil
  "*Hook called at select folder.")
(defvar prom-get-new-mail-pre-hook nil
  "*Hook called at previous get new mail.")
(defvar prom-get-new-mail-hook nil
  "*Hook called at get new mail.")
(defvar prom-mew-load-hook nil
  "*Hook called at load prom-mew.")
(defvar prom-folder-mode-hook nil
  "*Hook called when prom-folder mode.")
(defvar prom-get-proc-log-hook nil
  "*Hook called after prom-set-promrc-log.")


;;; @ global variables
;;;

(defvar prom-startup-file ".promrc.el")
(defvar prom-interactive-catchup t)

(defvar promrc-log-assoc nil)
(defvar promrc-old-log-assoc nil)
(defvar promrc-prev-log-assoc nil)
(defvar promrc-log-assoc-presort nil)
(defvar promrc-log-assoc-aftsort nil)
(defvar prom-folder-name nil)
(defvar prom-previous-window-config nil)
(defvar prom-window-config nil)
(defvar prom-seen-list nil)
(defvar prom-cursol-point nil)
(defvar prom-status-list-all-folders nil)
(defvar prom-unread-mails 0)
(defvar prom-mew-setup nil)
(defvar prom-do-lock nil)

(defvar prom-prog-lockfile "lockfile")

(defvar prom-prog-lockfile-arg-list '("-2" "-r4" "-l10")
  "*Argument list for lockfile program")
(defvar prom-lockfile-arg-list prom-prog-lockfile-arg-list
  "*Argument list for lockfile program.
This variable is obsolate, use `prom-prog-lockfile-arg-list'.")

(defconst prom-folder-buffer  "*Prom*")
(defconst prom-buffer-tmp    " *prom tmp*")

(defconst prom-folder-list-regexp   " %4d: %s\n")
(defconst prom-folder-search-regexp "^%s[ \t]*\\(%s\\):")
(defconst prom-folder-name-regexp   "^ *[0-9]+:[ \t]+\\([^ \t\n]+\\)\\([ \t].*\\|$\\)")

;;

(defvar prom-tmp-auto-select-next nil)
(defvar prom-folder-mode-map nil)


;;; @ environment set
;;;

(defvar prom-folder-mode-menu-spec
  '("Prom"
    ["Read" prom-folder-read-folder t]
    ["Next unread folder" prom-folder-next-unread-folder t]
    ["Previous unread folder" prom-folder-prev-unread-folder t]
    ["Next folder" prom-folder-next-folder t]
    ["Previous folder" prom-folder-prev-folder t]
    ["Jump to folder" prom-folder-jump-to-folder t]
    "----"
    ["Get new mail"  prom-get-new-mail t]
    ["Get all new mail" prom-get-new-all-mail t]
    ["Suspend" prom-suspend t]
    ["Exit" prom-exit t]
    ["Quit" prom-quit t]
    ["Catchup" prom-folder-catchup t]
    ["List folders" prom-folder-list-folders t]
    ["List all folders" prom-folder-list-all-folders t]
    ["Go to folder" prom-folder-goto-folder t]
    "----"
    ["Write a mail" mew-send t]
    ["Status Update" mew-status-update t]
    )
  )

;;; @ code
;;;

(defun prom-folder-define-key ()
  (if prom-folder-mode-map
      ()
    (setq prom-folder-mode-map (make-sparse-keymap))
    (let ((prom-folder-toggle-move-key (not prom-folder-toggle-move-key)))
      (prom-folder-toggle-move-key))	;; default key bind
    (define-key prom-folder-mode-map "\r"    'prom-folder-read-folder)
    (define-key prom-folder-mode-map " "     'prom-folder-read-folder)
    (define-key prom-folder-mode-map "t"     'prom-folder-toggle-move-key)
    (define-key prom-folder-mode-map "h"     'prom-folder-toggle-display-header)
    (define-key prom-folder-mode-map "j"     'prom-folder-jump-to-folder)
    (define-key prom-folder-mode-map "s"     'prom-get-new-mail)
    (define-key prom-folder-mode-map "\es"   'prom-get-new-all-mail)
    (define-key prom-folder-mode-map "z"     'prom-suspend)
    (define-key prom-folder-mode-map "q"     'prom-exit)
    (define-key prom-folder-mode-map "Q"     'prom-quit)
    (define-key prom-folder-mode-map "c"     'prom-folder-catchup)
    (define-key prom-folder-mode-map "l"     'prom-folder-list-folders)
    (define-key prom-folder-mode-map "L"     'prom-folder-list-all-folders)
    (define-key prom-folder-mode-map "g"     'prom-folder-goto-folder)
    (define-key prom-folder-mode-map "v"     'prom-version)
    (define-key prom-folder-mode-map "V"     'prom-summary-virtual)

    ;; mew commands
    (define-key prom-folder-mode-map "w"     'mew-send)
    (define-key prom-folder-mode-map "Z"     'mew-status-update)
    (define-key prom-folder-mode-map "\C-c\C-o" 'mew-summary-jump-to-draft-buffer)
    ;; menu bar
    (if mew-xemacs-p
	(define-key prom-folder-mode-map 'button2 'prom-folder-mouse-show)
      (define-key prom-folder-mode-map [mouse-2] 'prom-folder-mouse-show)
      (easy-menu-define
       prom-folder-mode-menu prom-folder-mode-map
       "Menu used in Prom folder mode."
       prom-folder-mode-menu-spec
       ))
    ))

(if mew-xemacs-p
   (if (<= emacs-major-version 20)
       (setq mew-cs-binary mew-cs-noconv))
)

(defun prom-mew-setup ()
  (if prom-mew-setup
      nil
    (add-hook 'mew-message-hook 'prom-add-seen-list)
    (add-hook 'mew-summary-mode-hook
	      '(lambda ()
		 (define-key mew-summary-mode-map "q"  'prom-summary-exit)
		 (define-key mew-summary-mode-map "g"  'prom-summary-goto-folder)
		 ))
    (and (boundp 'mew-virtual-mode-map)
	 (add-hook 'mew-virtual-mode-hook
		   '(lambda ()
		      (define-key mew-virtual-mode-map "q"  'prom-summary-exit)
		      (define-key mew-virtual-mode-map "g"  'prom-summary-goto-folder)
		      )))
    ;; for mew-draft
    (if prom-mew-xheader
	(let ((x-prom-mew (assoc "X-Prom-Mew:" mew-header-alist)))
	  (if x-prom-mew
	      (setcdr x-prom-mew
		      (eval prom-mew-xheader))
	    (setq mew-header-alist
		  (cons (cons "X-Prom-Mew:" (eval prom-mew-xheader))
			mew-header-alist)))
	  ))
    ;; for mew-1.92 or older
    (if (not (fboundp 'mew-folder-imapp))
	(defun mew-folder-imapp (folder) nil))
    (setq prom-mew-setup t)
    ))

;;; @ Macros
;;;

(defmacro prom-push (v l)
  (list 'setq l (list 'cons v l)))

(defmacro prom-set-log-promrc (log promrc)
  (` (setq (, promrc)
	   (prom-put-alist (car (, log)) (cdr (, log))
			   (, promrc) t))
     ))

(defmacro prom-get-promrc (folder promrc-assoc)
  (` (assoc (, folder) (, promrc-assoc))))

(defmacro prom-promrc-unread-count (folder promrc-assoc)
  (` (car (cdr (prom-get-promrc (, folder) (, promrc-assoc))))))

(defmacro prom-promrc-mail-log (folder promrc-assoc)
  (` (cdr (cdr (prom-get-promrc (, folder) (, promrc-assoc))))))

(defmacro prom-info-folder-name (folder-info)
  (` (car (, folder-info))))

(defmacro prom-info-unread-count (folder-info)
  (` (car (cdr (, folder-info)))))

(defmacro prom-info-mail-log (folder-info)
  (` (cdr (cdr (, folder-info)))))


(defmacro prom-make-promrc-log (folder unread-count mail-log)
  (` (append (list (, folder) (, unread-count)) (, mail-log))))


;;; @ prom-folder-mode
;;;

(defun prom-folder-mode ()
  "Major mode for procmail log listing.

\\{prom-folder-mode-map}
"
  (interactive)
  (kill-all-local-variables)
  (setq major-mode 'prom-folder-mode)
  (setq mode-name "Prom")
  (setq mode-line-modified "-- ")
  (setq mode-line-buffer-identification
	(format "%s: List of folders" prom-version))
  (setq mode-line-process nil)
  (use-local-map prom-folder-mode-map)
  (setq truncate-lines t)
  ;;
  (if mew-xemacs-p
      (progn
	;;(set-specifier scrollbar-height (cons (current-buffer) 0))
        (set-buffer-menubar current-menubar)
        (add-submenu nil prom-folder-mode-menu-spec)
	))
  ;;
  (buffer-disable-undo (current-buffer))
  (setq buffer-read-only t)
  (run-hooks 'prom-folder-mode-hook))


;;; @ prom enter and exit
;;;

(defun prom-mew (&optional arg)
  (interactive "P")
  (let ((buf prom-folder-buffer))
    (run-hooks 'prom-previous-hook)
    (setq prom-previous-window-config (current-window-configuration))
    (if (null mew-mail-path) (mew-init))
    (prom-mew-init buf arg)
    (run-hooks 'prom-hook)
    ))

(defun prom-exit ()
  (interactive)
  ;;
  (prom-save-promrc-file)
  (prom-clean-variables)
  (if prom-exit-kill-all-mew-buffer
      (progn
	(mew-buffer-message-clean-up (function mew-kill-buffer))
	(mew-buffers-clean-up)
	(mew-temp-dir-clean-up)
	(mew-mark-clean-up)))
  (mew-kill-buffer prom-folder-buffer)
  (if prom-previous-window-config
      (set-window-configuration prom-previous-window-config))
  (run-hooks 'prom-exit-hook))

(defun prom-quit ()
  (interactive)
  (prom-save-promrc-file)
  (prom-clean-variables)
  (mew-summary-quit)
  (mew-kill-buffer prom-buffer-tmp)
  (mew-kill-buffer prom-folder-buffer)
  (if prom-previous-window-config
      (set-window-configuration prom-previous-window-config))
  (run-hooks 'prom-exit-hook))

(defun prom-suspend ()
  (interactive)
  (if prom-previous-window-config
      (set-window-configuration prom-previous-window-config))
  )

(defun prom-mew-init (buf &optional arg)
  (cond ((get-buffer buf)
	 (switch-to-buffer (get-buffer buf))
	 )
	(t
	 (switch-to-buffer (get-buffer-create buf))
	 (if prom-full-window
	     (delete-other-windows))
	 (prom-folder-define-key)
	 (prom-folder-mode)
	 (prom-mew-setup)
	 (prom-read-promrc-file)
	 (prom-del-folder-promrc-log)
	 ))
  (if arg
      (prom-folder-goto-folder)
    (or prom-init-no-get-new-mail
	(prom-get-new-mail)
	))
  )

(defun prom-clean-variables ()
  (setq promrc-log-assoc nil
	promrc-old-log-assoc nil
	promrc-prev-log-assoc nil
	prom-status-list-all-folders nil))

;;; @ Commands for prom-folder-mode
;;;

(defun prom-get-new-mail (&optional arg)
  "Get New mail, from procmail log files.
If arg is non-nil, check unread folders."
  (interactive "P")
  (let ((folder (prom-folder-folder-name))
	status)
    (run-hooks 'prom-get-new-mail-pre-hook)
    (or prom-status-list-all-folders
	(prom-del-folder-promrc-log))
    ;;
    (or prom-lock-optional-method
	(and prom-get-new-mail-optional-method
	     (funcall prom-get-new-mail-optional-method arg)))
    (setq status (prom-lock proc-lock-file))
    (cond ((eq status 'error)
	   ;; lock failed
	   (message "lock file `%s' exists!! Please wait a minute." proc-lock-file)
	   (sit-for 1))
	  (status
	   ;; lock successed
	   (and prom-lock-optional-method
		(and prom-get-new-mail-optional-method
		     (funcall prom-get-new-mail-optional-method arg)))
	   (prom-get-proc-log)
	   (prom-unlock proc-lock-file)))
    (run-hooks 'prom-get-new-mail-hook)
    (prom-sort-folder)
    (if (not (eq status 'error))
	(cond ((eq prom-start-list-folders 'nomail-all)
	       (if promrc-log-assoc
		   (prom-list-folders t)
		 (prom-folder-list-all-folders t)))
	      (prom-start-list-folders
	       (prom-folder-list-all-folders t))
	      (t
	       (prom-list-folders t))))
    (if folder
	(prom-folder-jump-to-folder folder))
    ))

(defun prom-get-new-all-mail (&optional arg)
  "Get New mail, from procmail log files and unread folders.
If arg, check no '.mew-cache' folders."
  (interactive "P")
  (let ((prom-get-new-mail-optional-method 'prom-check-unread-folders))
    (prom-get-new-mail arg)))

(defun prom-folder-mouse-show (e)
  (interactive "e")
  (mouse-set-point e)
  (beginning-of-line)
  (prom-folder-read-folder))

(defun prom-folder-read-folder (&optional arg)
  (interactive "P")
  (let ((folder (prom-folder-folder-name)))
    (if folder
	(progn
	  (if (string-match "^\\(.:\\)?/" folder)
	      (error "This path is not folder. Please catchup('c') and check ~/.procmailrc."))
	  (prom-read-folder folder nil arg)))
    ))

(defun prom-folder-goto-folder (&optional arg folder range)
  (interactive "P")
  (mew-window-push)
  (if (interactive-p)
      (call-interactively 'prom-summary-goto-folder)
    (prom-summary-goto-folder arg folder range))
  (run-hooks 'prom-select-folder-hook))

(defun prom-folder-jump-to-folder (folder)
  "Jump to folder."
  (interactive
   (list (completing-read "folder: " promrc-log-assoc nil 'require-match)))
  (let ((case-fold-search nil))
    (goto-char (point-min))
    (re-search-forward (prom-folder-make-regexp folder) nil t)
    ;; Adjust cursor point.
    (beginning-of-line)
    (search-forward ":" nil t)
    ))

(defun prom-folder-next-folder (n)
  "Go to next N'th folder."
  (interactive "p")
  (while (and (> n 1)
	      (prom-folder-search-forward nil t))
    (setq n (1- n)))
  (or (prom-folder-search-forward nil t)
      (message "No more folder")))

(defun prom-folder-next-unread-folder (n)
  "Go to next N'th folder."
  (interactive "p")
  (while (and (> n 1)
	      (prom-folder-search-forward nil nil))
    (setq n (1- n)))
  (or (prom-folder-search-forward nil nil)
      (message "No more unread folder")))

(defun prom-folder-prev-folder (n)
  "Go to previous N'th folder."
  (interactive "p")
  (while (and (> n 1)
	      (prom-folder-search-forward t t))
    (setq n (1- n)))
  (or (prom-folder-search-forward t t)
      (message "No more folder")))

(defun prom-folder-prev-unread-folder (n)
  "Go to previous N'th folder."
  (interactive "p")
  (while (and (> n 1)
	      (prom-folder-search-forward t nil))
    (setq n (1- n)))
  (or (prom-folder-search-forward t nil)
      (message "No more unread folder")))

(defun prom-folder-toggle-move-key (&optional arg)
  (interactive "P")
  (setq prom-folder-toggle-move-key
	(if (null arg) (not prom-folder-toggle-move-key)
	  (> (prefix-numeric-value arg) 0)))
  (if prom-folder-toggle-move-key
      (progn
       (define-key prom-folder-mode-map "n"   'prom-folder-next-folder)
       (define-key prom-folder-mode-map "p"   'prom-folder-prev-folder)
       (define-key prom-folder-mode-map "N"   'prom-folder-next-unread-folder)
       (define-key prom-folder-mode-map "P"   'prom-folder-prev-unread-folder))
    (define-key prom-folder-mode-map "n"   'prom-folder-next-unread-folder)
    (define-key prom-folder-mode-map "p"   'prom-folder-prev-unread-folder)
    (define-key prom-folder-mode-map "N"   'prom-folder-next-folder)
    (define-key prom-folder-mode-map "P"   'prom-folder-prev-folder))
  )

(defun prom-folder-toggle-display-header (&optional arg)
  (interactive "P")
  (setq prom-list-display-header
	(if (null arg) (not prom-list-display-header)
	  (> (prefix-numeric-value arg) 0)))
  (prom-folder-search-forward t t t)
  (let ((folder (prom-folder-folder-name)))
    (prom-list-folders nil t)
    (and folder
	 (prom-folder-jump-to-folder folder)))
  )

(defun prom-folder-catchup ()
  "Mark all messages as unread in current folder as read."
  (interactive)
  (let* ((folder (prom-folder-folder-name)))
    (and folder
	 (or (not prom-interactive-catchup) ;Without confirmation?
	     (y-or-n-p
	      "Delete all messages as read? "))
	 (progn
	   (message "")			;Clear "Yes or No" question.
	   ;; Any marked messages will be preserved.
	   (prom-update-unread-messages folder t)
	   (prom-list-folders)
	   (prom-folder-jump-to-folder folder)
	   (prom-folder-next-folder 1)))
    ))

(defun prom-folder-list-folders (&optional arg)
  (interactive "P")
  (setq prom-status-list-all-folders
	(if (null arg)
	    (not prom-status-list-all-folders)
	  arg))
  (if prom-status-list-all-folders
      (prom-folder-list-all-folders)
    (prom-del-folder-promrc-log)
    (prom-list-folders nil t)
    (setq prom-status-list-all-folders nil)))

(defun prom-folder-list-all-folders (&optional mes)
  (interactive "P")
  (let ((folder-list mew-folder-list))
    (message "Listing all folders ...")
    (while folder-list
      (prom-add-promrc-log
       (car folder-list) nil nil nil)
      (setq folder-list (cdr folder-list)))
    (prom-sort-folder)
    (prom-list-folders mes)
    (setq prom-status-list-all-folders t)
    (message "Listing all folders ... done")
    ))

(defun prom-summary-virtual ()
  (interactive)
  (let ((folder (concat 
	       "++" 
	       (mew-input-string "Virtual folder name %s(%s): " 
				 "" ;; dummy
				 "virtual")))
	(folders (mew-input-folders (or (prom-folder-folder-name)
					prom-folder-name
					)))
	(grep (if (fboundp 'mew-input-pick-pattern)
		  (mew-input-pick-pattern)
		(mew-read-pick-pattern))))
    (mew-summary-scan-body mew-prog-imls
			   'mew-virtual-mode
			   folder
			   mew-cs-virtual
			   nil
			   folders
			   grep)
    )
  )

(defun prom-mew-resetup ()
  (interactive)
  (let ((prom-mew-setup nil))
    (prom-mew-setup)))

(defun prom-version ()
  (interactive)
  (message "%s with %s" prom-version mew-version))


;;; @ Commands or Functions for mew-summary-mode
;;;

(defun prom-add-seen-list (&optional msgnum)
  (let ((prom-msg (or msgnum
		      (cdr (mew-current-get 'message)))))
    (and (stringp prom-msg)
	 (setq prom-msg (string-to-int prom-msg)))
    (if (not (memq prom-msg prom-seen-list))
	(prom-push prom-msg prom-seen-list)))
  )

;; [[ replace functions in mew-summary.el, mew-mark.el

(defun prom::mew-summary-down ()
  (if (orig::mew-summary-down)
      t
    (if (not (get-buffer prom-folder-buffer))
	;;(message "No more message")
	()
      (let* ((cmd (if mew-xemacs-p
		      last-command-char
		    (string-to-char (this-command-keys))))
	     (cmd-key (if mew-xemacs-p
			  (single-key-description cmd)
			(key-description (char-to-string cmd))))
	     (folder (prom-summary-search-folder))
 	     (select-next
	      (and prom-auto-select-next
		   prom-tmp-auto-select-next
		   (not (member this-command
				prom-auto-select-next-ignored-command-list)))))
	(message "No more message%s"
		 (if select-next
		     (if folder
			 (format " (Type %s for %s)"
				 cmd-key
				 folder)
		       (format " (Type %s to exit %s)"
			       cmd-key
			       prom-folder-name
			       ))
		   ""))
	;; Select next unread folder automatically.
	(cond (select-next
	       (let (key keve)
		 (setq key (car (setq keve (prom-read-event-char))))
		 (if (equal key cmd)
		     (prom-summary-next-folder)
		   (prom-push (cdr keve) unread-command-events))))
	      )))
    ;;
    nil)
  )

(defun prom::mew-summary-mark-as (mark &optional force)
  "Mark this message if possible"
  (orig::mew-summary-mark-as mark force)
  (let ((msg (mew-summary-message-number)))
    (prom-add-seen-list msg)))

;;

(defconst prom-replace-function-list
  (list 'mew-summary-down
	'mew-summary-mark-as))

(defun prom-replace-function ()
  (mapcar
   (lambda (function)
     (if (not (fboundp (intern (format "orig::%s" function))))
	 (progn
	   (fset (intern (format "orig::%s" function))
		 (symbol-function function))
	   (fset function (intern (format "prom::%s" function)))
	   )))
   prom-replace-function-list
   ))

(prom-replace-function)


;; ]]

(defun prom-summary-next-folder ()
  (interactive)
  (prom-summary-jump-to-folder prom-folder-name)
  (let ((folder (prom-summary-search-folder)))
    (if (null folder)
	(progn
	  (message "Exiting %s..." prom-folder-name)
	  (prom-summary-exit)
	  (message ""))
      (message "Selecting %s..." folder)
      (prom-summary-exit t)		;Exit Summary mode temporary.
      (prom-summary-jump-to-folder folder)
      (prom-read-folder folder t)
      ))
  )

(defun prom-summary-exit (&optional temporary)
  "Exit reading current folder, and then return to folder selection mode."
  (interactive "P")
  (if prom-folder-name
      (prom-update-unread-messages prom-folder-name))
  (setq prom-seen-list nil)
  (or prom-mew-compatible
      (prom-kill-buffer))
  (mew-summary-suspend)
  (if (and (not prom-mew-compatible)
	   (get-buffer prom-folder-buffer))
      (set-buffer prom-folder-buffer))
  (if (and prom-mew-compatible
	   (not (equal (buffer-name) prom-folder-buffer)))
      nil
    (prom-list-folders)
    (if prom-folder-name
	(prom-folder-jump-to-folder prom-folder-name))
    )
  )

(defun prom-summary-goto-folder (&optional arg fld range)
  (interactive "P")
  (let (dir folder prev-folder)
    (if (interactive-p)
	(progn
	  (setq prev-folder (buffer-name))
	  (call-interactively 'mew-summary-goto-folder)
	  (setq folder (buffer-name))
	  (if (equal prev-folder folder)
	      nil
	    (if prom-folder-name
		(prom-update-unread-messages prom-folder-name))
	    (if folder
		(setq prom-folder-name folder))
	    (setq prom-seen-list nil)
	    (setq prom-tmp-auto-select-next nil)
	    ))
      (setq folder (or fld (mew-input-folder mew-inbox-folder))
	    dir (mew-expand-folder folder))
      (cond
       ((mew-folder-newsp folder)
	(prom-summary-goto-folder-subr folder range arg))
       ((mew-folder-imapp folder)
	(if (or (file-directory-p dir)
		(and (y-or-n-p
		      (format
		       "Cache directory for %s does not exist. Create it? "
		       folder))
		     (mew-make-directory dir)))
	    (prom-summary-goto-folder-subr folder range arg)))
       (t   ;; mail or local news
	(if (null dir)
	    (message "Folder is wrong")
	  (if (not (file-directory-p dir))
	      (message "No such folder %s" folder)
	    (prom-summary-goto-folder-subr folder range arg)
	    (if mew-summary-trace-directory (cd dir)))))))
    ))

(defun prom-summary-goto-folder-subr (folder range arg)
  (let (new-folder)
    (if (get-buffer folder)
	(switch-to-buffer folder)
      (mew-summary-folder-create folder)
      (setq new-folder t))
    (prom-summary-ls folder range (or arg new-folder) t)))

(defun prom-summary-ls (&optional prom-folder range jump arg)
  (let ((folder (or prom-folder (buffer-name)))
	(force range)
	scanp lines)
    (mew-summary-folder-cache-manage folder)
    (mew-mark-clean)
    (if jump (goto-char (point-max)))
    (mew-buffers-setup folder)
    (cond
     ((boundp 'mew-range-interactive-alist)  ;; for Newer Mew
      (cond
       (range
	(setq range (prom-adj-range2 folder range))
	(setq scanp t))
       ((mew-folder-remotep folder);; xxx
	(setq range (mew-input-range folder mew-range-interactive-alist t))
	(setq scanp t))
       ((and mew-summary-cache-use (mew-summary-folder-dir-newp))
	(setq range (mew-input-range folder mew-range-auto-alist mew-ask-range))
	(setq scanp t)))
      (if (not scanp)
	  (or arg (goto-char (point-max)))
	(or arg (goto-char (point-max)))
	(mew-decode-syntax-delete)
	(if (equal (car range) "all")
	    (setq lines (mew-summary-mark-collect3 mew-mark-review)))
	(mew-summary-scan-body mew-prog-imls 
			       'mew-summary-mode
			       folder
			       mew-cs-scan
			       range
			       nil
			       nil
			       lines)))
     (t ;; for Older Mew
      (if (or force
	      (mew-folder-newsp folder)
	      (mew-folder-imapp folder)
	      (and mew-summary-cache-use
		   (mew-summary-folder-dir-newp)))
	  (progn
	    (mew-decode-syntax-delete)
	    (or arg (goto-char (point-max)))
	    (mew-summary-scan-body mew-prog-imls 
				   'mew-summary-mode
				   folder
				   mew-cs-scan
				   (if (null range)
				       (mew-input-range folder)
				     (prom-adj-range folder range))))
	(or arg (goto-char (point-max))))))))


;;; @ Functions of commands for prom-folder-mode
;;;

(defun prom-folder-dir-newp (folder)
  ;; buffer switched
  (let* ((dir (file-chase-links (mew-expand-folder folder)))
	 (tdir (nth 5 (file-attributes dir)))
	 (da (car tdir))
	 (db (car (cdr tdir)))
	 (cache (expand-file-name mew-summary-cache-file dir))
	 (tcache (nth 5 (file-attributes cache)))
	 (fa (car tcache))
	 (fb (car (cdr tcache))))
    (cond
     ((null tdir) nil)
     ((null tcache) t) ;; no cache, do update!
     ((> da fa) t)
     ((= da fa) (if (> db fb) t nil)) ;; nil if same 
     (t nil)
     )
    ))

(defun prom-mew-directory-msgs (folder)
  "*Return (list begin-msg eng-msg msgs) in folder."
  (let* ((dir (mew-expand-folder folder)))
    (if (file-exists-p dir)
	(let ((files (sort (mapcar 'string-to-int
				   (directory-files dir nil "^[0-9]+$" t))
			   '<)))
	  (if files
	      (list (car files) (car (reverse files)) (length files))))
      nil)
    ))


(defun prom-mew-cache-lastnum (folder &optional cache)
  (let ((mew-folder-buffer (get-buffer folder))
	(mew-cache (or cache
		       (mew-expand-folder folder mew-summary-cache-file))))
    (save-excursion
      (if mew-folder-buffer
	  (set-buffer mew-folder-buffer)
	(set-buffer (get-buffer-create prom-buffer-tmp))
	(erase-buffer)
	(if (file-exists-p mew-cache)
	    (mew-frwlet mew-cs-scan mew-cs-binary
			(insert-file-contents mew-cache))))
      (goto-char (point-max))
      (if (bobp)
	  0
	(forward-line -1)
	(string-to-int
	 (save-excursion
	   (beginning-of-line)
	   (if (looking-at mew-summary-message-regex)
	       (mew-match 1)
	     "0")))
	))
    ))

(defun prom-unread-count (folder &optional disp)
  "*Return (list unread-count begin-msg eng-msg) in folders.
Ignored if `mew-summary-cache-use' is nil."
  (let ((cache (mew-expand-folder folder mew-summary-cache-file))
	(unread-count nil)
	(cache-lastnum nil)
	(lastnum nil)
	msgs begin-msg)
    (if (and mew-summary-cache-use
	     (prom-folder-dir-newp folder))
	(save-excursion
	  (if (or (prom-member-regex
		   folder
		   prom-ignore-check-folders)
		  (and (not (file-exists-p cache))
		       prom-ignore-no-mewcache-folders))
	      nil
	    (if disp
		(message "Checking unread folders ... (%s)" folder))
	    (if (setq msgs (prom-mew-directory-msgs folder))
		(progn
		  (setq lastnum (car (cdr msgs)))
		  (setq cache-lastnum
			(prom-mew-cache-lastnum folder cache))
		  (cond ((= 0 cache-lastnum)
			 (setq begin-msg (car msgs))
			 (setq unread-count (nth 2 msgs)))
			(t
			 (setq unread-count (- lastnum cache-lastnum))
			 (setq begin-msg (1+ cache-lastnum))))
		  (if (> 0 unread-count)
		      (setq unread-count 0))
		  ))
	    )))
    (if (and unread-count (> unread-count 0))
	(list unread-count begin-msg lastnum))
    ))

(defun prom-member-regex (str regex-alist)
  (let ((regex))
    (catch 'found
      (while (setq regex (car regex-alist))
	(if (string-match regex str)
	    (throw 'found regex))
	(setq regex-alist (cdr regex-alist)))
      nil)
    ))

(defun prom-check-unread-folders (&optional arg folder-list)
  "Check unread folders.
 If arg is non-nul, check no '.mew-cache' folders.
 If folder-list is given, check `folder-list'. if nil, check `mew-folder-list'
"
  (let ((prom-ignore-no-mewcache-folders
	 (if arg
	     nil
	   prom-ignore-no-mewcache-folders)))
    (if (not prom-ignore-no-mewcache-folders)
	(call-interactively 'mew-status-update))
    (setq folder-list (or folder-list
			  mew-folder-list))
    (message "Checking unread folders ...")
    (while folder-list
      (let ((unread-list
	     (prom-unread-count (car folder-list) t)))
	(and (car unread-list)
	     (prom-add-promrc-log
	      (car folder-list)
	      (nth 1 unread-list) nil nil (car unread-list)))
	(setq folder-list (cdr folder-list))))
    (message "Checking unread folders ... done")
    ))

(defun prom-check-list-folders (&optional arg)
  "Check `prom-check-folders' folders.
If arg, check `mew-folder-list' folders."
  (if arg
      (prom-check-unread-folders t)
    (prom-check-unread-folders nil prom-check-folders)))

(defun prom-folder-jump-message (msg)
  (goto-char (point-min))
  (if (re-search-forward (format "^[ ]*%d[^0-9:]+" msg) nil t)
      (beginning-of-line)
    ))

(defun prom-list-folders (&optional mes force)
  (if (and (not force)
	   (equal promrc-prev-log-assoc promrc-log-assoc))
      nil
    (prom-list-folders-builtin mes)
    (prom-folder-highlight-mouse)
    (run-hooks 'prom-list-folders-hook))
  (if (zerop (buffer-size))
      nil
    (goto-char (point-min))
    (prom-folder-search-forward nil nil t))
  (if mes
      (cond ((eq prom-unread-mails 0)
	     (message "No unread mail"))
	    ((eq prom-unread-mails 1)
	     (message " 1 unread mail"))
	    (t
	     (message " %d unread mails" prom-unread-mails))))
  (setq promrc-prev-log-assoc (copy-alist promrc-log-assoc))
  )

(defun prom-folder-highlight-mouse ()
  (if (and window-system prom-highlight-mouse-line)
      (cond (mew-temacs-p
	     (save-excursion
	       (let ((buffer-read-only nil)
		     (regexp prom-folder-name-regexp))
		 (goto-char (point-min))
		 (while (not (eobp))
		   (if (re-search-forward regexp nil t)
		       (overlay-put
			(make-overlay
			 (match-beginning 1) (match-end 1))
			'mouse-face 'highlight))
		   (forward-line 1)
		   ))
	       ))
	    (mew-xemacs-p
	     (setq mode-motion-hook prom-highlight-mouse-line-function))
	    )))

(defun prom-list-folders-builtin (&optional mes)
  (let ((buffer-read-only nil)
	(promrc promrc-log-assoc))
    (erase-buffer)
    (setq prom-unread-mails 0)
    (while promrc
      (let* ((folder-info (car promrc))
	     (folder-name (prom-info-folder-name folder-info))
	     (mail-log-all (prom-info-mail-log folder-info))
	     (unread-count (prom-info-unread-count folder-info))
	     (unread-mail (or unread-count (length mail-log-all)))
	     )
	(setq prom-unread-mails (+ prom-unread-mails unread-mail))
	(insert (format prom-folder-list-regexp
			unread-mail
			folder-name))
	;; if unread-count is non-nil, this folder is checked folder.
	(if (and (not unread-count)
		 prom-list-display-header)
	    (while mail-log-all
	      (let ((mail-log (car mail-log-all)))
		(insert (format (concat "      %5d"
					(if prom-list-display-from
					    " (%-14s)"
					  "%s")
					" %s\n")
				(car mail-log)
				;; From
				(if prom-list-display-from
				    (substring-e
				     (prom-get-display-name
				      (nth 1 mail-log))
				     0 14)
				  "")
				;; Subject
				(prom-header-decode (nth 2 mail-log))
				)))
	      (setq mail-log-all (cdr mail-log-all))))
	(setq promrc (cdr promrc))))
    ))

(defun prom-folder-search-forward (backward norest &optional heretoo)
  "Search for the next (or previous) folder.
If 1st argument BACKWARD is non-nil, search backward instead.
If 2nd argument NOREST is non-nil, don't care about folder property.
If optional argument HERETOO is non-nil, current line is searched for, too."
  (let ((case-fold-search nil)
	(func
	 (if backward
	     (function re-search-backward) (function re-search-forward)))
	(regexp
	 (format prom-folder-search-regexp
		 (if norest ".." " [ \t]")
		 (if norest "[0-9]+" "[1-9][0-9]*")))
	(found nil))
    (if backward
	(if heretoo
	    (end-of-line)
	  (beginning-of-line))
      (if heretoo
	  (beginning-of-line)
	(end-of-line)))
    (setq found (funcall func regexp nil t))
    ;; Adjust cursor point.
    (beginning-of-line)
    (search-forward ":" nil t)
    ;; Return T if found.
    found
    ))

(defun prom-folder-folder-name ()
  "Get folder name around point."
  (save-excursion
    (beginning-of-line)
    (if (looking-at prom-folder-name-regexp)
	(mew-match 1))
    ))

(defun prom-read-folder (folder &optional no-message arg)
  (let* ((folder-info (prom-get-promrc folder promrc-log-assoc))
	 (mail-log (prom-info-mail-log folder-info))
	 (unread-count (prom-info-unread-count folder-info))
	 (begin-msg (car (car mail-log)))
	 (end-msg (car (car (reverse mail-log))))
	 (range nil)
	 (prom-auto-select-first prom-auto-select-first))
    (setq prom-folder-name folder)
    (if (null no-message)
	(setq prom-window-config (current-window-configuration)))
    (setq prom-cursol-point (point))
    (if (null begin-msg)
	(progn
	  (setq prom-tmp-auto-select-next nil)
	  (prom-folder-goto-folder arg folder)
	  )
      (setq prom-tmp-auto-select-next t)
      (setq range (concat (int-to-string begin-msg)
			  "-"
			  (if (or unread-count
				  prom-summary-ls-always-last)
			      "last"
			    (int-to-string end-msg))
			  ))
      ;; if unread-count is non-nil, this folder is checked folder.
      (if unread-count
	  (progn
	    (prom-update-unread-messages folder t)
	    (setq prom-auto-select-first
		  prom-auto-select-first-for-checked-folder)))
      (setq prom-seen-list nil)
      (prom-folder-goto-folder arg folder
			       (list range nil 'update)) ;; not erase
      (if (and begin-msg prom-auto-select-first)
	  (progn
	    (if (processp mew-summary-buffer-process)
		(if (and (not prom-wait-auto-select-first)
			 (fboundp 'accept-process-output))
		    (while
			(and mew-summary-buffer-process
			     (equal (process-status mew-summary-buffer-process) 'run)
			     (not (prom-search-message begin-msg)))
		      (accept-process-output mew-summary-buffer-process)
		      (sit-for 0.1))
		  (while mew-summary-buffer-process (sit-for 1)))
	      )
	    (mew-summary-jump-message begin-msg)
	    (mew-summary-display nil)))
      )))

(defun prom-search-message (msg)
  (save-excursion
;;    (goto-char (point-min))
    (if (re-search-forward (format "^[ ]*%s[^0-9]+" msg) nil t)
	(progn
	  (beginning-of-line)
	  t)
      nil)))

(defun prom-adj-range (folder range)
  "return (range erase 'update)"
  (string-match "\\(.*\\)-\\(.*\\)" (car range))
  (let ((end-num (mew-match 2 (car range))))
    (cond
     ((get-buffer folder)
      (save-excursion
	(set-buffer folder)
	(if (equal (point-min) (point-max))
	    range	;; default
	  (goto-char (point-max))
	  (forward-line -1)
	  (list (concat (int-to-string 
			 (1+ (string-to-int (mew-summary-message-number))))
			"-"
			end-num)
		nil 'update) ;; not erase
	  ))
      )
     (t range)	;; default
     )))

(defun prom-adj-range2 (folder range)
  "return (range erase-update)"
  (string-match "\\(.*\\)-\\(.*\\)" (car range))
  (let ((end-num (mew-match 2 (car range))))
    (cond
     ((get-buffer folder)
      (save-excursion
	(set-buffer folder)
	(if (equal (point-min) (point-max))
	    range	;; default
	  (goto-char (point-max))
	  (forward-line -1)
	  (list (concat (int-to-string 
			 (1+ (string-to-int (mew-summary-message-number))))
			"-"
			end-num)
		'update) ;; not erase
	  )))
     (t range)	;; default
     )))

(defun prom-kill-buffer (&optional buf)
  (if prom-kill-mew-buffer
      (progn
	(if (null buf)
	    (setq buf (current-buffer)))
	(let ((buf-name (buffer-name buf)))
	  (if (not (equal buf-name prom-folder-buffer))
	      (progn
		;;(mew-summary-folder-mark-exec)
		(mew-mark-clean)
 		(if (get-buffer (mew-buffer-message))
		    (delete-windows-on (mew-buffer-message)))
		(kill-buffer buf)
		(setq mew-buffers (delete buf-name mew-buffers)))))
	(mew-kill-buffer (mew-buffer-message))
	)))

(defun prom-lock (lockfile)
  (setq prom-do-lock t)
  (if prom-lock-at-exist-log
      (setq prom-do-lock
	    (let ((log-list proc-log-list)
		  proc-log)
	      (catch 'exist
		(while log-list
		  (setq proc-log (car log-list))
		  (if (file-exists-p proc-log)
		      (throw 'exist t))
		  (setq log-list (cdr log-list)))
		nil))))
  (if prom-do-lock
      (setq prom-do-lock
	    (or
	     (cond (prom-use-lockfile
		    (prom-wait-lock lockfile))
		   (t
		    (prom-make-lock lockfile)))
	     'error)))
  prom-do-lock
  )

(defun prom-unlock (lockfile)
  (if (and prom-do-lock
	   (file-exists-p lockfile))
      (delete-file lockfile)))

(defun prom-make-lock (lockfile)
  (let ((status (call-process "ln" nil nil nil
			      "-s" "prom-mew" (expand-file-name lockfile))))
    (if (= 0 status)
	t
      (message "lock file exists!!")
      nil
      )))

(defun prom-wait-lock (lockfile)
  (message "Now locking..." lockfile)
  (let ((status (apply (function call-process)
		       prom-prog-lockfile nil nil nil
		       (append
			prom-prog-lockfile-arg-list
			(list (expand-file-name lockfile))))))
    (if (= 0 status)
	(progn
	  (message "")
	  t)
      (message "lock failed!!")
      nil
      )))

;;; @ Functions for promrc-log-assoc
;;;

(defun prom-get-proc-log ()
  (save-excursion
    (set-buffer (get-buffer-create prom-buffer-tmp))
    (buffer-disable-undo (current-buffer))
    (let ((log-list proc-log-list))
      (erase-buffer)
      (while log-list
	(let ((proc-log (car log-list)))
	  (cond ((file-exists-p proc-log)
		 (goto-char (point-max))
		 (mew-flet (insert-file-contents proc-log))
		 (delete-file proc-log))
		)
	  (setq log-list (cdr log-list))))
      (if (zerop (buffer-size))
	  nil
	(prom-append-keep-log)
	(prom-set-promrc-log)
	(run-hooks 'prom-get-proc-log-hook)
	))
    ))

(defun prom-append-keep-log ()
  (if proc-keep-log
      (let ((log-size (nth 7 (file-attributes proc-keep-log))))
	(if (and prom-keep-log-max-size log-size
		 (> log-size prom-keep-log-max-size))
	    (rename-file proc-keep-log (concat proc-keep-log ".bak") t))
	(if (file-writable-p proc-keep-log)
	    (save-excursion
	      (write-region (point-min) (point-max) proc-keep-log t 'no-msg))
	  (message "not writable file! `%s'" proc-keep-log)))))

(defun prom-get-display-name (from)
  (or (cond
       ((and (boundp 'mew-addrbook-switch)
	     (fboundp 'mew-addrbook-func))
	(let ((func (mew-addrbook-func prom-mew-addrbook-for-prom)))
	  (and func (funcall func from))))
       ((and (boundp 'mew-use-petname)
	     mew-use-petname)
	(cond
	 ((fboundp 'mew-addrbook-nickname-get)
	  (mew-addrbook-nickname-get from))
	 ((and (boundp 'mew-petname-alist)
	       mew-petname-alist)
	  (cdr (mew-assoc-case-equal from mew-petname-alist 0))))))
      from))

(defun prom-set-promrc-log ()
  (let (folder msg from subject petname)
    (save-excursion
      (goto-char (point-min))
      (while (re-search-forward "^  Folder: \\(.+\\)" nil t)
	(let ((folder-body (mew-match 1)))
	  (if (string-match "^\\(.+\\)/\\([0-9]+\\)" folder-body)
	      (let ((path (mew-match 1 folder-body))
		    (num (mew-match 2 folder-body)))
		(setq msg (string-to-int num))
		(cond ((string-match "^[+=]" path)
		       (setq folder path)
		       )
		      ;; Absolute path (include DriveLetter)
		      ((string-match "^\\(.:\\)?/" path)
		       (cond
			((string-match (concat "^" (expand-file-name mew-mail-path) "/*") path)
			 (setq folder
			       (concat "+" (substring path (match-end 0)))) )
			((string-match (concat "^" (expand-file-name mew-news-path) "/*") path)
			 (setq folder
			       (concat "=" (substring path (match-end 0)))) )
			(t
			 (setq folder path)) ))
		      ;; mail folder
		      (t
		       (setq folder (concat "+" path))
		       ))
		(save-excursion
		  (forward-line -1)
		  (beginning-of-line)
		  (if (looking-at "^ Subject: \\(.+\\)")
		      (progn
			(setq subject (mew-match 1))
			(setq subject
			      (or (mew-cs-decode-string subject mew-cs-scan)
				  ""))
			(forward-line -1)
			(beginning-of-line))
		    (setq subject ""))
		  (if (looking-at "^From \\([^ \t\n]+\\) +")
		      (setq from (mew-match 1))
		    (setq from "")))
		;;
		(prom-add-promrc-log folder msg from subject))))))))

(defun prom-sort-folder ()
  (cond (prom-sort-folder-list-2
	 (prom-sort-folder-2))
	(t
	 (prom-sort-folder-1))))

(defun prom-sort-folder-1 ()
  (let ((folder-list (reverse prom-sort-folder-list)))
    (while folder-list
      (let* ((folder (car folder-list))
	     (folder-info (prom-get-promrc folder promrc-log-assoc)))
	(if folder-info
	    (setq promrc-log-assoc
		  (cons folder-info (delq folder-info promrc-log-assoc)))
	  ))
      (setq folder-list (cdr folder-list)))))

(defun prom-sort-folder-2 ()
  (let ((sort-list prom-sort-folder-list-2)
	(promrc-log-assoc-2 nil))
    (if (equal promrc-log-assoc-presort promrc-log-assoc)
	(setq promrc-log-assoc (copy-alist promrc-log-assoc-aftsort))
      (setq promrc-log-assoc-presort (copy-alist promrc-log-assoc))
      (while sort-list
	(let* ((sort-key (car sort-list))
	       (alist promrc-log-assoc)
	       folder-info n)
	  (while alist
	    (setq folder-info (car alist))
	    (setq n (car folder-info))
	    (if (string-match sort-key n)
		(progn
		  (setq promrc-log-assoc-2
			(append promrc-log-assoc-2 (list folder-info)))
		  (setq promrc-log-assoc
			(delq folder-info promrc-log-assoc))))
	    (setq alist (cdr alist)))
	  )
	(setq sort-list (cdr sort-list)))
      (setq promrc-log-assoc
	    (append promrc-log-assoc-2 promrc-log-assoc))
      (setq promrc-log-assoc-aftsort (copy-alist promrc-log-assoc))
      )))

(defun prom-add-promrc-log (folder msg from subject &optional unread-count)
  (let ((add-log (and msg (list (list msg from subject))))
	(promrc promrc-log-assoc)
	new-folder-info found)
    (setq found (prom-get-promrc folder promrc))
    (if found
	(let* ((folder-name (prom-info-folder-name found))
	       (old-unread-count (prom-info-unread-count found))
	       (mail-log (prom-info-mail-log found)))
	  (if add-log
	      (let ((new-mail-log
		     (if old-unread-count
			 add-log
		       (if (and unread-count mail-log)
			   (progn (setq unread-count nil)
				  mail-log)
			 (append mail-log add-log)))))
		(setq new-folder-info
		      (prom-make-promrc-log
		       folder-name unread-count new-mail-log)))
	    (setq new-folder-info
		  (prom-make-promrc-log
		   folder-name old-unread-count mail-log)))
	  )
      (setq new-folder-info
	    (prom-make-promrc-log folder unread-count add-log))
      )
    (prom-set-log-promrc new-folder-info promrc-log-assoc)
    ))

(defun prom-del-folder-promrc-log ()
  (let ((promrc promrc-log-assoc))
    (while promrc
      (let* ((folder-info (car promrc))
	     (unread-count (prom-info-unread-count folder-info)))
	(if (and (null (prom-info-mail-log folder-info))
		 (or (null unread-count)
		     (zerop unread-count)))
	    (setq promrc-log-assoc
		  (delq folder-info promrc-log-assoc))))
      (setq promrc (cdr promrc)))
    ))

(defun prom-update-unread-messages (folder &optional all)
  (if all
      (prom-del-allmsg-promrc-log folder)
    (prom-del-msg-promrc-log folder prom-seen-list)))

(defun prom-del-allmsg-promrc-log (folder)
  (let (log found)
    (setq found (prom-get-promrc folder promrc-log-assoc))
    (if found
	(progn
	  (setq log (list (prom-info-folder-name found)))
	  (prom-set-log-promrc log promrc-log-assoc)
	  ))))

(defun prom-del-msg-promrc-log (folder msg-list)
  (let (promrc)
    (setq promrc (prom-get-promrc folder promrc-log-assoc))
    (if promrc
	(while msg-list
	  (let* ((old-unread-count (prom-info-unread-count promrc))
		 (log-all (prom-info-mail-log promrc))
		 (log log-all)
		 (msg (car msg-list))
		 (found nil)
		 info)
	    (while (and (not found) log)
	      (if (equal msg (car (car log)))
		  (let* ((new-log (delq (car log) log-all))
			 (unread-count (and old-unread-count
					    (length new-log))))
		    (setq info
			  (prom-make-promrc-log
			   folder unread-count new-log))
		    (prom-set-log-promrc info promrc-log-assoc)
		    (setq found t))
		(setq log (cdr log))))
	    (setq msg-list (cdr msg-list)))))
    ))

(defun prom-read-promrc-file ()
  "Read startup FILE."
  (let ((startup (expand-file-name prom-startup-file mew-mail-path)))
    (if (file-readable-p startup)
	(load startup t t t)
      )
    (setq promrc-old-log-assoc (copy-alist promrc-log-assoc))))

(defun prom-save-promrc-file ()
  "Save to .promrc FILE and cache file."
  (prom-del-folder-promrc-log)
  (if (equal promrc-old-log-assoc promrc-log-assoc)
      nil
    (save-excursion
      (set-buffer (get-buffer-create " *proc-promrc*"))
      (buffer-disable-undo (current-buffer))
      (erase-buffer)
      (insert "(setq promrc-log-assoc '"
	      (prin1-to-string promrc-log-assoc)
	      ")\n")
      (let ((make-backup-files nil)
	    (version-control nil)
	    (require-final-newline t) ;Don't ask even if requested.
	    (startup (expand-file-name prom-startup-file mew-mail-path)))
	(write-region (point-min) (point-max) startup nil 'no-msg)
	(kill-buffer (current-buffer))
	(message "Saving %s... Done" startup))
      )
    ))


;;; @ Misc
;;;

(defun substring-e (string start end)
  (substring (concat string (make-string (- end start) ?\ )) start end))

;; from tl-list.el (Tools for MIME), Modified by M.Murata
(defun prom-put-alist (item value alist &optional last)
  "If there is a pair whose car is <ITEM>, replace its cdr by <VALUE>.
If there is not such pair, create new pair (<ITEM> . <VALUE>) and
return new alist whose car is the new pair and cdr is <ALIST>.
"
  (if (assoc item alist)
      (progn
	(rplacd (assoc item alist) value)
	alist)
    (if last
	(append alist (list (cons item value)))
      (cons (cons item value) alist))
    ))

;;; @ Modified functions in mew-header.el 1.70
;;;

(defun prom-header-decode (str)
  (if (null str)
      (setq str "")
    (if (not (string-match mew-header-decode-regex str))
	;;(setq str (mew-cs-decode-string str mew-cs-scan))
      nil
      (while (string-match mew-header-decode-regex str)
	(let* ((charset (mew-match 1 str))
	       (encode (mew-match 2 str))
	       (enstr (mew-match 3 str))
	       (head (substring str 0 (match-beginning 0)))
	       (tail (substring str (match-end 0) (length str)))
	       ;;(func (cdr (mew-assoc-match encode mew-header-decode-switch 0)))
	       (destr ""))
	  (setq destr (mew-header-decode charset encode enstr))
	  (setq str (concat head destr tail))
	  ))))
  str
  )

;;; @ Modified functions in gnus.el (GNUS 4)
;;;

(defun prom-summary-search-folder (&optional backward)
  "Search for next unread folder.
If optional argument BACKWARD is non-nil, search backward instead."
  (save-excursion
    (set-buffer prom-folder-buffer)
    (save-excursion
      (if prom-cursol-point
	  (goto-char prom-cursol-point))
      (if (prom-folder-search-forward backward nil)
	  (prom-folder-folder-name))
      )))

(defun prom-folder-make-regexp (folder)
  "Return regexp that matches for a line of folder."
  (concat "^.+: " (regexp-quote folder) "\\([ \t].*\\|$\\)"))

(defun prom-summary-jump-to-folder (folder)
  "Move point to folder in message mode buffer."
  ;; Keep update point of Group mode buffer if visible.
  (if (eq (current-buffer)
	  (get-buffer prom-folder-buffer))
      (save-window-excursion
	;; Take care of tree window mode.
	(if (get-buffer-window prom-folder-buffer)
	    (pop-to-buffer prom-folder-buffer))
	(prom-folder-jump-to-folder folder))
    (save-excursion
      ;; Take care of tree window mode.
      (if (get-buffer-window prom-folder-buffer)
	  (pop-to-buffer prom-folder-buffer)
	(set-buffer prom-folder-buffer))
      (prom-folder-jump-to-folder folder))))

;; Modified functions in gnus-util.el (Gnus 5.4)

(defun prom-read-event-char ()
  "Get the next event."
  (let ((event (read-event)))
    ;; should be gnus-characterp, but this can't be called in XEmacs anyway
    (cons (and (numberp event) event) event)))

(defun prom-xmas-read-event-char ()
  "Get the next event."
  (let ((event (next-command-event)))
    (sit-for 0)
    ;; We junk all non-key events.  Is this naughty?
    (while (not (or (key-press-event-p event)
		    (button-press-event-p event)))
      (dispatch-event event)
      (setq event (next-command-event)))
    (cons (and (key-press-event-p event)
	       (event-to-character event))
	  event)))

(if mew-xemacs-p
    (fset 'prom-read-event-char 'prom-xmas-read-event-char))

;;; @ end
;;;

(run-hooks 'prom-mew-load-hook)

(provide 'prom-mew)

;;; Local variables:
;;; mode: outline-minor
;;; outline-regexp: ";;; @+\\|(......"
;;; End:
