(FILECREATED " 8-Feb-86 15:25:34" {DSK}<LISPFILES2>IMPROVEDDCOMS>SETUPMENU.;1
 13508  

      previous date: " 3-Feb-86 00:01:18" {GOEDEL}<usr2/pds/updating/lisp>SETUPMENU)


(* Copyright (c) 1986 by Quintus Computer Systems, Inc. All rights reserved.)

(PRETTYCOMPRINT SETUPMENUCOMS)

(RPAQQ SETUPMENUCOMS
 ((SCCS) (* WARNING: This material is CONFIDENTIAL and proprietary to Quintus 
Computer Systems Inc.) (INITVARS QP.LOGO.WINDOW (QP.SCRATCH.FILE (QUOTE {CORE}QP.SCRATCH.FILE)) 
QP.SAVE.SELECTION QP.CURRENT.TEXTSTREAM QP.TEDIT.MENU (QP.PROLOG.FONT (FONTCREATE (QUOTE TERMINAL) 10 
(QUOTE STANDARD) 0 (QUOTE DISPLAY))) (QP.PROLOG.NAME (QUOTE Xerox% Quintus% Prolog)) 
QP.PROLOG.WINDOW.HANDLE QP.PROLOG.STREAM.HANDLE QP.PROLOG.MODE.TEDIT.MENU QP.PROLOG.TEXEC.MENU) (* 
Declare globals) (GLOBALVARS BackgroundMenu BackgroundMenuCommands QP.TEDIT.MENU TEDIT.DEFAULT.MENU 
TEDIT.DEFAULT.PROPS QP.TEDIT.PROPS QP.PROLOG.MODE.TEDIT.MENU QP.PROLOG.TEXEC.MENU QP.PROLOG.NAME 
QP.PROLOG.WINDOW.HANDLE QP.PROLOG.STREAM.HANDLE QP.PROLOG.FONT QP.SAVE.SELECTION QP.SCRATCH.FILE) (
FILES LOGO2 ICONW TEXEC TEDIT TEDITMODE) (FNS QP.TEXTSTREAM QP.TEXTOBJ QP.ACTIVE.TEXTOBJS 
QP.PROLOG.SETUP QP.RESET.PROLOG QP.TEDIT.FILENAME QP.TEDIT.WINDOW) (* Note that the logo bitmap will 
be loaded from the Prolog sysout, and will be in the global variable QP.LOGO.BITMAP This bitmap is 
currently stored in the file LOGO2 The function QP.SET.UP.LOGO has been moved to the file LOGO2 as 
well) (FNS QP.PROLOG.TEXEC QP.MARK.PREDICATE QP.CREATE.TEDIT.MENU) (* Here is some additional code 
that will be needed for Compile and Consult) (FNS QP.TEDIT.COMPILE.CODE QP.TEDIT.CONSULT.CODE 
QP.SETUP.TRANSFER.FILE QP.CREATE.SCRATCH.FILE QP.EDITOR.LOAD.CODE) (* Attach the stream as a property 
to the filename as well as make sure the window has the proper filename as a property) (FNS 
QP.ATTACH.STREAM.GET) (* Now call the initialization) (VARS QP.TEDIT.PROPS) (P (QP.LOGO.WINDOW) (
QP.PROLOG.SETUP)) (P (* * Don't want to use filepkg ADVISE com, since the TEDITMODE package advises 
TEDIT, also. The two sets of advice need to be separated.) (ADVISE (QUOTE TEDIT) (QUOTE AROUND) NIL (
QUOTE (LET ((OTHERTEDIT (AND TEXT (QP.TEXTOBJ TEXT))) (PROC *)) (if OTHERTEDIT then (TEDIT.PROMPTPRINT
 (TEXTSTREAM PROC) "WARNING - This is the second TEdit on this file." T)) PROC))))))
(* %%G%  %%W% )



(* WARNING: This material is CONFIDENTIAL and proprietary to Quintus Computer Systems Inc.)



(RPAQ? QP.LOGO.WINDOW
 NIL)

(RPAQ? QP.SCRATCH.FILE
 (QUOTE {CORE}QP.SCRATCH.FILE))

(RPAQ? QP.SAVE.SELECTION
 NIL)

(RPAQ? QP.CURRENT.TEXTSTREAM
 NIL)

(RPAQ? QP.TEDIT.MENU
 NIL)

