(FILECREATED " 8-Feb-86 16:07:04" {DSK}<LISPFILES2>IMPROVEDDCOMS>TEDITMODE.;1
 12730  

      changes to:  (ADVICE TEDIT.GET TEDIT.PUT)

      previous date: " 2-Feb-86 23:32:03" {GOEDEL}</usr2/pds/updating/>TEDITMODE)


(* 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) (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)))) (ADVISE (QUOTE TEDIT) (QUOTE AFTER)
 NIL (QUOTE (TEDITMODE.SET.MODE.INITIALLY (TEXTOBJ !VALUE)))))))
(* %%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))))
(READVISE TEDIT.GET TEDIT.PUT)
(* * 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))))
(ADVISE (QUOTE TEDIT) (QUOTE AFTER) NIL (QUOTE (TEDITMODE.SET.MODE.INITIALLY (TEXTOBJ !VALUE))))
(PUTPROPS TEDITMODE COPYRIGHT ("Quintus Computer Systems, Inc" 1986))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (1995 11900 (TEDITMODE.CHANGEDEFAULTMODE 2005 . 3157) (TEDITMODE.CHANGEMODE 3159 . 4375)
 (TEDITMODE.COPY.MENU 4377 . 5304) (TEDITMODE.DEFAULTMODE 5306 . 5904) (TEDITMODE.FIX.TEDIT.PROPS 5906
 . 7063) (TEDITMODE.MODE 7065 . 9695) (TEDITMODE.NEWMODE 9697 . 10779) (
TEDITMODE.SET.MODE.AFTER.GET.OR.PUT 10781 . 11363) (TEDITMODE.SET.MODE.INITIALLY 11365 . 11898)))))
STOP