(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10)
(filecreated "30-Oct-87 16:20:30" {erinyes}<lispusers>lyric>simplechat.\;3 6810
|changes| |to:| (fns ttychat.typeout) (vars simplechatcoms)
|previous| |date:| "30-Oct-87 15:16:05" {erinyes}<lispusers>lyric>simplechat.\;1)
; Copyright (c) 1987 by Xerox Corporation. All rights reserved.
(prettycomprint simplechatcoms)
(rpaqq simplechatcoms ((fns ttychat ttychat.eosop ttychat.login ttychat.typeout ttychat.close) (vars (ttychat.ttbl nil)) (declare\: donteval@load doeval@compile dontcopy compilervars (addvars (nlama) (nlaml) (lama ttychat))))
)
(defineq
(ttychat
(cl:lambda (&optional host logoption) (* \; "Edited 30-Oct-87 15:14 by Masinter") (prog (connection streams openfn result) (or host (setq host defaultchathost)) (cond ((not (or host (setq host (promptforword "
Host: " nil "Enter name of host to chat to, or <cr> to abort" nil nil nil (charcode (cr)))))) (return nil))) (cond ((not (setq openfn (find.chat.protocol host))) (* \; "Don't know how to talk to this host") (return (concat "Unknown Chat host: " host))) ((not (setq streams (apply* (progn (setq host (car openfn)) (* \; "Value returned was (CanonicalHostName OpenFn)") (cadr openfn)) host))) (return "Failed")) (t (let* ((instream (car streams)) (outstream (cdr streams))) (streamprop instream (quote oldeosop) (|fetch| endofstreamop |of| instream)) (|replace| endofstreamop |of| instream |with| (function ttychat.eosop)) (cond ((not (fmemb host chat.allhosts)) (setq chat.allhosts (cons host chat.allhosts)) (setq chat.hostmenu))) (let (typeout (key (|fetch| (linebuffer keyboardstream) |of| \\linebuf.ofd)) ch (state (list (quote :terminal))) (okey \\currentkeyaction) (nkey nil)) (cl:unwind-protect (progn (cond ((eq key \\keyboard.stream) (setq \\currentkeyaction (setq nkey (let ((keyaction (keyactiontable \\defaultkeyaction))) (|for| pair |in| (currentinterrupts keyaction) |when| (leq (car pair) 255) |do| (intchar (car pair) nil nil keyaction)) (* \; " turn off all interrupts in charset 0") (|for| pair |in| chat.interrupts |do| (intchar (car pair) nil nil keyaction)) (|for| pair |in| chat.keyactions |do| (keyaction (car pair) (cdr pair) keyaction)) keyaction))))) (printout t "[Connected to " host ", type ↑] to escape]" t) (setq typeout (add.process (bquote (ttychat.typeout (quote (\\\, instream)) (quote (\\\, (getstream t (quote output)))) (quote (\\\, state)) (quote (\\\, (this.process))))) (quote name) (quote chat.typeout))) (and (neq logoption (quote none)) (ttychat.login instream outstream host logoption)) (prog nil wait-for-typein (cond ((null (car state)) (return nil))) (cond ((not (readp key)) (go wait))) got-char (setq ch (bin key)) (cond ((eq ch chat.controlchar) (setq ch (logand (bin key) 31))) ((eq ch chat.metachar) (setq ch (logor (bin key) 128))) ((eq ch (charcode "↑]")) (forceoutput outstream) (selectq (askuser nil nil "Chat command:" (quote ((b . "inary") (t . "ext") (c . "lose") (" ")))) (b (rplaca state (quote :binary))) (t (rplaca state (quote :terminal))) (c (return nil)) nil) (terpri t) (go no-char)) ((igeq ch \\maxthinchar) (cond ((eq (lrsh ch 8) 1) (setq ch (logor 128 (logand ch 127)))) (t (ringbells) (go no-char))))) (bout outstream ch) (cond ((readp key) (go got-char))) no-char (cond ((null (car state)) (* |;;| "check here 'cause the other process might have aborted") (return nil))) (forceoutput outstream) wait (cond ((null (car state)) (return nil))) (waitforinput 1000) (go wait-for-typein))) (* |;;| "here be unwind protect clauses ") (cond ((eq \\currentkeyaction nkey) (setq \\currentkeyaction okey))) (add.process (bquote (ttychat.close (quote (\\\, typeout)) (quote (\\\, instream)) (quote (\\\, outstream)))))))) (return host)))))
)
(ttychat.eosop
(lambda (stream) (* \; "Edited 30-Oct-87 13:32 by Masinter") (* |;;;| "Return -1 to indicate EOS to CHAT, and restore the streams EOS op incase it's needed for other things.") (|replace| endofstreamop |of| stream |with| (or (streamprop stream (quote eosop)) (function \\eoserror))) -1)
)
(ttychat.login
(lambda (instream outstream host option) (* \; "Edited 30-Oct-87 13:47 by Masinter") (prog ((ostype (getostype host)) (loginfo (gethostinfo host (quote loginfo))) name/pass com) (or loginfo (return)) (setq name/pass (\\internal/getpassword host nil nil nil nil ostype)) (setq com (cond (option) ((assoc (quote attach) loginfo) (or (chat.loginfo instream host (car name/pass)) (quote login))) (t (* \; "Don't know how to do anything but login, so silly to try anything else") (quote login)))) (cond ((null (setq loginfo (assoc com loginfo))) (|printout| promptwindow t "Login option " com " not implemented for this type of host")) (t (|for| x |in| (cdr loginfo) |do| (selectq x (cr (bout outstream (charcode cr)) (forceoutput outstream)) (lf (bout outstream (charcode lf)) (forceoutput outstream)) (username (prin3 (car name/pass) outstream)) (password (prin3 (\\decrypt.pwd (cdr name/pass)) outstream)) (wait (* \; "Some systems do not permit typeahead") (cond ((not (chat.flush&wait instream)) (* \; "Couldn't sync, so wait longer.") (dismiss chat.wait.time))) (dismiss chat.wait.time)) (prin3 x outstream))) (forceoutput outstream)))))
)
(ttychat.typeout
(lambda (instream terminal state proc) (* \; "Edited 30-Oct-87 16:19 by masinter") (settermtable (or ttychat.ttbl (setq ttychat.ttbl (let ((tt (copytermtable (quote orig)))) (|for| i |from| 0 |to| 31 |do| (echochar i (quote real) tt)) (echochar (charcode lf) (quote ignore) tt) tt)))) (let (msg ch last-char space-width) (or (equal (charwidth (charcode "i") terminal) (charwidth (charcode "W") terminal)) (dspfont defaultfont terminal)) (setq space-width (charwidth (charcode space) terminal)) (|while| (igeq (setq ch (bin instream)) 0) |do| (* \; "Print any protocol related msgs that might have come along while we where asleep") (if (eq (car state) (quote :binary)) then (bout terminal ch) else (selcharq ch (lf (|if| (eq last-char (charcode cr)) |then| (* \; " ignore ") nil)) (↑h (dspbackup space-width terminal)) (progn (setq last-char ch) (bout terminal ch)))))) (printout terminal "[Connection closed remotely]" t) (rplaca state nil) (* \; "tell other process we aborted") (wake.process proc t))
)
(ttychat.close
(lambda (typeout instream outstream) (* \; "Edited 30-Oct-87 14:39 by Masinter") (* |;;;| "Close the streams for a connection if they are open.") (del.process typeout) (cond ((openp instream) (closef instream))) (cond ((openp outstream) (closef outstream))))
)
)
(rpaqq ttychat.ttbl nil)
(declare\: donteval@load doeval@compile dontcopy compilervars
(addtovar nlama )
(addtovar nlaml )
(addtovar lama ttychat)
)
(putprops simplechat copyright ("Xerox Corporation" 1987))
(declare\: dontcopy
(filemap (nil (645 6558 (ttychat 655 . 3778) (ttychat.eosop 3780 . 4086) (ttychat.login 4088 . 5247) (
ttychat.typeout 5249 . 6275) (ttychat.close 6277 . 6556)))))
stop