(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)


(FILECREATED "12-Dec-2024 15:07:45" {WMEDLEY}<lispusers>VERSIONDEFS.;11
 6270   

      :EDIT-BY rmk

      :CHANGES-TO (VARS VERSIONDEFSCOMS)

      :PREVIOUS-DATE " 6-Dec-2024 22:12:48" {WMEDLEY}<lispusers>VERSIONDEFS.;10)


(PRETTYCOMPRINT VERSIONDEFSCOMS)

(RPAQQ VERSIONDEFSCOMS
 [(FNS FINDFILEVERSION GETVINFO VERSIONP)
                        (FNS EDV DFV)
                        (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
                               (ADDVARS (NLAMA DVV DFV EDV)
                                      (NLAML)
                                      (LAMA])
(DEFINEQ

(FINDFILEVERSION

  [LAMBDA (FILE VERSION DIRLIST NOERROR)
                     (* ; "Edited  6-Dec-2024 22:12 by rmk")


                                                             (* ; "Edited  1-Dec-2024 23:01 by rmk")


                                                             (* ; "Edited  4-Oct-2024 15:23 by rmk")


    (* ;; "Returns the version of FILE in DIRLIST that correspond to the relative version specifier VERSION.  Negative version count backwrd from the newest (=-1), positive count forward  from the oldest (=1). F, FIRST,OLDEST are equivalent to 1 (= oldest), N NEWEST are equivalent to -1 (newest).")


    (LET (FILES)
         (SETQ VERSION (VERSIONP
 VERSION))
         (if
 (EQ VERSION -1)
             then
 (FINDFILE FILE T DIRLIST)
           elseif
 [SETQ FILES (FILDIR (PACKFILENAME 'VERSION '* 'BODY (FINDFILE FILE T DIRLIST]
             then
 (CAR (if
 (ILESSP VERSION 0)
                           then
 
                                (* ;; "-2 is the second newest version")


                                (NTH FILES (IMINUS VERSION))
                         else
 
                              (* ;; "2 is the second oldest")


                              (NTH (DREVERSE FILES)
                                   VERSION)))
           elseif
 (NOT NOERROR)
             then
 (ERROR (CONCAT "Version " VERSION " of " FILE " not found"])

(GETVINFO

  [LAMBDA (NAME TYPE FILE VERSION DIRLIST)
                   (* ; "Edited  6-Dec-2024 21:37 by rmk")


                                                             (* ; "Edited  1-Dec-2024 23:50 by rmk")


    (* ;; "Gets the TYPE definition of NAME from version VERSION of FILE, returns the definition after storing it under an annotated name that the filepkg doesn't see.  ")


    (CL:WHEN (VERSIONP
 TYPE)
        (SETQ VERSION TYPE)
        (SETQ TYPE NIL))
    (CL:WHEN (VERSIONP
 FILE)
        (SETQ VERSION FILE)
        (SETQ FILE NIL))
    (CL:UNLESS [OR FILE (SETQ FILE (CAR (WHEREIS NAME TYPE T]
        (ERROR (CONCAT "File for " NAME " not found")))
    (CL:UNLESS VERSION
        (SETQ VERSION 'NEWEST))
    (LET ((VFILE (FINDFILEVERSION
 FILE VERSION DIRLIST))
          (CONNECTED (DIRECTORYNAME T T))
          DEF VNAME HOST DIR)                                (* ; "Don't include the whole path if it's the connected one. Perhaps we should create/return both a short name and a long name")

         (SETQ DEF (GETDEF NAME TYPE FILE))
         (SETQ HOST (FILENAMEFIELD VFILE 'HOST))
         (SETQ DIR (FILENAMEFIELD VFILE 'DIRECTORY))
         (CL:WHEN (STRING.EQUAL HOST (FILENAMEFIELD CONNECTED 'HOST))
                (SETQ HOST NIL))
         (CL:WHEN (STRING.EQUAL DIR (FILENAMEFIELD CONNECTED 'DIRECTORY))
                (SETQ DIR NIL))
         (SETQ VNAME (PACK* (CL:IF HOST
                                (CONCAT "{" HOST "}")
                                "")
                            (CL:IF DIR
                                (CONCAT "<" (L-CASE DIR)
                                       ">")
                                "")
                            NAME ";" (FILENAMEFIELD VFILE 'VERSION)
                            (SELECTQ VERSION
                                (1 " (F)")
                                (-1 " (N)")
                                "")))
         (LIST VNAME TYPE DEF])

(VERSIONP

  [LAMBDA (X)
                                                (* ; "Edited  6-Dec-2024 20:26 by rmk")


    (* ;; "Normalize X if X is a version designator, otherwise NIL")


    (SELECTQ X
        ((F FIRST OLDEST) 
             1)
        ((N NEWEST 0) 
             -1)
        (FIXP X])
)
(DEFINEQ

(EDV

  [NLAMBDA ARGS
                                              (* ; "Edited  6-Dec-2024 21:30 by rmk")


                                                             (* ; "Edited  2-Dec-2024 00:14 by rmk")

    (SETQ ARGS (MKLIST ARGS))
    (PROG ((NAME (POP
 ARGS))
           (TYPE (POP
 ARGS))
           (FILE (POP
 ARGS))
           (VERSION (POP
 ARGS))
           (DIRLIST (POP
 ARGS))
           VINFO)
          (SETQ VINFO (GETVINFO
 NAME TYPE FILE VERSION DIRLIST))
          (EDITE (CADDR VINFO)
                 NIL
                 (CAR VINFO)
                 (CADR VINFO)
                 NIL
                 '(:DONTWAIT))
          (CAR VINFO])

(DFV

  [NLAMBDA ARGS
                                              (* ; "Edited  6-Dec-2024 21:29 by rmk")


                                                             (* ; "Edited  2-Dec-2024 00:08 by rmk")

    (SETQ ARGS (MKLIST ARGS))
    (APPLY (FUNCTION EDV)
           (LIST (POP
 ARGS)
                 NIL
                 (POP
 ARGS)
                 (POP
 ARGS)
                 (POP
 ARGS])
)
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS 

(ADDTOVAR NLAMA
 DVV DFV EDV)

(ADDTOVAR NLAML
 )

(ADDTOVAR LAMA
 )
)
(PRETTYCOMPRINT VERSIONDEFSCOMS)

(RPAQQ VERSIONDEFSCOMS
 [(FNS FINDFILEVERSION GETVINFO VERSIONP)
                        (FNS EDV DFV)
                        (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
                               (ADDVARS (NLAMA DFV EDV)
                                      (NLAML)
                                      (LAMA])
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS 

(ADDTOVAR NLAMA
 DFV EDV)

(ADDTOVAR NLAML
 )

(ADDTOVAR LAMA
 )
)
(DECLARE%: DONTCOPY
  (FILEMAP (NIL (683 4442 (FINDFILEVERSION 693 . 2140) (GETVINFO 2142 . 4125) (VERSIONP 4127 . 4440)) (
4443 5589 (EDV 4453 . 5153) (DFV 5155 . 5587)))))
STOP