(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "30-Dec-87 14:09:13" |{POGO:AISNORTH:XEROX}<CUTTING>TMAX>TMAX.;8| 24599
changes to%: (VARS TMAXCOMS)
previous date%: "30-Dec-87 11:33:00" |{POGO:AISNORTH:XEROX}<CUTTING>TMAX>TMAX.;7|)
(* "
Copyright (c) 1987 by Stanford University. All rights reserved.
")
(PRETTYCOMPRINT TMAXCOMS)
(RPAQQ TMAXCOMS ((* ; "Developed under support from NIH grant RR-00785.") (* ; "Written by Frank Gilmurray and Sami Shaio.") (FILES (COMPILED SYSLOAD) TEDIT FREEMENU) (VARS TMAX.FILE.LIST) (DECLARE%: DONTCOPY (P (DOFILESLOAD (LIST* (QUOTE (SOURCE)) TMAX.FILE.LIST))) (DECLARE%: EVAL@COMPILE DONTCOPY (P (OR (GETPROP (QUOTE EXPORTS.ALL) (QUOTE FILE)) (LOAD (QUOTE EXPORTS.ALL)))))) (P (DOFILESLOAD TMAX.FILE.LIST)) (* ;;; "Free Menu data structures") (VARS TSP.FM.DESC IMAGEOBJ.MENU.ITEMS) (* ;;; "Free Menu functions") (FNS TSP.DISPLAY.FMMENU TSP.SETUP.FILENAMES TSP.SETUP.FMMENU TSP.FMMENU TSP.FM.APPLY UPDATE.ALL DOWNDATE.ALL TSP.FUNCTION.HOOKS TSP.GETFN TSP.PUTFN TSP.HARDCOPYFN) (* ;;; "Free Menu toggle functions") (FNS AutoUpdate.TOGGLE UPDATE? NGROUP.Menu.TOGGLE NGROUPMENU.ENABLED? NGROUP.Text-Before.TOGGLE TEXTBEFORE.ENABLED? NGROUP.Text-After.TOGGLE TEXTAFTER.ENABLED? Manual.Index.TOGGLE MANUALINDEX.ENABLED?) (* ;;; "TSP font stuff") (FNS GET.TSP.FONT GET.TSP.FONT.FAMILY GET.TSP.FONT.SIZE GET.TSP.FONT.FACE ABBREVIATE.FONT TMAX.SHADEOBJ) (* ;;; "Collect ImageObjects") (FNS TSP.LIST.OF.OBJECTS) (GLOBALVARS GP.DefaultFont GP.DefaultShade) (MACROS MAKE.DATEOBJ.IMAGEFNS MAKE.INDEXOBJ.IMAGEFNS MAKE.NUMBEROBJ.IMAGEFNS MAKE.REGMARKOBJ.IMAGEFNS MAKE.XREFOBJ.IMAGEFNS) (P (SETQ GP.DefaultFont (FONTCREATE (QUOTE GACHA) 10)) (SETQ GP.DefaultShade 10260) (SETQ \NUMBEROBJ.IMAGEFNS (MAKE.NUMBEROBJ.IMAGEFNS)) (SETQ \DATEOBJ.IMAGEFNS (MAKE.DATEOBJ.IMAGEFNS)) (SETQ \REGMARKOBJ.IMAGEFNS (MAKE.REGMARKOBJ.IMAGEFNS)) (SETQ \INDEXOBJ.IMAGEFNS (MAKE.INDEXOBJ.IMAGEFNS)) (SETQ \XREFOBJ.IMAGEFNS (MAKE.XREFOBJ.IMAGEFNS)) (TEDIT.ADD.MENUITEM TEDIT.DEFAULT.MENU (QUOTE (TMAX% Menu (FUNCTION TSP.DISPLAY.FMMENU)))) (TSP.FUNCTION.HOOKS) (SETQ IMAGEOBJGETFNS (APPEND (QUOTE ((DATE.GETFN) (INDEX.GETFN) (NUMBER.GETFN) (REGMARK.GETFN) (XREF.GETFN))) IMAGEOBJGETFNS))))
)
(* ; "Developed under support from NIH grant RR-00785.")
(* ; "Written by Frank Gilmurray and Sami Shaio.")
(FILESLOAD (COMPILED SYSLOAD) TEDIT FREEMENU)
(RPAQQ TMAX.FILE.LIST (TMAX-DATE TMAX-ENDNOTE TMAX-INDEX TMAX-NUMBER TMAX-NGRAPH TMAX-NGROUP TMAX-XREF)
)
(DECLARE%: DONTCOPY
(DOFILESLOAD (LIST* (QUOTE (SOURCE)) TMAX.FILE.LIST))
(DECLARE%: EVAL@COMPILE DONTCOPY
(OR (GETPROP (QUOTE EXPORTS.ALL) (QUOTE FILE)) (LOAD (QUOTE EXPORTS.ALL)))
)
)
(DOFILESLOAD TMAX.FILE.LIST)
(* ;;; "Free Menu data structures")
(RPAQQ TSP.FM.DESC ((PROPS FORMAT TABLE TYPE MOMENTARY FONT (HELVETICA 10 BRR)) ((LABEL "Miscellany:" TYPE DISPLAY FONT (NIL NIL MRR)) (LABEL "Update" ID UPDATE SELECTEDFN TSP.FM.APPLY) (LABEL "Undo Update" ID UNDOUPDATE SELECTEDFN TSP.FM.APPLY) (LABEL "Set AutoUpdate" TYPE TOGGLE SELECTEDFN AutoUpdate.TOGGLE FONT (NIL NIL BIR)) (LABEL "Date/Time" ID DATE/TIME SELECTEDFN TSP.FM.APPLY)) ((LABEL "References:" TYPE DISPLAY FONT (NIL NIL MRR)) (LABEL "Reference" ID REFERENCE SELECTEDFN TSP.FM.APPLY) (LABEL "Known References" ID KNOWNREF SELECTEDFN TSP.FM.APPLY) (LABEL "Reference By" TYPE STATE MENUITEMS (Ask Value Page) INITSTATE Value LINKS (DISPLAY DEFAULTREF)) (LABEL "" TYPE DISPLAY ID DEFAULTREF FONT (GACHA 10 MRR))) ((LABEL "Endnotes:" TYPE DISPLAY FONT (NIL NIL MRR)) (LABEL "Endnote" ID ENDNOTE SELECTEDFN TSP.FM.APPLY) (LABEL "Insert Endnotes" ID INSERTNOTE SELECTEDFN TSP.FM.APPLY) (LABEL "Delete Endnotes" ID DELETENOTE SELECTEDFN TSP.FM.APPLY) (LABEL "Set Style" ID SETSTYLE SELECTEDFN TSP.FM.APPLY)) ((LABEL "Numbering:" TYPE DISPLAY FONT (NIL NIL MRR)) (LABEL "NGroup Menu" TYPE TOGGLE ID NGROUP.MENU SELECTEDFN NGROUP.Menu.TOGGLE FONT (NIL NIL BIR)) (LABEL "New Ngroup" ID NEWNGROUP SELECTEDFN TSP.FM.APPLY) (LABEL "Text Before" TYPE TOGGLE SELECTEDFN NGROUP.Text-Before.TOGGLE FONT (NIL NIL BIR)) (LABEL "Text After" TYPE TOGGLE SELECTEDFN NGROUP.Text-After.TOGGLE FONT (NIL NIL BIR))) ((LABEL "Contents File:" TYPE DISPLAY FONT (NIL NIL MRR)) (LABEL "Create TOC" ID CREATETOC SELECTEDFN TSP.FM.APPLY) (LABEL "View TOC" ID VIEWTOC SELECTEDFN TSP.FM.APPLY) (LABEL "TOC Filename:" TYPE EDITSTART LINKS (EDIT TOC.FILE)) (LABEL "" TYPE EDIT ID TOC.FILE FONT (GACHA 10 MRR))) ((LABEL "Indices:" TYPE DISPLAY FONT (NIL NIL MRR)) (LABEL "Index" ID INDEX SELECTEDFN TSP.FM.APPLY) (LABEL "Extended Index" ID XTNDINDEX SELECTEDFN TSP.FM.APPLY) (LABEL "Known Indices" ID KNOWNINDEX SELECTEDFN TSP.FM.APPLY) (LABEL "Manual Index" TYPE TOGGLE SELECTEDFN Manual.Index.TOGGLE FONT (NIL NIL BIR))) ((LABEL "Indices File:" TYPE DISPLAY FONT (NIL NIL MRR)) (LABEL "Create Index" ID CREATEINDEX SELECTEDFN TSP.FM.APPLY) (LABEL "View Index" ID VIEWINDEX SELECTEDFN TSP.FM.APPLY) (LABEL "Index Filename:" TYPE EDITSTART LINKS (EDIT INDEX.FILE)) (LABEL "" TYPE EDIT ID INDEX.FILE FONT (GACHA 10 MRR))))
)
(RPAQQ IMAGEOBJ.MENU.ITEMS ((UPDATE (UPDATE.ALL TSTREAM TWINDOW)) (UNDOUPDATE (DOWNDATE.ALL TSTREAM TWINDOW)) (DATE/TIME (TEDIT.INSERT.OBJECT (DATEOBJ) (TEXTOBJ TSTREAM))) (REFERENCE (INSERT.REF TSTREAM)) (KNOWNREF (INSERT.REF TSTREAM T)) (ENDNOTE (ADD.ENDNOTE TSTREAM TWINDOW)) (INSERTNOTE (INSERT.ENDNOTES TSTREAM TWINDOW)) (DELETENOTE (DELETE.ENDNOTES TSTREAM)) (SETSTYLE (SET.ENDNOTE.STYLE TSTREAM TWINDOW)) (NEWNGROUP (AND (ADD.NUMBER.GROUP TWINDOW TSTREAM) (GRAPHMENU TSTREAM TWINDOW))) (CREATETOC (CREATE.TOC.FILE TSTREAM TWINDOW)) (VIEWTOC (VIEW.TOC.FILE TSTREAM TWINDOW)) (INDEX (INSERT.INDEX TSTREAM TWINDOW)) (XTNDINDEX (INSERT.INDEXENTRY TSTREAM TWINDOW)) (KNOWNINDEX (INSERT.KNOWN.INDEX TSTREAM TWINDOW)) (CREATEINDEX (CREATE.INDEX.FILE TSTREAM TWINDOW)) (VIEWINDEX (VIEW.INDEX.FILE TSTREAM TWINDOW)))
)
(* ;;; "Free Menu functions")
(DEFINEQ
(TSP.DISPLAY.FMMENU
[LAMBDA (STREAM) (* fsg "24-Aug-87 14:37")
(* * Here when user buttons TMAX Menu in the TEDIT.DEFAULT.MENU.)
(LET ((WINDOW (\TEDIT.MAINW STREAM))
(IMAGEOBJ.MENUW (TSP.FMMENU STREAM)))
(AND (NOT (OPENWP IMAGEOBJ.MENUW))
(PROGN (TSP.SETUP.FILENAMES IMAGEOBJ.MENUW)
(ATTACHWINDOW IMAGEOBJ.MENUW WINDOW 'TOP 'JUSTIFY)
(WINDOWPROP IMAGEOBJ.MENUW 'PASSTOMAINCOMS '(MOVEW SHAPEW SHRINKW BURYW])
(TSP.SETUP.FILENAMES
[LAMBDA (OBJMENUW) (* ; "Edited 11-Nov-87 11:19 by drc:")
(* * Here when displaying the TMAX menu.
Setup the TOC/INDEX filenames if they're not already specified.)
(LET ((TEXT.FILE (with TEXTOBJ TEXTOBJ TXTFILE)))
(AND (STREAMP TEXT.FILE)
(LET* [(FILE.NAME (fetch (STREAM FULLNAME) of TEXT.FILE))
(FILE.BASE (PACKFILENAME 'HOST (FILENAMEFIELD FILE.NAME 'HOST)
'DIRECTORY
(FILENAMEFIELD FILE.NAME 'DIRECTORY)
'NAME
(FILENAMEFIELD FILE.NAME 'NAME]
(for EXTENSION in '(TOC INDEX)
do (LET ((FM.ITEM (FM.GETITEM (MKATOM (CONCAT EXTENSION ".FILE"))
NIL OBJMENUW)))
(AND (STREQUAL (FM.ITEMPROP FM.ITEM 'LABEL)
"")
(FM.CHANGESTATE FM.ITEM (CONCAT FILE.BASE "." EXTENSION)
OBJMENUW])
(TSP.SETUP.FMMENU
[LAMBDA (WINDOW) (* fsg "24-Aug-87 16:04")
(* * Here to set up things like the FreeMenu, hasharrays, etc.
the first time through.)
(OR (WINDOWPROP WINDOW 'IMAGEOBJ.MENUW)
(TSP.FMMENU (OR (CAR (NLSETQ (TEXTSTREAM WINDOW)))
(with STREAM (with TEXTOBJ TEXTOBJ STREAMHINT)
FULLNAME])
(TSP.FMMENU
[LAMBDA (STREAM) (* ; "Edited 29-Sep-87 11:17 by fsg")
(* * Creates the TMAX ImageObj menu but doesn't attach itself to the main TEdit
window.)
(LET ((WINDOW (\TEDIT.MAINW STREAM))
IMAGEOBJ.MENUW)
(OR (WINDOWPROP WINDOW 'IMAGEOBJ.MENUW)
(PROGN (WINDOWPROP WINDOW 'TSP.CODE.ARRAY (HASHARRAY 100))
(WINDOWPROP WINDOW 'TSP.INDEX.ARRAY (HASHARRAY 100))
(WINDOWPROP WINDOW 'TSP.NGROUP.ARRAY (HASHARRAY 100))
(SETQ IMAGEOBJ.MENUW (FREEMENU TSP.FM.DESC
"TMAX (Tedit Macros And eXtensions) -- LYRIC version"
))
(WINDOWPROP IMAGEOBJ.MENUW 'TSTREAM STREAM)
(WINDOWADDPROP IMAGEOBJ.MENUW 'CLOSEFN (FUNCTION FREEATTACHEDWINDOW))
(WINDOWPROP IMAGEOBJ.MENUW 'TWINDOW WINDOW)
(WINDOWPROP WINDOW 'IMAGEOBJ.MENUW IMAGEOBJ.MENUW)
(WINDOWPROP WINDOW 'HARDCOPYFN (FUNCTION TSP.HARDCOPYFN))
IMAGEOBJ.MENUW])
(TSP.FM.APPLY
[LAMBDA (ITEM WINDOW BUTTON) (* ; "Edited 29-Sep-87 11:17 by fsg")
(LET [(LABEL (FM.ITEMPROP ITEM 'ID))
(TSTREAM (WINDOWPROP WINDOW 'TSTREAM))
(TWINDOW (WINDOWPROP WINDOW 'TWINDOW]
(EVAL (CADR (ASSOC LABEL IMAGEOBJ.MENU.ITEMS])
(UPDATE.ALL
[LAMBDA (STREAM WINDOW) (* fsg "24-Aug-87 11:40")
(* * Update the NGroup/Endnote numbers and any References to them.)
(UPDATE.NUMBEROBJS WINDOW STREAM 'NUMBEROBJP)
(UPDATE.XREFS WINDOW)
(* * This should check if there is an Endnote section.
If there is one then we want to re-insert the Endnotes.
The test for REGMARKOBJs works because we are only using them for the purpose
of marking the Endnote section.)
(AND (TSP.LIST.OF.OBJECTS (TEXTOBJ STREAM)
'REGMARKOBJP)
(INSERT.ENDNOTES STREAM WINDOW])
(DOWNDATE.ALL
[LAMBDA (STREAM WINDOW) (* fsg "24-Sep-87 16:16")
(* * Undo everything that UPDATE does.)
(DOWNDATE.NUMBEROBJS WINDOW STREAM 'NUMBEROBJP)
(UPDATE.XREFS WINDOW T)
(AND (TSP.LIST.OF.OBJECTS (TEXTOBJ STREAM)
'REGMARKOBJP)
(INSERT.ENDNOTES STREAM WINDOW])
(TSP.FUNCTION.HOOKS
[LAMBDA NIL (* fsg " 3-Aug-87 15:33")
(* * Called during LOAD to set up any function hooks.)
(LET (FUNCTION.HOOK)
(AND (SETQ FUNCTION.HOOK (LISTGET TEDIT.DEFAULT.PROPS 'GETFN))
(NEQ FUNCTION.HOOK (FUNCTION TSP.GETFN))
(PROGN (PRINTOUT PROMPTWINDOW T .CENTER 0 (CONCAT "TEdit GETFN hook " FUNCTION.HOOK
" replaced by TMAX GETFN hook.")
T)
(FLASHWINDOW PROMPTWINDOW 2)))
[COND
((LISTP TEDIT.DEFAULT.PROPS)
(LISTPUT TEDIT.DEFAULT.PROPS 'GETFN (FUNCTION TSP.GETFN)))
(T (SETQ TEDIT.DEFAULT.PROPS (LIST 'GETFN (FUNCTION TSP.GETFN]
(AND (SETQ FUNCTION.HOOK (LISTGET TEDIT.DEFAULT.PROPS 'PUTFN))
(NEQ FUNCTION.HOOK (FUNCTION TSP.PUTFN))
(PROGN (PRINTOUT PROMPTWINDOW T .CENTER 0 (CONCAT "TEdit PUTFN hook " FUNCTION.HOOK
" replaced by TMAX PUTFN hook.")
T)
(FLASHWINDOW PROMPTWINDOW 2)))
(COND
((LISTP TEDIT.DEFAULT.PROPS)
(LISTPUT TEDIT.DEFAULT.PROPS 'PUTFN (FUNCTION TSP.PUTFN)))
(T (SETQ TEDIT.DEFAULT.PROPS (LIST 'PUTFN (FUNCTION TSP.PUTFN])
(TSP.GETFN
[LAMBDA (STREAM FILENAME FLAVOR) (* fsg "24-Aug-87 14:27")
(* * Called both BEFORE and AFTER a TEdit GET.
Only interested in BEFORE call at which time we clear all the hash arrays in
case of multiple GETs.)
(AND (EQ FLAVOR 'BEFORE)
(LET ((WINDOW (\TEDIT.MAINW STREAM)))
(CLRHASH (WINDOWPROP WINDOW 'TSP.CODE.ARRAY))
(CLRHASH (WINDOWPROP WINDOW 'TSP.INDEX.ARRAY))
(CLRHASH (WINDOWPROP WINDOW 'TSP.NGROUP.ARRAY])
(TSP.PUTFN
[LAMBDA (STREAM FILENAME FLAVOR) (* fsg " 3-Aug-87 11:05")
(* * Called both before and after a TEdit PUT.)
(LET ((WINDOW (\TEDIT.MAINW STREAM)))
(COND
((EQ FLAVOR 'BEFORE)
(WINDOWPROP WINDOW 'DUMPNGROUPGRAPH T))
(T (WINDOWPROP WINDOW 'DUMPNGROUPGRAPH NIL])
(TSP.HARDCOPYFN
[LAMBDA (WINDOW IMAGESTREAM) (* fsg "13-Aug-87 10:35")
(* * Here when the TMAX/TEdit window is hardcopied.
Clear out the old Index page numbers and then do the regular hardcopy.)
(RESET.INDEX.PAGENUMBERS WINDOW)
(TEDIT.HARDCOPYFN WINDOW IMAGESTREAM])
)
(* ;;; "Free Menu toggle functions")
(DEFINEQ
(AutoUpdate.TOGGLE
[LAMBDA (ITEM WINDOW BUTTON) (* ; "Edited 29-Sep-87 11:35 by fsg")
(WINDOWPROP (WINDOWPROP WINDOW 'TWINDOW)
'AUTOUPDATE
(FM.ITEMPROP ITEM 'STATE])
(UPDATE?
[LAMBDA (WINDOW) (* ss%: "27-Jun-87 16:33")
(WINDOWPROP WINDOW 'AUTOUPDATE])
(NGROUP.Menu.TOGGLE
[LAMBDA (ITEM WINDOW BUTTON) (* ss%: "27-Jun-87 16:28")
(LET [(TWINDOW (WINDOWPROP WINDOW 'TWINDOW))
(TSTREAM (WINDOWPROP WINDOW 'TSTREAM))
(TOGGLE.STATE (FM.ITEMPROP ITEM 'STATE]
(COND
(TOGGLE.STATE (GRAPHMENU TSTREAM TWINDOW))
(T (CLOSE.NGROUP.GRAPH TWINDOW])
(NGROUPMENU.ENABLED?
[LAMBDA (TWINDOW) (* ; "Edited 29-Sep-87 11:42 by fsg")
(FM.ITEMPROP (FM.GETITEM 'NGROUP.MENU NIL (WINDOWPROP TWINDOW 'IMAGEOBJ.MENUW))
'STATE])
(NGROUP.Text-Before.TOGGLE
[LAMBDA (ITEM WINDOW BUTTON) (* ; "Edited 29-Sep-87 11:45 by fsg")
(WINDOWPROP (WINDOWPROP WINDOW 'TWINDOW)
'NGROUPTEXTBEFORE
(FM.ITEMPROP ITEM 'STATE])
(TEXTBEFORE.ENABLED?
[LAMBDA (WINDOW) (* ss%: "27-Jun-87 16:29")
(WINDOWPROP WINDOW 'NGROUPTEXTBEFORE])
(NGROUP.Text-After.TOGGLE
[LAMBDA (ITEM WINDOW BUTTON) (* ; "Edited 29-Sep-87 11:46 by fsg")
(WINDOWPROP (WINDOWPROP WINDOW 'TWINDOW)
'NGROUPTEXTAFTER
(FM.ITEMPROP ITEM 'STATE])
(TEXTAFTER.ENABLED?
[LAMBDA (WINDOW) (* ss%: "27-Jun-87 16:29")
(WINDOWPROP WINDOW 'NGROUPTEXTAFTER])
(Manual.Index.TOGGLE
[LAMBDA (ITEM WINDOW BUTTON) (* ; "Edited 29-Sep-87 11:48 by fsg")
(WINDOWPROP (WINDOWPROP WINDOW 'TWINDOW)
'MANUALINDEX
(FM.ITEMPROP ITEM 'STATE])
(MANUALINDEX.ENABLED?
[LAMBDA (WINDOW) (* ss%: "27-Jun-87 16:27")
(WINDOWPROP WINDOW 'MANUALINDEX])
)
(* ;;; "TSP font stuff")
(DEFINEQ
(GET.TSP.FONT
[LAMBDA (WINDOW DEFAULT.FONT FONT.FIELD) (* fsg " 8-Jul-87 10:08")
(* * Return the font descriptor list. If the FAMILY, SIZE, and/or FACE is not
specified, it defaults to the corresponding value in the DEFAULT.FONT
descriptor. If FONT.FIELD is non-NIL, it specifies which one of the three
fields to get.)
(LET ([FAMILY (COND
((AND FONT.FIELD (NEQ FONT.FIELD 'FAMILY))
(FONTPROP DEFAULT.FONT 'FAMILY))
(T (GET.TSP.FONT.FAMILY DEFAULT.FONT]
[SIZE (COND
((AND FONT.FIELD (NEQ FONT.FIELD 'SIZE))
(FONTPROP DEFAULT.FONT 'SIZE))
(T (GET.TSP.FONT.SIZE DEFAULT.FONT]
[FACE (COND
((AND FONT.FIELD (NEQ FONT.FIELD 'FACE))
(FONTPROP DEFAULT.FONT 'FACE))
(T (GET.TSP.FONT.FACE DEFAULT.FONT]
NEWENTRY.FONT)
(AND (SETQ NEWENTRY.FONT (FONTCREATE FAMILY SIZE FACE NIL NIL T))
(LIST FAMILY SIZE (FONTPROP NEWENTRY.FONT 'FACE])
(GET.TSP.FONT.FAMILY
[LAMBDA (DEFAULT.FONT) (* fsg " 8-Jul-87 15:44")
(* * Get the font family from the menu or DEFAULT.FONT if the menu returns NIL.)
(OR [MKATOM (MENU (create MENU
TITLE ← "Font Family"
CENTERFLG ← T
ITEMS ← '((Classic 'CLASSIC)
(Gacha 'GACHA)
(Helvetica 'HELVETICA)
(Modern 'MODERN)
(TimesRoman 'TIMESROMAN]
(FONTPROP DEFAULT.FONT 'FAMILY])
(GET.TSP.FONT.SIZE
[LAMBDA (DEFAULT.FONT) (* fsg " 8-Jul-87 09:56")
(* * Get the font size from the menu or DEFAULT.FONT if the menu returns NIL.)
(OR [MKATOM (MENU (create MENU
TITLE ← "Font Size"
CENTERFLG ← T
MENUCOLUMNS ← 2
ITEMS ← '(6 8 10 12 14 18 24 36]
(FONTPROP DEFAULT.FONT 'SIZE])
(GET.TSP.FONT.FACE
[LAMBDA (DEFAULT.FONT) (* fsg " 8-Jul-87 15:44")
(* * Get the font face from the menu or DEFAULT.FONT if the menu returns NIL.)
(OR [MKATOM (MENU (create MENU
TITLE ← "Font Face"
CENTERFLG ← T
ITEMS ← '((Standard 'MRR "(MEDIUM REGULAR REGULAR)")
(Italic 'MIR "(MEDIUM ITALIC REGULAR)")
(Bold 'BRR "(BOLD REGULAR REGULAR)")
(BoldItalic 'BIR "(BOLD ITALIC REGULAR)"]
(FONTPROP DEFAULT.FONT 'FACE])
(ABBREVIATE.FONT
[LAMBDA (FONT) (* fsg " 8-Jul-87 15:57")
(* * Returns an abbreviated font description.
For example, if the font is (TIMESROMAN 12
(BOLD REGULAR REGULAR)) then the list (TimesRoman 12 Bold) is returned.)
(LET [(FONT.LIST (COND
[(FONTP FONT)
(LIST (FONTPROP FONT 'FAMILY)
(FONTPROP FONT 'SIZE)
(FONTPROP FONT 'FACE]
(T FONT]
(LIST (LET ((FONT.FAMILY (CAR FONT.LIST)))
(SELECTQ FONT.FAMILY
(CLASSIC 'Classic)
(GACHA 'Gacha)
(HELVETICA 'Helvetica)
(MODERN 'Modern)
(TIMESROMAN 'TimesRoman)
FONT.FAMILY))
(CADR FONT.LIST)
(LET [(FONT.FACE (CONCATLIST (for FIELD in (CADDR FONT.LIST) collect (GNC FIELD]
(SELECTQ (MKATOM FONT.FACE)
(MRR 'Standard)
(MIR 'Italic)
(BRR 'Bold)
(BIR 'BoldItalic)
FONT.FACE])
(TMAX.SHADEOBJ
[LAMBDA (OBJ STREAM) (* fsg "17-Sep-87 11:25")
(* * Shade the ImageObject to distinguish it from normal text.)
(AND (IMAGESTREAMTYPEP STREAM 'DISPLAY)
(LET [(BOUNDBOX (IMAGEOBJPROP OBJ 'BOUNDBOX]
(BLTSHADE GP.DefaultShade STREAM (DSPXPOSITION NIL STREAM)
(IDIFFERENCE (DSPYPOSITION NIL STREAM)
(with IMAGEBOX BOUNDBOX YDESC))
(with IMAGEBOX BOUNDBOX XSIZE)
(with IMAGEBOX BOUNDBOX YSIZE])
)
(* ;;; "Collect ImageObjects")
(DEFINEQ
(TSP.LIST.OF.OBJECTS
[LAMBDA (TEXTOBJ TESTFN TESTFNARG) (* ss%: "27-Jun-87 16:32")
(* * Loop through each PIECE of the TEdit document and call the user supplied
function on those PIECEs that are ImageObjects.)
(AND TESTFN (LET ((OBJLIST (TCONC NIL)))
(TEDIT.MAPPIECES TEXTOBJ [FUNCTION (LAMBDA (CH# PIECE PC# OBL)
(AND (TYPENAMEP PIECE 'PIECE)
(IMAGEOBJP (fetch POBJ of PIECE))
(APPLY* TESTFN (fetch POBJ
of PIECE)
TESTFNARG)
(TCONC OBL
(LIST (fetch POBJ of PIECE)
CH#]
OBJLIST)
(CDAR OBJLIST])
)
(DECLARE%: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS GP.DefaultFont GP.DefaultShade)
)
(DECLARE%: EVAL@COMPILE
(PUTPROPS MAKE.DATEOBJ.IMAGEFNS MACRO (LAMBDA NIL (IMAGEFNSCREATE (FUNCTION DATE.DISPLAYFN) (FUNCTION DATE.IMAGEBOXFN) (FUNCTION DATE.PUTFN) (FUNCTION DATE.GETFN) (FUNCTION DATE.COPYFN) (FUNCTION DATE.BUTTONEVENTINFN) (FUNCTION NILL) (FUNCTION NILL) (FUNCTION NILL) (FUNCTION NILL) (FUNCTION NILL) (FUNCTION NILL) (FUNCTION NILL))))
(PUTPROPS MAKE.INDEXOBJ.IMAGEFNS MACRO (LAMBDA NIL (IMAGEFNSCREATE (FUNCTION INDEX.DISPLAYFN) (FUNCTION INDEX.IMAGEBOXFN) (FUNCTION INDEX.PUTFN) (FUNCTION INDEX.GETFN) (FUNCTION INDEX.COPYFN) (FUNCTION INDEX.BUTTONEVENTINFN) (FUNCTION NILL) (FUNCTION NILL) (FUNCTION NILL) (FUNCTION INDEX.WHENDELETEDFN) (FUNCTION NILL) (FUNCTION NILL) (FUNCTION NILL))))
(PUTPROPS MAKE.NUMBEROBJ.IMAGEFNS MACRO (LAMBDA NIL (IMAGEFNSCREATE (FUNCTION NUMBER.DISPLAYFN) (FUNCTION NUMBER.IMAGEBOXFN) (FUNCTION NUMBER.PUTFN) (FUNCTION NUMBER.GETFN) (FUNCTION NUMBER.COPYFN) (FUNCTION NUMBER.BUTTONEVENTINFN) (FUNCTION NILL) (FUNCTION NILL) (FUNCTION NILL) (FUNCTION XREF.WHENDELETEDFN) (FUNCTION NILL) (FUNCTION NILL) (FUNCTION NILL))))
(PUTPROPS MAKE.REGMARKOBJ.IMAGEFNS MACRO (LAMBDA NIL (IMAGEFNSCREATE (FUNCTION REGMARK.DISPLAYFN) (FUNCTION REGMARK.IMAGEBOXFN) (FUNCTION REGMARK.PUTFN) (FUNCTION REGMARK.GETFN) (FUNCTION REGMARK.COPYFN) (FUNCTION REGMARK.BUTTONEVENTINFN) (FUNCTION NILL) (FUNCTION NILL) (FUNCTION NILL) (FUNCTION NILL) (FUNCTION NILL) (FUNCTION NILL) (FUNCTION NILL))))
(PUTPROPS MAKE.XREFOBJ.IMAGEFNS MACRO (LAMBDA NIL (IMAGEFNSCREATE (FUNCTION XREF.DISPLAYFN) (FUNCTION XREF.IMAGEBOXFN) (FUNCTION XREF.PUTFN) (FUNCTION XREF.GETFN) (FUNCTION XREF.COPYFN) (FUNCTION XREF.BUTTONEVENTINFN) (FUNCTION NILL) (FUNCTION NILL) (FUNCTION NILL) (FUNCTION NILL) (FUNCTION NILL) (FUNCTION NILL) (FUNCTION NILL))))
)
(SETQ GP.DefaultFont (FONTCREATE (QUOTE GACHA) 10))
(SETQ GP.DefaultShade 10260)
(SETQ \NUMBEROBJ.IMAGEFNS (MAKE.NUMBEROBJ.IMAGEFNS))
(SETQ \DATEOBJ.IMAGEFNS (MAKE.DATEOBJ.IMAGEFNS))
(SETQ \REGMARKOBJ.IMAGEFNS (MAKE.REGMARKOBJ.IMAGEFNS))
(SETQ \INDEXOBJ.IMAGEFNS (MAKE.INDEXOBJ.IMAGEFNS))
(SETQ \XREFOBJ.IMAGEFNS (MAKE.XREFOBJ.IMAGEFNS))
(TEDIT.ADD.MENUITEM TEDIT.DEFAULT.MENU (QUOTE (TMAX% Menu (FUNCTION TSP.DISPLAY.FMMENU))))
(TSP.FUNCTION.HOOKS)
(SETQ IMAGEOBJGETFNS (APPEND (QUOTE ((DATE.GETFN) (INDEX.GETFN) (NUMBER.GETFN) (REGMARK.GETFN) (XREF.GETFN))) IMAGEOBJGETFNS))
(PUTPROPS TMAX COPYRIGHT ("Stanford University" 1987))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (5973 13549 (TSP.DISPLAY.FMMENU 5983 . 6548) (TSP.SETUP.FILENAMES 6550 . 7801) (
TSP.SETUP.FMMENU 7803 . 8263) (TSP.FMMENU 8265 . 9463) (TSP.FM.APPLY 9465 . 9784) (UPDATE.ALL 9786 .
10458) (DOWNDATE.ALL 10460 . 10830) (TSP.FUNCTION.HOOKS 10832 . 12262) (TSP.GETFN 12264 . 12824) (
TSP.PUTFN 12826 . 13198) (TSP.HARDCOPYFN 13200 . 13547)) (13595 15844 (AutoUpdate.TOGGLE 13605 . 13841
) (UPDATE? 13843 . 13988) (NGROUP.Menu.TOGGLE 13990 . 14372) (NGROUPMENU.ENABLED? 14374 . 14610) (
NGROUP.Text-Before.TOGGLE 14612 . 14862) (TEXTBEFORE.ENABLED? 14864 . 15027) (NGROUP.Text-After.TOGGLE
15029 . 15277) (TEXTAFTER.ENABLED? 15279 . 15440) (Manual.Index.TOGGLE 15442 . 15681) (
MANUALINDEX.ENABLED? 15683 . 15842)) (15878 20843 (GET.TSP.FONT 15888 . 17052) (GET.TSP.FONT.FAMILY
17054 . 17737) (GET.TSP.FONT.SIZE 17739 . 18227) (GET.TSP.FONT.FACE 18229 . 18928) (ABBREVIATE.FONT
18930 . 20239) (TMAX.SHADEOBJ 20241 . 20841)) (20883 22099 (TSP.LIST.OF.OBJECTS 20893 . 22097)))))
STOP