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


(FILECREATED "16-Jan-2025 13:35:20" {DSK}<home>matt>Interlisp>medley>sources>APUTDQ.;2
 10901  

      :EDIT-BY "mth"

      :CHANGES-TO (FNS LOADUP)

      :PREVIOUS-DATE "25-Oct-2022 11:44:17" {DSK}<home>matt>Interlisp>medley>sources>APUTDQ.;1)


(* ; "
Copyright (c) 1981-1988, 1990, 2021-2022, 2025 by Venue & Xerox Corporation.
")

(PRETTYCOMPRINT APUTDQCOMS)

(RPAQQ APUTDQCOMS

       [
        (* ;; " this file contains some dummy definitions of functions whose real implementation is on other files")


        (DECLARE%: EVAL@LOAD DONTCOPY (P (PRIN1 "Warning: APUTDQ contains dummy definitions of " T)
                                         (PRIN1 
                                        "FAULTEVAL FAULTAPPLY ERRORX SET-DOCUMENTATION SMASHFILECOMS"
                                                T)
                                         (PRIN1 "Be careful not to confuse with the real definitions"
                                                T)
                                         (TERPRI T)))
        (FNS GREETFILENAME FAULTEVAL FAULTAPPLY ERRORX SET-DOCUMENTATION)
        (FNS SMASHFILECOMS SMASHFILECOMSLST)
        (INITVARS (DEFAULTREGISTRY)
               (USERGREETFILES)
               (LOGINHOST/DIR '{DSK}))
        (FNS LOADUP ENDLOADUP)
        (ALISTS (SYSTEMINITVARS \CONNECTED.DIRECTORY DWIMFLG ADDSPELLFLG FILEPKGFLG BUILDMAPFLG 
                       UPDATEMAPFLG DEFAULTREGISTRY DEFAULTPRINTINGHOST DIRECTORIES USERGREETFILES 
                       NETWORKOSTYPES CH.NET.HINT CH.DEFAULT.DOMAIN CH.DEFAULT.ORGANIZATION 
                       ADVISEDFNS LISPUSERSDIRECTORIES DISPLAYFONTDIRECTORIES DISPLAYFONTEXTENSIONS 
                       INTERPRESSFONTDIRECTORIES))
        [DECLARE%: DONTEVAL@LOAD DOCOPY 

               (* ;; "many of these are obsolete and can be removed, but it is unclear which ones")


               (P (DUMMYDEF (ADDSTATS *)
                         (LISPXWATCH NILL)
                         (CLBUFS NILL)
                         (FINDFILE INFILEP)
                         (FILEMAP *)
                         (VIRGINFN GETD))
                  (DUMMYDEF (* QUOTE)
                         (GETP GETPROP)
                         (DECLARE QUOTE)
                         (FRPLNODE2 RPLNODE2)
                         (DISPLAYTERMP TRUE)
                         (FRPLACA RPLACA)
                         (FRPLACD RPLACD)
                         (MISSPELLED? NILL)
                         (UNDOSAVE NILL)
                         (SETLINELENGTH ZERO)
                         (DOBE NILL)
                         (RELINK NILL)
                         (PUT PUTPROP)
                         (/PUT PUTPROP)))
               (ADDVARS (SYSFILES)
                      (LISPXHISTORY)
                      (LINKEDFNS))
               (VARS (CLEARSTKLST T)
                     (SYSHASHARRAY (HASHARRAY 50))
                     (DISPLAYTERMFLG T)
                     (%#UNDOSAVES)
                     (NLAMA)
                     (NLAML)
                     (LAMS)
                     (TTYLINELENGTH 82)
                     (COMPILE.EXT 'LCOM)
                     (FASL.EXT 'DFASL)
                     (*COMPILED-EXTENSIONS* '(DFASL LCOM))
                     (SYSOUT.EXT 'SYSOUT]
        (LOCALVARS . T)
        (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA)
                                                                             (NLAML)
                                                                             (LAMA])



(* ;; 
" this file contains some dummy definitions of functions whose real implementation is on other files")


(DECLARE%: EVAL@LOAD DONTCOPY 

(PRIN1 "Warning: APUTDQ contains dummy definitions of " T)

(PRIN1 "FAULTEVAL FAULTAPPLY ERRORX SET-DOCUMENTATION SMASHFILECOMS" T)

(PRIN1 "Be careful not to confuse with the real definitions" T)

(TERPRI T)
)
(DEFINEQ

(GREETFILENAME

(LAMBDA (USER) (* ; "Edited 20-Jul-88 16:00 by drc:") (* ;; "Returns name of an existing greeting file, or NIL") (DECLARE (GLOBALVARS USERGREETFILES LOGINHOST/DIR COMPILE.EXT)) (LET (FILE) (SELECTQ USER (T (OR (AND (EQ \MACHINETYPE \MAIKO) (OR (AND (SETQ FILE (UNIX-GETENV "LDEINIT")) (INFILEP FILE)) (INFILEP "{DSK}/usr/local/lde/site-init.lisp"))) (FINDFILE-WITH-EXTENSIONS "{DSK}INIT" NIL (APPEND *COMPILED-EXTENSIONS* (QUOTE ("LISP")))) (while (SETQ FILE (PROMPTFORWORD (QUOTE "Please enter name of system init file
(e.g. {server}<directory>INIT.extension): "))) until (SETQ FILE (INFILEP FILE)) finally (RETURN FILE)))) (NIL) (COND ((LISTP USERGREETFILES) (* ;; "USERGREETFILES is a list of templates for possible init file names.  The templates contain pieces of file names and the symbols USER and COM to denote logged in user and compiled extension.") (LET ((POS (AND DEFAULTREGISTRY (STRPOS (QUOTE %.) (SETQ USER (U-CASE USER)))))) (* ; "Grapevine hack: if user's login name has registry same as default, strip off registry before treating name as a directory") (COND ((AND POS (STREQUAL (SUBSTRING USER (ADD1 POS) -1) (MKSTRING DEFAULTREGISTRY))) (SETQ USER (SUBSTRING USER 1 (SUB1 POS))))) (for D in (COND ((LISTP (CAR USERGREETFILES)) USERGREETFILES) (T (CONS USERGREETFILES))) when (SETQ D (if (MEMB (QUOTE COM) D) then (* ;; "Icky old compiled file specification.  Want to search for everything in *COMPILED-EXTENSIONS*.  Have to smash extension to NIL so that it looks like name has no explicit extension (there is already a dot in the template, sigh)") (FINDFILE-WITH-EXTENSIONS (PACKFILENAME.STRING (QUOTE EXTENSION) NIL (QUOTE BODY) (CONCATLIST (SUBPAIR (QUOTE (USER COM)) (LIST USER "") D))) NIL *COMPILED-EXTENSIONS*) else (* ; "Random file, no COM element") (INFILEP (CONCATLIST (SUBST USER (QUOTE USER) D))))) do (RETURN D))))))))
)

(FAULTEVAL

(NLAMBDA FAULTX (* lmm "16-MAY-80 11:57") (RAID FAULTX)))

(FAULTAPPLY

(LAMBDA (FAULTFN FAULTARGS) (* lmm "16-MAY-80 11:58") (RAID FAULTFN)))

(ERRORX

(LAMBDA (ERXM) (* lmm "16-MAY-80 11:58") (RAID ERXM)))

(SET-DOCUMENTATION

(LAMBDA (NAME DOC-TYPE NEW-STRING) (* "lmm" "27-Oct-86 11:16") NIL))
)
(DEFINEQ

(SMASHFILECOMS

(LAMBDA (FILE) (* JonL " 8-Jun-84 10:43") (* ; "dummy definition for APUTDQ") (PROG ((FILECOMS (PACK (LIST FILE (QUOTE COMS))))) (COND ((BOUNDP FILECOMS) (* ; "Already loaded, but may want to clobber its FNS, VARS, and BLOCKS E.G.  MISC, BASIC.") (SMASHFILECOMSLST (GETATOMVAL FILECOMS)) (SET FILECOMS (QUOTE NOBIND))))))
)

(SMASHFILECOMSLST

(LAMBDA (COMS) (* lmm "11-MAR-83 13:17") (MAPC COMS (FUNCTION (LAMBDA (COM) (PROG (NAME) (AND (EQ (CADR COM) (QUOTE *)) (LITATOM (CADDR COM)) (SETQ NAME (CADDR COM))) (SELECTQ (CAR COM) (COMS (SMASHFILECOMSLST (COND (NAME (GETATOMVAL NAME)) (T (CDR COM))))) (FILEVARS (SETQ NAME (COND ((EQ (CADR COM) (QUOTE *)) (* ;; "if caddr is a litatom, name was set to it above.  if caddr is not, dangerous to evaluate the form, so punt") (GETATOMVAL NAME)) (T (CDR COM))))) ((PROP IFPROP) (COND ((AND (EQ (CADDR COM) (QUOTE *)) (LITATOM (CADDDR COM))) (SETQ NAME (CADDDR COM))))) NIL) (COND ((AND NAME (LITATOM NAME)) (SET NAME (QUOTE NOBIND)))))))))
)
)

(RPAQ? DEFAULTREGISTRY
 )

(RPAQ? USERGREETFILES
 )

(RPAQ? LOGINHOST/DIR
 '{DSK})
(DEFINEQ

(LOADUP

  [LAMBDA (FILES)
                                            (* ; "Edited 16-Jan-2025 13:35 by mth")


                                                           (* ; "Edited 12-Mar-2021 00:15 by larry")

    (for
 X in
 FILES do
 (if
 (FMEMB X SYSFILES)
                           then
 (PRINTOUT T X " already loaded" T)
                         else
 (PRINTOUT T "loading " X T)
                              (DOFILESLOAD (LIST '(SYSLOAD)
                                                 X)))
                       (SMASHFILECOMS
 X])

(ENDLOADUP

  [LAMBDA NIL
    (DECLARE
 (GLOBALVARS USERRECLST SYSTEMINITVARS MEDLEY-INIT-VARS))

                                                             (* ; "Edited 25-Oct-2022 11:43 by lmm")


    (* ;; "")


    (* ;; "All records existing at this point in time have been loaded as part of the system.")


    (FOR
 R IN
 USERRECLST DO
 (RECORDPRIORITY R 'SYSTEM))

    (* ;; "reset variables to nil")


    (* ;; " MEDLEY-INIT-VARS is done by aroundexitfn")


    [FOR
 X IN
 SYSTEMINITVARS WHEN
 (NOT (ASSOC (CAR X)
                                              MEDLEY-INIT-VARS))
       DO
 (SETTOPVAL (CAR X)
                 (COPY (CDR X]
    (FOR
 FILE IN
 (OPENP) DO
 (PRINTOUT T (CLOSEF FILE)
                                   " closed" T))

    (* ;; "get rid of files loaded")


    (NCONC SYSFILES (REVERSE FILELST))
    (SETQ FILELST NIL)
    (for
 TYPE in
 FILEPKGTYPES do
 (FILEPKGCHANGES TYPE NIL))
    (CLRPROMPT])
)

(ADDTOVAR SYSTEMINITVARS

          (\CONNECTED.DIRECTORY . {DSK})
          (DWIMFLG . T)
          (ADDSPELLFLG . T)
          (FILEPKGFLG . T)
          (BUILDMAPFLG . T)
          (UPDATEMAPFLG . T)
          (DEFAULTREGISTRY)
          (DEFAULTPRINTINGHOST)
          (DIRECTORIES)
          (USERGREETFILES)
          (NETWORKOSTYPES)
          (CH.NET.HINT)
          (CH.DEFAULT.DOMAIN)
          (CH.DEFAULT.ORGANIZATION)
          (ADVISEDFNS)
          (LISPUSERSDIRECTORIES {DSK})
          (DISPLAYFONTDIRECTORIES {DSK})
          (DISPLAYFONTEXTENSIONS DISPLAYFONT)
          (INTERPRESSFONTDIRECTORIES {DSK}))
(DECLARE%: DONTEVAL@LOAD DOCOPY 

(DUMMYDEF (ADDSTATS *
)
       (LISPXWATCH NILL)
       (CLBUFS NILL)
       (FINDFILE INFILEP)
       (FILEMAP *
)
       (VIRGINFN GETD))

(DUMMYDEF                                                    (* QUOTE)

       (GETP GETPROP)
       (DECLARE
 QUOTE)
       (FRPLNODE2 RPLNODE2)
       (DISPLAYTERMP TRUE)
       (FRPLACA RPLACA)
       (FRPLACD RPLACD)
       (MISSPELLED? NILL)
       (UNDOSAVE NILL)
       (SETLINELENGTH ZERO)
       (DOBE NILL)
       (RELINK NILL)
       (PUT PUTPROP)
       (/PUT PUTPROP))


(ADDTOVAR SYSFILES
 )

(ADDTOVAR LISPXHISTORY
 )

(ADDTOVAR LINKEDFNS
 )


(RPAQQ CLEARSTKLST
 T)

(RPAQ SYSHASHARRAY
 (HASHARRAY 50))

(RPAQQ DISPLAYTERMFLG
 T)

(RPAQQ %#UNDOSAVES
 NIL)

(RPAQQ NLAMA
 NIL)

(RPAQQ NLAML
 NIL)

(RPAQQ LAMS
 NIL)

(RPAQQ TTYLINELENGTH
 82)

(RPAQQ COMPILE.EXT
 LCOM)

(RPAQQ FASL.EXT
 DFASL)

(RPAQQ *COMPILED-EXTENSIONS*
 (DFASL LCOM))

(RPAQQ SYSOUT.EXT
 SYSOUT)
)
(DECLARE%: DOEVAL@COMPILE DONTCOPY

(LOCALVARS . T)
)
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS 

(ADDTOVAR NLAMA
 )

(ADDTOVAR NLAML
 )

(ADDTOVAR LAMA
 )
)
(PUTPROPS APUTDQ COPYRIGHT ("Venue & Xerox Corporation" 1981 1982 1983 1984 1985 1986 1987 1988 1990 
2021 2022 2025))
(DECLARE%: DONTCOPY
  (FILEMAP (NIL (3999 6207 (GREETFILENAME 4009 . 5882) (FAULTEVAL 5884 . 5956) (FAULTAPPLY 5958 . 6044) 
(ERRORX 6046 . 6112) (SET-DOCUMENTATION 6114 . 6205)) (6208 7228 (SMASHFILECOMS 6218 . 6560) (
SMASHFILECOMSLST 6562 . 7226)) (7322 8926 (LOADUP 7332 . 7916) (ENDLOADUP 7918 . 8924)))))
STOP