(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")
(FILECREATED " 8-Jul-88 11:10:20" {ERINYES}<LISPUSERS>LYRIC>GRAPHGROUP.;2 13377
changes to%: (MACROS \WIN)
(VARS GRAPHGROUPCOMS)
previous date%: "17-Aug-86 17:06:37" {ERINYES}<LISPUSERS>LYRIC>GRAPHGROUP.;1)
(* "
Copyright (c) 1986, 1988 by Xerox Corporation. All rights reserved.
")
(PRETTYCOMPRINT GRAPHGROUPCOMS)
(RPAQQ GRAPHGROUPCOMS
((VARS \GraphGroupGVtoNSRegistryMapping \NAMETYPE.NSGROUP \NAMETYPE.NSINDIVIDUAL)
(FNS GraphGroup \GraphGroupGVisNSP \GraphGroupReadNSEntry)
(FILES GRAPEVINE MAINTAIN)
(DECLARE%: EVAL@COMPILE DONTCOPY (FILES (LOADCOMP)
MAINTAIN)
(MACROS \WIN))
(FNS \GraphGroupAux \GraphGroupReadFn \GraphGroupReadMapping)))
(RPAQQ \GraphGroupGVtoNSRegistryMapping
((ALLAREAS . "ALL AREAS:XEROX")
(AYLRX . "AYL:RX")
(AYLTSDRX . "AYLTSD:RX")
(BRIDGEHOUSERXUK . "BRIDGE HOUSE:RXUK")
(BROOKRIVER . "BROOKRIVER:XEROX")
(BUSRX . "BUS:RX")
(CB19RXF . "CB19:RXF")
(CINOPS . "CIN OPS:XEROX")
(DLOSCE . "DLOSCE:XEROX")
(DLOSCSS . "DLOSCSS:XEROX")
(DLOSETRON . "DLOSETRON:XEROX")
(DLOSL300 . "DLOSL300:XEROX")
(DLOSLC . "DLOSLC:XEROX")
(DLOSLV . "DLOSLV:XEROX")
(DLOSLV-COMM . "DLOSLV-COMM:XEROX")
(DLOSNSC . "DLOSNSC:XEROX")
(DTSSIEMENS . "DTS:SIEMENS")
(EDSERVICES . "EDSERVICES:LEESBURG")
(EIS . "EIS:VERSATEC")
(ELSEGUNDO . "EL SEGUNDO:XEROX")
(ESAREA . "ES AREA:XEROX")
(ESCP8 . "ES CP8:XEROX")
(ESGSDWCO . "ES GSD/WCO:XEROX")
(ESM4RED . "ES M4 RED:XEROX")
(ESPOORXSF . "ESPOO:RXSF")
(ESXC15 . "ES XC15:XEROX")
(ESXC16 . "ES XC16:XEROX")
(ESXCOST . "ES XC OST:XEROX")
(HENR801G . "HENR801G:XEROX")
(HKRXS . "HK:RXS")
(IHAIL . "IH:AIL")
(IWAFX . "IWA:FUJI XEROX")
(NSC . "NSC:XEROX")
(NSC-50 . "NSC-5.0:XEROX")
(OSBUBAYSHORE . "OSBU BAYSHORE:XEROX")
(OSBUNORTH . "OSBU NORTH:XEROX")
(OSBURX . "OSBU:RX")
(OSBUSOUTH . "OSBU SOUTH:XEROX")
(OSDASSOCIATES . "OSD ASSOCIATES:XEROX")
(OSSERVICE . "OS SERVICE:XEROX")
(PAAREA . "PA AREA:XEROX")
(PARC . "PARC:XEROX")
(PARC-MES . "PARC-MES:XEROX")
(PAVISITORS . "VISITORS PA:XEROX VISITORS")
(PQANET1 . "PQANET1:XEROX")
(PQANET2 . "PQANET2:XEROX")
(PQANET3 . "PQANET3:XEROX")
(RDES . "RDES:VERSATEC")
(ROCH . "ROCH:XEROX")
(ROCH805 . "ROCH805:XEROX")
(ROCH888 . "ROCH888:XEROX")
(RXH . "RXH:RX")
(RXHRX . "RXH:RX")
(SANDIEGOXCSS . "SAN DIEGO:XCSS")
(SBDERX . "SBD-E:RX")
(SBDRXN . "SBD:RXN")
(SHINJUKUMIZUNOFX . "SHINJUKU MIZUNO:FUJI XEROX")
(SOLNAMORXS . "SOLNA-MO:RXS")
(STHQ . "STHQ:XEROX")
(SUNNYVALE . "SUNNYVALE:XEROX")
(TESTLABORPNIDSIEMENS . "TESTLABOR PN ID:SIEMENS")
(TORHO . "TOR HO:XCI")
(TSC . "TSC:XEROX")
(VEN1RX . "VEN1:RX")
(VISTA . "VISTA:XEROX")
(WBST102A . "WBST102A:XEROX")
(WBST105 . "WBST105:XEROX")
(WBST105B . "WBST105B:XEROX")
(WBST114 . "WBST114:XEROX")
(WBST128 . "WBST128:XEROX")
(WBST129 . "WBST129:XEROX")
(WBST129UL . "WBST129UL:XEROX")
(WBST139 . "WBST139:XEROX")
(WBST147 . "WBST147:XEROX")
(WBST207V . "WBST207V:XEROX")
(WBST311 . "WBST311:XEROX")
(WBSTAREA . "WBST AREA:XEROX")
(WGCERX . "WGC-E:RX")
(WNDC . "WNDC:XEROX")
(XRCC-NS . "XRCC:XEROX")
(XSIS . "XSIS:XEROX")
(XSISHQ . "XSIS-HQ:XEROX")
(ZTISOFSIEMENS . "ZTISOF:SIEMENS")
(ZURICHRXCH . "ZURICH:RXCH")))
(RPAQQ \NAMETYPE.NSGROUP 3)
(RPAQQ \NAMETYPE.NSINDIVIDUAL 2)
(DEFINEQ
(GraphGroup
[LAMBDA (Group InfoStream LayoutOptions ExpandNSGroups) (* N.H.Briggs "17-Aug-86 16:51")
(LET ((Entry (GV.READENTRY Group NIL (FUNCTION \GraphGroupReadFn)))
GroupStructure)
(SETQ GroupStructure (\GraphGroupAux Entry InfoStream ExpandNSGroups))
[SHOWGRAPH (LAYOUTSEXPR GroupStructure (LISTGET LayoutOptions 'FORMAT)
(LISTGET LayoutOptions 'BOXING)
(OR (LISTGET LayoutOptions 'FONT)
(FONTCREATE 'CLASSIC 10))
(LISTGET LayoutOptions 'MOTHERD)
(LISTGET LayoutOptions 'PERSONALD)
(LISTGET LayoutOptions 'FAMILYD]
(AND InfoStream (FRESHLINE InfoStream))
GroupStructure])
(\GraphGroupGVisNSP
[LAMBDA (Address) (* N.H.Briggs "17-Aug-86 16:42")
(* determine if a name returned by
Grapevine is in fact an NS name)
(LET ((GVAddress (\GV.PARSERECIPIENTS1 Address DEFAULTREGISTRY T)))
(if (SETQ DomainAndOrganization (CDR (FASSOC (U-CASE (CDAR GVAddress))
\GraphGroupGVtoNSRegistryMapping)))
then (CONCAT (CAAR GVAddress)
":" DomainAndOrganization])
(\GraphGroupReadNSEntry
[LAMBDA (Address) (* N.H.Briggs "17-Aug-86 16:33")
(LET [(Properties (CAR (NLSETQ (CH.LIST.PROPERTIES Address]
(if (MEMB 3 (CADR Properties))
then (* it's a group)
(LIST \NAMETYPE.NSGROUP (CAR Properties))
elseif (MEMB 10003 (CADR Properties))
then (* it's an individual)
(LIST \NAMETYPE.NSINDIVIDUAL (CAR Properties])
)
(FILESLOAD GRAPEVINE MAINTAIN)
(DECLARE%: EVAL@COMPILE DONTCOPY
(FILESLOAD (LOADCOMP)
MAINTAIN)
(DECLARE%: EVAL@COMPILE
(PUTPROPS \WIN MACRO ((Stream)
(LOGOR (LSH (\BIN Stream)
8)
(\BIN Stream))))
)
)
(DEFINEQ
(\GraphGroupAux
[LAMBDA (Entry InfoStream ExpandNSGroups) (* N.H.Briggs "17-Aug-86 16:51")
(SELECTC (CAR Entry)
(\NAMETYPE.INDIVIDUAL
(AND InfoStream (printout InfoStream "."))
[if (NULL (CDDR Entry))
then (MKATOM (CADR Entry))
else (* there is forwarding)
(LIST (MKATOM (CADR Entry))
(LET [(FwdEntry (GV.READENTRY (CADDR Entry)
NIL
(FUNCTION \GraphGroupReadFn]
(if (EQ FwdEntry 'BadRName)
then (AND InfoStream (printout InfoStream "?"))
(MKATOM (CADDR Entry))
else (\GraphGroupAux FwdEntry InfoStream])
(\NAMETYPE.NSINDIVIDUAL
(AND InfoStream (printout InfoStream ".")) (* isn't any forwarding in NS mail)
(MKATOM (CADR Entry)))
(\NAMETYPE.GROUP
[LET [(Members (GV.READMEMBERS (CADR Entry]
[AND InfoStream (printout InfoStream "[" (SUB1 (LENGTH Members]
(PROG1
[CONS (CADR Entry)
(for Member in Members when (NEQ (TYPENAME Member)
'TIMESTAMP)
collect (LET [(MemberEntry (GV.READENTRY Member NIL
(FUNCTION \GraphGroupReadFn]
(if (EQ MemberEntry 'BadRName)
then (if (AND ExpandNSGroups (SETQ MemberNSName
(\GraphGroupGVisNSP
Member))
(SETQ MemberNSEntry (
\GraphGroupReadNSEntry
MemberNSName)))
then (\GraphGroupAux MemberNSEntry
InfoStream ExpandNSGroups)
else (AND InfoStream (printout InfoStream "?")
)
(MKATOM Member))
else (\GraphGroupAux MemberEntry InfoStream
ExpandNSGroups]
(AND InfoStream (printout InfoStream "]")))])
(\NAMETYPE.NSGROUP
[LET [(Members (CH.RETRIEVE.MEMBERS (CADR Entry)
'MEMBERS]
(AND InfoStream (printout InfoStream "[" (LENGTH Members)))
(PROG1 [CONS (CADR Entry)
(for Member in Members
collect (LET ((MemberEntry (\GraphGroupReadNSEntry Member)))
(if (NULL MemberEntry)
then (AND InfoStream (printout InfoStream "?"))
(MKATOM Member)
else (\GraphGroupAux MemberEntry InfoStream
ExpandNSGroups]
(AND InfoStream (printout InfoStream "]")))])
NIL])
(\GraphGroupReadFn
[LAMBDA (Stream) (* N.H.Briggs "16-Jul-86 11:12")
(LET (ComponentCount Result)
(\RECEIVESTAMP Stream T) (* Skip stamp)
(SETQ ComponentCount (\WIN Stream))
(* There is a database entry. First component is the "prefix" %, which contains,
among other things, the name's type and its "official" name)
(\WIN Stream) (* Length of this component)
(\RECEIVESTAMP Stream T) (* Skip stamp)
(SETQ Result (LIST (\WIN Stream)
(\RECEIVERNAME Stream))) (* return the component type and
"official" name)
(if (EQ (CAR Result)
\NAMETYPE.INDIVIDUAL)
then (* should pick up forwarding info)
(\SKIPCOMPONENT Stream) (* password)
(\SKIPCOMPONENT Stream) (* connect site)
(if (NOT (ZEROP (\WIN Stream)))
then (NCONC1 Result (\RECEIVESTRING Stream (\WIN Stream)))
(* forwarding))
(to (IDIFFERENCE ComponentCount 4) do (\SKIPCOMPONENT Stream))
(* throw away the leftovers)
else (* throw away the leftovers)
(to (SUB1 ComponentCount) do (\SKIPCOMPONENT Stream)))
Result])
(\GraphGroupReadMapping
[LAMBDA NIL (* N.H.Briggs "14-Aug-86 23:14")
(LET ((Stream (OPENSTREAM "{INDIGO}<REGISTRAR>GV>GV-NS-MAPPING.TXT" 'INPUT))
(NoSpaceReadTable (COPYREADTABLE 'ORIG))
End)
(SETSEPR (LIST (CHARCODE CR))
NIL NoSpaceReadTable)
(SETBRK (LIST (CHARCODE CR))
NIL NoSpaceReadTable)
(SETQ End (FILEPOS "NS-to-GV Mappings:" Stream 1 NIL NIL NIL (UPPERCASEARRAY)))
(FILEPOS "GV-to-NS Mappings:" Stream 1 NIL NIL NIL (UPPERCASEARRAY))
(FILEPOS "." Stream NIL NIL NIL T)
(until (GREATERP (GETFILEPTR Stream)
End) collect (SETQ Registry (READ Stream))
(READ Stream)
(SKIPSEPRS Stream)
(SETQ DomainOrg (RSTRING Stream NoSpaceReadTable))
(FILEPOS "." Stream NIL NIL NIL T)
(CONS Registry DomainOrg])
)
(PUTPROPS GRAPHGROUP COPYRIGHT ("Xerox Corporation" 1986 1988))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (4018 6109 (GraphGroup 4028 . 4841) (\GraphGroupGVisNSP 4843 . 5512) (
\GraphGroupReadNSEntry 5514 . 6107)) (6417 13290 (\GraphGroupAux 6427 . 10421) (\GraphGroupReadFn
10423 . 12210) (\GraphGroupReadMapping 12212 . 13288)))))
STOP