(FILECREATED "13-Feb-86 16:38:19" {DSK}<LISPFILES2>IMPROVEDDCOMS>SETUPMENU.;2 14108
changes to: (FNS QP.EDITOR.LOAD.CODE)
previous date: " 8-Feb-86 15:25:34" {DSK}<LISPFILES2>IMPROVEDDCOMS>SETUPMENU.;1)
(* 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: "13-Feb-86 16:37")
(QP.SEND.PROLOG (CONCAT "'$editor←load←code'(" OPERATION ","
(LET ((FNAME (QP.TEDIT.FILENAME STREAM)))
(if (OR (LITATOM FNAME)
(STRINGP FNAME))
then (CONCAT "'" (PACKFILENAME (QUOTE VERSION)
NIL
(QUOTE BODY)
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 (3650 7566 (QP.TEXTSTREAM 3660 . 4066) (QP.TEXTOBJ 4068 . 4383) (QP.ACTIVE.TEXTOBJS 4385
. 4590) (QP.PROLOG.SETUP 4592 . 6469) (QP.RESET.PROLOG 6471 . 6827) (QP.TEDIT.FILENAME 6829 . 7054) (
QP.TEDIT.WINDOW 7056 . 7564)) (7815 11146 (QP.PROLOG.TEXEC 7825 . 9271) (QP.MARK.PREDICATE 9273 . 9716
) (QP.CREATE.TEDIT.MENU 9718 . 11144)) (11232 13013 (QP.TEDIT.COMPILE.CODE 11242 . 11512) (
QP.TEDIT.CONSULT.CODE 11514 . 11784) (QP.SETUP.TRANSFER.FILE 11786 . 12160) (QP.CREATE.SCRATCH.FILE
12162 . 12410) (QP.EDITOR.LOAD.CODE 12412 . 13011)) (13145 13464 (QP.ATTACH.STREAM.GET 13155 . 13462))
)))
STOP