(RPAQ? QP.PROLOG.FONT
 (FONTCREATE (QUOTE TERMINAL) 10 (QUOTE STANDARD) 0 (QUOTE DISPLAY)))

(RPAQ? QP.PROLOG.NAME
 (QUOTE Xerox% Quintus% Prolog))

(RPAQ? QP.PROLOG.WINDOW.HANDLE
 NIL)

(RPAQ? QP.PROLOG.STREAM.HANDLE
 NIL)

(RPAQ? QP.PROLOG.MODE.TEDIT.MENU
 NIL)

(RPAQ? QP.PROLOG.TEXEC.MENU
 NIL)



(* Declare globals)


(DECLARE: DOEVAL@COMPILE DONTCOPY

(GLOBALVARS BackgroundMenu BackgroundMenuCommands QP.TEDIT.MENU TEDIT.DEFAULT.MENU TEDIT.DEFAULT.PROPS
 QP.TEDIT.PROPS QP.PROLOG.MODE.TEDIT.MENU QP.PROLOG.TEXEC.MENU QP.PROLOG.NAME QP.PROLOG.WINDOW.HANDLE 
QP.PROLOG.STREAM.HANDLE QP.PROLOG.FONT QP.SAVE.SELECTION QP.SCRATCH.FILE)
)
(FILESLOAD LOGO2 ICONW TEXEC TEDIT TEDITMODE)
(DEFINEQ

(QP.TEXTSTREAM

(LAMBDA (FILENAME.OR.TEXTOBJ) (* pds: "20-Jan-86 11:47") (* * Just like TEXTSTREAM, except can also 
take a filename as arg. Returns a textstream, or NIL.) (if (OR (STRINGP FILENAME.OR.TEXTOBJ) (LITATOM 
FILENAME.OR.TEXTOBJ)) then (* assume it's a filename.) (LET ((TXTOBJ (QP.TEXTOBJ FILENAME.OR.TEXTOBJ))
) (if TXTOBJ then (TEXTSTREAM TXTOBJ))) else (TEXTSTREAM FILENAME.OR.TEXTOBJ))))

(QP.TEXTOBJ

(LAMBDA (FILENAME.OR.STREAM) (* pds: "20-Jan-86 11:50") (* * Just like TEXTOBJ except can also take a 
filename as arg. Returns a TEXTOBJ, or NIL.) (bind (FILENAME ← (FULLNAME FILENAME.OR.STREAM (QUOTE OLD
))) for TXTOBJ in (QP.ACTIVE.TEXTOBJS) thereis (EQUAL (QP.TEDIT.FILENAME TXTOBJ) FILENAME))))

(QP.ACTIVE.TEXTOBJS

(LAMBDA NIL (* pds: "11-Jan-86 17:19") (bind TXTOBJ for W in (ACTIVEWINDOWS) when (SETQ TXTOBJ (
WINDOWPROP (OR (WINDOWPROP W (QUOTE ICONFOR)) W) (QUOTE TEXTOBJ))) collect TXTOBJ)))

