(FILECREATED "19-Jan-87 23:47:54" {PHYLUM}<LISPUSERS>KOTO>LAFITEPRIVATEDL.;2
 7379   

      changes to:  (FNS \GV.PARSERECIPIENTS1 \GV.PARSE.PRIVATE.DISTRIBUTION.LIST)

      previous date: "29-Aug-86 18:08:17" {PHYLUM}<LISPUSERS>KOTO>LAFITEPRIVATEDL.;1)


(* 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 (QUOTE 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)
					    (QUOTE 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
 (QUOTE 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 (
QUOTE
 ENDOFSTREAMOP)
			   (
FUNCTION
 (LAMBDA (STREAM)      (* ; "Terminate anything in progress")

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

					       (
STREAMPROP
 STREAM (
QUOTE
 EOFCOUNT)
							     1)
					       (
CHARCODE
 ,))
					  (1                 (* ; 

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

					     (
STREAMPROP
 STREAM (
QUOTE
 EOFCOUNT)
							   2)
					     (
CHARCODE
 %)))
					  (2                 (* ; "Still unbalanced, must have been a string")

					     (
STREAMPROP
 STREAM (
QUOTE
 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))
									(
QUOTE
 ,)))
						      when
 (
PROGN
 
                                                             (* ; "Lists are comments")

								      (
NLISTP
 TOKEN))
						      collect
 TOKEN))
				 collect
 ADDR repeatuntil
 (
EOFP
 FIELDSTREAM)))
	    [
SELECTQ
 (
STREAMPROP
 FIELDSTREAM (
QUOTE
 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
										(
QUOTE
 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)
						   (
QUOTE
 :
))
					     (
NULL
 (
CDDDR
 ADDRESS))
					     (
EQ
 (
CADDR
 ADDRESS)
						   (
QUOTE
 ;)))
				    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
 (
QUOTE
 <
)
									     ADDRESS))
						       (
SETQ
 CLOSE (
FMEMB
 (
QUOTE
 >
)
									      (
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
 (
QUOTE
 <
)
									  VALIDRECIPIENT
									  (
QUOTE
 >
))
								  (
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
 (
QUOTE
 BODY)
							(
CAR
 DL)
							(
QUOTE
 EXTENSION)
							LAFITEDL.EXT)
				 T
				 (
CONS
 LAFITEDEFAULTHOST&DIR LAFITEDLDIRECTORIES)))
	   (STREAM (
AND
 FILENAME (
CAR
 (
NLSETQ
 (
OPENTEXTSTREAM
 (
OPENSTREAM
 FILENAME
										    (
QUOTE
 INPUT)
										    (
QUOTE
 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)
	   (QUOTE SEPRCHAR)
	   ADDRESSPARSERRDTBL)
(PUTPROPS LAFITEPRIVATEDL COPYRIGHT ("Xerox Corporation" 1986 1987))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (1679 6974 (\GV.PARSERECIPIENTS1 1689 . 5952) (\GV.PARSE.PRIVATE.DISTRIBUTION.LIST 5954
 . 6972)))))
STOP