github.com/Interlisp.medley
1
0
Fork 0
mirror of synced 2026-04-17 17:12:43 +00:00
Code Issues Projects Releases Wiki Activity

Update CHAT for MCCS

Browse Source
This commit is contained in:
rmkaplan
2025-10-11 13:34:56 -07:00
parent b747e0fca2
commit b27c9f6968
4 changed files with 277 additions and 72 deletions
Download Patch File Download Diff File Expand all files Collapse all files

260
library/CHAT
View File

@@ -1,18 +1,17 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "20-Jan-93 13:46:52" {DSK}<python>lde>lispcore>library>CHAT.;3 54346
changes to%: (RECORDS EMACSCOMMANDS)
(FILECREATED "11-Oct-2025 10:32:05" {WMEDLEY}<library>CHAT.;3 59585
previous date%: "21-Dec-92 10:50:12" {DSK}<python>lde>lispcore>library>CHAT.;2)
:EDIT-BY rmk
:CHANGES-TO (FNS CHAT.TYPEIN CHAT.TYPEOUT CHAT.INIT)
:PREVIOUS-DATE "20-Jan-93 13:46:52" {WMEDLEY}<library>CHAT.;1)
(* ; "
Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1992, 1993 by Venue & Xerox Corporation. All rights reserved.
")
(PRETTYCOMPRINT CHATCOMS)
(RPAQQ CHATCOMS
(RPAQQ CHATCOMS
[(COMS (* ; "CHAT typein")
(FNS CHAT CHAT.STARTUP CHAT.PROMPT.FOR.INPUT CHAT.CHOOSE.EMULATOR CHAT.SET.EMULATOR
CHAT.INIT FIND.CHAT.PROTOCOL CHAT.TYPEIN CHAT.BIN CHAT.CLOSE
@@ -73,7 +72,7 @@ Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1992, 1993 b
(P (SETQ BackgroundMenu))
(FILES DMCHAT)
(* ;
 "need DMCHAT since it's the default emulator")
 "need DMCHAT since it's the default emulator")
(INITRECORDS CHAT.STATE])
@@ -231,7 +230,8 @@ Host: " NIL "Enter name of host to chat to, or <cr> to abort" NIL NIL (QUOTE TTY
)
(CHAT.INIT
[LAMBDA (STREAMS WINDOW HOST DISPLAYTYPE) (* ; "Edited 11-Jun-90 14:37 by mitani")
[LAMBDA (STREAMS WINDOW HOST DISPLAYTYPE) (* ; "Edited 10-Oct-2025 12:01 by rmk")
(* ; "Edited 11-Jun-90 14:37 by mitani")
(LET* [(INSTREAM (CAR STREAMS))
(OUTSTREAM (CDR STREAMS))
(DPYNAME (fetch (CHATDISPLAYTYPE DPYNAME) of DISPLAYTYPE))
@@ -245,10 +245,8 @@ Host: " NIL "Enter name of host to chat to, or <cr> to abort" NIL NIL (QUOTE TTY
(WINDOWPROP WINDOW 'CHATSTATE STATE)
(COND
[(EQ DPYNAME 'TEDIT)
(replace (CHAT.STATE TEXTSTREAM) of STATE with
(TEDITSTREAM.INIT
WINDOW
(FUNCTION TEDITCHAT.MENUFN]
(replace (CHAT.STATE TEXTSTREAM) of STATE with (TEDITSTREAM.INIT WINDOW
(FUNCTION TEDITCHAT.MENUFN]
(T (WINDOWPROP WINDOW 'CURSORMOVEDFN NIL)
(WINDOWPROP WINDOW 'RESHAPEFN (FUNCTION CHAT.RESHAPEWINDOW))
(WINDOWPROP WINDOW 'BUTTONEVENTFN (FUNCTION CHAT.BUTTONFN))
@@ -257,7 +255,8 @@ Host: " NIL "Enter name of host to chat to, or <cr> to abort" NIL NIL (QUOTE TTY
(WINDOWPROP WINDOW 'WINDOWENTRYFN 'GIVE.TTY.PROCESS)
(WINDOWPROP WINDOW 'RIGHTBUTTONFN NIL)
(WINDOWPROP WINDOW 'CURSOROUTFN NIL)
(WINDOWPROP WINDOW 'SCROLLFN NIL)))
(WINDOWPROP WINDOW 'SCROLLFN NIL)
(MODERNWINDOW WINDOW)))
(WINDOWADDPROP WINDOW 'CLOSEFN (FUNCTION CHAT.CLOSEFN))
(WINDOWPROP WINDOW 'ICONWINDOW NIL)
(WINDOWPROP WINDOW 'ICONFN (FUNCTION CHAT.ICONFN))
@@ -270,8 +269,97 @@ Host: " NIL "Enter name of host to chat to, or <cr> to abort" NIL NIL (QUOTE TTY
)
(CHAT.TYPEIN
(LAMBDA (HOST WINDOW LOGOPTION INITSTREAM) (* ; "Edited 15-Feb-90 12:18 by bvm") (DECLARE (SPECVARS STREAM)) (* ; "so that menu can change it") (PROG* ((THISPROC (THIS.PROCESS)) (DEFAULTSTREAM T) (STATE (WINDOWPROP WINDOW (QUOTE CHATSTATE))) (CHATSTREAM (fetch (CHAT.STATE OUTSTREAM) of STATE)) (INSTREAM (fetch (CHAT.STATE INSTREAM) of STATE)) STREAM CH CHATPROMPTWINDOW LOCALECHOSTREAM) (RESETSAVE NIL (LIST (FUNCTION (LAMBDA (WINDOW) (AND RESETSTATE (NEQ RESETSTATE (QUOTE HARDRESET)) (CHAT.CLOSE WINDOW T)))) WINDOW)) (* ; "If an error occurs, or process is killed, this will flush the connection etc") (IF (NEQ LOGOPTION (QUOTE HARDRESET)) THEN (* ; "Only do this the first time") (LET ((DISPLAYTYPE (STREAMPROP INSTREAM (QUOTE DISPLAYTYPE))) DISPLAYNAME) (COND (DISPLAYTYPE (CHAT.SETDISPLAYTYPE INSTREAM (fetch (CHATDISPLAYTYPE DPYCODE) of DISPLAYTYPE) (SETQ DISPLAYNAME (fetch (CHATDISPLAYTYPE DPYNAME) of DISPLAYTYPE))))) (CHAT.SCREENPARAMS STATE INSTREAM WINDOW) (replace (CHAT.STATE TYPEOUTPROC) of STATE with (ADD.PROCESS (BQUOTE (CHAT.TYPEOUT (\, WINDOW) (QUOTE (\, DISPLAYNAME)) (QUOTE (\, STATE)))) (QUOTE NAME) (QUOTE CHAT.TYPEOUT) (QUOTE RESTARTABLE) (QUOTE HARDRESET))) (AND (NEQ LOGOPTION (QUOTE NONE)) (CHAT.LOGIN HOST LOGOPTION WINDOW STATE)) (COND (INITSTREAM (NLSETQ (SETQ STREAM (COND ((STRINGP INITSTREAM) (OPENSTRINGSTREAM INITSTREAM)) (T (OPENSTREAM INITSTREAM (QUOTE INPUT)))))))))) (TTYDISPLAYSTREAM WINDOW) (* ; "So that \TTYBACKGROUND flashes the caret where we expect") (bind OUTPUTSTREAM while (EQ (fetch (CHAT.STATE RUNNING?) of STATE) T) do (COND ((NULL STREAM) (SETQ STREAM DEFAULTSTREAM))) (SETQ OUTPUTSTREAM (if (fetch (CHAT.STATE LOCALECHO) of STATE) then (OR LOCALECHOSTREAM (SETQ LOCALECHOSTREAM (CL:MAKE-BROADCAST-STREAM CHATSTREAM (GETSTREAM WINDOW (QUOTE OUTPUT))))) else CHATSTREAM)) (COND ((EQ STREAM T) (* ;; "Handle terminal specially") (OR (TTY.PROCESSP) (\WAIT.FOR.TTY)) (COND ((\SYSBUFP) (do (SETQ CH (\GETKEY)) (COND ((<= CH \MAXTHINCHAR) (BOUT OUTPUTSTREAM CH)) ((EQ (LRSH CH 8) 1) (* ; "META char set => ascii meta") (BOUT OUTPUTSTREAM (LOGOR 128 (LOGAND CH 127)))) (T (* ; "Not in charset zero, not a meta. Most hosts don't understand.(PRINTCCODE CH CHATSTREAM) (CHARSET CHATSTREAM 0)") (FLASHWINDOW WINDOW))) repeatwhile (\SYSBUFP)) (FORCEOUTPUT CHATSTREAM)))) (T (until (EOFP STREAM) do (BOUT OUTPUTSTREAM (\BIN STREAM))) (FORCEOUTPUT CHATSTREAM) (CLOSEF STREAM) (SETQ STREAM) (COND ((SETQ CHATPROMPTWINDOW (GETPROMPTWINDOW WINDOW NIL NIL T)) (* ; "Indicate completion of Input if came from menu command") (CLEARW CHATPROMPTWINDOW))))) (\TTYBACKGROUND)) (* ;; "Get here if we close connection.") (SELECTQ (fetch (CHAT.STATE RUNNING?) of STATE) (CLOSE (CHAT.CLOSE WINDOW)) (ABORT (CHAT.CLOSE WINDOW T)) (NIL (* ; "Already dead.")) (SHOULDNT (CONCAT "Unknown state in CHAT: " (fetch (CHAT.STATE RUNNING?) of STATE)))) (BLOCK)))
)
[LAMBDA (HOST WINDOW LOGOPTION INITSTREAM) (* ; "Edited 11-Oct-2025 10:30 by rmk")
(* ; "Edited 15-Feb-90 12:18 by bvm")
(DECLARE (SPECVARS STREAM)) (* ; "so that menu can change it")
(PROG* ((THISPROC (THIS.PROCESS))
(DEFAULTSTREAM T)
(STATE (WINDOWPROP WINDOW 'CHATSTATE))
(CHATSTREAM (fetch (CHAT.STATE OUTSTREAM) of STATE))
(INSTREAM (fetch (CHAT.STATE INSTREAM) of STATE))
STREAM CH CHATPROMPTWINDOW LOCALECHOSTREAM)
(RESETSAVE NIL (LIST [FUNCTION (LAMBDA (WINDOW)
(AND RESETSTATE (NEQ RESETSTATE 'HARDRESET)
(CHAT.CLOSE WINDOW T]
WINDOW)) (* ;
 "If an error occurs, or process is killed, this will flush the connection etc")
[IF (NEQ LOGOPTION 'HARDRESET)
THEN (* ; "Only do this the first time")
(LET ((DISPLAYTYPE (STREAMPROP INSTREAM 'DISPLAYTYPE))
DISPLAYNAME)
[COND
(DISPLAYTYPE (CHAT.SETDISPLAYTYPE INSTREAM (fetch (CHATDISPLAYTYPE
DPYCODE)
of DISPLAYTYPE)
(SETQ DISPLAYNAME (fetch (CHATDISPLAYTYPE DPYNAME)
of DISPLAYTYPE]
(CHAT.SCREENPARAMS STATE INSTREAM WINDOW)
(replace (CHAT.STATE TYPEOUTPROC) of STATE
with (ADD.PROCESS `(CHAT.TYPEOUT ,WINDOW ',DISPLAYNAME
',STATE)
'NAME
'CHAT.TYPEOUT
'RESTARTABLE
'HARDRESET))
(AND (NEQ LOGOPTION 'NONE)
(CHAT.LOGIN HOST LOGOPTION WINDOW STATE))
(COND
(INITSTREAM (NLSETQ (SETQ STREAM (COND
((STRINGP INITSTREAM)
(OPENSTRINGSTREAM INITSTREAM))
(T (OPENSTREAM INITSTREAM
'INPUT]
(TTYDISPLAYSTREAM WINDOW) (* ;
 "So that \TTYBACKGROUND flashes the caret where we expect")
(bind OUTPUTSTREAM while (EQ (fetch (CHAT.STATE RUNNING?) of STATE)
T)
do (COND
((NULL STREAM)
(SETQ STREAM DEFAULTSTREAM)))
(SETQ OUTPUTSTREAM (if (fetch (CHAT.STATE LOCALECHO) of STATE)
then [OR LOCALECHOSTREAM (SETQ LOCALECHOSTREAM
(CL:MAKE-BROADCAST-STREAM
CHATSTREAM
(GETSTREAM WINDOW 'OUTPUT]
else CHATSTREAM))
[COND
[(EQ STREAM T)
(* ;; "Handle terminal specially")
(OR (TTY.PROCESSP)
(\WAIT.FOR.TTY))
(COND
((\SYSBUFP)
(do (SETQ CH (MTOUCODE (\GETKEY)))
(COND
((<= CH \MAXTHINCHAR)
(BOUT OUTPUTSTREAM CH))
[(EQ (LRSH CH 8)
1) (* ; "META char set => ascii meta")
(BOUT OUTPUTSTREAM (LOGOR 128 (LOGAND CH 127]
(T (* ; "Not in charset zero, not a meta. Most hosts don't understand.(PRINTCCODE CH CHATSTREAM) (CHARSET CHATSTREAM 0)")
(FLASHWINDOW WINDOW))) repeatwhile (\SYSBUFP))
(FORCEOUTPUT CHATSTREAM]
(T (until (EOFP STREAM) do (BOUT OUTPUTSTREAM (\BIN STREAM)))
(FORCEOUTPUT CHATSTREAM)
(CLOSEF STREAM)
(SETQ STREAM)
(COND
((SETQ CHATPROMPTWINDOW (GETPROMPTWINDOW WINDOW NIL NIL T))
(* ;
 "Indicate completion of Input if came from menu command")
(CLEARW CHATPROMPTWINDOW]
(\TTYBACKGROUND))
(* ;; "Get here if we close connection.")
[SELECTQ (fetch (CHAT.STATE RUNNING?) of STATE)
(CLOSE (CHAT.CLOSE WINDOW))
(ABORT (CHAT.CLOSE WINDOW T))
(NIL (* ; "Already dead."))
(SHOULDNT (CONCAT "Unknown state in CHAT: " (fetch (CHAT.STATE RUNNING?) of STATE]
(BLOCK])
(CHAT.BIN
(LAMBDA (OUTSTREAM STATE) (* rda%: "20-Aug-84 23:09") (until (\SYSBUFP) bind (FIRSTTIME _ T) do (COND (FIRSTTIME (FORCEOUTPUT OUTSTREAM) (SETQ FIRSTTIME NIL))) (\TTYBACKGROUND)) (\GETKEY))
@@ -308,11 +396,10 @@ Host: " NIL "Enter name of host to chat to, or <cr> to abort" NIL NIL (QUOTE TTY
(DEFGLOBALVAR CHAT.HOSTINFO NIL
"A-list of (host . proplist) for Chat. Only recognized prop for now is :KEYACTIONS.")
(DEFGLOBALVAR CHAT.OSTYPES '([UNIX :KEYACTIONS ((BS (127 127]
(* ;
 "make the BS key send DEL when talking to UNIX hosts")
)
"A-list of (host . proplist). Only recognized prop is :KEYACTIONS.")
(DEFGLOBALVAR CHAT.OSTYPES '([UNIX :KEYACTIONS ((BS (127 127](* ;
 "make the BS key send DEL when talking to UNIX hosts")
)
"A-list of (host . proplist). Only recognized prop is :KEYACTIONS.")
(DEFGLOBALVAR CHAT.PROTOCOL.ABBREVS NIL
"A-list of (abbrev . protocol) for use in the host/x syntax.")
@@ -321,7 +408,7 @@ Host: " NIL "Enter name of host to chat to, or <cr> to abort" NIL NIL (QUOTE TTY
"List of hosts to Chat to (clear CHAT.HOSTMENU if you change this).")
(CL:DEFVAR CHAT.DISPLAYTYPES '((NIL 10 DM2500))
"List of triples (host code driver) telling the preferred driver (a symbol) for host. Code is numeric value for use with PupChat. Host = NIL gives default preference."
"List of triples (host code driver) telling the preferred driver (a symbol) for host. Code is numeric value for use with PupChat. Host = NIL gives default preference."
)
(DEFGLOBALVAR CHAT.FONT NIL
@@ -381,15 +468,15 @@ Host: " NIL "Enter name of host to chat to, or <cr> to abort" NIL NIL (QUOTE TTY
"A-list of (ostype . loginfo), where loginfo is a plist specifying what to send for different logging commands: LOGIN, ATTACH, or WHERE. Each property value is a list of strings mixed with the symbols USERNAME, PASSWORD, WAIT, CR, LF."
)
(PUTPROPS CHAT.OSTYPES VARTYPE ALIST)
(PUTPROPS CHAT.OSTYPES VARTYPE ALIST)
(PUTPROPS CHAT.HOSTINFO VARTYPE ALIST)
(PUTPROPS CHAT.HOSTINFO VARTYPE ALIST)
(PUTPROPS NETWORKLOGINFO VARTYPE ALIST)
(PUTPROPS NETWORKLOGINFO VARTYPE ALIST)
(PUTPROPS CHAT.PROTOCOL.ABBREVS VARTYPE ALIST)
(PUTPROPS CHAT.PROTOCOL.ABBREVS VARTYPE ALIST)
(PUTPROPS CHAT.PROTOCOLTYPES VARTYPE ALIST)
(PUTPROPS CHAT.PROTOCOLTYPES VARTYPE ALIST)
@@ -438,8 +525,77 @@ Host: " NIL "Enter name of host to chat to, or <cr> to abort" NIL NIL (QUOTE TTY
(DEFINEQ
(CHAT.TYPEOUT
(LAMBDA (WINDOW DPYNAME CHAT.STATE) (* ; "Edited 12-Aug-88 10:35 by drc:") (bind (CNT _ 1) (HANDLECHARFN _ (CADR (FASSOC DPYNAME CHAT.DRIVERTYPES))) (INSTREAM _ (fetch (CHAT.STATE INSTREAM) of CHAT.STATE)) (TERM.STATE _ (FETCH (CHAT.STATE TERM.STATE) of CHAT.STATE)) (TYPEIN.PROCESS _ (WINDOWPROP WINDOW (QUOTE PROCESS))) (OUTSTREAM _ (COND ((EQ DPYNAME (QUOTE TEDIT)) (WINDOWPROP WINDOW (QUOTE TEXTSTREAM))) (T (WINDOWPROP WINDOW (QUOTE DSP))))) TYPESCRIPTSTREAM CRPENDING MSG CH first (IF (NOT TERM.STATE) THEN (* ; "First time, ask terminal to get itself set up") (replace (CHAT.STATE TERM.STATE) of CHAT.STATE with (SETQ TERM.STATE (CL:FUNCALL (CADDR (FASSOC DPYNAME CHAT.DRIVERTYPES)) CHAT.STATE)))) (* ; "TERM.HOME CHAT.STATE") while (IGEQ (SETQ CH (BIN INSTREAM)) 0) do (while (fetch (CHAT.STATE HELD) of CHAT.STATE) do (BLOCK)) (\CHECKCARET OUTSTREAM) (COND ((SETQ MSG (GETSTREAMPROP INSTREAM (QUOTE MESSAGE))) (PRIN1 MSG OUTSTREAM) (PUTSTREAMPROP INSTREAM (QUOTE MESSAGE) NIL))) (* ; "Print any protocol related msgs that might have come along while we where asleep") (SPREADAPPLY* HANDLECHARFN (SETQ CH (LOGAND CH (MASK.1'S 0 7))) CHAT.STATE TERM.STATE) (COND ((SETQ TYPESCRIPTSTREAM (fetch (CHAT.STATE TYPESCRIPTSTREAM) of CHAT.STATE)) (COND ((SELCHARQ CH (CR (PROG1 CRPENDING (SETQ CRPENDING T))) (LF (COND (CRPENDING (\OUTCHAR TYPESCRIPTSTREAM (CHARCODE EOL)) (* ; "Have the typescript turn crlf into whatever it likes for eol") (SETQ CRPENDING NIL)) (T T))) (PROGN (COND (CRPENDING (\BOUT TYPESCRIPTSTREAM (CHARCODE CR)) (SETQ CRPENDING NIL))) T)) (\BOUT TYPESCRIPTSTREAM CH))))) (COND (CHATDEBUGFLG (COND ((OR (EQ CHATDEBUGFLG T) (IGREATERP (add CNT 1) CHATDEBUGFLG)) (BLOCK) (SETQ CNT 1))))) (COND ((AND (TTY.PROCESSP TYPEIN.PROCESS) (OR \LONGSYSBUF (NEQ 0 (fetch (RING READ) of \SYSBUFFER)))) (* ;; "block if there's any type ahead to make sure we see keyboard input in case the output stream never blocks.") (BLOCK))) finally (SELECTQ CH (-1 (CHAT.TYPEOUT.CLOSE WINDOW OUTSTREAM CHAT.STATE (QUOTE CLOSE) "closed")) (-2 (CHAT.TYPEOUT.CLOSE WINDOW OUTSTREAM CHAT.STATE (QUOTE ABORT) "aborted")) (CHAT.TYPEOUT.CLOSE WINDOW OUTSTREAM CHAT.STATE (QUOTE CLOSE) "closed somehow")) (COND ((NOT (OPENWP WINDOW)) (DEL.PROCESS (WINDOWPROP WINDOW (QUOTE PROCESS)))))))
)
[LAMBDA (WINDOW DPYNAME CHAT.STATE) (* ; "Edited 10-Oct-2025 22:38 by rmk")
(* ; "Edited 12-Aug-88 10:35 by drc:")
(bind (CNT _ 1)
(HANDLECHARFN _ (CADR (FASSOC DPYNAME CHAT.DRIVERTYPES)))
(INSTREAM _ (fetch (CHAT.STATE INSTREAM) of CHAT.STATE))
(TERM.STATE _ (FETCH (CHAT.STATE TERM.STATE) of CHAT.STATE))
(TYPEIN.PROCESS _ (WINDOWPROP WINDOW 'PROCESS))
[OUTSTREAM _ (COND
((EQ DPYNAME 'TEDIT)
(WINDOWPROP WINDOW 'TEXTSTREAM))
(T (WINDOWPROP WINDOW 'DSP]
TYPESCRIPTSTREAM CRPENDING MSG CH
first [IF (NOT TERM.STATE)
THEN (* ;
 "First time, ask terminal to get itself set up")
(replace (CHAT.STATE TERM.STATE) of CHAT.STATE
with (SETQ TERM.STATE (CL:FUNCALL (CADDR (FASSOC DPYNAME CHAT.DRIVERTYPES))
CHAT.STATE]
(* ; "TERM.HOME CHAT.STATE")
while (IGEQ (SETQ CH (BIN INSTREAM))
0) do (while (fetch (CHAT.STATE HELD) of CHAT.STATE) do (BLOCK))
(\CHECKCARET OUTSTREAM)
(COND
((SETQ MSG (GETSTREAMPROP INSTREAM 'MESSAGE))
(PRIN1 MSG OUTSTREAM)
(PUTSTREAMPROP INSTREAM 'MESSAGE NIL)))
(* ;
 "Print any protocol related msgs that might have come along while we where asleep")
(SPREADAPPLY* HANDLECHARFN (SETQ CH (LOGAND CH (MASK.1'S 0 7)))
CHAT.STATE TERM.STATE)
[COND
((SETQ TYPESCRIPTSTREAM (fetch (CHAT.STATE TYPESCRIPTSTREAM) of
CHAT.STATE
))
(COND
((SELCHARQ CH
(CR (PROG1 CRPENDING (SETQ CRPENDING T)))
(LF (COND
(CRPENDING (\OUTCHAR TYPESCRIPTSTREAM (CHARCODE EOL))
(* ;
 "Have the typescript turn crlf into whatever it likes for eol")
(SETQ CRPENDING NIL))
(T T)))
(PROGN (COND
(CRPENDING (\BOUT TYPESCRIPTSTREAM (CHARCODE CR))
(SETQ CRPENDING NIL)))
T))
(\BOUT TYPESCRIPTSTREAM (UTOMCODE CH]
[COND
(CHATDEBUGFLG (COND
((OR (EQ CHATDEBUGFLG T)
(IGREATERP (add CNT 1)
CHATDEBUGFLG))
(BLOCK)
(SETQ CNT 1]
(COND
([AND (TTY.PROCESSP TYPEIN.PROCESS)
(OR \LONGSYSBUF (NEQ 0 (fetch (RING READ) of \SYSBUFFER]
(* ;; "block if there's any type ahead to make sure we see keyboard input in case the output stream never blocks.")
(BLOCK))) finally (SELECTQ CH
(-1 (CHAT.TYPEOUT.CLOSE WINDOW OUTSTREAM
CHAT.STATE 'CLOSE "closed"))
(-2 (CHAT.TYPEOUT.CLOSE WINDOW OUTSTREAM
CHAT.STATE 'ABORT "aborted"))
(CHAT.TYPEOUT.CLOSE WINDOW OUTSTREAM CHAT.STATE
'CLOSE "closed somehow"))
(COND
((NOT (OPENWP WINDOW))
(DEL.PROCESS (WINDOWPROP WINDOW 'PROCESS])
(CHAT.TYPEOUT.CLOSE
(LAMBDA (WINDOW OUTSTREAM CHAT.STATE NEWSTATE MSG) (* ; "Edited 9-Nov-89 14:55 by bvm") (COND ((OPENWP WINDOW) (printout OUTSTREAM T "[Connection " MSG " by remote host]" T))) (replace (CHAT.STATE RUNNING?) of CHAT.STATE with NEWSTATE) (LET ((CHATPROC (WINDOWPROP WINDOW (QUOTE PROCESS)))) (if (AND CHATPROC (NOT (TTY.PROCESSP CHATPROC))) then (* ;; "Ordinarily, typein process notices that we've closed and will gracefully clean up, but currently it's hung waiting for tty. I could give it the tty explicitly, but that might disrupt the user's typing to some other process right now, especially if (tty.process t) chooses not to give it back to the same place. So we'll just explicitly kill it (it does have a cleanup form to handle closing the window, etc).") (DEL.PROCESS CHATPROC))))
@@ -551,7 +707,7 @@ Host: " NIL "Enter name of host to chat to, or <cr> to abort" NIL NIL (QUOTE TTY
)
(DEFGLOBALVAR CHAT.EMACSCOMMANDS '(21 16 14 6 1)
"List of 5 character codes that perform Emacs functions Arg, Up 1 Line, Down 1 Line, Forward Character, Beginning of Line"
"List of 5 character codes that perform Emacs functions Arg, Up 1 Line, Down 1 Line, Forward Character, Beginning of Line"
)
(DEFINEQ
@@ -614,11 +770,9 @@ Host: " NIL "Enter name of host to chat to, or <cr> to abort" NIL NIL (QUOTE TTY
(DECLARE%: DONTEVAL@LOAD DOCOPY
(ADDTOVAR BackgroundMenuCommands ("Chat" '(\SPAWN.CHAT)
"Runs a new CHAT process; prompts for host"
(SUBITEMS ("No Login" '(\SPAWN.CHAT 'NONE)
"Runs CHAT without doing automatic login"
))))
"Runs a new CHAT process; prompts for host"
(SUBITEMS ("No Login" '(\SPAWN.CHAT 'NONE)
"Runs CHAT without doing automatic login"))))
(SETQ BackgroundMenu)
@@ -668,24 +822,22 @@ Host: " NIL "Enter name of host to chat to, or <cr> to abort" NIL NIL (QUOTE TTY
(CHAT.STATE 44 POINTER))
'46)
)
(PUTPROPS CHAT COPYRIGHT ("Venue & Xerox Corporation" 1982 1983 1984 1985 1986 1987 1988 1989 1990
1992 1993))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (4424 27453 (CHAT 4434 . 6212) (CHAT.STARTUP 6214 . 14801) (CHAT.PROMPT.FOR.INPUT 14803
. 15726) (CHAT.CHOOSE.EMULATOR 15728 . 16259) (CHAT.SET.EMULATOR 16261 . 17240) (CHAT.INIT 17242 .
19217) (FIND.CHAT.PROTOCOL 19219 . 19577) (CHAT.TYPEIN 19579 . 22480) (CHAT.BIN 22482 . 22686) (
CHAT.CLOSE 22688 . 24999) (CHAT.DEACTIVATE.WINDOW 25001 . 25353) (CHAT.CLOSEFN 25355 . 25558) (
CHAT.CLOSE.CONNECTION 25560 . 25799) (CHAT.LOGIN 25801 . 27451)) (31396 33372 (ADD.CHAT.MESSAGE 31406
. 31572) (CHAT.LOGINFO 31574 . 31808) (CHAT.SENDSCREENPARAMS 31810 . 32083) (CHAT.SETDISPLAYTYPE
32085 . 32410) (CHAT.FLUSH&WAIT 32412 . 32632) (CHAT.ENDOFSTREAMOP 32634 . 33074) (CHAT.OPTIONMENU
33076 . 33370)) (33402 37669 (CHAT.TYPEOUT 33412 . 35706) (CHAT.TYPEOUT.CLOSE 35708 . 36524) (
CHAT.DID.RESHAPE 36526 . 36809) (CHAT.SCREENPARAMS 36811 . 37667)) (37699 45838 (GETCHATWINDOW 37709
. 38663) (CHAT.BUTTONFN 38665 . 39113) (CHAT.HOLD 39115 . 39490) (CHAT.MENU 39492 . 41589) (
CHAT.CLEAR.FROM.MENU 41591 . 41747) (CHAT.TAKE.INPUT 41749 . 41917) (CHAT.TAKE.INPUT1 41919 . 42548) (
DO.CHAT.OPTION 42550 . 42846) (CHAT.RECONNECT 42848 . 43524) (CHAT.RECONNECT.OFF 43526 . 43815) (
CHAT.RESHAPEWINDOW 43817 . 44594) (CHAT.TTYENTRYFN 44596 . 44843) (CHAT.TTYEXITFN 44845 . 44925) (
CHAT.TYPESCRIPT 44927 . 45128) (CHAT.TYPESCRIPT1 45130 . 45836)) (45868 46637 (
CHAT.CHOOSE.PHONE.NUMBER 45878 . 46635)) (46742 48495 (CHAT.EMACS.MOVE 46752 . 48174) (
CHAT.SWITCH.EMACS 48176 . 48493)) (48712 49215 (CHAT.ICONFN 48722 . 49213)) (51928 52142 (\SPAWN.CHAT
51938 . 52140)))))
(FILEMAP (NIL (4288 30348 (CHAT 4298 . 6076) (CHAT.STARTUP 6078 . 14665) (CHAT.PROMPT.FOR.INPUT 14667
. 15590) (CHAT.CHOOSE.EMULATOR 15592 . 16123) (CHAT.SET.EMULATOR 16125 . 17104) (CHAT.INIT 17106 .
19106) (FIND.CHAT.PROTOCOL 19108 . 19466) (CHAT.TYPEIN 19468 . 25375) (CHAT.BIN 25377 . 25581) (
CHAT.CLOSE 25583 . 27894) (CHAT.DEACTIVATE.WINDOW 27896 . 28248) (CHAT.CLOSEFN 28250 . 28453) (
CHAT.CLOSE.CONNECTION 28455 . 28694) (CHAT.LOGIN 28696 . 30346)) (34239 36215 (ADD.CHAT.MESSAGE 34249
. 34415) (CHAT.LOGINFO 34417 . 34651) (CHAT.SENDSCREENPARAMS 34653 . 34926) (CHAT.SETDISPLAYTYPE
34928 . 35253) (CHAT.FLUSH&WAIT 35255 . 35475) (CHAT.ENDOFSTREAMOP 35477 . 35917) (CHAT.OPTIONMENU
35919 . 36213)) (36245 43159 (CHAT.TYPEOUT 36255 . 41196) (CHAT.TYPEOUT.CLOSE 41198 . 42014) (
CHAT.DID.RESHAPE 42016 . 42299) (CHAT.SCREENPARAMS 42301 . 43157)) (43189 51328 (GETCHATWINDOW 43199
. 44153) (CHAT.BUTTONFN 44155 . 44603) (CHAT.HOLD 44605 . 44980) (CHAT.MENU 44982 . 47079) (
CHAT.CLEAR.FROM.MENU 47081 . 47237) (CHAT.TAKE.INPUT 47239 . 47407) (CHAT.TAKE.INPUT1 47409 . 48038) (
DO.CHAT.OPTION 48040 . 48336) (CHAT.RECONNECT 48338 . 49014) (CHAT.RECONNECT.OFF 49016 . 49305) (
CHAT.RESHAPEWINDOW 49307 . 50084) (CHAT.TTYENTRYFN 50086 . 50333) (CHAT.TTYEXITFN 50335 . 50415) (
CHAT.TYPESCRIPT 50417 . 50618) (CHAT.TYPESCRIPT1 50620 . 51326)) (51358 52127 (
CHAT.CHOOSE.PHONE.NUMBER 51368 . 52125)) (52232 53985 (CHAT.EMACS.MOVE 52242 . 53664) (
CHAT.SWITCH.EMACS 53666 . 53983)) (54198 54701 (CHAT.ICONFN 54208 . 54699)) (57414 57628 (\SPAWN.CHAT
57424 . 57626)))))
STOP

BIN
library/CHAT.LCOM
View File

Binary file not shown.

89
library/CHATTERMINAL
View File

@@ -1,14 +1,13 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED " 4-Jul-90 02:21:01" |{PELE:MV:ENVOS}<LISPCORE>LIBRARY>CHATTERMINAL.;3| 20832
changes to%: (VARS CHATTERMINALCOMS)
(FILECREATED "11-Oct-2025 10:28:04" {WMEDLEY}<library>CHATTERMINAL.;2 22325
previous date%: "14-Jun-90 15:57:05" {DSK}<users>sybalsky>bane>chatterminal.;1)
:EDIT-BY rmk
:CHANGES-TO (FNS TERM.PRINTCHAR)
:PREVIOUS-DATE " 4-Jul-90 02:21:01" {WMEDLEY}<library>CHATTERMINAL.;1)
(* ; "
Copyright (c) 1984, 1985, 1986, 1987, 1988, 1990 by VENUE & Xerox Corporation. All rights reserved.
")
(PRETTYCOMPRINT CHATTERMINALCOMS)
@@ -93,8 +92,63 @@ Copyright (c) 1984, 1985, 1986, 1987, 1988, 1990 by VENUE & Xerox Corporation.
)
(TERM.PRINTCHAR
(LAMBDA (CHAT.STATE CHAR WRAPFN) (* ; "Edited 2-Sep-88 10:35 by jds") (* ;;; "Print a character. If this char fills the last position on the line, then the next action is determined by WRAPFN: if it is given, we call it with CHAT.STATE as arg. Otherwise, if WRAPMODE is on in the state, we perform an explict newline, else we peg at the right margin.") (LET* ((DSP (ffetch (CHAT.STATE DSP) of (\DTEST CHAT.STATE (QUOTE CHAT.STATE)))) (DISPLAYDATA (fetch (STREAM IMAGEDATA) of DSP)) (XPOS (ffetch (CHAT.STATE XPOS) of CHAT.STATE)) IMAGEWIDTH CHARWIDTH) (if (NEQ (ffetch (\DISPLAYDATA DDCHARSET) of DISPLAYDATA) (\CHARSET CHAR)) then (* ;; "The display stream's caches are invalid. Fix them up for the new character set (this also cleans up after font changes, etc, and at initial window opening)") (\CHANGECHARSET.DISPLAY DISPLAYDATA (\CHARSET CHAR))) (* ;; "These two SETQs can't be in the LET* because the charset change may need to happen first:") (SETQ IMAGEWIDTH (\DSPGETCHARIMAGEWIDTH CHAR DISPLAYDATA)) (SETQ CHARWIDTH (\DSPGETCHARWIDTH CHAR DISPLAYDATA)) (if (NEQ IMAGEWIDTH CHARWIDTH) then (* ;; "Take care of the case where the character's image isn't the same as its escapement, by filling in the background properly for the intervening space. We wouldn't have to worry about this nonsense if ns fonts did their character bitmaps properly.") (\BLTSHADE.DISPLAY (CASE (fetch DDSOURCETYPE of DISPLAYDATA) (INVERT BLACKSHADE) (T WHITESHADE)) DSP (+ XPOS IMAGEWIDTH) (- (ffetch (CHAT.STATE YPOS) of CHAT.STATE) (ffetch (CHAT.STATE FONTDESCENT) of CHAT.STATE)) (- CHARWIDTH IMAGEWIDTH) (ffetch (CHAT.STATE FONTHEIGHT) of CHAT.STATE))) (\BLTCHAR CHAR DSP DISPLAYDATA) (if (ffetch (CHAT.STATE UNDERLINEMODE) of CHAT.STATE) then (* ; "Underline what we just drew") (\BLTSHADE.DISPLAY BLACKSHADE DSP XPOS (- (ffetch (CHAT.STATE YPOS) of CHAT.STATE) CHAT.UNDERLINE.DESCENT) CHARWIDTH 1 (QUOTE INVERT))) (if (>= (freplace (CHAT.STATE XPOS) of CHAT.STATE with (+ XPOS (ffetch (CHAT.STATE FONTWIDTH) of CHAT.STATE))) (ffetch (CHAT.STATE TTYWIDTH) of CHAT.STATE)) then (* ; "Have reached right margin, so wrap around") (if WRAPFN then (* ; "Terminal-specific wrap handler") (CL:FUNCALL WRAPFN CHAT.STATE) elseif (ffetch (CHAT.STATE WRAPMODE) of CHAT.STATE) then (TERM.NEWLINE CHAT.STATE) else (* ; "No, don't wrap--stay on the last character") (MOVETO (freplace (CHAT.STATE XPOS) of CHAT.STATE with XPOS) (ffetch (CHAT.STATE YPOS) of CHAT.STATE) DSP)))))
)
[LAMBDA (CHAT.STATE CHAR WRAPFN) (* ; "Edited 10-Oct-2025 22:37 by rmk")
(* ; "Edited 2-Sep-88 10:35 by jds")
(* ;;; "Print a character. If this char fills the last position on the line, then the next action is determined by WRAPFN: if it is given, we call it with CHAT.STATE as arg. Otherwise, if WRAPMODE is on in the state, we perform an explict newline, else we peg at the right margin.")
(SETQ CHAR (UTOMCODE CHAR))
(LET* ([DSP (ffetch (CHAT.STATE DSP) of (\DTEST CHAT.STATE 'CHAT.STATE]
(DISPLAYDATA (fetch (STREAM IMAGEDATA) of DSP))
(XPOS (ffetch (CHAT.STATE XPOS) of CHAT.STATE))
IMAGEWIDTH CHARWIDTH)
(if (NEQ (ffetch (\DISPLAYDATA DDCHARSET) of DISPLAYDATA)
(\CHARSET CHAR))
then
(* ;; "The display stream's caches are invalid. Fix them up for the new character set (this also cleans up after font changes, etc, and at initial window opening)")
(\CHANGECHARSET.DISPLAY DISPLAYDATA (\CHARSET CHAR)))
(* ;;
 "These two SETQs can't be in the LET* because the charset change may need to happen first:")
(SETQ IMAGEWIDTH (\DSPGETCHARIMAGEWIDTH CHAR DISPLAYDATA))
(SETQ CHARWIDTH (\DSPGETCHARWIDTH CHAR DISPLAYDATA))
(if (NEQ IMAGEWIDTH CHARWIDTH)
then
(* ;; "Take care of the case where the character's image isn't the same as its escapement, by filling in the background properly for the intervening space. We wouldn't have to worry about this nonsense if ns fonts did their character bitmaps properly.")
(\BLTSHADE.DISPLAY (CASE (fetch DDSOURCETYPE of DISPLAYDATA)
(INVERT BLACKSHADE)
(T WHITESHADE))
DSP
(+ XPOS IMAGEWIDTH)
(- (ffetch (CHAT.STATE YPOS) of CHAT.STATE)
(ffetch (CHAT.STATE FONTDESCENT) of CHAT.STATE))
(- CHARWIDTH IMAGEWIDTH)
(ffetch (CHAT.STATE FONTHEIGHT) of CHAT.STATE)))
(\BLTCHAR CHAR DSP DISPLAYDATA)
(if (ffetch (CHAT.STATE UNDERLINEMODE) of CHAT.STATE)
then (* ; "Underline what we just drew")
(\BLTSHADE.DISPLAY BLACKSHADE DSP XPOS (- (ffetch (CHAT.STATE YPOS) of CHAT.STATE)
CHAT.UNDERLINE.DESCENT)
CHARWIDTH 1 'INVERT))
(if (>= (freplace (CHAT.STATE XPOS) of CHAT.STATE with (+ XPOS (ffetch (CHAT.STATE
FONTWIDTH)
of CHAT.STATE)))
(ffetch (CHAT.STATE TTYWIDTH) of CHAT.STATE))
then (* ;
 "Have reached right margin, so wrap around")
(if WRAPFN
then (* ; "Terminal-specific wrap handler")
(CL:FUNCALL WRAPFN CHAT.STATE)
elseif (ffetch (CHAT.STATE WRAPMODE) of CHAT.STATE)
then (TERM.NEWLINE CHAT.STATE)
else (* ;
 "No, don't wrap--stay on the last character")
(MOVETO (freplace (CHAT.STATE XPOS) of CHAT.STATE with XPOS)
(ffetch (CHAT.STATE YPOS) of CHAT.STATE)
DSP])
(TERM.RESET.DISPLAY.PARMS
(LAMBDA (CHAT.STATE) (* ; "Edited 21-May-90 00:00 by jrb:") (* ;; "Reset state, assuming window coords are as if CLEARW was just called.") (LET* ((WINDOW (ffetch (CHAT.STATE WINDOW) of (\DTEST CHAT.STATE (QUOTE CHAT.STATE)))) (DSP (ffetch (CHAT.STATE DSP) of CHAT.STATE)) (FONT (PROGN (DSPFONT (OR CHAT.FONT (DEFAULTFONT (QUOTE DISPLAY))) DSP) (* ; "Reset default font, and read it back after display has coerced it as necessary") (DSPFONT NIL DSP))) (FONTDESCENT (FONTPROP FONT (QUOTE DESCENT))) (FONTWIDTH (CHARWIDTH (CHARCODE A) FONT)) (FONTHEIGHT (FONTPROP FONT (QUOTE HEIGHT))) (CLEARMODEFN (ffetch (CHAT.STATE CLEARMODEFN) of CHAT.STATE)) TERM.STATE) (freplace (CHAT.STATE PLAINFONT) of CHAT.STATE with (freplace (CHAT.STATE FONT) of CHAT.STATE with FONT)) (freplace (CHAT.STATE CHATBOLDFONT) of CHAT.STATE with (freplace (CHAT.STATE ITALICFONT) of CHAT.STATE with NIL)) (freplace (CHAT.STATE FONTHEIGHT) of CHAT.STATE with FONTHEIGHT) (freplace (CHAT.STATE FONTWIDTH) of CHAT.STATE with FONTWIDTH) (freplace (CHAT.STATE FONTDESCENT) of CHAT.STATE with FONTDESCENT) (* ;; "We use just the part of window that is even multiple of the font width and height") (LET ((TTYHEIGHT (+ (ITIMES (IQUOTIENT (WINDOWPROP WINDOW (QUOTE HEIGHT)) FONTHEIGHT) FONTHEIGHT) FONTDESCENT))) (freplace (CHAT.STATE TTYHEIGHT) of CHAT.STATE with (freplace (CHAT.STATE TOPMARGIN) of CHAT.STATE with TTYHEIGHT)) (* ;; "JRB Just guessing that nobody sets BOTTOMMARGIN, or that somebody is clobbering it...") (freplace (CHAT.STATE BOTTOMMARGIN) of CHAT.STATE with 0) (freplace (CHAT.STATE HOMEPOS) of CHAT.STATE with (- TTYHEIGHT FONTHEIGHT)) (freplace (CHAT.STATE TTYWIDTH) of CHAT.STATE with (ITIMES (IQUOTIENT (WINDOWPROP WINDOW (QUOTE WIDTH)) FONTWIDTH) FONTWIDTH))) (if (AND CLEARMODEFN (SETQ TERM.STATE (ffetch (CHAT.STATE TERM.STATE) of CHAT.STATE))) then (* ;; "Clear any funny mode the terminal might have gotten into. Test for TERM.STATE is because when we are called at startup, TERM.STATE might not be filled in yet (what a crock).") (CL:FUNCALL CLEARMODEFN CHAT.STATE TERM.STATE))))
@@ -144,15 +198,14 @@ Copyright (c) 1984, 1985, 1986, 1987, 1988, 1990 by VENUE & Xerox Corporation.
(LOCALVARS . T)
)
)
(PUTPROPS CHATTERMINAL COPYRIGHT ("VENUE & Xerox Corporation" 1984 1985 1986 1987 1988 1990))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (1149 20319 (TERM.ADDCHAR 1159 . 1955) (TERM.ADDLINE 1957 . 2559) (TERM.CLEAR.TAB 2561
. 2817) (TERM.DELCHAR 2819 . 3649) (TERM.DELETELINE 3651 . 4370) (TERM.DOWN 4372 . 5400) (
TERM.ERASE.IN.DISPLAY 5402 . 6364) (TERM.ERASE.IN.LINE 6366 . 6945) (TERM.ERASE.TO.EOL 6947 . 7332) (
TERM.ERASEBITS 7334 . 7597) (TERM.GODOWN 7599 . 8188) (TERM.HOME 8190 . 8486) (TERM.IDENTIFY.SELF 8488
. 8708) (TERM.LEFT 8710 . 9187) (TERM.MODIFY.ATTRIBUTES 9189 . 10814) (TERM.MOVETO 10816 . 11413) (
TERM.NEWLINE 11415 . 11694) (TERM.PRINTCHAR 11696 . 14173) (TERM.RESET.DISPLAY.PARMS 14175 . 16281) (
TERM.RIGHT 16283 . 16867) (TERM.SCROLLDOWN 16869 . 17588) (TERM.SET.TAB 17590 . 17971) (
TERM.SETMARGINS 17973 . 18562) (TERM.SMOOTHSCROLL 18564 . 19180) (TERM.TAB 19182 . 19795) (TERM.UP
19797 . 20317)))))
(FILEMAP (NIL (1029 21906 (TERM.ADDCHAR 1039 . 1835) (TERM.ADDLINE 1837 . 2439) (TERM.CLEAR.TAB 2441
. 2697) (TERM.DELCHAR 2699 . 3529) (TERM.DELETELINE 3531 . 4250) (TERM.DOWN 4252 . 5280) (
TERM.ERASE.IN.DISPLAY 5282 . 6244) (TERM.ERASE.IN.LINE 6246 . 6825) (TERM.ERASE.TO.EOL 6827 . 7212) (
TERM.ERASEBITS 7214 . 7477) (TERM.GODOWN 7479 . 8068) (TERM.HOME 8070 . 8366) (TERM.IDENTIFY.SELF 8368
. 8588) (TERM.LEFT 8590 . 9067) (TERM.MODIFY.ATTRIBUTES 9069 . 10694) (TERM.MOVETO 10696 . 11293) (
TERM.NEWLINE 11295 . 11574) (TERM.PRINTCHAR 11576 . 15760) (TERM.RESET.DISPLAY.PARMS 15762 . 17868) (
TERM.RIGHT 17870 . 18454) (TERM.SCROLLDOWN 18456 . 19175) (TERM.SET.TAB 19177 . 19558) (
TERM.SETMARGINS 19560 . 20149) (TERM.SMOOTHSCROLL 20151 . 20767) (TERM.TAB 20769 . 21382) (TERM.UP
21384 . 21904)))))
STOP

BIN
library/CHATTERMINAL.LCOM
View File

Binary file not shown.