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


(FILECREATED " 1-Aug-2022 09:28:41" {DSK}<home>larry>git-loops>system>LOADLOOPS.;11
 20004  

      :CHANGES-TO (VARS LOADLOOPSCOMS)

      :PREVIOUS-DATE " 9-Jul-2022 20:50:48" {DSK}<home>larry>git-loops>system>LOADLOOPS.;10)


(* ; "
Copyright (c) 1983-1988, 1990-1991, 1993, 2022 by Venue & Xerox Corporation.
")

(PRETTYCOMPRINT LOADLOOPSCOMS)

(RPAQQ LOADLOOPSCOMS

       [

(* ;;; "Loops loadup stuff")


        
        (* ;; "Bootstrap function until LOOPSBROWSE is loaded")


        (FNS LOADLOOPS LoadLispUsers NOCACHEMACRO UnMarkChanges)
        (VARS (LispUserFilesForLoops '(GRAPHER))
              (LoopsPatchFiles NIL)
              (*DEFAULT-CLEANUP-COMPILER* 'CL:COMPILE-FILE)
              (LOOPSFILES '(LOADLOOPS LOOPSSITE BLOCKLOOKUP LOOPSSPEEDUP LOOPSDATATYPES LOOPSSTRUC 
                                  LOOPSPRINT LOOPS-FILEPKG LOOPSACCESS LOOPSUID LOOPSEDIT 
                                  LOOPSMETHODS LOOPSKERNEL LOOPSACTIVEVALUES LOOPSUTILITY 
                                  LOOPSINSPECT LOOPSWINDOW LOOPSBROWSE LOOPSDEBUG LOOPSUSERINTERFACE
                                  LOOPS-TTYEDIT INSPECT-PATCH))
              (*REMOVE-INTERLISP-COMMENTS* T))
        
        (* ;; "Loopsms  in library")


        
        (* ;; "Loops version decl's")


        (VARS (LoopsVersion 'Lyric/Medley))
        
        (* ;; 

        "Some utility functions and macros we like having around - these are actually used in Loops")


        (FNS PromptEval PromptRead)
        (MACROS MenuGetOrCreate)
        
        (* ;; "NiceMenu is used all over the place. It really doesn't belong in this file. Ditto ColumnateMenuItems (JDS 11/8/91)")


        (FNS NiceMenu ColumnateMenuItems)
        
        (* ;; "Load the site specific file. Note that this assumes that the file is easily found, say on the same directory as this file. If no file is found, that is OK, it is assumed that there is no site file.")


        
        (* ;; "The ugly RESETLST stuff is to prevent the TTY window from hanging.")


        (P (RESETLST
               [RESETSAVE (WINDOWPROP \TopLevelTtyWindow 'PAGEFULLFN (FUNCTION NILL))
                      (LIST (FUNCTION WINDOWPROP)
                            \TopLevelTtyWindow
                            'PAGEFULLFN
                            (WINDOWPROP \TopLevelTtyWindow 'PAGEFULLFN]
               (FILESLOAD (NOERROR)
                      LoopsSite)))
        
        (* ;; "Some reasonable defaults, in case they wern't set by the site file")


        [INITVARS (LoadLoopsForms NIL)
               (OptionalLispuserFiles NIL)
               
               (* ;; "All these variables were set by the LOOPS.DFASL file with this as the fallback")


               [LOOPSDIRECTORY (LET [(thisFile (FULLNAME (GETSTREAM NIL 'INPUT]
                                    (PACKFILENAME 'HOST (FILENAMEFIELD thisFile 'HOST)
                                           'DEVICE
                                           (FILENAMEFIELD thisFile 'DEVICE)
                                           'DIRECTORY
                                           (FILENAMEFIELD thisFile 'DIRECTORY]
               
               (* ;; "If LOOPSDIRECTORY happens to end in %"SOURCES>%" or %"SYSTEM>%", construct the library, users, and rules directory pathnames by replacing it with %"LIBRARY>%", %"USERS>%", and %"USERS>RULES>%" respectively.  Otherwise punt and set them the same as LOOPSDIRECTORY.")


               (LOOPSLIBRARYDIRECTORY (LET [(POSSOURCES (OR (STRPOS "SOURCES>" LOOPSDIRECTORY NIL NIL
                                                                   T NIL UPPERCASEARRAY T)
                                                            (STRPOS "SYSTEM>" LOOPSDIRECTORY NIL NIL
                                                                   T NIL UPPERCASEARRAY T]
                                           (IF POSSOURCES THEN (MKATOM (CONCAT (SUBSTRING
                                                                                LOOPSDIRECTORY 1
                                                                                (SUB1 POSSOURCES))
                                                                              "LIBRARY>"))
                                               ELSE LOOPSDIRECTORY)))
               (LOOPSUSERSDIRECTORY (LET [(POSSOURCES (OR (STRPOS "SOURCES>" LOOPSDIRECTORY NIL NIL T
                                                                 NIL UPPERCASEARRAY T)
                                                          (STRPOS "SYSTEM>" LOOPSDIRECTORY NIL NIL T
                                                                 NIL UPPERCASEARRAY T]
                                         (IF POSSOURCES THEN (MKATOM (CONCAT (SUBSTRING 
                                                                                    LOOPSDIRECTORY 1
                                                                                    (SUB1 POSSOURCES)
                                                                                    )
                                                                            "USERS>"))
                                             ELSE LOOPSDIRECTORY)))
               (LOOPSUSERSRULESDIRECTORY (LET [(POSSOURCES (OR (STRPOS "SOURCES>" LOOPSDIRECTORY NIL
                                                                      NIL T NIL UPPERCASEARRAY T)
                                                               (STRPOS "SYSTEM>" LOOPSDIRECTORY NIL 
                                                                      NIL T NIL UPPERCASEARRAY T]
                                              (IF POSSOURCES THEN (MKATOM (CONCAT (SUBSTRING
                                                                                   LOOPSDIRECTORY 1
                                                                                   (SUB1 POSSOURCES))
                                                                                 "USERS>RULES>"))
                                                  ELSE LOOPSDIRECTORY]
        (VARS (DIRECTORIES (UNION (LIST LOOPSDIRECTORY LOOPSLIBRARYDIRECTORY LOOPSUSERSDIRECTORY 
                                        LOOPSUSERSRULESDIRECTORY)
                                  DIRECTORIES)))
        (P (MOVD? 'NILL 'UpdateClassBrowsers])



(* ;;; "Loops loadup stuff")





(* ;; "Bootstrap function until LOOPSBROWSE is loaded")


(DEFINEQ

(LOADLOOPS

  [LAMBDA (sysout-dir load-option)
                           (* ; "Edited  7-Jul-2022 19:44 by lmm")


                                                          (* ; "Edited 28-Jun-88 18:08 by JAMES.PA")

    (DECLARE
 (GLOBALVARS LoopsPatchFiles LOOPSFILES LoadLoopsForms LOOPSDIRECTORY LoopsDate 
                    *FEATURES*))
    (CNDIR LOOPSDIRECTORY)
    (RESETLST

        (* ;; "stop the tty window from hanging up while loading files")


        [RESETSAVE (WINDOWPROP \TopLevelTtyWindow 'PAGEFULLFN (FUNCTION NILL))
               (LIST (FUNCTION WINDOWPROP)
                     \TopLevelTtyWindow
                     'PAGEFULLFN
                     (WINDOWPROP \TopLevelTtyWindow 'PAGEFULLFN]
                                                             (* ; 

                           "Binding the variables LISPXHIST and LISPXHISTORY so history is not saved")

        [RESETVARS (LISPXHISTORY)
                   (PROG ((DIRECTORIES (CONS NIL (CONS (DIRECTORYNAME T T)
                                                       DIRECTORIES)))
                          LISPXHIST)

                    (* ;; "Load the files")


                         (COND
                            (LoopsPatchFiles (for
 file in
 LoopsPatchFiles when
 (ATOM file)
                                                do
 (PUTPROP (ROOTFILENAME file)
                                                          'FILEDATES NIL))
                                   (DOFILESLOAD LoopsPatchFiles)))
                         (LoadLispUsers
)
                         (DOFILESLOAD (CONS (MKLIST (OR load-option 'COMPILED))
                                            LOOPSFILES))
                         (COND
                            ((EQ MAKESYSNAME ':MEDLEY)       (* ; "This load must be conditionalized here since the file will be compiled in Medley and not loadable in Lyric at all.")

                             (FILESLOAD MEDLEY-PATCH.DFASL)))

                    (* ;; "Replace any boot-strapping stuff with the real thing")


                         (MOVD 'FullInstallMethod 'InstallMethod)
                         (MOVD 'FullNameObject 'NameObject)
                         (FILEPKGTYPE 'FNS 'WHENCHANGED (NCONC1 (FILEPKGTYPE 'FNS 'WHENCHANGED)
                                                               'FnOrMethodChanged))

                    (* ;; "Remember info about the state of the system")


                         (push
 *FEATURES* 'LOOPS :LOOPS)
                         (SETQ LoopsDate (DATE))

                    (* ;; "Now do any user specified initialization")


                         (for
 form in
 LoadLoopsForms do
 (EVAL form])
    (COND
       (sysout-dir (SETQ FILELST NIL)
              (SETQ LOGINHOST/DIR NIL)
              (SETQ INITIALSLST)
              (SETQ USERNAME NIL)
              (SETQ FIRSTNAME 'SirOrMadam)
              (CLEARW \TopLevelTtyWindow)
              (UnMarkChanges
)
              (ENDLOADUP)
              (COND
                 ((NEQ T sysout-dir)
                  (/CNDIR sysout-dir)))
              (MAKESYS 'LOOPS.SYSOUT (PACK* 'LOOPS "/" MAKESYSNAME])

(LoadLispUsers

  [LAMBDA NIL
                                            (* edited%: " 4-Apr-86 10:35")


         (* * Load the usual Lispusers files for Loops)


    (DOFILESLOAD (CONS '(SYSLOAD FROM VALUEOF LISPUSERSDIRECTORIES)
                       OptionalLispuserFiles))
    (DOFILESLOAD (CONS '(SYSLOAD FROM VALUEOF LISPUSERSDIRECTORIES)
                       LispUserFilesForLoops])

(NOCACHEMACRO

  [LAMBDA (FN BODY ENV)
    (CL:FUNCALL FN BODY ENV])

(UnMarkChanges

  [LAMBDA (FILES)
                                        (* smL "10-Dec-86 19:19")


         (* * Unmark all changes that have been made and forget files to list and 

       compile)


    (SETQ NOTLISTEDFILES NIL)
    (SETQ NOTCOMPILEDFILES NIL)
    (UPDATEFILES)
    [SETQ OLDCHANGES (for
 file in
 FILELST first
 (SETQ $$VAL (FILEPKGCHANGES))
                        when
 (OR (NULL FILES)
                                     (FMEMB file FILES)) join
 (CDR (GETPROP file 'FILE]
    [for
 COM in
 OLDCHANGES when
 (NEQ COMMENTFLG (CAR COM))
       do
 (for
 ITEM in
 (CDR COM) do
 (UNMARKASCHANGED ITEM (CAR COM]
    OLDCHANGES])
)

(RPAQQ LispUserFilesForLoops
 (GRAPHER))

(RPAQQ LoopsPatchFiles
 NIL)

(RPAQQ *DEFAULT-CLEANUP-COMPILER*
 CL:COMPILE-FILE)

(RPAQQ LOOPSFILES
 (LOADLOOPS LOOPSSITE BLOCKLOOKUP LOOPSSPEEDUP LOOPSDATATYPES LOOPSSTRUC LOOPSPRINT
                         LOOPS-FILEPKG LOOPSACCESS LOOPSUID LOOPSEDIT LOOPSMETHODS LOOPSKERNEL 
                         LOOPSACTIVEVALUES LOOPSUTILITY LOOPSINSPECT LOOPSWINDOW LOOPSBROWSE 
                         LOOPSDEBUG LOOPSUSERINTERFACE LOOPS-TTYEDIT INSPECT-PATCH))

(RPAQQ *REMOVE-INTERLISP-COMMENTS*
 T)



(* ;; "Loopsms  in library")





(* ;; "Loops version decl's")



(RPAQQ LoopsVersion
 Lyric/Medley)



(* ;; "Some utility functions and macros we like having around - these are actually used in Loops")


(DEFINEQ

(PromptEval

  [LAMBDA (promptString window sameLine?)
                (* ; "Edited 17-Nov-87 10:26 by jrb:")

                                                             (* Printout promptString in 

                                                           promptwindow and return value of 

                                                           expression read there)

    (PROG [NEWVALUE (mainWindow (WINDOWPROP window 'MAINWINDOW]
          (RESETLST
              (RESETSAVE (TTYDISPLAYSTREAM (OR window PROMPTWINDOW)))
              (RESETSAVE (TTY.PROCESS (THIS.PROCESS)))
              (CLRPROMPT)
              (RESETSAVE (PRINTLEVEL 4 3))
              (printout T promptString T "The expression read will be EVALuated.")
              (if
 sameLine?
                  then
 (printout T "> ")
                else
 (printout T T "> "))

              (* ;; "Make sure that buttoning the main window drags the TTY back here if window is an attachedwindow, and that closing it kills us")


              (if
 mainWindow
                  then
 (WINDOWPROP mainWindow 'PROCESS (WINDOWPROP window 'PROCESS))
                        (WINDOWADDPROP mainWindow 'CLOSEFN 'Don'tCloseIfBusy 'FIRST))
              (CL:UNWIND-PROTECT
                  (SETQ NEWVALUE (LISPX (LISPXREAD T T)
                                        '>))
                  (AND mainWindow (WINDOWPROP mainWindow 'PROCESS NIL)))
                                                             (* clear tty buffer because it 

                                                           sometimes has stuff left.)

              (CLEARBUF T T))
          (RETURN NEWVALUE])

(PromptRead

  [LAMBDA (promptString window sameLine?)
                (* ; "Edited 17-Nov-87 10:23 by jrb:")

                                                             (* ; 

                  "Printout promptString in promptwindow and return value of expression read there")

    (PROG [NEWVALUE (mainWindow (WINDOWPROP window 'MAINWINDOW]
          (RESETLST
              (RESETSAVE (TTYDISPLAYSTREAM (OR window PROMPTWINDOW)))
              (RESETSAVE (TTY.PROCESS (THIS.PROCESS)))
              (CLRPROMPT)
              (RESETSAVE (PRINTLEVEL 4 3))
              (printout T promptString)
              (if
 sameLine?
                  then
 (printout T "> ")
                else
 (printout T T "> "))
              (CLEARBUF T T)                                 (* ; 

                                            "clear tty buffer because it sometimes has stuff left.")


              (* ;; "Make sure that buttoning the main window drags the TTY back here if window is an attachedwindow, and that it won't close until done")


              (if
 mainWindow
                  then
 (WINDOWPROP mainWindow 'PROCESS (WINDOWPROP window 'PROCESS))
                        (WINDOWADDPROP mainWindow 'CLOSEFN 'Don'tCloseIfBusy 'FIRST))
              (ALLOW.BUTTON.EVENTS)
              (CL:UNWIND-PROTECT
                  [SETQ NEWVALUE (CAR (ERSETQ (TTYINREAD T T]
                  (AND mainWindow (WINDOWPROP mainWindow 'PROCESS NIL))))
          (RETURN NEWVALUE])
)
(DECLARE%: EVAL@COMPILE 

(PUTPROPS MenuGetOrCreate
 MACRO
 [(name items)
                                 (COND
                                    ((type?
 MENU (GETTOPVAL 'name))
                                     name)
                                    (T (SETTOPVAL 'name (create
 MENU
                                                               CHANGEOFFSETFLG _ T
                                                               ITEMS _ items])
)



(* ;; 
"NiceMenu is used all over the place. It really doesn't belong in this file. Ditto ColumnateMenuItems (JDS 11/8/91)"
)


(DEFINEQ

(NiceMenu

  [LAMBDA (items title)
                                  (* ; "Edited 13-Jun-88 18:56 by TAL")

    (COND
       ((NULL items)
        (PROMPTPRINT "No items for " title)
        NIL)
       (T (LET [(columns (ADD1 (IQUOTIENT (FLENGTH items)
                                      35]
               (MENU (create
 MENU
                            CHANGEOFFSETFLG _ T
                            ITEMS _ (ColumnateMenuItems items columns)
                            TITLE _ title
                            MENUCOLUMNS _ columns])

(ColumnateMenuItems

  [LAMBDA (items columns nullItem)
                       (* ; "Edited  8-Feb-88 14:26 by mcf")


    (* ;; "Organize items in order by columns instead of by rows")


    (LET ([nullItem (OR nullItem '("" NIL ""]
          (len (LENGTH items))
          rows)
         (COND
            ((OR (NOT (NUMBERP columns))
                 (ZEROP columns))
             (SETQ columns 1)))
         (SETQ rows (IQUOTIENT len columns))
         (COND
            ((NOT (ZEROP (IREMAINDER len columns)))
             (add
 rows 1)))
         (for
 row to
 rows join
 (for
 x in
 (NTH items row)
                                              by
 (NTH x (ADD1 rows)) as
 col from
 0
                                              collect
 x finally
 (COND
                                                                           ((NEQ col columns)
                                                                            (change
 $$VAL
                                                                                   (NCONC1 DATUM 
                                                                                          nullItem])
)



(* ;; 
"Load the site specific file. Note that this assumes that the file is easily found, say on the same directory as this file. If no file is found, that is OK, it is assumed that there is no site file."
)





(* ;; "The ugly RESETLST stuff is to prevent the TTY window from hanging.")



(RESETLST
    [RESETSAVE (WINDOWPROP \TopLevelTtyWindow 'PAGEFULLFN (FUNCTION NILL))
           (LIST (FUNCTION WINDOWPROP)
                 \TopLevelTtyWindow
                 'PAGEFULLFN
                 (WINDOWPROP \TopLevelTtyWindow 'PAGEFULLFN]
    (FILESLOAD (NOERROR)
           LoopsSite))



(* ;; "Some reasonable defaults, in case they wern't set by the site file")



(RPAQ? LoadLoopsForms
 NIL)

(RPAQ? OptionalLispuserFiles
 NIL)

(RPAQ? LOOPSDIRECTORY

       [LET [(thisFile (FULLNAME (GETSTREAM NIL 'INPUT]
            (PACKFILENAME 'HOST (FILENAMEFIELD thisFile 'HOST)
                   'DEVICE
                   (FILENAMEFIELD thisFile 'DEVICE)
                   'DIRECTORY
                   (FILENAMEFIELD thisFile 'DIRECTORY])

(RPAQ? LOOPSLIBRARYDIRECTORY

       (LET [(POSSOURCES (OR (STRPOS "SOURCES>" LOOPSDIRECTORY NIL NIL T NIL UPPERCASEARRAY T)
                             (STRPOS "SYSTEM>" LOOPSDIRECTORY NIL NIL T NIL UPPERCASEARRAY T]
            (IF POSSOURCES THEN (MKATOM (CONCAT (SUBSTRING LOOPSDIRECTORY 1 (SUB1 POSSOURCES))
                                               "LIBRARY>"))
                ELSE LOOPSDIRECTORY)))

(RPAQ? LOOPSUSERSDIRECTORY

       (LET [(POSSOURCES (OR (STRPOS "SOURCES>" LOOPSDIRECTORY NIL NIL T NIL UPPERCASEARRAY T)
                             (STRPOS "SYSTEM>" LOOPSDIRECTORY NIL NIL T NIL UPPERCASEARRAY T]
            (IF POSSOURCES THEN (MKATOM (CONCAT (SUBSTRING LOOPSDIRECTORY 1 (SUB1 POSSOURCES))
                                               "USERS>"))
                ELSE LOOPSDIRECTORY)))

(RPAQ? LOOPSUSERSRULESDIRECTORY

       (LET [(POSSOURCES (OR (STRPOS "SOURCES>" LOOPSDIRECTORY NIL NIL T NIL UPPERCASEARRAY T)
                             (STRPOS "SYSTEM>" LOOPSDIRECTORY NIL NIL T NIL UPPERCASEARRAY T]
            (IF POSSOURCES THEN (MKATOM (CONCAT (SUBSTRING LOOPSDIRECTORY 1 (SUB1 POSSOURCES))
                                               "USERS>RULES>"))
                ELSE LOOPSDIRECTORY)))

(RPAQ DIRECTORIES
 (UNION (LIST LOOPSDIRECTORY LOOPSLIBRARYDIRECTORY LOOPSUSERSDIRECTORY 
                               LOOPSUSERSRULESDIRECTORY)
                         DIRECTORIES))

(MOVD? 'NILL 'UpdateClassBrowsers)
(PUTPROPS LOADLOOPS COPYRIGHT ("Venue & Xerox Corporation" 1983 1984 1985 1986 1987 1988 1990 1991 
1993 2022))
(DECLARE%: DONTCOPY
  (FILEMAP (NIL (6536 10947 (LOADLOOPS 6546 . 9760) (LoadLispUsers 9762 . 10168) (NOCACHEMACRO 10170 . 
10241) (UnMarkChanges 10243 . 10945)) (11728 14953 (PromptEval 11738 . 13434) (PromptRead 13436 . 
14951)) (15559 17323 (NiceMenu 15569 . 16124) (ColumnateMenuItems 16126 . 17321)))))
STOP