;;;; AUTHOR:  小松弘幸 <komatsu@taiyaki.org>
;;;; LICENSE: GPL2
;;;;
;;;; $Id: mell-process.el,v 1.1.1.1 2002/08/25 14:24:47 komatsu Exp $

(defvar mell-process-extra-status-alist nil)

(defun mell-process-exit (process-alist)
  (let ((process       	    (cdr (assoc 'process   	    process-alist)))
	)
    (and (process-status process)
	 (delete-process process))
    ))

(defun mell-process-command-init (process-alist &optional forcep)
  (let ((process       	    (cdr (assoc 'process   	    process-alist)))
	(buffer        	    (cdr (assoc 'buffer    	    process-alist)))
	(command       	    (cdr (assoc 'command   	    process-alist)))
	(args-list     	    (cdr (assoc 'args-list          process-alist)))
	(exit-function 	    (cdr (assoc 'exit-function      process-alist)))
	(message-error-init (cdr (assoc 'message-error-init process-alist)))
	)
    (and (or forcep
	     (not (member (mell-process-status process) '(run error))))
	 (progn (mell-process-exit process-alist)
		(or (mell-process-command-start
		     process buffer command args-list exit-function)
		    (mell-process-error process message-error-init))
		))))
    
(defun mell-process-set-buffer-coding-system (&optional buffer)
  (and buffer
       (set-buffer buffer))
  (if (fboundp 'set-current-process-coding-system) ;;; for Emacs20
      (set-current-process-coding-system *euc-japan* *euc-japan*)
    (set-buffer-process-coding-system 'euc-japan 'euc-japan))
  )


(defun mell-process-command-start (process buffer command &optional args-list
					    exit-function)
  (condition-case nil
      (save-excursion
	(get-buffer-create buffer)
	(set-buffer buffer)
	(and exit-function
	     (progn (make-variable-buffer-local 'kill-buffer-hook)
		    (add-hook 'kill-buffer-hook exit-function)
		    (add-hook 'kill-emacs-hook  exit-function)))
	(process-kill-without-query
;	 (apply 'start-process-shell-command
	 (apply 'start-process
		process buffer command args-list))
	(mell-process-set-buffer-coding-system)
	t
	)
    (error nil)
    ))

(defun mell-process-network-start (process buffer server port
					    &optional exit-function)
  (condition-case nil
      (save-excursion
	(get-buffer-create buffer)
	(set-buffer buffer)
	(and exit-function
	     (progn (make-variable-buffer-local 'kill-buffer-hook)
		    (add-hook 'kill-buffer-hook exit-function)
		    (add-hook 'kill-emacs-hook  exit-function)))
	(process-kill-without-query
	 (open-network-stream process buffer server port))
	(mell-process-set-buffer-coding-system)
	t
	)
    (error nil)
    ))

(defun mell-process-set-exit-function (process exit-function)
  (save-excursion
    (set-buffer (process-buffer process))
    (make-variable-buffer-local 'kill-buffer-hook)
    (add-hook 'kill-buffer-hook exit-function)
    (add-hook 'kill-emacs-hook  exit-function)
    ))  

(defun mell-process-status (process)
  (or (process-status process)
      (cdr (assoc process mell-process-extra-status-alist)))
  )

(defun mell-process-error (process &optional message)
  (mell-process-status-set-error process)
  (message (or message "エラーが発生しました"))
  )

(defun mell-process-status-set-error (process)
  (remassoc process mell-process-extra-status-alist)
  (setq mell-process-extra-status-alist
	(cons (cons process 'error) mell-process-extra-status-alist))
  )

;;;; mell-process-send-string
(defun mell-process-send-string (process-alist string)
  (save-excursion
    (let ((process 	 (cdr (assoc 'process 	    process-alist)))
	  (buffer  	 (cdr (assoc 'buffer   	    process-alist)))
	  (init-function (cdr (assoc 'init-function process-alist)))
	  (timeout
	   (cdr (assoc 'timeout-second         process-alist)))
	  (timeout-handler-function
	   (cdr (assoc 'timeout-handler-function   process-alist)))
	  (end-of-output-p-function
	   (cdr (assoc 'end-of-output-p-function process-alist)))
	  output-string
	  )
      (funcall init-function)
      (set-buffer buffer)
      (erase-buffer)

      ;;;; いちいちエンコードを指定しないと, よく文字化けが起こる.
      (mell-process-set-buffer-coding-system)
      (process-send-string process string)
      (accept-process-output (get-process process) 2 0)

      (if end-of-output-p-function 
	  (if (eq timeout t)
	      (while (not (funcall end-of-output-p-function))
		(sleep-for 0.1))
	    (with-timeout
		((or timeout 2)
		 (if timeout-handler-function
		     (setq output-string (funcall timeout-handler-function))
		   ))
	      (while (not (funcall end-of-output-p-function))
		(sleep-for 0.1))
	      )
	    ))
      (or output-string
	  (buffer-string))
      )))

; プロセスの出力が長い場合に有効かも?
;    (catch 'process-loop
;      (while (process-status kakasi-process)
;	(accept-process-output (get-process kakasi-process) 1 0)
;	(and (> (buffer-size) 0)
;	     (if function (funcall function) t)
;	     (throw 'process-loop nil))
;	))
;    (buffer-string)

(provide 'mell-process)