(FILECREATED "17-Mar-86 12:54:44" {DSK}<LISPFILES2>DCOMS>TEDITMODE.;2 12900
changes to: (VARS TEDITMODECOMS)
(ADVICE \TEDIT.WINDOW.SETUP)
previous date: " 8-Feb-86 16:07:04" {DSK}<LISPFILES2>DCOMS>TEDITMODE.;1)
(* Copyright (c) 1986 by Quintus Computer Systems, Inc. All rights reserved.)
(PRETTYCOMPRINT TEDITMODECOMS)
(RPAQQ TEDITMODECOMS ((SCCS)
(RECORDS TEDITMODEREC)
(INITVARS (TEDITMODE.DEFAULTMODE.VAR (QUOTE Text))
(TEDITMODE.MODELIST (LIST (create TEDITMODEREC MODE ← (QUOTE Text)
IN-MENU? ← T EXTENSION-LIST ←
(QUOTE (tedit TEDIT))
TEXTPROPS ← NIL WINDOWPROPS ← NIL
INITTEXTPROPS ← NIL)))
TEDITMODE.MENU)
(GLOBALVARS TEDITMODE.DEFAULTMODE.VAR TEDITMODE.MENU TEDITMODE.MODELIST)
(FNS TEDITMODE.CHANGEDEFAULTMODE TEDITMODE.CHANGEMODE TEDITMODE.COPY.MENU
TEDITMODE.DEFAULTMODE TEDITMODE.FIX.TEDIT.PROPS TEDITMODE.MODE
TEDITMODE.NEWMODE TEDITMODE.SET.MODE.AFTER.GET.OR.PUT
TEDITMODE.SET.MODE.INITIALLY)
(P (if (NOT (ASSOC "Mode" (fetch (MENU ITEMS)
of TEDIT.DEFAULT.MENU)))
then
(TEDIT.ADD.MENUITEM TEDIT.DEFAULT.MENU
(QUOTE ("Mode" (FUNCTION TEDITMODE.CHANGEMODE))))))
(ADVISE TEDIT.GET TEDIT.PUT \TEDIT.WINDOW.SETUP)
(P (* * Don't want to use filepkg ADVISE com, since Prolog system code
advises TEDIT, also. The two sets of advice need to be separated.)
(ADVISE (QUOTE TEDIT)
(QUOTE BEFORE)
NIL
(QUOTE (SETQ PROPS (TEDITMODE.FIX.TEDIT.PROPS TEXT PROPS)))))))
(* %%G% %%W% )
[DECLARE: EVAL@COMPILE
(RECORD TEDITMODEREC (MODE IN-MENU? EXTENSION-LIST TEXTPROPS WINDOWPROPS INITTEXTPROPS))
]
(RPAQ? TEDITMODE.DEFAULTMODE.VAR (QUOTE Text))
(RPAQ? TEDITMODE.MODELIST (LIST (create TEDITMODEREC MODE ← (QUOTE Text)
IN-MENU? ← T EXTENSION-LIST ← (QUOTE (tedit TEDIT))
TEXTPROPS ← NIL WINDOWPROPS ← NIL INITTEXTPROPS ← NIL)))
(RPAQ? TEDITMODE.MENU NIL)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS TEDITMODE.DEFAULTMODE.VAR TEDITMODE.MENU TEDITMODE.MODELIST)
)
(DEFINEQ
(TEDITMODE.CHANGEDEFAULTMODE
(LAMBDA NIL (* pds: " 2-Feb-86 19:05") (* * Pops up a menu to allow the user to see what the default
TEdit mode is now, and optionally to change it.) (* * Any changes to this function should probably
also be made to TEDITMODE.CHANGEMODE) (if (NULL TEDITMODE.MENU) then (SETQ TEDITMODE.MENU (create MENU
ITEMS ← (for REC in TEDITMODE.MODELIST when (fetch (TEDITMODEREC IN-MENU?) of REC) collect (fetch (
TEDITMODEREC MODE) of REC)) CENTERFLG ← T TITLE ← "TEdit Mode"))) (LET ((CURRENTMODE (
TEDITMODE.DEFAULTMODE))) (replace (MENU SHADEDITEMS) of TEDITMODE.MENU with (for ITM in (fetch (MENU
ITEMS) of TEDITMODE.MENU) as I from 1 when (EQUAL ITM CURRENTMODE) do (RETURN (LIST (CONS I BLACKSHADE
))))) (replace (MENU IMAGE) of TEDITMODE.MENU with NIL) (LET ((NEWMODE (MENU TEDITMODE.MENU))) (if (
AND NEWMODE (NEQ NEWMODE CURRENTMODE)) then (TEDITMODE.DEFAULTMODE NEWMODE) (if (EQUAL NEWMODE (
TEDITMODE.DEFAULTMODE)) then (PROMPTPRINT (CONCAT "Default TEdit mode changed to '" NEWMODE "'")) else
(PROMPTPRINT "Couldn't change mode")) else (PROMPTPRINT (CONCAT "Default TEdit mode is still '"
CURRENTMODE "'")))))))
(TEDITMODE.CHANGEMODE
(LAMBDA (TEXTSTREAM) (* pds: " 2-Feb-86 18:57") (* * Pops up a menu to allow the user to see what mode
the TEdit window is in now, and optionally to change it.) (* * Any changes to this function should
probably also be made to TEDITMODE.CHANGEDEFAULTMODE) (if (NULL TEDITMODE.MENU) then (SETQ
TEDITMODE.MENU (create MENU ITEMS ← (for REC in TEDITMODE.MODELIST when (fetch (TEDITMODEREC IN-MENU?)
of REC) collect (fetch (TEDITMODEREC MODE) of REC)) CENTERFLG ← T TITLE ← "TEdit Mode"))) (LET ((
CURRENTMODE (TEDITMODE.MODE TEXTSTREAM))) (replace (MENU SHADEDITEMS) of TEDITMODE.MENU with (for ITM
in (fetch (MENU ITEMS) of TEDITMODE.MENU) as I from 1 when (EQUAL ITM CURRENTMODE) do (RETURN (LIST (
CONS I BLACKSHADE))))) (replace (MENU IMAGE) of TEDITMODE.MENU with NIL) (LET ((NEWMODE (MENU
TEDITMODE.MENU))) (if (AND NEWMODE (NEQ NEWMODE CURRENTMODE)) then (TEDITMODE.MODE TEXTSTREAM NEWMODE)
(if (EQUAL NEWMODE (TEDITMODE.MODE TEXTSTREAM)) then (TEDIT.PROMPTPRINT TEXTSTREAM (CONCAT
"TEdit mode changed to '" NEWMODE "'") T) else (TEDIT.PROMPTPRINT TEXTSTREAM "Couldn't change mode" T)
) else (TEDIT.PROMPTPRINT TEXTSTREAM (CONCAT "TEdit mode is still '" CURRENTMODE "'") T))))))
(TEDITMODE.COPY.MENU
(LAMBDA (MENU) (* pds: "30-Jan-86 16:00") (create MENU ITEMS ← (fetch (MENU ITEMS) of MENU) CENTERFLG
← (fetch (MENU CENTERFLG) of MENU) CHANGEOFFSETFLG ← (fetch (MENU CHANGEOFFSETFLG) of MENU) MENUFONT ←
(fetch (MENU MENUFONT) of MENU) TITLE ← (fetch (MENU TITLE) of MENU) MENUOFFSET ← (fetch (MENU
MENUOFFSET) of MENU) WHENSELECTEDFN ← (fetch (MENU WHENSELECTEDFN) of MENU) MENUBORDERSIZE ← (fetch (
MENU MENUBORDERSIZE) of MENU) MENUOUTLINESIZE ← (fetch (MENU MENUOUTLINESIZE) of MENU) WHENHELDFN ← (
fetch (MENU WHENHELDFN) of MENU) MENUPOSITION ← (fetch (MENU MENUPOSITION) of MENU) WHENUNHELDFN ← (
fetch (MENU WHENUNHELDFN) of MENU) MENUUSERDATA ← (fetch (MENU MENUUSERDATA) of MENU) MENUTITLEFONT ←
(fetch (MENU MENUTITLEFONT) of MENU) SUBITEMFN ← (fetch (MENU SUBITEMFN) of MENU) MENUFEEDBACKFLG ← (
fetch (MENU MENUFEEDBACKFLG) of MENU) SHADEDITEMS ← (fetch (MENU SHADEDITEMS) of MENU))))
(TEDITMODE.DEFAULTMODE
(LAMBDA (NEWMODE) (* pds: " 2-Feb-86 18:14") (* * Return the current default TEdit mode. If NEWMODE is
non-NIL, then make it be the new default TEdit mode.) (PROG1 TEDITMODE.DEFAULTMODE.VAR (if NEWMODE
then (if (SASSOC NEWMODE TEDITMODE.MODELIST) then (if (NOT (EQUAL NEWMODE TEDITMODE.DEFAULTMODE.VAR))
then (SETQ TEDITMODE.DEFAULTMODE.VAR NEWMODE) (LET ((BGMENUITEM (ASSOC (QUOTE TEdit)
BackgroundMenuCommands))) (change (CADDR BGMENUITEM) (CONCAT "Opens a TEdit window in '" NEWMODE
"' mode.")) (SETQ BackgroundMenu NIL))) else (ERROR "Unknown mode" NEWMODE))))))
(TEDITMODE.FIX.TEDIT.PROPS
(LAMBDA (TEXT PROPS) (* pds: " 2-Feb-86 21:55") (* * Called before TEDIT (TEDIT is advised) to fix up
the PROPS supplied to TEDIT and make them appropriate for the mode. Returns a new PROPS list.) (LET* (
(SPECIFIEDMODE (LISTGET PROPS (QUOTE TEDIT.MODE))) (FILENAME (AND (NOT SPECIFIEDMODE) TEXT (INFILEP
TEXT)) (* * No need to get file name if user specified mode explicitly.)) (MODEREC (OR (AND
SPECIFIEDMODE (SASSOC SPECIFIEDMODE TEDITMODE.MODELIST)) (AND FILENAME (bind (EXT ← (FILENAMEFIELD
FILENAME (QUOTE EXTENSION))) for REC in TEDITMODE.MODELIST thereis (MEMB EXT (fetch (TEDITMODEREC
EXTENSION-LIST) of REC)))) (SASSOC (TEDITMODE.DEFAULTMODE) TEDITMODE.MODELIST)))) (* * MODEREC should
never be NIL.) (APPEND (if (NOT (EQUAL SPECIFIEDMODE (fetch (TEDITMODEREC MODE) of MODEREC))) then (
LIST (QUOTE TEDIT.MODE) (fetch (TEDITMODEREC MODE) of MODEREC)) else NIL) PROPS (LET ((TEXTPROPS (
APPEND (fetch (TEDITMODEREC INITTEXTPROPS) of MODEREC) (fetch (TEDITMODEREC TEXTPROPS) of MODEREC))))
(APPEND (LIST (QUOTE TEDITMODE.OLDPROPS) (for PROP in TEXTPROPS by (CDDR PROP) collect (CONS PROP NIL)
)) TEXTPROPS))))))
(TEDITMODE.MODE
(LAMBDA (TEXTOBJ-OR-STREAM-OR-WINDOW NEWMODE DONTBREAK?) (* pds: " 2-Feb-86 22:05") (* * Returns
current mode of TEXTOBJ-OR-STREAM. If NEWMODE is non-NIL, then also changes
TEXTOBJ-OR-STREAM-OR-WINDOW to NEWMODE. Modes are listed in TEDITMODE.MODELIST, which is a list of
TEDITMODEREC, which are of the form (mode in-menu? extension-list textprops windowprops enterfn exitfn
) %. Mode is the name of the mode; if in-menu? is non-NIL, then this mode will automatically be
included in the menu of modes presented when you select MODE from the modified default TEdit menu;
extension-list is a list of file extensions that automatically switch a TEdit window to that mode.
Textprops is a property list of TEXTOBJ properties and their values. These properties will be set when
a TEdit window is put into the mode, and unset when taken out of that mode. Similarly for
windowprops. A menu placed on the TEdit window's TEDIT.MENU prop will be used instead of the default
TEdit menu. Enterfn, if non-NIL, and not the atom DON'T, will be applied to the TEXTOBJ before it is
changed to this mode. Similarly for exitfn. If either of them is, or returns, the atom DON'T, then the
mode will not be entered (exited) %.) (PROG1 (TEXTPROP (TEXTOBJ TEXTOBJ-OR-STREAM-OR-WINDOW) (QUOTE
TEDIT.MODE)) (if NEWMODE then (* * N.B.: In the LET below, I use SASSOC to find the appropriate mode
record since I know that the mode is the first entry in the record. I know this is unclean, but I'm
doing it anyway.) (LET* ((MODEREC (SASSOC NEWMODE TEDITMODE.MODELIST)) (TXTOB (TEXTOBJ
TEXTOBJ-OR-STREAM-OR-WINDOW)) (WIN (CAR (fetch (TEXTOBJ \WINDOW) of TXTOB)))) (if MODEREC then (with
TEDITMODEREC MODEREC (if (AND (LET ((EXITFN (TEXTPROP TXTOB (QUOTE EXITMODEFN)))) (OR (NULL EXITFN) (
NEQ (APPLY* EXITFN TXTOB NEWMODE) (QUOTE DON'T)))) (LET ((ENTERFN (LISTGET TEXTPROPS (QUOTE
ENTERMODEFN)))) (OR (NULL ENTERFN) (NEQ (APPLY* ENTERFN TXTOB NEWMODE) (QUOTE DON'T))))) then (for
PAIR in (TEXTPROP TXTOB (QUOTE TEDITMODE.OLDPROPS)) do (TEXTPROP TXTOB (CAR PAIR) (CDR PAIR))) (for
PAIR in (WINDOWPROP WIN (QUOTE TEDITMODE.OLDPROPS)) do (WINDOWPROP WIN (CAR PAIR) (CDR PAIR))) (
TEXTPROP TXTOB (QUOTE TEDITMODE.OLDPROPS) (for PTR on TEXTPROPS by (CDDR PTR) collect (CONS (CAR PTR)
(PROG1 (TEXTPROP TXTOB (CAR PTR)) (TEXTPROP TXTOB (CAR PTR) (CADR PTR)))))) (WINDOWPROP WIN (QUOTE
TEDITMODE.OLDPROPS) (for PTR on WINDOWPROPS by (CDDR PTR) collect (CONS (CAR PTR) (WINDOWPROP WIN (CAR
PTR) (CADR PTR))))) (TEXTPROP TXTOB (QUOTE TEDIT.MODE) NEWMODE) elseif (NOT DONTBREAK?) then (ERROR
"Unknown TEdit mode" NEWMODE)))))))))
(TEDITMODE.NEWMODE
(LAMBDA (TEDITMODERECORD) (* pds: " 2-Feb-86 23:18") (LET ((NEWMODE (fetch (TEDITMODEREC MODE) of
TEDITMODERECORD))) (if (NOT (SASSOC NEWMODE TEDITMODE.MODELIST)) then (NCONC1 TEDITMODE.MODELIST
TEDITMODERECORD) (if (fetch (TEDITMODEREC IN-MENU?) of TEDITMODERECORD) then (SETQ TEDITMODE.MENU NIL)
(LET ((BGMENUITEM (ASSOC (QUOTE TEdit) BackgroundMenuCommands))) (if (NULL (CDDDR BGMENUITEM)) then (
* Add submenu to TEdit item) (NCONC1 BGMENUITEM (LIST (QUOTE SUBITEMS) (LIST "<change default>" (KWOTE
(LIST (FUNCTION TEDITMODE.CHANGEDEFAULTMODE))) "Allows you to choose the default TEdit mode") (LIST (
QUOTE Text) (KWOTE (LIST (FUNCTION TEDIT) NIL NIL NIL (KWOTE (LIST (QUOTE TEDIT.MODE) (QUOTE Text)))))
"Opens a TEdit window in 'Text' mode."))) (change (CADDR BGMENUITEM)
"Opens a TEdit window in 'Text' mode.")) (NCONC1 (CADDDR BGMENUITEM) (LIST NEWMODE (KWOTE (LIST (
FUNCTION TEDIT) NIL NIL NIL (KWOTE (LIST (QUOTE TEDIT.MODE) NEWMODE)))) (CONCAT
"Opens a TEdit window in '" NEWMODE "' mode.")))) (SETQ BackgroundMenu NIL)) NEWMODE else NIL))))
(TEDITMODE.SET.MODE.AFTER.GET.OR.PUT
(LAMBDA (TEXTOBJ) (* pds: " 2-Feb-86 20:52") (LET* ((NEWMODEREC (bind (EXT ← (FILENAMEFIELD (
\TEXTSTREAM.FILENAME TEXTOBJ) (QUOTE EXTENSION))) for MODE in TEDITMODE.MODELIST thereis (MEMB EXT (
fetch (TEDITMODEREC EXTENSION-LIST) of MODE)))) (NEWMODE (AND NEWMODEREC (fetch (TEDITMODEREC MODE) of
NEWMODEREC)))) (if NEWMODE then (LET ((OLDMODE (TEDITMODE.MODE TEXTOBJ NEWMODE))) (if (AND (NOT (
EQUAL NEWMODE OLDMODE)) (EQUAL NEWMODE (TEDITMODE.MODE TEXTOBJ))) then (TEDIT.PROMPTPRINT TEXTOBJ (
CONCAT "Tedit mode is '" NEWMODE "'"))))))))
(TEDITMODE.SET.MODE.INITIALLY
(LAMBDA (TEXTOBJ) (* pds: " 2-Feb-86 22:05") (LET ((WIN (CAR (fetch (TEXTOBJ \WINDOW) of TEXTOBJ)))) (
WINDOWPROP WIN (QUOTE TEDITMODE.OLDPROPS) (for PTR on (fetch (TEDITMODEREC WINDOWPROPS) of (SASSOC (
TEXTPROP TEXTOBJ (QUOTE TEDIT.MODE)) TEDITMODE.MODELIST)) by (CDDR PTR) collect (CONS (CAR PTR) (
WINDOWPROP WIN (CAR PTR) (CADR PTR)))))) (if (NOT (TEXTPROP TEXTOBJ (QUOTE DONT.ANNOUNCE.MODE))) then
(TEDIT.PROMPTPRINT TEXTOBJ (CONCAT "TEdit mode is '" (TEDITMODE.MODE TEXTOBJ) "'"))) TEXTOBJ))
)
(if (NOT (ASSOC "Mode" (fetch (MENU ITEMS)
of TEDIT.DEFAULT.MENU)))
then
(TEDIT.ADD.MENUITEM TEDIT.DEFAULT.MENU (QUOTE ("Mode" (FUNCTION TEDITMODE.CHANGEMODE)))))
(PUTPROPS TEDIT.GET READVICE (NIL (AFTER NIL (TEDITMODE.SET.MODE.AFTER.GET.OR.PUT TEXTOBJ FILE))))
(PUTPROPS TEDIT.PUT READVICE (NIL (AFTER NIL (TEDITMODE.SET.MODE.AFTER.GET.OR.PUT TEXTOBJ FILE))))
(PUTPROPS \TEDIT.WINDOW.SETUP READVICE (NIL (AFTER NIL (TEDITMODE.SET.MODE.INITIALLY TEXTOBJ))))
(READVISE TEDIT.GET TEDIT.PUT \TEDIT.WINDOW.SETUP)
(* * Don't want to use filepkg ADVISE com, since Prolog system code advises TEDIT, also. The two sets
of advice need to be separated.)
(ADVISE (QUOTE TEDIT)
(QUOTE BEFORE)
NIL
(QUOTE (SETQ PROPS (TEDITMODE.FIX.TEDIT.PROPS TEXT PROPS))))
(PUTPROPS TEDITMODE COPYRIGHT ("Quintus Computer Systems, Inc" 1986))
(DECLARE: DONTCOPY
(FILEMAP (NIL (2118 12023 (TEDITMODE.CHANGEDEFAULTMODE 2128 . 3280) (TEDITMODE.CHANGEMODE 3282 . 4498)
(TEDITMODE.COPY.MENU 4500 . 5427) (TEDITMODE.DEFAULTMODE 5429 . 6027) (TEDITMODE.FIX.TEDIT.PROPS 6029
. 7186) (TEDITMODE.MODE 7188 . 9818) (TEDITMODE.NEWMODE 9820 . 10902) (
TEDITMODE.SET.MODE.AFTER.GET.OR.PUT 10904 . 11486) (TEDITMODE.SET.MODE.INITIALLY 11488 . 12021)))))
STOP