;;; mew-scan.el --- Scanning messages for Mew

;; Author:  Kazu Yamamoto <Kazu@Mew.org>
;; Created: Oct  2, 1996
;; Revised: Oct 25, 1996

;;; Code:

(defconst mew-scan-version "mew-scan.el version 0.24")

(require 'mew)

(defvar mew-summary-inbox-position (make-marker))

(defun mew-summary-get (&optional arg)
  "Get +inbox asynchronously."
  (interactive "P")
  (if (get-buffer mew-inbox-folder)
      (switch-to-buffer mew-inbox-folder)
    (mew-summary-folder-create mew-inbox-folder))
  (if (and mew-summary-trace-directory
	   (not (mew-folder-newsp mew-inbox-folder)))
      (cd (mew-expand-folder mew-inbox-folder)))
  (mew-summary-folder-cache-manage mew-inbox-folder)
  (if (and mew-summary-cache-use (mew-summary-folder-dir-newp))
      (progn
	;; scan the gap
	(or arg (goto-char (point-max)))
	(mew-summary-scan-body mew-prog-imls
			       'mew-summary-mode
			       mew-inbox-folder
			       mew-cs-scan
			       (mew-input-range mew-inbox-folder))
	;; wait for asynchronous process
	(if mew-xemacs-p
	    (while mew-summary-buffer-process
	      (accept-process-output)
	      (sit-for 0.1)) ;; to flush
	  (while mew-summary-buffer-process (sit-for 1)))
	))
  (set-marker mew-summary-inbox-position (point) (current-buffer))
  ;; for C-xC-x
  (or arg (goto-char (point-max)))
  (mew-summary-scan-body mew-prog-imget
			 'mew-summary-mode
			 mew-inbox-folder
			 mew-cs-scan)
  ;; On PPP environment, executing "imget" lets the dial be up.
  ;; So, it's a good idea to flush queue at this time
  ;; if messages to be sent exist.
  (if (and mew-auto-flush-queue
	   mew-queue-path (file-directory-p mew-queue-path)
	   (> (length (directory-files mew-queue-path)) 2))
      (mew-summary-flush-queue))
  )

(defun mew-summary-exchange-point ()
  (interactive)
  (and (equal (buffer-name) mew-inbox-folder)
       (marker-position mew-summary-inbox-position)
       (goto-char (marker-position mew-summary-inbox-position))))

(defun mew-summary-ls (&optional arg jump)
  "List this folder asynchronously."
  (interactive "P")
  (let* ((folder (buffer-name)))
    (mew-summary-folder-cache-manage folder)
    (mew-mark-clean-up)
    (if jump (goto-char (point-max)))
    (if (not (mew-folder-member folder mew-clean-up-buffers))
	(setq mew-clean-up-buffers (cons folder mew-clean-up-buffers)))
    (if (or (interactive-p)
	    (mew-folder-newsp folder)
	    (mew-folder-imapp folder)
	    (and mew-summary-cache-use
		 (mew-summary-folder-dir-newp)))
	(let ((range (mew-input-range folder)))
	  (or arg (goto-char (point-max)))
	  (mew-summary-scan-body mew-prog-imls 
				 'mew-summary-mode
				 folder
				 mew-cs-scan
				 range))
      (or arg (goto-char (point-max))))
    ))

;;
;; Scan
;;

(defun mew-summary-scan-body (prog mode folder read &optional range folders grep reviews)
  (save-excursion
    (set-buffer (get-buffer-create folder))
    (buffer-disable-undo (current-buffer))
    (if (not (equal major-mode mode)) (funcall mode))
    (mew-window-configure (current-buffer) 'summary)
    (mew-current-set 'message nil)
    (mew-current-set 'part nil)
    (mew-current-set 'cache nil)
    (setq mew-summary-buffer-direction 'down)
    (mew-decode-syntax-delete)
    (if (not (mew-summary-exclusive-p))
	()
      (condition-case nil
	  (let ((process-connection-type mew-connection-type1))
	    (cond
	     ((string-match mew-prog-imget prog)
	      (if (string= mew-config-imget mew-config-default)
		  (message "Getting %s ..." folder)
		(message "Getting %s (%s)..." folder mew-config-imget)))
	     ((string-match mew-prog-imls prog)
	      (message "Listing %s ..." folder)
	      (if (or (equal 'erase (car (cdr range)))
		      (equal mode 'mew-virtual-mode))
		  (let ((buffer-read-only nil)) (erase-buffer))))
	     )
	    (setq mew-summary-buffer-start-point (point))
	    (setq mew-summary-buffer-string nil) ; just in case
	    (setq mew-summary-buffer-process
		  (apply (function start-process) 
			 prog;; name
			 (current-buffer) 
			 prog;; program
			 (format "--width=%d" (if mew-summary-scan-width
						  mew-summary-scan-width
						(if (< (window-width) 80)
						    80
						  (window-width))))
			 (append mew-prog-im-arg ;; xxx
				 (cond
				  ((string-match  mew-prog-imget prog)
				   (append
				    (list (concat "--config="
						  mew-config-imget))
				    mew-prog-imget-arg-list))
				  ((string-match  mew-prog-imls prog)
				   (cond
				    ((equal mode 'mew-summary-mode)
				     (append
				      (list (format "--thread=%s"
						    (if (mew-folder-newsp folder) 
							"yes" "no")))
				      (list (concat "--src=" folder))
				      mew-prog-imls-arg-list
				      (if (listp (car range))
					  (car range)
					(list (car range)))))
				    ((equal mode 'mew-virtual-mode)
				     (list
				      (concat "--src=" (mew-join "," folders))
				      (concat "--grep=" grep)))
				    ))
				  ))
			 ))
	    (mew-set-process-cs mew-summary-buffer-process read mew-cs-noconv)
	    (set-process-filter mew-summary-buffer-process
				'mew-summary-scan-filter)
	    (set-process-sentinel mew-summary-buffer-process
				  'mew-summary-scan-sentinel)
	    (setq mew-summary-buffer-reviews reviews)
	    (process-kill-without-query mew-summary-buffer-process)
	    )
	(quit
	 (set-process-sentinel mew-summary-buffer-process nil)
	 (setq mew-summary-buffer-start-point nil)
	 (setq mew-summary-buffer-process nil)
	 (setq mew-summary-buffer-string nil)
	 (setq mew-summary-buffer-reviews nil)
	 ))
      )))

(defun mew-summary-scan-filter (process string)
  (let ((after-change-function nil)
	(after-change-functions nil)
	(obuf (current-buffer))
	(opos (point))
	(omax (point-max)))
    ;; save-excursion is not usefule because sometime we want to 
    ;; move the cursor forward.
    (set-buffer (process-buffer process)) ;; necessary
    (setq mew-summary-buffer-string 
	  (concat mew-summary-buffer-string string)) ;; nil can concat
    (cond
     ;; just for imls
     ((or (string-match mew-prog-imget (process-name process))
	  (string-match mew-prog-imls  (process-name process)))
      (if (string-match "^Password" mew-summary-buffer-string)
	  (progn
	    (setq mew-summary-buffer-string "")
	    (process-send-string
	     process
	     (format "%s\n" (mew-input-passwd "Enter password : ")))
	    ))
      ;; Skip greeting...
      (if (string-match "^imget: Getting new messages.*\n"
			mew-summary-buffer-string)
	  (setq mew-summary-buffer-string
		(substring mew-summary-buffer-string (match-end 0))))))
    (while (string-match "^ *[0-9]+.*\n" mew-summary-buffer-string)
      (goto-char (point-max))
      ;; the cursor moves forward!
      (let ((buffer-read-only nil))
	(insert (mew-match 0 mew-summary-buffer-string)))
      (setq mew-summary-buffer-string
	    (substring mew-summary-buffer-string (match-end 0))))
    (if (or (equal opos mew-summary-buffer-start-point)
	    (not (equal opos omax)))
	;; move the cursor to the original position.
	(goto-char opos))
    (set-buffer obuf)))

(defun mew-summary-scan-sentinel (process event)
  (save-excursion
    (set-buffer (process-buffer process)) ;; necessary
    (let ((prog (process-name process))
	  (folder (buffer-name))
	  (msg nil))
      (if (not mew-summary-buffer-string)
	  ()
	(cond
	 ((string-match mew-prog-imget prog)
	  (cond
	   ((string-match (format "^%s: no \\(new \\)?message" prog)
			  mew-summary-buffer-string)
	    (message "No new message"))
	   ((string-match (format "^%s: ERROR: invalid password" prog)
			  mew-summary-buffer-string)
	    (message "Password is wrong"))
	   ((string-match (format "^%s: ERROR: \\([^\n]*\\)" prog)
			  mew-summary-buffer-string)
	    (message "Get error: %s" (mew-match 1 mew-summary-buffer-string)))
	   ((string-match (format "^%s: \\([0-9]+\\) message" prog)
			  mew-summary-buffer-string)
	    (setq msg (concat (mew-match 1 mew-summary-buffer-string) 
			      " message(s)")))
	   (t
	    (if (mew-folder-imapp folder)
		(setq msg (format "Getting %%%s ... done" folder))
	      (setq msg (format "Getting %s ... done" folder)))
	    )
	   ))
	 ((string-match mew-prog-imls prog)
	  (cond
;;	   ((string-match (format "^%s: no message" prog)
;;			  mew-summary-buffer-string)
;;	    (message "No messages in %s" folder))
	   ((string-match (format "^%s: ERROR: \\([^\n]*\\)" prog)
			  mew-summary-buffer-string)
	    (message "List error: %s" (mew-match 1 mew-summary-buffer-string)))
	   (t
	    (if (mew-folder-imapp folder)
		(setq msg (format "Listing %%%s ... done" folder))
	      (setq msg (format "Listing %s ... done" folder)))
	    )
	   ))
	 )
	(if msg
	    (let ((buffer-read-only nil)
		  (reviews mew-summary-buffer-reviews))
	      (goto-char (point-max))
	      (keep-lines (concat mew-summary-message-regex))
	      ;; save cache only when success
	      (while reviews
		(goto-line (car reviews))
		(mew-summary-mark-as mew-mark-review)
		(setq reviews (cdr reviews)))
	      (if (and mew-summary-cache-use
		       (not (mew-folder-newsp folder)))
		  (mew-summary-folder-cache-save))
	      (mew-highlight-mark-region
	       mew-summary-buffer-start-point (point-max))
	      (message msg)
	      ))
	)
      (set-buffer-modified-p nil)
      ;; xxx if killed, we can't clear sentinel
      ;;(set-process-sentinel mew-summary-buffer-process nil)
      (setq mew-summary-buffer-start-point nil)
      (setq mew-summary-buffer-process nil)
      (setq mew-summary-buffer-string nil)
      (setq mew-summary-buffer-reviews nil)
      (cond
       ((string-match mew-prog-imget prog)
	(run-hooks 'mew-summary-inc-sentinel-hook))
       ((string-match mew-prog-imls prog)
	(run-hooks 'mew-summary-scan-sentinel-hook))
       )
      )))

;;
;; process control
;;
;; mew-summary-buffer-process is a key to see if exclusive

(defun mew-summary-exclusive-p ()
  (cond
   ((eq mew-summary-buffer-process t)
    (message "Try again later.")
    nil) ;; not exclusive
   ((processp mew-summary-buffer-process)
    (message "%s is running. Try again later."
	     (process-name mew-summary-buffer-process))
    nil) ;; not exclusive
   (t t)) ;; exclusive
  )

(provide 'mew-scan)

;;
;; Config for imget
;;

(defun mew-summary-config-imget ()
  (interactive)
  (setq mew-config-imget (mew-input-config mew-config-imget)))

;;; Copyright Notice:

;; Copyright (C) 1996, 1997, 1998 Mew developing team.
;; All rights reserved.

;; Redistribution and use in source and binary forms, with or without
;; modification, are permitted provided that the following conditions
;; are met:
;; 
;; 1. Redistributions of source code must retain the above copyright
;;    notice, this list of conditions and the following disclaimer.
;; 2. Redistributions in binary form must reproduce the above copyright
;;    notice, this list of conditions and the following disclaimer in the
;;    documentation and/or other materials provided with the distribution.
;; 3. All advertising materials mentioning features or use of this software
;;    must display the following acknowledgement:
;;       This product includes software developed by 
;;       Mew developing team and its contributors.
;; 4. Neither the name of the team nor the names of its contributors
;;    may be used to endorse or promote products derived from this software
;;    without specific prior written permission.
;; 
;; THIS SOFTWARE IS PROVIDED BY THE TEAM AND CONTRIBUTORS ``AS IS'' AND
;; ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
;; IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
;; PURPOSE ARE DISCLAIMED.  IN NO EVENT SHALL THE TEAM OR CONTRIBUTORS BE
;; LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
;; CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
;; SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR
;; BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE
;; OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN
;; IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

;;; mew-scan.el ends here
