1
0
mirror of synced 2026-05-03 06:39:40 +00:00

Rmk30 WHEREIS for missing GETFN, TMAX fixed (#749)

* MACHINEINDEPENDENT: better searching for foo-fie

FINDFILE-WITH-EXTENSIONS, DOFILESLOAD

* MEDLEY-UTILS, PRINTFN:  WHEREIS/PF know about foo>foo-fie

* WHERE-IS:  Just MAKEFILE-NEW to get FUNCTIONS into the filemap

* ACE does LOADCOMP itself

* MACHINEINDEPENDENT:  FINDFILE-WITH-EXTENSIONS recognized SUBDIRECTORY

* SPELLFILE:  Calls FINDFILE-WITH-EXTENSIONS at the top

So FINDFILE and FILE-NOT-FOUND will consider FOO>FOO-FIE for file FOO-FIE

* WINDOWOBJ:  Missing GETFN does WHEREIS #748

* TMAX*:  Localize IMAGEFNS

The various IMAGEFNS were defined on TMAX itself, not on the file where the functions were (esp GETFN).

Also fixed some dependencies.  With new WINDOWOBJ, TMAX.TEDIT finds its image objects.

* WINDOWOBJ again:  SYSLOAD the GETFN file

Co-authored-by: Larry Masinter <LMM@acm.org>
This commit is contained in:
rmkaplan
2022-04-24 11:32:59 -07:00
committed by GitHub
parent 1eccc2e59b
commit e22f10b19a
21 changed files with 11 additions and 10 deletions

575
lispusers/tmax/TMAX Normal file
View File

@@ -0,0 +1,575 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "17-Mar-2022 23:12:47" {DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>TMAX.;3 25981
:CHANGES-TO (VARS TMAXCOMS)
:PREVIOUS-DATE "24-Oct-2021 23:45:20"
{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>TMAX.;2)
(* ; "
Copyright (c) 1987, 1997, 1999 by Stanford University.
")
(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* '(SOURCE)
TMAX.FILE.LIST)))
(DECLARE%: EVAL@COMPILE DONTCOPY (P (OR (GETPROP 'EXPORTS.ALL 'FILE)
(LOAD '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)
(* ;;; "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)
(VARS (GP.DefaultFont (FONTCREATE 'TERMINAL 10))
(GP.DefaultShade 1024))
(P [TEDIT.ADD.MENUITEM TEDIT.DEFAULT.MENU '(TMAX% Menu (FUNCTION TSP.DISPLAY.FMMENU)
NIL
(SUBITEMS (Update [FUNCTION
(LAMBDA
(TEXTSTREAM)
(UPDATE.ALL
TEXTSTREAM
(\TEDIT.MAINW
TEXTSTREAM]
"Updates all cross-references"
)
(NGroup% Menu
[FUNCTION (LAMBDA
(TEXTSTREAM)
(GRAPHMENU TEXTSTREAM
(\TEDIT.MAINW
TEXTSTREAM]
"Displays number-group menu"]
(TSP.FUNCTION.HOOKS))))
(* ; "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* '(SOURCE)
TMAX.FILE.LIST))
(DECLARE%: EVAL@COMPILE DONTCOPY
(OR (GETPROP 'EXPORTS.ALL 'FILE)
(LOAD '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 (TERMINAL 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 (TERMINAL 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 (TERMINAL 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 (VIEW.INDEX.FILE TSTREAM TWINDOW T))
(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 2-May-97 17:02 by rmk:")
(* ; "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 (CL:UNLESS (HASHARRAYP (WINDOWPROP WINDOW 'TSP.NGROUP.ARRAY))
(WINDOWPROP WINDOW 'TSP.NGROUP.ARRAY (HASHARRAY 100)))
(CL:UNLESS (HASHARRAYP (WINDOWPROP WINDOW 'TSP.CODE.ARRAY))
(WINDOWPROP WINDOW 'TSP.CODE.ARRAY (HASHARRAY 100)))
(SETQ IMAGEOBJ.MENUW (FREEMENU TSP.FM.DESC "TMAX (Tedit Macros And eXtensions)"))
(WINDOWPROP IMAGEOBJ.MENUW 'TSTREAM STREAM)
(WINDOWADDPROP IMAGEOBJ.MENUW 'CLOSEFN (FUNCTION FREEATTACHEDWINDOW))
(WINDOWPROP IMAGEOBJ.MENUW 'TWINDOW WINDOW)
(WINDOWPROP WINDOW 'IMAGEOBJ.MENUW IMAGEOBJ.MENUW)
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])
)
(* ;;; "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) (* ; "Edited 24-Oct-2021 23:39 by rmk:")
(* 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)
(Terminal 'TERMINAL)
(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) (* ; "Edited 24-Oct-2021 22:05 by rmk:")
(* 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)
(TERMINAL 'Terminal)
(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 SHADE) (* ; "Edited 26-Jan-97 14:07 by rmk:")
(* 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 (OR SHADE GP.DefaultShade)
STREAM
(DSPXPOSITION NIL STREAM)
(IDIFFERENCE (DSPYPOSITION NIL STREAM)
(FETCH YDESC OF BOUNDBOX))
(FETCH XSIZE OF BOUNDBOX)
(FETCH YSIZE OF BOUNDBOX])
)
(* ;;; "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)
)
(RPAQ GP.DefaultFont (FONTCREATE 'TERMINAL 10))
(RPAQQ GP.DefaultShade 1024)
[TEDIT.ADD.MENUITEM TEDIT.DEFAULT.MENU '(TMAX% Menu (FUNCTION TSP.DISPLAY.FMMENU)
NIL
(SUBITEMS (Update [FUNCTION (LAMBDA (TEXTSTREAM)
(UPDATE.ALL TEXTSTREAM
(\TEDIT.MAINW
TEXTSTREAM]
"Updates all cross-references")
(NGroup% Menu [FUNCTION (LAMBDA (TEXTSTREAM)
(GRAPHMENU
TEXTSTREAM
(\TEDIT.MAINW
TEXTSTREAM]
"Displays number-group menu"]
(TSP.FUNCTION.HOOKS)
(PUTPROPS TMAX COPYRIGHT ("Stanford University" 1987 1997 1999))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (8231 15446 (TSP.DISPLAY.FMMENU 8241 . 8806) (TSP.SETUP.FILENAMES 8808 . 10059) (
TSP.SETUP.FMMENU 10061 . 10521) (TSP.FMMENU 10523 . 11709) (TSP.FM.APPLY 11711 . 12030) (UPDATE.ALL
12032 . 12704) (DOWNDATE.ALL 12706 . 13076) (TSP.FUNCTION.HOOKS 13078 . 14508) (TSP.GETFN 14510 .
15070) (TSP.PUTFN 15072 . 15444)) (15492 17741 (AutoUpdate.TOGGLE 15502 . 15738) (UPDATE? 15740 .
15885) (NGROUP.Menu.TOGGLE 15887 . 16269) (NGROUPMENU.ENABLED? 16271 . 16507) (
NGROUP.Text-Before.TOGGLE 16509 . 16759) (TEXTBEFORE.ENABLED? 16761 . 16924) (NGROUP.Text-After.TOGGLE
16926 . 17174) (TEXTAFTER.ENABLED? 17176 . 17337) (Manual.Index.TOGGLE 17339 . 17578) (
MANUALINDEX.ENABLED? 17580 . 17739)) (17775 23248 (GET.TSP.FONT 17785 . 18949) (GET.TSP.FONT.FAMILY
18951 . 19799) (GET.TSP.FONT.SIZE 19801 . 20289) (GET.TSP.FONT.FACE 20291 . 20990) (ABBREVIATE.FONT
20992 . 22492) (TMAX.SHADEOBJ 22494 . 23246)) (23288 24504 (TSP.LIST.OF.OBJECTS 23298 . 24502)))))
STOP