(FILECREATED "15-Dec-85 18:14:43" {FLOPPY}DEDITAUG.;1 11628
changes to: (VARS DEDITAUGCOMS)
(FNS DEDITINIT DEDITYankTo FORCE#ESCQUOTE)
(ALISTS (DEDITTYPEINCOMS Y))
previous date: "15-Dec-85 17:44:56" {DSK}<USERFILES>LISPUSERS>DEDITAUG.;55)
(PRETTYCOMPRINT DEDITAUGCOMS)
(RPAQQ DEDITAUGCOMS ((* Various augmentations to DEdit: - modifications so DEdit can remember more
than just the first two windows and to allow precreation of DEdit windows to
specified regions. - a MoveTo command to DEdit menu to handle some common
command sequences. - editmacros for invoking TEdit on the current expression.)
(FNS DEDITINIT DODEDITINIT DEDITYankTo TEDITE TEDITE/PP)
(* * Usermacros)
(USERMACROS PPTED TED)
(ALISTS (DEDITTYPEINCOMS Y))
[VARS (DEDITYANKCOMS (QUOTE ((MoveTo (DEDITYankTo (QUOTE MoveTo))
NIL "( )")
(MoveTo (DEDITYankTo (QUOTE MoveTo))
MoveTo)
(CopyTo (DEDITYankTo (QUOTE CopyTo))
MoveTo)
(SwitchWith (DEDITYankTo (QUOTE SwitchWith))
MoveTo)
(WrapIn (DEDITYankTo (QUOTE WrapIn))
MoveTo]
(INITVARS (TEDITEWINDOW)
(DONTUNCACHEFLG)
(DEDITREGIONS)
(DEDITADDMACROS)
(DEDITADDCOMS))
(APPENDVARS (AFTERSYSOUTFORMS (DODEDITINIT)))
(ADVISE (PUTWINDOWPROP IN UNDEDITW))
(P (DODEDITINIT)
(* Necessary so that the addition to DEDITTYPEINCOMS will be seen.))))
(* Various augmentations to DEdit: - modifications so DEdit can remember more than just the
first two windows and to allow precreation of DEdit windows to specified regions. - a MoveTo
command to DEdit menu to handle some common command sequences. - editmacros for invoking TEdit
on the current expression.)
(DEFINEQ
(DEDITINIT
[LAMBDA (REGIONS ADDMACROS ADDCOMS) (* M.Model "15-Dec-85 11:45")
(* Initialize DEdit with windows corresponding to the regions specified by the list REGIONS, and set DONTUNCACHEFLG
to the length of the list. -
ADDCOMS is a list of additional commands for the DEdit menu, in a form ready for DEFDEDITCOM, i.e.
(name expression super before) -
ADDMACROS is a list of usermacros to add at the end of the EditCom submenu.)
(DECLARE (GLOBALVARS DEditWindow DONTUNCACHEFLG DEDITYANKCOMS))
(LET ((WINLST))
(RESETDEDIT)
[MAPC (APPEND DEDITYANKCOMS (for MACRO in ADDMACROS collect (LIST MACRO (LIST (QUOTE
DEDITEditCom)
(KWOTE MACRO))
(QUOTE EditCom)))
ADDCOMS)
(FUNCTION (LAMBDA (ARGS)
(APPLY (QUOTE DEFDEDITCOM)
ARGS]
(COND
(REGIONS [OR (EQ T DONTUNCACHEFLG)
(SETQ DONTUNCACHEFLG (MAX (OR DONTUNCACHEFLG 0)
(LENGTH REGIONS]
[COND
(DEditWindow (SHAPEW DEditWindow (CAR REGIONS)))
(T (SETQ DEditWindow (CREATEW (CAR REGIONS)
"DEdit"]
[SETQ WINLST (CONS DEditWindow (for REG in (CDR REGIONS) collect (CREATEW REG
"DEdit"]
(for TAIL on WINLST do (WINDOWPROP (CAR TAIL)
(QUOTE DEDITCACHED)
(CADR TAIL)))
(for WIN in WINLST do (CLOSEW WIN])
(DODEDITINIT
[LAMBDA NIL (* M.Model " 7-Dec-85 22:28")
(DEDITINIT DEDITREGIONS DEDITADDMACROS DEDITADDCOMS])
(DEDITYankTo
[LAMBDA (CMD SPEC) (* M.Model "28-Nov-85 13:19")
(* Commands to do things to TOP THRU NEXT, often
relative to a previously selected DESTINATION.)
(DECLARE (USEDFREE DEFAULTCURSOR))
(SELECTQ (U-CASE (NTHCHAR [OR CMD (RESETFORM (CURSOR DEFAULTCURSOR)
(MENU (CONSTANT (create MENU
ITEMS ←(QUOTE (MoveTo CopyTo
SwitchWith
WrapIn))
MENUOFFSET ←(QUOTE
(-1 . 32]
1))
(N (* Selection outside menu (NIL))
(PROMPTPRINT "Aborted"))
(M (* Movement commands)
(SELECTQ (U-CASE (NTHCHAR [OR SPEC
(RESETFORM (CURSOR DEFAULTCURSOR)
(MENU (CONSTANT (create MENU
ITEMS ←(QUOTE
(After Before
There))
MENUOFFSET ←(QUOTE
(-1 . 32]
1))
(N (* Selection outside menu (NIL))
(PROMPTPRINT "Aborted"))
(A (DEDITBI)
(DEDITDelete)
(DEDITAfter)
(DEDITBO))
(B (DEDITBI)
(DEDITDelete)
(DEDITBefore)
(DEDITBO))
((T H)
(DEDITBI)
(DEDITDelete)
(DEDITReplace)
(DEDITBO))
(PROMPTPRINT
"Illegal second argument to DEDITYankTo:
legal arguments are A(fter), B(efore), and Th/H(ere).")))
(C (* Copying commands.)
(SELECTQ (U-CASE (NTHCHAR [OR SPEC
(RESETFORM (CURSOR DEFAULTCURSOR)
(MENU (CONSTANT (create MENU
ITEMS ←(QUOTE
(After Before
There))
MENUOFFSET ←(QUOTE
(-1 . 32]
1))
(N (* Selection outside menu (NIL))
(PROMPTPRINT "Aborted"))
(A (DEDITBI)
(DEDITCopy)
(DEDITSwap)
(DEDITBO)
(DEDITAfter)
(DEDITBO))
(B (DEDITBI)
(DEDITCopy)
(DEDITSwap)
(DEDITBO)
(DEDITBefore)
(DEDITBO))
((T H)
(DEDITBI)
(DEDITCopy)
(DEDITSwap)
(DEDITBO)
(DEDITReplace)
(DEDITBO))
(PROMPTPRINT
"Illegal second argument to DEDITYankTo:
legal arguments are A(fter), B(efore), and Th/H(ere).")))
(S (* Switch with here.)
(DEDITBI)
(DEDITSwap)
(DEDITSwitch)
(DEDITBO))
[W (* MBD expressions in another.)
(SELECTQ [SETQ SPEC
(OR SPEC
(RESETFORM (CURSOR DEFAULTCURSOR)
(MENU (CONSTANT (create MENU
ITEMS ←(QUOTE (LET LET* PROGN PROG1
PROG RESETFORM
COND SELECTQ AND
OR LIST *))
MENUOFFSET ←(QUOTE (-1 . 136]
(NIL (* Selection outside menu)
(PROMPTPRINT "Aborted"))
[(PROG LET
LET*)
(DEDITBI)
[PUSHSELECTION (LIST (LIST SPEC NIL (QUOTE &]
(DEDITReplace)
(DEDITEditCom (QUOTE ((BO -1]
(COND (DEDITBI)
[PUSHSELECTION (LIST (LIST SPEC (QUOTE &]
(DEDITReplace))
(PROGN (DEDITBI)
[PUSHSELECTION (LIST (LIST SPEC (QUOTE &]
(DEDITReplace)
(DEDITEditCom (QUOTE ((BO -1]
(PROMPTPRINT CMD
" is not a valid YankTo command;
valid commands are M(ove), C(opy), S(witch), and W(rap)."])
(TEDITE
[LAMBDA (EXPR PPFLG) (* M.Model " 1-Nov-85 16:45")
(* TEDIT the currently selected editor expression. -
If PPFLG, then prettyprint expression to a file and edit that; this is much slower, and requires a PUT before QUIT
(but allows abort by QUITTING without PUTTING). -
Return a list of the resulting expressions.)
(DECLARE (USEDFREE TEDITEWINDOW))
(OR (WINDOWP TEDITEWINDOW)
(SETQ TEDITEWINDOW (CREATEW NIL "TEDIT of current expression" NIL T)))
(RESETFORM (CURSOR DEFAULTCURSOR)
(COND
(PPFLG (TEDITE/PP EXPR))
(T (bind X (STRM ←(OPENSTRINGSTREAM (TEDIT (MKSTRING EXPR T)
TEDITEWINDOW T)
(QUOTE INPUT)))
eachtime (SETQ X (NLSETQ (READ STRM))) collect (CAR X) while X
finally (AND (OPENP STRM)
(CLOSEF STRM])
(TEDITE/PP
[LAMBDA (EXPR) (* M.Model " 1-Nov-85 16:44")
(* Prettyprint EXPR to a file, TEDIT the file, and read
back in its contents.)
(LET [(TEMPFILE (OPENFILE (QUOTE {CORE}TEDITE.SCRATCH)
(QUOTE OUTPUT]
(RESETVAR PRETTYTABFLG NIL (PROGN (LINELENGTH (IQUOTIENT (WINDOWPROP TEDITEWINDOW (QUOTE WIDTH))
(CHARWIDTH 77 TEDITEWINDOW))
TEMPFILE)
(PRINTDEF EXPR NIL NIL NIL NIL TEMPFILE)))
(TERPRI TEMPFILE)
(CLOSEF TEMPFILE)
(TEDIT TEMPFILE TEDITEWINDOW T)
(COND
((IGREATERP (FILENAMEFIELD (INFILEP (PACKFILENAME (QUOTE VERSION)
NIL
(QUOTE BODY)
TEMPFILE))
(QUOTE VERSION))
(FILENAMEFIELD TEMPFILE (QUOTE VERSION)))
(* If quit without putting, returns some kind of
record.)
(DELFILE TEMPFILE) (* Close the old version and open the edited one.)
(SETQ TEMPFILE (OPENFILE (QUOTE {CORE}TEDITE.SCRATCH)
(QUOTE INPUT))) (* Collect all the expressions.
Don%'t worry about extra parentheses: they will be
removed by the TED editmacro.)
(bind X first (SETFILEPTR TEMPFILE 0) eachtime (SETQ X (NLSETQ (READ TEMPFILE)))
collect (CAR X) while X
finally (AND (OPENP TEMPFILE)
(CLOSEF TEMPFILE))
(DELFILE TEMPFILE)))
(T (DELFILE TEMPFILE)
(LIST EXPR])
)
(* * Usermacros)
(ADDTOVAR USERMACROS (PPTED NIL UP (I 1 (TEDITE (## 1)
T))
(BO 1)
1)
(TED NIL UP (I 1 (TEDITE (## 1)))
(BO 1)
1))
(ADDTOVAR EDITCOMSA TED)
(ADDTOVAR DEDITTYPEINCOMS (Y YankTo [NLAMBDA (CMD SPEC)
(DEDITYankTo CMD SPEC]))
(RPAQQ DEDITYANKCOMS ((MoveTo (DEDITYankTo (QUOTE MoveTo))
NIL "( )")
(MoveTo (DEDITYankTo (QUOTE MoveTo))
MoveTo)
(CopyTo (DEDITYankTo (QUOTE CopyTo))
MoveTo)
(SwitchWith (DEDITYankTo (QUOTE SwitchWith))
MoveTo)
(WrapIn (DEDITYankTo (QUOTE WrapIn))
MoveTo)))
(RPAQ? TEDITEWINDOW )
(RPAQ? DONTUNCACHEFLG )
(RPAQ? DEDITREGIONS )
(RPAQ? DEDITADDMACROS )
(RPAQ? DEDITADDCOMS )
(APPENDTOVAR AFTERSYSOUTFORMS (DODEDITINIT))
(PUTPROPS PUTWINDOWPROP-IN-UNDEDITW READVICE ((UNDEDITW . PUTWINDOWPROP)
(AROUND NIL (AND (OR (NEQ PROP (QUOTE DEDITCACHED))
VALUE
(NULL DONTUNCACHEFLG)
(AND (FIXP DONTUNCACHEFLG)
(IGEQ (FLENGTH WDS)
DONTUNCACHEFLG)))
*))))
(READVISE PUTWINDOWPROP-IN-UNDEDITW)
(DODEDITINIT)
(* Necessary so that the addition to DEDITTYPEINCOMS will be seen.)
(DECLARE: DONTCOPY
(FILEMAP (NIL (1809 10343 (DEDITINIT 1819 . 3396) (DODEDITINIT 3398 . 3571) (DEDITYankTo 3573 . 7582)
(TEDITE 7584 . 8565) (TEDITE/PP 8567 . 10341)))))
STOP