(FILECREATED "15-May-85 12:04:29" {ERIS}<LISPCORE>SOURCES>LISPTAJOPATCH.;1
 3361   

      changes to:  (VARS LISPTAJOPATCHCOMS))


(* Copyright (c) 1985 by Xerox Corporation. All rights reserved.)

(PRETTYCOMPRINT LISPTAJOPATCHCOMS)

(RPAQQ LISPTAJOPATCHCOMS
 ((FNS \PFRemoveDirectoryID \PFFindRootDirEntry \PFAddRootDirEntry 
			       \PFRemoveRootDirEntry \PFFindRootDirEntryNum)))
(DEFINEQ

(\PFRemoveDirectoryID

  [LAMBDA (vol type)                                         (* mjs "15-May-85 11:52")

    (
PROG
 ((rootDir (create
 RootDirectory)))
          (if
 (
\PFGetRootDirectory
 vol rootDir)
	      then
 (\PFRemoveRootDirEntry
 type rootDir)
		   (if
 (
LESSP
 (fetch
 (RootDirectory countEntries) of
 rootDir)
			      1)
		       then
 (
\PFPurgeRootDirectory
 vol rootDir)
		     else
 (
\PFPutRootDirectory
 vol rootDir])

(\PFFindRootDirEntry

  [LAMBDA (type rootDir)                                     (* mjs "15-May-85 11:54")


          (* * Find the directoryFileID that corresponds to type, if any.)



    (LET ((entryNum (\PFFindRootDirEntryNum
 type rootDir)))
      (
AND
 (
SMALLP
 entryNum)
	   (fetch
 (RootDirEntry file) of
 (MESAELT (fetch
 (RootDirectory entries) of
 rootDir)
						  RootDirEntryArray entryNum])

(\PFAddRootDirEntry

  [LAMBDA (type directoryID rootDir)                         (* mjs "15-May-85 11:56")


          (* * Add specified (type directoryID) pair)



    (UNINTERRUPTABLY
        (
PROG
 ((entryNum (fetch
 (RootDirectory countEntries) of
 rootDir)))
	      (MESASETA (fetch
 (RootDirectory entries) of
 rootDir)
			RootDirEntryArray entryNum (create
 RootDirEntry
							   type ← type
							   file ← directoryID))
	      (replace
 (RootDirectory countEntries) of
 rootDir with
 (
ADD1
 entryNum))))])

(\PFRemoveRootDirEntry

  [LAMBDA (type rootDir)                                     (* mjs "15-May-85 11:57")

    (UNINTERRUPTABLY
        [
PROG
 ((nuke (\PFFindRootDirEntryNum
 type rootDir)))
	      (if
 nuke
		  then
 (bind
 directories first
 (
SETQ
 directories (fetch
 (RootDirectory entries)
								    of
 rootDir))
			  for
 entryNum from
 (
ADD1
 nuke) to
 (
SUB1
 (fetch
 (RootDirectory countEntries)
								    of
 rootDir))
			  do
 (MESASETA directories RootDirEntryArray (
SUB1
 entryNum)
				       (MESAELT directories RootDirEntryArray entryNum)))
		       (replace
 (RootDirectory countEntries) of
 rootDir
			  with
 (
SUB1
 (fetch
 (RootDirectory countEntries) of
 rootDir])])

(\PFFindRootDirEntryNum

  [LAMBDA (type rootDir)                                     (* mjs "15-May-85 11:57")


          (* * look through registered directories to find the desired one. Stored as an array of (type directoryFileID) 

	  pairs.)



    (bind
 directories first
 (
SETQ
 directories (fetch
 (RootDirectory entries) of
 rootDir))
       for
 entryNum from
 0 to
 (
SUB1
 (fetch
 (RootDirectory countEntries) of
 rootDir))
       thereis
 (
EQ
 (fetch
 (RootDirEntry type) of
 (MESAELT directories RootDirEntryArray entryNum))
		   type])
)
(PUTPROPS LISPTAJOPATCH COPYRIGHT ("Xerox Corporation" 1985))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (394 3277 (\PFRemoveDirectoryID 404 . 891) (\PFFindRootDirEntry 893 . 1330) (
\PFAddRootDirEntry 1332 . 1889) (\PFRemoveRootDirEntry 1891 . 2665) (\PFFindRootDirEntryNum 2667 . 
3275)))))
STOP