(FILECREATED "28-Apr-86 14:00:59" {ERIS}<LISPCORE>LIBRARY>WHEREIS.;3 21400  

      changes to:  (VARS WHEREISCOMS)
                   (FNS WHEREIS CLOSEWHEREIS)

      previous date: "29-Nov-84 17:30:12" {ERIS}<LISPCORE>LIBRARY>WHEREIS.;1)


(* Copyright (c) 1983, 1984, 1986 by Xerox Corporation. All rights reserved.)

(PRETTYCOMPRINT WHEREISCOMS)

(RPAQQ WHEREISCOMS ((* "WHEREIS from a hashfile")
                    (FILES HASH)
                    (COMS (* "This probably should go into the system somewhere")
                          (FNS \REMOVEOLDVERSIONS))
                    (FNS WHEREIS CLOSEWHEREIS WHEREISNOTICE WHEREISNOTICE1)
                    (ADDVARS (WHEREIS.HASH))
                    (GLOBALVARS WHEREIS.HASH)
                    (DECLARE: DONTEVAL@LOAD DOCOPY (ADDVARS (AROUNDEXITFNS CLOSEWHEREIS)))
                    (LOCALVARS . T)))



(* "WHEREIS from a hashfile")

(FILESLOAD HASH)



(* "This probably should go into the system somewhere")

