(FILECREATED "17-Aug-86 17:06:37" {QV}<BRIGGS>LISP>GRAPHGROUP.;8 12122
changes to: (FNS GraphGroup \GraphGroupAux \GraphGroupReadNSEntry \GraphGroupGVisNSP
\GraphGroupReadMapping)
(VARS GRAPHGROUPCOMS \NAMETYPE.NSGROUP \NAMETYPE.NSINDIVIDUAL
\GraphGroupGVtoNSRegistryMapping)
previous date: "23-Jul-86 17:51:32" {QV}<BRIGGS>LISP>GRAPHGROUP.;6)
(* Copyright (c) 1986 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT GRAPHGROUPCOMS)
(RPAQQ GRAPHGROUPCOMS ((FNS GraphGroup \GraphGroupGVisNSP \GraphGroupReadNSEntry)
(FILES GRAPEVINE MAINTAIN)
(DECLARE: EVAL@COMPILE DONTCOPY (FILES (LOADCOMP)
MAINTAIN)
(MACROS \WIN))
(FNS \GraphGroupAux \GraphGroupReadFn \GraphGroupReadMapping)
(VARS \GraphGroupGVtoNSRegistryMapping \NAMETYPE.NSGROUP
\NAMETYPE.NSINDIVIDUAL)))
(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 (QUOTE FORMAT))
(LISTGET LayoutOptions (QUOTE BOXING))
(OR (LISTGET LayoutOptions (QUOTE FONT))
(FONTCREATE (QUOTE CLASSIC)
10))
(LISTGET LayoutOptions (QUOTE MOTHERD))
(LISTGET LayoutOptions (QUOTE PERSONALD))
(LISTGET LayoutOptions (QUOTE 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 (QUOTE 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)
(QUOTE TIMESTAMP))
collect (LET [(MemberEntry (GV.READENTRY
Member NIL
(FUNCTION
\GraphGroupReadFn]
(if (EQ MemberEntry (QUOTE 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)
(QUOTE 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" (QUOTE INPUT)))
(NoSpaceReadTable (COPYREADTABLE (QUOTE 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])
)
(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)
(PUTPROPS GRAPHGROUP COPYRIGHT ("Xerox Corporation" 1986))
(DECLARE: DONTCOPY
(FILEMAP (NIL (858 2872 (GraphGroup 868 . 1697) (\GraphGroupGVisNSP 1699 . 2284) (
\GraphGroupReadNSEntry 2286 . 2870)) (3093 8892 (\GraphGroupAux 3103 . 6215) (\GraphGroupReadFn 6217
. 7872) (\GraphGroupReadMapping 7874 . 8890)))))
STOP