;; irchat-dcc.el  (for irchat-2.4jp version)
;; Copyright (C) 1995,1996 Takahiro Kikuchi

;; Author:   Takahiro Kikuchi <kick@kyoto.wide.ad.jp>
;; Created:  Mar 19, 1995
;; Modified: Mar 29, 1995
;; Bug Fixed: Aug 8, 1996  special thanks to ohm@kyoto.wide.ad.jp

(defvar irchat-dcc-list nil)
(defvar irchat-dcc-partner nil)

(defun irchat-dcc-request (from to rest)
  "DCC request from user"
  (cond
   ((null rest)
    (irchat-insert0 (format "*** Bad format DCC from %s\n" from))
    (irchat-ctcp-reply from (format "ERRMSG :DCC: bad format")))
   ((string-match "^SEND \\([^ ]+\\) \\([^ ]+\\) \\([^ ]+\\) \\([^ ]+\\)" rest)
    (let ((file (matching-substring rest 1))
	  (host (matching-substring rest 2))
	  (port (matching-substring rest 3))
	  (size (matching-substring rest 4)))
      (irchat-dcc-add-object
       (list 'GET 'Offered nil (current-time-string)
	     from host port file size file))
      (irchat-insert-special
       (format "*** DCC SEND request from %s: %s (%s bytes)\n"
	       from file size) t) ;; GAGA
      (if irchat-dcc-auto-get-file
	  (irchat-Command-dcc-get))))
   ((string-match "^CHAT \\([^ ]+\\) \\([^ ]+\\) \\([^ ]+\\)" rest)
    (let ((file (matching-substring rest 1))
	  (host (matching-substring rest 2))
	  (port (matching-substring rest 3)))
      (irchat-dcc-add-object
       (list 'CHAT 'Offered nil (current-time-string)
	     from host port file))
      (irchat-insert-special (format "*** DCC CHAT request from %s\n"
			     from) t))) ;; GAGA
   ((string-match "^CANCEL \\([^ ]+\\) \\([^ ]+\\) \\([^ ]+\\)" rest)
    (let ((file (matching-substring rest 1))
	  (host (matching-substring rest 2))
	  (port (matching-substring rest 3)))
      (irchat-dcc-cancel from host port file)))
   (t
    (irchat-insert0 (format "*** Unknown DCC from %s: %s\n" from rest))
    (irchat-ctcp-reply from (format "ERRMSG :DCC: bad command")))))

(defun irchat-dcc-cancel (from host port file)
  "DCC cancel request from user"
  (let ((dcc-list irchat-dcc-list) dcc-object found)
    (while (and dcc-list (not found))
      (setq dcc-object (car dcc-list)
	    dcc-list (cdr dcc-list))
      (if (and (string= (nth 4 dcc-object) from)
	       (string= (nth 5 dcc-object) host)
	       (string= (nth 6 dcc-object) port)
	       (string= (nth 7 dcc-object) file))
	  (setq found dcc-object)))
    (if found
	(progn
	  (irchat-insert0 irchat-dcc-list-header)
	  (irchat-insert0 (irchat-dcc-list-object 0 dcc-object))
	  (irchat-insert0 (format "*** DCC canceled from %s\n" from))
	  (if (nth 2 dcc-object)
	      (delete-process (nth 2 dcc-object)))
	  (irchat-dcc-delete-object dcc-object)))))
    

