;;; -*- LISP -*-
;;;
;;; Functions defined
;;;
;;;  (OPEN-INQUIR-FILE)
;;;     Must be done before these other things can happen
;;;
;;;  (LOOKUP-INQUIR-INFO <evaluable-uname> <un-eval'd tag>) 
;;;	Macro to look up a certain tag in the INQUIR database
;;;
;;;  (GET-USER-NAME <evaluable-uname>)
;;;
;;;     SUBR returns something of the form 
;;;	  ((last-name first-name middle-name) title lineage alias? nickname)
;;;      or NIL if no such user.
;;;
;;;	TITLE is one a word like [MR, MRS, ... DR, ...] (see code
;;;	 for currently used list)
;;;
;;;     LINEAGE is one of II, III, or JR
;;;
;;;	NIL is returned for unspecified elements. Alias's are tried to be
;;;	 traced through. If something was an alias, the ALIAS? flag is non-NIL
;;;	 all other info is as if it had been info about who it is an alias for.
;;;	 Multiple aliases should be traced through correctly.
;;;
;;;  (CLOSE-INQUIR-FILE)
;;;     Should be done after all LOOKUP-INQUIR-INFO's are done to 
;;;	close our INQUIR disk channel.
;;;

(DEFPROP LSRMAP ((DSK inquir) LSRRTN FASL) AUTOLOAD)

(DECLARE (SPECIAL *INQUIR-FILE-OBJECT*)
	 (*EXPR LSRMAP LSRITM LSRUNM))

(DEFUN OPEN-INQUIR-FILE () ; Allocate 15 pages for this map
       (SETQ *INQUIR-FILE-OBJECT* (LSRMAP 15.))
       T)

(DEFUN CLOSE-INQUIR-FILE ()
       (CLOSE *INQUIR-FILE-OBJECT*)
       T)

(DEFUN LOOKUP-INQUIR-INFO MACRO (FORM)
       (LET (((UNAME DATA) (CDR FORM)))
	    `(LSRITM ',(OR (CDR (ASSQ DATA '((UNAME . 0.)
					     (FULL-NAME . 1.)
					     (NICKNAME . 2.)
					     (SOCIAL-SECURITY-NUMBER . 3.)
					     (MIT-ADDRESS . 4.)
					     (MIT-TELEPHONE-NUMBER . 5.)
					     (HOME-ADDRESS . 6.)
					     (HOME-TELEPHONE-NUMBER . 7.)
					     (SUPERVISOR . 8.)
					     (PROJECT . 9.)
					     (FILE-DIRECTORY-NAMES . 10.)
					     (AUTHORIZATION . 11.)
					     (GROUP-AFFILIATION . 12.)
					     (RELATION TO GROUP . 13.)
					     (BIRTHDAY . 14.)
					     (REMARKS . 15.)
					     (NETWORK-ADDRESS . 16.)
					     (LAST-ALTERATION . 17.)
					     (MACHINES-KNOWN-ON . 18.))))
			   (ERROR '|Unknown INQUIR Keyword| DATA))
		     (LSRUNM *INQUIR-FILE-OBJECT* ,UNAME))))

(DEFUN UNAME? (X) (AND (SYMBOLP X)
		       (PLUSP (LSRUNM *INQUIR-FILE-OBJECT* X))))
       
(DECLARE (*EXPR PARSE$MAKE-WORDS))

(DEFPROP PARSE$MAKE-WORDS ((games) PARSE FASL) AUTOLOAD)

(DEFUN GET-USER-NAME (WHO)
       (COND ((NOT (UNAME? WHO)) NIL)
	     (T
	      (LET* ((DATA   (LOOKUP-INQUIR-INFO WHO FULL-NAME))
		     (TOKENS (PARSE$MAKE-WORDS (EXPLODEC DATA)))
		     (LAST-NAME) (FIRST-NAME) (MIDDLE) (TITLE-ETC) (LINEAGE)
		     (ALIAS ()))
		    (DO ()
			((NOT
			  (AND (EQ (CADR TOKENS) '/,)
			       (EQ (CAR (LAST TOKENS)) 'FOR)
			       (MEMQ (LOOKUP-INQUIR-INFO WHO GROUP-AFFILIATION)
				     '(/@ /O)))))
			(SETQ ALIAS T)
			(SETQ WHO (CAR TOKENS))
			(SETQ TOKENS
			      (PARSE$MAKE-WORDS
			       (EXPLODEC
				(SETQ DATA
				      (LOOKUP-INQUIR-INFO WHO FULL-NAME))))))
		    (SETQ TOKENS (DELETE '/. TOKENS))
		    (COND ((SETQ TITLE-ETC (CAR (OR (MEMQ 'MR TOKENS)
						    (MEMQ 'MRS TOKENS)
						    (MEMQ 'MISS TOKENS)
						    (MEMQ 'MS TOKENS)
						    (MEMQ 'DR TOKENS))))
			   (SETQ TOKENS (DELETE TITLE-ETC TOKENS))))
		    (COND ((SETQ LINEAGE (CAR (OR (MEMQ 'II TOKENS)
						  (MEMQ 'III TOKENS)
						  (MEMQ 'JR TOKENS))))
			   (SETQ TOKENS (DELETE LINEAGE TOKENS))))
		    (COND ((NOT (MEMQ '/, TOKENS)) ; What a loser...
			   (POP TOKENS FIRST-NAME)
			   (COND ((CDR TOKENS)
				  (POP TOKENS MIDDLE)
				  (POP TOKENS LAST-NAME))
				 (T
				  (POP TOKENS LAST-NAME))))
			  ((EQ (CADR TOKENS) '/,)
			   (SETQ TOKENS (DELETE '/, TOKENS))
			   (POP TOKENS LAST-NAME)
			   (POP TOKENS FIRST-NAME)
			   (POP TOKENS MIDDLE))
			  (T
			   (SETQ FIRST-NAME (CADR (MEMQ '/, TOKENS)))
			   (SETQ LAST-NAME  (DO ((L () (CONS (CAR TOKS) L))
						 (TOKS TOKENS (CDR TOKS)))
						((EQ (CAR TOKS) '/,)
						 (IMPLODE
						  (MAPCAN 'EXPLODEC
							  (NREVERSE L))))))))
		    `( (,LAST-NAME
			,FIRST-NAME
			,@(COND (MIDDLE (NCONS MIDDLE))))
		      ,TITLE-ETC
		      ,LINEAGE
		      ,ALIAS
		      ,(LET ((NICKNAME (LOOKUP-INQUIR-INFO WHO NICKNAME)))
			    (COND ((EQ NICKNAME '||) NIL)
				  (T NICKNAME))))))))