;;;
;;;  cmail-summary.el - making and displaying summaries
;;;
;;;  $Author: tmp $
;;;  created at: Wed Jul 28 17:09:58 JST 1993
;;;
;;;  Copyright (C) 1992-1996 Yukihiro Matsumoto.

;; This file is not part of GNU Emacs but obeys its copyright notice.

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY.  No author or distributor
;; accepts responsibility to anyone for the consequences of using it
;; or for whether it serves any particular purpose or works at all,
;; unless he says so in writing.  Refer to the GNU Emacs General Public
;; License for full details.

;; Everyone is granted permission to copy, modify and redistribute
;; GNU Emacs, but only under the conditions described in the
;; GNU Emacs General Public License.   A copy of this license is
;; supposed to have been given to you along with GNU Emacs so you
;; can know your rights and responsibilities.  It should be in a
;; file named COPYING.  Among other things, the copyright notice
;; and this notice must be preserved on all copies.

(provide 'cmail-summary)

;; ==== メイルのインデックス生成 ========================================
(defun cmail-get-mail-headers (beg end)
  "カレントバッファのBEGとENDの間からメイルのヘッダを回収する."
  (let ((sbj *cmail-unknown-field-value)
	(dt "00/00/00")
	(whm "somebody <sombody@somewhere>")
	(lines 0)
	(st "A")
	tmp)
    (goto-char beg)
    (search-forward "\n\n" end 1)
    (setq lines (count-lines (point) end))
    (setq end (point))
    (let ((curbuf (current-buffer))
	  (idxbuf (get-buffer-create " *cmail-header*")) status-mark)
      (set-buffer idxbuf)
      (erase-buffer)
      (cmail-insert-buffer-substring curbuf beg end)
      (let ((code (detect-coding-region (point-min) (point-max))))
	(if (listp code) (setq code (car code)))
	(decode-coding-region (point-min) (point-max) code))
      (run-hooks 'cmail-get-headers-hook)
      (goto-char (point-min))
      (setq tmp (cmail-get-field-values "Subject"))
      (if tmp (setq sbj tmp))
      (goto-char (point-min))
      (if cmail-use-X-Nsubject
	  (let ((tmp (cmail-get-field-values "X-Nsubject")))
	    (if tmp (setq sbj tmp))))
      (goto-char (point-min))
      (setq tmp (cmail-trans-name-form (cmail-get-field-values "From")))
      (if tmp (setq whm tmp))
      (goto-char (point-min))
      (setq tmp (cmail-trans-date-form (cmail-get-field-values "Date")
				       cmail-summary-long-date-format))
      (if tmp (setq dt tmp))
      (goto-char (point-min))
      (if (re-search-forward "^X-cmail-status: \\(.+\\)$" end t)
	  (setq st (elt (cmail-get-mark-symbol (match-string 1)) 1)))
      (kill-buffer idxbuf)
      (set-buffer curbuf))
    (format "%s %s %s %d [%s]" st dt whm lines sbj)))

;; ++++ サマリ生成(interactive) +++++++++++++++++++++++++++++++++++++++++++
(defvar *cmail-folder-curpos nil)

(defun cmail-make-summary (&optional folder quiet)
  "FOLDERのインデックスからサマリを生成する."
  (interactive (list cmail-current-folder))
  (if (null folder)
      (setq folder cmail-current-folder)
    (setq cmail-current-folder folder))
  (if cmail-broken-cursor (sit-for 0))
  (if (get-buffer *cmail-summary-buffer) (kill-buffer *cmail-summary-buffer))
  (set-buffer (get-buffer-create *cmail-summary-buffer))
  (run-hooks 'cmail-summary-buffer-created-hook)
  (cmail-select-buffer *cmail-summary-buffer)
  (setq buffer-read-only nil)
  (erase-buffer)
  (let (lim sumr exception-type (th (cmail-thread-p)))
    (condition-case nil
	(progn
	  (or quiet (cmail-message-resource1 'make-summary-1 folder))
	  (cmail-get-header folder)
	  (widen)
	  (if (and th cmail-thread-ignore-limit)
	      (progn
		(setq *cmail-summary-limit nil)
		(goto-char (point-min))
		(cmail-th-insert-summary))
	    (if *cmail-summary-limit
		(let ((n *cmail-summary-limit))
		  (if (< n 0)
		      (progn
			(goto-char (point-min))
			(while (and (not (eobp)) (< n 0))
			  (forward-line 1)
			  (setq n (1+ n)))
			(if (eobp)
			    (setq *cmail-summary-limit nil)
			  (narrow-to-region (point-min) (point)))
			(goto-char (point-min)))
		    (goto-char (point-max))
		    (while (and (not (bobp)) (> n 0))
		      (forward-line -1)
		      (setq n (1- n)))
		    (if (bobp) (setq *cmail-summary-limit nil))))
	      (goto-char (point-min)))
	    (if (null th)
		(while (not (eobp))
		  (cmail-insert-summary 0)
		  (forward-line 1))
	      (save-excursion
		(cmail-get-folder)
		(setq *cmail-thread-data nil))
	      (cmail-th-insert-summary)
	      (if *cmail-summary-limit
		  (save-excursion
		    (cmail-get-folder)
		    (setq *cmail-thread-data nil))))))
      (quit (beep) (setq exception-type 'quit))
      (error (beep) (setq exception-type 'error)))
    (set-buffer *cmail-summary-buffer)
    (cond ((eq exception-type 'error)
	   (or quiet (cmail-message-resource1 'make-summary-2 folder))
	   (goto-char (point-max))
	   (insert-string (cmail-get-resource 'make-summary-3))
	   (insert-string (cmail-get-resource 'make-summary-4))
	   (insert-string (cmail-get-resource 'make-summary-5))
	   (insert-string (cmail-get-resource 'make-summary-6))
	   (insert-string (cmail-get-resource 'make-summary-7)))
	  ((eq exception-type 'quit)
	   (or quiet (cmail-message-resource1 'make-summary-8 folder))
	   (goto-char (point-max))
	   (insert-string (cmail-get-resource 'make-summary-9))
	   (insert-string (cmail-get-resource 'make-summary-10))
	   (insert-string (cmail-get-resource 'make-summary-11))
	   (insert-string (cmail-get-resource 'make-summary-12)))
	  (t 
	   (or quiet (cmail-message-resource1 'make-summary-13 folder))
	   (cmail-init-summary-curpos folder)))
    (cmail-summary-mode)
    (cmail-mode-line-update)
    (cmail-sync-header folder)
    (cmail-fixcp)))

(defun cmail-init-summary-curpos (folder)
  (goto-char (point-min))
  (if (re-search-forward "^[ +]*[0-9]+U " nil t)
      nil
    (let ((pos (assoc folder *cmail-folder-curpos)))
      (if pos
	  (cmail-goto-index (cdr pos))
	(goto-char (point-max))
	(forward-line -1)))))

(defun cmail-mode-line-update ()
  (setq mode-line-buffer-identification
	(format "cmail:   << %s{%d} %s>>" cmail-current-folder
		(cmail-num-of-mails)
		(if (cmail-thread-p) "thread " "")))
  (if *cmail-summary-limit
      (setq mode-name (format "Summary{limit:%d}" *cmail-summary-limit))
    (setq mode-name "Summary")))

(defun cmail-insert-summary (level)
  (save-excursion
    (setq sumr (cmail-make-summary-line level))
    (set-buffer *cmail-summary-buffer)
    (goto-char (point-max))
    (insert sumr)))

(defun cmail-make-summary-line (thread-level)
  "サマリを1行生成する."
  (beginning-of-line)
  (let (sum)
    (if (null (re-search-forward cmail-summary-regexp
				 (save-excursion (end-of-line) (point)) t))
	(let ((fmt (cmail-get-resource 'make-summary-line-1)) (num "0"))
	  (if (re-search-forward "^[0-9]+")
	      (setq num (buffer-substring (match-beginning 0) (match-end 0))))
	  (format fmt num))
      (setq *cmail-match-data (match-data))
      (setq sum (assoc cmail-current-folder cmail-summarize-format-alist))
      (if sum (setq sum (cdr sum))
	(setq sum cmail-summarize-format))
    (concat (format " %4s%s " (cmail-summary-fp-value ?p)
		    (cmail-summary-fp-value ?s))
	    (if sum
		(if (functionp sum)
		    (funcall sum)
		  (cmail-format-parser sum 'cmail-summary-fp-value))
	      (format "%s [%s] %s%s\n"
		      (cmail-summary-fp-value ?d)
		      (cmail-fill -17 (cmail-summary-fp-value ?n))
		      (cmail-summary-fp-value ?I)
		      (cmail-summary-fp-value ?j)))))))

(defun cmail-summary-fp-value (chr)
  "サマリを作成する時のformat-parserの変換規則の関数."
  (store-match-data *cmail-match-data)
  (if *cmail-match-data
      (cond 
	    ((= chr ?p) (buffer-substring (match-beginning 1) (match-end 1)))
	    ((= chr ?s) (let ((stts 
			       (buffer-substring (match-beginning 2)
						 (match-end 2))))
			  (if (string= stts "A")
			      " "
			    stts)))
	    ((= chr ?d) (buffer-substring (match-beginning 3) (match-end 3)))
	    ((= chr ?l) (let ((lines (buffer-substring
				      (match-beginning 6) (match-end 6))))
			  (if (string= "" lines) "0" lines)))
	    ((= chr ?j) (buffer-substring (match-beginning 7) (match-end 7)))
	    ((= chr ?n) (buffer-substring (match-beginning 4) (match-end 4)))
	    ((= chr ?S) (buffer-substring (match-beginning 2) (match-end 2)))
	    ((= chr ?a) (buffer-substring (match-beginning 5) (match-end 5)))
	    ((= chr ?N) (format "%3s:%s" (cmail-summary-fp-value ?l)
				         (cmail-summary-fp-value ?n)))
	    ((= chr ?A) (format "%3s:%s" (cmail-summary-fp-value ?l)
				         (cmail-summary-fp-value ?a)))
	    ((= chr ?I) (cmail-spaces (* cmail-thread-indent thread-level)))
	    ((= chr ?i) (if (> thread-level 0)
			    (cmail-spaces (window-width))
			  ""))
	    (t ""))
    ""))

(defun cmail-summary-limit (unset)
  "サマリのlimitを設定する. \\[universal-argument]が与えられた場合,
現在設定されているlimitを解除する."
  (interactive "P")
  (and (cmail-thread-p)
       (cmail-error-resource 'summary-limit-1))
  (let ((input (read-string (cmail-get-resource 'summary-limit-2)))
	(old *cmail-summary-limit))
    (if (equal input "") (setq unset t))
    (setq *cmail-summary-limit
	  (if unset
	      nil
	    (string-to-int input)))
    (if (equal old *cmail-summary-limit)
	nil
      (cmail-make-summary)))
  (if unset
      (cmail-message-resource 'summary-limit-3)))

(defun cmail-expand-summary (n)
  "サマリのlimitをN mailだけ拡大する."
  (setq *cmail-summary-limit (+ n *cmail-summary-limit))
  (goto-char (point-min))
  (let ((page (cmail-get-page-number-from-summary t)) sumr)
    (save-excursion
      (if page
	  nil
	(cmail-get-folder)
	(setq page (cmail-mail-counter)))
      (cmail-get-header)
      (goto-char (point-max))
      (re-search-backward (format "^%d " page) (point-min) t)
      (if (bobp)
	  (setq *cmail-summary-limit nil)
	(while (> n 0)
	  (forward-line -1)
	  (setq sumr (cmail-make-summary-line 0))
	  (save-excursion
	    (set-buffer *cmail-summary-buffer)
	    (goto-char (point-min))
	    (let ((buffer-read-only nil))
	      (insert sumr)))
	  (setq n (1- n))))))
  (cmail-mode-line-update)
  (goto-char (point-min)))

(defun cmail-save-curpos ()
  (if (save-excursion
	(goto-char (point-min))
	(eobp))
      nil
    (let ((pos (cmail-get-page-number-from-summary))
	  (p (assoc cmail-current-folder *cmail-folder-curpos)))
      (if (null p)
	  (setq *cmail-folder-curpos
		(cons (cons cmail-current-folder pos) *cmail-folder-curpos))
	(setcdr p pos)))))

(defun cmail-disp-summary ()
  "サマリを再表示する. カーソル位置を保存する."
  (interactive)
  (cmail-save-curpos)
  (cmail-make-summary)
  (cmail-fixcp))

(defun cmail-disp-unlimit-summary ()
  "現在設定されているサマリのlimitを解除して, サマリを再表示する. 
カーソル位置を保存する."
  (interactive)
  (setq *cmail-summary-limit nil)
  (cmail-disp-summary))

;; ---- メイル資源からのメイルのインデックスの再構成(interactive) ----------
(defun cmail-remake-folder-headings ()
  "フォルダ中のヘッダ領域リストを再構成する.
この関数は, インデックス領域が何らか(バグ!?)によって破壊された場合に,
メイル群からインデックスを再構築するものである. これを実行する場合,
対象となるフォルダは, その先頭ページに何らかのデータが必要となる. そ
のデータをインデックスとして削除し, インデックスの生成を行なう."
  (interactive)
  (let ((folder cmail-current-folder))
    (if (y-or-n-p (cmail-get-resource 'remake-folder-headings-1))
	nil
      (cmail-error-resource 'remake-folder-headings-2))
    (let ((inhibit-quit t)
	  (index (cmail-get-header folder)))
      (save-excursion
	(cmail-get-header)
	(erase-buffer)
	(cmail-get-folder)
	(cmail-message-resource 'remake-folder-headings-3)
	(setq *cmail-thread-data nil)
	(goto-char (point-min))
	(let ((beg 0)
	      (maxc 0)
	      (cnt 1))
	  (re-search-forward *cmail-re-bdr nil t)
	  (forward-line 1)
	  (beginning-of-line)
	  (setq beg (point))
	  (while (re-search-forward *cmail-re-bdr nil t)
	    (let ((end (progn (beginning-of-line) (point)))
		  (head ""))
	      (if (> 2 (count-lines beg end))
		  nil
		(setq head (cmail-get-mail-headers beg end))
		(set-buffer index)
		(insert (format "%d %s\n" cnt head))
		(cmail-get-folder folder))
	      (cmail-message-resource1 'remake-folder-headings-4 cnt)
	      (setq cnt (1+ cnt))
	      (goto-char end)
	      (forward-line 1)
	      (setq beg (point))))
	(cmail-message-resource 'remake-folder-headings-5))))
    (cmail-get-folder)
    (setq *cmail-pagelist nil)
    (cmail-make-summary folder)
    (cmail-sync-header)
    (cmail-message-resource 'remake-folder-headings-6)))

(defvar *cmail-saved-curpos-point nil)

(defun cmail-push-curpos ()
  (save-excursion
    (set-buffer *cmail-summary-buffer)
    (let (page)
      (or (eobp)
	  (setq page (cmail-get-page-number-from-summary)))
      (cmail-get-header)
      (goto-char (point-min))
      (or (eobp)
	  (null page)
	  (re-search-forward (format "^%d " page) nil t))
      (setq *cmail-saved-curpos-point (point-marker)))))

(defun cmail-pop-curpos ()
  (let ((page 0))
    (save-excursion
      (cmail-get-header)
      (goto-char *cmail-saved-curpos-point)
      (if (eobp)
	  (forward-line -1)
	(beginning-of-line))
      (and (looking-at "^[0-9]+")
	   (setq page (string-to-int (buffer-substring (match-beginning 0)
						       (match-end 0))))))
    (cmail-goto-index page)))

;; ++++ インデックスからメイル資源を編集(削除)する(interactive) ++++++++++
(defun cmail-execute-index (&optional folder)
  "インデックスからメイルを編集する.
同時に, バックアップファイルを生成する."
  (interactive (list cmail-current-folder))
  (if (null folder) (setq folder cmail-current-folder))
  (if (or (not (interactive-p))
	  (y-or-n-p (cmail-get-resource 'execute-index-1)))
      nil
    (cmail-error-resource 'execute-index-2))
  (let ((buf (get-buffer " *Confirm*")))
    (if buf
	(kill-buffer buf)))
  (let (pages (cmail-current-folder folder))
    (cmail-get-header)
    (save-restriction
      (widen)
      (goto-char (point-min))
      (cmail-message-resource1 'execute-index-3 folder)
      (store-match-data nil)
      (goto-char (point-min))
      (while (re-search-forward "^\\([0-9]+\\) D" nil t)
	(setq pages (cons (string-to-int (buffer-substring (match-beginning 1)
							   (match-end 1)))
			  pages))))
    (if (interactive-p)
	(progn
	  (set-buffer *cmail-summary-buffer)
	  (cmail-push-curpos)
	  (mapcar 'cmail-delete-mail+summary pages)
	  (if (and (boundp 'cmail-message-expunge-function)
		   (functionp cmail-message-expunge-function))
	  (funcall cmail-message-expunge-function folder))
	  (cmail-diet-folder folder)
	  (cmail-make-summary cmail-current-folder t)
	  (cmail-pop-curpos))
      (mapcar 'cmail-delete-mail pages)
      (if (and (boundp 'cmail-message-expunge-function)
	       (functionp cmail-message-expunge-function))
	  (funcall cmail-message-expunge-function folder))
      (cmail-diet-folder folder)))
  (cmail-sync-header folder)
  (cmail-message-resource1 'execute-index-4 folder))

(defun cmail-delete-mail+summary (page)
  (save-excursion
    (set-buffer *cmail-summary-buffer)
    (cmail-goto-index page)
    (let ((buffer-read-only nil))
      (beginning-of-line)
      (cmail-delete-line 1))
    (cmail-fixcp)
    (cmail-delete-mail page)))

;; ==== フォルダのガーベジコレクション -整理- (interactive) =================
(defun cmail-diet-folder (folder &optional sum)
  "FOLDERの隙間をなくす."
  (interactive (list cmail-current-folder t))
  (and sum
       (cmail-message-resource 'diet-folder-1)
       (cmail-push-curpos))		; カーソル位置の保存
  (cmail-get-folder folder)
  (setq *cmail-thread-data nil)
  (cmail-n-page 1)
  (let ((inhibit-quit t)
	(index (get-buffer (cmail-header-buffer folder)))
	beg (cnt 1) (newcnt 1) (max 1))
    (setq beg (point))
    (while (re-search-forward *cmail-re-bln nil t)
      (if (< (count-lines beg (point)) 3)
	  (progn
	    (forward-line -1)
	    (cmail-delete-line 1))
	(forward-line -2)
	(save-excursion
	  (set-buffer index)
	  (save-restriction
	    (widen)
	    (goto-char (point-min))
	    (if (re-search-forward (format "^%d " cnt) nil t)
		(progn
		  (replace-match (format "\001%s " newcnt) t t)
		  (if (> newcnt max) (setq max newcnt))
		  (and sum
		       (cmail-message-resource1 'diet-folder-2 cnt))
		  (setq newcnt (1+ newcnt))))))
	(re-search-forward *cmail-re-bln nil t))
      (setq cnt (1+ cnt))
      (setq beg (point)))
    (cmail-get-folder folder)
    (setq *cmail-pagelist nil)
;    (cmail-rebuild-index)
    (setq *cmail-deleted nil)
    (save-excursion
      (set-buffer index)
      (save-restriction
	(widen)
	(goto-char (point-min))
	(while (re-search-forward "^\001" nil t)
	  (replace-match "" t t))))
    (and sum
	 (progn
	   (cmail-make-summary cmail-current-folder t)
	   (cmail-pop-curpos)		; カーソル位置の復旧
	   (message (cmail-format-resource 'diet-folder-3 folder max
					   (cmail-get-resource (if (= newcnt 2)
								   'diet-folder-4
								 'diet-folder-5))))))))

;; ++++ インデックスのソート ++++++++++++++++++++++++++++++++++++++++++++++++
(defun cmail-sort-by-number ()
  "メイル番号順にサマリをソートする."
  (interactive)
  (save-excursion
    (cmail-get-folder)
    (setq *cmail-disp-thread nil)
    (cmail-get-header)
    (sort-numeric-fields 1 (point) (point-max)))
  (cmail-disp-summary))

(defun cmail-sort-by-subject (&optional quiet)
  "サブジェクト順にサマリをソートする."
  (interactive)
  (cmail-sort-internal "\\7" quiet))

(defun cmail-sort-by-subject-relative (&optional quiet)
  "サブジェクト順にサマリをソートする."
  (interactive)
  (cmail-sort-internal "\\9" quiet))

(defun cmail-sort-by-date (&optional quiet)
  "日付順にサマリをソートする."
  (interactive)
  (cmail-sort-by-time quiet))

(defun cmail-sort-by-author (&optional quiet)
  "送り主の名前順にサマリをソートする."
  (interactive)
  (cmail-sort-internal "\\5" quiet))

(defun cmail-sort-internal (field &optional quiet)
  (save-excursion
    (or quiet (progn (cmail-get-folder) (setq *cmail-disp-thread nil)))
    (cmail-get-header)
    (goto-char (point-min))
    (sort-regexp-fields nil cmail-summary-regexp field
			(point) (point-max)))
  (or quiet (cmail-disp-summary))
  (cmail-sync-header))

(defun cmail-sort-index ()
  "FOLDERのインデックスを各フィールド値を参照して並べ換える(Egg版NEmacs専用)."
  (interactive)
  (save-excursion
    (cmail-get-folder)
    (setq *cmail-disp-thread nil)
    (let ((field (menu:select-from-menu (list 'menu
					      (cmail-get-resource 'sort-index-1)
					      cmail-sort-key-alist))))
      (cmail-get-header)
      (sort-regexp-fields nil cmail-summary-regexp field
			  (point) (point-max))))
  (cmail-disp-summary)
  (cmail-sync-header))

(defun cmail-sort-by-time (&optional quiet)
  "メイル本体からDateフィールドを取りだし, 時間も含めてソートする.
timezone.elが必要."
  (interactive)
  (require 'timezone)
  (require 'sort)
  (save-excursion
    (let ((date-sortable t) numeric-sortable)
      (or quiet (progn (cmail-get-folder) (setq *cmail-disp-thread nil)))
      (cmail-get-header)
      (goto-char (point-min))
      (sort-subr nil 'forward-line 'end-of-line 'cmail-sort-fetch-field)))
  (or quiet (cmail-disp-summary))
  (cmail-sync-header))

(defun cmail-sort-header (&optional folder)
  "cmail-sort-header-alistの指定に従ってサマリをソートする.
指定にマッチしないフォルダはcmail-sort-header-defaultに従う.
folderの指定がない場合には, cmail-current-folderをソートする."
  (if (null folder) (setq folder cmail-current-folder))
  (save-excursion
    (let (result al
	  (alst cmail-sort-header-alist)
	  (cmail-current-folder folder))
      (cmail-get-folder folder)
      (if (null alst)
	  (cmail-sort-header-internal cmail-sort-header-default)
	(while alst
	  (setq al (car alst))
	  (if (null (setq result (cmail-sort-header-check-member folder al)))
	      (if (null (setq alst (cdr alst)))
		  (cmail-sort-header-internal cmail-sort-header-default))
	    (cmail-sort-header-internal (car al) result)
	    (setq alst nil)))))))

(defun cmail-sort-header-check-member (folder al)
  "cmail-sort-headerの補助関数. cmail-sort-header-alistの現在のリスト中に
処理中のフォルダの指定があるかどうかを調べる. 指定が見つかった場合には,
non-nilまたはリスト中に指定されたヘッダフィールド名もしくは関数名を返す."
  (let (hf)
    (if (string-match "^[AaDdRrSsTt]$" (car al))
	(member folder (car (cdr al)))
      (if (null (string-match "^[FfHhNn]$" (car al)))
	  nil
	(setq al (cdr al))
	(while al
	  (if (null (member folder (car (cdr (car al)))))
	      (setq al (cdr al))
	    (setq hf (car (car al)))
	    (setq al nil)))
	hf))))

(defun cmail-sort-header-internal (key &optional result)
  "cmail-sort-headerの補助関数. keyの指定に従ってcmail-current-folderの
サマリをソートする. 指定されたkeyがない場合, cmail-sync-headerを実行する."
  (if (null key)
      (cmail-sync-header)
    (save-excursion
      (cond ((string-match "^[Rr]$" key)
	     (cmail-sort-by-subject-relative t))
	    ((string-match "^[Ss]$" key)
	     (cmail-sort-by-subject t))
	    ((string-match "^[Aa]$" key)
	     (cmail-sort-by-author t))
	    ((string-match "^[Dd]$" key)
	     (cmail-sort-by-date t))
	    ((string-match "^[Tt]$" key)
	     (cmail-sort-by-time t))
	    ((string-match "^[Nn]$" key)
	     (cmail-sort-by-specified-header result t))
	    ((string-match "^[FfHh]$" key)
	     (cmail-sort-by-specified-header result))))
    (if (cmail-thread-p)
	(progn
	  (setq *cmail-thread-data nil)
	  (if (and cmail-thread-ignore-limit
		   cmail-thread-prepare-data-on-archive)
	      (progn
		(cmail-get-header)
		(cmail-build-thread)))))))

(defun cmail-sort-by-specified-header (header-field &optional numeric-sortable)
  "cmail-sort-header-internalの補助関数. alist中に指定されたヘッダフィールドの
値を取得するcmail-sort-fetch-fieldをソート用のキー取得関数として呼び出し, サ
マリをソートする. または, alist中に指定された関数をソート用のキー取得関数と
して呼び出し, サマリをソートする."
  (let (date-sortable)
    (require 'sort)
    (save-excursion
      (cmail-get-header)
      (goto-char (point-min))
      (if (functionp header-field)
	  (sort-subr nil 'forward-line 'end-of-line header-field)
        (sort-subr nil 'forward-line 'end-of-line 'cmail-sort-fetch-field))))
  (cmail-sync-header))

(defun cmail-sort-fetch-field ()
  "cmail-sort-by-time, cmail-sort-by-specified-headerの補助関数.
date-sortable, numeric-sortableの指定に従って, ソート可能な日付,
数値, あるいはフィールドの値をそのまま返す."
  (save-excursion
    (beginning-of-line)
    (re-search-forward "^\\([0-9]+\\) " nil t)
    (let (page value)
      (setq page (string-to-int (buffer-substring (match-beginning 1)
						  (match-end 1))))
      (cmail-get-folder)
      (cmail-n-page page)
      (cond (date-sortable
	     (re-search-forward "^Date:\\s *\\(.*\\)$" (cmail-head-max) nil)
	     (setq value (buffer-substring (match-beginning 1)
					   (match-end 1)))
	     (timezone-make-date-sortable value))
	    (numeric-sortable
	     (re-search-forward (format "^%s:\\s *[^0-9]*\\([0-9]+\\).*$"
					header-field)
				(cmail-head-max) nil)
	     (setq value (buffer-substring (match-beginning 1)
					   (match-end 1)))
	     (string-to-int value))
	    (t
	     (re-search-forward (format "^%s:\\s *\\(.*\\)$" header-field)
				(cmail-head-max) nil)
	     (setq value (buffer-substring (match-beginning 1)
					   (match-end 1))))))))

(defun cmail-sort-by-bytes ()
  "メイルのバイト数順にサマリをソートする."
  (interactive)
  (require 'sort)
  (save-excursion
    (cmail-get-folder)
    (setq *cmail-disp-thread nil)
    (cmail-get-header)
    (goto-char (point-min))
    (sort-subr nil 'forward-line 'end-of-line 'cmail-sort-get-bytes))
  (cmail-disp-summary)
  (cmail-sync-header))

(defun cmail-sort-get-bytes ()
  "cmail-sort-by-bytesの補助関数. メイルのバイト数を返す."
  (save-excursion
    (beginning-of-line)
    (re-search-forward "^\\([0-9]+\\) " nil t)
    (let (page)
      (setq page (string-to-int (buffer-substring (match-beginning 1)
						  (match-end 1))))
      (cmail-get-folder)
      (- (cmail-n-page (1+ page)) (cmail-n-page page) 2))))

;; ++++ インデックスの編集(interactive) +++++++++++++++++++++++++++++++++++++
(defun cmail-move-index ()
  "インデックスのマーク\"^\"されたmailをカーソル位置に移動する."
  (interactive)
  (and (cmail-thread-p)
       (cmail-error-resource 'move-index-1))
  (cmail-message-resource 'move-index-2)
  (let ((fld (cmail-header-buffer cmail-current-folder))
	(target (cmail-get-page-number-from-summary))
	(moving-from 0)
	(cnt 0)
	(prev (point))
	(index ""))
    (goto-char (point-min))
    (while (re-search-forward "^[ +]*[0-9]+\\^ " nil t)
      (setq moving-from (cmail-get-page-number-from-summary))
      (if (eq target moving-from)
	  nil
	(set-buffer fld)
	(goto-char (point-min))
	(if (not (re-search-forward (format "^%d " moving-from)
				    nil t))
	    nil
	  (beginning-of-line)
	  (setq index
		(concat (buffer-substring
			 (point)
			 (save-excursion (end-of-line) (point)))
			"\n"))
	  (cmail-delete-line 1)
	  (setq prev (point))
	  (goto-char (point-min))
	  (if (not (eq target 0))
	      (if (not (re-search-forward (format "^%d " target) nil t))
		  (progn
		    (goto-char prev)
		    (insert-string index))
		(beginning-of-line)
		(insert-string index)
		(setq cnt (1+ cnt)))
	    (re-search-forward *cmail-re-bdr nil t)
	    (beginning-of-line)
	    (insert-string index)
	    (setq cnt (1+ cnt))))
	(set-buffer *cmail-summary-buffer))
      (forward-line 1))
    (if (eq cnt 0)
	(progn
	  (cmail-message-resource 'move-index-3)
	  (goto-char prev))
      (message (cmail-format-resource 'move-index-4
				      cnt (cmail-get-resource (if (= cnt 1)
								  'move-index-5
								'move-index-6))))
      (cmail-make-summary))
    (cmail-goto-index moving-from))
  (cmail-sync-header))

(defun cmail-goto-index (nth)
  "カーソルをサマリのnth番のメイルの位置に移動する."
  (interactive "Ngoto mail: ")
  (if (consp nth)
      (setq nth (prefix-numeric-value nth)))
  (let ((idx nth) found)
    (while (> idx 0)
      (goto-char (point-min))
      (if (re-search-forward (format "^+? *%d[^0-9]" idx) nil t)
	  (progn
	    (and (= nth idx) (setq found t))
	    (setq idx 0))
	(setq idx (1- idx))))
    (cmail-fixcp)
    (recenter (/ (window-height) 2))
    found))

;; ---- マーク設定(interactive) -----------------------------------------
(defun cmail-mark-mail (arg)
  "mailにマークをつける. Argはマークする数."
  (interactive "p")
  (cmail-fixcp)
  (let ((buffer-read-only nil))
    (cond
     ((and (interactive-p) (= arg 1))
      (and 
       (eq (char-after (1- (point))) ?^)
       (cmail-go-down 1))
      (forward-char -1)
      (delete-char 1)
      (insert-string "^"))
     (t
      (while (> arg 0)
	(forward-char -1)
	(delete-char 1)
	(insert-string "^")
	(setq arg (1- arg))
	(and (> arg 0) (cmail-go-down 1)))
      )))
  (run-hooks 'cmail-marked-hook)
  (cmail-fixcp))

(defun cmail-mark-all ()
  "全てのmailにマークをつける."
  (interactive)
  (let ((pos (cmail-get-page-number-from-summary))
	(cnt (count-lines (point-min) (point-max))))
    (goto-char (point-min))
    (cmail-mark-mail cnt)
    (cmail-sync-header)
    (cmail-goto-index pos)))

(defun cmail-mark-delete (arg)
  "mailに消印を押す. Argはマークする数."
  (interactive "p")
  (save-excursion
    (cmail-get-folder cmail-current-folder)
    (setq *cmail-deleted t))
  (cmail-fixcp)
  (cmail-exec
   '(lambda (page)
      (let (status-mark)
	(save-excursion
	  (cmail-get-folder)
	  (cmail-n-page page)
	  (setq status-mark
		(cmail-set-mail-status '("Deleted") '("Hold"))))
	(apply 'cmail-put-mark
	       (cmail-get-page-number-from-summary) status-mark))) arg)
  (run-hooks 'cmail-marked-hook)
  (cmail-fixcp)
  (and cmail-mark-delete-show-next
       (eq (char-after (1- (point))) ?U)
       (cmail-show-contents (cmail-get-page-number-from-summary))))

(defun cmail-expire-mark (folder &optional delete)
  "カレントフォルダのメイルのうち古いもの(デフォルトは7日)に
削除マークを付ける．"
  (interactive (list cmail-current-folder current-prefix-arg))
  (cmail-message-resource1 'expire-mark-1 folder)
  (let ((cmail-current-folder folder)
	(n 1) max today date expdays last)
    (setq today (current-time-string))
    (cmail-get-folder)
    (and delete (setq *cmail-deleted t))
    (setq max (cmail-mail-counter))
    (setq expdays (cmail-expiry-days folder))
    (while (> max n)
      (cmail-n-page n)
      (if (re-search-forward "^X-cmail-status: U" (cmail-head-max) t)
	  nil
	(cmail-n-page n)
	(setq date (cmail-get-field-values "Date"))
	(and date 
	     (> (cmail-days-between today date) expdays)
	     (if delete
		 (save-excursion
		   (cmail-get-header)
		   (goto-char (point-min))
		   (re-search-forward (format "^%d " n) nil t)
		   (if (looking-at "H")
		       nil
		     (setq last n)
		     (delete-char 1)
		     (insert "D")))
	       (save-excursion
		 (set-buffer *cmail-summary-buffer)
		 (cmail-goto-index n)
		 (cmail-mark-mail 1)))))
      (setq n (1+ n)))
    (set-buffer *cmail-summary-buffer)
    (cmail-message-resource1 'expire-mark-2 folder)
    (if (and delete (interactive-p))
	(progn
	  (cmail-disp-summary)
	  (and last (cmail-goto-index last))
	  (cmail-fixcp)))))

(defun cmail-mark-hold (arg)
  "mailをHoldにする. Argはマークする数."
  (interactive "p")
  (save-excursion
    (cmail-get-folder cmail-current-folder)
    (setq *cmail-deleted t))
  (cmail-fixcp)
  (cmail-exec
   '(lambda (page)
      (let (status-mark)
	(save-excursion
	  (cmail-get-folder)
	  (cmail-n-page page)
	  (setq status-mark
		(cmail-set-mail-status '("Hold") '("Deleted"))))
	(apply 'cmail-put-mark
	       (cmail-get-page-number-from-summary) status-mark))) arg)
  (run-hooks 'cmail-marked-hook)
  (cmail-fixcp))

(defun cmail-bookmark ()
  "メッセージのブックマークをトグルする. "
  (interactive)
  (cmail-fixcp)
  (let (status-mark (page (cmail-get-page-number-from-summary)))
    (save-excursion
      (cmail-get-folder)
      (cmail-n-page page)
      (if (cmail-mail-status-p "Bookmarked")
	  (setq status-mark
		(cmail-set-mail-status '("Active") '("Bookmarked")))
	(setq status-mark
	      (cmail-set-mail-status '("Bookmarked"))))
      (apply 'cmail-put-mark page status-mark)))
  (run-hooks 'cmail-marked-hook)
  (cmail-fixcp))

(defun cmail-mark-unread (arg)
  "mailを未読に戻す. Argは戻す数."
  (interactive "p")
  (setq *cmail-current-folder "")
  (cmail-exec
   '(lambda (page)
      (let (status-mark)
	(save-excursion
	  (cmail-get-folder)
	  (cmail-n-page page)
	  (cond
	   ;; if repeat argument is given, add Unread flag.
	   ((and (integerp arg) (not (eq arg 1)))
	    (setq status-mark
		  (cmail-set-mail-status '("Unread"))))
	   ;; if otherwise, delete standard marks in order.
	   ((cmail-mail-status-p "Deleted")
	    (setq status-mark
		  (cmail-set-mail-status '("Active") '("Deleted"))))
	   ((cmail-mail-status-p "Hold")
	    (setq status-mark
		  (cmail-set-mail-status '("Active") '("Hold"))))
	   ((cmail-mail-status-p "Edited")
	    (setq status-mark
		  (cmail-set-mail-status '("Active") '("Edited"))))
	   ((cmail-mail-status-p "Bookmarked")
	    (setq status-mark
		  (cmail-set-mail-status '("Active") '("Bookmarked"))))
	   ((cmail-mail-status-p "Forwarded")
	    (setq status-mark
		  (cmail-set-mail-status '("Active") '("Forwarded"))))
	   ((cmail-mail-status-p "Replied")
	    (setq status-mark
		  (cmail-set-mail-status '("Active") '("Replied"))))
	   (t
	    (setq status-mark
		  (cmail-set-mail-status '("Unread") '("Active"))))))
	(apply 'cmail-put-mark
	       (cmail-get-page-number-from-summary) status-mark))) arg)
  (run-hooks 'cmail-marked-hook)
  (cmail-fixcp))

(defun cmail-mark-active (arg)
  "mailを既読に戻す. Argは戻す数."
  (interactive "p")
  (setq *cmail-current-folder "")
  (cmail-exec
   '(lambda (page)
      (let (status-mark)
	(save-excursion
	  (cmail-get-folder)
	  (cmail-n-page page)
	  (setq status-mark (cmail-set-mail-status '("Active") '("Unread"))))
	(apply 'cmail-put-mark page status-mark))) arg)
  (run-hooks 'cmail-marked-hook)
  (cmail-fixcp))

(defun cmail-unmark (arg)
  "mailのマークを外す. Argはアクティブにする数."
  (interactive "p")
  (while (> arg 0)
    (cmail-fixcp)
    (let ((page (cmail-get-page-number-from-summary)) status-mark)
      (save-excursion
	(cmail-get-folder)
	(cmail-n-page page)
	(setq status-mark
	      (cmail-set-mail-status '("Active") '("Deleted" "Hold"))))
      (cmail-fixcp)
      (apply 'cmail-put-mark page status-mark))
    (cmail-go-down 1)
    (setq arg (1- arg)))
  (run-hooks 'cmail-marked-hook)
  (cmail-fixcp))

(defun cmail-catch-up-all (all)
  "サマリ内の全ての未読mailを既読にする.
\\[universal-argument]が与えられると未読だけでなく全てのメイルを既読にする."
  (interactive "P")
  (if (y-or-n-p (cmail-get-resource (if all 'catch-up-all-1 'catch-up-all-2)))
      (progn
	(cmail-message-resource 'catch-up-all-3)
	(goto-char (point-min))
	(while (not (eobp))
	  (if (or all
		  (progn
		    (cmail-fixcp)
		    (= (char-after (1- (point))) ?U)))
	      (let ((page (cmail-get-page-number-from-summary))
		    status-mark)
		(save-excursion
		  (cmail-get-folder)
		  (cmail-n-page page)
		  (setq status-mark
			(cmail-set-mail-status '("Active") '("Unread"))))
		(apply 'cmail-put-mark page status-mark)))
	  (forward-line 1))
	(cmail-message-resource 'catch-up-all-4))
    (message ""))			;erase "(y or n)" line.
  (cmail-sync-header)
  (if (and cmail-use-folders-mode-first cmail-archive-on-get)
      (cmail-folders)
    (cmail-fixcp)))

(defun cmail-put-mark (page mark1 mark2 &optional folder)
  "PAGE番目のmailのサマリにマークMARK1を, インデックスにMARK2をつける."
  (save-excursion
    (set-buffer *cmail-summary-buffer)
    (if (or (null folder) (string= cmail-current-folder folder))
	(progn
	  (cmail-fixcp)
	  (forward-char -1)
	  (let ((buffer-read-only nil))
	    (looking-at ".")
	    (if (not (string= mark1 (match-string 0)))
		(replace-match mark1 t t)))))
    (if (null mark2)
	nil
      (cmail-get-header folder)
      (goto-char (point-min))
      (re-search-forward (format "^%d " page) nil t)
      (looking-at ".")
      (if (not (string= mark2 (match-string 0)))
	  (replace-match mark2 t t)))))

(defun cmail-mark-confirm (mark)
  (let (any (win (current-window-configuration)))
  (with-output-to-temp-buffer " *Confirm*"
    (buffer-flush-undo standard-output)
    (save-excursion
      (set-buffer standard-output)
      (erase-buffer)
      (setq truncate-lines t)
      (set-buffer *cmail-summary-buffer)
      (goto-char (point-min))
      (while (re-search-forward (format "^+? *[0-9]+%c.*$" mark) nil t)
	(set-buffer standard-output)
	(cmail-insert-buffer-substring *cmail-summary-buffer
				 (match-beginning 0)
				 (match-end 0))
	(insert "\n")
	(setq any t)
	(set-buffer *cmail-summary-buffer)))
    (set-buffer-modified-p nil))
  (if any
      (message
       (substitute-command-keys
	(cmail-get-resource
	 (if (one-window-p t)
	     (if pop-up-windows 'mark-confirm-1
	       'mark-confirm-2)
	   'mark-confirm-3))))
    (set-window-configuration win)
    (cmail-message-resource1 'mark-confirm-4 mark))))

(defun cmail-confirm-mark ()
  (interactive)
  (cmail-mark-confirm ?^))

(defun cmail-confirm-execute ()
  (interactive)
  (cmail-mark-confirm ?D))

(defun cmail-expand-summary-window ()
  "メイルウィンドウを消去する"
  (interactive)
  (cmail-go-summary)
  (if cmail-use-full-window
      (progn
	(delete-other-windows)
	(if cmail-always-display-folders
	    (cmail-folders-split-window)))
    (let ((win (get-buffer-window *cmail-mail-buffer)))
      (and win (delete-window win))))
  (switch-to-buffer *cmail-summary-buffer)
  (recenter))