(defun irchat-Command-dcc-send ()
  "Send file to user via DCC"
  (interactive)
  (let (proc
	(file (expand-file-name
	       (read-file-name "File to send: " default-directory nil))))
    (setq irchat-dcc-partner
	(irchat-completing-default-read "To whom: "
	 (append irchat-nick-alist irchat-channel-alist)
	 '(lambda (s) t) nil irchat-dcc-partner))
    (setq proc (start-process irchat-dcc-program nil irchat-dcc-program
			      "file" "send" file))
    (irchat-pj-set-process-coding-system proc)
    (irchat-dcc-add-object
     (list 'SEND 'Setting proc (current-time-string)
	   irchat-dcc-partner nil nil file nil))
    (set-process-buffer proc
            (get-buffer-create (format " DCC:%s" (process-id proc))))
    (set-process-filter proc 'irchat-dcc-filter)
    (set-process-sentinel proc 'irchat-dcc-sentinel)))

(defun irchat-dcc-filter (process output)
  (let ((obuf (current-buffer)) (pbuf (process-buffer process)))
    (set-buffer pbuf)
    (goto-char (point-max))
    (insert output)
    (goto-char (point-min))
    (while (looking-at ".*\n")
      (goto-char (match-end 0))
      (setq output (buffer-substring 1 (point)))
      (delete-region 1 (point))
      (set-buffer obuf)
      (irchat-dcc-filter-sub process output)
      (set-buffer pbuf))
    (set-buffer obuf)))

(defun irchat-dcc-filter-sub (process output)
  (let* ((dcc-object (irchat-dcc-get-process-object process)) filename
	 (nick (nth 4 dcc-object))
	 (file (nth 7 dcc-object))
	 (size (nth 8 dcc-object)))
    (if (null dcc-object)
	(delete-process process)   ;; garbage process
      (cond
       ((eq (nth 1 dcc-object) 'Active)
	(irchat-dcc-chat-loop-filter-sub process output))
       ((string-match "^DCC GETTING" output)
	;; 'Connect -> 'Getting
	(setcar (nthcdr 1 dcc-object) 'Getting)
	(irchat-insert0
	 (format "*** DCC getting file %s (%s bytes) from %s\n"
		 file size nick)))
       ((string-match "^DCC SEND \\([^ ]+\\) \\([^ ]+\\) \\(.+\\)\n" output)
	;; 'Setting -> 'Waiting
	(let ((host (matching-substring output 1))
	      (port (matching-substring output 2))
	      (size (matching-substring output 3)))
	  (setcar (nthcdr 1 dcc-object) 'Waiting)
	  (setcar (nthcdr 5 dcc-object) host)
	  (setcar (nthcdr 6 dcc-object) port)
	  (setcar (nthcdr 8 dcc-object) size)
	  (setq filename (if (string-match ".*/\\(.*\\)" file)
			     (matching-substring file 1) file))
	  (irchat-send "PRIVMSG %s :DCC SEND %s %s %s %s"
		       nick filename host port size)
	  (irchat-insert0
	   (format "*** DCC SEND request file %s (%s bytes) to %s\n"
		   file size nick))))
       ((string-match "^DCC SENDING" output)
	;; 'Waiting -> 'Sending
	(setcar (nthcdr 1 dcc-object) 'Sending)
	(irchat-insert0
	 (format "*** DCC sending file %s (%s bytes) to %s\n"
		 file size nick)))
       ((string-match "^DCC CHAT \\([^ ]+\\) \\([^ ]+\\)\n" output)
	;; 'Setting -> 'Waiting
	(let ((host (matching-substring output 1))
	      (port (matching-substring output 2)))
	  (setcar (nthcdr 1 dcc-object) 'Waiting)
	  (setcar (nthcdr 5 dcc-object) host)
	  (setcar (nthcdr 6 dcc-object) port)
	  (irchat-send "PRIVMSG %s :DCC CHAT chat %s %s"
		       nick host port)
	  (irchat-insert0
	   (format "*** DCC CHAT request to %s\n" nick))))
       ((string-match "^DCC CHATTING" output)
	;; 'Waiting or 'Connect -> 'Active
	(set-process-filter process 'irchat-dcc-chat-loop-filter)
	(setcar (nthcdr 1 dcc-object) 'Active)
	(irchat-insert0
	 (format "*** DCC CHAT connection (with %s) established.\n" nick)))
       ((string-match "^DCC REPORT \\(.+\\)" output)
	(message "DCC report: %s" (matching-substring output 1)))
       ((string-match "^DCC ERROR \\(.+\\)" output)
	(irchat-insert0
	 (format "*** DCC ERROR: %s\n" (matching-substring output 1))))
       ((string-match "^DCC ERROR1 \\(.+\\)" output)
	(irchat-dcc-add-object 
	 (list 'GET 'Offered nil
	       (nth 3 dcc-object) (nth 4 dcc-object) (nth 5 dcc-object)
	       (nth 6 dcc-object) (nth 9 dcc-object) (nth 8 dcc-object)))
	(irchat-insert0
	 (format "*** DCC ERROR: %s\n" (matching-substring output 1))))
       (t
	(irchat-insert0
	 (format "*** DCC FATAL ERROR: %s\n" (matching-substring output 1)))
	nil)))))

(defun irchat-dcc-sentinel (process output)
  (let* ((dcc-object (irchat-dcc-get-process-object process))
	 (type (nth 0 dcc-object))
	 (nick (nth 4 dcc-object))
	 (file (nth 7 dcc-object))
	 (size (nth 8 dcc-object)))
    (if (null dcc-object) 
	(delete-process process)   ;; garbage process
      (cond
       ((and (string-match "^finished" output) (eq type 'SEND))
	;; 'Sending -> 'Done
	(irchat-insert0
	 (format "*** DCC sent file %s (%s bytes) to %s\n" file size nick))
	(message ""))
       ((and (string-match "^finished" output) (eq type 'GET))
	;; 'Getting -> 'Done
	(irchat-insert0
	 (format "*** DCC got file %s (%s bytes) from %s\n" file size nick))
	(message ""))
       ((and (string-match "^finished" output) (eq type 'CHAT))
	;; 'Active -> 'Done
	(irchat-insert0
	 (format "*** DCC CHAT connection (with %s) finished.\n" nick)))
       (t
	(irchat-insert0
	 (format "*** DCC ERROR process (%s %s %s %s) is %s\n"
		 (prin1-to-string (nth 0 dcc-object)) ; type
		 (if (nth 7 dcc-object) (nth 7 dcc-object) "") ; file
		 (cond
		  ((eq (nth 0 dcc-object) 'SEND) "to")
		  ((eq (nth 0 dcc-object) 'GET) "from")
		  ((eq (nth 0 dcc-object) 'CHAT) "with"))
		 (nth 4 dcc-object) ; nick
		 (substring output 0 (1- (length output)))))))
      (irchat-dcc-delete-object dcc-object))))


(defun irchat-Command-dcc-kill ()
  "Kill DCC process and object"
  (interactive)
  (let (dcc-object number)
    (if (numberp current-prefix-arg)
	(setq number current-prefix-arg)
      (setq number nil))
    (if number
	(setq dcc-object (irchat-dcc-get-object number))
      (setq dcc-object (irchat-dcc-get-offered-object)))
    (if (null dcc-object)
	(if number
	    (irchat-insert0 (format "*** DCC No.%d --- not found\n" number))
	  (irchat-insert0 (format "*** There is no offered DCC\n")))
      (irchat-insert0 irchat-dcc-list-header)
      (irchat-insert0 (irchat-dcc-list-object number dcc-object))
      (if (y-or-n-p "Kill this DCC? ")
	  (if (irchat-dcc-match-object dcc-object) ;;still alive?
	      (let ((nick (nth 4 dcc-object))
		    (host (nth 5 dcc-object))
		    (port (nth 6 dcc-object))
		    (file (nth 7 dcc-object)))
		(irchat-send "PRIVMSG %s :DCC CANCEL %s %s %s"
			     nick file host port)
		(if (nth 2 dcc-object)
		    (delete-process (nth 2 dcc-object)))
		(irchat-dcc-delete-object dcc-object)
		(irchat-insert0 (format "*** DCC killed.\n"))))))))


(defun irchat-Command-dcc-get ()
  "Get offered file from list."
  (interactive)
  (let (dcc-object number)
    (if (numberp current-prefix-arg)
	(setq number current-prefix-arg)
      (setq number nil))
    (if number
	(setq dcc-object (irchat-dcc-get-object number))
      (setq dcc-object (irchat-dcc-get-offered-object)))
    (if (null dcc-object)
	(if number
	    (irchat-insert0 (format "*** DCC No.%d --- not found\n" number))
	  (irchat-insert0 (format "*** There is no offered DCC SEND\n")))
      (if (not (eq (nth 1 dcc-object) 'Offered))
	  (irchat-insert0 (format "*** DCC No.%d --- not offered\n" number))
	(cond
	 ((eq (nth 0 dcc-object) 'GET)
	  (let (proc dir
		;;(nick (nth 4 dcc-object))
		(host (nth 5 dcc-object))
		(port (nth 6 dcc-object))
		(file (nth 7 dcc-object))
		(size (nth 8 dcc-object)))
	    (while (string-match "\\(.*\\)[/~]\\(.*\\)" file)
	      (setq file (format "%s-%s"  (matching-substring file 1)
				          (matching-substring file 2))))
	    (if (file-directory-p irchat-dcc-directory)
		(setq dir irchat-dcc-directory)
	      (irchat-insert0
	       (format "*** irchat-dcc-directory [%s] is not directory!!\n"
		       irchat-dcc-directory))
	      (setq dir "/tmp"))
	    (setq file (format "%s/%s" dir file))
	    (if (file-attributes (expand-file-name file dir))
		(progn
		  (irchat-insert0
		   (format "*** file[%s] already exist. Do you overwrite it?\n"
			   file))
		  (setq file (read-file-name "Write file: " file file))))
	    (setcar (nthcdr 7 dcc-object) file)
	    (setq file (expand-file-name file dir))
	    (setq proc
		  (start-process irchat-dcc-program nil irchat-dcc-program 
				 "file" "get" host port size file))
	    (irchat-pj-set-process-coding-system proc)
	    (setcar (nthcdr 1 dcc-object) 'Connect)
	    (setcar (nthcdr 2 dcc-object) proc)
	    (set-process-buffer proc
                    (get-buffer-create (format " DCC:%s" (process-id proc))))
	    (set-process-sentinel proc 'irchat-dcc-sentinel)
	    (set-process-filter proc 'irchat-dcc-filter)))
	 ((eq (nth 0 dcc-object) 'CHAT)
	  (let (proc
		;;(nick (nth 4 dcc-object))
		(host (nth 5 dcc-object))
		(port (nth 6 dcc-object)))
	    (setq proc
		  (start-process irchat-dcc-program nil irchat-dcc-program 
				 "chat" "connect" host port))
	    (irchat-pj-set-process-coding-system proc)
	    (setcar (nthcdr 1 dcc-object) 'Connect)
	    (setcar (nthcdr 2 dcc-object) proc)
	    (set-process-buffer proc
                    (get-buffer-create (format " DCC:%s" (process-id proc))))
	    (set-process-sentinel proc 'irchat-dcc-sentinel)
	    (set-process-filter proc 'irchat-dcc-filter)))
	 (t
	  (irchat-insert0 "Fatal error! in Command-dcc-get\n")
	  nil))))))

(defun irchat-Command-dcc-chat ()
  "send DCC CHAT request"
  (interactive)
  (let (proc)
    (setq irchat-dcc-partner
	(irchat-completing-default-read "With whom: "
	 (append irchat-nick-alist irchat-channel-alist)
	 '(lambda (s) t) nil irchat-dcc-partner))
    (setq proc (start-process irchat-dcc-program nil irchat-dcc-program
			      "chat" "listen"))
    (irchat-pj-set-process-coding-system proc)
    (irchat-dcc-add-object
     (list 'CHAT 'Setting proc (current-time-string)
	   irchat-dcc-partner nil nil "chat"))
    (set-process-buffer proc
            (get-buffer-create (format " DCC:%s" (process-id proc))))
    (set-process-filter proc 'irchat-dcc-filter)
    (set-process-sentinel proc 'irchat-dcc-sentinel)))

(defun irchat-dcc-chat-send (to xmsg)
  (let ((dcc-list irchat-dcc-list) dcc-object found not-active)
    (while (and dcc-list (not found))
      (setq dcc-object (car dcc-list)
	    dcc-list (cdr dcc-list))
      (if (and (eq (nth 0 dcc-object) 'CHAT)
	       (string-ci-equal (nth 4 dcc-object) to))
	  (if (not (eq (nth 1 dcc-object) 'Active))
	      (setq not-active t)
	    (process-send-string (nth 2 dcc-object)
				 (format "%s\n" (irchat-string-out xmsg)))
	    (setq found t))))
    (if (not found)
	(if not-active
	    (irchat-insert0
	     (format "*** DCC CHAT with %s is not active\n" to))
	  (irchat-insert0
	   (format "*** There is no DCC CHAT with %s\n" to))))))
  
(defun irchat-dcc-chat-loop-filter (process output)
  (let ((obuf (current-buffer)) (pbuf (process-buffer process)))
    (set-buffer pbuf)
    (goto-char (point-max))
    (insert output)
    (goto-char (point-min))
    (while (looking-at ".*\n")
      (goto-char (match-end 0))
      (setq output (buffer-substring 1 (point)))
      (delete-region 1 (point))
      (set-buffer obuf)
      (irchat-dcc-chat-loop-filter-sub process output)
      (set-buffer pbuf))
    (set-buffer obuf)))

(defun irchat-dcc-chat-loop-filter-sub (process output)
  (let* ((dcc-object (irchat-dcc-get-process-object process))
	 (xmsg (irchat-string-in (substring output 0 (1- (length output)))))
	 ;;(state (nth 1 dcc-object))
	 (nick (nth 4 dcc-object)))
    (if (null dcc-object)
	(delete-process process)   ;; garbage process
      (irchat-insert-private t (format "=%s" nick) xmsg))))


(defun irchat-Command-dcc-list ()
  "show DCC list"
  (interactive)
  (if (null irchat-dcc-list)
      (irchat-insert0 "*** There is no DCC list.\n")
    (irchat-insert0 irchat-dcc-list-header)
    (let ((dcc-list irchat-dcc-list) (num 0) dcc-object)
      (while dcc-list
	(setq dcc-object (car dcc-list)
	      dcc-list (cdr dcc-list))
	(setq num (+ num 1))
	(irchat-insert0 (irchat-dcc-list-object num dcc-object))))))

(setq irchat-dcc-list-header
      "*** DCC Received Time Type Status  Nick      filename/chat\n")
     ;"01: [Mar 18 12:34:56] SEND Waiting abcdefghi /hoge/hoge (123 bytes)"

(defun irchat-dcc-list-object (num dcc-object)
  (cond
   ((or (eq (car dcc-object) 'SEND) (eq (car dcc-object) 'GET))
    (format "%02d: [%s] %4s %7s %9s %s (%s bytes)\n"
	    (if num num (irchat-dcc-match-object dcc-object))
	    (substring (nth 3 dcc-object) 4 19) ; time
	    (add-space 4 (prin1-to-string (nth 0 dcc-object))) ; type
	    (add-space 7 (prin1-to-string (nth 1 dcc-object))) ; status
	    (add-space 9 (nth 4 dcc-object)) ; nick
	    (nth 7 dcc-object) ; file
	    (nth 8 dcc-object))) ; size
   ((eq (car dcc-object) 'CHAT)
    (format "%02d: [%s] %4s %7s %9s <chat>\n"
	    (if num num (irchat-dcc-match-object dcc-object))
	    (substring (nth 3 dcc-object) 4 19) ; time
	    (add-space 4 (prin1-to-string (nth 0 dcc-object))) ; type
	    (add-space 7 (prin1-to-string (nth 1 dcc-object))) ; status
	    (add-space 9 (nth 4 dcc-object)))) ; nick
   (t
    "00: Unknown\n")))


(defun irchat-dcc-add-object (dcc-object)
  (setq irchat-dcc-list (append irchat-dcc-list (list dcc-object))))

(defun irchat-dcc-delete-object (dcc-object)
  (let ((num (irchat-dcc-match-object dcc-object)))
    (if num
	(let ((nth (1- num)))
	  (if (= 0 nth)
	      (setq irchat-dcc-list (cdr irchat-dcc-list))
	    (setcdr (nthcdr (1- nth) irchat-dcc-list)
		    (nthcdr (1+ nth) irchat-dcc-list)))))))

(defun irchat-dcc-get-object (num)
  "return object"
  (nth (1- num) irchat-dcc-list))

(defun irchat-dcc-get-offered-object ()
  "return the first offered object"
  (let ((dcc-list irchat-dcc-list) (num 0) dcc-object found)
    (while (and dcc-list (not found))
      (setq dcc-object (car dcc-list)
	    dcc-list (cdr dcc-list))
      (setq num (1+ num))
      (if (eq (nth 1 dcc-object) 'Offered)
	  (setq found dcc-object)))
    found))

(defun irchat-dcc-get-process-object (process)
  "return object"
  (let ((dcc-list irchat-dcc-list) (num 0) dcc-object found)
    (while (and dcc-list (not found))
      (setq dcc-object (car dcc-list)
	    dcc-list (cdr dcc-list))
      (setq num (+ num 1))
      (if (eq (nth 2 dcc-object) process)
	  (setq found dcc-object)))
    found))

(defun irchat-dcc-match-object (dcc-object)
  "what number?"
  (let ((dcc-list irchat-dcc-list) (num 0) obj found)
    (while (and dcc-list (not found))
      (setq obj (car dcc-list)
	    dcc-list (cdr dcc-list))
      (setq num (1+ num))
      (if (eq dcc-object obj)
	  (setq found num)))
    found))

(provide 'irchat-dcc)
