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


(FILECREATED " 8-May-2026 10:41:23" {DSK}<Users>larry>il>MEDLEY>INTERNAL>MEDLEY-UTILS.;2
 30963  

      :EDIT-BY "lmm"

      :CHANGES-TO (ADVICE TEDIT.PROMPTPRINT)
                  (FNS GATHER-INFO MAKE-FULLER-DB MEDLEY-FIX-LINKS MEDLEY-FIX-DATES MAKE-EXPORTS-ALL
                       MAKE-WHEREIS-HASH MAKE-WHEREIS-LOOPS HCFILES MAKE-INDEX-HTMLS RECOMPILE-ONE 
                       RECMPL COMPILE-SETUP REMAKEFILES)

      :PREVIOUS-DATE " 4-May-2026 19:19:00" {DSK}<Users>larry>il>MEDLEY>INTERNAL>MEDLEY-UTILS.;1)


(PRETTYCOMPRINT MEDLEY-UTILSCOMS)

(RPAQQ MEDLEY-UTILSCOMS

       [(FNS GATHER-INFO MAKE-FULLER-DB MEDLEY-FIX-LINKS MEDLEY-FIX-DATES)
        (VARS HC-SKIP-EXTENSIONS MEDLEY-FIX-DIRS OKSOURCES OKLIBRARY OKLISPUSERS OKINTERNAL)
        (FNS MAKE-EXPORTS-ALL MAKE-WHEREIS-HASH MAKE-WHEREIS-LOOPS)
        (FNS HCFILES MAKE-INDEX-HTMLS)
        (PROP FILETYPE MEDLEY-UTILS)
        (ADVISE TEDIT.PROMPTPRINT)
        (FNS RECOMPILE-ONE RECMPL COMPILE-SETUP REMAKEFILES)
        (FUNCTIONS REPORT-AND-GO)
        (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA)
                                                                             (NLAML)
                                                                             (LAMA])
(DEFINEQ

(GATHER-INFO

  [LAMBDA (PHASE)
                                            (* ; "Edited 22-May-2023 23:59 by lmm")


                                                           (* ; "Edited 26-Dec-2021 18:56 by larry")


                                                           (* ; "Edited 24-Oct-2021 09:43 by larry")

    (SELECTQ PHASE
        (ALL (for
 I from
 0 to
 4 do
 (GATHER-INFO
 I)))
        (0 (SETQ SYSFILES (UNION SYSFILES FILELST))
           (SETQ FILELST NIL)
           (FILESLOAD (SOURCE)
                  SYSEDIT))
        (1 [SETQ LOADEDFILES (for
 X in
 LOADEDFILELST collect
 (FILENAMEFIELD X 'NAME]
           (FILESLOAD FILESETS)
           [SETQ ALLFILESETSFILES (for
 X in
 FILESETS join
 (APPEND (EVAL X]
           [SETQ SOURCES (for
 X in
 (DIRECTORY (MEDLEYDIR "sources" "*.*;" T))
                            when
 [NOT (MEMB (FILENAMEFIELD X 'EXTENSION)
                                            '(LCOM DFASL TEDIT TXT] collect
 (FILENAMEFIELD
                                                                             X
                                                                             'NAME])
        (-1 (PRINTOUT T " loaded files not in SYSFILES or FILELST: "
                   (for
 X in
 LOADEDFILES when
 (NOT (OR (FMEMB X SYSFILES)
                                                       (FMEMB X FILELST))) collect
 X)
                   T)
            (PRINTOUT T "Sources not loaded: " (CL:SET-DIFFERENCE SOURCES (APPEND ALLFILESETSFILES 
                                                                                 LOADEDFILES))
                   T)
            (PRINTOUT T "Files in FILESETS not loaded " (CL:SET-DIFFERENCE ALLFILESETSFILES 
                                                               LOADEDFILES)
                   T))
        (2 (SETQ DEFINEDFNS (LET ((DEFD NIL))
                                 [MAPATOMS (FUNCTION (CL:LAMBDA (X)
                                                            (CL:WHEN (GETD X)
                                                                (CL:SETQ DEFD (CONS X DEFD)))]
                                 DEFD))
           [for
 X in
 DEFINEDFNS when
 (CCODEP X)
              do
 (LET [(Y (PUTPROP X 'CCC (CALLSCCODE X]
                      (for
 REV in
 '(BLOCK-CALLED-BY CALLED-BY BOUND-BY SPECIAL-BY GLOBAL-BY)
                         as
 VAL in
 Y do
 (for
 S in
 VAL do
 (PUTPROP S REV (CONS X (GETPROP S REV]
           (SETQ CALLEDFNS NIL)
           [MAPATOMS (FUNCTION (LAMBDA (X)
                                 (if
 (AND (NOT (GETD X))
                                          (GETPROP X 'CALLED-BY))
                                     then
 (CL:PUSH X CALLEDFNS])
        (-2 (PRINTOUT T "Functions called and not defined" CALLEDFNS T))
        (3 (for
 X in
 SYSFILES
              do
 (LOAD X 'PROP)
                 (PUTPROP X 'CONTENT (READFILE X))
                 (for
 EXR in
 (GETPROP X 'CONTENT)
                    do
 (SELECTQ (CAR EXR)
                           (DEFINEQ (for
 DFN in
 (CDR EXR)
                                       do
 (if
 (EQUAL (CADR DFN)
                                                     (GETPROP (CAR DFN)
                                                            'EXPR))
                                              then
 (PRINTOUT T (CAR DFN)
                                                          " ")
                                                   (PUTPROP (CAR DFN)
                                                          'EXPR
                                                          (CADR DFN))
                                            else
 (PRINTOUT T (CAR DFN)
                                                        "* "))))
                           NIL)))
           [SETQ ALLCONTENT (for
 X in
 SYSFILES collect
 (CONS X (GETPROP X 'CONTENT]
                                                             (* ; " don't edit with SEDIT")

           (LET (DUPS)
                [for
 X in
 SYSFILES do
 (for
 FN in
 (FILEFNSLST X)
                                         do
 (if
 (GETPROP FN 'WHEREIS)
                                                then
 (NCONC1 (GETPROP FN 'WHEREIS)
                                                            X)
                                                     (OR (FMEMB FN DUPS)
                                                         (SETQ DUPS (CONS FN DUPS)))
                                              else
 (PUTPROP FN 'WHEREIS (LIST X]
                (SETQ DUPFNS DUPS))
           (SETQ NO-SOURCE (for
 X in
 DEFINEDFNS when
 (NOT (GETPROP X 'EXPR)) collect
 X)))
        (-3 (PRINTOUT T "Functions compiled but no expr" NO-SOURCE T)
            (PRINTOUT T "Functions on more than one file: " DUPFNS T))
        (4 (PRINTOUT T T "STARTING MASTERSCOPE PHASE ON " (DATE)
                  T)
           (FILESLOAD (SOURCE)
                  SYSEDIT)
           (for
 X in
 SYSFILES do
 (MSNOTICEFILE X))
           [for
 X in
 SYSFILES do
 (PRINTOUT T T "Analyzing " X T)
                                 (MASTERSCOPE `(ANALYZE ON ,(KWOTE X])
        (-4 "No queries yet")
        (HELP])

(MAKE-FULLER-DB

  [LAMBDA (DRIBBLEFILE DBFILE SYSOUTFILE)
                    (* ; "Edited 28-Mar-2025 08:53 by lmm")


                                                           (* ; "Edited  3-Aug-2023 18:12 by frank")


                                                           (* ; "Edited 16-Jul-2022 22:07 by larry")


                                                           (* ; "Edited 20-Jun-2022 17:23 by larry")

    (FILESLOAD (SOURCE)
           FILESETS)
    (DRIBBLE (OR DRIBBLEFILE "fuller.dribble"))
    (FILESLOAD LAFITE)
    (DOFILESLOAD (SUBSET (APPEND OKSOURCES OKLIBRARY OKLISPUSERS OKINTERNAL)
                        'FINDFILE))
    (GATHER-INFO
 'ALL)
    (MASTERSCOPE '(WHO CALLS XYZZY))
    (DUMPDATABASE NIL (MKATOM (OR DBFILE "fuller.database")))
    (DRIBBLE)
    (MAKESYS (OR SYSOUTFILE "fuller.sysout")
           "Welcome to Fuller sysout"])

(MEDLEY-FIX-LINKS

  [LAMBDA (UNIXPATH)
                                       (* ; "Edited 18-Jan-2021 12:01 by larry")

    (OR UNIXPATH (SETQ UNIXPATH (UNIX-GETENV "MEDLEYDIR"))
        (ERROR "No Directory"))
                            (* ; "Edited 18-Jan-2021 11:45 by larry")

    (ShellCommand (CONCAT "cd " UNIXPATH " && /bin/sh scripts/fixlinks && /bin/sh /tmp/doit"])

(MEDLEY-FIX-DATES

  [LAMBDA (DIRS)
                                           (* ; "Edited 28-Jan-2021 12:15 by larry")

    (for
 X in
 (OR DIRS MEDLEY-FIX-DIRS) join
 (FIX-DIRECTORY-DATES (MEDLEYDIR (PRINT X T])
)

(RPAQQ HC-SKIP-EXTENSIONS

       (PDF SKIP HTML LCOM DFASL SH SYSOUT DRIBBLE IMPTR DISPLAYFONT WD WIDTHS MEDLEYDISPLAYFONT 
            PSCFONT ALL DATABASE 1 MD GZ PRESS IP BITMAP EL ELC XFORMS BUGREPORTS SUITE LISTING AWK 
            DINFOGRAPH HASHFILE BLTCHAR DOC DOCPOINTERS STATUS NOTEFILE ICO ISS BMP PNG PS1 
            VENUESYSOUT ACE FMC HKB LGC CMD COMMAND HTM SVG XML EXE))

(RPAQQ MEDLEY-FIX-DIRS
 ("sources" "library" "lispusers" "internal" "greetfiles" "doctools"))

(RPAQQ OKSOURCES
 (RENAMEFNS VMEM READSYS CASH-FILE HASH-FILE MEDLEYDIR MAKEINIT))

(RPAQQ OKLIBRARY

       (POSTSCRIPTSTREAM CHATTERMINAL DMCHAT CHAT PRESS READNUMBER EDITBITMAP IMAGEOBJ TEDIT HRULE 
              TABLEBROWSER FILEBROWSER GRAPHER SPY WHERE-IS COPYFILES MSANALYZE MSPARSE MSCOMMON 
              MASTERSCOPE UNIXCOMM UNIXPRINT UNICODE HASH CLIPBOARD UNIXCHAT VT100KP VTCHAT SKETCH 
              SKETCHBMELT SCALEBITMAP SKETCHOBJ SKETCHEDIT SKETCHELEMENTS SKETCHOPS MATMULT SAMEDIR 
              REMOTEVMEM ETHERRECORDS UNIXUTILS CHATDECLS BROWSER))

(RPAQQ OKLISPUSERS

       (THINFILES ISO8859IO DINFO HELPSYS MODERNIZE WHEELSCROLL PRETTYFILEINDEX WHO-LINE 
              BACKGROUND-YIELD OBJECTWINDOW REGIONMANAGER COMPARETEXT EXAMINEDEFS COMPARESOURCES 
              COMPAREDIRECTORIES PSEUDOHOSTS DATEFORMAT-EDITOR DOC-OBJECTS EQUATIONS BICLOCK 
              FILEWATCH LIFE IDLEHAX GITFNS TMAX IMTOOLS EQUATIONFORMS UNBOXEDOPS TILED-SEDIT 
              IDLEDEMO WDWHACKS BUTTONS PICK PAGEHOLD UNIXYCD))

(RPAQQ OKINTERNAL
 (MEDLEY-UTILS))
(DEFINEQ

(MAKE-EXPORTS-ALL

  [LAMBDA (OUTFILE)
                                          (* ; "Edited 15-Apr-2026 16:42 by mth")


                                                           (* ; "Edited  3-Aug-2023 18:34 by frank")


                                                           (* ; "Edited  9-Mar-2021 16:11 by larry")


    (* ;; "Edited May 3, 2018 by Ron Kaplan--relative to MEDLEYDIR/lispcore/.  Don't know why it does the CORE/RENAME")


    (* ;; "Edited Aug 17 94 by Sybalsky -- point it to /king/export/lispcore as the truth directory.")


    (* ;; "Edited July 5, 1990 by Sybalsky -- point it to Pele as the truth directory.")


    (* ;; "Edited September 29, 1986 by van Melle")


    (CNDIR (MEDLEYDIR "sources"))
    (LOAD 'FILESETS)
    (GATHEREXPORTS EXPORTFILES (OR OUTFILE "exports.all"])

(MAKE-WHEREIS-HASH

  [LAMBDA (DRIBBLEFILE TMPFILE WHEREISFILE DEPTH SUBDIRS)
    (* ; "Edited  4-Feb-2024 21:57 by lmm")


                                                           (* ; "Edited  3-Aug-2023 18:37 by frank")


                                                             (* ; "Edited 12-Mar-2022 12:46 by rmk")


                                                           (* ; "Edited 24-Mar-2021 13:26 by larry")

    (LET ((FILING.ENUMERATION.DEPTH (OR DEPTH 2))
          HASHFILE)
         (DRIBBLE (OR DRIBBLEFILE "whereis.dribble"))
         (SETQ HASHFILE (XCL::WHERE-IS-NOTICE (OR TMPFILE "whereis.hash-tmp")
                               :FILES
                               (for
 X in
 (OR SUBDIRS MEDLEY-FIX-DIRS)
                                  collect
 (CONCAT (IF
 SUBDIRS
                                                      THEN
 X
                                                    ELSE
 (MEDLEYDIR X))
                                                 "*.;"))
                               :HASH-FILE-SIZE 60000 :NEW T))
         (RENAMEFILE HASHFILE (OR WHEREISFILE "whereis.hash"))
         (DRIBBLE])

(MAKE-WHEREIS-LOOPS

  [LAMBDA NIL
                                                (* ; "Edited  3-Apr-2024 12:12 by lmm")


                                                             (* ; "Edited  4-Feb-2024 22:29 by lmm")

    (MAKE-WHEREIS-HASH
 "whereis-loops.dribble" NIL "whereis-loops.hash" 4 (LIST (GIT-GET-PROJECT
                                                                                 'LOOPS
                                                                                 'CLONEPATH])
)
(DEFINEQ

(HCFILES

  [LAMBDA (BASE REDO SUBSETS)
                                (* ; "Edited  8-May-2026 10:39 by lmm")


                                                             (* ; "Edited  4-May-2026 19:18 by lmm")


                                                             (* ; "Edited 16-Apr-2026 22:42 by mth")


                                                             (* ; "Edited 30-Jun-2024 08:27 by lmm")


                                                             (* ; "Edited 23-Apr-2024 23:15 by lmm")


                                                             (* ; "Edited 22-Apr-2024 13:22 by lmm")


                                                             (* ; "Edited  5-Feb-2024 12:16 by lmm")


                                                             (* ; "Edited  4-Nov-2023 11:14 by lmm")


                                                             (* ; "Edited 20-Oct-2022 16:11 by lmm")


(* ;;;; "BASE is the root directory. Doesn't replace PDF files except when REDO")


(* ;;; " SUBSETS is some combination of (:YRDY :HYML :PRETTY and INDEX")


    (LET* ([DIRLIST (LIST (OR BASE (PSEUDOFILENAME (MEDLEYDIR]
           [PHASES (OR SUBSETS '(TEDIT PRETTY INDEX HRULE]
           (DOTEDIT (MEMB 'TEDIT PHASES))
           (DOPRETTY (MEMB 'PRETTY PHASES)))
          (FILESLOAD PDFSTREAM SKETCH)
          (FONTSET 'STANDARD)
          (while
 DIRLIST
             do
 (SETQ BASE (pop
 DIRLIST)) 

                (* ;; "Breadth-first processing")


                (for
 SRCPATH in
 (DIRECTORY (CONCAT BASE "*.*;"))
                   do
 (PROG* ((SRC (UNPACKFILENAME SRCPATH))
                              [EXT (U-CASE (LISTGET SRC 'EXTENSION]
                              (DIR (LISTGET SRC 'DIRECTORY))
                              [NAME (U-CASE (LISTGET SRC 'NAME]
                              [NOV (PACKFILENAME.STRING `(VERSION NIL ,@SRC]
                              LSFP DEST)
                             (CL:WHEN (DIRECTORYNAMEP SRCPATH)

                                 (* ;; 

                                 "any directory names, push them off and do them in another phase")


                                 (if
 [NOT (OR (STRPOS "<." NOV)
                                              (CL:SEARCH "<LOADUPS>" NOV :TEST #'CL:CHAR-EQUAL)
                                              (STRPOS ">." NOV)
                                              (INFILEP (CONCAT NOV ".skip"]
                                     then
 (SETQ DIRLIST (NCONC1 DIRLIST SRCPATH))
                                          (CL:FORMAT T "~&Deferring to later ~a~%%" SRCPATH)
                                   else
 (CL:FORMAT T "~&Skipping ~a~%%" SRCPATH))
                                 (RETURN))

                       (* ;; "Fixup files that start with . and have no other extension")


                             (CL:WHEN (AND (NULL EXT)
                                           (EQ (CHCON1 NAME)
                                               (CHARCODE %.)))
                                 (SETQ EXT (SUBATOM NAME 2)))
                             (CL:WHEN (MEMB EXT HC-SKIP-EXTENSIONS)

                                 (* ;; "ignore any of these extensions")


                                 (CL:FORMAT T "~&Ignoring (on extension): ~a~%%" SRCPATH)
                                 (RETURN))

                       (* ;; 

                  " doesn't (yet) implement  / to - translation. .readme should show up as -.readme.")


                             (SETQ DEST (CONCAT NOV ".pdf"))
                             (CL:WHEN (AND (NOT REDO)
                                           (INFILEP DEST))
                                 (CL:FORMAT T "~a is already there~%%" DEST)
                                 (RETURN))
                             (CL:WHEN (INFILEP (CONCAT DEST ".skip"))
                                 (CL:FORMAT T "Explicit .skip ~a~%%" DEST)
                                 (RETURN))
                             (CL:FORMAT T "~&Starting on ~a:~%%" SRCPATH)
                             (CL:WHEN [AND DOTEDIT (OR (MEMB EXT '(TEDIT TED SKETCH BRAVO))
                                                       (CAR (REPORT-AND-GO
 (TEDIT.FORMATTEDFILEP
                                                                            SRCPATH)
                                                                   (CL:FORMAT NIL 
                                                "~~%%~S TEDIT.FORMATTEDFILEP of ~A -- Condition: ~~A"
                                                                          'FAIL SRCPATH]
                                 (if
 (EQ REDO 'TEST)
                                     then
 (CL:FORMAT T "Testing open ~a..." SRCPATH)
                                          (CLOSEF? (OPENTEXTSTREAM SRCPATH))
                                   else
 
                                        (* ;; "ADDED HERE")


                                        (SETQ NLSETQGAG NIL)
                                        (SETQ \TEDIT.THELPFLG T)
                                        (REPORT-AND-GO
 (TEDIT.TO.IMAGEFILE SRCPATH DEST 'PDF)
                                               (CL:FORMAT NIL 
                                                  "~~%%~S TEDIT.TO.IMAGEFILE of ~A -- Condition: ~~A"
                                                      'FAIL SRCPATH)))
                                 (PRIN3 " DONE" T)
                                 (TERPRI T)
                                 (RETURN))
                             (CL:WHEN (AND DOPRETTY (OR (NULL EXT)
                                                        (EQ EXT 'IL))
                                           [SETQ LSFP (CAR (REPORT-AND-GO
 (LISPSOURCEFILEP SRCPATH)
                                                                  (CL:FORMAT NIL 
                                                     "~~%%~S LISPSOURCEFILEP of ~A -- Condition: ~~A"
                                                                         'FAIL SRCPATH]
                                           (NEQ LSFP *COMMON-LISP-READ-ENVIRONMENT*))

                                 (* ;; "Why the check for NEQ *COMMON-LISP-READ-ENVIRONMENT* ??")


                                 (PRIN3 "PDF printing " T)
                                 (PRIN3 SRCPATH T)
                                 (PRIN3 " to " T)
                                 (PRIN3 DEST T)
                                 (PRIN3 " ..." T)
                                 (REPORT-AND-GO
 (CL:WITH-OPEN-STREAM (STR (OPEN-PDF-STREAM DEST))
                                                       (PRETTYFILEINDEX SRCPATH NIL STR))
                                        (CL:FORMAT NIL 
                                               "~~%%~S PRETTYFILEINDEX of ~A -- Condition: ~~A"
                                               'FAIL SRCPATH))
                                 (PRIN3 " DONE" T)
                                 (TERPRI T)
                                 (RETURN))

                       (* ;; "Everything else")


                             (PRIN3 "No processing." T)
                             (TERPRI T])

(MAKE-INDEX-HTMLS

  [LAMBDA (BASE TOP LEVEL ROOT.NAME)
                         (* ; "Edited 15-Apr-2026 16:33 by mth")


                                                             (* ; "Edited 28-Jan-2026 11:01 by lmm")


                                                             (* ; "Edited 27-Jan-2026 10:50 by lmm")


                                                             (* ; "Edited 23-Jan-2026 11:59 by lmm")


                                                             (* ; "Edited 29-Apr-2024 14:18 by lmm")


                                                             (* ; "Edited 26-Apr-2024 16:15 by lmm")


                                                             (* ; "Edited 20-Apr-2024 12:34 by lmm")


                                                             (* ; "Edited 13-Apr-2024 21:18 by lmm")


                                                            (* ; " Edited 16-May-2025 13:17 by fgh")

    [OR BASE (SETQ BASE (TRUEFILENAME (MEDLEYDIR]
    (OR (DIRECTORYNAMEP BASE)
        (ERROR BASE "not a directory name"))
    (OR (AND (NUMBERP LEVEL)
             (IGREATERP LEVEL 0))
        (SETQ LEVEL 1))
    (OR ROOT.NAME (SETQ ROOT.NAME 'MEDLEY))
    (RESETLST
        (if
 (EQ LEVEL 1)
            then
 (RESETSAVE (PSEUDOHOSTS T))
                 (PSEUDOHOST ROOT.NAME BASE))
        (SETQ BASE (PSEUDOFILENAME BASE))
        [LET*
         ((SUBDIRS NIL)
          (DEST (PACKFILENAME 'NAME "index" 'EXTENSION "html" 'VERSION NIL 'BODY BASE))
          (PSEUDOHOST (EQ (NTHCHAR BASE (CL:1- 0))
                          '}))
          SLASHED SHORTNAME)
         (CL:WITH-OPEN-FILE
          (S DEST :DIRECTION :OUTPUT :IF-EXISTS :NEW-VERSION :IF-DOES-NOT-EXIST :CREATE 
             :EXTERNAL-FORMAT :UTF-8)
          (CL:FORMAT S "<HTML>~%%<HEAD>~%%")
          (CL:FORMAT S "<TITLE>Index page for ~a</TITLE>~%%" (SETQ SLASHED (SLASHIT BASE)))
          (CL:FORMAT S "<META CHARSET=%"UTF-8%">~%%")
          (CL:FORMAT S "<SCRIPT>~%%")
          (CL:FORMAT S "    function uponclick(){~%%")
          (CL:FORMAT S "        var newLoc = location.href.replace(/\/index.html$/i, %"%");~%%")
          (CL:FORMAT S "        location = newLoc.replace(/\/[­\/]+\/?$/, %"%");~%%")
          (CL:FORMAT S "     }~%%")
          (CL:FORMAT S "</SCRIPT>~%%")
          (CL:FORMAT S "</HEAD>~%%")
          (CL:FORMAT S "<BODY><H1>Index page for ~a</H1>~%%" SLASHED)
          (CL:UNLESS (EQ LEVEL 1)
                 (CL:FORMAT S 
       "<DIV>~%%<BUTTON TYPE=%"BUTTON%" ONCLICK=%"uponclick()%">Go up one level</BUTTON>~%%</DIV>~%%"
                        ))
          (CL:FORMAT S "<P>This is an index of the files just to link them in.~%%<UL>~%%")
          (for
 FULLNAME in
 (DIRECTORY (CONCAT BASE "*.*;"))
             do
 (if
 (EQ (NTHCHAR FULLNAME -1)
                        '>)
                    then
 
                         (* ;; "A directory")


                         (if
 (NOT (DIRECTORYNAMEP FULLNAME))
                             then
 (HELP (CONCAT "NOT DIRNAME " FULLNAME)))
                         (SETQ SHORTNAME (MKATOM (SUBSTRING FULLNAME
                                                        (+ (NCHARS BASE)
                                                           (if
 PSEUDOHOST
                                                               then
 2
                                                             else
 1))
                                                        -2)))
                         (CL:UNLESS (OR (EQ SHORTNAME '.git)
                                        (EQ SHORTNAME '.GIT)
                                        [AND (STRPOS ".git" (L-CASE FULLNAME))
                                             (NOT (STRPOS ".github" (L-CASE FULLNAME]
                                        (INFILEP (CONCAT FULLNAME ".skip")))

                             (* ;; ".skip in the directory itself -- don't index any of it")


                             (SETQ SUBDIRS (NCONC1 SUBDIRS FULLNAME))
                             (CL:FORMAT S "<LI><A HREF=%"~a/%">~a/</A></LI>~%%" SHORTNAME SHORTNAME))
                  elseif
 (MEMB [SETQ SHORTNAME (MKATOM (SUBSTRING FULLNAME (ADD1 (NCHARS BASE))
                                                              (SUB1 (OR (STRPOS ".;" FULLNAME)
                                                                        (STRPOS ";" FULLNAME)
                                                                        (HELP (CONCAT 
                                                                            "No ; in non-directory  "
                                                                                     FULLNAME]
                               '(index.html .skip))
                    then
 
                         (* ;; "dont index the index")


                  elseif
 (MEMB (FILENAMEFIELD SHORTNAME 'EXTENSION)
                               '(IMPTR SKIP skip imptr))
                    then
 
                         (* ;; " don't enuerate ANY.SKIP ANY.IMPTR etc")


                  else
 (CL:FORMAT S "<LI><A HREF=%"~a%">~a</A></LI>~%%" SHORTNAME SHORTNAME)))
          (CL:FORMAT S "</UL></BODY></HTML>~%%"))
         (NCONC SUBDIRS (for
 D in
 SUBDIRS join
 (MAKE-INDEX-HTMLS
 D (OR TOP BASE)
                                                      (ADD1 LEVEL])])
)

(PUTPROPS MEDLEY-UTILS
 FILETYPE
 :COMPILE-FILE)

[XCL:REINSTALL-ADVICE 'TEDIT.PROMPTPRINT :BEFORE '[(:LAST (PROGN (PRIN3 " " T)
                                                                 (PRIN3 MSG T]
       :AFTER
       '((:LAST (AND (STRPOS "GETFN" MSG)
                     (HELP MSG]

(READVISE TEDIT.PROMPTPRINT)
(DEFINEQ

(RECOMPILE-ONE

  [LAMBDA (FILES)
                                            (* ; "Edited  3-Apr-2024 08:12 by lmm")


                                                             (* ; "Edited 10-Feb-2024 13:31 by LMM")


    (* ;; " Still working on this -- the idea is to run a sysout for compiling which has been set up to compile one file, and then logout(T) and restart.")


    (* ;; " it will continue until there are no more files to compile")


    (CL:WITH-OPEN-STREAM (S (OPENSTREAM (OR (INFILEP "COMPILE.DRIBBLE")
                                            "COMPILE.DRIBBLE")
                                   'BOTH))
           (DRIBBLE S)
           (BKSYSBUF " ")
           (PRINTOUT T "------------------" T "SEARCHING...")
           (for
 X in
 (OR FILES SYSFILES) when
 (MEMB (GET X 'FILETYPE)
                                                    '(CL:COMPILE-FILE :COMPILE-FILE))
              when
 [NOT (INFILEP (CONCAT X '.DFASL] do
 (PRINTOUT T "Compiling " X T "")
                                                       (DOFILESLOAD (LIST X))
                                                       (LOAD X 'PROP)
                                                       (COPYFILE (FINDFILE X)
                                                              X)
                                                       (FOR
 V IN
 (CL:VALUES-LIST (CL:COMPILE-FILE
                                                                                  X))
                                                          DO
 (PRINT V))
                                                       (CL:FORCE-OUTPUT (DRIBBLEFILE)
                                                              T)
                                                       (DRIBBLE)
                                                       (RETURN) FINALLY
 (HELP "NO MORE"])

(RECMPL

  [LAMBDA (FILES)
                                            (* ; "Edited 17-Feb-2024 15:39 by lmm")


                                                             (* ; "Edited  8-Feb-2024 19:24 by lmm")

    (LET ((*PRINT-CASE* :DOWNCASE)
          SRC DESTPREV (PRETTYFLG T)
          (*PRINT-BASE* 10))
         (CNDIR)
         (for
 X in
 (OR FILES SYSFILES) do
 (IF
 (SETQ SRC (INFILEP (CONCAT SRCDIR X ".ilsp")))
                                              THEN
 (APPLY* (COMPILE-FILE? SRC)
                                                          SRC])

(COMPILE-SETUP

  [LAMBDA NIL
                                                (* ; "Edited 17-Feb-2024 08:23 by lmm")


                                                           (* ; "Edited  9-Feb-2024 16:15 by larry")


    (* ;; "first set up compile environment")


    (FILESLOAD SYSEDIT)

    (* ;; " load in necessary packages")


    (FILESLOAD MEDLEY-UTILS)
    (CLRHASH CLISPARRAY)                                     (* ; 

                                                       "clear out cache of file package translations")

    (FILESLOAD WHERE-IS MEDLEY-UTILS GITFNS FILEBROWSER])

(REMAKEFILES

  [LAMBDA (FILES)
                                            (* ; "Edited  8-Feb-2024 07:47 by lmm")

    (LET ((*PRINT-CASE* :DOWNCASE)
          WIN DIFF (PRETTYFLG T)
          (*PRINT-BASE* 10))
         (for
 X in
 (OR FILES SYSFILES)
            do
 (LOAD X 'PROP)
               (PUTPROP X 'CONTENT (READFILE X))
               (for
 EXR in
 (GETPROP X 'CONTENT)
                  do
 (SELECTQ (CAR EXR)
                         (DEFINEQ (for
 DFN in
 (CDR EXR)
                                     do
 (if
 (EQUAL (CADR DFN)
                                                   (GETPROP (CAR DFN)
                                                          'EXPR))
                                            then
 (PRINTOUT T (CAR DFN)
                                                        " ")
                                                 (PUTPROP (CAR DFN)
                                                        'EXPR
                                                        (CADR DFN))
                                          else
 (PRINTOUT T (CAR DFN)
                                                      "* "))))
                         NIL))
               (MAKEFILE (MKATOM (SETQ DESTFILE (CONCAT (L-CASE X)
                                                       ".ilsp")))
                      '(NEW))
               (SETQ DIFF (COMPARESOURCES X DESTFILE NIL))
               (TERPRI])
)

(DEFMACRO REPORT-AND-GO
 (FORM REPORT-FORMAT)
                 (* ; "Edited  4-May-2026 19:02 by lmm")


                                                             (* ; "Edited 16-Apr-2026 16:02 by mth")

   `[CL:MULTIPLE-VALUE-BIND (FORM-RESULT ERROR-CONDITION)
           (IGNORE-ERRORS (CL:VALUES ,FORM))                 (* ; "Only the first value")

           (COND
              (ERROR-CONDITION (BAKTRACE 'BAKTRACE NIL NIL 1 T)
                     (PRIN3 (CL:FORMAT NIL ,REPORT-FORMAT ERROR-CONDITION)
                            T)
                     NIL)
              (T (LIST FORM-RESULT])
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS 

(ADDTOVAR NLAMA
 )

(ADDTOVAR NLAML
 )

(ADDTOVAR LAMA
 )
)
(DECLARE%: DONTCOPY
  (FILEMAP (NIL (1365 8299 (GATHER-INFO 1375 . 6757) (MAKE-FULLER-DB 6759 . 7668) (MEDLEY-FIX-LINKS 7670
 . 8063) (MEDLEY-FIX-DATES 8065 . 8297)) (9871 12447 (MAKE-EXPORTS-ALL 9881 . 10728) (
MAKE-WHEREIS-HASH 10730 . 11919) (MAKE-WHEREIS-LOOPS 11921 . 12445)) (12448 25236 (HCFILES 12458 . 
19760) (MAKE-INDEX-HTMLS 19762 . 25234)) (25570 30182 (RECOMPILE-ONE 25580 . 27477) (RECMPL 27479 . 
28082) (COMPILE-SETUP 28084 . 28708) (REMAKEFILES 28710 . 30180)) (30184 30807 (REPORT-AND-GO 30184 . 
30807)))))
STOP