github.com/Interlisp.medley
1
0
Fork 0
mirror of synced 2026-03-02 18:14:44 +00:00
Code Issues Projects Releases Wiki Activity

Collect TALK files into lispusers/talk/ (#2147)

Browse Source 
* Collect TALK files into lispusers/talk/

renamed with hyphen convention.  Also pull over TALKGAP files that were previous obsolete, and remove them from obsolete/lispusers

* Replace TALK.TEDIT--file got smashed

* TALK.TEDIT now comments the current situation
This commit is contained in:
rmkaplan
2025-06-16 11:46:00 -07:00
committed by GitHub
parent c5dd583468
commit d26e29f0d0
13 changed files with 0 additions and 1198 deletions
Download Patch File Download Diff File Expand all files Collapse all files

616
lispusers/TALK
View File

@@ -1,616 +0,0 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "22-Jul-88 15:43:07" |{MCS:MCS:STANFORD}<LANE>TALK.;10| 38505
previous date%: "16-Jun-88 09:25:17" |{MCS:MCS:STANFORD}<LANE>TALK.;9|)
(* "
Copyright (c) 1987, 1988 by Stanford University. All rights reserved.
")
(PRETTYCOMPRINT TALKCOMS)
(RPAQQ TALKCOMS ((* TALK client/server code)
(LOCALVARS . T)
(FNS TALK)
(FNS TALK.RECONNECT TALK.PROCESS TALK.DISPLAY TALK.LISTEN TALK.CLOSEFN
TALK.ANSWER TALK.ANSWER.WINDOW TALK.ANSWER.USERNAME TALK.GET.NAME
TALK.ADD.NAME TALK.FLASH.CARET TALK.WHENSELECTEDFN TALK.RINGBELLS
TALK.START.SERVER)
(FNS TALK.ICON.BUTTONEVENTFN TALK.ICON.CLOSEFN)
(* TALK data)
(DECLARE%: DONTCOPY (RECORDS TALK.SERVICETYPE TALK.PROTOCOLTYPE))
(VARS TALK.MENU.ITEMS TALK.USER.MESSAGES)
(INITVARS TALK.SERVICETYPES TALK.PROTOCOLTYPES TALK.GAG TALK.HOSTNAMES
TALK.ICON.WINDOWS (TALK.ANSWER.WAIT 15)
(TALK.READTABLE (COPYREADTABLE 'ORIG))
(TALK.DEFAULT.REGION (CREATEREGION 0 0 500 500))
(TALK.CLOSED.STRING " -- Connection Closed")
(TALK.ICON.FONT LITTLEFONT))
(GLOBALVARS TALK.MENU.ITEMS TALK.USER.MESSAGES TALK.SERVICETYPES
TALK.PROTOCOLTYPES TALK.GAG TALK.HOSTNAMES TALK.ICON.WINDOWS
TALK.ANSWER.WAIT TALK.READTABLE TALK.DEFAULT.REGION TALK.CLOSED.STRING
TALK.ICON.FONT)
(ALISTS (BackgroundMenuCommands Talk))
(VARS (BackgroundMenu))
(APPENDVARS (BACKGROUNDFNS TALK.START.SERVER)
(AFTERMAKESYSFORMS (TALK.START.SERVER NIL T)))
(BITMAPS TALK.ICON.BITMAP)
(GLOBALVARS TALK.ICON.BITMAP)
(P (SETSYNTAX (CHARCODE SPACE)
(CHARCODE A)
TALK.READTABLE))))
(* TALK client/server code)
(DECLARE%: DOEVAL@COMPILE DONTCOPY
(LOCALVARS . T)
)
(DEFINEQ
(TALK
[LAMBDA (USER.OR.HOSTNAME SERVICE PROTOCOL) (* ; "Edited 9-Jun-88 12:32 by cdl")
(* DECLARATIONS%: (RECORD RESULT
 (SERVICETYPE INPUTSTREAM
  . OUTPUTSTREAM)))
(PROG (USER PROTOCOLTYPE PROTOCOLTYPES SERVICETYPE SERVICETYPES RESULT ADDRESSABLE?)
(if (NULL USER.OR.HOSTNAME)
then (if (SETQ USER.OR.HOSTNAME (TALK.GET.NAME))
then (if (LISTP USER.OR.HOSTNAME)
then (RETURN (TALK.RECONNECT USER.OR.HOSTNAME)))
else (RETURN)))
(if SERVICE
then (if [SETQ SERVICETYPE (for SERVICETYPE in TALK.SERVICETYPES
thereis (with TALK.SERVICETYPE
SERVICETYPE (STRING-EQUAL
SERVICE
TALK.SERVICENAME]
then (SETQ SERVICETYPES (LIST SERVICETYPE))
else (RETURN (LIST "Unknown service type!" SERVICE)))
else (if (NULL (SETQ SERVICETYPES TALK.SERVICETYPES))
then (RETURN "No services available!")))
(if PROTOCOL
then (if (SETQ PROTOCOLTYPE (ASSOC PROTOCOL TALK.PROTOCOLTYPES))
then (SETQ PROTOCOLTYPES (LIST PROTOCOLTYPE))
else (RETURN (LIST "Unknown protocol!" PROTOCOL)))
else (if (NULL (SETQ PROTOCOLTYPES TALK.PROTOCOLTYPES))
then (RETURN "No protocols available!")))
(if [SETQ PROTOCOLTYPE (bind ADDRESS for PROTOCOLTYPE in PROTOCOLTYPES
when (with TALK.PROTOCOLTYPE PROTOCOLTYPE
(SETQ ADDRESS (APPLY* TALK.HOSTNAMEFN
USER.OR.HOSTNAME)))
thereis (PROGN (TALK.ADD.NAME USER.OR.HOSTNAME
ADDRESS (with TALK.PROTOCOLTYPE
PROTOCOLTYPE
TALK.PROTOCOLNAME))
(SETQ ADDRESSABLE? T)
(SELECTQ (SETQ RESULT
(with TALK.PROTOCOLTYPE
PROTOCOLTYPE
(APPLY* TALK.CONNECTFN
ADDRESS
SERVICETYPES)))
(ANSWER (RETURN))
(LISTP RESULT]
then (with RESULT RESULT (RETURN (TALK.PROCESS INPUTSTREAM OUTPUTSTREAM
SERVICETYPE PROTOCOLTYPE 'CLIENT
USER.OR.HOSTNAME T)))
else (RETURN (if ADDRESSABLE?
then (SELECTQ RESULT
(ANSWER "No answer from TALK service!")
(LIST "Can't connect to host!" USER.OR.HOSTNAME))
else (LIST "Host not found!" USER.OR.HOSTNAME])
)
(DEFINEQ
(TALK.RECONNECT
[LAMBDA (DESTINATION) (* ; "Edited 10-Jun-88 14:59 by cdl")
(* DECLARATIONS%: (RECORD RESULT
 (SERVICETYPE INPUTSTREAM
  . OUTPUTSTREAM))
 (RECORD DESTINATION
 (NAME . ENTRIES)) (RECORD ENTRY
 (PROTOCOL . ADDRESS)))
(DECLARE (SPECVARS DESTINATION))
(if TALK.SERVICETYPES
then
[LET (PROTOCOLTYPE RESULT ENTRY ADDRESS) (* try all the protocols but prefer
 those that have already succeeded)
(if [SETQ PROTOCOLTYPE
(for PROTOCOLTYPE in [SORT (APPEND TALK.PROTOCOLTYPES)
(FUNCTION (LAMBDA (PROTOCOLTYPE)
(* DECLARATIONS%: (RECORD
 DESTINATION (NAME . ENTRIES)))
(with TALK.PROTOCOLTYPE
PROTOCOLTYPE
(with DESTINATION
DESTINATION
(ASSOC
TALK.PROTOCOLNAME
ENTRIES]
when [with TALK.PROTOCOLTYPE PROTOCOLTYPE
(AND [SETQ ADDRESS (with DESTINATION DESTINATION
(if (SETQ ENTRY
(ASSOC TALK.PROTOCOLNAME
ENTRIES))
then (with ENTRY ENTRY
ADDRESS)
else (APPLY* TALK.HOSTNAMEFN
NAME]
(SETQ RESULT (APPLY* TALK.CONNECTFN ADDRESS
TALK.SERVICETYPES]
thereis (SELECTQ RESULT
(ANSWER (RETURN))
(LISTP RESULT]
then (with RESULT RESULT (TALK.PROCESS INPUTSTREAM OUTPUTSTREAM
SERVICETYPE PROTOCOLTYPE 'CLIENT
(with DESTINATION DESTINATION NAME)
T))
else (SELECTQ RESULT
(ANSWER "No answer from TALK service!")
(LIST "Can't connect to host!" (with DESTINATION DESTINATION NAME]
else "No services available!"])
(TALK.PROCESS
[LAMBDA (INPUTSTREAM OUTPUTSTREAM SERVICETYPE PROTOCOLTYPE MODE USER SPAWN?)
(* ; "Edited 9-Jun-88 12:35 by cdl")
(if (LITATOM SERVICETYPE)
then (SETQ SERVICETYPE (ASSOC SERVICETYPE TALK.SERVICETYPES)))
(if (LITATOM PROTOCOLTYPE)
then (SETQ PROTOCOLTYPE (ASSOC PROTOCOLTYPE TALK.PROTOCOLTYPES)))
(LET ((DISPLAYSTREAM (TALK.DISPLAY INPUTSTREAM OUTPUTSTREAM SERVICETYPE PROTOCOLTYPE MODE
USER)))
(if SPAWN?
then [ADD.PROCESS `(TALK.LISTEN ,INPUTSTREAM ,OUTPUTSTREAM ,(KWOTE SERVICETYPE)
,(KWOTE PROTOCOLTYPE)
,DISPLAYSTREAM]
else (TALK.LISTEN INPUTSTREAM OUTPUTSTREAM SERVICETYPE PROTOCOLTYPE DISPLAYSTREAM])
(TALK.DISPLAY
[LAMBDA (INPUTSTREAM OUTPUTSTREAM SERVICETYPE PROTOCOLTYPE MODE USER)
(* ; "Edited 9-Jun-88 14:46 by cdl")
(* DECLARATIONS%: (ASSOCRECORD
 MESSAGES (GREETING)))
(LET (MAINWINDOW WINDOW REGION GREETING)
(DECLARE (SPECVARS GREETING))
(SETQ USER (with TALK.PROTOCOLTYPE PROTOCOLTYPE (APPLY* TALK.USERNAMEFN INPUTSTREAM
OUTPUTSTREAM SERVICETYPE MODE
USER)))
(with REGION (SETQ REGION (if (REGIONP TALK.DEFAULT.REGION)
then (with REGION TALK.DEFAULT.REGION
(GETBOXREGION WIDTH HEIGHT))
else (GETREGION)))
(SETQ HEIGHT (QUOTIENT HEIGHT 2)))
(SETQ MAINWINDOW (CREATEW (with REGION REGION (create REGION
BOTTOM _ (PLUS BOTTOM HEIGHT)
using REGION))
(PACK* "TALK (" (with TALK.SERVICETYPE SERVICETYPE
TALK.SERVICENAME)
")")))
(SETQ WINDOW (CREATEW REGION (CONCAT "(" (with TALK.PROTOCOLTYPE PROTOCOLTYPE
TALK.PROTOCOLNAME)
") Talk from " USER)))
(WINDOWPROP MAINWINDOW 'STREAMS (CONS INPUTSTREAM OUTPUTSTREAM))
(WINDOWADDPROP MAINWINDOW 'CLOSEFN (FUNCTION TALK.CLOSEFN))
(ATTACHWINDOW WINDOW MAINWINDOW 'BOTTOM)
(ATTACHMENU (create MENU
ITEMS _ TALK.MENU.ITEMS
CENTERFLG _ T
MENUBORDERSIZE _ 1
WHENSELECTEDFN _ (FUNCTION TALK.WHENSELECTEDFN))
WINDOW
'BOTTOM)
(with TALK.SERVICETYPE SERVICETYPE (APPLY* TALK.DISPLAYFN MAINWINDOW WINDOW INPUTSTREAM
OUTPUTSTREAM PROTOCOLTYPE USER))
(if (AND (SETQ GREETING (CAR (with MESSAGES TALK.USER.MESSAGES GREETING)))
(SETQ GREETING (ERRORSET GREETING)))
then (BKSYSBUF (CAR GREETING)))
WINDOW])
(TALK.LISTEN
[LAMBDA (INPUTSTREAM OUTPUTSTREAM SERVICETYPE PROTOCOLTYPE WINDOW)
(* ; "Edited 7-Jun-88 08:42 by cdl")
(PROG (ICON? (MAINWINDOW (MAINWINDOW WINDOW)))
(with TALK.SERVICETYPE SERVICETYPE (APPLY* TALK.LISTENFN MAINWINDOW WINDOW INPUTSTREAM
OUTPUTSTREAM PROTOCOLTYPE))
(TTY.PROCESS T)
(CLOSEF? INPUTSTREAM)
(if [OR (OPENWP WINDOW)
(for PROP in '(ICON ICONWINDOW) thereis (SETQ ICON?
(OPENWP (WINDOWPROP
MAINWINDOW
PROP]
then (WINDOWPROP WINDOW 'TITLE (CONCAT (WINDOWPROP WINDOW 'TITLE)
TALK.CLOSED.STRING))
(for WINDOW in (ATTACHEDWINDOWS WINDOW) when (WINDOWPROP WINDOW
'MENU)
do (if (DETACHWINDOW WINDOW)
then (CLOSEW WINDOW)))
(if ICON?
then (SHRINKW MAINWINDOW)
else (FLASHWINDOW WINDOW])
(TALK.CLOSEFN
[LAMBDA (WINDOW) (* ; "Edited 9-Jun-88 14:45 by cdl")
(* DECLARATIONS%: (RECORD STREAMS
 (INPUTSTREAM . OUTPUTSTREAM)))
(LET ((STREAMS (WINDOWPROP WINDOW 'STREAMS NIL)))
(if STREAMS
then (with STREAMS STREAMS (CLOSEF? INPUTSTREAM)
(CLOSEF? OUTPUTSTREAM])
(TALK.ANSWER
[LAMBDA (USER SERVICE PROTOCOL ADDRESS) (* ; "Edited 9-Jun-88 09:20 by cdl")
(LET [WINDOW REGION (EVENT (CREATE.EVENT))
(TIME (DATE '(DATEFORMAT NO.SECONDS]
(DECLARE (GLOBALVARS \IDLING))
(PROGN (* Only really necessary if you're
 talking to yourself)
(SPAWN.MOUSE))
(WINDOWPROP (SETQ WINDOW (TALK.ANSWER.WINDOW USER))
'EVENT EVENT)
(BITBLT TALK.ICON.BITMAP NIL NIL WINDOW)
[SETQ REGION (with REGION (DSPCLIPPINGREGION NIL WINDOW)
(CREATEREGION LEFT BOTTOM WIDTH (QUOTIENT HEIGHT 3]
(CENTERPRINTINREGION (CONCAT SERVICE "(" PROTOCOL ")")
(with REGION REGION (CREATEREGION LEFT BOTTOM WIDTH (DIFFERENCE HEIGHT 7)))
WINDOW)
(DSPFONT (PROG1 (DSPFONT TALK.ICON.FONT WINDOW)
(CENTERPRINTINREGION (CONCAT (SUBSTRING TIME 1 6)
(SUBSTRING TIME 10 -1))
(with REGION REGION (add BOTTOM HEIGHT)
(CREATEREGION LEFT BOTTOM WIDTH (DIFFERENCE HEIGHT 7)))
WINDOW))
WINDOW)
(if USER
then (TALK.ADD.NAME USER ADDRESS PROTOCOL)
(with REGION REGION (add BOTTOM HEIGHT)
(TALK.ANSWER.USERNAME USER (CREATEREGION LEFT BOTTOM WIDTH
(DIFFERENCE HEIGHT 7))
WINDOW)))
(TALK.RINGBELLS WINDOW)
(if (AND [STRINGP (AWAIT.EVENT EVENT (TIMES TALK.ANSWER.WAIT 1000 (if \IDLING
then
(* Provide extra time to login)
2
else 1]
USER)
then (* We timed out, leave the icon up
 but change its functionality)
(WINDOWPROP WINDOW 'TALK (LIST USER (CONS PROTOCOL ADDRESS)))
(WINDOWPROP WINDOW 'EVENT NIL)
(INVERTW WINDOW)
else (WINDOWPROP WINDOW 'EVENT NIL)
(CLOSEW WINDOW))
(WINDOWPROP WINDOW 'RESULT])
(TALK.ANSWER.WINDOW
[LAMBDA (USER) (* ; "Edited 9-Jun-88 10:27 by cdl")
(PROG (WINDOW REGION)
[if TALK.ICON.WINDOWS
then
[if [AND USER (SETQ WINDOW (for WINDOW in TALK.ICON.WINDOWS
thereis (EQUAL USER (CAR (WINDOWPROP WINDOW
'TALK]
then (RETURN WINDOW)
else (SETQ REGION
(with REGION (WINDOWPROP (CAR TALK.ICON.WINDOWS)
'REGION)
(if (LESSP (PLUS PRIGHT WIDTH)
SCREENWIDTH)
then (CREATEREGION PRIGHT BOTTOM WIDTH HEIGHT)
else (CREATEREGION (OR (fetch (REGION LEFT)
of (REGIONP TALK.DEFAULT.REGION)
)
0)
(if (LESSP (PLUS PTOP HEIGHT)
SCREENHEIGHT)
then PTOP
else (OR (fetch (REGION BOTTOM)
of (REGIONP
TALK.DEFAULT.REGION
))
0))
WIDTH HEIGHT]
else (SETQ REGION (with BITMAP TALK.ICON.BITMAP
(if (REGIONP TALK.DEFAULT.REGION)
then (with REGION TALK.DEFAULT.REGION
(CREATEREGION LEFT BOTTOM BITMAPWIDTH
BITMAPHEIGHT))
else (CREATEREGION 0 0 BITMAPWIDTH BITMAPHEIGHT]
(push TALK.ICON.WINDOWS (SETQ WINDOW (CREATEW REGION NIL 0 T)))
(WINDOWPROP WINDOW 'BUTTONEVENTFN (FUNCTION TALK.ICON.BUTTONEVENTFN))
(WINDOWPROP WINDOW 'CLOSEFN (FUNCTION TALK.ICON.CLOSEFN))
(RETURN WINDOW])
(TALK.ANSWER.USERNAME
[LAMBDA (USER REGION WINDOW) (* cdl "10-Jun-87 08:38")
(LET (PTR FONTHEIGHT (FONT (DSPFONT NIL WINDOW)))
(if (AND (GREATERP (NCHARS USER)
(QUOTIENT (BITMAPWIDTH TALK.ICON.BITMAP)
(CHARWIDTH (CHARCODE A)
FONT)))
(SETQ PTR (STRPOS (CONSTANT (CHARACTER (CHARCODE SPACE)))
USER)))
then (DSPFONT TALK.ICON.FONT WINDOW)
(SETQ FONTHEIGHT (QUOTIENT (FONTPROP TALK.ICON.FONT 'HEIGHT)
2))
(CENTERPRINTINREGION (SUBSTRING USER 1 (SUB1 PTR))
(with REGION REGION (CREATEREGION LEFT (PLUS BOTTOM FONTHEIGHT)
WIDTH HEIGHT))
WINDOW)
(CENTERPRINTINREGION (SUBSTRING USER (ADD1 PTR)
-1)
(with REGION REGION (CREATEREGION LEFT (DIFFERENCE BOTTOM FONTHEIGHT)
WIDTH HEIGHT))
WINDOW)
(DSPFONT FONT WINDOW)
else (CENTERPRINTINREGION USER REGION WINDOW])
(TALK.GET.NAME
[LAMBDA NIL (* ; "Edited 16-Jun-88 09:24 by cdl")
(* DECLARATIONS%: (RECORD ENTRY
 (NAME . PAIRS)) (RECORD PAIR
 (PROTOCOL . ADDRESS)))
(LET
[HOSTNAME HOSTNAMES MENU (ITEM '("" NIL ""]
(if
(SETQ HOSTNAMES
(for ENTRY in TALK.HOSTNAMES
collect
(if (LISTP ENTRY)
then
[with
ENTRY ENTRY
`(,NAME ,(KWOTE ENTRY)
NIL
(SUBITEMS ,@(for PAIR in PAIRS
collect (with PAIR PAIR
`(,(CONCAT PROTOCOL " " ADDRESS)
,(KWOTE (LIST NAME PAIR]
else ENTRY)))
then (push HOSTNAMES ITEM))
[SETQ MENU (create MENU
TITLE _ "TALK"
ITEMS _ `(("Prompt for User/Host" 'PROMPT "Prompt for a new user or hostname."
)
(,(if TALK.GAG
then "Turn TALK On"
else "Turn TALK Off")
(PROGN (SETQ TALK.GAG (NOT TALK.GAG))
NIL)
"Toggle TALK connection accept/refuse switch.")
,@HOSTNAMES]
[if HOSTNAMES
then (SHADEITEM ITEM MENU BLACKSHADE) (* Kludge to make entire line of
 menu inverted, not just up to
 subitem arrows)
(with REGION (MENUITEMREGION ITEM MENU)
(with MENU MENU (BLTSHADE BLACKSHADE (with WINDOW IMAGE SAVE)
(PLUS LEFT MENUOUTLINESIZE)
(PLUS BOTTOM MENUOUTLINESIZE)
WIDTH HEIGHT]
(SELECTQ (SETQ HOSTNAME (MENU MENU))
(PROMPT (SETQ HOSTNAME (MKATOM (PROMPTFORWORD "User or host?" NIL NIL PROMPTWINDOW)))
(TERPRI PROMPTWINDOW))
NIL)
HOSTNAME])
(TALK.ADD.NAME
[LAMBDA (NAME ADDRESS PROTOCOL) (* ; "Edited 9-Jun-88 12:39 by cdl")
(* DECLARATIONS%: (RECORD ENTRY
 (NAME . PAIRS)))
(LET (ENTRY)
(if (NOT (EQUAL NAME ADDRESS))
then (if (SETQ ENTRY (bind HOSTNAME (NCHARS _ (NCHARS NAME)) for ENTRY
in TALK.HOSTNAMES
eachtime (SETQ HOSTNAME
(if (LISTP ENTRY)
then (with ENTRY ENTRY NAME)
else ENTRY))
thereis (STRING-EQUAL HOSTNAME NAME)))
then (if (NLISTP ENTRY)
then (SETQ TALK.HOSTNAMES (DREMOVE ENTRY TALK.HOSTNAMES))
(push TALK.HOSTNAMES (LIST NAME (CONS PROTOCOL
ADDRESS)))
else (PUTASSOC PROTOCOL ADDRESS (with ENTRY ENTRY PAIRS)
))
else (push TALK.HOSTNAMES (LIST NAME (CONS PROTOCOL ADDRESS])
(TALK.FLASH.CARET
[LAMBDA (WINDOW POSITION FLG) (* ; "Edited 2-Jun-88 15:17 by cdl")
(DECLARE (GLOBALVARS DEFAULTCARET))
(if (OPENWP WINDOW)
then (SELECTQ FLG
(OFF [with POSITION POSITION
(if XCOORD
then (with CURSOR DEFAULTCARET
(BITBLT CUIMAGE NIL NIL WINDOW XCOORD YCOORD NIL
NIL NIL 'INVERT])
(ON [with POSITION POSITION (with CURSOR DEFAULTCARET
(BITBLT CUIMAGE NIL NIL WINDOW
(SETQ XCOORD
(DIFFERENCE (DSPXPOSITION NIL
WINDOW)
CUHOTSPOTX))
(SETQ YCOORD
(DIFFERENCE (DSPYPOSITION NIL
WINDOW)
CUHOTSPOTY))
NIL NIL NIL 'INVERT])
NIL])
(TALK.WHENSELECTEDFN
[LAMBDA (ITEM FROMMENU BUTTON) (* ; "Edited 9-Jun-88 14:50 by cdl")
(* DECLARATIONS%: (RECORD STREAMS
 (INPUTSTREAM . OUTPUTSTREAM)))
(LET [MAINWINDOW TEXTSTREAM STREAMS (WINDOW (MAINWINDOW (WFROMMENU FROMMENU]
(DECLARE (SPECVARS WINDOW MAINWINDOW TEXTSTREAM STREAMS))
(SETQ TEXTSTREAM (WINDOWPROP (SETQ MAINWINDOW (MAINWINDOW WINDOW))
'TEXTSTREAM))
(if (AND (SETQ STREAMS (WINDOWPROP MAINWINDOW 'STREAMS))
(OPENP (with STREAMS STREAMS OUTPUTSTREAM)))
then (ERRORSET (CADR ITEM])
(TALK.RINGBELLS
[LAMBDA (WINDOW) (* cdl "16-Mar-87 08:01")
(DECLARE (GLOBALVARS RINGBELLS.L1 RINGBELLS.L2))
(PLAYTUNE RINGBELLS.L1) (* Dorados and Dolphins can't do
 PLAYTUNE but let BEEPON/BEEPOFF
 handle that)
(FLASHWINDOW WINDOW)
(PLAYTUNE RINGBELLS.L2])
(TALK.START.SERVER
[LAMBDA (PROTOCOL RESTART) (* ; "Edited 8-Jun-88 15:06 by cdl")
(DECLARE (SPECVARS RESTART))
(if PROTOCOL
then (LET ((PROTOCOLTYPE (ASSOC PROTOCOL TALK.PROTOCOLTYPES)))
(DECLARE (SPECVARS PROTOCOLTYPE))
(if PROTOCOLTYPE
then [with TALK.PROTOCOLTYPE PROTOCOLTYPE
(if TALK.STARTSERVERFN
then (CAR (NLSETQ (APPLY* TALK.STARTSERVERFN
RESTART]
else (ERROR PROTOCOL "Unknown protocol!")))
else (for PROTOCOLTYPE declare%: (SPECVARS PROTOCOLTYPE) in TALK.PROTOCOLTYPES
do (with TALK.PROTOCOLTYPE PROTOCOLTYPE
(if TALK.STARTSERVERFN
then (NLSETQ (APPLY* TALK.STARTSERVERFN RESTART])
)
(DEFINEQ
(TALK.ICON.BUTTONEVENTFN
[LAMBDA (WINDOW) (* ; "Edited 9-Jun-88 10:02 by cdl")
(* DECLARATIONS%: (RECORD
 DESTINATION (NAME (PROTOCOL . ADDRESS))))
(RESETFORM (INVERTW WINDOW)
(until (MOUSESTATE UP) do))
(ALLOW.BUTTON.EVENTS)
(if (WINDOWPROP WINDOW 'EVENT)
then (WINDOWPROP WINDOW 'RESULT T)
(NOTIFY.EVENT (WINDOWPROP WINDOW 'EVENT NIL)
T)
else (LET ((DESTINATION (WINDOWPROP WINDOW 'TALK))
RESULT)
(if (MOUSECONFIRM (CONCAT "(Re)Connect to " (with DESTINATION DESTINATION
NAME)
"?"))
then (if (PROCESSP (SETQ RESULT (TALK.RECONNECT DESTINATION)))
then (CLOSEW WINDOW)
else (FLASHWINDOW WINDOW)
(PROMPTPRINT RESULT])
(TALK.ICON.CLOSEFN
[LAMBDA (WINDOW) (* cdl "10-May-87 10:07")
(LET ((EVENT (WINDOWPROP WINDOW 'EVENT NIL)))
(if EVENT
then (NOTIFY.EVENT EVENT T)))
(SETQ TALK.ICON.WINDOWS (DREMOVE WINDOW TALK.ICON.WINDOWS])
)
(* TALK data)
(DECLARE%: DONTCOPY
(DECLARE%: EVAL@COMPILE
(RECORD TALK.SERVICETYPE (TALK.SERVICENAME TALK.DISPLAYFN TALK.LISTENFN))
(RECORD TALK.PROTOCOLTYPE (TALK.PROTOCOLNAME TALK.HOSTNAMEFN TALK.USERNAMEFN TALK.CONNECTFN
TALK.EVENTFN TALK.STARTSERVERFN TALK.CASEARRAY))
)
)
(RPAQQ TALK.MENU.ITEMS ((Disconnect (TALK.CLOSEFN MAINWINDOW)
"Close TALK connection and keep window open.")
(RingBells (PROGN (PRINTCCODE (CHARCODE ^G)
(CDR STREAMS))
(FORCEOUTPUT (CDR STREAMS))
(FLASHWINDOW MAINWINDOW))
"Execute a (RINGBELLS) on the remote machine.")
(Message (LET [(MESSAGE (MENU (create MENU ITEMS _ TALK.USER.MESSAGES]
(if [AND MESSAGE (TTY.PROCESSP (WINDOWPROP MAINWINDOW
'PROCESS]
then
(BKSYSBUF MESSAGE)))
"Insert a generic message.")))
(RPAQQ TALK.USER.MESSAGES (("One moment please" "One moment please..." NIL (SUBITEMS (
"the phone's ringing"
"One moment please, the phone's ringing..."
)
(
"there's someone at the door"
"One moment please, there's someone at the door..."
)
(
"someone is trying to TALK to me"
"One moment please, someone is trying to TALK to me..."
)))
(DATE (DATE)
"The current date and time.")
"Bye."))
(RPAQ? TALK.SERVICETYPES NIL)
(RPAQ? TALK.PROTOCOLTYPES NIL)
(RPAQ? TALK.GAG NIL)
(RPAQ? TALK.HOSTNAMES NIL)
(RPAQ? TALK.ICON.WINDOWS NIL)
(RPAQ? TALK.ANSWER.WAIT 15)
(RPAQ? TALK.READTABLE (COPYREADTABLE 'ORIG))
(RPAQ? TALK.DEFAULT.REGION (CREATEREGION 0 0 500 500))
(RPAQ? TALK.CLOSED.STRING " -- Connection Closed")
(RPAQ? TALK.ICON.FONT LITTLEFONT)
(DECLARE%: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS TALK.MENU.ITEMS TALK.USER.MESSAGES TALK.SERVICETYPES TALK.PROTOCOLTYPES TALK.GAG
TALK.HOSTNAMES TALK.ICON.WINDOWS TALK.ANSWER.WAIT TALK.READTABLE TALK.DEFAULT.REGION
TALK.CLOSED.STRING TALK.ICON.FONT)
)
(ADDTOVAR BackgroundMenuCommands (Talk '(PRINTOUT PROMPTWINDOW T (TALK)
T)
"Start a TALK session with another user/host."))
(RPAQQ BackgroundMenu NIL)
(APPENDTOVAR BACKGROUNDFNS TALK.START.SERVER)
(APPENDTOVAR AFTERMAKESYSFORMS (TALK.START.SERVER NIL T))
(RPAQQ TALK.ICON.BITMAP #*(80 78)OOOOOOOOOOOOOOOOOOOOLAIKKGHHDBNOOOOOOOOOOGFKJOKKEJDMOOOOOOOOOG@KHOHHEJJOOOOOOOOOOGFKJOKJMJNMOOOOOOOOOGFHKGKKDBNOOOOOOOOOOOOOOOOOOOOOOOOOOOOOH@@@@@@@@@@@@@@@@@@AH@@@@@@@@@@@@@@@@@@AH@@@@@@@@@@@@@@@@@@AH@@@@@@@@@@@@@@@@@@AH@@@@@@@@@@@@@@@@@@AH@@@@@@@@@@@@@@@@@@AH@@@@@@@@@@@@@@@@@@AH@@@@@@@@@@@@@@@@@@AH@@@@@@@@@@@@@@@@@@AH@@@@@@@@@@@@@@@@@@AH@@@@@@@@@@@@@@@@@@AH@@@@@@@@@@@@@@@@@@AH@@@@@@@@@@@@@@@@@@AH@@@@@@@@@@@@@@@@@@AH@@@@@@@@@@@@@@@@@@AH@@@@@@@@@@@@@@@@@@AH@@@@@@@@@@@@@@@@@@AH@@@@@@@@@@@@@@@@@@AH@@@@@@@@@@@@@@@@@@AOOOOOOOOOOOOOOOOOOOOLAKGDGOOOOOOOOOOOOOOOGKBENOOOOOOOOOOOOOOOGKEDGOOOOOOOOOOOOOOOGKGENOOOOOOOOOOOOOOOGKGDGOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOH@@@@@@@@@@@@@@@@@@AH@@@@@@@@@@@@@@@@@@AH@@@@@@@@@@@@@@@@@@AH@@@@@@@@@@@@@@@@@@AH@@@@@@@@@@@@@@@@@@AH@@@@@@@@@@@@@@@@@@AH@@@@@@@@@@@@@@@@@@AH@@@@@@@@@@@@@@@@@@AH@@@@@@@@@@@@@@@@@@AH@@@@@@@@@@@@@@@@@@AH@@@@@@@@@@@@@@@@@@AH@@@@@@@@@@@@@@@@@@AH@@@@@@@@@@@@@@@@@@AH@@@@@@@@@@@@@@@@@@AH@@@@@@@@@@@@@@@@@@AH@@@@@@@@@@@@@@@@@@AH@@@@@@@@@@@@@@@@@@AH@@@@@@@@@@@@@@@@@@AH@@@@@@@@@@@@@@@@@@AOOOOOOOOOOOOOOOOOOOOMM@HLGOOOOOOOOOOOOOOLIFKENOOOOOOOOOOOOOOMEFKDGOOOOOOOOOOOOOOMMFKENOOOOOOOOOOOOOOMM@HLGOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOH@@@@@@@@@@@@@@@@@@AH@@@@@@@@@@@@@@@@@@AH@@@@@@@@@@@@@@@@@@AH@@@@@@@@@@@@@@@@@@AH@@@@@@@@@@@@@@@@@@AH@@@@@@@@@@@@@@@@@@AH@@@@@@@@@@@@@@@@@@AH@@@@@@@@@@@@@@@@@@AH@@@@@@@@@@@@@@@@@@AH@@@@@@@@@@@@@@@@@@AH@@@@@@@@@@@@@@@@@@AH@@@@@@@@@@@@@@@@@@AH@@@@@@@@@@@@@@@@@@AH@@@@@@@@@@@@@@@@@@AH@@@@@@@@@@@@@@@@@@AH@@@@@@@@@@@@@@@@@@AH@@@@@@@@@@@@@@@@@@AH@@@@@@@@@@@@@@@@@@AOOOOOOOOOOOOOOOOOOOO
)
(DECLARE%: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS TALK.ICON.BITMAP)
)
(SETSYNTAX (CHARCODE SPACE)
(CHARCODE A)
TALK.READTABLE)
(PUTPROPS TALK COPYRIGHT ("Stanford University" 1987 1988))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (2377 6659 (TALK 2387 . 6657)) (6660 31221 (TALK.RECONNECT 6670 . 10485) (TALK.PROCESS
10487 . 11403) (TALK.DISPLAY 11405 . 14118) (TALK.LISTEN 14120 . 15633) (TALK.CLOSEFN 15635 . 16150) (
TALK.ANSWER 16152 . 18935) (TALK.ANSWER.WINDOW 18937 . 21688) (TALK.ANSWER.USERNAME 21690 . 23092) (
TALK.GET.NAME 23094 . 25712) (TALK.ADD.NAME 25714 . 27266) (TALK.FLASH.CARET 27268 . 28866) (
TALK.WHENSELECTEDFN 28868 . 29649) (TALK.RINGBELLS 29651 . 30143) (TALK.START.SERVER 30145 . 31219)) (
31222 32752 (TALK.ICON.BUTTONEVENTFN 31232 . 32451) (TALK.ICON.CLOSEFN 32453 . 32750)))))
STOP

BIN
lispusers/talk/TALK Normal file
View File

Binary file not shown.

BIN
lispusers/talk/TALK-GAP Normal file
View File

Binary file not shown.

BIN
lispusers/talk/TALK-IP Normal file
View File

Binary file not shown.

BIN
lispusers/talk/TALK-NS Normal file
View File

Binary file not shown.

BIN
lispusers/talk/TALK-NSGAP Normal file
View File

Binary file not shown.

BIN
lispusers/talk/TALK-SKETCH Normal file
View File

Binary file not shown.

BIN
lispusers/talk/TALK-TEDIT Normal file
View File

Binary file not shown.

BIN
lispusers/talk/TALK-TTY Normal file
View File

Binary file not shown.

BIN
lispusers/talk/TALK.TEDIT Normal file
View File

Binary file not shown.

240
obsolete/lispusers/IPTALK
View File

@@ -1,240 +0,0 @@
(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")
(FILECREATED "22-Jul-88 14:16:28" |{MCS:MCS:STANFORD}<LANE>IPTALK.;1| 12755 )
(PRETTYCOMPRINT IPTALKCOMS)
(RPAQQ IPTALKCOMS ((* TALK (Interim)
IP Interface)
(LOCALVARS . T)
(FNS TALK.IP.SERVER)
(FNS TALK.IP.USERNAME TALK.IP.CONNECT TALK.IP.EVENT TALK.START.IP.SERVER)
(INITVARS (TALK.UDP.PORT 517))
(GLOBALVARS TALK.UDP.PORT TALK.IP.CONSTANTS)
(DECLARE%: DONTCOPY (RECORDS TALK.IP.PACKET)
(CONSTANTS * TALK.IP.CONSTANTS))
(* etc)
(FILES TALK TCP TCPUDP)
(APPENDVARS (TALK.PROTOCOLTYPES (IP DODIP.HOSTP TALK.IP.USERNAME
TALK.IP.CONNECT TALK.IP.EVENT
TALK.START.IP.SERVER)))
(DECLARE%: DONTCOPY DONTEVAL@LOAD EVAL@COMPILE (FILES ETHERRECORDS TCPEXPORTS)
)
(P (TALK.START.IP.SERVER))))
(* TALK (Interim) IP Interface)
(DECLARE%: DOEVAL@COMPILE DONTCOPY
(LOCALVARS . T)
)
(DEFINEQ
(TALK.IP.SERVER
[LAMBDA NIL (* ; "Edited 17-Jun-88 13:45 by cdl")
(DECLARE (GLOBALVARS \IP.READY))
(LET (SOCKET)
(DECLARE (SPECVARS SOCKET))
(RESETLST
[RESETSAVE NIL `(UDP.CLOSE.SOCKET ,(SETQ SOCKET (UDP.OPEN.SOCKET TALK.UDP.PORT]
[bind PACKET RESPONSE SERVICE GAP.SERVICETYPE TALK.SERVICETYPE INPUTSTREAM
OUTPUTSTREAM PORT USER while \IP.READY
do (SETQ PACKET (UDP.GET SOCKET T))
(UDP.SETUP (SETQ RESPONSE (\ALLOCATE.ETHERPACKET))
(with IP PACKET IPSOURCEADDRESS)
(with UDP PACKET UDPSOURCEPORT)
0 SOCKET 'FREE)
(UDP.APPEND.BYTE RESPONSE (with TALK.IP.PACKET PACKET TALK.SERVICE.BYTE))
(if [OR [NULL (if (SETQ GAP.SERVICETYPE (ASSOC (with TALK.IP.PACKET
PACKET
TALK.SERVICE.BYTE
)
GAP.SERVICETYPES))
then (SETQ SERVICE (with GAP.SERVICETYPE
GAP.SERVICETYPE
GAP.SERVICENAME]
(NULL (SETQ TALK.SERVICETYPE (ASSOC SERVICE TALK.SERVICETYPES]
then (UDP.APPEND.BYTE RESPONSE \IPTALK.NOSERVICE)
(UDP.SEND SOCKET RESPONSE)
elseif [OR TALK.GAG (NOT (TALK.ANSWER (SETQ USER (with TALK.IP.PACKET
PACKET
TALK.IP.USERNAME)
)
SERVICE
'IP
(with IP PACKET IPSOURCEADDRESS]
then (UDP.APPEND.BYTE RESPONSE \IPTALK.NOANSWER)
(UDP.SEND SOCKET RESPONSE)
else (UDP.APPEND.BYTE RESPONSE \IPTALK.SUCCESS)
(UDP.APPEND.WORD RESPONSE (SETQ PORT (\TCP.SELECT.PORT)))
(UDP.SEND SOCKET RESPONSE)
(if (SETQ INPUTSTREAM (TCP.OPEN (with IP PACKET IPSOURCEADDRESS
)
NIL PORT 'PASSIVE 'INPUT))
then (TALK.PROCESS INPUTSTREAM (TCP.OTHER.STREAM INPUTSTREAM)
TALK.SERVICETYPE
'IP
'SERVER USER T])])
)
(DEFINEQ
(TALK.IP.USERNAME
[LAMBDA (INPUTSTREAM OUTPUTSTREAM SERVICETYPE MODE USER)
(* ; "Edited 8-Jun-88 15:45 by cdl")
(SELECTQ (with TALK.SERVICETYPE SERVICETYPE TALK.SERVICENAME)
((TTY Sketch) (* For (backward) compatibility)
USER)
(LET ((NAME (USERNAME)))
(PRINTOUT OUTPUTSTREAM (if (NOT (STREQUAL NAME (CONSTANT null)))
then NAME)
T)
(FORCEOUTPUT OUTPUTSTREAM)
(SETQ NAME (RATOM INPUTSTREAM TALK.READTABLE)) (* Eat EOL)
(BIN INPUTSTREAM)
(OR NAME USER])
(TALK.IP.CONNECT
[LAMBDA (HOST SERVICETYPES) (* ; "Edited 13-Jun-88 17:54 by cdl")
(DECLARE (SPECVARS HOST SERVICETYPES))
(LET
(SOCKET)
(DECLARE (SPECVARS SOCKET))
(RESETLST
[RESETSAVE NIL `(UDP.CLOSE.SOCKET ,(SETQ SOCKET (UDP.OPEN.SOCKET]
[PROG (NAME REQUEST RESPONSE INPUTSTREAM RESULT)
(while (STREQUAL (SETQ NAME (USERNAME))
(CONSTANT null)) do (LOGIN))
(if
[LITATOM
(SETQ RESULT
(for SERVICETYPE in SERVICETYPES
thereis (PROGN (UDP.SETUP (SETQ REQUEST (\ALLOCATE.ETHERPACKET))
HOST TALK.UDP.PORT 0 SOCKET 'FREE)
(UDP.APPEND.BYTE
REQUEST
(with GAP.SERVICETYPE
[for GAP.SERVICETYPE in GAP.SERVICETYPES
thereis (with GAP.SERVICETYPE
GAP.SERVICETYPE
(with TALK.SERVICETYPE
SERVICETYPE
(EQ GAP.SERVICENAME
TALK.SERVICENAME]
GAP.UNSPECIFIED))
(UDP.APPEND.BYTE REQUEST 0)
(UDP.APPEND.WORD REQUEST 0)
(UDP.APPEND.WORD REQUEST (NCHARS NAME))
(UDP.APPEND.STRING REQUEST NAME)
(if [SETQ RESPONSE
(UDP.EXCHANGE SOCKET REQUEST
(TIMES TALK.ANSWER.WAIT
(CONSTANT (PROGN
(* Convert to milliseconds and
 double in case they are idle)
(TIMES 2 1000]
then (SELECT (with TALK.IP.PACKET RESPONSE
TALK.STATUS)
(\IPTALK.SUCCESS T)
(\IPTALK.NOSERVICE NIL)
(\IPTALK.NOANSWER (RETURN 'ANSWER))
(RETURN 'CONNECT))
else (* Can't connect)
(RETURN 'CONNECT]
then (RETURN RESULT)
else (if (STREAMP (SETQ INPUTSTREAM (TCP.OPEN HOST (with TALK.IP.PACKET
RESPONSE
TALK.TEDIT.PORT)
NIL
'ACTIVE
'INPUT T)))
then [RETURN (CONS RESULT (CONS INPUTSTREAM (TCP.OTHER.STREAM
INPUTSTREAM]
else (RETURN 'CONNECT])])
(TALK.IP.EVENT
[LAMBDA (INPUTSTREAM OUTPUTSTREAM) (* cdl "18-May-87 16:29")
(while (AND (OPENP INPUTSTREAM)
(OPENP OUTPUTSTREAM)
(NOT (READP INPUTSTREAM))) do (if (EOFP INPUTSTREAM)
then (CLOSEF? INPUTSTREAM))
(BLOCK])
(TALK.START.IP.SERVER
[LAMBDA (RESTART) (* ; "Edited 17-Jun-88 12:20 by cdl")
[LET [(DEVICE (\GETDEVICEFROMNAME 'TCP 'NOERROR 'DONTCREATE]
(if DEVICE
then (* (Temporary) patch to make TCP
 streams handle NS character codes)
(with FDEV DEVICE (if (NULL READCHARCODE)
then (SETQ READCHARCODE (FUNCTION \GENERIC.READCCODE
]
(bind PROCESS while (AND (SETQ PROCESS (FIND.PROCESS 'TALK.IP.SERVER))
RESTART) do (DEL.PROCESS PROCESS)
(BLOCK)
yield (if PROCESS
then PROCESS
elseif \IP.READY
then (ADD.PROCESS '(TALK.IP.SERVER)
'RESTARTABLE
'SYSTEM])
)
(RPAQ? TALK.UDP.PORT 517)
(DECLARE%: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS TALK.UDP.PORT TALK.IP.CONSTANTS)
)
(DECLARE%: DONTCOPY
(DECLARE%: EVAL@COMPILE
(ACCESSFNS TALK.IP.PACKET [(TALK.PACKET.BASE (with UDP DATUM UDPCONTENTS))
(TALK.IP.USERNAME (\GETBASESTRING (with UDP DATUM UDPCONTENTS)
6
(with TALK.IP.PACKET DATUM
TALK.USERNAME.LENGTH]
(BLOCKRECORD TALK.PACKET.BASE ((TALK.SERVICE.BYTE BYTE)
(TALK.STATUS BYTE)
(TALK.TEDIT.PORT WORD)
(TALK.USERNAME.LENGTH WORD))))
)
(RPAQQ TALK.IP.CONSTANTS ((\IPTALK.SUCCESS 0)
(\IPTALK.NOSERVICE 1)
(\IPTALK.NOANSWER 2)))
(DECLARE%: EVAL@COMPILE
(RPAQQ \IPTALK.SUCCESS 0)
(RPAQQ \IPTALK.NOSERVICE 1)
(RPAQQ \IPTALK.NOANSWER 2)
(CONSTANTS (\IPTALK.SUCCESS 0)
(\IPTALK.NOSERVICE 1)
(\IPTALK.NOANSWER 2))
)
)
(* etc)
(FILESLOAD TALK TCP TCPUDP)
(APPENDTOVAR TALK.PROTOCOLTYPES (IP DODIP.HOSTP TALK.IP.USERNAME TALK.IP.CONNECT TALK.IP.EVENT
TALK.START.IP.SERVER))
(DECLARE%: DONTCOPY DONTEVAL@LOAD EVAL@COMPILE
(FILESLOAD ETHERRECORDS TCPEXPORTS)
)
(TALK.START.IP.SERVER)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (1313 4720 (TALK.IP.SERVER 1323 . 4718)) (4721 11119 (TALK.IP.USERNAME 4731 . 5475) (
TALK.IP.CONNECT 5477 . 9538) (TALK.IP.EVENT 9540 . 9963) (TALK.START.IP.SERVER 9965 . 11117)))))
STOP

319
obsolete/lispusers/NSTALK
View File

@@ -1,319 +0,0 @@
(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")
(FILECREATED "27-Jul-88 09:09:52" |{MCS:MCS:STANFORD}<LANE>NSTALK.;3| 16112
changes to%: (FNS DEFINE.GAP.SERVER)
previous date%: "16-Jun-88 17:33:04" |{MCS:MCS:STANFORD}<LANE>NSTALK.;1|)
(PRETTYCOMPRINT NSTALKCOMS)
(RPAQQ NSTALKCOMS ((* TALK NS (GAP)
Interface)
(LOCALVARS . T)
(FNS CH.USER.WORKSTATION TALK.NS.SERVER)
(FNS TALK.NS.USERNAME TALK.NS.CONNECT TALK.NS.EVENT TALK.NS.CREDENTIALS)
(* GAP Server)
(FNS GAP.SERVER DEFINE.GAP.SERVER)
(INITVARS GAP.SERVICETYPES [TALK.GAP.HANDLE '((0 0]
(TALK.GAP.UNKNOWN "(Viewpoint or XDE User)"))
(VARS TALK.GAP.PARAMETERS TALK.GAP.TRANSPORT)
(GLOBALVARS GAP.SERVICETYPES TALK.GAP.HANDLE TALK.GAP.UNKNOWN
TALK.GAP.PARAMETERS TALK.GAP.TRANSPORT)
(DECLARE%: DONTCOPY (RECORDS GAP.SERVICETYPE))
(* etc)
(FILES TALK COURIERSERVE)
(APPENDVARS (TALK.PROTOCOLTYPES (NS COERCE-TO-NSADDRESS TALK.NS.USERNAME
TALK.NS.CONNECT TALK.NS.EVENT
COURIER.START.SERVER)))
[DECLARE%: DOCOPY (COMS (DECLARE%: EVAL@LOADWHEN (NOT (HASDEF 'GAP
'COURIERPROGRAM))
(FILES NSTALKGAP]
(* DECLARE%: DONTCOPY DONTEVAL@LOAD EVAL@COMPILE (FILES ETHERRECORDS SPPDECLS)
(* Also need to load EXPORTS.ALL))
(* COURIER.RESET.SOCKET used to be defined by TALK, now defined in
COURIERSERVE module)
(APPENDVARS (BEFORELOGOUTFORMS (COURIER.RESET.SOCKET)))
(P (DEFINE.GAP.SERVER)
(COURIER.START.SERVER))))
(* TALK NS (GAP) Interface)
(DECLARE%: DOEVAL@COMPILE DONTCOPY
(LOCALVARS . T)
)
(DEFINEQ
(CH.USER.WORKSTATION
[LAMBDA (USER WORKSTATION) (* ; "Edited 3-Jun-88 09:18 by cdl")
(if WORKSTATION
then (LET (NSADDRESS)
(if (SETQ NSADDRESS (COERCE-TO-NSADDRESS WORKSTATION (ZERO)))
then (CH.DELETE.PROPERTY USER 'ADDRESS.LIST)
(CH.ADD.ITEM.PROPERTY USER 'ADDRESS.LIST (SETQ NSADDRESS (CONS
NSADDRESS
))
'(SEQUENCE NSADDRESS))
(CONS USER NSADDRESS)
else (ERROR WORKSTATION "Address for host not found!")))
else (CH.DELETE.PROPERTY USER 'ADDRESS.LIST])
(TALK.NS.SERVER
[LAMBDA (INPUTSTREAM PROGRAM PROCEDURE PARAMETERS TRANSPORT WAITTIME CREDENTIALS VERIFIER)
(* ; "Edited 15-Jun-88 11:10 by cdl")
(* DECLARATIONS%: (ASSOCRECORD ALST
 (service)))
(LET ((USER (TALK.NS.CREDENTIALS CREDENTIALS))
(ADDRESS (create NSADDRESS
NSSOCKET _ (ZERO) using (SPP.DESTADDRESS INPUTSTREAM)))
SERVICETYPE)
(with GAP.SERVICETYPE [for SERVICETYPE in GAP.SERVICETYPES
thereis (for NUMBER
in (CAR (with ALST TRANSPORT service))
thereis (with GAP.SERVICETYPE
SERVICETYPE (EQP NUMBER
GAP.UNSPECIFIED
]
(if (OR TALK.GAG (NOT (TALK.ANSWER (OR USER TALK.GAP.UNKNOWN)
GAP.SERVICENAME
'NS ADDRESS)))
then (if (AND (EQ GAP.SERVICENAME 'TTY)
(NULL VERIFIER))
then
(* Should be noAnswerOrBusy, but that 915's XDE/Viewpoint so use VERIFIER to
 determine if called by Lisp, can't count on this for future)
'(ABORT serviceNotFound)
else '(ABORT noAnswerOrBusy))
else (COURIER.RETURN INPUTSTREAM PROGRAM PROCEDURE TALK.GAP.HANDLE)
(TALK.PROCESS INPUTSTREAM (SPPOUTPUTSTREAM INPUTSTREAM)
GAP.SERVICENAME
'NS
'SERVER USER])
)
(DEFINEQ
(TALK.NS.USERNAME
[LAMBDA (INPUTSTREAM OUTPUTSTREAM SERVICETYPE MODE USER)
(* ; "Edited 9-Jun-88 12:42 by cdl")
(LET (OBJECT NAME (SERVICE (with TALK.SERVICETYPE SERVICETYPE TALK.SERVICENAME)))
(DECLARE (GLOBALVARS LOCAL.CLEARINGHOUSE CH.NET.HINT))
(if (OR (EQ SERVICE 'TEdit)
(EQ MODE 'CLIENT))
then (if (STREQUAL (SETQ NAME (USERNAME))
(CONSTANT null))
then (SETQ NAME NIL)
elseif (OR LOCAL.CLEARINGHOUSE CH.NET.HINT)
then (if (SETQ OBJECT (CH.LOOKUP.OBJECT NAME))
then (SETQ NAME OBJECT)))
(PRINTOUT OUTPUTSTREAM NAME T)
(FORCEOUTPUT OUTPUTSTREAM))
(if (OR (EQ SERVICE 'TEdit)
(EQ MODE 'SERVER))
then (if (SETQ OBJECT (RATOM INPUTSTREAM TALK.READTABLE))
then (SETQ USER OBJECT)) (* Eat EOL)
(BIN INPUTSTREAM))
(SELECTQ SERVICE
(TTY (with SPPCON (with SPPSTREAM OUTPUTSTREAM SPP.CONNECTION)
(SETQ SPPEOMONFORCEOUT T)))
NIL)
USER])
(TALK.NS.CONNECT
[LAMBDA (HOST SERVICETYPES) (* ; "Edited 15-Jun-88 10:40 by cdl")
(* DECLARATIONS%: (RECORD
 AUTHENTICATOR (CREDENTIALS VERIFIER)))
(PROG (USER STREAM SERVICETYPE RESULT (CREDENTIALS (with AUTHENTICATOR (CH.GETAUTHENTICATOR
T)
CREDENTIALS))
(VERIFIER (with AUTHENTICATOR (CH.GETAUTHENTICATOR)
VERIFIER)))
(DECLARE (GLOBALVARS SPP.USER.TIMEOUT))
(if (SETQ STREAM (COURIER.OPEN HOST NIL T (PACK* 'TALK# HOST)))
then
(if
(SETQ SERVICETYPE
(for SERVICETYPE in SERVICETYPES
thereis
(SELECTQ [CAR
(SETQ RESULT
(COURIER.CALL
STREAM
'GAP
'Create TALK.GAP.PARAMETERS
`([service (,(with GAP.SERVICETYPE
[for TYPE in GAP.SERVICETYPES
thereis (with GAP.SERVICETYPE TYPE
(with TALK.SERVICETYPE
SERVICETYPE
(EQ GAP.SERVICENAME
TALK.SERVICENAME]
GAP.UNSPECIFIED]
,@TALK.GAP.TRANSPORT)
SPP.USER.TIMEOUT CREDENTIALS VERIFIER 'RETURNERRORS]
(ERROR (SELECTQ (CADR RESULT)
(noAnswerOrBusy (* User hung up or didn't answer,
 don't try another service)
(RETURN))
(serviceNotFound
(* Old Lisp TTY service returns this when it really means noAnswerOrBusy for
 compatibility with Tajo/Viewpoint.)
(if (with TALK.SERVICETYPE SERVICETYPE
(EQ TALK.SERVICENAME 'TTY))
then
(* Don't try services following TTY service for NS we don't know if remote
 service wasn't there or remote user refused connection so we may annoy the
 remote user, of course we may miss a possible connection)
(RETURN)))
NIL))
RESULT)))
then [RETURN (CONS SERVICETYPE (CONS STREAM (SPPOUTPUTSTREAM STREAM]
else (CLOSEF? STREAM)
(RETURN 'ANSWER))
else (RETURN 'CONNECT])
(TALK.NS.EVENT
[LAMBDA (INPUTSTREAM OUTPUTSTREAM) (* cdl "10-Jun-87 07:55")
(if (AND (OPENP INPUTSTREAM)
(OPENP OUTPUTSTREAM)
(NOT (READP INPUTSTREAM)))
then (AWAIT.EVENT (with SPPCON (with SPPSTREAM INPUTSTREAM SPP.CONNECTION)
SPPINPUTEVENT)))
(if (OPENP INPUTSTREAM)
then (SELECTQ (EOFP INPUTSTREAM)
(ATTENTION (SPP.CLEARATTENTION INPUTSTREAM)
(BIN INPUTSTREAM))
(EOM (SPP.CLEAREOM INPUTSTREAM))
(T (CLOSEF INPUTSTREAM))
NIL])
(TALK.NS.CREDENTIALS
[LAMBDA (CREDENTIALS) (* cdl " 6-May-87 15:58")
(if (AND CREDENTIALS (SETQ CREDENTIALS (CADR CREDENTIALS)))
then (SUBATOM (COURIER.READ.REP CREDENTIALS 'CLEARINGHOUSE 'NAME)
1 -2])
)
(* GAP Server)
(DEFINEQ
(GAP.SERVER
[LAMBDA (STREAM PROGRAM PROCEDURE PARAMETERS TRANSPORT WAITTIME CREDENTIALS VERIFIER)
(* ; "Edited 9-Jun-88 12:06 by cdl")
(* DECLARATIONS%: (ASSOCRECORD ALST
 (service)))
(LET (SERVICETYPE)
(if [OR [for NUMBER in (CAR (with ALST TRANSPORT service))
thereis (SETQ SERVICETYPE (for SERVICETYPE in GAP.SERVICETYPES
thereis (with GAP.SERVICETYPE
SERVICETYPE
(AND (EQP NUMBER
GAP.UNSPECIFIED
)
GAP.SERVERFN]
(AND (SETQ SERVICETYPE (ASSOC T GAP.SERVICETYPES))
(with GAP.SERVICETYPE SERVICETYPE
(* There was a server in place
 before TALK was loaded)
(FGETD GAP.SERVERFN]
then (APPLY* (with GAP.SERVICETYPE SERVICETYPE GAP.SERVERFN)
STREAM PROGRAM PROCEDURE PARAMETERS TRANSPORT WAITTIME CREDENTIALS
VERIFIER)
else '(ABORT serviceNotFound])
(DEFINE.GAP.SERVER
[LAMBDA NIL (* ; "Edited 27-Jul-88 09:08 by cdl")
(* DECLARATIONS%: (ASSOCRECORD
 PROCEDURES (Create))
 (PROPRECORD PROCEDURE
 (IMPLEMENTEDBY)))
(if (HASDEF 'GAP 'COURIERPROGRAM)
then (PROG [SERVERFN PROCEDURE (COURIERDEF (GETDEF 'GAP 'COURIERPROGRAM]
[with COURIERPGM COURIERDEF (SETQ PROCEDURE (with PROCEDURES
PROCEDURES Create))
[if (SETQ SERVERFN (with PROCEDURE PROCEDURE IMPLEMENTEDBY))
then (if (EQ SERVERFN 'GAP.SERVER)
then (RETURN))
(* Make the existing GAP server the
 default)
(if GAP.SERVICETYPES
then (PUTASSOC T `(DEFAULT ,SERVERFN)
GAP.SERVICETYPES)
else (push GAP.SERVICETYPES
`(T DEFAULT ,SERVERFN]
(with PROCEDURE PROCEDURE (SETQ IMPLEMENTEDBY 'GAP.SERVER]
(PUTDEF 'GAP 'COURIERPROGRAM COURIERDEF)
(UNMARKASCHANGED 'GAP 'COURIERPROGRAM))
else (ERROR "Courier program GAP not defined!"])
)
(RPAQ? GAP.SERVICETYPES NIL)
(RPAQ? TALK.GAP.HANDLE '((0 0)))
(RPAQ? TALK.GAP.UNKNOWN "(Viewpoint or XDE User)")
(RPAQQ TALK.GAP.PARAMETERS (ttyHost (seven even two 100 (none 0 0))))
(RPAQQ TALK.GAP.TRANSPORT ((teletype)))
(DECLARE%: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS GAP.SERVICETYPES TALK.GAP.HANDLE TALK.GAP.UNKNOWN TALK.GAP.PARAMETERS TALK.GAP.TRANSPORT)
)
(DECLARE%: DONTCOPY
(DECLARE%: EVAL@COMPILE
(RECORD GAP.SERVICETYPE (GAP.UNSPECIFIED GAP.SERVICENAME GAP.SERVERFN))
)
)
(* etc)
(FILESLOAD TALK COURIERSERVE)
(APPENDTOVAR TALK.PROTOCOLTYPES (NS COERCE-TO-NSADDRESS TALK.NS.USERNAME TALK.NS.CONNECT
TALK.NS.EVENT COURIER.START.SERVER))
(DECLARE%: DOCOPY
(DECLARE%: EVAL@LOADWHEN
(NOT (HASDEF 'GAP 'COURIERPROGRAM))
(FILESLOAD NSTALKGAP)
)
)
(* DECLARE%: DONTCOPY DONTEVAL@LOAD EVAL@COMPILE (FILES ETHERRECORDS SPPDECLS) (* Also need to load
EXPORTS.ALL))
(* COURIER.RESET.SOCKET used to be defined by TALK, now defined in COURIERSERVE module)
(APPENDTOVAR BEFORELOGOUTFORMS (COURIER.RESET.SOCKET))
(DEFINE.GAP.SERVER)
(COURIER.START.SERVER)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (2304 5420 (CH.USER.WORKSTATION 2314 . 3215) (TALK.NS.SERVER 3217 . 5418)) (5421 11213 (
TALK.NS.USERNAME 5431 . 6816) (TALK.NS.CONNECT 6818 . 10218) (TALK.NS.EVENT 10220 . 10917) (
TALK.NS.CREDENTIALS 10919 . 11211)) (11237 14919 (GAP.SERVER 11247 . 13041) (DEFINE.GAP.SERVER 13043
. 14917)))))
STOP

23
obsolete/lispusers/NSTALKGAP
View File

File diff suppressed because one or more lines are too long