(QP.PROLOG.SETUP

(LAMBDA NIL (* pds: " 2-Feb-86 23:07") (if (NOT (SASSOC "Xerox Quintus Prolog" BackgroundMenuCommands)
) then (push BackgroundMenuCommands (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"))))) (SETQ BackgroundMenu NIL)) (if (NOT
 QP.PROLOG.MODE.TEDIT.MENU) then (SETQ QP.PROLOG.MODE.TEDIT.MENU (TEDITMODE.COPY.MENU 
TEDIT.DEFAULT.MENU)) (TEDIT.ADD.MENUITEM QP.PROLOG.MODE.TEDIT.MENU (QUOTE ("Library" (FUNCTION 
QP.LIBRARY)))) (TEDIT.ADD.MENUITEM QP.PROLOG.MODE.TEDIT.MENU (QUOTE ("Find Definition" (FUNCTION 
QP.FIND.DEFINITION)))) (TEDIT.ADD.MENUITEM QP.PROLOG.MODE.TEDIT.MENU (QUOTE ("Compile" (FUNCTION 
QP.TEDIT.COMPILE.CODE)))) (TEDIT.ADD.MENUITEM QP.PROLOG.MODE.TEDIT.MENU (QUOTE ("Consult" (FUNCTION 
QP.TEDIT.CONSULT.CODE))))) (TEDITMODE.NEWMODE (create TEDITMODEREC MODE ← (QUOTE Prolog) IN-MENU? ← T 
EXTENSION-LIST ← (QUOTE (pl PL)) TEXTPROPS ← (LIST (QUOTE SELFN) (FUNCTION QP.MARK.PREDICATE) (QUOTE 
GETFN) (FUNCTION QP.ATTACH.STREAM.GET)) WINDOWPROPS ← (LIST (QUOTE TEDIT.MENU) 
QP.PROLOG.MODE.TEDIT.MENU) INITTEXTPROPS ← (LIST (QUOTE FONT) (QUOTE (TERMINAL 10 STANDARD))))) (* * 
This still has some bugs: (if (NOT QP.PROLOG.TEXEC.MENU) then (SETQ QP.PROLOG.TEXEC.MENU (
\TEDIT.CREATEMENU (LIST (QUOTE ("Library" (FUNCTION QP.LIBRARY))) (QUOTE ("Find Definition" (FUNCTION 
QP.FIND.DEFINITION))))))) (TEDITMODE.NEWMODE (create TEDITMODEREC MODE ← (QUOTE PrologTExec) IN-MENU? 
← NIL EXTENSION-LIST ← NIL TEXTPROPS ← (LIST (QUOTE SELFN) (FUNCTION QP.MARK.PREDICATE)) WINDOWPROPS ←
 (LIST (QUOTE TEDIT.MENU) QP.PROLOG.TEXEC.MENU (QUOTE TEDIT.TITLEMENUFN) (FUNCTION 
TEDIT.DEFAULT.MENUFN) (QUOTE ICONFN) (FUNCTION QP.ICONFN))))) (TEDITMODE.DEFAULTMODE (QUOTE Prolog))))

(QP.RESET.PROLOG

(LAMBDA NIL (* pds: "29-Jan-86 21:27") (if (MOUSECONFIRM 
"Selecting this option completely reinitializes Prolog, deleting the entire database.") then (LET ((
PROC (FIND.PROCESS QP.PROLOG.NAME))) (if PROC then (DEL.PROCESS PROC) (while (FIND.PROCESS 
QP.PROLOG.NAME) do (BLOCK 100)))) (SETQ QP.SYSTEM.SOLIDIFIED 0) (QP.PROLOG.TEXEC))))

(QP.TEDIT.FILENAME

(LAMBDA (WINDOW.OR.TEXTOBJ) (* pds: "14-Jan-86 13:36") (LET ((FNAME (\TEXTSTREAM.FILENAME (TEXTOBJ 
WINDOW.OR.TEXTOBJ)))) (if FNAME then (FULLNAME FNAME (QUOTE OLD)) else (TEXTOBJ WINDOW.OR.TEXTOBJ)))))

(QP.TEDIT.WINDOW

(LAMBDA (FILENAME.OR.TEXTOBJ.OR.STREAM) (* pds: "20-Jan-86 11:48") (* * Given a filename, TEXTOBJ, 
text stream, running TEdit process, or TEdit editing window, returns the TEdit editing window.) (LET (
(TXTOBJ (if (OR (STRINGP FILENAME.OR.TEXTOBJ.OR.STREAM) (LITATOM FILENAME.OR.TEXTOBJ.OR.STREAM)) then 
(* assume it's a filename.) (QP.TEXTOBJ FILENAME.OR.TEXTOBJ.OR.STREAM) else (TEXTOBJ 
FILENAME.OR.TEXTOBJ.OR.STREAM)))) (if TXTOBJ then (CAR (fetch (TEXTOBJ \WINDOW) of TXTOBJ))))))
)



(* Note that the logo bitmap will be loaded from the Prolog sysout, and will be in the global 
variable QP.LOGO.BITMAP This bitmap is currently stored in the file LOGO2 The function 
QP.SET.UP.LOGO has been moved to the file LOGO2 as well)


