(require 'mime-view)

(defun morq ()
  (interactive)
  (if (get-buffer morq-list-buffer)
      (morq-list-again)
    (morq-list-inbox)))

(defun mq () (interactive)
  (morq-list-inbox))

(defconst morq-complete-header-regexp "^\\(To\\|From\\|Cc\\|Bcc\\|Reply-To\\|Return-Receipt-To\\):")
(defvar morq-raw-buffer " *morq mail*")
(defvar morq-temp-buffer "*morq tmp*")
(defvar morq-list-buffer "*morq-list*")
(defvar morq-mail-buffer "*morq-mail*")
(defvar morq-command "morq")

(defconst morq-parse-list-regex "^\\([0-9]+\\) \\([0-9]+\\) \\([0-9]+\\) \\([0-9]+\\) \\([0-9]+-[0-9]+-[0-9]+\\) \\([0-9]+:[0-9]+\\):[0-9]+ \\([0-9]+\\) \\([^\t]*\\)\t\\(.*\\)$")
(defconst morq-unread-pattern "^[-0-9]+ [:0-9]+ U ")
(defconst morq-checked-pattern "^[-0-9]+ [:0-9]+ ^ ")

(defvar morq-args-history nil)
(defvar morq-last-args nil)

(defvar morq-font-lock-keywords
  (eval-when-compile
    (let* ((cite-chars "[>|}]")
	   (cite-prefix "A-Za-z")
	   (cite-suffix (concat cite-prefix "0-9_.@-`'\"")))
      (list '("^\\(From\\|Sender\\):" . font-lock-function-name-face)
	    '("^Reply-To:.*$" . font-lock-function-name-face)
	    '("^Subject:" . font-lock-comment-face)
	    '("^\\(To\\|Apparently-To\\|Cc\\|Newsgroups\\):"
	      . font-lock-keyword-face)
	    ;; Use MATCH-ANCHORED to effectively anchor the regexp left side.
	    `(,cite-chars
	      (,(concat "\\=[ \t]*"
			"\\(\\([" cite-prefix "]+[" cite-suffix "]*\\)?"
			"\\(" cite-chars "[ \t]*\\)\\)+"
			"\\(.*\\)")
	       (beginning-of-line) (end-of-line)
	       (2 font-lock-constant-face nil t)
	       (4 font-lock-comment-face nil t)))
	    '("^\\(X-[A-Za-z0-9-]+\\|In-reply-to\\|Date\\):.*$"
	      . font-lock-string-face))))
  "Additional expressions to highlight in Morq Mail buffer.")

(setenv "LD_LIBRARY_PATH" "/usr/lib:/usr/local/lib")

(defun morq-match-nth (n)
  (buffer-substring (match-beginning n) (match-end n)))

(defun morq-flags (n)
  (cond
   ((= n 0) "U")
   ((= n 1) " ")
   ((= n 2) "U")
   ((= n 3) "P")
   ((= n 4) "U")
   ((= n 5) "R")
   ((= n 6) "U")
   ((= n 7) "P")))

(defun morq-list-indent (n)
  (make-string (* 2 n) ?\x20))

(defun morq-trancate-address (n addr)
  (let ((len (length addr)))
    (if (< n len)
	(substring addr 0 n)
      (concat addr (make-string (- n len) ?\x20)))))

(defun morq-list-adjust ()
  (if (eobp) (forward-line -1))
  (beginning-of-line)
  (looking-at "[-0-9]+ [:0-9]+ ")
  (goto-char (match-end 0)))

(defun morq-list-again ()
  (interactive)
  (set-buffer (get-buffer-create morq-list-buffer))
  (let ((mid (morq-list-fetch-mid)) dmid umid n m diff (lim 2000) target (cont t))
    (save-excursion
      (and (re-search-forward morq-unread-pattern nil t)
	   (setq dmid (morq-list-fetch-mid))))
    (save-excursion
      (and (re-search-backward morq-unread-pattern nil t)
	   (setq umid (morq-list-fetch-mid))))
    (apply 'morq-list morq-last-args)
    (setq n (1- (count-lines (point-min) (point-max))))
    (while (and (< 0 n) cont)
      (setq m (car (gethash n morq-list-data)))
      (cond
       ((eq m mid)
	(setq cont nil)
	(setq target n))
       ((or (eq m dmid) (and (null target ) (eq m umid)))
	(setq target n)))
      (setq n (1- n)))
    (if target
	(goto-line (1+ target))
      (goto-char (point-min))
      (re-search-forward morq-unread-pattern nil t))
    (morq-list-adjust)))

(defun morq-list-back ()
  (interactive)
  (setq morq-last-args (car morq-args-history))
  (setq morq-args-history (cdr morq-args-history))
  (morq-list-again))

(defvar morq-list-mode-map nil)
(if morq-list-mode-map
    nil
  (setq morq-list-mode-map (make-keymap))
  (suppress-keymap morq-list-mode-map)
  (define-key morq-list-mode-map "\C-m" 'morq-list-show-mail)
  (define-key morq-list-mode-map "." 'morq-list-show-mail)
  (define-key morq-list-mode-map " " 'morq-list-read-mail)
  (define-key morq-list-mode-map "s" 'morq-list-isearch-article)
  (define-key morq-list-mode-map "b" 'morq-list-scroll-down)
  (define-key morq-list-mode-map "p" 'morq-list-prev-mail)
  (define-key morq-list-mode-map "j" 'morq-list-forward-line)
  (define-key morq-list-mode-map "k" 'morq-list-backward-line)
  (define-key morq-list-mode-map "P" 'morq-list-prev-unread-mail)
  (define-key morq-list-mode-map "n" 'morq-list-next-mail)
  (define-key morq-list-mode-map "N" 'morq-list-next-unread-mail)
  (define-key morq-list-mode-map "a" 'morq-list-archive-read)
  (define-key morq-list-mode-map "h" 'delete-other-windows)
  (define-key morq-list-mode-map "q" 'morq-list-query)
  (define-key morq-list-mode-map "v" 'morq-list-label)
  (define-key morq-list-mode-map "i" 'morq-list-inbox)
  (define-key morq-list-mode-map "t" 'morq-list-thread)
  (define-key morq-list-mode-map "g" 'morq-list-again)
  (define-key morq-list-mode-map "B" 'morq-list-back)
  (define-key morq-list-mode-map "u" 'morq-list-uncheck)
  (define-key morq-list-mode-map "U" 'morq-list-unread)
  (define-key morq-list-mode-map "I" 'morq-list-move-to-inbox)
  (define-key morq-list-mode-map "T" 'morq-list-trash)
  (define-key morq-list-mode-map "l" 'morq-list-add-label)
  (define-key morq-list-mode-map "L" 'morq-list-remove-label)
  (define-key morq-list-mode-map "d" 'morq-list-todo)
  (define-key morq-list-mode-map "D" 'morq-list-done)
  (define-key morq-list-mode-map "S" 'morq-list-spam)
  (define-key morq-list-mode-map "^" 'morq-list-check)
  (define-key morq-list-mode-map "m" 'morq-list-check)
  (define-key morq-list-mode-map "\M-^" 'morq-list-check-all)
  (define-key morq-list-mode-map "x" 'morq-list-execute)
  (define-key morq-list-mode-map "r" 'morq-list-reply)
  (define-key morq-list-mode-map "f" 'morq-list-followup)
  (define-key morq-list-mode-map "R" 'morq-list-reply)
  (define-key morq-list-mode-map "F" 'morq-list-followup)
  (define-key morq-list-mode-map "|" 'morq-list-pipe)
  (define-key morq-list-mode-map "c" 'compose-mail)
  (define-key morq-list-mode-map "\C-cS" 'morq-clear-spam)
  (define-key morq-list-mode-map "\C-cT" 'morq-clear-trash)
  (define-key morq-list-mode-map "\C-cm" 'morq-list-ml-id)
  (define-key morq-list-mode-map "\C-ck" 'morq-list-keywords)
  (define-key morq-list-mode-map "\C-cv" 'morq-list-mc-verify)
  (define-key morq-list-mode-map "\C-cd" 'morq-list-mc-decrypt)
  (if mouse-button-2
      (define-key morq-list-mode-map 
	mouse-button-2 'morq-list-button-dispatcher))
  )

(defun morq-list-mode ()
  (interactive)
  (save-excursion
    (kill-all-local-variables)
    (use-local-map morq-list-mode-map)
    (setq mode-name "Morq List")
    (setq major-mode 'morq-list-mode)
    (make-variable-buffer-local 'morq-list-data)
    (make-variable-buffer-local 'morq-last-mid)
    (setq truncate-lines t)
    (buffer-disable-undo (current-buffer))
    (setq buffer-read-only t)
    (if (functionp 'hscroll-mode) (hscroll-mode))
    (run-hooks 'morq-list-mode-hook)))

(defun morq-list (&rest args)
  (set-buffer (get-buffer-create morq-temp-buffer))
  (apply 'morq-exec-cmd args)
  (goto-char (point-min))
  (let ((buf (get-buffer-create morq-list-buffer))
	(hash (make-hash-table))
	(idx 0)
	(lines (count-lines (point-min) (point-max))))
    (set-buffer buf)
    (morq-list-mode)
    (unless (equal args morq-last-args)
      (setq morq-args-history (cons morq-last-args morq-args-history))
      (setq morq-last-args args))
    (setq morq-list-data hash)
    (setq buffer-read-only nil)
    (erase-buffer)
    (set-buffer morq-temp-buffer)
    (while (re-search-forward morq-parse-list-regex nil t)
      (let ((mid (string-to-int (morq-match-nth 1)))
	    (flg (string-to-int (morq-match-nth 2)))
	    (pid (string-to-int (morq-match-nth 3)))
	    (tid (string-to-int (morq-match-nth 4)))
	    (date (morq-match-nth 5))
	    (time (morq-match-nth 6))
	    (indent (morq-list-indent (string-to-int (morq-match-nth 7))))
	    (from (morq-trancate-address 15 (morq-match-nth 8)))
	    (subj (morq-match-nth 9)))
	(save-excursion
	  (set-buffer buf)
	  (insert (format "%s %s %s [%s] %s%s\n" date time (morq-flags flg) from indent subj))
	  (let (beg)
	    (beginning-of-line)
	    (setq beg (point))
	    (end-of-line)
	    (put-text-property beg (point) 'mouse-face 'highlight))
	  (puthash idx (list mid flg pid tid) hash)
	  (setq idx (1+ idx)))))
    (set-buffer buf)
    (setq buffer-read-only t)
    (setq mode-line-buffer-identification
	  (format "morq: %s %d" (cdr args) lines)))
  (switch-to-buffer morq-list-buffer)
  (delete-other-windows)
  (goto-char (point-min))
  (or (re-search-forward "[-0-9]+ [:0-9]+ \\(U\\)" nil t)
      (re-search-forward "[-0-9]+ [:0-9]+ \\([ PR]\\)" nil t))
  (morq-list-adjust))

(defun morq-labels-table (&optional mid)
  (save-excursion
    (let (list beg end)
      (set-buffer (get-buffer-create morq-temp-buffer))
      (if (null mid)
	  (morq-exec-cmd "list_label")
	(morq-exec-cmd "list_label" (int-to-string mid)))
      (goto-char (point-min))
      (setq beg (point))
      (while (re-search-forward ", " nil t)
	(setq end (match-beginning 0))
	(setq list (cons (list (buffer-substring beg end)) list))
	(setq beg (match-end 0)))
      (goto-char (point-max))
      (skip-chars-backward "\n\r ")
      (setq list (cons (list (buffer-substring beg (point))) list)))))

(defun morq-list-label (label)
  (interactive (list (completing-read "visit label: " (morq-labels-table) nil t)))
  (let ((mid (morq-list-fetch-mid)))
    (morq-list "show_label" label)
    (and mid (morq-goto-mid mid))))

(defun morq-list-inbox ()
  (interactive)
  (let ((buf (get-buffer morq-list-buffer)))
    (if (and buf (eq buf (current-buffer))
	     morq-last-args
	     (equal (car morq-last-args) "show_label")
	     (equal (cadr morq-last-args) "inbox"))
	(morq-list-again)
      (morq-list-label "inbox"))))

(defun morq-list-query (query)
  (interactive "squery: ")
  (morq-list "show_query" query))

(defun morq-goto-mid (mid)
  (let (n (cont t) target)
    (setq n (1- (count-lines (point-min) (point-max))))
    (while (and (< 0 n) cont)
      (let (m (car (gethash n morq-list-data)))
	(if (eq m mid)
	    (setq cont nil)
	  (setq target n)))
      (setq n (1- n)))
    (if cont
	nil
      (goto-line target)
      (morq-list-adjust))))

(defun morq-list-thread ()
  (interactive)
  (let ((data (morq-list-fetch-data)))
    (morq-list "show_thread" (int-to-string (nth 3 data)))
    (morq-goto-mid (car data))))

(defun morq-list-similarity (mid)
  (interactive (list (morq-list-fetch-mid)))
  (morq-list "show_similarity" (int-to-string mid)))

(defun morq-list-fetch-data ()
  (let ((buf (get-buffer morq-list-buffer)))
    (if (not (and (eq (current-buffer) buf)
		  (boundp 'morq-list-data)))
	nil
      (beginning-of-line)
      (and (eobp) (forward-line -1))
      (let ((n (count-lines (point-min) (point))))
	(gethash n morq-list-data)))))

(defun morq-list-fetch-mid ()
  (let ((data (morq-list-fetch-data)))
    (and data (car data))))

(defun morq-list-mail-window ()
  (switch-to-buffer morq-list-buffer)
  (let ((lw (get-buffer-window morq-list-buffer))
	(mw (get-buffer-window morq-mail-buffer))
	lh mh fh)
    (setq lh (if lw (window-height lw) 0))
    (setq mh (if mw (window-height mw) 0))
    (setq fh (frame-height))
    (if lw
	(select-window lw)
      (switch-to-buffer morq-list-buffer))
    (if (not (= (+ lh mh) fh))
	(progn
	  (delete-other-windows)
	  (split-window lw (/ fh 5))))
    (pop-to-buffer morq-mail-buffer)
    (pop-to-buffer morq-list-buffer)
    (recenter (/ (* (window-height) 2) 3))
    (morq-list-adjust)))

(defun morq-list-mark (a b)
  (beginning-of-line)
  (let ((buffer-read-only nil))
    (and (looking-at (format "[-0-9]+ [:0-9]+ \\(%s\\)" a))
	 (replace-match b nil t nil 1))))

(defun morq-list-mark-update ()
  (let* ((data (morq-list-fetch-data)))
    (morq-list-mark "." (morq-flags (nth 1 data)))))

(defun morq-list-mark-check ()
  (morq-list-mark "." "^"))

(defun morq-list-show-mail (data)
  (interactive (list (morq-list-fetch-data)))
  (delete-other-windows)
  (morq-list-read-mail data))

(defun morq-mail-apply (func &rest args)
  (interactive)
  (let* ((data (morq-list-fetch-data))
	 (mid (car data))
	 (w (selected-window)))
    (if (and (eq morq-last-mid mid) (get-buffer-window morq-mail-buffer))
	(morq-list-mail-window)
      (morq-list-show-mail data))
    (unwind-protect
	(progn
	  (select-window (get-buffer-window morq-mail-buffer))
	  (apply func args))
      (select-window w))))
  
(defun morq-list-scroll-down ()
  (interactive)
  (morq-mail-apply 'scroll-down))

(defun morq-list-forward-line (n)
  (interactive "p")
  (morq-mail-apply 'scroll-up n))

(defun morq-list-backward-line (n)
  (interactive "p")
  (morq-mail-apply 'scroll-up (- n)))

(defun morq-list-read-mail (data)
  (interactive (list (morq-list-fetch-data)))
  (let (scroll pos w)
    (if (and (eq morq-last-mid (car data))
	     (setq w (get-buffer-window morq-mail-buffer)))
	(if (save-window-excursion
	      (and (select-window w)
		   (not (pos-visible-in-window-p (point-max)))))
	    (progn
	      (pop-to-buffer morq-mail-buffer)
	      (scroll-up)
	      (setq scroll t))
	  (set-buffer morq-list-buffer)
	  (forward-line 1)
	  (setq pos (point))
	  (setq data (morq-list-fetch-data))))
    (if scroll
	nil
      (set-buffer morq-list-buffer)
      (if (eq morq-last-mid (car data))
	  (progn
	    (set-buffer morq-mail-buffer)
	    (goto-char (point-min)))
	(setq morq-last-mid (car data))
	(morq-read-mail data)
	(morq-list-mark-update)))
    (morq-list-mail-window)
    (and pos (goto-char pos))
    (morq-list-adjust)))

(defun morq-list-prev-mail ()
  (interactive)
  (forward-line -1)
  (morq-list-read-mail (morq-list-fetch-data)))

(defun morq-list-prev-unread-mail ()
  (interactive)
  (if (re-search-backward morq-unread-pattern nil t)
      (morq-list-read-mail (morq-list-fetch-data))
    (message "no previous unread mail.")))

(defun morq-list-next-mail ()
  (interactive)
  (forward-line 1)
  (morq-list-read-mail (morq-list-fetch-data)))

(defun morq-list-next-unread-mail ()
  (interactive)
  (if (re-search-forward morq-unread-pattern nil t)
      (morq-list-read-mail (morq-list-fetch-data))
    (message "no next unread mail.")))

(defun morq-list-archive-read ()
  (interactive)
  (if (not (equal morq-last-args '("show_label" "inbox")))
      (morq-list-again)
    (delete-other-windows)
    (save-excursion
      (set-buffer (get-buffer-create morq-temp-buffer))
      (morq-exec-cmd "archive_read"))
    (morq-list-inbox)))

(defun morq-list-unread ()
  (interactive)
  (let ((data (morq-list-fetch-data)))
    (save-excursion
      (set-buffer (get-buffer-create morq-temp-buffer))
      (morq-exec-cmd "mark_as_unread" (int-to-string (car data))))
    (setcar (cdr data) (logand (car (cdr data)) (lognot 1)))
    (morq-list-mark-update)
    (setq morq-last-mid nil)
    (delete-other-windows)
    (forward-line 1)
    (morq-list-adjust)))

(defun morq-list-check ()
  (interactive)
  (morq-list-mark-check)
  (delete-other-windows)
  (forward-line 1)
  (morq-list-adjust))

(defun morq-list-check-all ()
  (interactive)
  (delete-other-windows)
  (save-excursion
    (goto-char (point-min))
    (while (not (eobp))
      (morq-list-mark-check)
      (forward-line 1)))
  (morq-list-adjust))

(defun morq-list-uncheck ()
  (interactive)
  (morq-list-adjust)
  (if (looking-at "^")
      (let ((data (morq-list-fetch-data)))
	(morq-list-mark "^" (morq-flags (nth 1 data))))
    (morq-list-unread)))

(defconst morq-execute-actions '(("read" "mark_as_read") ("unread" "mark_as_unread")
				 ("trash" "trash") ("spam" "spam") ("archive" "archive_mail")
				 ("delete_reply_mark" "mark_as_unreplied")
				 ("labels" "add_labels" t)
				 ("build_index" "reindex")
				 ("inbox" "move_to_inbox")))

(defun morq-list-execute (action &optional label)
  (interactive (list (cadr (assoc (completing-read "action: " morq-execute-actions nil t)
				  morq-execute-actions))))
  (and (interactive-p) (message "action: %s" action))
  (goto-char (point-min))
  (let (list mid)
    (if (and (equal action "add_labels") (null label))
	(setq label (completing-read "add label: " (morq-labels-table) nil nil)))
    (while (re-search-forward morq-checked-pattern nil t)
      (setq mid (morq-list-fetch-mid))
      (forward-line 1)
      (setq list (cons (int-to-string mid) list)))
    (if label
	(setq list (cons label list)))
    (if (< 0 (length list))
	(save-excursion
	  (set-buffer (get-buffer-create morq-temp-buffer))
	  (apply 'morq-exec-cmd action list))))
  (morq-list-again))

(defun morq-list-process-mail (cmd)
  (beginning-of-line)
  (let ((mid (morq-list-fetch-mid)))
    (if (looking-at morq-checked-pattern)
	(morq-list-execute cmd)
      (let ((mid (morq-list-fetch-mid)))
	(set-buffer (get-buffer-create morq-temp-buffer))
	(morq-exec-cmd cmd (int-to-string mid)))
      (delete-other-windows)
      (forward-line 1)
      (morq-list-again)
      (and mid (morq-goto-mid mid)))))

(defun morq-list-add-label (data label)
  (interactive (list (morq-list-fetch-data)
		     (completing-read "add label: " (morq-labels-table) nil nil)))
  (if (looking-at morq-checked-pattern)
      (morq-list-execute "add_labels" label)
    (save-excursion
      (set-buffer (get-buffer-create morq-temp-buffer))
      (morq-exec-cmd "add_label" (int-to-string (car data)) label))
    (setq morq-last-mid nil)
    (morq-list-read-mail data)))

(defun morq-list-remove-label (data label)
  (interactive
   (let* ((data (morq-list-fetch-data))
	  (label (completing-read "remove label: " (morq-labels-table (car data)) nil t)))
     (list data label)))
  (if (looking-at morq-checked-pattern)
      (morq-list-execute "remove_labels" label)
    (save-excursion
      (set-buffer (get-buffer-create morq-temp-buffer))
      (morq-exec-cmd "remove_label" (int-to-string (car data)) label))
    (setq morq-last-mid nil)
    (morq-list-read-mail data)))

(defun morq-list-todo (data)
  (interactive (list (morq-list-fetch-data)))
  (if (looking-at morq-checked-pattern)
      (morq-list-execute "add_labels" "action")
    (save-excursion
      (set-buffer (get-buffer-create morq-temp-buffer))
      (morq-exec-cmd "add_label" (int-to-string (car data)) "action"))
    (setq morq-last-mid nil)
    (morq-list-read-mail data)))

(defun morq-list-done (data)
  (interactive (list (morq-list-fetch-data)))
  (if (looking-at morq-checked-pattern)
      (morq-list-execute "remove_labels" "action")
    (save-excursion
      (set-buffer (get-buffer-create morq-temp-buffer))
      (morq-exec-cmd "remove_label" (int-to-string (car data)) "action"))
    (setq morq-last-mid nil)
    (morq-list-read-mail data)))

(defun morq-list-trash ()
  (interactive)
  (morq-list-process-mail "trash"))

(defun morq-list-move-to-inbox ()
  (interactive)
  (morq-list-process-mail "move_to_inbox"))

(defun morq-list-spam ()
  (interactive)
  (morq-list-process-mail "spam"))

(defun morq-list-isearch-article ()
  "Do incremental search forward on current article."
  (interactive)
  (let ((data (morq-list-fetch-data))
	(w (selected-window)))
    (if (and (eq morq-last-mid (car data)) (get-buffer-window morq-mail-buffer))
	(morq-list-mail-window)
      (morq-list-show-mail data))
    (unwind-protect
	(progn
	  (select-window (get-buffer-window morq-mail-buffer))
	  (isearch-forward))
      (select-window w))))

(defun morq-list-button-dispatcher (event)
  (interactive "e")
  (mouse-set-point event)
  (morq-list-show-mail (morq-list-fetch-data)))

(defun morq-mime-content ()
  (mime-view-buffer (current-buffer) morq-mail-buffer nil nil 'binary)
  (goto-char (point-min))
  (setq mode-name "Readmail MIME")
  (make-local-variable 'truncate-partial-width-windows)
  (setq truncate-partial-width-windows nil)
  (make-local-variable 'font-lock-defaults)
  (setq font-lock-defaults
	'(morq-font-lock-keywords
	  t nil nil nil
	  (font-lock-maximum-size . nil)
	  (font-lock-inhibit-thing-lock . (lazy-lock-mode fast-lock-mode))))
  (if (text-property-any (point-min) (point-max) 'morq-fontified nil)
      (let ((modified (buffer-modified-p))
	    (buffer-undo-list t) (inhibit-read-only t)
	    before-change-functions after-change-functions
	    buffer-file-name buffer-file-truename)
	(save-excursion
	  (save-match-data
	    (add-text-properties (point-min) (point-max) '(morq-fontified t))
	    (font-lock-fontify-buffer)))))
  (local-set-key "w" 'widen))

(defun morq-read-mail (data &optional decrypt)
  (save-excursion
    (let ((mid (car data)) (already nil))
      (and (get-buffer morq-mail-buffer)
	   (save-excursion
	     (set-buffer morq-mail-buffer)
	     (and (not decrypt) (eq mid morq-mail-mid)
		  (setq already t)
		  (and morq-mail-decoded
		       (setq decrypt t)))))
      (if already
	  (set-buffer morq-mail-buffer)
	(set-buffer (get-buffer-create morq-raw-buffer))
	(if (functionp 'set-buffer-multibyte)
	    (set-buffer-multibyte nil)
	  (setq mc-flag nil kanji-fileio-code nil))
	(morq-exec-cmd "show_mail" (int-to-string mid))
	(if decrypt 
	    (progn
	      (require 'mailcrypt)
	      (mc-decrypt)))
	(morq-mime-content)
	(set-buffer morq-mail-buffer)
	(make-variable-buffer-local 'morq-mail-mid)
	(setq morq-mail-mid mid)
	(make-variable-buffer-local 'morq-mail-decoded)
	(setq morq-mail-decoded decrypt)
	(run-hooks 'morq-show-contents-hook))
      (setq mode-line-buffer-identification
	    (format "morq: %d << %s >>" mid (morq-labels mid)))
      (setcar (cdr data) (logior (car (cdr data)) 1))
      (pop-to-buffer morq-mail-buffer))))

(defun morq-labels (mid)
  (save-excursion
    (set-buffer (get-buffer-create morq-temp-buffer))
    (morq-exec-cmd "list_label" (int-to-string mid))
    (goto-char (point-max))
    (skip-chars-backward "\n\r ")
    (buffer-substring-no-properties (point-min) (point))))

(defun morq-exec-cmd (&rest args)
  (setq buffer-offer-save nil)	;for people who set default to t
  (erase-buffer)
  (message "reading...")
  (if (not (zerop (apply 'call-process morq-command nil t nil args)))
      (let (err)
	(goto-char (point-min))
	(end-of-line)
	(setq err (buffer-substring (point-min) (point)))
	(error "morq error: %s" err)))
  (message ""))

(defun morq-reply-mark (mid)
  (save-excursion
    (delete-windows-on (current-buffer))
    (set-buffer (get-buffer-create morq-temp-buffer))
    (morq-exec-cmd "mark_as_replied" (int-to-string mid))
    (set-buffer morq-list-buffer)
    (let (line)
      (maphash (lambda (key value)
		 (if (= (car value) mid)
		     (setq line key)))
	       morq-list-data)
      (if line
	  (progn
	    (goto-line (1+ line))	   ; goto-line counts from 1
	    (morq-list-mark "." "R"))))))

(defun morq-reply-yank-original (arg)
  (interactive "P")
  (save-excursion
    (insert (format "\nIn message \"%s\"\n    on %s, %s writes:\n"
		    morq-reply-subject morq-reply-date morq-reply-from))
    (mail-yank-original arg)))

(defun morq-reply (noyank all-cc)
  (let ((data (morq-list-fetch-data)) mid
	message-id to subject cc from date action)
    (setq mid (car data))
    (morq-read-mail data)
    (bury-buffer morq-mail-buffer)
    (set-buffer morq-mail-buffer)
    (goto-char (point-min))
    (re-search-forward "^$" nil t)
    (save-restriction
      (narrow-to-region (point-min) (point))
      (setq message-id (mail-fetch-field "Message-Id"))
      (setq subject (or (mail-fetch-field "Subject") ""))
      (setq to (mail-strip-quoted-names (or (mail-fetch-field "Reply-to" nil)
					    (mail-fetch-field "From" nil))))
      (and (string-match "^\\([Rr][Ee]:[ \t]*\\)+" subject)
	   (setq subject (substring subject (match-end 0))))
      (setq subject (concat "Re: " subject))
      (if noyank
	  nil
	(setq from (mail-fetch-field "From"))
	(setq date (mail-fetch-field "Date")))
      (if all-cc
	  (let ((fields '("Cc" "To" "From" "Reply-To"))
		tmp cc-list)
	    (while fields
	      (setq tmp (mail-fetch-field (car fields) nil t))
	      (and tmp
		   (setq cc-list (append cc-list
					 (split-string (mail-strip-quoted-names tmp) ", +"))))
	      (setq fields (cdr fields)))
	    (setq cc-list (delete-duplicates cc-list :test ' string-equal))
	    (setq cc-list (delete to cc-list))
	    (and mail-self-blind user-mail-address
		 (setq cc-list (delete user-mail-address cc-list)))
	    (setq cc (mapconcat 'identity cc-list ", "))
	    (if (string-equal cc "")
		(setq cc nil)))))
    (setq action (list (list (function morq-reply-mark) mid)))
    (mail nil to subject message-id cc (current-buffer) action)
    (rfc822-goto-eoh)
    (forward-line 1)
    (make-variable-buffer-local 'morq-reply-subject)
    (setq morq-reply-subject subject)
    (make-variable-buffer-local 'morq-reply-date)
    (setq morq-reply-date date)
    (make-variable-buffer-local 'morq-reply-from)
    (setq morq-reply-from from)
    (make-variable-buffer-local 'morq-reply-sign)
    (setq morq-reply-sign nil)
    (or noyank (morq-reply-yank-original nil))))

(defun morq-reply-send-and-exit ()
  (interactive)
  (mail-send)
  (let ((buf (get-buffer morq-list-buffer)))
    (if buf
	(progn
	  (delete-other-windows)
	  (bury-buffer)
	  (switch-to-buffer buf))
      (delete-window))))

(defvar *morq-addresses-age nil)
(defvar *morq-addresses nil)

(defvar morq-addresses-file "~/.addresses")

(defsubst morq-older (t1 t2)
  (cond
   ((= (car t1) (car t2))
    (< (nth 1 t1) (nth 1 t2)))
   ((< (car t1) (car t2)) t)
   (t nil)))

(defun morq-address-complete-list ()
  "宛先の補完用リストを返す."
  (let ((ad (expand-file-name morq-addresses-file)) mod buf tl)
    (if (eq mail-aliases t)
	(progn
	  (setq mod t)
	  (setq mail-aliases nil)
	  (if (file-exists-p mail-personal-alias-file)
	      (build-mail-aliases))))
    (and (file-exists-p ad)
	 (or (null *morq-addresses-age)
	     (morq-older *morq-addresses-age (nth 5 (file-attributes ad))))
	 (progn
	   (setq mod t)
	   (setq *morq-mailrc-age (nth 5 (file-attributes ad)))
	   (save-excursion
	     (setq buf (get-buffer-create " morqaddr"))
	     (set-buffer buf)
	     (erase-buffer)
	     (insert-file-contents ad)
	     (goto-char (point-min))
	     (while (re-search-forward "^\\([^ \t\n#]+\\)" nil t)
	       (setq tl (cons (list (buffer-substring-no-properties
				     (match-beginning 1)
				     (match-end 1))) tl))
	       (forward-line 1))
	     (kill-buffer buf))))
    (if mod (setq *morq-addresses (if tl (append tl mail-aliases) mail-aliases))))
  *morq-addresses)

(defun morq-complete-address ()
  "mailモードにおいてaddressを補完する."
  (interactive)
  (let* ((end (point))
	 (start (save-excursion
		  (skip-chars-backward "^ \t\n,")
		  (point)))
	 (pattern (buffer-substring-no-properties start end))
	 (cl (morq-address-complete-list))
	 completion alias)
    (if (null cl)
	nil
      (setq completion (try-completion pattern cl))
      (cond ((eq completion t)
	     (setq alias (assoc pattern mail-aliases))
	     (if alias
		 (progn
		   (delete-region start end)
		   (insert (cdr alias)))))
	    ((null completion)
	     (condition-case nil
		 (dabbrev-expand nil)
	       (error (message "can't find completion for \"%s\"" pattern)
		      (ding))))
	    ((not (string= pattern completion))
	     (delete-region start end)
	     (insert completion))
	    (t
	     (message "Making completion list...")
	     (let ((list (all-completions pattern cl)))
	       (with-output-to-temp-buffer "*Completion*"
		 (display-completion-list list)))
	     (message "Making completion list... done"))))))

(defun morq-complete-address-or-tab (force)
  (interactive "P")
  (let ((case-fold-search t))
    (cond ((or force
	       (and
		;; カーソルがヘッダにあるかどうか.
		(< (point)
		   (save-excursion
		     (rfc822-goto-eoh)
		     (point)))
		;; フィールドが適切かどうか.
		(save-excursion
		  (beginning-of-line)
		  ;; 継続行なら後ろに戻る
		  (while (and (looking-at "^[ \t]")
			      (not (= (point) (point-min))))
		    (forward-line -1))
		  ;; 行頭が適切なヘッダか.
		  (looking-at morq-complete-header-regexp))))
	   (morq-complete-address))
	  ((save-excursion (skip-chars-backward "[ \t]") (bolp))
	   (indent-relative))
	  ((save-excursion
	     (let ((p (point)))
	       (skip-chars-backward "a-z")
	       (not (= p (point)))))
	   (condition-case nil
	       (dabbrev-expand nil)
	     (error (funcall mail-complete-function nil))))
	  (t
	   (indent-relative)))))

(add-hook 'mail-setup-hook
	  (lambda ()
	    (define-key mail-mode-map "\C-i" 'morq-complete-address-or-tab)
	    (define-key mail-mode-map "\C-c\C-c" 'morq-reply-send-and-exit)
	    (define-key mail-mode-map "\C-c\C-y" 'morq-reply-yank-original)
	    ))

(defun morq-list-reply (&optional noyank)
  (interactive "P")
  (morq-reply noyank nil))

(defun morq-list-followup (&optional noyank)
  (interactive "P")
  (morq-reply noyank t))

(defun morq-clear-trash ()
  (interactive)
  (set-buffer (get-buffer-create morq-temp-buffer))
  (morq-exec-cmd "clear_trash")
  (morq-list-again)
  (message "removed all mails in trash"))

(defun morq-clear-spam ()
  (interactive)
  (set-buffer (get-buffer-create morq-temp-buffer))
  (morq-exec-cmd "clear_spam")
  (morq-list-again)
  (message "removed all mails in spam"))

(defvar *morq-last-pipe-command nil)

(defun morq-list-pipe (cmd)
  (interactive (list (read-string "Pipe to command: " *morq-last-pipe-command)))
  (setq *morq-last-pipe-command cmd)
  (let ((data (morq-list-fetch-data))
	(buf (get-buffer-create "*Shell Command Output*")))
    (save-excursion
      (morq-read-mail data)
      (morq-list-mark-update)
      (save-excursion
	(set-buffer buf)
	(erase-buffer))
      (save-excursion
	(set-buffer morq-mail-buffer)
	(call-process-region (point-min) (point-max)
			     (or shell-file-name "sh")
			     nil buf nil "-c" cmd))
      (morq-list-mail-window)
      (morq-list-adjust)
      (set-buffer buf)
      (let ((lines (count-lines (point-min) (point-max))))
	(if (= lines 0)
	    (kill-buffer buf)
	  (if (> lines 1)
	      (display-buffer buf)
	    (message (buffer-substring (point-min) (1- (point-max))))
	    (kill-buffer buf)))
	(if (not (= lines 1))
	    (message "piping out message... done"))))))

(defun morq-list-ml-id ()
  (interactive)
  (save-window-excursion
    (save-excursion
      (morq-list-show-mail (morq-list-fetch-data))
      (set-buffer (get-buffer morq-mail-buffer))
      (set-buffer morq-mail-buffer)
      (goto-char (point-min))
      (let* ((ml (mail-fetch-field "X-ML-Name"))
	     (count (mail-fetch-field "X-Mail-Count"))
	     (ml-id (format "[%s:%s]" ml count)))
	(if (not (and ml count))
	    (message "no ML info")
	  (kill-new ml-id)
	  (message "%s" ml-id))))))

(defun morq-list-keywords (mid)
  (interactive (list (morq-list-fetch-mid)))
  (let (keywords)
    (save-excursion
      (set-buffer (get-buffer-create morq-temp-buffer))
      (morq-exec-cmd "show_keywords" (int-to-string mid))
      (goto-char (point-max))
      (skip-chars-backward "\n\r ")
      (setq keywords (buffer-substring-no-properties (point-min) (point))))
    (message "keywords: %s" keywords)))

(defun morq-list-mc-verify (data)
  (interactive (list (morq-list-fetch-data)))
  (save-excursion
    (set-buffer (get-buffer-create morq-raw-buffer))
    (if (functionp 'set-buffer-multibyte)
	(set-buffer-multibyte nil)
      (setq mc-flag nil kanji-fileio-code nil))
    (morq-exec-cmd "show_mail" (int-to-string (car data)))
    (require 'mailcrypt)
    (mc-verify)))

(defun morq-list-mc-decrypt (data)
  (interactive (list (morq-list-fetch-data)))
  (save-window-excursion
    (morq-read-mail data t)))

(provide 'morq)