(FILECREATED "18-Feb-87 15:45:59" {SUMEX-AIM}PS:<TMAX.SOURCES>NGROUP.;3 44781
changes to: (FNS NGROUP.BUTTONEVENTINFN)
previous date: "17-Feb-87 14:25:08" {SUMEX-AIM}PS:<GILMURRAY.LISP>NGROUP.;3)
(* Copyright (c) 1987 by Leland Stanford Junior University. All rights reserved.)
(PRETTYCOMPRINT NGROUPCOMS)
(RPAQQ NGROUPCOMS ((* Developed under support from NIH grant RR-00785.)
(* Written by Frank Gilmurray and Sami Shaio.)
(* * NUMBER ImageObject functions)
(FNS NUMBEROBJ NUMBEROBJP NGROUP.NUMBEROBJP NUMBER.DISPLAYFN NUMBER.IMAGEBOXFN NUMBER.PUTFN
NUMBER.GETFN NUMBER.BUTTONEVENTINFN)
(FNS NGROUP.BUTTONEVENTINFN NGROUP.WHENSELECTEDFN)
(* * Number Group GRAPH functions)
(FNS GRAPHMENU TSP.NGROUP.GRAPHP INITIAL.NGROUP.GRAPH TSPGRAPHREGION
ADD.NGROUP.TO.MOTHER.NODE ADD.NODE.TO.GRAPH COLLECT.HASHARRAY CREATE.NGROUP.NODE
GET.FROMNODES GET.MOTHER.GROUP MAKE.MOTHER.NODE MAKE.NGROUP.NODELST GET.TONODES
FIND.NODE)
(* * Other unsorted functions)
(FNS INSERT.NGROUP VERIFY.NGROUP.ORDER ADD.NUMBER.GROUP ADD.NGROUP.TO.DBASE COLLECT.NGROUPS
LIST.FONT.PROPS MAP.NGROUP.LOOKS NGROUP.GETFONT CHANGE.NGROUP CHANGE.NGROUP.FONT
CHANGE.NGROUP.FORMAT CHANGE.NGROUP.CHARTYPE CHANGE.NGROUP.DELIMIT CHANGE.NGROUP.START
CHANGE.NGROUP.ADDTOTOC TSP.GET.NGROUP.ARRAY TSP.LEGALID)
(* * Number counting functions)
(FNS UPDATE.NUMBEROBJS RESET.DEPENDENT.CLASSES RESET.NCOUNTER GET.NCOUNTER NCOUNTER?
LIST.ANCESTORS FLATTEN.TREE.TO.STRING NGROUP.CHARTYPE NUMBER.TO.LETTER
REMOVE.ALL.COUNTERS)
(* * Table-of-Contents functions)
(FNS TOC.ENABLED? GET.TOC.TEXTSTRING CREATE.TOC.FILE VIEW.TOC.FILE GET.TOC.FILE
WRITE.TOC.FILE)
(RECORDS NGCOUNTER NGTEMPLATE NUMBEROBJ)))
(* Developed under support from NIH grant RR-00785.)
(* Written by Frank Gilmurray and Sami Shaio.)
(* * NUMBER ImageObject functions)
(DEFINEQ
(NUMBEROBJ
(LAMBDA (USE TEMPLATE NUMSTRING LINK.TO REF.TYPE FONT) (* fsg " 4-Feb-87 13:26")
(LET ((NEWOBJ (IMAGEOBJCREATE (create NUMBEROBJ
REF.TYPE ← REF.TYPE
NUMSTRING ←(OR NUMSTRING "↑n")
USE ← USE
TEMPLATE ← TEMPLATE
LINK.TO ← LINK.TO
NUMBER.TEXT ← NIL
PAGE.NUMBER ← NIL
FONT ← FONT)
(IMAGEFNSCREATE (FUNCTION NUMBER.DISPLAYFN)
(FUNCTION NUMBER.IMAGEBOXFN)
(FUNCTION NUMBER.PUTFN)
(FUNCTION NUMBER.GETFN)
(FUNCTION NILL)
(FUNCTION NUMBER.BUTTONEVENTINFN)
(FUNCTION NILL)
(FUNCTION NILL)
(FUNCTION NILL)
(FUNCTION XREF.WHENDELETEDFN)
(FUNCTION NILL)
(FUNCTION NILL)
(FUNCTION NILL)))))
(IMAGEOBJPROP NEWOBJ 'TYPE
'NUMBEROBJ)
NEWOBJ)))
(NUMBEROBJP
(LAMBDA (IMOBJ) (* ss: "25-Jun-85 12:11")
(* Tests an imageobj to see if it is a number imageobject. By convention, testing functions for an imageobject will
be named (CONCAT <type of imageobj> "P"))
(AND IMOBJ (EQ (IMAGEOBJPROP IMOBJ 'TYPE)
'NUMBEROBJ))))
(NGROUP.NUMBEROBJP
(LAMBDA (IMOBJ) (* fsg "15-Dec-86 09:57")
(* * Like NUMBEROBJP but also checks for NGroup ImageObject.)
(AND (NUMBEROBJP IMOBJ)
(EQ (fetch (NUMBEROBJ USE) of (fetch OBJECTDATUM of IMOBJ))
'NGROUP))))
(NUMBER.DISPLAYFN
(LAMBDA (OBJ STREAM) (* fsg "17-Feb-87 14:20")
(* Display function for numberobjs. Allows different formats for display according to the use to which the
numberobj is being put. If no specific action is specified, displaying defaults to printing out as a plain
number.*)
(LET* ((DATUM (fetch OBJECTDATUM of OBJ))
(NUMSTRING (MKSTRING (fetch NUMSTRING of DATUM)))
(NUMBER.TEXT (fetch NUMBER.TEXT of DATUM))
(TEMPLATE (MKSTRING (fetch TEMPLATE of DATUM)))
(USE (fetch USE of DATUM))
(REF.TYPE (fetch REF.TYPE of DATUM))
(MAIN.WINDOW (CAR (fetch \WINDOW of TEXTOBJ)))
(FONT (SELECTQ USE
(NOTE (fetch NUMBER.FONT of (GET.ENDNOTE.FONTS MAIN.WINDOW)))
(NGROUP (NGROUP.GETFONT REF.TYPE MAIN.WINDOW))
(SHOULDNT "Undefined USE field, neither NOTE nor NGroup"))))
(AND (STRINGP NUMBER.TEXT)
(EQ USE 'NGROUP)
(SETQ NUMSTRING (CONCAT NUMSTRING NUMBER.TEXT)))
(AND (FONTP FONT)
(DSPFONT (FONTCREATE (FONTPROP FONT 'FAMILY)
(FONTPROP FONT 'SIZE)
(FONTPROP FONT 'FACE))
STREAM))
(SELECTQ USE
(NGROUP (PRIN3 NUMSTRING STREAM)
(SELECTQ (IMAGESTREAMTYPE STREAM)
(DISPLAY NIL)
(replace PAGE.NUMBER of DATUM
with (CAR FORMATTINGSTATE))))
(NOTE (LET ((CURRENT.YPOS (DSPYPOSITION NIL STREAM))
(IMAGEBOX (LISTGET (fetch IMAGEOBJPLIST of OBJ)
'BOUNDBOX)))
(DSPYPOSITION (IPLUS CURRENT.YPOS
(IDIFFERENCE (fetch YSIZE
of IMAGEBOX)
(FONTPROP STREAM
'HEIGHT)))
STREAM)
(PRIN1 NUMSTRING STREAM)
(DSPYPOSITION CURRENT.YPOS STREAM)))
NIL))))
(NUMBER.IMAGEBOXFN
(LAMBDA (OBJ STREAM CURRENTX RIGHTMARGIN) (* fsg "17-Feb-87 11:21")
(* * The YSize is computed as the current font height plus half of the NOTE or NGroup font.
The reason is weird. Ask Sami for more details.)
(LET* ((MAIN.WINDOW (CAR (fetch \WINDOW of TEXTOBJ)))
(DATUM (fetch OBJECTDATUM of OBJ))
(USE (fetch USE of DATUM))
(REF.TYPE (fetch REF.TYPE of DATUM))
(DEFAULTSTRING (MKSTRING (fetch NUMSTRING of DATUM)))
(NUMBER.TEXT (fetch NUMBER.TEXT of DATUM))
(FONT (SELECTQ USE
(NOTE (fetch NUMBER.FONT of (GET.ENDNOTE.FONTS MAIN.WINDOW)))
(NGROUP (NGROUP.GETFONT REF.TYPE MAIN.WINDOW))
(SHOULDNT "Undefined USE field, neither NOTE nor NGroup"))))
(AND (STRINGP NUMBER.TEXT)
(EQ USE 'NGROUP)
(SETQ DEFAULTSTRING (CONCAT DEFAULTSTRING NUMBER.TEXT)))
(AND (FONTP FONT)
(DSPFONT (FONTCREATE (FONTPROP FONT 'FAMILY)
(FONTPROP FONT 'SIZE)
(FONTPROP FONT 'FACE))
STREAM))
(create IMAGEBOX
XSIZE ←(STRINGWIDTH DEFAULTSTRING STREAM)
YSIZE ←(IPLUS (FONTPROP (CURRENT.DISPLAY.FONT STREAM)
'HEIGHT)
(FIX (TIMES .5 (FONTPROP STREAM 'HEIGHT))))
YDESC ←(FONTPROP STREAM 'DESCENT)
XKERN ← 0))))
(NUMBER.PUTFN
(LAMBDA (OBJ STREAM) (* fsg " 4-Feb-87 13:29")
(LET ((USE (fetch USE of (fetch OBJECTDATUM of OBJ)))
(MAIN.WINDOW (PROCESSPROP (THIS.PROCESS)
'WINDOW)))
(SELECTQ USE
(NOTE (NOTE.PUTFN OBJ STREAM MAIN.WINDOW))
(NGROUP (replace (NUMBEROBJ FONT) of (fetch OBJECTDATUM of OBJ)
with (LIST.FONT.PROPS (NGROUP.GETFONT (fetch REF.TYPE
of (fetch
OBJECTDATUM
of OBJ))
MAIN.WINDOW)))
(replace NGROUP.MOTHER of (fetch OBJECTDATUM of OBJ)
with (GET.FROMNODES (fetch REF.TYPE
of (fetch OBJECTDATUM of OBJ))
MAIN.WINDOW))
(PRIN4 (LIST 'NGroup
(IMAGEOBJPROP OBJ 'TAG)
(fetch OBJECTDATUM of OBJ))
STREAM))
(PRIN4 (LIST 'Unknown% Number% Type
(IMAGEOBJPROP OBJ 'TAG)
(fetch OBJECTDATUM of OBJ))
STREAM)))))
(NUMBER.GETFN
(LAMBDA (STREAM) (* edited: "29-Jan-87 16:27")
(LET* ((USE/TEXT (CDR (READ STREAM)))
(NEWOBJ (NUMBEROBJ))
(USE (MKATOM (fetch USE of (CADR USE/TEXT))))
(WINDOW (PROCESSPROP (THIS.PROCESS)
'WINDOW)))
(OR (WINDOWPROP WINDOW 'IMAGEOBJ.MENUW)
(TSP.FMMENU (TEXTSTREAM WINDOW)))
(IMAGEOBJPROP NEWOBJ 'TAG
(CAR USE/TEXT))
(SETQ USE/TEXT (CADR USE/TEXT))
(replace USE of (fetch OBJECTDATUM of NEWOBJ) with USE)
(SELECTQ USE
(NOTE (NOTE.GETFN NEWOBJ USE/TEXT WINDOW))
(NGROUP (ADD.NGROUP.TO.DBASE (fetch REF.TYPE of USE/TEXT)
(fetch TEMPLATE of USE/TEXT)
(fetch NGROUP.MOTHER of USE/TEXT)
(AND (fetch (NUMBEROBJ FONT) of USE/TEXT)
(replace (NUMBEROBJ FONT)
of USE/TEXT
with (APPLY*
'FONTCREATE
(fetch (NUMBEROBJ FONT)
of USE/TEXT))))
(CREATE.NGROUP.NODE (fetch REF.TYPE
of USE/TEXT)
(fetch NGROUP.MOTHER
of USE/TEXT)
USE/TEXT WINDOW)
WINDOW)
(CREATE.NGROUP.NODE (fetch NGROUP.MOTHER of USE/TEXT)
NIL NIL WINDOW)
(ADD.NGROUP.TO.MOTHER.NODE (fetch REF.TYPE of USE/TEXT)
(fetch NGROUP.MOTHER of USE/TEXT)
WINDOW)
(WINDOWPROP WINDOW 'REBUILD.GRAPHFLG
T)
(replace OBJECTDATUM of NEWOBJ with USE/TEXT))
(replace OBJECTDATUM of NEWOBJ with USE/TEXT))
NEWOBJ)))
(NUMBER.BUTTONEVENTINFN
(LAMBDA (NUMBEROBJ STREAM) (* fsg " 4-Feb-87 13:31")
(LET ((USE (fetch USE of (fetch OBJECTDATUM of NUMBEROBJ)))
(REF.TYPE (fetch REF.TYPE of (fetch OBJECTDATUM of NUMBEROBJ)))
(CHANGED NIL))
(AND (MOUSESTATE MIDDLE)
(SELECTQ USE
(NOTE (NOTE.BUTTONEVENTINFN NUMBEROBJ STREAM))
(NGROUP.BUTTONEVENTINFN REF.TYPE NUMBEROBJ STREAM)))
CHANGED)))
)
(DEFINEQ
(NGROUP.BUTTONEVENTINFN
(LAMBDA (USE NUMBEROBJ STREAM) (* fsg "18-Feb-87 11:19")
(LET* ((TAG (IMAGEOBJPROP NUMBEROBJ 'TAG))
(NMENU (create MENU
TITLE ←(COND
(TAG (CONCAT USE " Tag:" TAG))
(T USE))
ITEMS ←(COND
(TAG '(Change% Tag))
(T '(Tag)))
WHENSELECTEDFN ← 'NGROUP.WHENSELECTEDFN)))
(PUTMENUPROP NMENU 'OBJ
NUMBEROBJ)
(MENU NMENU))))
(NGROUP.WHENSELECTEDFN
(LAMBDA (ITEM MENU MB) (* fsg " 4-Feb-87 13:41")
(LET ((TSTREAM (TEXTSTREAM WINDOW))
(OBJ (GETMENUPROP MENU 'OBJ))
PREV.CODE CODE)
(SETQ CODE (TSP.GET.INCODE TSTREAM))
(AND (SETQ PREV.CODE (IMAGEOBJPROP OBJ 'TAG))
(TSP.PUTCODE PREV.CODE NIL WINDOW))
(IMAGEOBJPROP OBJ 'TAG
CODE)
(COND
(CODE (TSP.PUTCODE CODE OBJ WINDOW)
(TSP.PUTCODE PREV.CODE NIL WINDOW))))))
)
(* * Number Group GRAPH functions)
(DEFINEQ
(GRAPHMENU
(LAMBDA (TSTREAM TWINDOW) (* fsg " 2-Dec-86 08:54")
(LET* ((RESHAPEFLG NIL)
(GRAPH (OR (AND (NOT (WINDOWPROP TWINDOW 'REBUILD.GRAPHFLG))
(WINDOWPROP TWINDOW 'NGROUP.GRAPH))
(INITIAL.NGROUP.GRAPH TWINDOW)))
(REGION (TSPGRAPHREGION GRAPH TWINDOW T))
(GRAPHW (OR (WINDOWPROP TWINDOW 'NGROUPW)
(CREATEW REGION "Number Group Graph" NIL T))))
(WINDOWPROP GRAPHW 'REPAINTFN
NIL)
(ATTACHWINDOW (SHAPEW GRAPHW REGION)
TWINDOW
'TOP
'JUSTIFY
'LOCALCLOSE)
(SHOWGRAPH GRAPH GRAPHW (FUNCTION INSERT.NGROUP)
(FUNCTION CHANGE.NGROUP))
(WINDOWPROP TWINDOW 'REBUILD.GRAPHFLG
NIL)
(WINDOWPROP TWINDOW 'NGROUPW
GRAPHW)
(WINDOWPROP TWINDOW 'NGROUP.GRAPH
GRAPH)
(WINDOWPROP GRAPHW 'CLOSEFN
'DETACHWINDOW)
(WINDOWPROP GRAPHW 'TWINDOW
TWINDOW)
(WINDOWPROP GRAPHW 'TSTREAM
TSTREAM))))
(TSP.NGROUP.GRAPHP
(LAMBDA (TWINDOW) (* fsg "15-Dec-86 15:27")
(LET* ((MENUW (WINDOWPROP TWINDOW 'IMAGEOBJ.MENUW))
(ITEM (FM.ITEMFROMID MENUW 'NGroup% Menu)))
(FM.ITEMPROP ITEM 'STATE))))
(INITIAL.NGROUP.GRAPH
(LAMBDA (WINDOW) (* ss: "24-Apr-86 14:31")
(LET* ((ROOTNODE (NODECREATE 'NEW.NGROUP
'NEW.NGROUP
NIL NIL NIL NIL 1))
(NODELST (for NODE in (COLLECT.HASHARRAY (TSP.GET.NGROUP.ARRAY WINDOW))
collect (CADR NODE))))
(OR (FIND.NODE 'NEW.NGROUP
WINDOW)
(PROGN (SETQ NODELST (CONS ROOTNODE NODELST))
(ADD.NGROUP.TO.DBASE 'NEW.NGROUP
NIL NIL NIL ROOTNODE WINDOW)))
(LAYOUTGRAPH NODELST '(NEW.NGROUP)))))
(TSPGRAPHREGION
(LAMBDA (GRAPH MAIN.WINDOW TITLEFLG BORDER) (* ss: " 2-Apr-86 16:28")
(LET ((R (GRAPHREGION GRAPH))
(MAIN.R (WINDOWREGION MAIN.WINDOW)))
(replace (REGION WIDTH) of R with (WIDTHIFWINDOW (fetch (REGION WIDTH) of R)))
(replace (REGION HEIGHT) of R with (HEIGHTIFWINDOW (fetch (REGION HEIGHT)
of R)
TITLEFLG BORDER))
R)))
(ADD.NGROUP.TO.MOTHER.NODE
(LAMBDA (ID MOTHERID W) (* ss: " 3-Apr-86 17:50")
(LET* ((MOTHER.NODE (FIND.NODE MOTHERID W))
(TONODES (fetch (GRAPHNODE TONODES) of MOTHER.NODE)))
(OR (MEMBER ID TONODES)
(replace (GRAPHNODE TONODES) of MOTHER.NODE with (CONS ID TONODES))))))
(ADD.NODE.TO.GRAPH
(LAMBDA (NODE GRAPH WINDOW) (* ss: "24-Apr-86 14:26")
(LET* ((PARENT.NODE (FIND.NODE (CAR (fetch (GRAPHNODE FROMNODES) of NODE))
WINDOW))
(TONODES (fetch (GRAPHNODE TONODES) of NODE)))
(OR (MEMBER (fetch (GRAPHNODE NODEID) of NODE)
TONODES)
(PROGN (replace (GRAPHNODE TONODES) of PARENT.NODE
with (CONS (fetch (GRAPHNODE NODEID) of NODE)
(fetch (GRAPHNODE TONODES) of PARENT.NODE)))
(replace (GRAPH GRAPHNODES) of GRAPH
with (CONS NODE (fetch (GRAPH GRAPHNODES) of GRAPH)))))
(LAYOUTGRAPH (fetch (GRAPH GRAPHNODES) of GRAPH)
'(NEW.NGROUP)))))
(COLLECT.HASHARRAY
(LAMBDA (HARRAY) (* ss: " 3-Apr-86 16:46")
(LET ((RESULT NIL))
(MAPHASH HARRAY '(LAMBDA (VAL KY)
(SETQ RESULT (CONS VAL RESULT))))
RESULT)))
(CREATE.NGROUP.NODE
(LAMBDA (ID MOTHER USERDATA W) (* ss: " 4-Apr-86 13:13")
(LET* ((NGROUP.HARRAY (TSP.GET.NGROUP.ARRAY W))
(NODE (GETHASH ID NGROUP.HARRAY)))
(OR NODE (LET ((NEW.NODE (NODECREATE ID ID NIL NIL (LIST MOTHER))))
(PUTHASH ID (LIST USERDATA NEW.NODE)
(LIST NGROUP.HARRAY))
NEW.NODE))
(OR (AND NODE (CAR NODE))
(AND USERDATA NODE (RPLACA NODE USERDATA))))))
(GET.FROMNODES
(LAMBDA (NGID WINDOW) (* ss: " 3-Apr-86 16:00")
(CAR (fetch (GRAPHNODE FROMNODES) of (FIND.NODE NGID WINDOW)))))
(GET.MOTHER.GROUP
(LAMBDA (DEPENDENT WINDOW) (* ss: " 2-Apr-86 16:30")
(CAR (fetch (GRAPHNODE FROMNODES) of (FIND.NODE DEPENDENT WINDOW)))))
(MAKE.MOTHER.NODE
(LAMBDA NIL (* ss: " 8-Feb-86 16:01")
(LET ((TONODES NIL))
(NODECREATE 'NEW.NGROUP
'NEW.NGROUP
NIL
(for NGROUP in (TSP.GET 'NGROUPS)
do (COND
((NOT (GET.FROMNODES (fetch REF.TYPE of NGROUP)))
(SETQ TONODES (CONS (fetch REF.TYPE of NGROUP)
TONODES))))
finally (RETURN TONODES))
NIL NIL 1))))
(MAKE.NGROUP.NODELST
(LAMBDA NIL (* ss: " 8-Feb-86 16:04")
(LET* ((NODELST (for NGROUP in (TSP.GET 'NGROUPS)
collect (NODECREATE (fetch REF.TYPE of NGROUP)
(fetch REF.TYPE of NGROUP)
NIL
(GET.TONODES (fetch REF.TYPE of NGROUP))
(GET.FROMNODES (fetch REF.TYPE of NGROUP))))))
(SETQ NODELST (CONS (MAKE.MOTHER.NODE)
NODELST)))))
(GET.TONODES
(LAMBDA (MOTHER-GROUP WINDOW) (* ss: " 2-Apr-86 16:31")
(fetch (GRAPHNODE TONODES) of (FIND.NODE MOTHER-GROUP WINDOW))))
(FIND.NODE
(LAMBDA (NID WINDOW) (* ss: " 3-Apr-86 18:26")
(CADR (GETHASH NID (TSP.GET.NGROUP.ARRAY WINDOW)))))
)
(* * Other unsorted functions)
(DEFINEQ
(INSERT.NGROUP
(LAMBDA (NODE GRAPHW) (* fsg "13-Jan-87 16:21")
(AND NODE (LET* ((TWINDOW (WINDOWPROP GRAPHW 'TWINDOW))
(TSTREAM (WINDOWPROP GRAPHW 'TSTREAM))
(LABEL (fetch (GRAPHNODE NODELABEL) of NODE))
(TEMPLATE (fetch (NUMBEROBJ TEMPLATE)
of (CAR (GETHASH LABEL (TSP.GET.NGROUP.ARRAY TWINDOW)))))
(OLDLOOKS (fetch CARETLOOKS of (TEXTOBJ TSTREAM)))
(NEWLOOKS (NGROUP.GETFONT LABEL TWINDOW)))
(SELECTQ LABEL
(NEW.NGROUP (COND
((ADD.NUMBER.GROUP TWINDOW TSTREAM)
(CLOSEW GRAPHW)
(GRAPHMENU TSTREAM TWINDOW))
(T NIL)))
(AND (VERIFY.NGROUP.ORDER TWINDOW TSTREAM LABEL)
(PROGN (TEDIT.CARETLOOKS TSTREAM NEWLOOKS)
(LET ((NEWOBJ (NUMBEROBJ 'NGROUP
TEMPLATE
(CONCAT "[" LABEL "]")
NIL LABEL NEWLOOKS)))
(AND (TOC.ENABLED? TWINDOW)
(GET.TOC.TEXTSTRING NEWOBJ TSTREAM
LABEL))
(IMAGEOBJPROP NEWOBJ 'TWINDOW
TWINDOW)
(TEDIT.INSERT.OBJECT NEWOBJ TSTREAM))
(TEDIT.CARETLOOKS TSTREAM OLDLOOKS)
(AND (UPDATE? TWINDOW)
(UPDATE.NUMBEROBJS TWINDOW
'NUMBEROBJP)))))))))
(VERIFY.NGROUP.ORDER
(LAMBDA (WINDOW STREAM LABEL) (* fsg "15-Dec-86 15:46")
(* * Verify the NGroup order before inserting a new NGroup. The order is valid if the new NGroup is a top level
node or the previous NGroup is the same as or the mother of this new NGroup. Note that the "previous NGroup" must
be a member of this NGroup`s tree branch.)
(OR (EQ (GET.FROMNODES LABEL WINDOW)
'NEW.NGROUP)
(LET* ((ANCESTORS (LIST.ANCESTORS LABEL NIL WINDOW))
(MOTHER (CAR (LAST ANCESTORS)))
(SELECTION (TEDIT.GETSEL STREAM))
(CH# (SELECTQ (fetch POINT of SELECTION)
(LEFT (fetch CH# of SELECTION))
(ADD1 (fetch CH# of SELECTION))))
PREV.NGROUP)
(NCONC1 ANCESTORS LABEL)
(SETQ PREV.NGROUP (for OBJ in (REVERSE (TSP.LIST.OF.OBJECTS (TEXTOBJ
WINDOW)
'
NGROUP.NUMBEROBJP))
bind REF.TYPE
do (COND
((AND (IGREATERP CH# (CADR OBJ))
(MEMB (SETQ REF.TYPE
(fetch (NUMBEROBJ REF.TYPE)
of (fetch OBJECTDATUM
of (CAR OBJ))))
ANCESTORS))
(RETURN REF.TYPE))
(T NIL))))
(COND
((OR (EQ PREV.NGROUP LABEL)
(EQ PREV.NGROUP MOTHER))
T)
(T (TEDIT.PROMPTPRINT STREAM (CONCAT "%"" LABEL
"%" not inserted, no preceding %""
MOTHER "%" NGroup.")
T)
NIL))))))
(ADD.NUMBER.GROUP
(LAMBDA (TWINDOW STREAM) (* fsg "14-Jan-87 11:30")
(OR (TSP.NGROUP.GRAPHP TWINDOW)
(PROGN (FM.CHANGESTATE (FM.ITEMFROMID (WINDOWPROP TWINDOW 'IMAGEOBJ.MENUW)
'NGroup% Menu)
(WINDOWPROP TWINDOW 'IMAGEOBJ.MENUW))
(GRAPHMENU STREAM TWINDOW)))
(LET* ((PREV.ITEMS (COLLECT.NGROUPS TWINDOW))
(NEW.GROUPID (MKATOM (TSP.LEGALID NIL (CONS 'NEW.NGROUP
PREV.ITEMS)
STREAM)))
TEMPLATE DEPENDENT.CLASS NEW.NODE)
(COND
(NEW.GROUPID (SETQ DEPENDENT.CLASS
(MKATOM (AND PREV.ITEMS (MENU (create MENU
TITLE ←
"Select Parent Group OR none"
ITEMS ←(SORT PREV.ITEMS
'UALPHORDER)))
)))
(SETQ TEMPLATE (OR TEMPLATE (create NGTEMPLATE
NG.CHARTYPE ← 'Number
NG.DELIMIT ← "."
NG.START ← 1
NG.ADDTOTOC ← T)))
(SETQ NEW.NODE (NODECREATE NEW.GROUPID NEW.GROUPID NIL NIL
(LIST (OR DEPENDENT.CLASS
'NEW.NGROUP))))
(ADD.NGROUP.TO.DBASE NEW.GROUPID TEMPLATE DEPENDENT.CLASS GP.DefaultFont
NEW.NODE TWINDOW)
(ADD.NODE.TO.GRAPH NEW.NODE (WINDOWPROP TWINDOW 'NGROUP.GRAPH)
TWINDOW))
(T NIL)))))
(ADD.NGROUP.TO.DBASE
(LAMBDA (NEW.GROUPID TEMPLATE DEPENDENT.CLASS FONT NGROUP.NODE TWINDOW)
(* ss: "24-Apr-86 14:19")
(LET ((NGROUP.ARRAY (TSP.GET.NGROUP.ARRAY TWINDOW)))
(OR (GETHASH NEW.GROUPID NGROUP.ARRAY)
(PROGN (WINDOWPROP TWINDOW 'REBUILD.GRAPHFLG
T)
(PUTHASH NEW.GROUPID
(LIST (create NUMBEROBJ
NGROUP.MOTHER ← DEPENDENT.CLASS
FONT ← FONT
REF.TYPE ← NEW.GROUPID
TEMPLATE ← TEMPLATE)
NGROUP.NODE)
(LIST NGROUP.ARRAY)))))))
(COLLECT.NGROUPS
(LAMBDA (TWINDOW) (* ss: "31-Mar-86 13:53")
(LET ((GRAPH (WINDOWPROP TWINDOW 'NGROUP.GRAPH)))
(for NODE in (fetch (GRAPH GRAPHNODES) of GRAPH) collect (fetch
(GRAPHNODE NODEID)
of NODE)
unless (EQ (fetch (GRAPHNODE NODEID) of NODE)
'NEW.NGROUP)))))
(LIST.FONT.PROPS
(LAMBDA (FONTDES) (* ss: " 6-Feb-86 16:12")
(AND FONTDES (LIST (FONTPROP FONTDES 'FAMILY)
(FONTPROP FONTDES 'SIZE)
(FONTPROP FONTDES 'FACE)))))
(MAP.NGROUP.LOOKS
(LAMBDA (LABEL NEWFDESC TWINDOW) (* ss: " 2-Apr-86 18:04")
(TEDIT.PROMPTPRINT (TEXTSTREAM TWINDOW)
(CONCAT "Updating looks for " LABEL " numbers...")
T)
(for NOTE/CH# in (TSP.LIST.OF.OBJECTS (TEXTOBJ TWINDOW)
(BQUOTE (LAMBDA (OBJ)
(AND (IMAGEOBJP OBJ)
(EQ (FETCH REF.TYPE
OF OBJ:OBJECTDATUM)
,
(KWOTE LABEL))))))
do (TEDIT.LOOKS (TEXTSTREAM TWINDOW)
NEWFDESC
(CADR NOTE/CH#)
1))
(TEDIT.PROMPTPRINT (TEXTSTREAM TWINDOW)
"done.")))
(NGROUP.GETFONT
(LAMBDA (NGROUP.NAME WINDOW) (* ss: " 3-Apr-86 18:26")
(fetch (NUMBEROBJ FONT) of (CAR (GETHASH NGROUP.NAME (TSP.GET.NGROUP.ARRAY WINDOW)))))
)
(CHANGE.NGROUP
(LAMBDA (NODE GRAPHW) (* fsg "13-Jan-87 15:11")
(* * Here when number group node is middle buttoned. Allow user to change the font and/or format of the ngroup.)
(AND NODE (OR (EQ 'NEW.NGROUP
(fetch (GRAPHNODE NODELABEL) of NODE))
(LET ((LABEL (fetch NODELABEL of NODE))
(ITEM.TO.CHANGE (MENU (create MENU
TITLE ← "Item to change"
CENTERFLG ← T
ITEMS ← '(Font Format)))))
(SELECTQ ITEM.TO.CHANGE
(Font (CHANGE.NGROUP.FONT LABEL GRAPHW))
(Format (CHANGE.NGROUP.FORMAT LABEL GRAPHW))
NIL))))))
(CHANGE.NGROUP.FONT
(LAMBDA (LABEL GRAPHW) (* fsg "13-Jan-87 15:13")
(* * Change the font of a number group.)
(LET* ((TSTREAM (WINDOWPROP GRAPHW 'TSTREAM))
(TWINDOW (WINDOWPROP GRAPHW 'TWINDOW))
(NBROBJ (CAR (GETHASH LABEL (TSP.GET.NGROUP.ARRAY TWINDOW))))
(OLD.FONT (fetch (NUMBEROBJ FONT) of NBROBJ))
NEW.FONT)
(TEDIT.PROMPTPRINT TSTREAM (CONCAT "%"" LABEL "%" font is " (LIST (ABBREVIATE.FONT
OLD.FONT))
", change to...")
T)
(SETQ NEW.FONT (FONTCREATE (GET.TSP.FONT TWINDOW OLD.FONT)))
(COND
((NEQ OLD.FONT NEW.FONT)
(replace (NUMBEROBJ FONT) of NBROBJ with NEW.FONT)
(MAP.NGROUP.LOOKS LABEL NEW.FONT TWINDOW))
(T NIL))
(TEDIT.PROMPTPRINT TSTREAM "" T))))
(CHANGE.NGROUP.FORMAT
(LAMBDA (LABEL GRAPHW) (* fsg "14-Jan-87 11:40")
(* * Change the format of a number group. The format is three element record; the character type, the delimiter,
and starting value.)
(LET* ((TSTREAM (WINDOWPROP GRAPHW 'TSTREAM))
(TWINDOW (WINDOWPROP GRAPHW 'TWINDOW))
(NBROBJ (CAR (GETHASH LABEL (TSP.GET.NGROUP.ARRAY TWINDOW))))
(OLD.TEMPLATE (fetch (NUMBEROBJ TEMPLATE) of NBROBJ))
NEW.CHARTYPE NEW.DELIMIT NEW.START NEW.ADDTOTOC)
(AND (SETQ NEW.CHARTYPE (CHANGE.NGROUP.CHARTYPE OLD.TEMPLATE LABEL TSTREAM))
(replace (NGTEMPLATE NG.CHARTYPE) of OLD.TEMPLATE with NEW.CHARTYPE))
(AND (SETQ NEW.DELIMIT (CHANGE.NGROUP.DELIMIT OLD.TEMPLATE LABEL TSTREAM))
(replace (NGTEMPLATE NG.DELIMIT) of OLD.TEMPLATE with NEW.DELIMIT))
(AND (SETQ NEW.START (CHANGE.NGROUP.START OLD.TEMPLATE LABEL TSTREAM))
(replace (NGTEMPLATE NG.START) of OLD.TEMPLATE with NEW.START))
(AND (SETQ NEW.ADDTOTOC (CHANGE.NGROUP.ADDTOTOC OLD.TEMPLATE LABEL TSTREAM))
(replace (NGTEMPLATE NG.ADDTOTOC) of OLD.TEMPLATE with (CDR NEW.ADDTOTOC)))
(COND
((OR NEW.CHARTYPE NEW.DELIMIT NEW.START)
(MAP.NGROUP.LOOKS LABEL (fetch (NUMBEROBJ FONT) of NBROBJ)
TWINDOW))
(T (TEDIT.PROMPTPRINT TSTREAM "" T))))))
(CHANGE.NGROUP.CHARTYPE
(LAMBDA (TEMPLATE LABEL STREAM) (* fsg "13-Jan-87 14:52")
(* * Show this NGroup's display type and return a possibly new display type.)
(TEDIT.PROMPTPRINT STREAM (CONCAT "%"" LABEL "%" displayed as " (fetch (NGTEMPLATE
NG.CHARTYPE)
of TEMPLATE)
", change to...")
T)
(MENU (create MENU
TITLE ← "NGroup Types"
CENTERFLG ← T
ITEMS ← '(Number Null% String Uppercase% Letter Lowercase% Letter
Uppercase% Roman Lowercase% Roman)))))
(CHANGE.NGROUP.DELIMIT
(LAMBDA (TEMPLATE LABEL STREAM) (* fsg "13-Jan-87 14:38")
(* * Show the delimiter following this NGroup and return a possibly new delimiter.)
(TEDIT.PROMPTPRINT STREAM (CONCAT "Delimiter following %"" LABEL "%" is %""
(fetch (NGTEMPLATE NG.DELIMIT) of TEMPLATE)
"%", change to...")
T)
(LET ((NEW.DELIMIT (MENU (create MENU
TITLE ← "NGroup Delimiters"
CENTERFLG ← T
ITEMS ← '((Dot ".")
(Dash "-")
(Null% String "")
Other)))))
(COND
((EQ NEW.DELIMIT 'Other)
(MKSTRING (TEDIT.GETINPUT STREAM (CONCAT "Specify delimiter following " LABEL ":"))
))
(T NEW.DELIMIT)))))
(CHANGE.NGROUP.START
(LAMBDA (TEMPLATE LABEL STREAM) (* fsg "13-Jan-87 15:09")
(* * Show this NGroup's starting value and return a possibly new starting value.)
(TEDIT.PROMPTPRINT STREAM (CONCAT "Starting value of %"" LABEL "%" is "
(fetch (NGTEMPLATE NG.START) of TEMPLATE)
", change it?")
T)
(MENU (create MENU
TITLE ← "Change start?"
CENTERFLG ← T
ITEMS ← '(YES NO)
WHENSELECTEDFN ←(FUNCTION (LAMBDA (ITEM)
(COND
((EQ ITEM 'YES)
(NUMBERPAD.READ (CREATE.NUMBERPAD.READER "Starting NGroup Value"
NIL NIL NIL T)))
(T NIL))))))))
(CHANGE.NGROUP.ADDTOTOC
(LAMBDA (TEMPLATE LABEL STREAM) (* fsg "14-Jan-87 13:17")
(* * Say if this NGroup will/won't be included in the TOC, if any and retrun a possibly new ADD-TO-TOC flag.)
(TEDIT.PROMPTPRINT STREAM (CONCAT "%"" LABEL "%" is " (COND
((fetch (NGTEMPLATE NG.ADDTOTOC) of TEMPLATE)
"")
(T "NOT "))
"included in TOC. Do you want it included?")
T)
(MENU (create MENU
TITLE ← "Include in TOC?"
CENTERFLG ← T
ITEMS ← '(YES NO)
WHENSELECTEDFN ←(FUNCTION (LAMBDA (ITEM)
(CONS ITEM (COND
((EQ ITEM 'YES)
T)
(T NIL)))))))))
(TSP.GET.NGROUP.ARRAY
(LAMBDA (W) (* ss: " 3-Apr-86 18:25")
(WINDOWPROP W 'TSP.NGROUP.ARRAY)))
(TSP.LEGALID
(LAMBDA (NAME NGROUPS STREAM) (* ss: "31-Mar-86 14:23")
(LET ((LEGAL T)
(ID (OR NAME (MKATOM (TEDIT.GETINPUT STREAM "Group name>")))))
(COND
((MEMBER ID NGROUPS)
(TSP.LEGALID (MKATOM (TEDIT.GETINPUT STREAM "Illegal name... Group name>"))
NGROUPS STREAM))
(T ID)))))
)
(* * Number counting functions)
(DEFINEQ
(UPDATE.NUMBEROBJS
(LAMBDA (WINDOW TESTFN TESTFNARG) (* fsg " 3-Feb-87 10:30")
(LET* ((TEXTOBJ (TEXTOBJ WINDOW))
(STREAM (TEXTSTREAM WINDOW))
(NBROBJ.LIST (TSP.LIST.OF.OBJECTS TEXTOBJ TESTFN TESTFNARG)))
(TEDIT.PROMPTPRINT STREAM "Updating Number Group ImageObjects..." T)
(for NUMBEROBJ in NBROBJ.LIST
do (LET* ((OBJECTDATUM (fetch OBJECTDATUM of (CAR NUMBEROBJ)))
(REF.TYPE (fetch REF.TYPE of OBJECTDATUM))
(NUMSTRING (MKATOM (fetch NUMSTRING of OBJECTDATUM)))
(USE (fetch USE of OBJECTDATUM))
(TEMPLATE (SELECTQ USE
(NGROUP (fetch TEMPLATE of OBJECTDATUM))
NIL))
(DEPENDENT.CLASS (GET.MOTHER.GROUP REF.TYPE WINDOW))
NEW.COUNT)
(RESET.DEPENDENT.CLASSES WINDOW USE REF.TYPE)
(SETQ NEW.COUNT (GET.NCOUNTER WINDOW USE REF.TYPE DEPENDENT.CLASS
TEMPLATE))
(COND
((EQ NEW.COUNT NUMSTRING))
(T (replace NUMSTRING of OBJECTDATUM with NEW.COUNT)
(TEDIT.OBJECT.CHANGED STREAM (CAR NUMBEROBJ)))))
finally (REMOVE.ALL.COUNTERS WINDOW))
(TEDIT.PROMPTPRINT STREAM "done"))))
(RESET.DEPENDENT.CLASSES
(LAMBDA (WINDOW USE REF.TYPE) (* fsg "12-Dec-86 10:50")
(for DEPENDENT in (fetch (GRAPHNODE TONODES) of (FIND.NODE REF.TYPE WINDOW))
do (PROGN (RESET.NCOUNTER WINDOW USE DEPENDENT)
(RESET.DEPENDENT.CLASSES WINDOW USE DEPENDENT)))))
(RESET.NCOUNTER
(LAMBDA (WINDOW USE REF.TYPE) (* fsg "12-Dec-86 11:07")
(LET* ((TEMPLATE (SELECTQ USE
(NGROUP (fetch (NUMBEROBJ TEMPLATE)
of (CAR (GETHASH REF.TYPE (TSP.GET.NGROUP.ARRAY
WINDOW)))))
NIL))
(COUNTER (NCOUNTER? WINDOW USE REF.TYPE TEMPLATE)))
(replace NCOUNT of COUNTER with (COND
(TEMPLATE (SUB1 (fetch NG.START of TEMPLATE)))
(T 0))))))
(GET.NCOUNTER
(LAMBDA (WINDOW USE REF.TYPE MOTHER.CLASS TEMPLATE) (* fsg "17-Dec-86 16:33")
(LET ((COUNTER (NCOUNTER? WINDOW USE REF.TYPE TEMPLATE)))
(COND
(COUNTER (PROGN (replace NCOUNT of COUNTER with (ADD1 (fetch NCOUNT
of COUNTER)))
(COND
(MOTHER.CLASS (FLATTEN.TREE.TO.STRING WINDOW USE REF.TYPE))
(T (fetch NCOUNT of COUNTER)))))
(T NIL)))))
(NCOUNTER?
(LAMBDA (WINDOW USE REF.TYPE TEMPLATE) (* fsg "23-Dec-86 09:13")
(* * Return the record for this number counter. If the record doesn't exist, we create one based on the USE value.)
(LET ((COUNTER.ID (MKATOM (CONCAT (SELECTQ USE
(NGROUP REF.TYPE)
USE)
"COUNTER"))))
(OR (WINDOWPROP WINDOW COUNTER.ID)
(PROGN (WINDOWPROP WINDOW COUNTER.ID
(create NGCOUNTER
NCOUNT ←(COND
((AND (EQ USE 'NGROUP)
TEMPLATE)
(SUB1 (fetch NG.START of TEMPLATE)))
(T 0))
ANCESTRY ←(SELECTQ USE
(NGROUP (LIST.ANCESTORS
REF.TYPE NIL
WINDOW))
NIL)))
(WINDOWADDPROP WINDOW 'COUNTERS
COUNTER.ID)
(WINDOWPROP WINDOW COUNTER.ID))))))
(LIST.ANCESTORS
(LAMBDA (NID ANCESTORS WINDOW) (* ss: " 2-Apr-86 16:32")
(LET* ((NODE (FIND.NODE NID WINDOW))
(MOTHER (AND NODE (CAR (fetch (GRAPHNODE FROMNODES) of NODE)))))
(COND
((AND MOTHER (NEQ MOTHER 'NEW.NGROUP))
(LIST.ANCESTORS MOTHER (CONS MOTHER ANCESTORS)
WINDOW))
(T ANCESTORS)))))
(FLATTEN.TREE.TO.STRING
(LAMBDA (WINDOW USE REF.TYPE) (* fsg "17-Dec-86 16:45")
(LET ((NCOUNTER (NCOUNTER? WINDOW USE REF.TYPE))
(FLAT.TREE ""))
(COND
((fetch ANCESTRY of NCOUNTER)
(for (ANCESTOR ANCESTOR.NCOUNT) in (REVERSE (fetch ANCESTRY of NCOUNTER))
do (SETQ ANCESTOR.NCOUNT (fetch NCOUNT of (NCOUNTER? WINDOW USE ANCESTOR)))
(SETQ FLAT.TREE (CONCAT (SELECTQ USE
(NGROUP (NGROUP.CHARTYPE WINDOW
ANCESTOR
ANCESTOR.NCOUNT T))
(CONCAT ANCESTOR.NCOUNT '-))
FLAT.TREE))
finally (SETQ FLAT.TREE
(MKATOM (CONCAT FLAT.TREE
(SELECTQ USE
(NGROUP (NGROUP.CHARTYPE WINDOW REF.TYPE
(fetch NCOUNT
of
NCOUNTER)
NIL))
(fetch NCOUNT of NCOUNTER)))))))
(T (SETQ FLAT.TREE (SELECTQ USE
(NGROUP (NGROUP.CHARTYPE WINDOW REF.TYPE
(fetch NCOUNT of NCOUNTER)
NIL))
(fetch NCOUNT of NCOUNTER)))))
FLAT.TREE)))
(NGROUP.CHARTYPE
(LAMBDA (WINDOW REF.TYPE NCOUNT MORE.FIELDS?) (* fsg "13-Jan-87 15:26")
(* * Convert the number NCOUNT to the format specified in TEMPLATE.)
(LET* ((NBROBJ (CAR (GETHASH REF.TYPE (TSP.GET.NGROUP.ARRAY WINDOW))))
(TEMPLATE (fetch (NUMBEROBJ TEMPLATE) of NBROBJ))
(CHARTYPE (fetch (NGTEMPLATE NG.CHARTYPE) of TEMPLATE)))
(CONCAT (COND
((OR (NOT (NUMBERP NCOUNT))
(ILEQ NCOUNT 0))
"?")
(T (SELECTQ CHARTYPE
(Number (MKSTRING NCOUNT))
(Uppercase% Letter (NUMBER.TO.LETTER NCOUNT T))
(Lowercase% Letter (NUMBER.TO.LETTER NCOUNT))
(Uppercase% Roman (ROMANNUMERALS NCOUNT T))
(Lowercase% Roman (ROMANNUMERALS NCOUNT))
(Null% String "")
NIL)))
(COND
((OR MORE.FIELDS? (EQ (GET.FROMNODES REF.TYPE WINDOW)
'NEW.NGROUP))
(fetch (NGTEMPLATE NG.DELIMIT) of TEMPLATE))
(T ""))))))
(NUMBER.TO.LETTER
(LAMBDA (NUMBER UCFLG) (* fsg " 5-Dec-86 10:18")
(* * Convert NUMBER to equivalent letter code.)
(LET ((LTRLST (MKSTRING (CHARACTER (IPLUS (CHARCODE A)
(IREMAINDER (SUB1 NUMBER)
26)))))
(LTRNBR (IQUOTIENT (SUB1 NUMBER)
26)))
(until (ZEROP LTRNBR)
do (SETQ LTRLST (CONCAT (CHARACTER (SUB1 (IPLUS (CHARCODE A)
(IREMAINDER LTRNBR 26))))
LTRLST))
(SETQ LTRNBR (IQUOTIENT LTRNBR 26)))
(COND
(UCFLG (U-CASE LTRLST))
(T (L-CASE LTRLST))))))
(REMOVE.ALL.COUNTERS
(LAMBDA (WINDOW) (* ss: "30-Sep-85 09:38")
(for COUNTER in (WINDOWPROP WINDOW 'COUNTERS) do (WINDOWPROP WINDOW COUNTER NIL)
finally (WINDOWPROP WINDOW 'COUNTERS
NIL))))
)
(* * Table-of-Contents functions)
(DEFINEQ
(TOC.ENABLED?
(LAMBDA (WINDOW) (* fsg "10-Dec-86 15:40")
(WINDOWPROP WINDOW 'ENABLETOC)))
(GET.TOC.TEXTSTRING
(LAMBDA (NBROBJ STREAM LABEL) (* fsg "14-Jan-87 09:35")
(* * Here if TOC is enabled to get the Table-Of-Contents text string for this NGroup. Because the WRITE.TOC.FILE
function uses a tab to align the page numbers, any tabs in the TOC string are converted to spaces.)
(LET ((TOC.STRING (TEDIT.GETINPUT STREAM (CONCAT "Text for " LABEL ": "))))
(AND TOC.STRING (replace (NUMBEROBJ NUMBER.TEXT) of (fetch OBJECTDATUM of NBROBJ)
with (CONCAT " "
(MKSTRING
(PACK (for TOC.CHAR in (UNPACK TOC.STRING)
collect
(COND
((EQ TOC.CHAR
(CHARACTER (CHARCODE TAB)))
(CHARACTER (CHARCODE SPACE)))
(T TOC.CHAR)))))))))))
(CREATE.TOC.FILE
(LAMBDA (STREAM WINDOW) (* fsg "27-Jan-87 09:32")
(* * Here to print the Table Of Contents. Each Line of the TOC consists of the NGroup, the corresponding text,
followed by the current listing page number.)
(LET* ((TOC.LIST (TSP.LIST.OF.OBJECTS (TEXTOBJ WINDOW)
'NGROUP.NUMBEROBJP))
(TOC.FILE (GET.TOC.FILE (WINDOWPROP WINDOW 'IMAGEOBJ.MENUW)))
(TOC.TABSTOP (LIST 'PARALOOKS
(LIST 'TABS
(LIST NIL (CONS (FIXR (ITIMES 72.27 5.5))
'DOTTEDLEFT)))))
(TOC.STREAM (AND TOC.FILE (OPENTEXTSTREAM NIL NIL NIL NIL TOC.TABSTOP))))
(COND
((AND TOC.LIST TOC.FILE)
(TEDIT.PROMPTPRINT STREAM (CONCAT "Putting Table-Of-Contents in " TOC.FILE "...")
T)
(WRITE.TOC.FILE TOC.STREAM TOC.LIST WINDOW)
(TEDIT.PROMPTPRINT STREAM "done")
(TEDIT.PUT TOC.STREAM TOC.FILE)
TOC.FILE)
(TOC.LIST (TEDIT.PROMPTPRINT STREAM
"Specify a file name for the Table-Of-Contents first."
T)
NIL)
(T (TEDIT.PROMPTPRINT STREAM "There are no NGroups in this document." T)
NIL)))))
(VIEW.TOC.FILE
(LAMBDA (STREAM WINDOW) (* fsg "15-Dec-86 13:48")
(* * Writes out the TOC file via CREATE.TOC.FILE and then opens another TEdit window where this new file is
displayed.)
(LET ((TOC.FILE (CREATE.TOC.FILE STREAM WINDOW))
(TOC.FILEW (WINDOWPROP WINDOW 'TOC.WINDOW)))
(AND TOC.FILE (COND
((WINDOWP TOC.FILEW)
(COND
((OPENWP TOC.FILEW)
(TEDIT.GET (TEXTOBJ TOC.FILEW)
TOC.FILE))
((OPENW TOC.FILEW)
(TEDIT TOC.FILE TOC.FILEW))))
(T (WINDOWPROP WINDOW 'TOC.WINDOW
(SETQ TOC.FILEW (CREATEW NIL (CONCAT "Viewing TOC file: "
TOC.FILE))))
(TEDIT TOC.FILE TOC.FILEW)))))))
(GET.TOC.FILE
(LAMBDA (MENUW) (* fsg "11-Dec-86 10:27")
(* * Return the user specified Table-Of-Contents file name.)
(LET* ((ITEM (FM.ITEMFROMID MENUW 'TOC.FILE))
(TOC.FILENAME (FM.ITEMPROP ITEM 'LABEL)))
(COND
((NOT (STREQUAL TOC.FILENAME ""))
(MKATOM TOC.FILENAME))
(T NIL)))))
(WRITE.TOC.FILE
(LAMBDA (TOC.STREAM TOC.LIST WINDOW) (* fsg "28-Jan-87 13:27")
(* * Here to do the actual output to the TOC file.)
(DSPFONT (FONTCREATE '(HELVETICA 14 BRR))
TOC.STREAM)
(PRINTOUT TOC.STREAM "Table of Contents" T)
(for (TOC.ITEM OBJECTDATUM ITEM.LEVEL) in TOC.LIST
when (fetch (NGTEMPLATE NG.ADDTOTOC) of (fetch (NUMBEROBJ TEMPLATE)
of (fetch OBJECTDATUM
of (CAR TOC.ITEM))))
do (SETQ OBJECTDATUM (fetch OBJECTDATUM of (CAR TOC.ITEM)))
(DSPFONT (fetch (NUMBEROBJ FONT) of OBJECTDATUM)
TOC.STREAM)
(SETQ ITEM.LEVEL (LENGTH (LIST.ANCESTORS (fetch (NUMBEROBJ REF.TYPE)
of OBJECTDATUM)
NIL WINDOW)))
(COND
((ZEROP ITEM.LEVEL)
(PRINTOUT TOC.STREAM T T))
(T (RPTQ ITEM.LEVEL (PRINTOUT TOC.STREAM " "))))
(PRINTOUT TOC.STREAM (CONCAT (fetch (NUMBEROBJ NUMSTRING) of OBJECTDATUM)
(OR (fetch (NUMBEROBJ NUMBER.TEXT) of OBJECTDATUM)
"")))
(DSPFONT GP.DefaultFont TOC.STREAM)
(PRINTOUT TOC.STREAM (CHARACTER (CHARCODE TAB))
(fetch (NUMBEROBJ PAGE.NUMBER) of OBJECTDATUM)
T)
(AND (ZEROP ITEM.LEVEL)
(PRINTOUT TOC.STREAM T)))))
)
[DECLARE: EVAL@COMPILE
(RECORD NGCOUNTER (NCOUNT . ANCESTRY))
(RECORD NGTEMPLATE (NG.CHARTYPE NG.DELIMIT NG.START NG.ADDTOTOC))
(RECORD NUMBEROBJ (REF.TYPE NUMSTRING USE NGROUP.MOTHER TEMPLATE LINK.TO NUMBER.TEXT PAGE.NUMBER
FONT))
]
(PUTPROPS NGROUP COPYRIGHT ("Leland Stanford Junior University" 1987))
(DECLARE: DONTCOPY
(FILEMAP (NIL (1963 10804 (NUMBEROBJ 1975 . 2986) (NUMBEROBJP 2990 . 3368) (NGROUP.NUMBEROBJP 3372 .
3711) (NUMBER.DISPLAYFN 3715 . 5774) (NUMBER.IMAGEBOXFN 5778 . 7273) (NUMBER.PUTFN 7277 . 8430) (
NUMBER.GETFN 8434 . 10290) (NUMBER.BUTTONEVENTINFN 10294 . 10801)) (10806 11877 (
NGROUP.BUTTONEVENTINFN 10818 . 11322) (NGROUP.WHENSELECTEDFN 11326 . 11874)) (11922 18225 (GRAPHMENU
11934 . 13037) (TSP.NGROUP.GRAPHP 13041 . 13313) (INITIAL.NGROUP.GRAPH 13317 . 13924) (TSPGRAPHREGION
13928 . 14408) (ADD.NGROUP.TO.MOTHER.NODE 14412 . 14788) (ADD.NODE.TO.GRAPH 14792 . 15593) (
COLLECT.HASHARRAY 15597 . 15845) (CREATE.NGROUP.NODE 15849 . 16377) (GET.FROMNODES 16381 . 16577) (
GET.MOTHER.GROUP 16581 . 16785) (MAKE.MOTHER.NODE 16789 . 17307) (MAKE.NGROUP.NODELST 17311 . 17848) (
GET.TONODES 17852 . 18042) (FIND.NODE 18046 . 18222)) (18266 31833 (INSERT.NGROUP 18278 . 19721) (
VERIFY.NGROUP.ORDER 19725 . 21385) (ADD.NUMBER.GROUP 21389 . 22799) (ADD.NGROUP.TO.DBASE 22803 . 23454
) (COLLECT.NGROUPS 23458 . 23884) (LIST.FONT.PROPS 23888 . 24139) (MAP.NGROUP.LOOKS 24143 . 24833) (
NGROUP.GETFONT 24837 . 25067) (CHANGE.NGROUP 25071 . 25812) (CHANGE.NGROUP.FONT 25816 . 26765) (
CHANGE.NGROUP.FORMAT 26769 . 28318) (CHANGE.NGROUP.CHARTYPE 28322 . 28949) (CHANGE.NGROUP.DELIMIT
28953 . 29755) (CHANGE.NGROUP.START 29759 . 30503) (CHANGE.NGROUP.ADDTOTOC 30507 . 31267) (
TSP.GET.NGROUP.ARRAY 31271 . 31432) (TSP.LEGALID 31436 . 31830)) (31875 39290 (UPDATE.NUMBEROBJS 31887
. 33206) (RESET.DEPENDENT.CLASSES 33210 . 33563) (RESET.NCOUNTER 33567 . 34089) (GET.NCOUNTER 34093
. 34583) (NCOUNTER? 34587 . 35516) (LIST.ANCESTORS 35520 . 35938) (FLATTEN.TREE.TO.STRING 35942 .
37182) (NGROUP.CHARTYPE 37186 . 38274) (NUMBER.TO.LETTER 38278 . 38989) (REMOVE.ALL.COUNTERS 38993 .
39287)) (39334 44416 (TOC.ENABLED? 39346 . 39497) (GET.TOC.TEXTSTRING 39501 . 40412) (CREATE.TOC.FILE
40416 . 41696) (VIEW.TOC.FILE 41700 . 42519) (GET.TOC.FILE 42523 . 42942) (WRITE.TOC.FILE 42946 .
44413)))))
STOP