(DEFINE-FILE-INFO §READTABLE "INTERLISP" §PACKAGE "INTERLISP")

(FILECREATED "19-Jan-87 23:56:51" {ERIS}<LISPUSERS>LISPCORE>LAFITEPRIVATEDL.;1
 10080  

      previous date%: "19-Jan-87 23:47:54" {PHYLUM}<LISPUSERS>KOTO>LAFITEPRIVATEDL.;2)


(* "
Copyright (c) 1986, 1987 by Xerox Corporation.  All rights reserved.
")

(PRETTYCOMPRINT LAFITEPRIVATEDLCOMS)

(RPAQQ LAFITEPRIVATEDLCOMS
 ((* * LAFITEDL.EXT is the default extension for dl files when no extension 
                               is specified)
                            (* * LAFITEDLDIRECTORIES is a list of directories to be searched after 
                               the connected directory and the LAFITEDEFAULTHOST&DIR in order to 
                               locate a dl file when no host or directory is specified)
                            (INITVARS (LAFITEDL.EXT 'DL)
                                   (LAFITEDLDIRECTORIES NIL))
                            (* * no functions are user callable)
                            (FNS \GV.PARSERECIPIENTS1 \GV.PARSE.PRIVATE.DISTRIBUTION.LIST)
                            (* Lafite's readtable for parsing addresses needs to have CR as a 
                               SEPRCHAR so that lines from a text file can all be parsed at once. 
                               This has no effect on normal operation since before private dls no CR 
                               was ever passed to the parser)
                            (P (SETSYNTAX (CHARCODE CR)
                                      'SEPRCHAR ADDRESSPARSERRDTBL))))
(* * LAFITEDL.EXT is the default extension for dl files when no extension is specified)


(* * LAFITEDLDIRECTORIES is a list of directories to be searched after the connected directory and the
 LAFITEDEFAULTHOST&DIR in order to locate a dl file when no host or directory is specified)



(RPAQ? LAFITEDL.EXT
 'DL)

(RPAQ? LAFITEDLDIRECTORIES
 NIL)
(* * no functions are user callable)


(DEFINEQ

(\GV.PARSERECIPIENTS1

  [LAMBDA (FIELD REGISTRY INTERNALFLG EDITWINDOW)
            (* N.H.Briggs "19-Jan-87 23:44")


(* ;;; "INTERNALFLG = T means produce addresses to give Grapevine;  NIL means give human-readable addresses")


    (PROG (FIELDSTREAM ADDRESSES ADDR TOKEN)
          (COND
             ((NULL FIELD)
              (RETURN)))
          (SETQ FIELDSTREAM (if
 (STRINGP FIELD)
                                then
 (OPENSTRINGSTREAM FIELD)
                              else
                           (* ; 

                                                             "FIELD should already be an open stream")

                                   FIELD))
          [SETFILEINFO FIELDSTREAM 'ENDOFSTREAMOP (FUNCTION (LAMBDA (STREAM)
                                                             (* ; "Terminate anything in progress")

                                                              (SELECTQ (STREAMPROP STREAM
                                                                              'EOFCOUNT)
                                                                  (NIL 
                                                             (* ; "First try terminating with comma")

                                                                       (STREAMPROP STREAM
                                                                              'EOFCOUNT 1)
                                                                       (CHARCODE %,))
                                                                  (1 
                                                             (* ; 

                                                 "Must be something unbalanced.  Try closing a paren")

                                                                     (STREAMPROP STREAM 'EOFCOUNT 2)
                                                                     (CHARCODE %)))
                                                                  (2 
                                                             (* ; 

                                                          "Still unbalanced, must have been a string")

                                                                     (STREAMPROP STREAM 'EOFCOUNT 3)
                                                                     (CHARCODE %"))
                                                                  (HELP]
          (OR REGISTRY (SETQ REGISTRY DEFAULTREGISTRY))
          
          (* ;; "first just collect all the atoms using a special readtable ")


          (SETQ ADDRESSES (when
 (SETQ ADDR (until
 (OR (EOFP FIELDSTREAM)
                                                      (EQ (SETQ TOKEN (READ FIELDSTREAM 
                                                                            ADDRESSPARSERRDTBL))
                                                          '%,)) when
 (PROGN 
                                                             (* ; "Lists are comments")

                                                                            (NLISTP TOKEN))
                                              collect
 TOKEN)) collect
 ADDR repeatuntil
 (EOFP 
                                                                                          FIELDSTREAM
                                                                                             )))
          [SELECTQ (STREAMPROP FIELDSTREAM 'EOFCOUNT)
              ((NIL 1)                                       (* ; "Okay")

                   )
              (COND
                 [EDITWINDOW (\SENDMESSAGEFAIL EDITWINDOW (if
 (STRINGP FIELD)
                                                              then
 "Malformed address(es): "
                                                            else
 (CONCAT "Malformed address(es) [in "
                                                                        (FULLNAME FIELDSTREAM)
                                                                        "]: "))
                                    (COND
                                       ((EQ (STREAMPROP FIELDSTREAM 'EOFCOUNT)
                                            2)
                                        "Unbalanced parentheses")
                                       (T "Unbalanced quotes"]
                 (T (RETURN (CONS]
          (RETURN (for
 ADDRESS in
 ADDRESSES bind
 REALADDRESS VALIDRECIPIENT CLOSE OPEN
                     join
 (if
 (AND (EQ (CADR ADDRESS)
                                       '%:)
                                   (NULL (CDDDR ADDRESS))
                                   (EQ (CADDR ADDRESS)
                                       ';))
                              then
 
          
          (* ;; "it's a private dl --- foo:;")


                                   (\GV.PARSE.PRIVATE.DISTRIBUTION.LIST
 ADDRESS REGISTRY INTERNALFLG 
                                          EDITWINDOW)
                            else
 
          
          (* ;; "ADDRESS will only get rebound if there is an address with <>'s in it ")


                                 (SETQ VALIDRECIPIENT (\GV.PARSE.SINGLE.ADDRESS
                                                       (COND
                                                          ([AND (SETQ OPEN (FMEMB '< ADDRESS))
                                                                (SETQ CLOSE (FMEMB '> (CDR OPEN]
                                                           (SETQ REALADDRESS (LDIFF (CDR OPEN)
                                                                                    CLOSE)))
                                                          (T ADDRESS))
                                                       REGISTRY INTERNALFLG EDITWINDOW))
                                 (LIST (COND
                                          ((OR T INTERNALFLG (NULL REALADDRESS))
                                           VALIDRECIPIENT)
                                          (T 
          
          (* ;; "Need to figure out how to make GETREGISTRY of this work, and remove duplicates in MAKEANSWERFORM before we can enable this")


                                             (\GV.REPACKADDRESS (APPEND (LDIFF ADDRESS OPEN)
                                                                       (LIST '< VALIDRECIPIENT
                                                                             '>)
                                                                       (CDR CLOSE])

(\GV.PARSE.PRIVATE.DISTRIBUTION.LIST

  [LAMBDA (DL REGISTRY INTERNALFLG EDITWINDOW)
               (* N.H.Briggs "19-Jan-87 23:45")

    (LET* [(FILENAME (FINDFILE (PACKFILENAME.STRING 'BODY (CAR DL)
                                      'EXTENSION LAFITEDL.EXT)
                            T
                            (CONS LAFITEDEFAULTHOST&DIR LAFITEDLDIRECTORIES)))
           (STREAM (AND FILENAME (CAR (NLSETQ (OPENTEXTSTREAM (OPENSTREAM FILENAME 'INPUT
                                                                     'OLD]
          (if
 (NOT STREAM)
              then
 (if
 EDITWINDOW
                       then
 (\SENDMESSAGEFAIL EDITWINDOW (CONCAT "Can't open dl file " (CAR DL)))
                     else
 (PROMPTPRINT "Can't open dl file " (CAR DL)))
                   (CONS)
            else
 (if
 INTERNALFLG
                     then
 (PROG1 (\GV.PARSERECIPIENTS1
 STREAM REGISTRY INTERNALFLG EDITWINDOW)
                                 (CLOSEF? STREAM))
                   else
 (CLOSEF STREAM)
                        (LIST (\GV.REPACKADDRESS DL])
)



(* Lafite's readtable for parsing addresses needs to have CR as a SEPRCHAR so that lines from a text 
file can all be parsed at once. This has no effect on normal operation since before private dls no CR 
was ever passed to the parser)


(SETSYNTAX (CHARCODE CR)
       'SEPRCHAR ADDRESSPARSERRDTBL)
(PUTPROPS LAFITEPRIVATEDL COPYRIGHT ("Xerox Corporation" 1986 1987))
(DECLARE%: DONTCOPY
  (FILEMAP (NIL (1965 9682 (\GV.PARSERECIPIENTS1 1975 . 8562) (\GV.PARSE.PRIVATE.DISTRIBUTION.LIST 8564
 . 9680)))))
STOP