(DEFINEQ

(\REMOVEOLDVERSIONS
  [LAMBDA (FULLFILELST)                                      (* rrb "22-Feb-84 18:12")
          
          (* removes all but the newest version of any file on FULLFILELST.
          Slow version as temporary until DIRECTORY has a way of asking for only the most 
          recent version.)

    (PROG ((EXPANDEDFILELST (for FILE in FULLFILELST collect (UNPACKFILENAME FILE)))
           UNIQUELST FILE)
          [for EXPTAIL on EXPANDEDFILELST
             do                                              (* skip deleted files.)
                (AND (SETQ FILE (CAR EXPTAIL))
                     (PROG [(XDIRECTORY (LISTGET FILE (QUOTE DIRECTORY)))
                            (XNAME (LISTGET FILE (QUOTE NAME)))
                            (XEXTENSION (LISTGET FILE (QUOTE EXTENSION)))
                            (XVERSION (LISTGET FILE (QUOTE VERSION]
          
          (* go thru the list of expanded files and see if there are any other files on 
          the list with the same name. If so and it is older, delete it.
          If so and it is newer, don't copy this guy onto the result list.)

                           (for EFLTAIL on (CDR EXPTAIL)
                              do (SETQ FILE (CAR EFLTAIL))
                                 [COND
                                    ((AND (EQ (LISTGET FILE (QUOTE NAME))
                                              XNAME)
                                          (EQ (LISTGET FILE (QUOTE EXTENSION))
                                              XEXTENSION)
                                          (EQ (LISTGET FILE (QUOTE DIRECTORY))
                                              XDIRECTORY))
                                     (COND
                                        ((IGREATERP (LISTGET FILE (QUOTE VERSION))
                                                XVERSION)    (* XFILE should be deleted)
                                         (RETURN NIL))
                                        (T                   (* mark it deleted. Don't want to play 
                                                             around with the pointers because the 
                                                             enclosing FOR is using the same list.)
                                           (RPLACA EFLTAIL NIL] finally (SETQ UNIQUELST
                                                                         (CONS (CAR EXPTAIL)
                                                                               UNIQUELST]
          (RETURN (for UFILE in UNIQUELST collect (PACKFILENAME UFILE])
)
(DEFINEQ

(WHEREIS
  [LAMBDA (NAME TYPE FILES FN)                               (* bvm: "28-Apr-86 12:24")
    (PROG (VAL)                                              (* if FN given, APPLY* to each element 
                                                             and return NIL)
          (COND
             ((EQ NAME T)                                    (* T as a NAME has a special meaning 
                                                             to INFILECOMS? so don't pass through.)
              (RETURN NIL)))
          (SETQ TYPE (GETFILEPKGTYPE TYPE))
          [for FILE in (OR (LISTP FILES)
                           FILELST) do (COND
                                          ((INFILECOMS? NAME TYPE (FILECOMS FILE))
                                           (COND
                                              (FN (APPLY* FN NAME FILE)))
                                           (SETQ VAL (CONS FILE VAL]
          [AND
           (EQ FILES T)
           (EQ TYPE (QUOTE FNS))
           (LITATOM NAME)
           (PROGN [COND
                     ((AND WHEREIS.HASH (NLISTP WHEREIS.HASH))
                                                             (* make sure WHEREIS.HASH is a list.)
                      (SETQ WHEREIS.HASH (LIST WHEREIS.HASH]
                  (for WHISHSFILE HNAME HSFILE DELP on WHEREIS.HASH
                     do 
          
          (* WHEREIS.HASH is a list of hash file names off of which the hash file 
          structure is linked into the system hash array.
          The full file name is hashed.)

                        (COND
                           ((LISTP (SETQ HNAME (CAR WHISHSFILE)))
                                                             (* file already has an associated 
                                                             hashfile datatype)
                            (SETQ HSFILE (CDR HNAME)))
                           [(SETQ HSFILE (FINDFILE HNAME T))
                            (COND
                               ([find X in WHEREIS.HASH
                                   suchthat (AND (LISTP X)
                                                 (EQ HSFILE (HASHFILEPROP (CDR X)
                                                                   (QUOTE NAME]
                                                             (* Looks like a duplicate entry)
                                (RPLACA WHISHSFILE (SETQ HSFILE NIL))
                                (SETQ DELP T))
                               (T (SETQ HSFILE (OPENHASHFILE HSFILE))
                                                             (* if the data file is ever closed, 
                                                             break the link to the hash file 
                                                             structure.)
                                  (WHENCLOSE (HASHFILEPROP HSFILE (QUOTE STREAM))
                                         (QUOTE BEFORE)
                                         [FUNCTION (LAMBDA (STRM)
                                                     (for TAIL on WHEREIS.HASH
                                                        when [AND (LISTP (CAR TAIL))
                                                                  (EQ STRM (HASHFILEPROP (CDAR TAIL)
                                                                                  (QUOTE STREAM]
                                                        do   (* remove the hashfile structure for 
                                                             this file's entry on WHEREIS.HASH.)
                                                           (RPLACA TAIL (CAAR TAIL]
                                         (QUOTE CLOSEALL)
                                         (QUOTE NO))
                                  (RPLACA WHISHSFILE (CONS HNAME HSFILE]
                           (T (OR [EQ (QUOTE Y)
                                      (ASKUSER 120 (QUOTE Y)
                                             (CONCAT HNAME 
                         ", a file on WHEREIS.HASH, not found -- do you want to delete and continue?"
                                                    )
                                             (QUOTE ((Y "es")
                                                     (N "o"]
                                  (ERRORX (LIST 23 HNAME)))
                              (RPLACA WHISHSFILE (SETQ HSFILE NIL))
                              (SETQ DELP T)))
                        [COND
                           (HSFILE (for FILE inside (GETHASHFILE NAME HSFILE)
                                      when (NOT (FMEMB FILE VAL))
                                      do (AND FN (APPLY* FN NAME FILE))
                                         (push VAL FILE] finally (COND
                                                                    (DELP (SETQ WHEREIS.HASH
                                                                           (DREMOVE NIL WHEREIS.HASH]
          (RETURN (AND (NULL FN)
                       (DREVERSE VAL])

(CLOSEWHEREIS
  [LAMBDA (FLG)                                              (* bvm: "28-Apr-86 12:33")
          
          (* * Close the whereis file over logout, since there's no point in paying to 
          keep it open)

    (AND WHEREIS.HASH (SELECTQ FLG
                          ((NIL BEFORELOGOUT BEFORESYSOUT BEFOREMAKESYS) 
                               (for HF in (for WH in WHEREIS.HASH when (LISTP WH)
                                             collect         (* Gather the hashfile handles)
                                                   (CDR WH)) do (NLSETQ (CLOSEHASHFILE HF))))
                          NIL])

(WHEREISNOTICE
  [LAMBDA (FILEGROUP NEWFLG DATABASEFILE)                    (* JonL "17-Nov-84 00:55")
          
          (* Copies the current whereis hash-file into a scratch file, then notices the 
          files in FILEGROUP The copy is so that this function will execute even though 
          someone else is reading the current database.
          The database is copied to a scratch file, then renamed to be a newer version of 
          the previous database, which is deleted.
          This allows others to use the old database while the copying is going on.
          If an earlier version of the scratch file exists, it means that someone else is 
          currently updating (their version disappears when they complete successfully or 
          logout), so we wait for them to finish.)

    (RESETLST
     (PROG (SCRATCH HF (SCRATCHVAL (LIST NIL))
                  [DATABASEFILENAME (OR DATABASEFILE (if WHEREIS.HASH
                                                         then 
                                                             (* if there is a list of files, use 
                                                             the top one.)
                                                              (if (NLISTP WHEREIS.HASH)
                                                                  then WHEREIS.HASH
                                                                elseif (NLISTP (CAR WHEREIS.HASH))
                                                                  then (CAR WHEREIS.HASH)
                                                                else (CAAR WHEREIS.HASH))
                                                       else (QUOTE WHEREIS.HASH]
                  OLDWH)
           (DECLARE (SPECVARS HF))                           (* HF is the hashfile used freely by 
                                                             WHEREISNOTICE1)
           (SETQ OLDWH (INFILEP DATABASEFILENAME))
           (RESETSAVE NIL (LIST [FUNCTION (LAMBDA (X)
                                            (if (CAR X)
                                                then (CLOSEF? (CAR X))
                                                     (AND RESETSTATE (DELFILE (CAR X]
                                SCRATCHVAL))                 (* creates a scratch file)
           (if (AND OLDWH (NOT NEWFLG))
               then                                          (* copy old one)
                    [RPLACA SCRATCHVAL (SETQ HF (CLOSEF (OPENFILE (SETQ SCRATCH
                                                                   (PACKFILENAME (QUOTE DIRECTORY)
                                                                          (FILENAMEFIELD 
                                                                                 DATABASEFILENAME
                                                                                 (QUOTE DIRECTORY))
                                                                          (QUOTE NAME)
                                                                          (QUOTE NEWWHEREISDATABASE)
                                                                          (QUOTE EXTENSION)
                                                                          (QUOTE SCRATCH)
                                                                          (QUOTE TEMPORARY)
                                                                          (QUOTE S)))
                                                               (QUOTE OUTPUT)
                                                               (QUOTE NEW] 
                                                             (* Compensate for the fact that 
                                                             PACKFILENAME produces version -1 for 
                                                             temporary ;S)
                    (AND (EQ (SYSTEMTYPE)
                             (QUOTE TOPS20))
                         (SETQ SCRATCH (PACKFILENAME (QUOTE VERSION)
                                              NIL
                                              (QUOTE BODY)
                                              SCRATCH))) 
          
          (* If there is a version earlier than the one we got, someone else must have 
          it, and we must wait until he gets rid of it
          (by deleting it))

                    [bind OLDV (RPT ← 1) until [EQ HF (SETQ OLDV (FULLNAME SCRATCH (QUOTE OLDEST]
                       do (DISMISS 2000)
                          (OR (NULL RPT)
                              (if (EQ RPT 5)
                                  then (printout T T (GETFILEINFO OLDV (QUOTE AUTHOR))
                                              " seems to be updating the database right now." T 
                                              "I'm waiting for him to finish." T T)
                                       (SETQ RPT NIL)
                                else (add RPT 1]
                    (SETQ HF (COPYHASHFILE OLDWH HF NIL NIL T))
                    (CLOSEF? OLDWH)
             elseif (AND OLDWH (EQ NEWFLG (QUOTE NOCOPY)))
               then (SETQ HF (OPENHASHFILE OLDWH (QUOTE BOTH)
                                    NIL))
             else (SETQ HF (CREATEHASHFILE DATABASEFILENAME (QUOTE SMALLEXPR)
                                  NIL
                                  (OR (NUMBERP NEWFLG)
                                      20000)))
                  (SETQ NEWFLG T))                           (* Must leave the new file 
                                                             open--otherwise, the user might lose 
                                                             access to it before he starts to do 
                                                             the noticing.)
           [for X
              in
              [\REMOVEOLDVERSIONS
               (for FILESPEC TEM inside FILEGROUP
                  join (if (SETQ TEM (INFILEP FILESPEC))
                           then                              (* an individual file)
                                (LIST TEM)
                         else                                (* a specification for a group of 
                                                             files, expand it.)
                              (DIRECTORY (PROG ((FGFIELDS (UNPACKFILENAME FILESPEC))
                                                DIRPATTERN)
                                               [SETQ DIRPATTERN (PACKFILENAME
                                                                 (APPEND (UNPACKFILENAME FILESPEC)
                                                                        (QUOTE (NAME *]
                                               (if [AND (FMEMB (QUOTE EXTENSION)
                                                               FGFIELDS)
                                                        (NULL (LISTGET FGFIELDS (QUOTE EXTENSION]
                                                   then      (* no extension, must put a dot on 
                                                             since <lisp>* gets all files not just 
                                                             those with no extension so <lisp>*.
                                                             is what we want.)
                                                        (SETQ DIRPATTERN (PACK* DIRPATTERN ".")))
                                               (RETURN (if (NULL (FMEMB (QUOTE VERSION)
                                                                        FGFIELDS))
                                                           then 
                                                             (* pass in a pattern that only gets 
                                                             the most recent version unless one is 
                                                             specified.)
                                                                (PACK* DIRPATTERN ";")
                                                         else DIRPATTERN]
              do (if (LISPSOURCEFILEP X)
                     then (ERSETQ (printout T .P2 (WHEREISNOTICE1 X)
                                         -2]
           (SETQ HF (CLOSEHASHFILE HF))
          
          (* This closes the file, but other updaters are still locked out cause they go 
          for a new version and then trip over our old one.)

           (OR NEWFLG (if (SETQ HF (RENAMEFILE HF (PACKFILENAME (QUOTE VERSION)
                                                         NIL
                                                         (QUOTE BODY)
                                                         DATABASEFILENAME)))
                          then (DELFILE OLDWH)))             (* Now others can get in to read or 
                                                             update.)
           (RETURN HF])

(WHEREISNOTICE1
  [LAMBDA (FILE TRYHARD)                                     (* JonL "17-Nov-84 00:38")
    (DECLARE (USEDFREE HF))
          
          (* * Note that we won't even be coming here unless FILE is LISPSOURCEFILEP)

    (RESETLST (PROG (NAME MAP MAPPOS DATE VAL)
                    [RESETSAVE [SETQ FILE (OPENFILE FILE (QUOTE INPUT)
                                                 (QUOTE OLD)
                                                 NIL
                                                 (QUOTE (DON'T.CHANGE.READ.DATE DON'T.CHANGE.DATE]
                           (QUOTE (PROGN (CLOSEF? OLDVALUE]
                    (SETFILEPTR FILE 0)
                    (SETQ MAP (OR (GETFILEMAP FILE)
                                  (GETFILEMAP FILE T)
                                  (RETURN "Can't find filemap")))
                    (if (AND (NOT TRYHARD)
                             (EQUAL (SETQ DATE (FILEDATE FILE))
                                    (GETHASHFILE FILE HF))
                             DATE)
                        then (RETURN (LIST FILE DATE)))
                    (SETQ NAME (NAMEFIELD FILE T))
                    [for X in (CDR MAP)
                       do (for Y in (CDDR X) do (OR [NULL (SETQ VAL (LOOKUPHASHFILE
                                                                     (CAR Y)
                                                                     NAME HF (QUOTE (INSERT RETRIEVE]
                                                    (EQ NAME VAL)
                                                    (AND (LISTP VAL)
                                                         (FMEMB NAME VAL))
                                                    (PUTHASHFILE (CAR Y)
                                                           (NCONC1 (OR (LISTP VAL)
                                                                       (LIST VAL))
                                                                  NAME)
                                                           HF]
                    (REMPROP NAME (QUOTE FILEMAP))
                    (PUTHASHFILE FILE DATE HF)
                    (RETURN FILE])
)

(ADDTOVAR WHEREIS.HASH )
(DECLARE: DOEVAL@COMPILE DONTCOPY

(GLOBALVARS WHEREIS.HASH)
)
(DECLARE: DONTEVAL@LOAD DOCOPY 

(ADDTOVAR AROUNDEXITFNS CLOSEWHEREIS)
)
(DECLARE: DOEVAL@COMPILE DONTCOPY

(LOCALVARS . T)
)
(PUTPROPS WHEREIS COPYRIGHT ("Xerox Corporation" 1983 1984 1986))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (994 3712 (\REMOVEOLDVERSIONS 1004 . 3710)) (3713 21089 (WHEREIS 3723 . 8911) (
CLOSEWHEREIS 8913 . 9600) (WHEREISNOTICE 9602 . 18873) (WHEREISNOTICE1 18875 . 21087)))))
STOP