(DEFINEQ

(QP.PROLOG.TEXEC

(LAMBDA (REGION) (* pds: " 2-Feb-86 22:48") (if (NOT (FIND.PROCESS QP.PROLOG.NAME)) then (PROG (handle
 window teditstream) (ALLOW.BUTTON.EVENTS) (SETQ window (OR QP.PROLOG.WINDOW.HANDLE (CREATEW REGION 
"Xerox Quintus Prolog"))) (CLRPROMPT) (SETQ teditstream (TEXEC.OPENTEXTSTREAM window)) (TEDITMODE.MODE
 teditstream (QUOTE PrologTExec)) (SETQ handle (ADD.PROCESS (BQUOTE (PROGN (TTYDISPLAYSTREAM (QUOTE , 
teditstream)) (QP.RUN.QUINTUS.PROLOG))) (QUOTE NAME) QP.PROLOG.NAME (QUOTE RESTARTABLE) T (QUOTE 
TTYENTRYFN) (QUOTE QP.TTYENTRYFN) (QUOTE TTYEXITFN) (QUOTE QP.TTYEXITFN) (QUOTE RESTARTFORM) (BQUOTE (
PROGN (TTYDISPLAYSTREAM (QUOTE , teditstream)) (QP.RUN.QUINTUS.PROLOG T))))) (* * save this 
information in global variables as well. This should be cleaned up to store this info on the Prolog 
process as properties.) (WINDOWPROP (SETQ QP.PROLOG.WINDOW.HANDLE window) (QUOTE ICONFN) (FUNCTION 
QP.ICONFN)) (CHANGEFONT QP.PROLOG.FONT (SETQ QP.PROLOG.STREAM.HANDLE teditstream)) (* * Create the 
listener process) (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.MARK.PREDICATE

(LAMBDA (TEXT SELECTION TYPE ACTION) (* pds: "30-Jan-86 21:03") (SELECTQ ACTION (TENTATIVE (if (AND (
EQ TYPE (QUOTE NORMAL)) (EQ (QUOTE PARA) (fetch (SELECTION SELKIND) of SELECTION))) then (SETQ 
QP.SAVE.SELECTION SELECTION))) (FINAL (if (AND (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.CREATE.TEDIT.MENU

(LAMBDA NIL (* pds: "31-Jan-86 12:42") (if (NOT QP.TEDIT.MENU) then (SETQ QP.PROLOG.MODE.TEDIT.MENU (
TEDITMODE.COPY.MENU TEDIT.DEFAULT.MENU)) (TEDIT.ADD.MENUITEM QP.PROLOG.MODE.TEDIT.MENU (QUOTE (
"Library" (QUOTE (LAMBDA (X) (QP.LIBRARY X)))))) (TEDIT.ADD.MENUITEM QP.PROLOG.MODE.TEDIT.MENU (QUOTE 
("Find Definition" (QUOTE (LAMBDA (X) (QP.FIND.DEFINITION X)))))) (TEDIT.ADD.MENUITEM 
QP.PROLOG.MODE.TEDIT.MENU (QUOTE ("Compile" (QUOTE (LAMBDA (X) (QP.TEDIT.COMPILE.CODE X)))))) (
TEDIT.ADD.MENUITEM QP.PROLOG.MODE.TEDIT.MENU (QUOTE ("Consult" (QUOTE (LAMBDA (X) (
QP.TEDIT.CONSULT.CODE X)))))) (SETQ QP.PROLOG.TEXEC.MENU (create MENU)) (TEDIT.ADD.MENUITEM 
QP.PROLOG.TEXEC.MENU (QUOTE ("Library" (QUOTE (LAMBDA (X) (QP.LIBRARY X)))))) (TEDIT.ADD.MENUITEM 
QP.PROLOG.TEXEC.MENU (QUOTE ("Find Definition" (QUOTE (LAMBDA (X) (QP.FIND.DEFINITION X)))))) (NCONC 
TEDITMODE.MODELIST (LIST (create TEDITMODEREC MODE ← (QUOTE Prolog) IN-MENU? ← T EXTENSION-LIST ← (
QUOTE (pl PL)) TEXTPROPS ← QP.TEDIT.PROPS WINDOWPROPS ← (LIST (QUOTE TEDIT.MENU) 
QP.PROLOG.MODE.TEDIT.MENU)) (create TEDITMODEREC MODE ← (QUOTE PrologTExec) IN-MENU? ← NIL 
EXTENSION-LIST ← NIL TEXTPROPS ← QP.TEDIT.PROPS WINDOWPROPS ← (LIST (QUOTE TEDIT.MENU) 
QP.PROLOG.TEXEC.MENU (QUOTE TEDIT.TITLEMENUFN) (FUNCTION TEDIT.DEFAULT.MENUFN))))) (SETQ 
TEDITMODE.MENU NIL) (* * QP.TEDIT.MENU is a global variable) (SETQ QP.TEDIT.MENU T))))
)



(* Here is some additional code that will be needed for Compile and Consult)


(DEFINEQ

(QP.TEDIT.COMPILE.CODE

(LAMBDA (STREAM) (* pds: "14-Jan-86 18:42") (if (QP.NOT.SAFE.TO.LOAD.CODE) then (TEDIT.PROMPTPRINT 
STREAM "cannot compile unless Prolog is at top-level prompt" T) else (QP.SETUP.TRANSFER.FILE STREAM) (
QP.EDITOR.LOAD.CODE "compile" STREAM))))

(QP.TEDIT.CONSULT.CODE

(LAMBDA (STREAM) (* pds: "14-Jan-86 18:42") (if (QP.NOT.SAFE.TO.LOAD.CODE) then (TEDIT.PROMPTPRINT 
STREAM "cannot consult unless Prolog is at top-level prompt" T) else (QP.SETUP.TRANSFER.FILE STREAM) (
QP.EDITOR.LOAD.CODE "consult" STREAM))))

(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.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.EDITOR.LOAD.CODE

(LAMBDA (OPERATION STREAM) (* pds: " 1-Feb-86 17:54") (QP.SEND.PROLOG (CONCAT "'$editor←load←code'(" 
OPERATION "," (LET ((FNAME (QP.TEDIT.FILENAME STREAM))) (if (OR (LITATOM FNAME) (STRINGP FNAME)) then 
(CONCAT "'" FNAME "'") else (CONCAT "lisp←datatype(" (\HILOC FNAME) ", " (\LOLOC FNAME) ")"))) ")"))))
)



(* Attach the stream as a property to the filename as well as make sure the window has the 
proper filename as a property)


(DEFINEQ

(QP.ATTACH.STREAM.GET

(LAMBDA (STREAM FILENAME WHEN) (* pds: "30-Jan-86 21:21") (if (AND (EQ WHEN (QUOTE AFTER)) FILENAME (
LET ((OLDSTREAM (QP.TEXTSTREAM FILENAME))) (AND OLDSTREAM (NEQ OLDSTREAM STREAM)))) then (
TEDIT.PROMPTPRINT STREAM "WARNING - This is the second Tedit window on this file." T))))
)



(* Now call the initialization)



(RPAQQ QP.TEDIT.PROPS
 (SELFN QP.MARK.PREDICATE))
(QP.LOGO.WINDOW)
(QP.PROLOG.SETUP)
(* * Don't want to use filepkg ADVISE com, since the TEDITMODE package advises TEDIT, also. The two 
sets of advice need to be separated.)
(ADVISE (QUOTE TEDIT) (QUOTE AROUND) NIL (QUOTE (LET ((OTHERTEDIT (AND TEXT (QP.TEXTOBJ TEXT))) (PROC 
*)) (if OTHERTEDIT then (TEDIT.PROMPTPRINT (TEXTSTREAM PROC) 
"WARNING - This is the second TEdit on this file." T)) PROC)))
(PUTPROPS SETUPMENU COPYRIGHT ("Quintus Computer Systems, Inc" 1986))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (3373 7289 (QP.TEXTSTREAM 3383 . 3789) (QP.TEXTOBJ 3791 . 4106) (QP.ACTIVE.TEXTOBJS 4108
 . 4313) (QP.PROLOG.SETUP 4315 . 6192) (QP.RESET.PROLOG 6194 . 6550) (QP.TEDIT.FILENAME 6552 . 6777) (
QP.TEDIT.WINDOW 6779 . 7287)) (7538 10869 (QP.PROLOG.TEXEC 7548 . 8994) (QP.MARK.PREDICATE 8996 . 9439
) (QP.CREATE.TEDIT.MENU 9441 . 10867)) (10955 12469 (QP.TEDIT.COMPILE.CODE 10965 . 11235) (
QP.TEDIT.CONSULT.CODE 11237 . 11507) (QP.SETUP.TRANSFER.FILE 11509 . 11883) (QP.CREATE.SCRATCH.FILE 
11885 . 12133) (QP.EDITOR.LOAD.CODE 12135 . 12467)) (12601 12920 (QP.ATTACH.STREAM.GET 12611 . 12918))
)))
STOP