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

(FILECREATED "25-Aug-2021 13:12:07" {DSK}<home>larry>medley>sources>APUTDQ.;2
 11185  

      changes to%:  (FNS ENDLOADUP)

      previous date%: "25-Aug-2021 12:11:36" {DSK}<home>larry>medley>sources>APUTDQ.;1)


(* ; "
Copyright (c) 1981-1988, 1990, 2021 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 FAULTEVAL)
                                                                             (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 12-Mar-2021 00:15 by larry")

    (for
 X in
 FILES do
 (PRINTOUT T "loading " X T)
                                  (OR (FMEMB X SYSFILES)
                                      (DOFILESLOAD (LIST '(SYSLOAD)
                                                         X)))
                                  (SMASHFILECOMS
 X])

(ENDLOADUP

  [LAMBDA NIL
                                          (* ; "Edited 25-Aug-2021 13:07 by larry")


    (* ;; "set up for NONET configuration;  sites with ethernet can load in init from other places")


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


    (DECLARE
 (GLOBALVARS USERRECLST SYSTEMINITVARS MEDLEY-INIT-VARS AFTERSYSOUTFORMS))
    (FOR
 R IN
 USERRECLST DO
 (RECORDPRIORITY R 'SYSTEM))

    (* ;; "reset variables to nil")


    (MEDLEY-INIT-VARS T)
    [FOR
 X IN
 SYSTEMINITVARS WHEN
 (NOT (ASSOC (CAR X)
                                                          MEDLEY-INIT-VARS))
       DO
 (SETTOPVAL (CAR X)
                     (COPY (CDR X]

    (* ;; " make sure these are done first")


    (SETQ AFTERSYSOUTFORMS (CONS '(MEDLEY-INIT-VARS)
                                 (REMOVE '(MEDLEY-INIT-VARS)
                                        AFTERSYSOUTFORMS)))
    (SETQ AFTERMAKESYSFORMS (CONS '(MEDLEY-INIT-VARS)
                                  (REMOVE '(MEDLEY-INIT-VARS)
                                         AFTERMAKESYSFORMS)))
    (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
 FAULTEVAL)

(ADDTOVAR NLAML
 )

(ADDTOVAR LAMA
 )
)
(PUTPROPS APUTDQ COPYRIGHT ("Venue & Xerox Corporation" 1981 1982 1983 1984 1985 1986 1987 1988 1990 
2021))
(DECLARE%: DONTCOPY
  (FILEMAP (NIL (3963 6171 (GREETFILENAME 3973 . 5846) (FAULTEVAL 5848 . 5920) (FAULTAPPLY 5922 . 6008) 
(ERRORX 6010 . 6076) (SET-DOCUMENTATION 6078 . 6169)) (6172 7192 (SMASHFILECOMS 6182 . 6524) (
SMASHFILECOMSLST 6526 . 7190)) (7286 9211 (LOADUP 7296 . 7719) (ENDLOADUP 7721 . 9209)))))
STOP