;;; -*- Mode:LISP; Package:SERIAL; Base:8 -*-

(defmacro defsite (sitename number &body body)
  (putprop (intern-soft sitename 'serial) number ':phone-number)
  `(defmethod (basic-serial-terminal ,(intern (format nil ":DIAL-~A" sitename)))
	      () ,@body))

(defsite mit-oz "2588260"
  (unwind-protect
    (progn
      (send modem-stream ':clear-input)
      (process-sleep 300.)
      (send modem-stream ':tyo #Control-C)
      (send modem-stream ':tyo #Control-C)
      (return-string-from-modem modem-stream)
      (send modem-stream ':string-out "RG.LMI lambda")
      (send modem-stream ':tyo #Return)
      (if (not (string-wait "LMI FTP PROMPT" modem-stream 50.))
	  (tv:notify self "Unable to log in")
	(tv:notify self "Logged in!")))
    (setq modem-lock nil)))

(defsite ti-dallas "12149950350"
  (unwind-protect
    (progn
      (send modem-stream ':clear-input)
      (send modem-stream ':tyo #Return)
      (return-string-from-modem modem-stream)
      (process-sleep 600. "Waiting")
      (send modem-stream ':string-out "21")
      (send modem-stream ':tyo #Return)
      (if (not (string-equal (return-string-from-modem modem-stream)
			     " TI CRL SYS ID 21"))
	  (tv:notify self "Unable to connect to TI terminal concentrator")
	(if (not (string-wait "GO " modem-stream 5.))
	    (tv:notify self "Mainframe not available")
	  (send modem-stream ':tyo #Control-C)
	  (return-string-from-modem modem-stream)
	  (send modem-stream ':string-out "LMI JSOL")
	  (send modem-stream ':tyo #Return)
	  (if (not (string-wait "LMI FTP PROMPT" modem-stream 50.))
	      (tv:notify self "Unable to log in")
	    (tv:notify self "Logged in!")))))
    (setq modem-lock nil)))

(defun transmit-twenex-file (window remote-filename local-filename)
  (send window ':transmit-twenex-file remote-filename local-filename))

(defmethod (basic-serial-terminal :transmit-twenex-file) (remote local)
  (unwind-protect
    (progn
      (setq modem-lock t)
      (send modem-stream ':string-out (format nil "LMODEM RAQ ~A" remote))
      (send modem-stream ':tyo #Return)
      (if (not
	    (string-wait "File open - ready to receive." modem-stream 3.))
	  (tv:notify nil "Error during file transfer: %~A  ~A" local remote)
	(lispm-send-file local modem-stream)))
    (setq modem-lock nil)))

(defun receive-twenex-file (window local-filename remote-filename)
  (send window ':receive-twenex-file local-filename remote-filename))


(defmethod (basic-serial-terminal :receive-twenex-file) (local remote)
  (send modem-file-connection ':GET-FILE local remote-file))


(defmethod (basic-serial-terminal :sync-on-prompt) (&optional (times 3.))
  (send modem-stream ':clear-input)
  (process-sleep 60.)
  (send modem-stream ':tyo #Return)
  (if (not (string-wait "LMI FTP PROMPT" modem-stream times))
      (tv:notify nil "Unable to sync on Twenex")))

(defvar current-twenex-file-connection nil)

(defun twenex-connect (&quote site)
  (if current-twenex-file-connection
      (tv:notify nil "Currently logged in! Use TWENEX-DISCONNECT")
    (setq current-twenex-file-connection (twenex-dial-and-login-site site))))

(defun twenex-transfer ()
  (if (not current-twenex-file-connection)
      (tv:notify nil "Log in first. Use TWENEX-CONNECT")
    (funcall current-twenex-file-connection ':sync-on-prompt)
    (do (char local remote) (())
      (format t "~%(T)ransmit, (R)eceive, or (E)xit: ")
      (setq char (char-upcase (tyi)))
      (selectq char
	(:#T
	 (format t "ransmit~%Local file name:")
	 (setq local (readline))
	 (format t "Remote file name:")
	 (setq remote (readline))
	 (cond
	   ((y-or-n-p (format nil "Transfer from ~A to ~A?" local remote))
	    (funcall current-twenex-file-connection ':sync-on-prompt)
	    (send current-twenex-file-connection ':transmit-twenex-file remote local))))
	(:#R
	 (format t "eceive~%Local file name:")
	 (setq local (readline))
	 (format t "Remote file name:")
	 (setq remote (readline))
	 (cond
	   ((y-or-n-p (format nil "Transfer from ~A to ~A?" remote local))
	    (funcall current-twenex-file-connection ':sync-on-prompt)
	    (send current-twenex-file-connection ':receive-twenex-file remote local))))
	(:#E
	 (format t "xit")
	 (return t))))))

(defun twenex-disconnect ()
  (if (not current-twenex-file-connection)
      (tv:notify nil "Log in first!")
    (funcall current-twenex-file-connection ':twenex-disconnect)))

(defmethod (basic-serial-terminal :twenex-disconnect) ()
  (send self ':sync-on-prompt)
  (send modem-stream ':string-out "Logout")
  (send modem-stream ':tyo #Return)
  (setq current-twenex-file-connection nil))

(defun twenex-dial-and-login-site (site &aux window)
  (setq window (terminal ':baud 1200. ':expose-p nil))
  (cond
    ((funcall window ':dial-site (format nil "~A" site) (get site ':phone-number) t)
     (funcall window (intern (format nil ":DIAL-~A" site))))) window)

(defun rstrings ()
  (funcall current-twenex-file-connection ':return-strings))

(defmethod (basic-serial-terminal :return-strings) (&aux list)
  (setq modem-lock t)
  (do () ((funcall terminal-io ':tyi-no-hang))
    (push (return-string-from-modem modem-stream) list))
  (setq modem-lock nil) list)

(defun get-directory (directory-string)
  (funcall current-twenex-file-connection ':get-dir directory-string))

(defmethod (basic-serial-terminal :put-ascii-line) (line)
  (send modem-stream ':string-out line)
  (send modem-stream ':tyo #return))

(defun view-directory ()
  (declare (:self-flavor basic-serial-terminal))
  (format self "~&Enter Directory name: ")
  (let ((directory-name (readline self)))
    (send self ':GET-DIR directory-name)))

(defmethod (basic-serial-terminal :get-dir) (dir)
  (with-open-file (hack "ed-buffer:twenex-directory" ':out)
    (funcall hack ':delete-text))
  (unwind-protect
    (progn
      (setq modem-lock t)
      (funcall-self ':sync-on-prompt 3.)
      (funcall-self ':sync-on-prompt 3.)
      (funcall-self ':clear-input)
      (process-sleep 60.)
      (funcall-self ':put-ascii-line (format nil "vdir ~A," dir))
      (funcall-self ':put-ascii-line "output direct.txt")
      (funcall-self ':sync-on-prompt 500.)
      (funcall-self ':receive-twenex-file "direct.txt" "ed-buffer:twenex-directory"))
    (setq modem-lock nil)))

(defun hack-twenex-dir (&aux current-minor current-major version char list)
  (with-open-file (in "ed-buffer:twenex-directory")
      (send in ':line-in)
      (send in ':line-in)
      (do () (())
	(cond
	  ((= (funcall in ':tyi) #\RETURN) (return))
	  ((= (setq char (funcall in ':tyi)) #/ )
	   (funcall in ':tyi)
	   (cond
	     ((= (funcall in ':tyi) #/ )
	      (read-until-char in #/.)
	      (setq version (read-until-char in #/;)))
	     (t
	      (setq current-minor (read-until-char in #/.))
	      (setq version (read-until-char in #/;)))))
	  (t
	   (setq current-major (string-append char (read-until-char in #/.)))
	   (setq current-minor (read-until-char in #/.))
	   (setq version (read-until-char in #/;))))
	(read-until-char in #/))
	(read-until-not-char in #/ )
	(push (list (format nil "~A.~A#~A" current-major current-minor version)
		    (string-append (read-until-char in #/ ) " " (read-until-char in #/ ))
		    (read-until-char in #/ )) list)
	(funcall in ':line-in))) list)

(defun read-until-char (stream char &aux string char1 quote)
  (setq string (make-array 10. ':type art-string ':leader-list '(0)))
  (do () (())
  (setq char1 (funcall stream ':tyi))
    (cond
      ((= char1 #/^)
       (array-push-extend
	 string (setq char1 (logand (funcall stream ':tyi) 37)))
       (if (= char1 26)
	   (setq quote t)))
      ((or ( char1 char) quote)
       (setq quote nil)
       (array-push-extend string char1))
      (t
       (return string)))))

(defun read-until-not-char (stream char)
  (do ((char1 (funcall stream ':tyi) (funcall stream ':tyi)))
      (( char1 char) (funcall stream ':untyi char))))

(defun compare-directories (remote-list local-dir remote-name
			    &aux file-list  match)
  (with-open-file (hack (format nil "ed-buffer:Differences - ~A  ~A" local-dir
				remote-name) ':out)
    (funcall hack ':delete-text))
  (with-open-file (differences (format nil "ed-buffer:Differences - ~A  ~A" local-dir
				remote-name) ':out)
    (setq remote-list (reverse remote-list))
    (setq file-list (cdr (fs:directory-list (string-append local-dir "*.*#*"))))
    (do* ((temp1 remote-list (cdr temp1))
	  (remote (car temp1) (car temp1)))
	 ((not remote))
      (do* ((temp2 file-list (cdr temp2))
	    (local (car temp2) (car temp2)))
	   ((not local))
	(if (string-equal  (car remote) (format nil "~A.~A#~D"
				  (send (car local) ':name)
				  (send (car local) ':type)
				  (send (car local) ':version)))
	    (progn (push (list local remote) match)
		   (rplaca temp2 (cadr temp2))
		   (rplacd temp2 (cddr temp2))
		   (rplaca temp1 (cadr temp1))
		   (rplacd temp1 (cddr temp1))
		   (return)))))
    (format differences "The following files exist only on the remote host.~%")
    (dolist (a remote-list)
      (if (not a) a
	(format differences "~A~A Creation Date:"
		remote-name (car a))
	(time:print-universal-time (time:parse-universal-time (cadr a)) differences)
	(format differences " Author:~A~%" (caddr a))))
    (terpri differences)
    (format differences "The following files exist only on the local host.~%")
    (dolist (a file-list)
      (if (not a) a
	(format differences "~A Creation Date:"
		(funcall (car a) ':string-for-printing))
	(time:print-universal-time (get a ':creation-date) differences)
	(format differences " Author:~A~%" (get a ':author))))
    (terpri differences)
    (format differences "The following files are in conflict.~%")
    (dolist (a match)
      (let ((local (car a))
	    (remote (cadr a)))
	(cond ((and (= (time:parse-universal-time (cadr remote))
		       (get local ':creation-date))
		    (string-equal (caddr remote)
				  (get local ':author))))
	      (t
	       (format differences "~A Creation Date:"
		       (funcall (car local) ':string-for-printing))
	       (time:print-universal-time (get local ':creation-date) differences)
	       (format differences " Author:~A~%" (get local ':author))
	       (format differences "~A~A Creation Date:"
		       remote-name (car remote))
	       (time:print-universal-time (time:parse-universal-time (cadr remote))
					  differences)
	       (format differences " Author:~A~%" (caddr remote))
	       (terpri differences)))))))
	      
(defun compare-twenex-with-local (remote-dir local-dir &aux list)
  (get-directory remote-dir)
  (setq list (hack-twenex-dir))
  (compare-directories list local-dir remote-dir))

(defun compare-system-directories ()
  (dolist (dirs '(("SRC:<L.BENCH>" "SRC:BENCH;")
		  ("SRC:<L.CC>" "SRC:CC;")
		  ("SRC:<L.CHAOS>" "SRC:CHAOS;")
		  ("SRC:<L.DEMO>" "SRC:DEMO;")
		  ("SRC:<L.DOC>" "SRC:DOC;")
		  ("SRC:<L.FILE>" "SRC:FILE;")
		  ("SRC:<L.FILE2>" "SRC:FILE2;")
		  ("SRC:<L.FONTS>" "SRC:FONTS;")
		  ("SRC:<L.IO>" "SRC:IO;")
		  ("SRC:<L.IO1>" "SRC:IO1;")
		  ("SRC:<L.ISPELL>" "SRC:ISPELL;")
		  ("SRC:<L.MAIL>" "SRC:MAIL;")
		  ("SRC:<L.PATCH>" "SRC:PATCH;")
		  ("SRC:<L.SITE>" "SRC:SITE;")
		  ("SRC:<L.SYS>" "SRC:SYS;")
		  ("SRC:<L.SYS2>" "SRC:SYS2;")
		  ("SRC:<L.UBIN>" "SRC:UBIN;")
		  ("SRC:<L.UCADR>" "SRC:UCADR;")
		  ("SRC:<L.WIND>" "SRC:WIND;")
		  ("SRC:<L.WINDOW>" "SRC:WINDOW;")
		  ("SRC:<L.ZMAIL>" "SRC:ZMAIL;")
		  ("SRC:<L.ZWEI>" "SRC:ZWEI;")))
    (compare-twenex-with-local (car dirs) (cadr dirs))))