(FILECREATED " 2-Feb-86 18:56:25" {DSK}<LISPFILES2>SETUPMENU.LSP;2 15995
changes to: (VARS SETUPMENUCOMS))
(* Copyright (c) 1986 by Quintus Computer Systems, Inc. All rights reserved.)
(PRETTYCOMPRINT SETUPMENUCOMS)
(RPAQQ SETUPMENUCOMS ((VARS (ORIGINAL.tedit NIL)
(QP.CURRENT.TEXTSTREAM NIL)
(QP.TEDIT.PROPS (QUOTE (SELFN (LAMBDA (TEXT SELECTION TYPE ACTION)
(QP.MARK.PREDICATE TEXT SELECTION
TYPE ACTION))
GETFN
(LAMBDA (STREAM FILENAME WHEN)
(QP.ATTACH.STREAM.GET STREAM
FILENAME
WHEN))
PUTFN
(LAMBDA (STREAM FILENAME WHEN)
(QP.ATTACH.STREAM.PUT STREAM
FILENAME
WHEN))
FONT
(TERMINAL 10 STANDARD))))
(QP.TEDIT.MODE (QUOTE PROLOG))
(QP.PROLOG.RESTARTABLE T)
(QP.PROLOG.STREAM.HANDLE NIL)
(QP.PROLOG.WINDOW.HANDLE NIL)
(QP.PROLOG.NAME (QUOTE Xerox% Quintus% Prolog))
(QP.PROLOG.FONT NIL)
(QP.SAVE.SELECTION NIL)
(QP.SCRATCH.FILE (QUOTE {CORE}QP.SCRATCH.FILE))
(QP.LOGO.WINDOW NIL))
(ADDVARS (GLOBALVARS ORIGINAL.tedit)
(GLOBALVARS QP.CURRENT.TEXTSTREAM)
(GLOBALVARS QP.TEDIT.PROPS)
(GLOBALVARS QP.TEDIT.MODE)
(GLOBALVARS QP.PROLOG.RESTARTABLE)
(GLOBALVARS QP.PROLOG.STREAM.HANDLE)
(GLOBALVARS QP.PROLOG.WINDOW.HANDLE)
(GLOBALVARS QP.PROLOG.NAME)
(GLOBALVARS QP.PROLOG.FONT)
(GLOBALVARS QP.SAVE.SELECTION)
(GLOBALVARS QP.SCRATCH.FILE)
(GLOBALVARS QP.LOGO.WINDOW))
(FILES ICONW LOGO2 TEDIT TEXEC)
(FNS QP.ATTACH.STREAM.GET QP.ATTACH.STREAM.PUT QP.CLOSE.CLEANUP QP.CREATE.SCRATCH.FILE
QP.CREATE.TEDIT.MENU QP.EDITOR.LOAD.CODE QP.ENSURE.VALID.SOURCE.FILE
QP.MAKE.FAKE.FILENAME QP.MARK.PREDICATE QP.PROLOG.SETUP QP.PROLOG.TEXEC QP.RESET.PROLOG
QP.SETUP.TRANSFER.FILE QP.TEDIT.COMPILE.CODE QP.TEDIT.CONSULT.CODE QUINTUS.TEDIT)
(MACROS QP.GET.CURRENT.FILENAME)
(P (QP.PROLOG.SETUP))))
(RPAQQ ORIGINAL.tedit NIL)
(RPAQQ QP.CURRENT.TEXTSTREAM NIL)
(RPAQQ QP.TEDIT.PROPS (SELFN (LAMBDA (TEXT SELECTION TYPE ACTION)
(QP.MARK.PREDICATE TEXT SELECTION TYPE ACTION))
GETFN
(LAMBDA (STREAM FILENAME WHEN)
(QP.ATTACH.STREAM.GET STREAM FILENAME WHEN))
PUTFN
(LAMBDA (STREAM FILENAME WHEN)
(QP.ATTACH.STREAM.PUT STREAM FILENAME WHEN))
FONT
(TERMINAL 10 STANDARD)))
(RPAQQ QP.TEDIT.MODE PROLOG)
(RPAQQ QP.PROLOG.RESTARTABLE T)
(RPAQQ QP.PROLOG.STREAM.HANDLE NIL)
(RPAQQ QP.PROLOG.WINDOW.HANDLE NIL)
(RPAQQ QP.PROLOG.NAME Xerox% Quintus% Prolog)
(RPAQQ QP.PROLOG.FONT NIL)
(RPAQQ QP.SAVE.SELECTION NIL)
(RPAQQ QP.SCRATCH.FILE {CORE}QP.SCRATCH.FILE)
(RPAQQ QP.LOGO.WINDOW NIL)
(ADDTOVAR GLOBALVARS ORIGINAL.tedit)
(ADDTOVAR GLOBALVARS QP.CURRENT.TEXTSTREAM)
(ADDTOVAR GLOBALVARS QP.TEDIT.PROPS)
(ADDTOVAR GLOBALVARS QP.TEDIT.MODE)
(ADDTOVAR GLOBALVARS QP.PROLOG.RESTARTABLE)
(ADDTOVAR GLOBALVARS QP.PROLOG.STREAM.HANDLE)
(ADDTOVAR GLOBALVARS QP.PROLOG.WINDOW.HANDLE)
(ADDTOVAR GLOBALVARS QP.PROLOG.NAME)
(ADDTOVAR GLOBALVARS QP.PROLOG.FONT)
(ADDTOVAR GLOBALVARS QP.SAVE.SELECTION)
(ADDTOVAR GLOBALVARS QP.SCRATCH.FILE)
(ADDTOVAR GLOBALVARS QP.LOGO.WINDOW)
(FILESLOAD ICONW LOGO2 TEDIT TEXEC)
(DEFINEQ
(QP.ATTACH.STREAM.GET
(LAMBDA (STREAM FILENAME WHEN)
(SELECTQ WHEN
(AFTER (if (AND FILENAME (NOT (GETPROP FILENAME (QUOTE STREAM))))
then (PUTPROP FILENAME (QUOTE STREAM)
STREAM)
(WINDOWPROP (CAR (fetch (TEXTOBJ \WINDOW)
of (TEXTOBJ STREAM)))
(QUOTE FILENAME)
FILENAME)
elseif FILENAME
then (TEDIT.PROMPTPRINT STREAM
"WARNING - There already is a Tedit window open on this file."
T)))
(LET ((FILE (QP.GET.CURRENT.FILENAME STREAM)))
(if FILE
then (REMPROP FILE (QUOTE STREAM)))))))
(QP.ATTACH.STREAM.PUT
(LAMBDA (STREAM FILENAME WHEN)
(SELECTQ WHEN
(AFTER (PUTPROP FILENAME (QUOTE STREAM)
STREAM)
(WINDOWPROP (CAR (fetch (TEXTOBJ \WINDOW) of (TEXTOBJ STREAM)))
(QUOTE FILENAME)
FILENAME))
NIL)))
(QP.CLOSE.CLEANUP
(LAMBDA (WINDOW)
(LET ((FILENAME (WINDOWPROP WINDOW (QUOTE FILENAME))))
(if FILENAME
then (REMPROP FILENAME (QUOTE STREAM))))))
(QP.CREATE.SCRATCH.FILE
(LAMBDA NIL
(if (EQ QP.SCRATCH.FILE NIL)
then (SETQ QP.SCRATCH.FILE (OPENFILE (QUOTE {CORE}QPSCRATCH;1)
(QUOTE BOTH)))
else (CLOSEF? QP.SCRATCH.FILE)
(DELFILE QP.SCRATCH.FILE)
(OPENFILE QP.SCRATCH.FILE (QUOTE BOTH)))))
(QP.CREATE.TEDIT.MENU
(LAMBDA NIL
(TEDIT.ADD.MENUITEM TEDIT.DEFAULT.MENU (QUOTE ("Library" (QUOTE (LAMBDA (X)
(QP.LIBRARY
X))))))
(TEDIT.ADD.MENUITEM TEDIT.DEFAULT.MENU (QUOTE ("Find Definition" (QUOTE (LAMBDA
(X)
(
QP.FIND.DEFINITION
X))))))
(TEDIT.ADD.MENUITEM TEDIT.DEFAULT.MENU (QUOTE ("Compile" (QUOTE (LAMBDA (X)
(
QP.TEDIT.COMPILE.CODE
X))))))
(TEDIT.ADD.MENUITEM TEDIT.DEFAULT.MENU (QUOTE ("Consult" (QUOTE (LAMBDA (X)
(
QP.TEDIT.CONSULT.CODE
X))))))
(SETQ QP.TEDIT.MENU T)))
(QP.EDITOR.LOAD.CODE
(LAMBDA (OPERATION STREAM)
(QP.SEND.PROLOG (CONCAT "'$editor←load←code'(" OPERATION ",'" (QP.GET.CURRENT.FILENAME STREAM)
"')"))))
(QP.ENSURE.VALID.SOURCE.FILE
(LAMBDA (STREAM)
(if (NOT (QP.GET.CURRENT.FILENAME STREAM))
then (LET ((FAKE.FILENAME (QP.MAKE.FAKE.FILENAME STREAM)))
(PUTPROP FAKE.FILENAME (QUOTE STREAM)
STREAM)
(WINDOWPROP (CAR (fetch (TEXTOBJ \WINDOW) of (TEXTOBJ STREAM)))
(QUOTE FILENAME)
FAKE.FILENAME)))))
(QP.MAKE.FAKE.FILENAME
(LAMBDA (STREAM)
(LET ((LOC.LIST (LOC STREAM)))
(PACKFILENAME (QUOTE NAME)
(PACK* (QUOTE QP)
(CAR LOC.LIST)
(QUOTE QP)
(CDR LOC.LIST))
(QUOTE HOST)
(QUOTE CORE)
(QUOTE EXTENSION)
(QUOTE PL)))))
(QP.MARK.PREDICATE
(LAMBDA (TEXT SELECTION TYPE ACTION)
(SELECTQ ACTION
(TENTATIVE (if (AND (EQ (WINDOWPROP (CAR (fetch (TEXTOBJ \WINDOW)
of TEXT))
(QUOTE TEDIT.MODE))
(QUOTE PROLOG))
(EQ TYPE (QUOTE NORMAL))
(EQ (QUOTE PARA)
(fetch (SELECTION SELKIND) of SELECTION)))
then (SETQ QP.SAVE.SELECTION SELECTION)))
(FINAL (if (AND (EQ (WINDOWPROP (CAR (fetch (TEXTOBJ \WINDOW)
of TEXT))
(QUOTE TEDIT.MODE))
(QUOTE PROLOG))
(EQ TYPE (QUOTE NORMAL))
(EQ (QUOTE PARA)
(fetch (SELECTION SELKIND) of SELECTION)))
then (QP.FIND.PREDICATE (fetch (TEXTOBJ STREAMHINT) of TEXT)
QP.SAVE.SELECTION)))
NIL)))
(QP.PROLOG.SETUP
(LAMBDA NIL
(QP.LOGO.WINDOW)
(LET ((NEWITEM (QUOTE ("Xerox Quintus Prolog" (QUOTE (QP.PROLOG.TEXEC))
"Runs Xerox Quintus Prolog in a TExec window"
(SUBITEMS ("Start New Prolog" (QUOTE (
QP.RESET.PROLOG))
"Runs Xerox Quintus Prolog after reinitializing the database")))))
(OLDITEMS BackgroundMenuCommands))
(if (NOT (MEMBER NEWITEM BackgroundMenuCommands))
then (SETQ BackgroundMenuCommands (CONS NEWITEM OLDITEMS))
(SETQ BackgroundMenu NIL))) (*)
(QP.CREATE.TEDIT.MENU)
(if (NOT (CCODEP (QUOTE ORIGINAL.tedit)))
then (MOVD (QUOTE TEDIT)
(QUOTE ORIGINAL.tedit))
(UNMARKASCHANGED (QUOTE ORIGINAL.tedit)
(QUOTE FNS))
(MOVD (QUOTE QUINTUS.TEDIT)
(QUOTE TEDIT))
(UNMARKASCHANGED (QUOTE TEDIT)
(QUOTE FNS))) (*)
(if (NOT QP.PROLOG.FONT)
then (SETQ QP.PROLOG.FONT (FONTCREATE (QUOTE TERMINAL)
10
(QUOTE STANDARD)
0
(QUOTE DISPLAY))))))
(QP.PROLOG.TEXEC
(LAMBDA NIL
(if (NOT (FIND.PROCESS QP.PROLOG.NAME))
then (PROG (handle window teditstream)
(ALLOW.BUTTON.EVENTS)
(SETQ window (OR QP.PROLOG.WINDOW.HANDLE (CREATEW NIL
"Xerox Quintus Prolog")))
(CLRPROMPT)
(SETQ teditstream (TEXEC.OPENTEXTSTREAM window (QUOTE NULL)))
(WINDOWPROP window (QUOTE ICONFN)
(FUNCTION QP.ICONFN))
(SETQ handle (ADD.PROCESS (BQUOTE (PROGN (TTYDISPLAYSTREAM
(QUOTE , teditstream))
(QP.RUN.QUINTUS.PROLOG)))
(QUOTE NAME)
QP.PROLOG.NAME
(QUOTE RESTARTABLE)
QP.PROLOG.RESTARTABLE
(QUOTE TTYENTRYFN)
(QUOTE QP.TTYENTRYFN)
(QUOTE TTYEXITFN)
(QUOTE QP.TTYEXITFN)
(QUOTE RESTARTFORM)
(BQUOTE (PROGN (TTYDISPLAYSTREAM
(QUOTE , teditstream))
(QP.RUN.QUINTUS.PROLOG
T)))))
(*)
(SETQ QP.PROLOG.WINDOW.HANDLE window)
(SETQ QP.PROLOG.STREAM.HANDLE teditstream)
(CHANGEFONT QP.PROLOG.FONT teditstream)
(*)
(WINDOWADDPROP window (QUOTE CLOSEFN)
(FUNCTION (LAMBDA (window)
(PROG ((proc (WINDOWPROP window (QUOTE PROCESS))))
(RETURN (COND
((EQ (THIS.PROCESS)
proc)
(ADD.PROCESS (LIST
(QUOTE CLOSEW)
(KWOTE window)))
(QUOTE DON'T))
((PROCESSP proc)
(DEL.PROCESS proc)
(SETQ QP.PROLOG.STREAM.HANDLE NIL)
NIL)))))))
(TTY.PROCESS handle))
else (PROMPTPRINT " Only one Prolog process can be active at a time"))))
(QP.RESET.PROLOG
(LAMBDA NIL
(if (MOUSECONFIRM (CONCAT "Selecting this option completely reinitializes " "Prolog, "
(CHARACTER (CHARCODE EOL))
"deleting the entire database."
(CHARACTER (CHARCODE EOL))))
then (SETQ QP.SYSTEM.SOLIDIFIED 0)
(QP.PROLOG.TEXEC))))
(QP.SETUP.TRANSFER.FILE
(LAMBDA (STREAM)
(QP.CREATE.SCRATCH.FILE)
(if (IGREATERP (fetch (SELECTION DCH) of (TEDIT.GETSEL STREAM))
1)
then (COPYCHARS (TEDIT.SEL.AS.STRING STREAM (TEDIT.GETSEL STREAM))
QP.SCRATCH.FILE)
else (SETFILEPTR STREAM 0)
(COPYCHARS STREAM QP.SCRATCH.FILE))
(CLOSEF QP.SCRATCH.FILE)
(TEDIT.SETSEL STREAM (QP.GET.CURSOR STREAM)
1
(QUOTE RIGHT))))
(QP.TEDIT.COMPILE.CODE
(LAMBDA (STREAM)
(if (QP.NOT.SAFE.TO.LOAD.CODE)
then (TEDIT.PROMPTPRINT STREAM "cannot compile unless Prolog is at top-level prompt" T)
else (QP.ENSURE.VALID.SOURCE.FILE STREAM)
(QP.SETUP.TRANSFER.FILE STREAM)
(QP.EDITOR.LOAD.CODE "compile" STREAM))))
(QP.TEDIT.CONSULT.CODE
(LAMBDA (STREAM)
(if (QP.NOT.SAFE.TO.LOAD.CODE)
then (TEDIT.PROMPTPRINT STREAM "cannot consult unless Prolog is at top-level prompt" T)
else (QP.ENSURE.VALID.SOURCE.FILE STREAM)
(QP.SETUP.TRANSFER.FILE STREAM)
(QP.EDITOR.LOAD.CODE "consult" STREAM))))
(QUINTUS.TEDIT
(LAMBDA (TEXT WINDOW DONTSPAWN PROPS)
(PROG (PROC TEDITCREATEDWINDOW OLDTEXT)
(if (AND TEXT (ATOM TEXT)
(NOT (FULLNAME TEXT (QUOTE OLD))))
then (OPENFILE TEXT (QUOTE BOTH)
(QUOTE NEW))
(CLOSEF? TEXT))
(COND
((AND TEXT (ATOM TEXT))
(SETQ TEXT (OPENFILE TEXT (QUOTE INPUT)
(QUOTE OLD)))))
(SETQ PROPS (APPEND PROPS QP.TEDIT.PROPS))
(RESETLST (RESETSAVE NIL (BQUOTE (AND (\, WINDOW)
(WINDOWPROP (\, WINDOW)
(QUOTE TEXTOBJ)
NIL))))
(WITH.MONITOR TEDIT.STARTUP.MONITORLOCK
(COND
((NOT WINDOW)
(SETQ TEDITCREATEDWINDOW T)
(SETQ WINDOW (COND
((OR (NOT TEDIT.DEFAULT.WINDOW)
(\TEDIT.ACTIVE.WINDOWP TEDIT.DEFAULT.WINDOW))
(TEDIT.CREATEW (COND
((AND TEXT (ATOM TEXT))
(CONCAT
"Please specify an editing window for "
TEXT))
(T
"Please specify a region for the editing window."))
TEXT
(APPEND PROPS (COPY
TEDIT.DEFAULT.PROPS))))
(T (\TEDIT.CREATEW.FROM.REGION (WINDOWPROP
TEDIT.DEFAULT.WINDOW
(QUOTE REGION))
TEXT
(APPEND
PROPS
(COPY
TEDIT.DEFAULT.PROPS)))
TEDIT.DEFAULT.WINDOW)))
(WINDOWPROP WINDOW (QUOTE TEXTOBJ)
T)
(WINDOWPROP WINDOW (QUOTE CLOSEFN)
(CONS (QUOTE QP.CLOSE.CLEANUP)
(WINDOWPROP WINDOW (QUOTE CLOSEFN)
)))
(WINDOWPROP WINDOW (QUOTE TEDIT.MODE)
QP.TEDIT.MODE)
(SETQ OLDTEXT TEXT)))))
(SETQ TEXT (OPENTEXTSTREAM TEXT WINDOW NIL NIL PROPS))
(SETQ QP.CURRENT.TEXTSTREAM TEXT)
(COND
(TEDITCREATEDWINDOW (TEXTPROP TEXT (QUOTE TEDITCREATEDWINDOW)
(QUOTE T))))
(COND
((AND OLDTEXT (ATOM OLDTEXT)
(NOT (GETPROP OLDTEXT (QUOTE STREAM))))
(PUTPROP OLDTEXT (QUOTE STREAM)
TEXT)
(WINDOWPROP WINDOW (QUOTE FILENAME)
OLDTEXT))
((AND OLDTEXT (ATOM OLDTEXT)
(GETPROP OLDTEXT (QUOTE STREAM)))
(TEDIT.PROMPTPRINT QP.CURRENT.TEXTSTREAM
"WARNING - This is the second Tedit window on this file."
T)))
(COND
(DONTSPAWN (RETURN (\TEDIT2 TEXT WINDOW T)))
(T (SETQ PROC (ADD.PROCESS (LIST (QUOTE \TEDIT2)
(KWOTE TEXT)
WINDOW NIL)
(QUOTE NAME)
(QUOTE TEdit)
(QUOTE RESTARTABLE)
(QUOTE HARDRESET)
(QUOTE RESTARTFORM)
(LIST (QUOTE \TEDIT.RESTARTFN)
(KWOTE TEXT)
WINDOW
(KWOTE PROPS))))
(PROCESSPROP PROC (QUOTE WINDOW)
WINDOW)
(COND
((NOT (LISTGET (APPEND PROPS (COPY TEDIT.DEFAULT.PROPS))
(QUOTE LEAVETTY)))
(TTY.PROCESS PROC)))
(RETURN PROC))))))
)
(DECLARE: EVAL@COMPILE
(PUTPROPS QP.GET.CURRENT.FILENAME MACRO
(**MACROARG** (LET ((STM (CAR (NTH **MACROARG** 1))))
(BQUOTE (PROGN (WINDOWPROP (CAR (fetch (TEXTOBJ \WINDOW)
of
(TEXTOBJ (\, STM))))
(QUOTE FILENAME)))))))
)
(QP.PROLOG.SETUP)
(PUTPROPS SETUPMENU.LSP COPYRIGHT ("Quintus Computer Systems, Inc" 1986))
(DECLARE: DONTCOPY
(FILEMAP (NIL (3441 15615 (QP.ATTACH.STREAM.GET 3451 . 4137) (QP.ATTACH.STREAM.PUT 4139 . 4447) (
QP.CLOSE.CLEANUP 4449 . 4643) (QP.CREATE.SCRATCH.FILE 4645 . 4973) (QP.CREATE.TEDIT.MENU 4975 . 5728)
(QP.EDITOR.LOAD.CODE 5730 . 5903) (QP.ENSURE.VALID.SOURCE.FILE 5905 . 6295) (QP.MAKE.FAKE.FILENAME
6297 . 6618) (QP.MARK.PREDICATE 6620 . 7545) (QP.PROLOG.SETUP 7547 . 8781) (QP.PROLOG.TEXEC 8783 .
10810) (QP.RESET.PROLOG 10812 . 11154) (QP.SETUP.TRANSFER.FILE 11156 . 11654) (QP.TEDIT.COMPILE.CODE
11656 . 11991) (QP.TEDIT.CONSULT.CODE 11993 . 12328) (QUINTUS.TEDIT 12330 . 15613)))))
STOP