github.com/Interlisp.medley
1
0
Fork 0
mirror of synced 2026-02-06 08:45:04 +00:00
Code Issues Projects Releases Wiki Activity

Rmk31 Move all TMAX* files to TMAX>TMAX* (#750)

Browse Source 
* 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.

* Move TMAX files to TMAX>

Given the WHEREIS change for GETFN and the FINDFILE-WITH-EXTENSIONS in SPELLFILE, TEDIT(TMAX.TEDIT) opens and all of its imageobjects are found and loaded from the TMAX> files.

* Push relocated files again:  (COPYFILES screwed up)

* Delete TMAX.INDEX   garbage file
This commit is contained in:
rmkaplan
2022-04-23 21:36:23 -07:00
committed by GitHub
parent f9f1038efb
commit 1eccc2e59b
37 changed files with 821 additions and 773 deletions
Download Patch File Download Diff File Expand all files Collapse all files

128
lispusers/TMAX → lispusers/TMAX/TMAX
View File

@@ -1,13 +1,11 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "24-Oct-2021 23:45:20" 
{DSK}<Users>kaplan>Local>medley3.5>git-medley>lispusers>TMAX.;4 31402
(FILECREATED "17-Mar-2022 23:12:47" {DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>TMAX.;3 25981
changes to%: (VARS TMAXCOMS)
(FNS GET.TSP.FONT.FAMILY)
:CHANGES-TO (VARS TMAXCOMS)
previous date%: "24-Oct-2021 22:06:32"
{DSK}<Users>kaplan>Local>medley3.5>git-medley>lispusers>TMAX.;2)
:PREVIOUS-DATE "24-Oct-2021 23:45:20"
{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>TMAX.;2)
(* ; "
@@ -18,9 +16,9 @@ Copyright (c) 1987, 1997, 1999 by Stanford University.
(RPAQQ TMAXCOMS
( (* ;
 "Developed under support from NIH grant RR-00785.")
 "Developed under support from NIH grant RR-00785.")
(* ;
 "Written by Frank Gilmurray and Sami Shaio.")
 "Written by Frank Gilmurray and Sami Shaio.")
(FILES (COMPILED SYSLOAD)
TEDIT FREEMENU)
(VARS TMAX.FILE.LIST)
@@ -59,18 +57,8 @@ Copyright (c) 1987, 1997, 1999 by Stanford University.
(FNS TSP.LIST.OF.OBJECTS)
(GLOBALVARS GP.DefaultFont GP.DefaultShade)
(MACROS MAKE.DATEOBJ.IMAGEFNS MAKE.NUMBEROBJ.IMAGEFNS MAKE.REGMARKOBJ.IMAGEFNS
MAKE.XREFOBJ.IMAGEFNS)
(VARS (GP.DefaultFont (FONTCREATE 'TERMINAL 10))
(GP.DefaultShade 1024)
(\NUMBEROBJ.IMAGEFNS (MAKE.NUMBEROBJ.IMAGEFNS))
(\DATEOBJ.IMAGEFNS (MAKE.DATEOBJ.IMAGEFNS))
(\REGMARKOBJ.IMAGEFNS (MAKE.REGMARKOBJ.IMAGEFNS))
(\XREFOBJ.IMAGEFNS (MAKE.XREFOBJ.IMAGEFNS)))
(ADDVARS (IMAGEOBJGETFNS (DATE.GETFN)
(NUMBER.GETFN)
(REGMARK.GETFN)
(XREF.GETFN)))
(GP.DefaultShade 1024))
(P [TEDIT.ADD.MENUITEM TEDIT.DEFAULT.MENU '(TMAX% Menu (FUNCTION TSP.DISPLAY.FMMENU)
NIL
(SUBITEMS (Update [FUNCTION
@@ -106,7 +94,7 @@ Copyright (c) 1987, 1997, 1999 by Stanford University.
TEDIT FREEMENU)
(RPAQQ TMAX.FILE.LIST (TMAX-DATE TMAX-ENDNOTE TMAX-INDEX TMAX-NUMBER TMAX-NGRAPH TMAX-NGROUP
TMAX-XREF))
TMAX-XREF))
(DECLARE%: DONTCOPY
(DOFILESLOAD (LIST* '(SOURCE)
@@ -552,92 +540,16 @@ Copyright (c) 1987, 1997, 1999 by Stanford University.
(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.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 NUMBER.PREPRINTFN])
(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 XREF.GET.DISPLAY.TEXT])
)
(RPAQ GP.DefaultFont (FONTCREATE 'TERMINAL 10))
(RPAQQ GP.DefaultShade 1024)
(RPAQ \NUMBEROBJ.IMAGEFNS (MAKE.NUMBEROBJ.IMAGEFNS))
(RPAQ \DATEOBJ.IMAGEFNS (MAKE.DATEOBJ.IMAGEFNS))
(RPAQ \REGMARKOBJ.IMAGEFNS (MAKE.REGMARKOBJ.IMAGEFNS))
(RPAQ \XREFOBJ.IMAGEFNS (MAKE.XREFOBJ.IMAGEFNS))
(ADDTOVAR IMAGEOBJGETFNS (DATE.GETFN)
(NUMBER.GETFN)
(REGMARK.GETFN)
(XREF.GETFN))
[TEDIT.ADD.MENUITEM TEDIT.DEFAULT.MENU '(TMAX% Menu (FUNCTION TSP.DISPLAY.FMMENU)
NIL
(SUBITEMS (Update [FUNCTION (LAMBDA (TEXTSTREAM)
(UPDATE.ALL
TEXTSTREAM
(\TEDIT.MAINW
(UPDATE.ALL TEXTSTREAM
(\TEDIT.MAINW
TEXTSTREAM]
"Updates all cross-references")
(NGroup% Menu [FUNCTION (LAMBDA (TEXTSTREAM)
@@ -650,14 +562,14 @@ Copyright (c) 1987, 1997, 1999 by Stanford University.
(TSP.FUNCTION.HOOKS)
(PUTPROPS TMAX COPYRIGHT ("Stanford University" 1987 1997 1999))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (8815 16030 (TSP.DISPLAY.FMMENU 8825 . 9390) (TSP.SETUP.FILENAMES 9392 . 10643) (
TSP.SETUP.FMMENU 10645 . 11105) (TSP.FMMENU 11107 . 12293) (TSP.FM.APPLY 12295 . 12614) (UPDATE.ALL
12616 . 13288) (DOWNDATE.ALL 13290 . 13660) (TSP.FUNCTION.HOOKS 13662 . 15092) (TSP.GETFN 15094 .
15654) (TSP.PUTFN 15656 . 16028)) (16076 18325 (AutoUpdate.TOGGLE 16086 . 16322) (UPDATE? 16324 .
16469) (NGROUP.Menu.TOGGLE 16471 . 16853) (NGROUPMENU.ENABLED? 16855 . 17091) (
NGROUP.Text-Before.TOGGLE 17093 . 17343) (TEXTBEFORE.ENABLED? 17345 . 17508) (NGROUP.Text-After.TOGGLE
17510 . 17758) (TEXTAFTER.ENABLED? 17760 . 17921) (Manual.Index.TOGGLE 17923 . 18162) (
MANUALINDEX.ENABLED? 18164 . 18323)) (18359 23832 (GET.TSP.FONT 18369 . 19533) (GET.TSP.FONT.FAMILY
19535 . 20383) (GET.TSP.FONT.SIZE 20385 . 20873) (GET.TSP.FONT.FACE 20875 . 21574) (ABBREVIATE.FONT
21576 . 23076) (TMAX.SHADEOBJ 23078 . 23830)) (23872 25088 (TSP.LIST.OF.OBJECTS 23882 . 25086)))))
(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

363
lispusers/TMAX/TMAX-DATE Normal file
View File

@@ -0,0 +1,363 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10)
(FILECREATED "17-Mar-2022 23:03:32" 
|{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>TMAX-DATE.;3| 14993
:CHANGES-TO (VARS TMAX-DATECOMS)
(FNS MAKE.DATEOBJ.IMAGEFNS)
:PREVIOUS-DATE "24-Oct-2021 13:52:22"
|{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>TMAX-DATE.;2|)
; Copyright (c) 1987-1988 by Xerox Corporation.
(PRETTYCOMPRINT TMAX-DATECOMS)
(RPAQQ TMAX-DATECOMS
(
(* |;;| "Developed under support from NIH grant RR-00785. Written by Frank Gilmurray and Sami Shaio. Updated by Ron Kaplan (2021)")
(* |;;;| "TMAX-DATE ImageObject functions")
(FNS DATEOBJ DATEOBJP DATE.DISPLAYFN DATE.IMAGEBOXFN DATE.PUTFN DATE.GETFN DATE.COPYFN
DATE.BUTTONEVENTINFN)
(* |;;;| "Date support functions")
(FNS CURRENT.DISPLAY.FONT CHANGE.DATE.FORMAT)
(* |;;;| "Functions to change date format")
(FNS FINDTIME FINDHOUR AMPM FINDDAY NUMP FINDMONTH FINDYEAR)
(VARS DATE.FORMAT.ITEMS)
(FNS MAKE.DATEOBJ.IMAGEFNS)
(INITVARS (\\DATEOBJ.IMAGEFNS (MAKE.DATEOBJ.IMAGEFNS)))
(ADDVARS (IMAGEOBJGETFNS (DATE.GETFN)))
(DECLARE\: DOEVAL@COMPILE DONTCOPY (RECORDS DATERECORD))))
(* |;;|
"Developed under support from NIH grant RR-00785. Written by Frank Gilmurray and Sami Shaio. Updated by Ron Kaplan (2021)"
)
(* |;;;| "TMAX-DATE ImageObject functions")
(DEFINEQ
(dateobj
(lambda (date/time date.string template) (* |fsg| "13-Jul-87 11:51")
(* * |Create| |an| |instance| |of| \a date |imageobj.|)
(let* ((template.type (or template '(m d y f)))
(dateandtime (or date/time (mkstring (date))))
(displaydate (or date.string (change.date.format dateandtime template.type)))
(newobj (imageobjcreate (|create| daterecord
datestring _ dateandtime
display.date _ displaydate
template.date _ template.type)
\\dateobj.imagefns)))
(imageobjprop newobj 'type 'dateobj)
newobj)))
(dateobjp
(lambda (imobj) (* |ss:| "27-Jun-87 15:39")
(* |Tests| |an| |imageobj| |to| |see| |if| |it| |is| \a |date| |imageobject.|
 b\y |convention,| |testing| |functions| |for| |an| |imageobject| |will| |be|
 |named| (concat |<type| |of| |imageobj>| "P"))
(and imobj (eq (imageobjprop imobj 'type)
'dateobj))))
(date.displayfn
(lambda (obj stream streamtype hoststream) (* |fsg| "17-Sep-87 10:44")
(* * |Display| |function| |for| |date| |imageobjs.|)
(tmax.shadeobj obj stream)
(prin1 (|fetch| display.date |of| (|fetch| objectdatum |of| obj))
stream)))
(date.imageboxfn
(lambda (obj stream currentx rightmargin) (* |ss:| "27-Jun-87 15:38")
(* * |Return| |the| |ImageBox| |for| |the| |date| |string.|
 |The| |size| |is| |determined| |by| |the| |stream's| |current| |font.|)
(dspfont (current.display.font stream)
stream)
(|create| imagebox
xsize _ (stringwidth (|fetch| display.date |of| (|fetch| objectdatum |of| obj))
stream)
ysize _ (fontprop stream 'height)
ydesc _ (fontprop stream 'descent)
xkern _ 0)))
(date.putfn
(lambda (obj stream) (* |ss:| "27-Jun-87 15:38")
(prin2 (list '|Date| (|fetch| objectdatum |of| obj))
stream)))
(date.getfn
(lambda (stream copy.object) (* |fsg| "20-Aug-87 14:56")
(let ((window (|with| textobj textobj (car \\window))))
(tsp.setup.fmmenu window))
(apply (function dateobj)
(or copy.object (cadr (read stream))))))
(date.copyfn
(lambda (image.obj source.stream target.stream) (* |fsg| "23-Jul-87 11:34")
(* * |Here| |to| copy \a |Date| |Image| |Object.|)
(selectq (imagestreamtype target.stream)
(text (let ((textobj (textobj target.stream)))
(apply* (imageobjprop image.obj 'getfn)
target.stream
(|fetch| objectdatum |of| image.obj))))
(error "Unknown TARGET stream type" (imagestreamtype target.stream)))))
(date.buttoneventinfn
(lambda (obj windowstream selection relx rely window hoststream button)
(* |fsg| "11-Aug-87 13:56")
(and (mousestate middle)
(let ((old.date (|fetch| objectdatum |of| obj))
(new.date (menu (|create| menu
title _ '|Date/Time Menu|
items _ date.format.items
centerflg _ t))))
(and new.date (not (equal (|fetch| (daterecord template.date) |of| old.date)
new.date))
(progn (|with| daterecord old.date (cond
((listp new.date)
(setq display.date (change.date.format
datestring new.date))
(setq template.date new.date))
(t (setq datestring (mkstring (date)))
(setq display.date (change.date.format
datestring
template.date)))))
'changed))))))
)
(* |;;;| "Date support functions")
(DEFINEQ
(current.display.font
(lambda (stream) (* \; "Edited 12-Mar-88 15:28 by drc:")
(* |;;;| "Return the current font. This function is here instead of TMAX because the DATE code is also used in the LetterHead code.")
(let ((current.font (|fetch| clfont |of| (|with| textstream (textstream textobj)
currentlooks))))
(cond
((typenamep current.font 'fontdescriptor)
current.font)
((typenamep current.font 'fontclass)
(|fetch| displayfd |of| current.font))
(t (shouldnt "Can't get current font"))))))
(CHANGE.DATE.FORMAT
(LAMBDA (DATE TEMPLATE) (* \;
 "Edited 24-Oct-2021 13:47 by rmk:")
(* |ss:| "27-Jun-87 15:36")
(* |;;;| "Convert the string DATE to the format specified by TEMPLATE.")
(COND
(TEMPLATE (LET ((VERSION (SELECTQ (CAR (LAST TEMPLATE))
(A 'ABBREV)
(F 'FULL)
'EURO))
(FUNCLST '((D FINDDAY)
(M FINDMONTH)
(Y FINDYEAR))))
(COND
((EQ T (CAR TEMPLATE))
(FINDTIME DATE VERSION))
(T (LET ((CH (|if| (EQ VERSION 'ABBREV)
|then| "/"
|else| " ")))
(CONCAT (APPLY (CADR (ASSOC (CAR TEMPLATE)
FUNCLST))
(LIST DATE VERSION))
CH
(APPLY (CADR (ASSOC (CADR TEMPLATE)
FUNCLST))
(LIST DATE VERSION))
(|if| (EQUAL CH " ")
|then| ", "
|else| CH)
(APPLY (CADR (ASSOC (CADDR TEMPLATE)
FUNCLST))
(LIST DATE VERSION))))))))
(T (DATE)))))
)
(* |;;;| "Functions to change date format")
(DEFINEQ
(FINDTIME
(LAMBDA (OLDDATE VERSION) (* \;
 "Edited 24-Oct-2021 13:28 by rmk:")
(* |;;|
 "RMK: The spell-out default is very strange: it rounds the minutes to the nearest half hour.")
(* |;;| "RMK: Correct for Y2K: Substrings then work. Still, terrible code.")
(* |ss:| "27-Jun-87 15:40")
(LET* ((UDATE (\\UNPACKDATE (IDATE OLDDATE)))
(HOUR (CAR (NTH UDATE 4)))
(MINUTES (CAR (NTH UDATE 5))))
(SELECTQ VERSION
(ABBREV (CONCAT (FINDHOUR HOUR)
":" MINUTES " " (AMPM HOUR)))
(EURO (SUBSTRING OLDDATE 13 17))
(CONCAT (SELECTQ (|if| (LESSP MINUTES 46)
|then| (FINDHOUR HOUR)
|else| (PLUS 1 (FINDHOUR HOUR)))
(1 "one")
(2 "two")
(3 "three")
(4 "four")
(5 "five")
(6 "six")
(7 "seven")
(8 "eight")
(9 "nine")
(10 "ten")
(11 "eleven")
(12 "twelve")
NIL)
" "
(|if| (AND (GREATERP MINUTES 15)
(LESSP MINUTES 45))
|then| "thirty"
|else| "o'clock")
" "
(AMPM HOUR))))))
(FINDHOUR
(LAMBDA (HOUR) (* \;
 "Edited 24-Oct-2021 13:35 by rmk:")
(* |ss:| " 8-Feb-86 17:49")
(COND
((LESSP HOUR 13)
HOUR)
(T (IDIFFERENCE HOUR 12)))))
(AMPM
(LAMBDA (HOUR) (* \;
 "Edited 24-Oct-2021 13:37 by rmk:")
(|if| (OR (LESSP HOUR 12)
(EQ HOUR 24))
|then| "a.m."
|else| "p.m.")))
(findday
(lambda (olddate version) (* |shw:| " 1-Jul-85 11:28")
(mkatom (|if| (nump (substring olddate 1 2))
|then| (substring olddate 1 2)
|else| (substring olddate 2 2)))))
(nump
(lambda (n) (* |edited:| " 4-Apr-86 17:55")
(* |changed|)
(not (null (numberp (mkatom n))))))
(FINDMONTH
(LAMBDA (OLDDATE VERSION) (* \;
 "Edited 24-Oct-2021 13:52 by rmk:")
(* |ss:| "27-Jun-87 15:40")
(* |;;| "\\UNPACKDATE uses 0 origin for months")
(LET ((MONTH (ASSOC (ADD1 (CAR (NTH (\\UNPACKDATE (IDATE OLDDATE))
2)))
'((1 |Jan| |January|)
(2 |Feb| |February|)
(3 |Mar| |March|)
(4 |Apr| |April|)
(5 |May| |May|)
(6 |Jun| |June|)
(7 |Jul| |July|)
(8 |Aug| |August|)
(9 |Sep| |September|)
(10 |Oct| |October|)
(11 |Nov| |November|)
(12 |DecDecember|)))))
(|if| (EQ VERSION 'ABBREV)
|then| (CADR MONTH)
|else| (CADDR MONTH)))))
(FINDYEAR
(LAMBDA (OLDDATE VERSION) (* \;
 "Edited 24-Oct-2021 13:48 by rmk:")
(* |ss:| "27-Jun-87 15:41")
(CAR (\\UNPACKDATE (IDATE OLDDATE)))))
)
(RPAQQ DATE.FORMAT.ITEMS
((|Month Day, Year| '(M D Y F)
"Insert current date as \"March 8, 1952\"")
(|Month/Day/Year| '(M D Y A)
"Insert current date as \"3/8/52\"")
(|Day Month, Year| '(D M Y F)
"Insert current date as \"8 March, 1952\"")
(|Day/Month/Year| '(D M Y A)
"Insert current date as \"8/3/52\"")
(|Time| '(T F)
"Insert current time as \"four thirty p.m.\"")
(|Numbered Time| '(T A)
"Insert current time as \"4:30 p.m.\"")
(|Military Time| '(T E)
"Insert current time as \"16:30\"")
(|Update| T "Convert to current date/time")))
(DEFINEQ
(MAKE.DATEOBJ.IMAGEFNS
(LAMBDA NIL (* \; "Edited 17-Mar-2022 23:03 by rmk")
(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))))
)
(RPAQ? \\DATEOBJ.IMAGEFNS (MAKE.DATEOBJ.IMAGEFNS))
(ADDTOVAR IMAGEOBJGETFNS (DATE.GETFN))
(DECLARE\: DOEVAL@COMPILE DONTCOPY
(DECLARE\: EVAL@COMPILE
(RECORD DATERECORD (DATESTRING DISPLAY.DATE TEMPLATE.DATE))
)
)
(PUTPROPS TMAX-DATE COPYRIGHT ("Xerox Corporation" 1987 1988))
(DECLARE\: DONTCOPY
(FILEMAP (NIL (1517 6251 (DATEOBJ 1527 . 2294) (DATEOBJP 2296 . 2730) (DATE.DISPLAYFN 2732 . 3054) (
DATE.IMAGEBOXFN 3056 . 3683) (DATE.PUTFN 3685 . 3883) (DATE.GETFN 3885 . 4179) (DATE.COPYFN 4181 .
4713) (DATE.BUTTONEVENTINFN 4715 . 6249)) (6295 8948 (CURRENT.DISPLAY.FONT 6305 . 7011) (
CHANGE.DATE.FORMAT 7013 . 8946)) (9001 13400 (FINDTIME 9011 . 10790) (FINDHOUR 10792 . 11153) (AMPM
11155 . 11454) (FINDDAY 11456 . 11727) (NUMP 11729 . 11958) (FINDMONTH 11960 . 13076) (FINDYEAR 13078
. 13398)) (14112 14678 (MAKE.DATEOBJ.IMAGEFNS 14122 . 14676)))))
STOP

BIN
lispusers/TMAX/TMAX-DATE.LCOM Normal file
View File

Binary file not shown.

457
lispusers/TMAX/TMAX-ENDNOTE Normal file
View File

@@ -0,0 +1,457 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10)
(FILECREATED "18-Mar-2022 07:12:34" 
|{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>TMAX-ENDNOTE.;4| 23444
:CHANGES-TO (VARS TMAX-ENDNOTECOMS)
:PREVIOUS-DATE "17-Mar-2022 23:10:26"
|{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>TMAX-ENDNOTE.;2|)
; Copyright (c) 1987 by Xerox Corporation.
(PRETTYCOMPRINT TMAX-ENDNOTECOMS)
(RPAQQ TMAX-ENDNOTECOMS
((* |Developed| |under| |support| |from| NIH |grant| RR-00785.)
(* |Written| |by| |Frank| |Gilmurray| |and| |Sami| |Shaio.|)
(FNS ADD.ENDNOTE INSERT.ENDNOTES INSERT.ENDNOTES.TEXT DELETE.ENDNOTES NOTESREGIONP
SET.ENDNOTE.STYLE MAP.ENDNOTE.LOOKS GET.ENDNOTE.FONTS)
(FNS ENDNOTEP NOTE.PUTFN NOTE.GETFN NOTE.BUTTONEVENTINFN NOTE.WHENSELECTEDFN)
(VARS ENDNOTE.NOTAG.ITEMS ENDNOTE.TAG.ITEMS)
(DECLARE\: EVAL@COMPILE DONTCOPY (RECORDS ENDNOTEFONTS))
(* * |Allow| |user| |to| |edit| |Endnote| |text| |in| |another| |TEdit| |window.|)
(FNS AUX.TEDIT AUX.TEDIT.AFTERQUITFN AUX.TEDIT.TITLEMENUFN)
(* * |Delimit| |text| |between| |two| |markers| |known| |as| REGION MARKERS.)
(FNS REGMARKOBJ REGMARKOBJP REGMARK.DISPLAYFN REGMARK.IMAGEBOXFN REGMARK.PUTFN REGMARK.GETFN
REGMARK.COPYFN REGMARK.BUTTONEVENTINFN)
(INITVARS (\\REGMARKOBJ.IMAGEFNS (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))))
(DECLARE\: EVAL@COMPILE DONTCOPY (RECORDS REGMARKOBJ))))
(* |Developed| |under| |support| |from| NIH |grant| RR-00785.)
(* |Written| |by| |Frank| |Gilmurray| |and| |Sami| |Shaio.|)
(DEFINEQ
(add.endnote
(lambda (stream window) (* |fsg| "13-Jul-87 10:44")
(* * |Insert| |an| endnote |ImageObject| |as| \a |superscript.|
 |Displayed| |as| \a |number| |when| |updated.|)
(let ((noteobj (numberobj 'note)))
(tedit.insert.object noteobj stream)
(|replace| (numberobj text.after#) |of| (|fetch| objectdatum |of| noteobj)
|with| (or (tedit.getinput stream "Endnote text:")
""))
(tedit.promptprint stream "" t)
(and (update? window)
(update.numberobjs window stream 'endnotep)))))
(insert.endnotes
(lambda (stream window) (* |fsg| "25-Sep-87 10:23")
(* * |Inserts| |text| |of| |endnotes| |at| |the| |end| |of| |the| |TEdit|
 |document.| |The| |text| |is| |inserted| |between| |two| |Region| |marking|
 |imageobjs.|)
(let ((textobj (textobj stream))
list.of.endnotes)
(and (setq list.of.endnotes (tsp.list.of.objects textobj 'endnotep))
(let ((caretposition (|fetch| ch# |of| (tedit.getsel stream))))
(tedit.promptprint stream (concat (cond
((delete.endnotes stream)
"Rei")
(t "I"))
"nserting Endnotes...")
t)
(tedit.insert.object (regmarkobj 'endnotes '|Endnotes-START|)
stream
(add1 (|fetch| textlen |of| textobj)))
(tedit.looks stream '(protected on) (|fetch| textlen |of| textobj)
1)
(tedit.insert stream (concat (character (charcode eol))
"Notes"
(character (charcode eol)))
(add1 (|fetch| textlen |of| textobj))
(|fetch| (endnotefonts title.font) |of| (get.endnote.fonts window))
t)
(insert.endnotes.text stream window textobj list.of.endnotes)
(tedit.insert.object (regmarkobj 'endnotes '|Endnotes-END|)
stream
(add1 (|fetch| textlen |of| textobj)))
(tedit.looks stream '(protected on) (|fetch| textlen |of| textobj)
1)
(tedit.promptprint stream "done")
(tedit.normalizecaret textobj (tedit.setsel stream caretposition 1)))))))
(insert.endnotes.text
(lambda (stream window textobj list.of.endnotes) (* |fsg| "18-Jun-87 13:17")
(* * |Here| |to| |print| |the| |text| |of| |each| |endnote.|)
(let ((textlooks (|fetch| (endnotefonts text.font) |of| (get.endnote.fonts window)))
(numblooks (|fetch| (endnotefonts number.font) |of| (get.endnote.fonts window))))
(|for| endnoteobj |in| list.of.endnotes
|do| (let ((numstring (mkstring (|fetch| (numberobj numstring) |of| (|fetch| objectdatum
|of| (car
endnoteobj
)))))
(text (|fetch| (numberobj text.after#) |of| (|fetch| objectdatum
|of| (car endnoteobj)))))
(tedit.insert stream numstring (add1 (|fetch| textlen |of| textobj))
numblooks t)
(tedit.insert stream (concat " " text (character (charcode eol)))
(add1 (|fetch| textlen |of| textobj))
textlooks t))))))
(delete.endnotes
(lambda (stream) (* |fsg| "25-Sep-87 10:12")
(* * |Delete| |the| |Endnotes,| |i.e.| |delete| |the| |start/end| regmark
 |ImageObjects| |and| |all| |the| |text| |between| |them.|)
(let* ((textobj (textobj stream))
(notemarker.list (tsp.list.of.objects textobj 'notesregionp))
(notes.start (cadar notemarker.list))
(notes.end (cadadr notemarker.list)))
(and notes.start notes.end (progn (tedit.promptprint stream "Deleting Endnotes..." t)
(tedit.delete stream notes.start (idifference
(add1 notes.end)
notes.start))
(tedit.promptprint stream "done")
t)))))
(notesregionp
(lambda (imobj) (* |ss:| "27-Jun-87 15:29")
(and (regmarkobjp imobj)
(eq (|fetch| region.use |of| (|fetch| objectdatum |of| imobj))
'endnotes))))
(set.endnote.style
(lambda (stream window) (* |fsg| "18-Aug-87 14:13")
(* * |Set| |the| |font| |of| |the| endnote |number,| |title,| |or| |text.|)
(let ((note.fonts (get.endnote.fonts window))
(note.type (menu (|create| menu
title _ "Endnote Fonts"
centerflg _ t
items _ '(|Number| |Title| |Text|))))
old.font new.font)
(and note.type (progn (setq old.font (selectq note.type
(|Number| (|fetch| (endnotefonts number.font)
|of| note.fonts))
(|Title| (|fetch| (endnotefonts title.font)
|of| note.fonts))
(|Text| (|fetch| (endnotefonts text.font)
|of| note.fonts))
nil))
(tedit.promptprint stream (concat "Change Endnote " note.type " font "
(abbreviate.font old.font)
" to...")
t)
(setq new.font (fontcreate (get.tsp.font window old.font)))
(cond
((neq old.font new.font)
(selectq note.type
(|Number| (|replace| (endnotefonts number.font) |of|
note.fonts
|with| new.font))
(|Title| (|replace| (endnotefonts title.font) |of| note.fonts
|with| new.font))
(|Text| (|replace| (endnotefonts text.font) |of| note.fonts
|with| new.font))
nil)
(and (eq note.type '|Number|)
(map.endnote.looks stream new.font)))
(t nil))
(tedit.promptprint stream "" t))))))
(map.endnote.looks
(lambda (stream numberfont) (* |ss:| "27-Jun-87 15:26")
(* * |Here| |to| |update| |the| endnote |looks.|
 |Only| |the| endnote |superscript| |numbers| |are| |updated.|)
(let ((list.of.notes (tsp.list.of.objects (textobj stream)
'endnotep)))
(and list.of.notes (progn (tedit.promptprint stream "Updating ENDNOTE Number looks..." t)
(|for| note/ch# |in| list.of.notes
|do| (tedit.looks stream numberfont (cadr note/ch#)
1))
(tedit.promptprint stream "done"))))))
(get.endnote.fonts
(lambda (window) (* |ss:| "27-Jun-87 15:24")
(* * |Setup| |the| |default| endnote |fonts| |for| |number,| |title,| |and|
 |text.|)
(or (windowprop window 'endnote.fonts)
(progn (windowprop window 'endnote.fonts
(|create| endnotefonts
number.font _ |GP.DefaultFont|
title.font _ |GP.DefaultFont|
text.font _ |GP.DefaultFont|))
(windowprop window 'endnote.fonts)))))
)
(DEFINEQ
(endnotep
(lambda (imobj) (* |ss:| "27-Jun-87 15:23")
(* * |Like| numberobjp |but| |also| |checks| |for| note |ImageObject.|)
(and (numberobjp imobj)
(eq (|fetch| (numberobj use) |of| (|fetch| objectdatum |of| imobj))
'note))))
(note.putfn
(lambda (numberobj stream window) (* |fsg| "11-Aug-87 10:04")
(* * |Used| |to| |put| \a |numberobj| |that| |is| |functioning| |as| |an|
 |endnote.|)
(|with| numberobj (|fetch| objectdatum |of| numberobj)
(setq font (|for| notefont |in| (get.endnote.fonts window) |collect| (list.font.props
notefont))))
(prin4 (list '|Endnote| nil (imageobjprop numberobj 'tag)
(|fetch| objectdatum |of| numberobj))
stream)))
(note.getfn
(lambda (newobj note.datum window) (* |fsg| "16-Jul-87 10:49")
(* * |Used| |to| |get| \a |numberobj| |that| |is| |functioning| |as| |an|
 |endnote.|)
(windowprop window 'endnote.fonts (|for| notefont |in| (|fetch| (numberobj font) |of| note.datum)
|collect| (fontcreate notefont)))
(|replace| (numberobj font) |of| note.datum |with| nil)
(|replace| objectdatum |of| newobj |with| note.datum)
newobj))
(note.buttoneventinfn
(lambda (obj stream window) (* |fsg| " 5-Aug-87 09:31")
(* * |Allow| |user| |to| |edit| |Endnote| |text,| |specify| \a tag\, |delete|
 |the| tag\, |or| |change| |the| tag.)
(let* ((tag (imageobjprop obj 'tag))
(nmenu (|create| menu
title _ '|Endnote Menu|
items _ (cond
(tag endnote.tag.items)
(t endnote.notag.items))
centerflg _ t
whenselectedfn _ 'note.whenselectedfn)))
(putmenuprop nmenu 'note.obj obj)
(putmenuprop nmenu 'note.window window)
(menu nmenu))))
(note.whenselectedfn
(lambda (item menu mb) (* |fsg| "10-Aug-87 13:48")
(let* ((window (getmenuprop menu 'note.window))
(obj (getmenuprop menu 'note.obj))
(tstream (textstream window)))
(selectq (cadr item)
((|Change Tag| |Define Tag|)
(let ((old.tag (imageobjprop obj 'tag))
(new.tag (tsp.get.incode tstream)))
(and new.tag (neq new.tag old.tag)
(progn (number.delete.tag window obj)
(tsp.putcode new.tag obj window)
(imageobjprop obj 'tag new.tag)))))
(|Delete Tag| (number.delete.tag window obj))
(|Show Tag| (tedit.promptprint tstream (concat "EndNote Tag=\"" (imageobjprop
obj
'tag)
"\"")
t))
(|Edit Text| (aux.tedit obj (concat "Endnote #" (|fetch| numstring
|of| (|fetch| objectdatum
|of| obj)))
tstream))
(error "Undefined EndNote menu item" item))
nil)))
)
(RPAQQ ENDNOTE.NOTAG.ITEMS ((|Edit Text| |Edit Text| "Edit the text associated with this EndNote.")
(|Define Tag| |Define Tag| "Define a TAG for this EndNote.")))
(RPAQQ ENDNOTE.TAG.ITEMS ((|Edit Text| |Edit Text| "Edit the text associated with this EndNote.")
(|Change Tag| |Change Tag| "Change this EndNote's TAG.")
(|Delete Tag| |Delete Tag| "Delete this EndNote's TAG.")
(|Show Tag| |Show Tag| "Show this EndNote's TAG.")))
(DECLARE\: EVAL@COMPILE DONTCOPY
(DECLARE\: EVAL@COMPILE
(RECORD ENDNOTEFONTS (NUMBER.FONT TITLE.FONT TEXT.FONT))
)
)
(* * |Allow| |user| |to| |edit| |Endnote| |text| |in| |another| |TEdit| |window.|)
(DEFINEQ
(aux.tedit
(lambda (imobj title stream) (* |ss:| "27-Jun-87 15:22")
(* * |Open| \a |TEdit| |window| |where| |the| |user| |can| |view/edit| |the|
 |text| |of| |the| |selected| |Endnote.|)
(let* ((mainwindow (\\tedit.mainw stream))
(auxwindow (createw (windowprop mainwindow 'auxw.region)
title)))
(windowprop auxwindow 'main.window mainwindow)
(windowprop auxwindow 'note.imageobj imobj)
(tedit nil auxwindow nil '(afterquitfn aux.tedit.afterquitfn titlemenufn
aux.tedit.titlemenufn))
(tedit.insert (textstream auxwindow)
(mkstring (|fetch| (numberobj text.after#) |of| (|fetch| objectdatum |of| imobj)))
nil
(|fetch| (endnotefonts text.font) |of| (get.endnote.fonts mainwindow))))))
(aux.tedit.afterquitfn
(lambda (auxwindow) (* |ss:| "27-Jun-87 15:22")
(* * |Here| after |user| |finished| |with| |Endnote| |TEdit| |process.|)
(let ((mainwindow (windowprop auxwindow 'main.window)))
(windowprop mainwindow 'auxw.region (windowprop auxwindow 'region))
(give.tty.process mainwindow)
(tedit.normalizecaret (textobj mainwindow)))))
(aux.tedit.titlemenufn
(lambda (auxwindow) (* |ss:| "27-Jun-87 15:23")
(* * |Here| |when| |left| |or| |middle| |button| |hit| |in| |title| |bar.|)
(let ((item (menu (|create| menu
centerflg _ t
items _ '(|Save Changes| |Abort Changes|)))))
(and item (progn (selectq item
(|Save Changes|
(|replace| (numberobj text.after#)
|of| (|fetch| objectdatum |of| (windowprop auxwindow
'note.imageobj))
|with| (coercetextobj (textstream auxwindow)
'stringp)))
nil)
(tedit.quit (textstream auxwindow)))))))
)
(* * |Delimit| |text| |between| |two| |markers| |known| |as| REGION MARKERS.)
(DEFINEQ
(regmarkobj
(lambda (use marking) (* |fsg| "10-Jul-87 15:58")
(let ((newobj (imageobjcreate (|create| regmarkobj
region.use _ use
marking _ marking)
\\regmarkobj.imagefns)))
(imageobjprop newobj 'type 'regmarkobj)
newobj)))
(regmarkobjp
(lambda (imobj) (* |ss:| "27-Jun-87 15:31")
(and imobj (eq (imageobjprop imobj 'type)
'regmarkobj))))
(regmark.displayfn
(lambda (obj stream) (* |fsg| "18-Feb-87 09:18")
(* * regmark |is| |just| \a |marker,| |it| |doesn't| |actually| |display|
 |anything.|)
nil))
(regmark.imageboxfn
(lambda (obj stream currentx rightmargin) (* |fsg| "17-Feb-87 10:22")
(* * regmark |is| |just| \a |marker,| |it| |doesn't| |actually| |display|
 |anything.|)
(|create| imagebox
xsize _ 0
ysize _ 0
ydesc _ 0
xkern _ 0)))
(regmark.putfn
(lambda (markobj stream) (* |fsg| "23-Jul-87 14:02")
(prin2 (list '|Region| (|fetch| region.use |of| (|fetch| objectdatum |of| markobj))
(|fetch| marking |of| (|fetch| objectdatum |of| markobj)))
stream)))
(regmark.getfn
(lambda (stream copy.object) (* |fsg| "20-Aug-87 14:58")
(let ((window (|with| textobj textobj (car \\window))))
(tsp.setup.fmmenu window))
(apply (function regmarkobj)
(or copy.object (cdr (read stream))))))
(regmark.copyfn
(lambda (image.obj source.stream target.stream) (* |fsg| "23-Jul-87 14:09")
(* * |Here| |to| copy \a |RegMark| |Image| |Object.|)
(selectq (imagestreamtype target.stream)
(text (let ((textobj (textobj target.stream)))
(apply* (imageobjprop image.obj 'getfn)
target.stream
(|fetch| objectdatum |of| image.obj))))
(error "Unknown TARGET stream type" (imagestreamtype target.stream)))))
(regmark.buttoneventinfn
(lambda (markobj stream) (* |fsg| "18-Feb-87 10:07")
(* * |This| |function| |is| |never| |called| |because| |the| regmark
 |ImageObjects| |are| |protected| |after| |they| |are| |inserted| |and|
 |anything| |protected| |can't| |be| |selected.|)
(and (mousestate middle)
(let ((markdatum (|fetch| objectdatum |of| markobj)))
(tedit.promptprint stream (concat "Region used for " (|fetch| region.use |of| markdatum
)
(cond
((|fetch| marking |of| markdatum)
(concat ", Marker is " (|fetch| marking
|of| markdatum)))
(t "")))
t)))))
)
(RPAQ? \\REGMARKOBJ.IMAGEFNS
(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)))
(DECLARE\: EVAL@COMPILE DONTCOPY
(DECLARE\: EVAL@COMPILE
(RECORD REGMARKOBJ (REGION.USE MARKING))
)
)
(PUTPROPS TMAX-ENDNOTE COPYRIGHT ("Xerox Corporation" 1987))
(DECLARE\: DONTCOPY
(FILEMAP (NIL (2489 12116 (ADD.ENDNOTE 2499 . 3167) (INSERT.ENDNOTES 3169 . 5372) (
INSERT.ENDNOTES.TEXT 5374 . 6803) (DELETE.ENDNOTES 6805 . 7796) (NOTESREGIONP 7798 . 8060) (
SET.ENDNOTE.STYLE 8062 . 10735) (MAP.ENDNOTE.LOOKS 10737 . 11504) (GET.ENDNOTE.FONTS 11506 . 12114)) (
12117 16032 (ENDNOTEP 12127 . 12468) (NOTE.PUTFN 12470 . 13122) (NOTE.GETFN 13124 . 13704) (
NOTE.BUTTONEVENTINFN 13706 . 14486) (NOTE.WHENSELECTEDFN 14488 . 16030)) (16790 19194 (AUX.TEDIT 16800
. 17762) (AUX.TEDIT.AFTERQUITFN 17764 . 18207) (AUX.TEDIT.TITLEMENUFN 18209 . 19192)) (19279 22743 (
REGMARKOBJ 19289 . 19696) (REGMARKOBJP 19698 . 19892) (REGMARK.DISPLAYFN 19894 . 20140) (
REGMARK.IMAGEBOXFN 20142 . 20493) (REGMARK.PUTFN 20495 . 20827) (REGMARK.GETFN 20829 . 21128) (
REGMARK.COPYFN 21130 . 21668) (REGMARK.BUTTONEVENTINFN 21670 . 22741)))))
STOP

BIN
lispusers/TMAX/TMAX-ENDNOTE.LCOM Normal file
View File

Binary file not shown.

881
lispusers/TMAX/TMAX-INDEX Normal file
View File

@@ -0,0 +1,881 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10)
(FILECREATED "20-Feb-97 17:58:09" |{DSK}<project>medley2.0>lispusers>TMAX-INDEX.;38| 46100
|changes| |to:| (FNS WRITE.INDEX.FILE INDEX.BUTTONEVENTINFN)
|previous| |date:| "19-Feb-97 21:51:43" |{DSK}<project>medley2.0>lispusers>TMAX-INDEX.;36|)
; Copyright (c) 1987, 1997 by Xerox Corporation. All rights reserved.
(PRETTYCOMPRINT TMAX-INDEXCOMS)
(RPAQQ TMAX-INDEXCOMS
(
(* |;;| "Developed under support from NIH grant RR-00785.")
(* |;;| "Written by Frank Gilmurray and Sami Shaio. Modified by Ron Kaplan")
(* |;;| "INDEX objects are simply inserted into the text stream. Information about them is accumulated only when the displayfn is applied to a hardcopy imagestream, and it is accumulated as a property of the imagestream.")
(* |;;;| "TMAX-INDEX ImageObject functions")
(INITVARS (INDEXDISPLAYAPPEARANCE 'BOX))
(FNS INDEXOBJ INDEXOBJP INDEX.DISPLAYFN INDEX.IMAGEBOXFN INDEX.PUTFN INDEX.GETFN INDEX.COPYFN
INDEX.BUTTONEVENTINFN)
(* |;;;| "Inserting indices")
(FNS INSERT.INDEX INSERT.INDEXENTRY INSERT.KNOWN.INDEX SUBITEM.SELECTFN ADD.NEW.INDEX)
(* |;;;| "Functions to change the Index/Extended Index")
(FNS CHANGE.INDEX CHANGE.INDEXENTRY CHANGE.XINDEX.KEY CHANGE.XINDEX.ENTRY CHANGE.XINDEX.FONT
CHANGE.XINDEX.NUMBER)
(* |;;;| "Other misc functions")
(FNS GETHASH.INDEX INDEX.PAGE.NUMBER INDEX.MANUAL.DELIMITER INDEX.STRING
GET.INDEXENTRY.NUMBER INDEX.LIST.REFS LIST.OF.INDEXENTRIES)
(* |;;;| "Index file functions")
(FNS CREATE.INDEX.FILE DUMP.INDEX VIEW.INDEX.FILE GET.INDEX.FILE WRITE.INDEX.FILE
WRITE.INDEX.PAGENUMBERS RESET.INDEX.PAGENUMBERS)
(RECORDS INDEX.ENTRY.RECORD)
(* |;;;| "Convenient interface--depress the props key to index the current selection")
(FNS SELECTION.TO.STRING SELECTION.TO.INDEX)
(MACROS MAKE.INDEXOBJ.IMAGEFNS)
(VARS (\\INDEXOBJ.IMAGEFNS (MAKE.INDEXOBJ.IMAGEFNS)))
(ADDVARS (IMAGEOBJGETFNS (INDEX.GETFN)))
(P (* \;
 "533 is the PROPS key on Sun keyboards")
(TEDIT.SETSYNTAX 533 'FN TEDIT.READTABLE)
(TEDIT.SETFUNCTION 533 (FUNCTION SELECTION.TO.INDEX)
TEDIT.READTABLE))
(* |;;;| "IMAGE OBJECT for causing the index to be written, without using the menu")
))
(* |;;| "Developed under support from NIH grant RR-00785.")
(* |;;| "Written by Frank Gilmurray and Sami Shaio. Modified by Ron Kaplan")
(* |;;|
"INDEX objects are simply inserted into the text stream. Information about them is accumulated only when the displayfn is applied to a hardcopy imagestream, and it is accumulated as a property of the imagestream."
)
(* |;;;| "TMAX-INDEX ImageObject functions")
(RPAQ? INDEXDISPLAYAPPEARANCE 'BOX)
(DEFINEQ
(indexobj
(lambda (key indexentry.parms) (* |fsg| "10-Jul-87 15:59")
(* * |Create| |an| |instance| |of| |an| |Index| |or| |Extended| |Index|
 |imageobject.| |The| |difference| |between| |the| |two| |is| |the| objectdatum.
 |For| \a |simple| |Index,| objectdatum |is| nil.
 |For| |an| |Extended| |Index,| objectdatum |is| \a |record| |containing| |the|
 |Entry,| |Entry's| |font,| |and| |Number| |option.|
 i\n |either| |case,| |the| index.key |property| |is| |the| |hash| |key| |and|
 |is| |also| |the| |text| |to| |index| |for| \a |simple| |Index.|
 |NOTE...Extended| |Index| |used| |to| |be| |called| |IndexEntry| |after| |the|
 |Scribe| |cmd| |of| |the| |same| |name.|)
(let ((newobj (imageobjcreate indexentry.parms \\indexobj.imagefns)))
(imageobjprop newobj 'index.key key)
(imageobjprop newobj 'type 'indexobj)
newobj)))
(indexobjp
(lambda (obj) (* |ss:| "27-Jun-87 15:53")
(* * |Tests| |an| |imageobject| |to| |see| |if| |it| |an| |Index| |or|
 |Extended| |Index| |imageobject.| b\y |convention,| |testing| |functions| |for|
 |an| |imageobject| |are| |named| <concat |type-of-imageobj| "P" >.)
(and obj (eq (imageobjprop obj 'type)
'indexobj))))
(INDEX.DISPLAYFN
(LAMBDA (OBJ IMAGESTREAM) (* \; "Edited 14-Feb-97 09:30 by rmk:")
(* |fsg| "17-Sep-87 11:14")
(* |;;| "Display an Index imageobject. If the stream-type is display, then just type Index or Extended Index followed by their args. Otherwise the stream-type is hardcopy. In this case, type nothing and replace the CAR of the hash array entry with a list of page numbers in which this index appears.")
(SELECTQ (IMAGESTREAMTYPE IMAGESTREAM)
(DISPLAY (CL:UNLESS (EQ 'INVISIBLE INDEXDISPLAYAPPEARANCE)
(DSPFONT |GP.DefaultFont| IMAGESTREAM)
(SELECTQ INDEXDISPLAYAPPEARANCE
(BOX (TMAX.SHADEOBJ OBJ IMAGESTREAM GRAYSHADE))
(HIGHLIGHT (TMAX.SHADEOBJ OBJ IMAGESTREAM BLACKSHADE))
(PROGN (TMAX.SHADEOBJ OBJ IMAGESTREAM)
(PRIN3 (INDEX.STRING OBJ)
IMAGESTREAM)))))
(LET ((PGS/IMOBJS (GETHASH.INDEX OBJ IMAGESTREAM))
(CURRENT.PAGE (INDEX.PAGE.NUMBER (WITH TEXTOBJ TEXTOBJ (CAR \\WINDOW)))))
(COND
((LISTP (CAR PGS/IMOBJS))
(OR (MEMB CURRENT.PAGE (CAR PGS/IMOBJS))
(RPLACA PGS/IMOBJS (APPEND (CAR PGS/IMOBJS)
(LIST CURRENT.PAGE)))))
(T (RPLACA PGS/IMOBJS (LIST CURRENT.PAGE))))))))
(INDEX.IMAGEBOXFN
(LAMBDA (OBJ STREAM CURRENTX RIGHTMARGIN) (* \; "Edited 14-Feb-97 09:23 by rmk:")
(* |ss:| "27-Jun-87 15:50")
(* |;;| "Return the ImageBox for an Index or Extended Index.")
(SELECTQ (IMAGESTREAMTYPE STREAM)
(DISPLAY (SELECTQ INDEXDISPLAYAPPEARANCE
(INVISIBLE (CREATE IMAGEBOX
XSIZE _ 0
YSIZE _ 0
YDESC _ 0
XKERN _ 0))
((BOX HIGHLIGHT)
(CREATE IMAGEBOX
XSIZE _ (CHARWIDTH (CHARCODE SPACE)
STREAM)
YSIZE _ (LRSH (FONTPROP STREAM 'HEIGHT)
1)
YDESC _ 0
XKERN _ 0))
(CREATE IMAGEBOX
XSIZE _ (STRINGWIDTH (INDEX.STRING OBJ)
|GP.DefaultFont|)
YSIZE _ (FONTPROP |GP.DefaultFont| 'HEIGHT)
YDESC _ (FONTPROP |GP.DefaultFont| 'DESCENT)
XKERN _ 0)))
(CREATE IMAGEBOX
XSIZE _ 0
YSIZE _ 0
YDESC _ 0
XKERN _ 0))))
(index.putfn
(lambda (obj stream) (* |ss:| "27-Jun-87 15:51")
(* * |Puts| |the| |Index| |or| |Extended| |Index| |imageobject| |in| \a |file.|)
(let ((datum (|fetch| objectdatum |of| obj))
(index.put.arg (list '|Index| (imageobjprop obj 'index.key))))
(and datum (nconc1 index.put.arg datum))
(prin2 index.put.arg stream))))
(INDEX.GETFN
(LAMBDA (STREAM COPY.OBJECT) (* \; "Edited 14-Feb-97 10:10 by rmk:")
(* |fsg| "20-Aug-87 14:57")
(* |;;| "Create the Index or Extended Index imageobject when it is read from file.")
(APPLY (FUNCTION INDEXOBJ)
(OR COPY.OBJECT (CDR (READ STREAM))))))
(index.copyfn
(lambda (image.obj source.stream target.stream) (* |fsg| "23-Jul-87 12:01")
(* * |Here| |to| copy |an| |Index| |or| |Extended| |Index| |Image| |Object.|)
(selectq (imagestreamtype target.stream)
(text (let ((textobj (textobj target.stream)))
(apply* (imageobjprop image.obj 'getfn)
target.stream
(list (imageobjprop image.obj 'index.key)
(|fetch| objectdatum |of| image.obj)))))
(error "Unknown TARGET stream type" (imagestreamtype target.stream)))))
(INDEX.BUTTONEVENTINFN
(LAMBDA (OBJ STREAM SEL RELX RELY WINDOW HOSTSTREAM BUTTON)
(* \; "Edited 20-Feb-97 13:53 by rmk:")
(* |fsg| "29-Jul-87 10:50")
(* |;;| "Process the middle button pressed inside an Index or Extended Index imageobject. This means the user wants to Change this index.")
(AND (MOUSESTATE MIDDLE)
(LET* ((DATUM (FETCH OBJECTDATUM OF OBJ))
(NEW.INDEX (MENU (CREATE MENU
TITLE _ (IMAGEOBJPROP OBJ 'INDEX.KEY)
ITEMS _ (LIST (COND
(DATUM '(|Change Extended Index| T
"Change Extended Index"))
(T '(|Change Index| T "Change Index"))))
CENTERFLG _ T))))
(CL:WHEN (AND NEW.INDEX (CAR (SETQ NEW.INDEX (COND
(DATUM (CHANGE.INDEXENTRY OBJ
STREAM))
(T (CHANGE.INDEX OBJ STREAM))))))
(IMAGEOBJPROP OBJ 'INDEX.KEY (CAR NEW.INDEX))
(AND DATUM (REPLACE OBJECTDATUM OF OBJ WITH (CADR NEW.INDEX)))
'CHANGED)))))
)
(* |;;;| "Inserting indices")
(DEFINEQ
(INSERT.INDEX
(LAMBDA (STREAM) (* \; "Edited 14-Feb-97 09:15 by rmk:")
(* |fsg| "10-Mar-87 14:02")
(* |;;| "Process the 'Index' function in the ImageObjects menu.")
(LET ((NEWINDEX.KEY (MKATOM (CONVERT.TABS.TO.SPACES (TEDIT.GETINPUT STREAM "Index Key:")))))
(AND NEWINDEX.KEY (LET ((NEW.INDEX.OBJ (INDEXOBJ NEWINDEX.KEY)))
(TEDIT.INSERT.OBJECT NEW.INDEX.OBJ STREAM)))
(TEDIT.PROMPTPRINT STREAM "" T))))
(INSERT.INDEXENTRY
(LAMBDA (STREAM WINDOW) (* \; "Edited 14-Feb-97 09:15 by rmk:")
(* |fsg| "19-Mar-87 11:56")
(* |;;| "Process the 'Extended Index' function in the ImageObjects menu. NOTE...Extended Index use to be called IndexEntry after the Scribe cmd of the same name.")
(LET ((NEWINDEX.KEY (MKATOM (CONVERT.TABS.TO.SPACES (TEDIT.GETINPUT STREAM "Extended Index Key:")
))))
(AND NEWINDEX.KEY (LET ((NEW.INDEX.OBJ
(INDEXOBJ NEWINDEX.KEY
(CREATE INDEX.ENTRY.RECORD
INDEX.ENTRY _
(OR (MKATOM (CONVERT.TABS.TO.SPACES
(TEDIT.GETINPUT STREAM
"Extended Index Entry:"
(MKSTRING NEWINDEX.KEY))))
NEWINDEX.KEY)
INDEX.ENTRYFONT _
(LET (NEWINDEX.FONT)
(TEDIT.PROMPTPRINT STREAM
"Extended Index Entry font..." T)
(UNTIL (SETQ NEWINDEX.FONT (GET.TSP.FONT
WINDOW
|GP.DefaultFont|
))
DO (TEDIT.PROMPTPRINT STREAM
"Invalid font specification...try again."
T))
NEWINDEX.FONT)
INDEX.NUMBER _ (PROGN (TEDIT.PROMPTPRINT STREAM
"Extended Index Number option..."
T)
(GET.INDEXENTRY.NUMBER)))))
)
(TEDIT.INSERT.OBJECT NEW.INDEX.OBJ STREAM)))
(TEDIT.PROMPTPRINT STREAM "" T))))
(INSERT.KNOWN.INDEX
(LAMBDA (STREAM WINDOW) (* \; "Edited 14-Feb-97 17:24 by rmk:")
(* |fsg| "16-Sep-87 11:31")
(* |;;| "Process the 'Known Indices' function in the ImageObjects menu. A menu of all the known Indices and Extended Indices pops up and the user may button one of these to insert the corrsponding Index or Extended Index.")
(HELP "NEED TO DO TEDIT.MAPPIECES INSTEAD OF INDEX.LIST.REFS")
(LET* ((PREVINDICES (INDEX.LIST.REFS STREAM))
(NEWINDEX.KEY (COND
(PREVINDICES (LET ((MENU.SELECTION
(MENU (|create| MENU
TITLE _ "Index Keys"
ITEMS _ PREVINDICES
MENUCOLUMNS _ (FIX (SQRT (LENGTH
PREVINDICES
)))
CENTERFLG _ T
WHENSELECTEDFN _ (FUNCTION
SUBITEM.SELECTFN)))))
(AND MENU.SELECTION (OR (LISTP MENU.SELECTION)
(LIST MENU.SELECTION)))))
(T (TEDIT.PROMPTPRINT STREAM
"There are no Indices/Extended Indices in this document." T)
NIL))))
(AND NEWINDEX.KEY (LET ((NEWINDEX.OBJ (APPLY 'INDEXOBJ NEWINDEX.KEY)))
(TEDIT.INSERT.OBJECT NEWINDEX.OBJ STREAM)
(TEDIT.PROMPTPRINT STREAM "" T))))))
(subitem.selectfn
(lambda (item menu key) (* |fsg| "16-Sep-87 13:28")
(* * |Function| |to| |handle| |multiple| |column| |menu| |when| |some| |items|
 |have| |subitems.|)
(prog (submenu subitems (submenus (getmenuprop menu 'submenus)))
(|if| (and (listp item)
(setq subitems (cdr (assoc 'subitems (cdddr item)))))
|then| (|if| (setq submenu (cdr (sassoc subitems submenus)))
|else| (setq submenu (|create| menu
items _ subitems
centerflg _ t))
(putmenuprop menu 'submenus (cons (cons subitems submenu)
submenus)))
(return (menu submenu))
|else| (return (defaultwhenselectedfn item menu key))))))
(ADD.NEW.INDEX
(LAMBDA (IMAGESTREAM INDEXKEY OBJ) (* \; "Edited 14-Feb-97 09:08 by rmk:")
(* |ss:| "27-Jun-87 15:44")
(* |;;| "Add an Index or Extended Index imageobject to our index array. If at least one already exists for this index key, then just append this imageobject to the list. Otherwise create a new array entry for this imageobject. The list contains three elements; a string, a list of Index imageobjects, and a list of Extended Index imageobjects.")
(LET ((CODE.ARRAY (STREAMPROP IMAGESTREAM 'TSP.INDEX.ARRAY))
HASH.VALUE INDEX.OBJS ENTRY.OBJS)
(CL:UNLESS (HASHARRAYP CODE.ARRAY)
(SETQ CODE.ARRAY (HASHARRAY 100))
(STREAMPROP IMAGESTREAM 'TSP.CODE.ARRAY CODE.ARRAY)
(CL:UNLESS (HASHARRAYP (STREAMPROP IMAGESTREAM 'TSP.INDEX.ARRAY))
(STREAMPROP IMAGESTREAM 'TSP.INDEX.ARRAY (HASHARRAY 100))))
(SETQ HASH.VALUE (GETHASH INDEXKEY CODE.ARRAY))
(SETQ INDEX.OBJS (CADR HASH.VALUE))
(SETQ ENTRY.OBJS (CADDR HASH.VALUE))
(COND
((FETCH OBJECTDATUM OF OBJ)
(SETQ ENTRY.OBJS (APPEND ENTRY.OBJS (LIST OBJ))))
(T (SETQ INDEX.OBJS (APPEND INDEX.OBJS (LIST OBJ)))))
(PUTHASH INDEXKEY (LIST NIL INDEX.OBJS ENTRY.OBJS)
CODE.ARRAY))))
)
(* |;;;| "Functions to change the Index/Extended Index")
(DEFINEQ
(change.index
(lambda (obj stream) (* |ss:| "27-Jun-87 15:44")
(* * |Here| |when| change |buttoned| |inside| |an| |Index| |ImageObject.|)
(list (mkatom (convert.tabs.to.spaces (tedit.getinput stream (concat "Change Index key \""
(imageobjprop obj
'index.key)
"\" to:")))))))
(change.indexentry
(lambda (obj stream) (* |fsg| "10-Mar-87 11:52")
(* * |Here| |when| change |buttoned| |inside| |an| |Extended| |Index|
 |ImageObject.| |NOTE...Extended| |Index| |used| |to| |be| |called| |IndexEntry|
 |after| |the| |Scribe| |cmd| |of| |the| |same| |name.|)
(prog1 (list (change.xindex.key obj stream)
(|create| index.entry.record
index.entry _ (change.xindex.entry obj stream)
index.entryfont _ (change.xindex.font obj stream)
index.number _ (change.xindex.number obj stream)))
(tedit.promptprint stream "" t))))
(change.xindex.key
(lambda (obj stream) (* |ss:| "27-Jun-87 15:45")
(* * |Change| |the| |key| |of| |an| |Extended| |Index.|)
(let ((oldindex.key (imageobjprop obj 'index.key)))
(or (mkatom (convert.tabs.to.spaces (tedit.getinput stream (concat
"Change Extended Index Key \""
oldindex.key "\" to:"))))
oldindex.key))))
(change.xindex.entry
(lambda (obj stream) (* |fsg| "10-Mar-87 11:31")
(* * |Change| |the| |entry| |of| |an| |Extended| |Index.|)
(let ((oldindex.entry (|fetch| index.entry |of| (|fetch| objectdatum |of| obj))))
(or (mkatom (convert.tabs.to.spaces (tedit.getinput stream (concat
"Change Extended Index Entry \""
oldindex.entry "\" to:")))
)
oldindex.entry))))
(change.xindex.font
(lambda (obj stream) (* |fsg| " 8-Jul-87 16:42")
(* * |Change| |the| |font| |of| |an| |Extended| |Index.|)
(let ((oldindex.font (|fetch| index.entryfont |of| (|fetch| objectdatum |of| obj)))
newindex.font)
(tedit.promptprint stream (concat "Change Extended Index Entry's font " (abbreviate.font
oldindex.font)
" to...")
t)
(|until| (setq newindex.font (get.tsp.font (\\tedit.mainw stream)
(or oldindex.font |GP.DefaultFont|)))
|do| (tedit.promptprint stream "Invalid font specification...try again." t))
newindex.font)))
(change.xindex.number
(lambda (obj stream) (* |fsg| "19-Mar-87 11:51")
(* * |Change| |the| |number| |option| |of| |an| |Extended| |Index.|)
(let ((oldindex.nbr (|fetch| index.number |of| (|fetch| objectdatum |of| obj))))
(tedit.promptprint stream (concat "Change Extended Index Number option \"" oldindex.nbr
"\" to...")
t)
(get.indexentry.number oldindex.nbr))))
)
(* |;;;| "Other misc functions")
(DEFINEQ
(GETHASH.INDEX
(LAMBDA (OBJ IMAGESTREAM) (* \; "Edited 14-Feb-97 09:28 by rmk:")
(* |fsg| "13-Jul-87 11:09")
(* |;;| "Get the hash array entry for this Index or Extended Index.")
(LET ((HARRAY (HASHARRAYP (STREAMPROP IMAGESTREAM 'TSP.INDEX.ARRAY))))
(CL:UNLESS HARRAY
(STREAMPROP IMAGESTREAM 'TSP.INDEX.ARRAY (SETQ HARRAY (HASHARRAY 100))))
(OR (GETHASH (IMAGEOBJPROP OBJ 'INDEX.KEY)
HARRAY)
(ADD.NEW.INDEX IMAGESTREAM (IMAGEOBJPROP OBJ 'INDEX.KEY)
OBJ)))))
(INDEX.PAGE.NUMBER
(LAMBDA (WINDOW) (* \; "Edited 14-Feb-97 09:58 by rmk:")
(* |fsg| "16-Jul-87 10:08")
(* |;;| "Return the index page number; either the page number or manual-style page number.")
(MKATOM (COND
((MANUALINDEX.ENABLED? WINDOW)
(LET ((INDEX.PAGE "")
(TEMPLATE.LIST (APPEND (WINDOWPROP WINDOW 'MANUALTEMPLATES)))
INDEX.TEMPLATE)
(WHILE (SETQ INDEX.TEMPLATE (POP TEMPLATE.LIST))
DO (WITH NGTEMPLATE INDEX.TEMPLATE (SETQ INDEX.PAGE
(CONCAT INDEX.PAGE
(OR NG.TEXT-BEFORE "")
(NGROUP.CHARTYPE.CONVERT
NG.CHARTYPE NG.CURRENTVAL
)
(INDEX.MANUAL.DELIMITER
NG.TEXT-AFTER
(CAR TEMPLATE.LIST))))))
(CONCAT INDEX.PAGE (CAR FORMATTINGSTATE))))
(T (CAR FORMATTINGSTATE))))))
(index.manual.delimiter
(lambda (after.delimiter next.template) (* |fsg| "16-Jul-87 10:00")
(* * |Return| |the| |delimiter| |between| |NGroups| |and| |the| |page| |number|
 |for| \a |Manual| |Index| |page| |reference.|)
(or (cond
(next.template (cond
((|fetch| (ngtemplate ng.text-before) |of| next.template)
"")
(t nil)))
(t (cond
((or (null after.delimiter)
(strequal after.delimiter ""))
".")
(t nil))))
after.delimiter)))
(index.string
(lambda (index.obj) (* |ss:| "27-Jun-87 15:52")
(* * |Returns| |the| |display| |imagestream| |text| |for| |an| |Index| |or|
 |Extended| |Index| |ImageObject.|)
(let ((objdatum (|fetch| objectdatum |of| index.obj))
(indexkey (mkatom (imageobjprop index.obj 'index.key))))
(cond
(objdatum (|with| index.entry.record objdatum (concat "{Index Key=" indexkey ",Entry="
index.entry
(selectq index.number
(yes ",Yes}")
(no ",No}")
(concat "," index.number "}"))))
)
(t (concat "{Index " indexkey "}"))))))
(get.indexentry.number
(lambda (defaultnumber) (* |ss:| "27-Jun-87 15:47")
(* * |Get| |the| number |argument| |for| |an| |IndexEntry| |ImageObject.|
 |The| number |can| |be| "YES" \, "NO" \, |or| |an| |integer.|)
(or (menu (|create| menu
title _ "Number?"
centerflg _ t
items _ '(yes no value)
whenselectedfn _ (function (lambda (item)
(cond
((eq item 'value)
(numberpad.read (create.numberpad.reader
"NUMBER value?" nil nil
nil t)))
(t item))))))
defaultnumber
'yes)))
(INDEX.LIST.REFS
(LAMBDA (IMAGESTREAM) (* \; "Edited 14-Feb-97 09:09 by rmk:")
(* |ss:| "27-Jun-87 15:51")
(* |;;| "Return a sorted list of the Index and Extended Index keys. Simple Index keys are just added to the list. For an Extended Index key, there are SUBITEMS for each Extended Index for this key. This list can be used as the ITEMS field in the Known Indices menu or for creating the index file.")
(LET ((INDEX.ARRAY (STREAMPROP IMAGESTREAM 'TSP.INDEX.ARRAY))
(INDEX.KEYLIST NIL)
(INDEX.ITEMS (CONS))
INDEX.VALUE)
(MAPHASH INDEX.ARRAY (FUNCTION (LAMBDA (VAL KY)
(SETQ INDEX.KEYLIST (CONS KY INDEX.KEYLIST)))))
(FOR KEY IN (SORT INDEX.KEYLIST 'UALPHORDER)
DO (SETQ INDEX.VALUE (GETHASH KEY INDEX.ARRAY))
(AND (CADR INDEX.VALUE)
(NCONC INDEX.ITEMS (LIST KEY)))
(AND (CADDR INDEX.VALUE)
(NCONC INDEX.ITEMS (LIST (LIST KEY NIL "Select an Extended Index subitem."
(CONS 'SUBITEMS (LIST.OF.INDEXENTRIES
KEY
(CADDR INDEX.VALUE))))))))
(CDR INDEX.ITEMS))))
(list.of.indexentries
(lambda (key objlist) (* |fsg| " 8-Jul-87 16:46")
(* * |Returns| \a |list| |of| |the| |Extended| |Indices| |of| |the| |given|
 |key| |sorted| |by| |Entry.|)
(let ((entry.list (cons))
datum)
(|for| obj |in| objlist
|do| (setq datum (|fetch| objectdatum |of| obj))
(nconc entry.list (list (list (concat (|fetch| index.entry |of| datum)
" "
(abbreviate.font (|fetch| index.entryfont
|of| datum))
" "
(|fetch| index.number |of| datum))
(kwote (list key datum))))))
(sort (intersection (cdr entry.list)
(cdr entry.list))
(function (lambda (a b)
(ualphorder (caadr (cadadr a))
(caadr (cadadr b)))))))))
)
(* |;;;| "Index file functions")
(DEFINEQ
(CREATE.INDEX.FILE
(LAMBDA (TEXTSTREAM IMAGESTREAM INDEXFILE INDEX.FONT NOTITLE)
(* \; "Edited 14-Feb-97 11:10 by rmk:")
(* |fsg| "13-Aug-87 09:05")
(* |;;| "Writes the indices and their corresponding page numbers to the index file. The indices are sorted alphabetically regardless of case.")
(LET ((INDEX.ARRAY (IF IMAGESTREAM
THEN (STREAMPROP IMAGESTREAM 'TSP.INDEX.ARRAY)
ELSE
(* |;;| "Menu call should do a hardcopy to a nodircore image stream, which can then be passed in for us to interrogate.")
(* |;;| "(STREAMPROP WINDOW 'TSP.INDEX.ARRAY)")
(HELP "Trying to write index when not hard-copying")))
(INDEX.LIST (INDEX.LIST.REFS IMAGESTREAM))
(INDEX.FILE (OUTFILEP INDEXFILE))
(INDEX.STREAM (OPENTEXTSTREAM)))
(COND
((AND INDEX.LIST INDEX.FILE)
(TEDIT.PROMPTPRINT TEXTSTREAM (CONCAT "Putting Indices into file " INDEX.FILE "... ")
T)
(CL:UNLESS NOTITLE
(DSPFONT (FONTCREATE '(HELVETICA 14 BRR))
INDEX.STREAM)
(PRINTOUT INDEX.STREAM "Index" T T))
(WRITE.INDEX.FILE INDEX.STREAM INDEX.LIST INDEX.ARRAY INDEX.FONT)
(CLOSEF? (TEDIT.PUT INDEX.STREAM INDEX.FILE))
INDEX.FILE)
(INDEX.LIST (TEDIT.PROMPTPRINT TEXTSTREAM "Specify a file name for the Indices first." T)
NIL)
(T (TEDIT.PROMPTPRINT TEXTSTREAM
"There are no Indices/Extended Indices in this document." T)
NIL)))))
(DUMP.INDEX
(LAMBDA (INDEXFILE) (* \; "Edited 14-Feb-97 11:12 by rmk:")
(* |;;| "Dumps the current index to INDEXFILE without a title and in the font of the current image stream. Convenient to call in an EVALOBJect context. By default, indexfile will be placed on the same directory as the text file underlying the textstream")
(DECLARE (USEDFREE TEXTSTREAM WINDOW IMAGESTREAM))
(LET ((TEXTFILE (FETCH (TEXTOBJ TXTFILE) OF (TEXTOBJ TEXTSTREAM))))
(IF TEXTFILE
THEN (SETQ TEXTFILE (FULLNAME TEXTFILE)))
(CREATE.INDEX.FILE TEXTSTREAM IMAGESTREAM (IF INDEXFILE
THEN (PACKFILENAME 'VERSION NIL
'BODY INDEXFILE
'HOST
(FILENAMEFIELD
TEXTFILE
'HOST)
'DIRECTORY
(FILENAMEFIELD
TEXTFILE
'DIRECTORY))
ELSEIF TEXTFILE
THEN (PACKFILENAME 'VERSION NIL
'EXTENSION
'INDEX
'BODY TEXTFILE)
ELSEIF (GET.INDEX.FILE
(WINDOWPROP WINDOW
'IMAGEOBJ.MENUW))
ELSE (HELP "No file for index"))
(DSPFONT NIL IMAGESTREAM)
T))))
(VIEW.INDEX.FILE
(LAMBDA (STREAM WINDOW DONTSHOW) (* \; "Edited 14-Feb-97 17:15 by rmk:")
(* |fsg| "12-Aug-87 16:34")
(* |;;| "Writes out the index file via CREATE.INDEX.FILE and then opens another TEdit window where this new file is displayed.")
(* |;;| "First, do a dummy hardcopy to get the page numbers. Use the type of the current defaultprintinghost as the imagestream type")
(LET* ((IMAGESTREAM (OPENIMAGESTREAM '{NULL}))
(INDEX.FILE (CREATE.INDEX.FILE STREAM (PROGN (TEDIT.FORMAT.HARDCOPY STREAM IMAGESTREAM
)
IMAGESTREAM)
(GET.INDEX.FILE (WINDOWPROP WINDOW 'IMAGEOBJ.MENUW)))))
(AND INDEX.FILE (NOT DONTSHOW)
(PROGN (OR (WINDOWPROP WINDOW 'INDEX.WINDOW)
(WINDOWPROP WINDOW 'INDEX.WINDOW (CREATEW NIL (CONCAT "Viewing Index file "
INDEX.FILE))))
(TEDIT INDEX.FILE (WINDOWPROP WINDOW 'INDEX.WINDOW)))))))
(get.index.file
(lambda (menuw) (* \; "Edited 29-Sep-87 14:34 by fsg")
(* * |Return| |the| |user| |specified| |index| |file| |name.|)
(let ((filename (fm.itemprop (fm.getitem 'index.file nil menuw)
'label)))
(and (not (strequal filename ""))
(mkatom filename)))))
(WRITE.INDEX.FILE
(LAMBDA (INDEX.STREAM INDEX.LIST INDEX.ARRAY INDEX.FONT PAGE.FONT)
(* \; "Edited 20-Feb-97 17:58 by rmk:")
(* |fsg| "13-Aug-87 10:43")
(* |;;| "For each Index, the Key is printed followed by the list of page numbers in which this Index Key appears. Each Extended Index is printed on a separate line and the page number depends on the Extended Index Number option.")
(CL:UNLESS INDEX.FONT (SETQ INDEX.FONT |GP.DefaultFont|))
(CL:UNLESS PAGE.FONT (SETQ PAGE.FONT INDEX.FONT))
(* |;;| "For some reason, the first line doesn't format properly after an Include object. Kludge to fix it here: put out a blank line. Perhaps a better thing would be to somehow fix the include object, or perhaps to have the DUMP.INDEX take a flag to control this.")
(PRINTOUT INDEX.STREAM " " T)
(FOR INDEX.ITEM IN INDEX.LIST
DO (COND
((LISTP INDEX.ITEM)
(* |;;| "Extended Index")
(FOR INDEX.SUBITEM (PGS.AND.IMOBJS _ (GETHASH (CAR INDEX.ITEM)
INDEX.ARRAY))
IN (CDR (CADDDR INDEX.ITEM))
DO (FOR INDEX.ENTRYARGS FONT IN (CDR (CADADR INDEX.SUBITEM))
DO (DSPFONT (SETQ FONT (FONTCREATE (CADR INDEX.ENTRYARGS)))
INDEX.STREAM)
(PRINTOUT INDEX.STREAM (MKSTRING (CAR INDEX.ENTRYARGS)))
(WRITE.INDEX.PAGENUMBERS INDEX.STREAM PGS.AND.IMOBJS
(CADDR INDEX.ENTRYARGS)
PAGE.FONT)
(DSPFONT FONT INDEX.STREAM)
(PRINTOUT INDEX.STREAM T))))
(T
(* |;;| "Simple Index")
(DSPFONT INDEX.FONT INDEX.STREAM)
(PRINTOUT INDEX.STREAM (MKSTRING INDEX.ITEM))
(WRITE.INDEX.PAGENUMBERS INDEX.STREAM (GETHASH INDEX.ITEM INDEX.ARRAY)
NIL PAGE.FONT)
(PRINTOUT INDEX.STREAM T))))))
(WRITE.INDEX.PAGENUMBERS
(LAMBDA (STREAM PAGES/IMOBJS NUMBER.OPTION PAGEFONT) (* \; "Edited 2-Feb-97 17:04 by rmk:")
(* |fsg| "11-Mar-87 11:04")
(* |;;| "Here to write the actual pages nubers that this Index or Extended Index appears in. NUMBER.OPTION is the Number field of an Extended Index.")
(DSPFONT PAGEFONT STREAM)
(LET ((PAGE.NBRS (COND
(NUMBER.OPTION (SELECTQ NUMBER.OPTION
(NO "")
(YES (CAR PAGES/IMOBJS))
(MKSTRING NUMBER.OPTION)))
(T (CAR PAGES/IMOBJS))))
(PAGE.STRING " "))
(COND
((LISTP PAGE.NBRS)
(SETQ PAGE.STRING (CONCAT PAGE.STRING (CAR PAGE.NBRS)))
(|for| PAGE |in| (CDR PAGE.NBRS) |do| (SETQ PAGE.STRING
(CONCAT PAGE.STRING ", " PAGE))
|finally| (PRINTOUT STREAM PAGE.STRING)))
(T (PRINTOUT STREAM (CONCAT PAGE.STRING PAGE.NBRS)))))))
(RESET.INDEX.PAGENUMBERS
(LAMBDA (IMAGESTREAM) (* \; "Edited 14-Feb-97 09:11 by rmk:")
(* |fsg| "13-Aug-87 10:43")
(* |;;| "Here before hardcopying the TMAX/TEdit window. Reset the page number list to NIL so the hardcopy DISPLAYFN will create a new list of index page numbers.")
(LET ((INDEX.ARRAY (STREAMPROP IMAGESTREAM 'TSP.INDEX.ARRAY)))
(AND INDEX.ARRAY (MAPHASH INDEX.ARRAY (FUNCTION (LAMBDA (VAL KEY)
(RPLACA VAL NIL))))))))
)
(DECLARE\: EVAL@COMPILE
(RECORD INDEX.ENTRY.RECORD (INDEX.ENTRY INDEX.ENTRYFONT INDEX.NUMBER))
)
(* |;;;| "Convenient interface--depress the props key to index the current selection")
(DEFINEQ
(SELECTION.TO.STRING
(LAMBDA (TEXTSTREAM) (* \; "Edited 27-Jan-97 12:53 by rmk:")
(LET (PREFIX ENDPOS NEXTESCAPE (SEL (TEDIT.GETSEL TEXTSTREAM))
(POINT (TEDIT.GETPOINT TEXTSTREAM))
STARTPOS ENDPOS)
(SETQ STARTPOS (SUB1 (FETCH CH# OF SEL)))
(SETQ ENDPOS (SUB1 (FETCH CHLIM OF SEL)))
(IF (EQ 'CHAR (FETCH SELKIND OF SEL))
THEN
(* |;;| "Stretch out to at least a word selection.")
(* |;;|
 "Look backwards, then forwards. 22 seems to be white-space, 21 is alphabetic, 20 is punctuation")
(FOR OLD STARTPOS C BC FROM (SUB1 STARTPOS) BY -1 TO 0
WHILE (PROGN (SETFILEPTR TEXTSTREAM STARTPOS)
(AND (SMALLP (SETQ C (BIN TEXTSTREAM)))
(SELECTQ (TEDIT.WORDGET C)
(22 NIL)
(20 (* \; "Include hyphens as alphabetics")
(EQ C (CHARCODE -)))
T)))
FINALLY (ADD STARTPOS 1) (* \; "Fileptr of first character")
(SETFILEPTR TEXTSTREAM ENDPOS)
(WHILE (PROGN (AND (NOT (EOFP TEXTSTREAM))
(SMALLP (SETQ C (BIN TEXTSTREAM)))
(SELECTQ (TEDIT.WORDGET C)
(22 NIL)
(20 (* \; "Include hyphens as alphabetics")
(EQ C (CHARCODE -)))
T))))
(SETQ ENDPOS (GETFILEPTR TEXTSTREAM))
(CL:UNLESS (EOFP TEXTSTREAM) (* \;
 "Have to back up over the ending space")
(SETQ ENDPOS (SUB1 ENDPOS)))))
(* |;;|
 "Always move the point to the right, so that the insert happens after the selection")
(SETQ STARTPOS (ADD1 STARTPOS))
(TEDIT.SETSEL TEXTSTREAM STARTPOS (- (ADD1 ENDPOS)
STARTPOS)
'RIGHT NIL T 'NORMAL)
(IF (CAR (NLSETQ (TEDIT.SEL.AS.STRING TEXTSTREAM)))
ELSE (TEDIT.PROMPTPRINT TEXTSTREAM "Invalid index term--contains image object?" T)
(ERROR!)))))
(SELECTION.TO.INDEX
(LAMBDA (STREAM) (* \; "Edited 14-Feb-97 09:56 by rmk:")
(* |fsg| "10-Mar-87 14:02")
(* |;;| "The index key has been depressed. Index on the current selection")
(LET ((NEWINDEX.KEY (MKATOM (CL:STRING-TRIM '(#\Space)
(CONVERT.TABS.TO.SPACES (SELECTION.TO.STRING STREAM)))))
(TEXTOBJ (TEXTOBJ STREAM)))
(IF (AND NEWINDEX.KEY (NEQ 0 (NCHARS NEWINDEX.KEY)))
THEN (LET ((OBJ (INDEXOBJ NEWINDEX.KEY)))
(REPLACE BLUEPENDINGDELETE OF TEXTOBJ WITH NIL)
(TEDIT.INSERT.OBJECT OBJ STREAM (TEDIT.GETPOINT STREAM))
(TEDIT.SETSEL STREAM (ADD1 (TEDIT.GETPOINT STREAM))
0
'RIGHT NIL T 'NORMAL)
(TEDIT.PROMPTPRINT STREAM (CONCAT "Index term: " NEWINDEX.KEY)
T))
ELSE (TEDIT.PROMPTPRINT STREAM "No index term selected" T)
(ERROR!)))))
)
(DECLARE\: EVAL@COMPILE
(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 NILL)
(FUNCTION NILL)
(FUNCTION NILL)
(FUNCTION NILL))))
)
(RPAQ \\INDEXOBJ.IMAGEFNS (MAKE.INDEXOBJ.IMAGEFNS))
(ADDTOVAR IMAGEOBJGETFNS (INDEX.GETFN))
(* \;
 "533 is the PROPS key on Sun keyboards")
(TEDIT.SETSYNTAX 533 'FN TEDIT.READTABLE)
(TEDIT.SETFUNCTION 533 (FUNCTION SELECTION.TO.INDEX)
TEDIT.READTABLE)
(* |;;;| "IMAGE OBJECT for causing the index to be written, without using the menu")
(PUTPROPS TMAX-INDEX COPYRIGHT ("Xerox Corporation" 1987 1997))
(DECLARE\: DONTCOPY
(FILEMAP (NIL (3149 10825 (INDEXOBJ 3159 . 4182) (INDEXOBJP 4184 . 4632) (INDEX.DISPLAYFN 4634 . 6204)
(INDEX.IMAGEBOXFN 6206 . 7752) (INDEX.PUTFN 7754 . 8184) (INDEX.GETFN 8186 . 8577) (INDEX.COPYFN 8579
. 9214) (INDEX.BUTTONEVENTINFN 9216 . 10823)) (10864 18737 (INSERT.INDEX 10874 . 11461) (
INSERT.INDEXENTRY 11463 . 14230) (INSERT.KNOWN.INDEX 14232 . 16309) (SUBITEM.SELECTFN 16311 . 17305) (
ADD.NEW.INDEX 17307 . 18735)) (18803 22734 (CHANGE.INDEX 18813 . 19381) (CHANGE.INDEXENTRY 19383 .
20133) (CHANGE.XINDEX.KEY 20135 . 20693) (CHANGE.XINDEX.ENTRY 20695 . 21328) (CHANGE.XINDEX.FONT 21330
. 22199) (CHANGE.XINDEX.NUMBER 22201 . 22732)) (22776 30497 (GETHASH.INDEX 22786 . 23453) (
INDEX.PAGE.NUMBER 23455 . 25034) (INDEX.MANUAL.DELIMITER 25036 . 25727) (INDEX.STRING 25729 . 26739) (
GET.INDEXENTRY.NUMBER 26741 . 27761) (INDEX.LIST.REFS 27763 . 29253) (LIST.OF.INDEXENTRIES 29255 .
30495)) (30539 40743 (CREATE.INDEX.FILE 30549 . 32428) (DUMP.INDEX 32430 . 34850) (VIEW.INDEX.FILE
34852 . 36116) (GET.INDEX.FILE 36118 . 36508) (WRITE.INDEX.FILE 36510 . 38911) (
WRITE.INDEX.PAGENUMBERS 38913 . 40113) (RESET.INDEX.PAGENUMBERS 40115 . 40741)) (40941 44995 (
SELECTION.TO.STRING 40951 . 43783) (SELECTION.TO.INDEX 43785 . 44993)))))
STOP

BIN
lispusers/TMAX/TMAX-INDEX.LCOM Normal file
View File

Binary file not shown.

27
lispusers/TMAX/TMAX-INTRO.TXT Normal file
View File

@@ -0,0 +1,27 @@
TMAX Introduction
TMAX (Tedit Macros And eXtensions) is a package that extends the
capabilities of TEdit by providing a menu of commands that allow the
user to do such things as indexing, writing a sorted index file,
arbitrary numbering, creating a list of notes, referencing numbered
objects by their numeric value, and writing a table-of-contents file.
There is also an extensive help file describing all the features of
TMAX. Rather than include examples of how to use these features, the
help file was written using these features and is both an example and
a description of using TMAX.
Before you can read the help file, you must first load the TMAX.DCOM
file from the {CSLI}<LISP.KOTO> directory. Then copy
{CSLI}<LISP.KOTO>TMAX.TEDIT to your local disk. Open up a TEdit window
and do a TEdit Get on {DSK}TMAX.TEDIT. The reason for copying the file
to the local disk is that, due to problems with the leaf server on
csli, TMAX runs a lot smoother when the source files are on non-leaf
hosts.
When you load the TMAX.TEDIT file, you will see the TMAX menu appended
to the top of your TEdit window. You invoke TMAX commands by buttoning
items in this menu. If you would like a hardcopy of the help file,
first button Update and then Insert Endnotes (both in the TMAX menu).
Then point the mouse at the black title bar at the top of the TEdit
window and select Hardcopy from the right button menu.

456
lispusers/TMAX/TMAX-NGRAPH Normal file
View File

@@ -0,0 +1,456 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10)
(filecreated "30-Dec-87 11:35:45" |{POGO:AISNORTH:XEROX}<CUTTING>TMAX>TMAX-NGRAPH.;2| 25361
|previous| |date:| "11-Nov-87 11:56:01" |{POGO:AISNORTH:XEROX}<CUTTING>TMAX>TMAX-NGRAPH.;1|)
; Copyright (c) 1987 by Xerox Corporation. All rights reserved.
(prettycomprint tmax-ngraphcoms)
(rpaqq tmax-ngraphcoms
((* |Developed| |under| |support| |from| nih |grant| rr-00785.)
(* |Written| |by| |Frank| |Gilmurray| |and| |Sami| |Shaio.|)
(* * |Number| |Group| graph |functions|)
(fns graphmenu initial.ngroup.graph ngroup.make.rootnode tspgraphregion close.ngroup.graph
ngroup.graph.closefn add.ngroup.to.mother.node add.node.to.graph collect.hasharray
create.ngroup.node get.fromnodes get.tonodes find.node tsp.get.ngroup.array tsp.legalid
list.ancestors toplevel.sisters get.ngroup.mother)
(* * |Number| |counting| |functions|)
(fns downdate.numberobjs update.numberobjs reset.dependent.classes reset.ncounter
get.ncounter ncounter? flatten.tree.to.string ngroup.chartype ngroup.chartype.convert
number.to.letter remove.all.counters)))
(* |Developed| |under| |support| |from| nih |grant| rr-00785.)
(* |Written| |by| |Frank| |Gilmurray| |and| |Sami| |Shaio.|)
(* * |Number| |Group| graph |functions|)
(defineq
(graphmenu
(lambda (tstream twindow) (* |fsg| "11-Jul-87 12:17")
(let* ((graph (or (and (not (windowprop twindow 'rebuild.graphflg))
(windowprop twindow 'ngroup.graph))
(initial.ngroup.graph twindow)))
(region (tspgraphregion graph twindow t))
(graphw (createw region "Number Group Graph" nil t)))
(and (ngroupmenu.enabled? twindow)
(close.ngroup.graph twindow))
(windowprop graphw 'repaintfn nil)
(attachwindow graphw 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 (function ngroup.graph.closefn))
(windowprop graphw 'twindow twindow)
(windowprop graphw 'tstream tstream))))
(initial.ngroup.graph
(lambda (window) (* |ss:| "27-Jun-87 16:56")
(let* ((rootnode (ngroup.make.rootnode))
(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)))))
(ngroup.make.rootnode
(lambda nil (* |ss:| "27-Jun-87 16:14")
(nodecreate 'new.ngroup '|NGroups| nil nil nil (fontcreate 'helvetica 10 'brr)
1)))
(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)))
(close.ngroup.graph
(lambda (twindow) (* |fsg| "11-Jul-87 12:51")
(* * |Program| |invoked| |close| |of| |the| |NGroup| |menu| |graph| |window.|
 program.close |is| |used| |to| |distinguish| |between| |our| |closing| |the|
 |window| |and| |the| |user| |buttoning| |the| |Window| |Menu| close |command.|)
(let ((graph.window (windowprop twindow 'ngroupw)))
(windowprop graph.window 'program.close t)
(freeattachedwindow graph.window)
(closew graph.window))))
(ngroup.graph.closefn
(lambda (graph.window) (* \; "Edited 29-Sep-87 15:04 by fsg")
(* * |Clean| |up| \a |few| |things| |when| |user| close\s |the| |NGroup| |menu|
 |graph| |window.|)
(or (windowprop graph.window 'program.close)
(let ((twindow (windowprop graph.window 'twindow)))
(fm.changestate (fm.getitem 'ngroup.menu nil (windowprop twindow 'imageobj.menuw))
nil
(windowprop twindow 'imageobj.menuw))
(freeattachedwindow graph.window)))))
(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:| "27-Jun-87 15:57")
(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:| "27-Jun-87 16:03")
(let ((result nil))
(maphash harray (function (lambda (val ky)
(setq result (cons val result)))))
result)))
(create.ngroup.node
(lambda (id mother userdata w) (* |fsg| "22-Jun-87 13:27")
(let* ((ngroup.harray (tsp.get.ngroup.array w))
(node (gethash id ngroup.harray)))
(or node (let ((new.node (selectq id
(new.ngroup (ngroup.make.rootnode))
(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.tonodes
(lambda (ngid window) (* |fsg| "28-Jul-87 10:54")
(* * i\f ngid |has| |only| |one| |child| |then| |return| |that| |child's|
 |name| |as| |an| |atom.| |Else| |return| |the| |list| |of| |NGID's| |children.|)
(* * a\s |of| |the| |date| |above,| |this| |function| |is| not |called.|)
(let ((tonodes (|fetch| (graphnode tonodes) |of| (find.node ngid window))))
(cond
((cdr tonodes)
(reverse tonodes))
(t (car tonodes))))))
(find.node
(lambda (ngid window) (* |fsg| " 4-Mar-87 10:22")
(cadr (gethash ngid (tsp.get.ngroup.array window)))))
(tsp.get.ngroup.array
(lambda (window) (* |ss:| "27-Jun-87 16:21")
(windowprop window 'tsp.ngroup.array)))
(tsp.legalid
(lambda (prev.ngroups stream) (* |fsg| " 3-Aug-87 17:04")
(* * |Get| \a |new| |NGroup| id |and| |make| |sure| |it's| |not| |already|
 |defined.|)
(let ((ngroup.id (mkatom (tedit.getinput stream "Group name:"))))
(|while| (member ngroup.id prev.ngroups)
|do| (setq ngroup.id (mkatom (tedit.getinput stream (concat ngroup.id
(cond
((eq ngroup.id 'new.ngroup)
" is a reserved name...Group name:"
)
(t
" already exists...Group name:"
)))))))
ngroup.id)))
(list.ancestors
(lambda (nid ancestors window) (* |ss:| "27-Jun-87 16:09")
(* * |Return| \a |list| |of| |the| |parents| |of| |the| |given| |node.|)
(let ((mother (get.fromnodes nid window)))
(cond
((and mother (neq mother 'new.ngroup))
(list.ancestors mother (cons mother ancestors)
window))
(t ancestors)))))
(toplevel.sisters
(lambda (window) (* |ss:| "27-Jun-87 16:21")
(* * |Returns| \a |list| |of| |the| |top| |level| |NGroup| |nodes.|
 a |top| |level| |node| |is| \a |node| |whose| |mother| |is| new.ngroup.)
(reverse (|fetch| (graphnode tonodes) |of| (find.node 'new.ngroup window)))))
(get.ngroup.mother
(lambda (ngid window) (* |fsg| " 4-Mar-87 11:24")
(* * |Return| |the| |top| |level| |mother| |of| \a |branch| |of| |the| |Ngroup|
 |tree.|)
(let ((ancestors (list.ancestors ngid nil window)))
(cond
(ancestors (car ancestors))
(t (cond
((find.node ngid window)
ngid)
(t nil)))))))
)
(* * |Number| |counting| |functions|)
(defineq
(downdate.numberobjs
(lambda (window stream objselectfn) (* |fsg| "25-Sep-87 09:45")
(* * |Undoes| |what| update.numberobjs |does.|)
(let ((nbrobj.list (tsp.list.of.objects (textobj window)
objselectfn)))
(and nbrobj.list
(progn (tedit.promptprint stream (concat "Undoing Update of " (selectq objselectfn
(ngroupp
"Number Groups")
(endnotep "Endnotes")
"Number Groups and Endnotes"
)
"...")
t)
(|for| nbrobj |in| nbrobj.list
|do| (let ((datum (|fetch| objectdatum |of| (car nbrobj))))
(|with| numberobj datum (setq page.number nil)
(and updated.obj
(progn (setq updated.obj nil)
(|replace| (ngtemplate ng.currentval)
|of| template |with| nil)
(setq numstring
(selectq use
(ngroup (concat "[" ref.type "]"))
(note "Note#")
nil))
(tedit.object.changed stream (car nbrobj)))))))
(tedit.promptprint stream "done"))))))
(update.numberobjs
(lambda (window stream objselectfn) (* |fsg| "25-Sep-87 09:34")
(* * |Convert| |the| |NGroup| |and| |Endnote| |markers| |to| |their|
 |corresponding| |numeric| |values.|)
(let ((nbrobj.list (tsp.list.of.objects (textobj window)
objselectfn)))
(and nbrobj.list (progn (tedit.promptprint stream (concat "Updating " (selectq objselectfn
(ngroupp
"Number Groups")
(endnotep
"Endnotes")
"Number Groups and Endnotes"
)
"...")
t)
(|for| nbrobj |in| nbrobj.list
|do| (let ((datum (|fetch| objectdatum |of| (car nbrobj)))
new.count)
(|with| numberobj datum (reset.dependent.classes window
use ref.type)
(setq new.count
(get.ncounter window use ref.type ngroup.mother
template datum))
(and (neq new.count numstring)
(progn (setq numstring new.count)
(setq updated.obj t)
(tedit.object.changed stream
(car nbrobj))))))
|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 nbr.datum)
(* |fsg| "11-Aug-87 15:26")
(let ((counter (ncounter? window use ref.type template)))
(and counter (progn (|with| ngcounter counter (|add| ncount 1)
(and (eq use 'ngroup)
template
(|replace| (ngtemplate ng.currentval) |of| template
|with| ncount)))
(cond
(mother.class (flatten.tree.to.string window use ref.type nbr.datum))
(t (mkstring (|fetch| ncount |of| counter)))))))))
(ncounter?
(lambda (window use ref.type template) (* |fsg| "14-Jul-87 14:10")
(* * |Return| |the| |record| |for| |this| |number| |counter.|
 i\f |the| |record| |doesn't| |exist,| |we| |create| |one| |based| |on| |the|
 use |value.|)
(let ((counter.id (mkatom (concat (selectq use
(ngroup (concat "NGROUP." ref.type "."))
(note "ENDNOTE.")
(error "Unknown NUMBER 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))))))
(flatten.tree.to.string
(lambda (window use ref.type nbr.datum) (* |fsg| " 5-Aug-87 14:12")
(let* ((ngroup.counter (ncounter? window use ref.type))
(ngroup.list (append (|fetch| (ngcounter ancestry) |of| ngroup.counter)))
(abbrevval (|with| numberobj nbr.datum (and abbrev-val (list.ancestors abbrev-val nil
window))))
(flat.tree "")
ancestor)
(and ngroup.list (|while| (setq ancestor (|pop| ngroup.list))
|do| (or (and abbrevval (memb ancestor abbrevval))
(setq flat.tree (concat flat.tree
(ngroup.chartype window ancestor
(|fetch| (ngcounter ncount)
|of| (ncounter? window use
ancestor))
(or (car ngroup.list)
ref.type)))))))
(setq flat.tree (concat flat.tree (ngroup.chartype window ref.type (|fetch| (ngcounter
ncount)
|of| ngroup.counter)
nil))))))
(ngroup.chartype
(lambda (window ref.type ncount next.ngroup) (* |fsg| "11-Aug-87 15:23")
(* * |Convert| |the| |number| ncount |to| |the| |format| |specified| |in|
 template. delimitflg |is| |the| |next| |NGroup's| |preceding| |delimiter| |or|
 nil |if| |either| |the| |next| |NGroup| |has| |no| |preceding| |delimiter| |or|
 |there| |is| |no| |next| |NGroup.|)
(let ((delimitflg (and next.ngroup (|with| ngtemplate (|fetch| (numberobj template)
|of| (car (gethash next.ngroup
(tsp.get.ngroup.array
window))))
ng.text-before))))
(|with| ngtemplate (|fetch| (numberobj template) |of| (car (gethash ref.type (
 tsp.get.ngroup.array
window))))
(concat (or ng.text-before "")
(ngroup.chartype.convert ng.chartype ncount)
(cond
(delimitflg "")
(t (or ng.text-after ""))))))))
(ngroup.chartype.convert
(lambda (chartype ncount) (* |fsg| "28-Jul-87 11:12")
(* * |Convert| |the| |value| ncount |to| |the| |type| |specified| |by|
 chartype. i\f ncount < 1 |and| chartype |is| |Letter/Roman| |then| |we|
 |return| nil. |This| |anomaly| |is| |usually| |caused| |by| |out-of-order|
 |NGroups.|)
(cond
((fixp ncount)
(cond
((or (igreaterp ncount 0)
(eq chartype '|Number|)
(eq chartype '|Null String|))
(selectq chartype
(uppercase\ letter
(number.to.letter ncount t))
(|lowercase letter|
(number.to.letter ncount))
(uppercase\ roman
(romannumerals ncount t))
(|lowercase roman|
(romannumerals ncount))
(|Null String| "")
(|Number| (mkstring ncount))
(error "Unknown display type" chartype)))
(t (mkstring nil))))
(t (error "Invalid integer" ncount)))))
(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))))
)
(putprops tmax-ngraph copyright ("Xerox Corporation" 1987))
(declare\: dontcopy
(filemap (nil (1425 11144 (graphmenu 1435 . 2488) (initial.ngroup.graph 2490 . 3059) (
ngroup.make.rootnode 3061 . 3282) (tspgraphregion 3284 . 3876) (close.ngroup.graph 3878 . 4462) (
ngroup.graph.closefn 4464 . 5065) (add.ngroup.to.mother.node 5067 . 5461) (add.node.to.graph 5463 .
6568) (collect.hasharray 6570 . 6856) (create.ngroup.node 6858 . 7535) (get.fromnodes 7537 . 7737) (
get.tonodes 7739 . 8326) (find.node 8328 . 8501) (tsp.get.ngroup.array 8503 . 8669) (tsp.legalid 8671
. 9832) (list.ancestors 9834 . 10278) (toplevel.sisters 10280 . 10662) (get.ngroup.mother 10664 .
11142)) (11189 25278 (downdate.numberobjs 11199 . 13348) (update.numberobjs 13350 . 15883) (
reset.dependent.classes 15885 . 16258) (reset.ncounter 16260 . 17044) (get.ncounter 17046 . 17876) (
ncounter? 17878 . 19663) (flatten.tree.to.string 19665 . 21370) (ngroup.chartype 21372 . 22825) (
ngroup.chartype.convert 22827 . 24000) (number.to.letter 24002 . 24992) (remove.all.counters 24994 .
25276)))))
stop

BIN
lispusers/TMAX/TMAX-NGRAPH.LCOM Normal file
View File

Binary file not shown.

799
lispusers/TMAX/TMAX-NGROUP Normal file
View File

@@ -0,0 +1,799 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10)
(FILECREATED "25-Jan-97 11:49:57" |{DSK}<project>medley2.0>lispusers>TMAX-NGROUP.;2| 47901
|changes| |to:| (FNS CONVERT.TABS.TO.SPACES)
|previous| |date:| "30-Dec-87 11:34:27" |{DSK}<project>medley2.0>lispusers>TMAX-NGROUP.;1|)
; Copyright (c) 1987, 1997 by Xerox Corporation. All rights reserved.
(PRETTYCOMPRINT TMAX-NGROUPCOMS)
(RPAQQ TMAX-NGROUPCOMS
((* |Developed| |under| |support| |from| NIH |grant| RR-00785.)
(* |Written| |by| |Frank| |Gilmurray| |and| |Sami| |Shaio.|)
(* * |Other| |unsorted| |functions|)
(FNS INSERT.NGROUP VERIFY.NGROUP.ORDER GET.PREVIOUS.NGROUPS ADD.NUMBER.GROUP
ADD.NGROUP.TO.DBASE COLLECT.NGROUPS LIST.FONT.PROPS MAP.NGROUP.LOOKS NGROUP.GETFONT
CHANGE.NGROUP CHANGE.NGROUP.FONT SHOW.NGROUP.FONT CHANGE.NGROUP.FORMAT
SHOW.NGROUP.FORMAT CHANGE.NGROUP.FORMAT.TXTBEFORE CHANGE.NGROUP.FORMAT.DISPLAY
CHANGE.NGROUP.FORMAT.TXTAFTER GET.NGROUP.DELIMITER CHANGE.NGROUP.FORMAT.ABBREV
CHANGE.NGROUP.FORMAT.START GET.NGROUP.START CHANGE.NGROUP.FORMAT.TOC
CHANGE.NGROUP.FORMAT.MANINDEX UPDATE.NGROUP.MANINDEX NGROUP.FIXUP.RECORDS)
(* * |Table-of-Contents| |functions|)
(FNS GET.NGROUP.TEXTSTRING CONVERT.TABS.TO.SPACES CREATE.TOC.FILE NGROUP.TOC.ENTRIES
VIEW.TOC.FILE GET.TOC.FILE WRITE.TOC.FILE WRITE.TOC.ENTRY)))
(* |Developed| |under| |support| |from| NIH |grant| RR-00785.)
(* |Written| |by| |Frank| |Gilmurray| |and| |Sami| |Shaio.|)
(* * |Other| |unsorted| |functions|)
(DEFINEQ
(insert.ngroup
(lambda (node graphw) (* |fsg| "26-Aug-87 14:37")
(* * |Insert| \a |NGroup| |build| |from| |the| |prototype| |definition.|)
(and node (let* ((twindow (windowprop graphw 'twindow))
(tstream (windowprop graphw 'tstream))
(label (|fetch| (graphnode nodeid) |of| node))
(oldlooks (|fetch| caretlooks |of| (textobj tstream)))
(newlooks (ngroup.getfont label twindow)))
(|with| numberobj (car (gethash label (tsp.get.ngroup.array twindow)))
(selectq label
(new.ngroup nil)
(let ((newobj (numberobj 'ngroup template (concat "[" label "]")
label newlooks (get.fromnodes label twindow)
abbrev-val)))
(tedit.caretlooks tstream newlooks)
(get.ngroup.textstring newobj label tstream twindow)
(imageobjprop newobj 'twindow twindow)
(tedit.insert.object newobj tstream)
(tedit.caretlooks tstream oldlooks)
(and (update? twindow)
(update.numberobjs twindow tstream 'ngroupp))
(verify.ngroup.order twindow newobj))))))))
(verify.ngroup.order
(lambda (window ngroup.obj) (* |fsg| "28-Jul-87 15:59")
(* * |Verify| |the| |NGroup| |order| |before| |inserting| \a |new| |NGroup.|
 |The| |order| |is| |valid| |if| |the| |new| |NGroup| |is| \a |top| |level|
 |node| |or| |its| |parent| |Ngroup| |has| |already| |been| |inserted.|)
(let* ((mother (|with| numberobj (|fetch| objectdatum |of| ngroup.obj)
ngroup.mother))
(selection (tedit.getsel (textstream window)))
(ch# (and selection (|fetch| ch# |of| selection))))
(cond
((or (eq mother 'new.ngroup)
(and ch# (|for| prev.ngroup |in| (tsp.list.of.objects (textobj window)
(function get.previous.ngroups)
ch#)
|thereis| (eq mother (|with| numberobj (|fetch| objectdatum
|of| (car prev.ngroup))
ref.type)))))
(tedit.promptprint (textstream window)
"" t))
(t (tedit.promptprint (textstream window)
(concat "Warning...\"" (|with| numberobj (|fetch| objectdatum |of| ngroup.obj)
ref.type)
"\" is not preceded by \"" mother "\" NGroup.")
t)
(flashwindow (|with| textobj (textobj window)
promptwindow)
2))))))
(get.previous.ngroups
(lambda (ngroup.obj char.pos) (* |fsg| "28-Jul-87 14:01")
(* * |Called| |from| tsp.list.of.objects |to| |collect| |all| |the| |NGroup|
 |ImageObjs| |that| |exist| |before| |the| |character| |position| char.pos.)
(and (ngroupp ngroup.obj)
(ilessp ch# char.pos))))
(add.number.group
(lambda (twindow stream) (* \; "Edited 30-Sep-87 14:34 by fsg")
(or (ngroupmenu.enabled? twindow)
(progn (fm.changestate (fm.getitem 'ngroup.menu nil (windowprop twindow 'imageobj.menuw))
t
(windowprop twindow 'imageobj.menuw))
(graphmenu stream twindow)))
(let* ((prev.items (collect.ngroups twindow))
(new.groupid (mkatom (tsp.legalid (cons 'new.ngroup prev.items)
stream)))
template dependent.class new.node)
(prog1 (cond
(new.groupid (setq dependent.class
(or (mkatom (and prev.items
(menu (|create| menu
title _ "Parent Group?"
items _ (sort prev.items 'ualphorder)
))))
'new.ngroup))
(or template
(setq template
(|create| ngtemplate
ng.chartype _ '|Number|
ng.text-before _ nil
ng.text-after _ "."
ng.start _ 1
ng.addtotoc _ t
ng.currentval _ nil
ng.manualindex _ nil)))
(setq new.node (nodecreate new.groupid new.groupid nil nil (list
dependent.class
)))
(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))
(tedit.promptprint stream "" t)))))
(add.ngroup.to.dbase
(lambda (new.groupid template dependent.class font ngroup.node twindow)
(* |fsg| " 3-Aug-87 16:43")
(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) (* |fsg| " 3-Aug-87 10:03")
(and (fontp fontdes)
(list (fontprop fontdes 'family)
(fontprop fontdes 'size)
(fontprop fontdes 'face)))))
(map.ngroup.looks
(lambda (label new.font twindow new.template) (* |fsg| " 5-Aug-87 13:40")
(* * |Here| |to| |change| |the| |font| |or| |format| |of| |an| |NGroup.|
 i\f new.template |is| |non-NIL| |then| |we| |are| |changing| |the| |format,|
 |else| |we| |are| |changing| |the| |font.|)
(tedit.promptprint (textstream twindow)
(concat "Updating " (cond
(new.template "FORMAT")
(t "FONT"))
" for \"" label "\" Ngroups...")
t)
(|for| ngroup.obj |in| (tsp.list.of.objects (textobj twindow)
`(lambda (obj)
(and (ngroupp obj)
(eq (fetch ref.type of (fetch objectdatum of obj))
\,
(kwote label)))))
|do| (|with| numberobj (|fetch| objectdatum |of| (car ngroup.obj))
(cond
(new.template (setq template new.template))
(t (tedit.looks (textstream twindow)
new.font
(cadr ngroup.obj)
1)
(setq font new.font)))))
(tedit.promptprint (textstream twindow)
"Done.")))
(ngroup.getfont
(lambda (ngroup.name window ngroup.obj) (* |fsg| " 4-Aug-87 15:00")
(* * |Get| |an| |NGroup's| |font.| i\f ngroup.obj |is| |non-NIL| |then| |we|
 |get| |the| |font| |from| |this| |ImageObj's| objectdatum.
 |Else| |we| |get| |the| |font| |from| |the| |NGroup| |graph| |prototype|
 |NGroup.|)
(|fetch| (numberobj font) |of| (cond
(ngroup.obj (|fetch| objectdatum |of| ngroup.obj))
(t (car (gethash ngroup.name (tsp.get.ngroup.array window))))))
))
(change.ngroup
(lambda (node graphw) (* |fsg| "30-Jul-87 13:52")
(* * |Here| |when| |number| |group| |node| |is| |middle| |buttoned.|
 |Allow| |user| |to| |change| |the| |font| |and/or| |format| |of| |the|
 |ngroup.|)
(and node (let ((label (|fetch| (graphnode nodeid) |of| node)))
(selectq label
(new.ngroup nil)
(menu (|create| menu
title _ (mkstring label)
centerflg _ t
items _ (eval ngroup.graph.menu.items))))))))
(change.ngroup.font
(lambda (label graphw font.field ngroup.obj) (* |fsg| " 4-Aug-87 15:09")
(* * |Change| \a |NGroup| |font.| i\f |NGROUP.OBJis| |non-NIL| |then| |we|
 |are| |working| |on| |an| |inserted| |NGroup.|
 |Else| |we| |are| |working| |on| |the| |graph| |prototype| |NGroups.|)
(let ((stream (windowprop graphw 'tstream))
(window (windowprop graphw 'twindow))
new.font)
(show.ngroup.font label graphw ngroup.obj)
(tedit.promptprint stream (selectq font.field
(family ", change Family to...")
(size ", change Size to...")
(face ", change Face to...")
", change to..."))
(|with| numberobj (cond
(ngroup.obj (|fetch| objectdatum |of| ngroup.obj))
(t (car (gethash label (tsp.get.ngroup.array window)))))
(setq new.font (fontcreate (get.tsp.font window font font.field)))
(tedit.promptprint stream "" t)
(and (neq font new.font)
(progn (setq font new.font)
(cond
(ngroup.obj new.font)
(t (map.ngroup.looks label new.font window)))))))))
(show.ngroup.font
(lambda (label graphw ngroup.obj) (* |fsg| " 4-Aug-87 14:57")
(* * |Show| |this| |NGroup's| |font| |specification.|)
(let* ((stream (windowprop graphw 'tstream))
(window (windowprop graphw 'twindow))
(font.list (abbreviate.font (ngroup.getfont label window ngroup.obj))))
(tedit.promptprint stream (concat label ": Family=" (|pop| font.list)
" Size="
(|pop| font.list)
" Face="
(|pop| font.list))
t))))
(change.ngroup.format
(lambda (label graphw format.field) (* |fsg| " 1-Sep-87 15:39")
(* * |Change| |the| |entire| |format| |or| \a |selected| |field| |of| |an|
 |NGroup.|)
(let ((window (windowprop graphw 'twindow))
(new.format (|for| field |in| (cond
(format.field (list format.field))
(t '(txtbefore display txtafter abbrevval start toc
manindex)))
|collect| (selectq field
(txtbefore (change.ngroup.format.txtbefore label graphw))
(display (change.ngroup.format.display label graphw))
(txtafter (change.ngroup.format.txtafter label graphw))
(abbrevval (change.ngroup.format.abbrev label graphw))
(start (change.ngroup.format.start label graphw))
(toc (change.ngroup.format.toc label graphw))
(manindex (change.ngroup.format.manindex label graphw))
(error "Unknown NGroup Format field" field)))))
(and (apply 'or new.format)
(let ((nbrobj (car (gethash label (tsp.get.ngroup.array window)))))
(map.ngroup.looks label (|fetch| (numberobj font) |of| nbrobj)
window
(|fetch| (numberobj template) |of| nbrobj)))))))
(show.ngroup.format
(lambda (label graphw) (* |fsg| "26-Aug-87 12:02")
(* * |Show| |this| |NGroup's| |format| |specification.|)
(let ((stream (windowprop graphw 'tstream))
(window (windowprop graphw 'twindow)))
(|with| numberobj (car (gethash label (tsp.get.ngroup.array window)))
(|with| ngtemplate template (tedit.promptprint stream
(concat label ": Display="
(concat (cond
(ng.text-before (concat "\""
ng.text-before
"\""))
(t "\"\""))
ng.chartype
(cond
(ng.text-after (concat "\""
ng.text-after
"\""))
(t "\"\"")))
" Abbrev="
(or abbrev-val "None")
" Start=" ng.start " TOC=" (cond
(ng.addtotoc
"Yes")
(t "No"))
(cond
((manualindex.enabled? window)
(cond
(ng.manualindex " ManIndex=Yes")
(t " ManIndex=No")))
(t "")))
t))))))
(change.ngroup.format.txtbefore
(lambda (label graphw ngroup.obj) (* |fsg| " 5-Aug-87 10:11")
(* * |Show| |and| |possibly| |reset| |the| |delimiter| |preceding| |this|
 |NGroup.| |Return| nil |if| |nothing| |changed| |else| |return| |the| |new|
 |delimiter.| i\f ngroup.obj |is| |non-NIL| |then| |we| |are| |working| |on|
 |an| |inserted| |NGroup.| |Else| |we're| |working| |on| |the| |graph|
 |prototype.|)
(let ((stream (windowprop graphw 'tstream))
(window (windowprop graphw 'twindow))
new.delimiter)
(|with| ngtemplate (|fetch| (numberobj template) |of| (cond
(ngroup.obj (|fetch| objectdatum
|of| ngroup.obj))
(t (car (gethash label (
tsp.get.ngroup.array
window)))))
)
(and (setq new.delimiter (get.ngroup.delimiter stream label ng.text-before
'before))
(not (strequal new.delimiter ng.text-before))
(setq ng.text-before new.delimiter))))))
(change.ngroup.format.display
(lambda (label graphw ngroup.obj) (* |fsg| " 5-Aug-87 10:12")
(* * |Show| |and| |possibly| |reset| |how| |this| |NGroup| |is| |displayed.|
 |Return| nil |if| |nothing| |changed| |else| |returm| |the| |new| |display|
 |type.| i\f ngroup.obj |is| |non-NIL| |then| |we| |are| |working| |on| |an|
 |inserted| |NGroup.| |Else| |we're| |working| |on| |the| |graph| |prototype.|)
(let ((stream (windowprop graphw 'tstream))
(window (windowprop graphw 'twindow))
new.display)
(|with| ngtemplate (|fetch| (numberobj template) |of| (cond
(ngroup.obj (|fetch| objectdatum
|of| ngroup.obj))
(t (car (gethash label (
tsp.get.ngroup.array
window)))))
)
(tedit.promptprint stream (concat "\"" label "\" displayed as " ng.chartype
", change to...")
t)
(|until| (or (null (setq new.display
(menu (|create| menu
title _ "NGroup Displays"
centerflg _ t
items _ '(|Number| |Null String| uppercase\ letter
|lowercase letter| uppercase\ roman
|lowercase roman|)))))
(selectq new.display
((|Number| |Null String|)
t)
(igreaterp ng.start 0)))
|do| (tedit.promptprint stream (concat "Starting value (=" ng.start
") must be > 0 for \"" new.display
"\". Try again.")
t))
(tedit.promptprint stream "" t)
(and new.display (neq new.display ng.chartype)
(kwote (setq ng.chartype new.display)))))))
(change.ngroup.format.txtafter
(lambda (label graphw ngroup.obj) (* |fsg| " 5-Aug-87 10:12")
(* * |Show| |and| |possibly| |reset| |the| |delimiter| |following| |this|
 |NGroup.| |Return| nil |if| |nothing| |changed| |else| |return| |the| |new|
 |delimiter.| i\f ngroup.obj |is| |non-NIL| |then| |we| |are| |working| |on|
 |an| |inserted| |NGroup.| |Else| |we're| |working| |on| |the| |graph|
 |prototype.|)
(let ((stream (windowprop graphw 'tstream))
(window (windowprop graphw 'twindow))
new.delimiter)
(|with| ngtemplate (|fetch| (numberobj template) |of| (cond
(ngroup.obj (|fetch| objectdatum
|of| ngroup.obj))
(t (car (gethash label (
tsp.get.ngroup.array
window)))))
)
(and (setq new.delimiter (get.ngroup.delimiter stream label ng.text-after
'after))
(not (strequal new.delimiter ng.text-after))
(setq ng.text-after new.delimiter))))))
(get.ngroup.delimiter
(lambda (stream label delimiter before/after) (* |fsg| "17-Aug-87 15:12")
(* * |Show| |and| |possibly| |reset| |the| |delimiter| |before/after| |this|
 |NGroup.| |Return| nil |if| |nothing| |changed| |else| |return| |the| |new|
 |delimiter.|)
(tedit.promptprint stream (concat "Delimiter " (selectq before/after
(before "preceding ")
"following ")
label "\" is " (cond
(delimiter (concat "\"" delimiter "\""))
(t '|Unspecified|))
", change to...")
t)
(prog1 (menu (|create| menu
title _ "NGroup Delimiters"
centerflg _ t
items _ '((|Period| ".")
(|Colon| ":")
(|Dash| "-")
(|Null String| "")
(|Other| (tedit.getinput stream (concat "Specify delimiter "
(selectq before/after
(before "preceding ")
"following ")
label ":"))))))
(tedit.promptprint stream "" t))))
(change.ngroup.format.abbrev
(lambda (label graphw ngroup.obj) (* |fsg| "26-Aug-87 11:48")
(* * |Change| |the| |display| |level| |of| \a |NGroup.|
 |Let| |the| |user| |decide| |how| |far| |up| |the| |parent| |tree| |to| |go|
 |wrt| |printing| |values.| |This| |allows| |user| |to| |number| |things| |as|
 |2.a,| |b,| |c,| |etc.| |Thanks| |to| |Michael| |Wescoat| |at| |Xerox| |for|
 |suggesting| |this.|)
(let ((stream (windowprop graphw 'tstream))
(window (windowprop graphw 'twindow)))
(|with| numberobj (cond
(ngroup.obj (|fetch| objectdatum |of| ngroup.obj))
(t (car (gethash label (tsp.get.ngroup.array window)))))
(let ((parents (list.ancestors label nil window)))
(cond
(parents (tedit.promptprint stream (concat label (cond
(abbrev-val (concat
" abbreviation starts at "
abbrev-val))
(t " not abbreviated"))
". Select starting level.")
t)
(let ((new.abrev (menu (|create| menu
title _ (concat label " Levels")
items _ (append parents (list label))
centerflg _ t))))
(and new.abrev (neq new.abrev abbrev-val)
(true (setq abbrev-val (cond
((eq new.abrev (car parents))
nil)
(t new.abrev)))))))
(t (tedit.promptprint stream (concat "Cannot abbreviate top level NGroup \""
label "\"")
t))))))))
(change.ngroup.format.start
(lambda (label graphw) (* |fsg| " 9-Jul-87 15:45")
(* * |Show| |and| |possibly| |reset| |this| |NGroup's| |starting| |value.|
 |Return| nil |if| |nothing| |changed| |else| |return| |the| |new| |starting|
 |value.|)
(let ((window (windowprop graphw 'twindow))
new.start)
(|with| ngtemplate (|fetch| (numberobj template) |of| (car (gethash label (
tsp.get.ngroup.array
window))))
(and (setq new.start (get.ngroup.start label ng.chartype ng.start (windowprop
graphw
'tstream)))
(neq new.start ng.start)
(setq ng.start new.start))))))
(get.ngroup.start
(lambda (label display start stream) (* |fsg| "23-Jul-87 14:38")
(* * |Get| |the| |starting| |value| |for| |this| |NGroup.|
 |Any| |value| |is| |ok| |for| \a |Number| |display| |but| |Letter/Roman|
 |numeral| |values| |must| |be| |greater| |than| |zero.|)
(let ((prompt.string (concat "Starting value of \"" label "\" is " start))
new.start)
(|until| (or (null (setq new.start (mkatom (tedit.getinput stream (concat prompt.string
". New starting value:"
)))))
(cond
((not (fixp new.start))
(setq prompt.string (concat new.start " is not an integer"))
nil)
(t (selectq display
((|Number| |Null String|)
t)
(cond
((ileq new.start 0)
(setq prompt.string (concat "Start (=" new.start
") must be > 0 for \"" display "\""))
nil)
(t t)))))))
new.start)))
(change.ngroup.format.toc
(lambda (label graphw) (* |fsg| " 7-Jul-87 09:12")
(* * |Show| |and| |possibly| |reset| |whether| |this| |NGroup| |is| |included|
 |in| |the| |Table-Of¬Contents.| |Return| nil |if| |no| |change| |else| |return|
 t.)
(let ((stream (windowprop graphw 'tstream))
(window (windowprop graphw 'twindow))
new.addtotoc)
(|with| ngtemplate (|fetch| (numberobj template) |of| (car (gethash label (
tsp.get.ngroup.array
window))))
(tedit.promptprint stream (concat "\"" label "\" is " (cond
(ng.addtotoc "")
(t "NOT "))
"included in the TOC. Do you want it included?")
t)
(setq new.addtotoc (menu (|create| menu
title _ "In TOC?"
centerflg _ t
items _ '((yes t)
(no nil))
whenselectedfn _ (function (lambda (item)
item)))))
(tedit.promptprint stream "" t)
(and new.addtotoc (neq (cadr new.addtotoc)
ng.addtotoc)
(progn (setq ng.addtotoc (cadr new.addtotoc))
t))))))
(change.ngroup.format.manindex
(lambda (label graphw) (* |fsg| " 1-Sep-87 15:39")
(* * |Show| |and| |possibly| |reset| |whether| |this| |NGroup| |is| |included|
 |in| |the| |manual| |index.| |Return| nil |if| |no| |change| |else| |return| t.)
(let ((stream (windowprop graphw 'tstream))
(window (windowprop graphw 'twindow))
new.manualindex)
(and (manualindex.enabled? window)
(|with| ngtemplate (|fetch| (numberobj template) |of| (car (gethash label (
tsp.get.ngroup.array
window))))
(tedit.promptprint stream (concat "\"" label "\" is " (cond
(ng.manualindex "")
(t "NOT"))
" included in the Manual Index. Do you want it included?"
)
t)
(setq new.manualindex (menu (|create| menu
title _ "Manual Index?"
centerflg _ t
items _ '((yes t)
(no nil))
whenselectedfn _ (function (lambda (item)
item)))))
(tedit.promptprint stream "" t)
(and new.manualindex (neq (cadr new.manualindex)
ng.manualindex)
(true (cond
((setq ng.manualindex (cadr new.manualindex))
(windowaddprop window 'manualgroups label))
(t (windowdelprop window 'manualgroups label))))))))))
(update.ngroup.manindex
(lambda (template label window) (* |ss:| "27-Jun-87 16:22")
(* * |Update| |the| |NGroup| |template| |list| |wrt| |the| |current| |NGroup|
 |level.| |Note| |that| |when| \a |new| |NGroup| |is| |seen,| |all| |it's|
 |children| |become| |undefined.| |Furthermore| |we| |know| |the| |NGroups|
 |are| |in| |order| |since| |the| |order| |is| |verified| |when| |the| |NGroup|
 |is| |inserted.|)
(and (manualindex.enabled? window)
(let* ((man.groups (windowprop window 'manualgroups))
(label.groups (memb label man.groups)))
(and label.groups (let* ((label.offset (add1 (idifference (length man.groups)
(length label.groups))))
(man.templates (windowprop window 'manualtemplates))
(template.sublist (nth man.templates label.offset)))
(cond
(template.sublist (rplnode template.sublist template))
(t (windowaddprop window 'manualtemplates template)))))))))
(ngroup.fixup.records
(lambda (ngroup.record copyflg) (* |fsg| " 3-Sep-87 15:35")
(* * |Function| |to| "fix up" |the| |NGroup| |record.|
 |This| |allows| |us| |to| |expand| |the| |NGroup| |record| |and| |still|
 |maintain| |backwatd| |compatability.| i\f copyflg |is| |non-NIL,| |we| |are|
 |doing| \a copy. i\n |this| |case| |un-update| |the| |record;|
 |Copied| |NGroups| |are| |always| |unupdated.|)
(let ((template (|fetch| (numberobj template) |of| ngroup.record)))
(|create| numberobj
ref.type _ (|fetch| (numberobj ref.type) |of| ngroup.record)
numstring _ (cond
(copyflg (selectq (|fetch| (numberobj use) |of| ngroup.record)
(ngroup (concat "[" (|fetch| (numberobj ref.type)
|of| ngroup.record)
"]"))
(note "Note#")
nil))
(t (|fetch| (numberobj numstring) |of| ngroup.record)))
use _ (|fetch| (numberobj use) |of| ngroup.record)
ngroup.mother _ (|fetch| (numberobj ngroup.mother) |of| ngroup.record)
template _ (|create| ngtemplate
ng.chartype _ (|fetch| (ngtemplate ng.chartype) |of| template)
ng.text-before _ (|fetch| (ngtemplate ng.text-before) |of| template
)
ng.text-after _ (|fetch| (ngtemplate ng.text-after) |of| template)
ng.start _ (|fetch| (ngtemplate ng.start) |of| template)
ng.addtotoc _ (|fetch| (ngtemplate ng.addtotoc) |of| template)
ng.currentval _ (cond
(copyflg nil)
(t (|fetch| (ngtemplate ng.currentval)
|of| template)))
ng.manualindex _ (|fetch| (ngtemplate ng.manualindex) |of| template
))
updated.obj _ (cond
(copyflg nil)
(t (|fetch| (numberobj updated.obj) |of| ngroup.record)))
text.after# _ (|fetch| (numberobj text.after#) |of| ngroup.record)
page.number _ (|fetch| (numberobj page.number) |of| ngroup.record)
font _ (|fetch| (numberobj font) |of| ngroup.record)
text.before# _ (|fetch| (numberobj text.before#) |of| ngroup.record)
abbrev-val _ (|fetch| (numberobj abbrev-val) |of| ngroup.record)))))
)
(* * |Table-of-Contents| |functions|)
(DEFINEQ
(get.ngroup.textstring
(lambda (nbrobj label stream window) (* |fsg| " 5-Aug-87 10:36")
(* * |Get| |the| |Table-Of-Contents| |before/after| |text| |string| |for|
 |this| |NGroup.| |Because| |the| write.toc.file |function| |uses| \a |tab| |to|
 |align| |the| |page| |numbers,| |any| |tabs| |in| |the| toc |strings| |are|
 |converted| |to| |spaces.|)
(and (textbefore.enabled? window)
(let ((toc.string (tedit.getinput stream (concat "Text before " label ":")
(mkstring label))))
(and toc.string (|replace| (numberobj text.before#) |of| (|fetch| objectdatum
|of| nbrobj)
|with| (concat (convert.tabs.to.spaces toc.string)
" ")))))
(and (textafter.enabled? window)
(let ((toc.string (tedit.getinput stream (concat "Text after " label ":"))))
(and toc.string (|replace| (numberobj text.after#) |of| (|fetch| objectdatum
|of| nbrobj)
|with| (concat " " (convert.tabs.to.spaces toc.string))))))))
(CONVERT.TABS.TO.SPACES
(LAMBDA (STRING) (* \; "Edited 25-Jan-97 11:49 by rmk:")
(* |fsg| "10-Mar-87 11:01")
(* |;;| "Returns a string with all tabs and CR's converted to spaces. We do this because some features like the Table-Of-Contents use a tab to align the page numbers.")
(AND (STRINGP STRING)
(CONCATLIST (FOR CHAR IN (CHCON STRING)
COLLECT (CHARACTER (SELCHARQ CHAR
((CR TAB LF)
(CHARCODE SPACE))
CHAR)))))))
(create.toc.file
(lambda (stream window) (* |fsg| "16-Jul-87 11:46")
(* * |Here| |to| |print| |the| |Table| o\f |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)
(function ngroup.toc.entries)))
(toc.file (get.toc.file (windowprop window 'imageobj.menuw)))
(toc.tabstop (list 'paralooks (list 'tabs (list nil (cons (fixr (times 72.27 6.125))
'dottedleft)))))
toc.stream)
(cond
((and toc.list toc.file)
(setq toc.stream (opentextstream nil nil nil nil toc.tabstop))
(tedit.promptprint stream (concat "Putting Table-Of-Contents into file " toc.file "...")
t)
(write.toc.file toc.stream toc.list window)
(tedit.promptprint stream "done")
(tedit.put toc.stream toc.file)
(closef? 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 included in the Table-Of-Contents." t)
nil)))))
(ngroup.toc.entries
(lambda (nbrobj) (* |fsg| "16-Jul-87 11:20")
(* * |Check| |if| nbrobj |is| \a |NGroup| |ImageObject| |and| |its| ng.addtotoc
 |flag| |is| |on.|)
(and (ngroupp nbrobj)
(|fetch| (ngtemplate ng.addtotoc) |of| (|fetch| (numberobj template)
|of| (|fetch| objectdatum |of| nbrobj))))))
(view.toc.file
(lambda (stream window) (* |fsg| "12-Aug-87 16:36")
(* * |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)))
(and toc.file (progn (or (windowprop window 'toc.window)
(windowprop window 'toc.window (createw nil (concat
"Viewing TOC file: "
toc.file))))
(tedit toc.file (windowprop window 'toc.window)))))))
(get.toc.file
(lambda (menuw) (* \; "Edited 29-Sep-87 15:17 by fsg")
(* * |Return| |the| |user| |specified| |Table-Of-Contents| |file| |name.|)
(let ((filename (fm.itemprop (fm.getitem 'toc.file nil menuw)
'label)))
(and (not (strequal filename ""))
(mkatom filename)))))
(write.toc.file
(lambda (toc.stream toc.list window) (* |fsg| "26-Aug-87 15:37")
(* * |Here| |to| |speficy| |the| |order| |of| |the| |Table-Of-Contents.|
 |The| toc |is| |ordered| |by| |the| |top-level| |sister| |nodes.|)
(dspfont (fontcreate '(helvetica 14 brr))
toc.stream)
(printout toc.stream "Table of Contents" t)
(|for| toc.mother |in| (toplevel.sisters window)
|do| (dspfont |GP.DefaultFont| toc.stream)
(printout toc.stream t)
(|for| toc.item |in| toc.list |when| (|with| numberobj (|fetch| objectdatum
|of| (car toc.item))
(eq (get.ngroup.mother ref.type window)
toc.mother))
|do| (write.toc.entry toc.item toc.stream window)))))
(write.toc.entry
(lambda (toc.item toc.stream window) (* |fsg| "27-Jul-87 14:55")
(* * |Write| |one| |line| |to| |the| |Table-Of-Contents| |file.|)
(let* ((datum (|fetch| objectdatum |of| (car toc.item)))
(item.level (length (list.ancestors (|fetch| (numberobj ref.type) |of| datum)
nil window))))
(dspfont |GP.DefaultFont| toc.stream)
(cond
((zerop item.level)
(printout toc.stream t))
(t (rptq item.level (printout toc.stream " "))))
(dspfont (|fetch| (numberobj font) |of| datum)
toc.stream)
(printout toc.stream (concat (or (|fetch| (numberobj text.before#) |of| datum)
"")
(|fetch| (numberobj numstring) |of| datum)
(or (|fetch| (numberobj text.after#) |of| datum)
"")))
(dspfont |GP.DefaultFont| toc.stream)
(printout toc.stream (character (charcode tab))
(|fetch| (numberobj page.number) |of| datum)
t))))
)
(PUTPROPS TMAX-NGROUP COPYRIGHT ("Xerox Corporation" 1987 1997))
(DECLARE\: DONTCOPY
(FILEMAP (NIL (1660 40131 (INSERT.NGROUP 1670 . 3281) (VERIFY.NGROUP.ORDER 3283 . 5076) (
GET.PREVIOUS.NGROUPS 5078 . 5447) (ADD.NUMBER.GROUP 5449 . 7814) (ADD.NGROUP.TO.DBASE 7816 . 8622) (
COLLECT.NGROUPS 8624 . 9221) (LIST.FONT.PROPS 9223 . 9491) (MAP.NGROUP.LOOKS 9493 . 10982) (
NGROUP.GETFONT 10984 . 11634) (CHANGE.NGROUP 11636 . 12337) (CHANGE.NGROUP.FONT 12339 . 13797) (
SHOW.NGROUP.FONT 13799 . 14517) (CHANGE.NGROUP.FORMAT 14519 . 16245) (SHOW.NGROUP.FORMAT 16247 . 18824
) (CHANGE.NGROUP.FORMAT.TXTBEFORE 18826 . 20365) (CHANGE.NGROUP.FORMAT.DISPLAY 20367 . 23015) (
CHANGE.NGROUP.FORMAT.TXTAFTER 23017 . 24551) (GET.NGROUP.DELIMITER 24553 . 26242) (
CHANGE.NGROUP.FORMAT.ABBREV 26244 . 28836) (CHANGE.NGROUP.FORMAT.START 28838 . 29916) (
GET.NGROUP.START 29918 . 31390) (CHANGE.NGROUP.FORMAT.TOC 31392 . 33276) (
CHANGE.NGROUP.FORMAT.MANINDEX 33278 . 35618) (UPDATE.NGROUP.MANINDEX 35620 . 36916) (
NGROUP.FIXUP.RECORDS 36918 . 40129)) (40176 47813 (GET.NGROUP.TEXTSTRING 40186 . 41565) (
CONVERT.TABS.TO.SPACES 41567 . 42322) (CREATE.TOC.FILE 42324 . 43848) (NGROUP.TOC.ENTRIES 43850 .
44322) (VIEW.TOC.FILE 44324 . 45119) (GET.TOC.FILE 45121 . 45519) (WRITE.TOC.FILE 45521 . 46523) (
WRITE.TOC.ENTRY 46525 . 47811)))))
STOP

BIN
lispusers/TMAX/TMAX-NGROUP.LCOM Normal file
View File

Binary file not shown.

601
lispusers/TMAX/TMAX-NUMBER Normal file
View File

@@ -0,0 +1,601 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10)
(FILECREATED "18-Mar-2022 07:06:06" 
|{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>TMAX-NUMBER.;8| 33934
:CHANGES-TO (VARS TMAX-NUMBERCOMS)
:PREVIOUS-DATE "17-Mar-2022 23:33:32"
|{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>TMAX-NUMBER.;7|)
; Copyright (c) 1987, 1999-2000 by Xerox Corporation.
(PRETTYCOMPRINT TMAX-NUMBERCOMS)
(RPAQQ TMAX-NUMBERCOMS
((* |Developed| |under| |support| |from| NIH |grant| RR-00785.)
(* |Written| |by| |Frank| |Gilmurray| |and| |Sami| |Shaio.|)
(* * TMAX-NUMBER |ImageObject| |functions|)
(FNS NUMBEROBJ NUMBEROBJP NGROUPP NUMBER.DISPLAYFN NUMBER.PREPRINTFN NUMBER.IMAGEBOXFN
NUMBER.PUTFN NUMBER.GETFN NUMBER.COPYFN NUMBER.BUTTONEVENTINFN NUMBEROBJ.TEDIT-TO-TEX-FN
)
(FNS COPY.NGROUP.BRANCH DUMP.NGROUP.GRAPH NGROUP.BUTTONEVENTINFN NGROUP.DEFINE.TAG
NUMBER.DELETE.TAG NGROUP.SHOW.TAG CHANGE.INSERTED.NGROUP.FORMAT
CHANGE.NGROUP.FORMAT.#TEXT SHOW.INSERTED.NGROUP.FORMAT)
(* * |Variable| |and| |Record| |definitions|)
(VARS NGROUP.GRAPH.MENU.ITEMS NGROUP.INSERTED.MENU.ITEMS NGROUP.INSERTED.NOTAG.ITEMS
NGROUP.INSERTED.TAG.ITEMS)
(FILES (COMPILED SYSLOAD)
TMAX)
(INITVARS (\\NUMBEROBJ.IMAGEFNS (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 NUMBER.PREPRINTFN))))
(DECLARE\: EVAL@COMPILE DONTCOPY (RECORDS NGCOUNTER NGTEMPLATE NUMBEROBJ))))
(* |Developed| |under| |support| |from| NIH |grant| RR-00785.)
(* |Written| |by| |Frank| |Gilmurray| |and| |Sami| |Shaio.|)
(* * TMAX-NUMBER |ImageObject| |functions|)
(DEFINEQ
(NUMBEROBJ
(LAMBDA (USE TEMPLATE NUMSTRING REF.TYPE FONT MOTHER ABBREV.LEVEL)
(* |fsg| "26-Aug-87 14:29")
(LET ((NEWOBJ (IMAGEOBJCREATE (|create| NUMBEROBJ
REF.TYPE _ REF.TYPE
NUMSTRING _ (OR NUMSTRING "Note#")
USE _ USE
NGROUP.MOTHER _ MOTHER
TEMPLATE _ TEMPLATE
UPDATED.OBJ _ NIL
TEXT.AFTER# _ NIL
PAGE.NUMBER _ NIL
FONT _ FONT
TEXT.BEFORE# _ NIL
ABBREV-VAL _ ABBREV.LEVEL)
\\NUMBEROBJ.IMAGEFNS)))
(IMAGEOBJPROP NEWOBJ 'TYPE 'NUMBEROBJ)
(IMAGEOBJPROP NEWOBJ 'TEDIT-TO-TEX-FN (FUNCTION NUMBEROBJ.TEDIT-TO-TEX-FN))
NEWOBJ)))
(numberobjp
(lambda (imobj) (* |ss:| "27-Jun-87 16:21")
(* * |Tests| |an| |imageobj| |to| |see| |if| |it| |is| \a |number|
 |imageobject.| |The| |only| |number| |imageobjects| |so| |far| |are| |NGroups|
 |and| |Endnotes.| b\y |convention,| |testing| |functions| |for| |an|
 |imageobject| |will| |be| |named| (concat |<type| |of| |imageobj>| "P"))
(and imobj (eq (imageobjprop imobj 'type)
'numberobj))))
(ngroupp
(lambda (imobj) (* |ss:| "27-Jun-87 16:15")
(* * |Like| numberobjp |but| |also| |checks| |for| |NGroup| |ImageObject.|)
(and (numberobjp imobj)
(eq (|fetch| (numberobj use) |of| (|fetch| objectdatum |of| imobj))
'ngroup))))
(number.displayfn
(lambda (image.obj stream) (* |fsg| "24-Sep-87 14:56")
(* |Display| |function| |for| |numberobjs.|
 |Allows| |different| |formats| |for| |display| |according| |to| |the| |use|
 |to| |which| |the| |numberobj| |is| |being| |put.|
 i\f |no| |specific| |action| |is| |specified,| |displaying| |defaults| |to|
 |printing| |out| |as| \a |plain| |number.*|)
(|with| numberobj (|fetch| objectdatum |of| image.obj)
(let* ((main.window (|with| textobj textobj (car \\window)))
(image.tag (imageobjprop image.obj 'tag))
(old.font (dspfont nil stream))
(nbr.font (selectq use
(note (|fetch| (endnotefonts number.font) |of| (get.endnote.fonts
main.window)))
(ngroup font)
(error "Undefined USE field" use))))
(and image.tag (or (tsp.getcodeval image.tag main.window)
(tsp.putcode image.tag image.obj main.window)))
(and (fontp nbr.font)
(dspfont (fontcreate (fontprop nbr.font 'family)
(fontprop nbr.font 'size)
(fontprop nbr.font 'face))
stream))
(or (imagestreamtypep stream 'display)
(setq page.number (car formattingstate)))
(tmax.shadeobj image.obj stream)
(selectq use
(ngroup (prin1 (concat (or text.before# "")
(mkstring numstring)
(or text.after# ""))
stream)
(or (imagestreamtypep stream 'display)
(update.ngroup.manindex template ref.type main.window)))
(note (let ((current.ypos (dspyposition nil stream))
(imagebox (listget (|fetch| imageobjplist |of| image.obj)
'boundbox)))
(dspyposition (iplus current.ypos (idifference (|fetch| ysize
|of| imagebox)
(fontprop stream
'height)))
stream)
(prin1 (mkstring numstring)
stream)
(dspyposition current.ypos stream)))
nil)
(dspfont old.font stream)))))
(NUMBER.PREPRINTFN
(LAMBDA (IMAGE.OBJ) (* \; "Edited 18-May-99 22:51 by rmk:")
(* |fsg| "24-Sep-87 14:56")
(* |;;| "Returns string that represents the number object, for plaintext put. If no specific action is specified, displaying defaults to printing out as a plain number.*")
(WITH NUMBEROBJ (FETCH OBJECTDATUM OF IMAGE.OBJ)
(LET* ((MAIN.WINDOW (WITH TEXTOBJ TEXTOBJ (CAR \\WINDOW)))
(IMAGE.TAG (IMAGEOBJPROP IMAGE.OBJ 'TAG)))
(AND IMAGE.TAG (OR (TSP.GETCODEVAL IMAGE.TAG MAIN.WINDOW)
(TSP.PUTCODE IMAGE.TAG IMAGE.OBJ MAIN.WINDOW)))
(SELECTQ USE
(NGROUP (CONCAT (OR TEXT.BEFORE# "")
(MKSTRING NUMSTRING)
(OR TEXT.AFTER# "")))
(NOTE (MKSTRING NUMSTRING))
NIL)))))
(number.imageboxfn
(lambda (obj stream currentx rightmargin) (* |fsg| " 4-Aug-87 14:56")
(* * |For| |Endnote| |numbers,| |the| |YSize| |is| |the| |current| |font|
 |height| |plus| 0.25 |times| |the| |Endnote| |number| |font| |height.|
 w\e |do| |this| |so| |the| |the| |Endnote| |number| |will| |be| |superscripted|
 |but| |not| |too| |much.|)
(* * |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.|)
(|with| numberobj (|fetch| objectdatum |of| obj)
(let* ((main.window (|with| textobj textobj (car \\window)))
(imobj.string (mkstring numstring))
(nbr.font (selectq use
(note (|fetch| (endnotefonts number.font) |of| (get.endnote.fonts
main.window)))
(ngroup font)
(error "Undefined USE field" use))))
(and (eq use 'ngroup)
(progn (and (stringp text.before#)
(setq imobj.string (concat text.before# imobj.string)))
(and (stringp text.after#)
(setq imobj.string (concat imobj.string text.after#)))))
(and (fontp nbr.font)
(dspfont (fontcreate (fontprop nbr.font 'family)
(fontprop nbr.font 'size)
(fontprop nbr.font 'face))
stream))
(|create| imagebox
xsize _ (stringwidth imobj.string stream)
ysize _ (selectq use
(note (fix (plus (times (dspscale nil stream)
(fontprop (current.display.font stream)
'height))
(times 0.25 (fontprop stream 'height)))))
(fontprop stream 'height))
ydesc _ (fontprop stream 'descent)
xkern _ 0)))))
(number.putfn
(lambda (obj stream) (* |fsg| " 5-Aug-87 08:24")
(let ((window (|with| textobj textobj (car \\window)))
(use (|with| numberobj (|fetch| objectdatum |of| obj)
use))
(old.font (|with| numberobj (|fetch| objectdatum |of| obj)
font)))
(selectq use
(note (note.putfn obj stream window))
(ngroup (let ((ngroup.rec (copy (|fetch| objectdatum |of| obj))))
(|with| numberobj ngroup.rec (setq font (list.font.props font))
(prin4 (list '|NGroup| (and (windowprop window 'dumpngroupgraph)
(dump.ngroup.graph window))
(imageobjprop obj 'tag)
ngroup.rec)
stream))))
(error "Unknown NUMBER ImageObject type" use)))))
(number.getfn
(lambda (stream copy.object) (* |fsg| " 3-Sep-87 15:17")
(* * i\f copy.object |is| |non-NIL| |then| |we| |are| |COPYing| |it| |to|
 |this| |window.|)
(let ((nbrobj.datum (or copy.object (cdr (read stream))))
(newobj (numberobj))
(window (|with| textobj textobj (car \\window))))
(tsp.setup.fmmenu window)
(and (ilessp (length nbrobj.datum)
3)
(setq nbrobj.datum (cons nil nbrobj.datum)))
(and (car nbrobj.datum)
(not (and (boundp 'tmax.prune.ngraph)
tmax.prune.ngraph))
(copy.ngroup.branch (car nbrobj.datum)
window))
(and (cadr nbrobj.datum)
(not (gethash (cadr nbrobj.datum)
(windowprop window 'tsp.code.array)))
(progn (tsp.putcode (cadr nbrobj.datum)
newobj window)
(imageobjprop newobj 'tag (cadr nbrobj.datum))))
(|with| numberobj (setq nbrobj.datum (ngroup.fixup.records (caddr nbrobj.datum)
copy.object))
(selectq use
(note (note.getfn newobj nbrobj.datum window))
(ngroup (and (listp font)
(setq font (fontcreate font)))
(create.ngroup.node ref.type ngroup.mother nbrobj.datum window)
(create.ngroup.node ngroup.mother nil nil window)
(add.ngroup.to.mother.node ref.type ngroup.mother window)
(windowprop window 'rebuild.graphflg t)
(and (|fetch| (ngtemplate ng.manualindex) |of| template)
(windowaddprop window 'manualgroups ref.type))
(|replace| objectdatum |of| newobj |with| nbrobj.datum))
(error "Unknown USE type in NUMBER.GETFN" use)))
newobj)))
(number.copyfn
(lambda (image.obj source.stream target.stream) (* |fsg| " 4-Aug-87 09:46")
(* * |Here| |to| copy \a |Number| |Image| |Object.|
 i\f |we| |are| |copying| |to| |our| |own| |window,| |we| |delete| |the| tag
 |if| |any| |so| |we| |don't| |get| |two| |ImageObjs| |with| |the| |same| tag
 |name.|)
(selectq (imagestreamtype target.stream)
(text (let ((source.window (|with| textobj textobj (car \\window)))
(textobj (textobj target.stream)))
(apply* (imageobjprop image.obj 'getfn)
target.stream
(list (|with| numberobj (|fetch| objectdatum |of| image.obj)
(and (eq use 'ngroup)
(neq source.stream target.stream)
(|for| parent |in| (append (list.ancestors ref.type nil
source.window)
(list ref.type))
|collect| (car (gethash parent (tsp.get.ngroup.array
source.window))))))
(and (neq source.stream target.stream)
(imageobjprop image.obj 'tag))
(|fetch| objectdatum |of| image.obj)))))
(error "Unknown TARGET stream type" (imagestreamtype target.stream)))))
(number.buttoneventinfn
(lambda (obj stream sel relx rely window hoststream button)(* |fsg| " 2-Sep-87 11:09")
(* * |Here| |when| \a |NumberOBJ| |is| |left| |or| |middle| |buttoned.|
 |Left| |just| |dislays| |the| |Tag| |if| |any| |in| |the| |prompt| |window.|
 |Middle| |pops| |up| \a |menu| |allowing| |this| |user| |to| |do| |various|
 |things.|)
(and (mousestate left)
(cond
((imageobjprop obj 'tag)
(|with| numberobj (|fetch| objectdatum |of| obj)
(tedit.promptprint stream (concat "Tag for this " (selectq use
(note "Endnote")
(ngroup ref.type)
(error "Undefined USE code"
use))
" is \""
(imageobjprop obj 'tag)
"\"")
t)))
(t (tedit.promptprint stream "" t))))
(and (mousestate middle)
(let* ((datum (|fetch| objectdatum |of| obj))
(use (|fetch| (numberobj use) |of| datum))
(ref.type (|fetch| (numberobj ref.type) |of| datum)))
(and (selectq use
(note (note.buttoneventinfn obj stream window))
(ngroup (ngroup.buttoneventinfn ref.type obj stream window))
(error "Undefined USE code" use))
(progn (tedit.promptprint stream "" t)
'changed))))))
(NUMBEROBJ.TEDIT-TO-TEX-FN
(LAMBDA (OBJ STREAM)
(PRIN3 "\\ex{" STREAM)
(LET ((DATUM (IMAGEOBJPROP OBJ 'OBJECTDATUM)))
(PRIN3 (CAR DATUM)
STREAM)
(PRIN3 (CADR DATUM)
STREAM))
(PRIN3 "}" STREAM)
T))
)
(DEFINEQ
(copy.ngroup.branch
(lambda (ngroup.parents window) (* |fsg| "11-Aug-87 09:36")
(* * |Build| |the| |NGroup| |database| |for| |the| |parents| |of| \a |copied|
 |NGroup| |or| |the| |entire| |NGroup| |database| |on| \a get.)
(|for| parent |in| ngroup.parents |do| (and parent (|with| numberobj parent (and (listp font)
(setq font
(fontcreate
font)))
(or ngroup.mother (setq ngroup.mother
'new.ngroup))
(create.ngroup.node ref.type
ngroup.mother parent window)
(create.ngroup.node ngroup.mother nil
nil window)
(add.ngroup.to.mother.node ref.type
ngroup.mother window))))))
(dump.ngroup.graph
(lambda (window) (* |fsg| " 3-Aug-87 16:03")
(* * |Return| \a |list| |of| |the| |NGroup| |graph| |data| |that| |is| put
 |along| |with| |the| |NGroup| |Imageobject.|
 w\e |can| |then| |rebuild| |the| |entire| |NGroup| |graph| |on| \a get.)
(let ((graph.list (tconc nil)))
(maphash (tsp.get.ngroup.array window)
(function (lambda (val key)
(and (neq key 'new.ngroup)
(let ((ngroup.rec (copy (car val))))
(|with| numberobj ngroup.rec (setq font (list.font.props font))
(tconc graph.list ngroup.rec)))))))
(windowprop window 'dumpngroupgraph nil)
(cdar graph.list))))
(ngroup.buttoneventinfn
(lambda (ref.type ngroup.obj stream window) (* |fsg| " 5-Aug-87 08:31")
(* * |Here| |when| |an| |inserted| |NGroup| |is| |middle| |buttoned.|)
(let ((tag (imageobjprop ngroup.obj 'tag))
(graphw (windowprop window 'imageobj.menuw)))
(menu (|create| menu
title _ (concat ref.type " Menu")
items _ (append (cond
(tag ngroup.inserted.tag.items)
(t ngroup.inserted.notag.items))
ngroup.inserted.menu.items)
centerflg _ t)))))
(ngroup.define.tag
(lambda (ref.type window ngroup.obj) (* |fsg| " 5-Aug-87 09:26")
(* * |Define| \a tag |for| |this| |NGroup| |or| |Change| |the| tag |if| |it|
 |already| |exists.|)
(let ((old.tag (imageobjprop ngroup.obj 'tag))
(new.tag (tsp.get.incode (textstream window))))
(and new.tag (neq new.tag old.tag)
(progn (and old.tag (number.delete.tag window ngroup.obj))
(tsp.putcode new.tag ngroup.obj window)
(imageobjprop ngroup.obj 'tag new.tag))))))
(number.delete.tag
(lambda (window ngroup.obj) (* |fsg| " 5-Aug-87 09:27")
(* * |Delete| |this| |Imageobj's| tag.)
(tsp.putcode (imageobjprop ngroup.obj 'tag nil)
nil window)
nil))
(ngroup.show.tag
(lambda (ref.type window ngroup.obj) (* |fsg| " 5-Aug-87 08:43")
(* * |Show| |this| |NGroup's| tag.)
(tedit.promptprint (textstream window)
(concat ref.type ": Tag=\"" (imageobjprop ngroup.obj 'tag)
"\"")
t)))
(change.inserted.ngroup.format
(lambda (ref.type ngroup.obj stream window format.field) (* |fsg| " 1-Sep-87 15:33")
(* * |Change| |an| |inserted| |NGroup's| |entire| |format| |or| \a |selected|
 |field.|)
(let ((graphw (windowprop window 'imageobj.menuw))
(new.format (|for| field |in| (cond
(format.field (list format.field))
(t '(txtbefore display txtafter abbrevval before#txt
after#txt)))
|collect| (selectq field
(txtbefore (change.ngroup.format.txtbefore ref.type graphw
ngroup.obj))
(display (change.ngroup.format.display ref.type graphw
ngroup.obj))
(txtafter (change.ngroup.format.txtafter ref.type graphw
ngroup.obj))
(abbrevval (change.ngroup.format.abbrev ref.type graphw
ngroup.obj))
(before#txt (change.ngroup.format.#text ref.type window
ngroup.obj 'before))
(after#txt (change.ngroup.format.#text ref.type window
ngroup.obj 'after))
(error "Unknown NGroup Format field" field)))))
(apply 'or new.format))))
(change.ngroup.format.#text
(lambda (ref.type window ngroup.obj flavor) (* |fsg| "25-Aug-87 14:48")
(* * |Change| |the| |text| |before| |or| |after| |an| |inserted| |NGroup|
 |regardless| |of| |the| |Text| |Before| |or| |Text| |After| |toggle|
 |settings.|)
(|with| numberobj (|fetch| objectdatum |of| ngroup.obj)
(let ((old.string (selectq flavor
(before text.before#)
text.after#))
(new.string (tedit.getinput (textstream window)
(concat (selectq flavor
(before "Text before ")
"Text after ")
ref.type ":"))))
(and new.string (setq new.string (concat (selectq flavor
(before "")
" ")
(convert.tabs.to.spaces new.string)
(selectq flavor
(before " ")
""))))
(selectq flavor
(before (setq text.before# new.string))
(setq text.after# new.string))
(not (strequal old.string new.string))))))
(show.inserted.ngroup.format
(lambda (ref.type ngroup.obj stream window) (* |fsg| "26-Aug-87 12:05")
(* * |Show| |the| |format| |of| |an| |inserted| |NGroup.|)
(|with| numberobj (|fetch| objectdatum |of| ngroup.obj)
(|with| ngtemplate template (tedit.promptprint stream
(concat ref.type ": Display="
(concat (cond
(ng.text-before (concat "\""
ng.text-before
"\""))
(t "\"\""))
ng.chartype
(cond
(ng.text-after (concat "\""
ng.text-after
"\""))
(t "\"\"")))
" Abbrev="
(or abbrev-val "None"))
t)))))
)
(* * |Variable| |and| |Record| |definitions|)
(RPAQQ NGROUP.GRAPH.MENU.ITEMS
`((|Change Font| (CHANGE.NGROUP.FONT LABEL GRAPHW)
"Change this NGroup's entire FONT."
(SUBITEMS (|Family| (CHANGE.NGROUP.FONT LABEL GRAPHW 'FAMILY)
"Change this NGroup's font family.")
(|Size| (CHANGE.NGROUP.FONT LABEL GRAPHW 'SIZE)
"Change this NGroup's font size.")
(|Face| (CHANGE.NGROUP.FONT LABEL GRAPHW 'FACE)
"Change this NGroup's font face.")))
(|Show Font| (SHOW.NGROUP.FONT LABEL GRAPHW)
"Show this NGroup's FONT.")
(|Change Format| (CHANGE.NGROUP.FORMAT LABEL GRAPHW)
"Change this NGroup's entire FORMAT."
(SUBITEMS (|Delimiter Before| (CHANGE.NGROUP.FORMAT LABEL GRAPHW 'TXTBEFORE)
"Change the delimiter preceding this NGroup.")
(|Display Type| (CHANGE.NGROUP.FORMAT LABEL GRAPHW 'DISPLAY)
"Change how this NGroup is displayed.")
(|Delimiter After| (CHANGE.NGROUP.FORMAT LABEL GRAPHW 'TXTAFTER)
"Change the delimiter following this NGroup.")
(|Abbreviate Level| (CHANGE.NGROUP.FORMAT LABEL GRAPHW 'ABBREVVAL)
"Specify the starting level of this NGroup value.")
(|Starting Value| (CHANGE.NGROUP.FORMAT LABEL GRAPHW 'START)
"Change this NGroup's starting value.")
(|Table-Of-Contents| (CHANGE.NGROUP.FORMAT LABEL GRAPHW 'TOC)
"Include this NGroup in the Table-Of-Contents.")
\,@
(AND (MANUALINDEX.ENABLED? (WINDOWPROP GRAPHW 'TWINDOW))
(LIST (LIST '|Manual Index| (FUNCTION (CHANGE.NGROUP.FORMAT LABEL GRAPHW
'MANINDEX))
"Include this NGroup in the Manual Index page numbers.")))))
(|Show Format| (SHOW.NGROUP.FORMAT LABEL GRAPHW)
"Show this NGroup's FORMAT.")))
(RPAQQ NGROUP.INSERTED.MENU.ITEMS
((|Change Font| (CHANGE.NGROUP.FONT REF.TYPE GRAPHW NIL NGROUP.OBJ)
"Change this NGroup's entire FONT."
(SUBITEMS (|Family| (CHANGE.NGROUP.FONT REF.TYPE GRAPHW 'FAMILY NGROUP.OBJ)
"Change this NGroup's font family.")
(|Size| (CHANGE.NGROUP.FONT REF.TYPE GRAPHW 'SIZE NGROUP.OBJ)
"Change this NGroup's font size.")
(|Face| (CHANGE.NGROUP.FONT REF.TYPE GRAPHW 'FACE NGROUP.OBJ)
"Change this NGroup's font face.")))
(|Show Font| (SHOW.NGROUP.FONT REF.TYPE GRAPHW NGROUP.OBJ)
"Show this NGroup's FONT.")
(|Change Format| (CHANGE.INSERTED.NGROUP.FORMAT REF.TYPE NGROUP.OBJ STREAM WINDOW)
"Change this NGroup's entire FORMAT."
(SUBITEMS (|Delimiter Before| (CHANGE.INSERTED.NGROUP.FORMAT REF.TYPE NGROUP.OBJ
STREAM WINDOW 'TXTBEFORE)
"Change the delimiter preceding this NGroup.")
(|Display Type| (CHANGE.INSERTED.NGROUP.FORMAT REF.TYPE NGROUP.OBJ STREAM
WINDOW 'DISPLAY)
"Change how this NGroup is displayed.")
(|Delimiter After| (CHANGE.INSERTED.NGROUP.FORMAT REF.TYPE NGROUP.OBJ STREAM
WINDOW 'TXTAFTER)
"Change the delimiter following this NGroup.")
(|Abbreviate Level| (CHANGE.INSERTED.NGROUP.FORMAT REF.TYPE NGROUP.OBJ STREAM
WINDOW 'ABBREVVAL)
"Specify the starting level of this NGroup value.")
(|Text Before| (CHANGE.INSERTED.NGROUP.FORMAT REF.TYPE NGROUP.OBJ STREAM WINDOW
'BEFORE#TXT)
"Change the text preceding this NGroup.")
(|Text After| (CHANGE.INSERTED.NGROUP.FORMAT REF.TYPE NGROUP.OBJ STREAM WINDOW
'AFTER#TXT)
"Change the text following this NGroup.")))
(|Show Format| (SHOW.INSERTED.NGROUP.FORMAT REF.TYPE NGROUP.OBJ STREAM WINDOW)
"Show this NGroup's FORMAT.")))
(RPAQQ NGROUP.INSERTED.NOTAG.ITEMS ((|Define Tag| (NGROUP.DEFINE.TAG REF.TYPE WINDOW NGROUP.OBJ)
"Define a TAG for this NGroup.")))
(RPAQQ NGROUP.INSERTED.TAG.ITEMS ((|Change Tag| (NGROUP.DEFINE.TAG REF.TYPE WINDOW NGROUP.OBJ)
"Change this NGroup's TAG.")
(|Delete Tag| (NUMBER.DELETE.TAG WINDOW NGROUP.OBJ)
"Delete this NGroup's TAG.")
(|Show Tag| (NGROUP.SHOW.TAG REF.TYPE WINDOW NGROUP.OBJ)
"Show this NGroup's TAG.")))
(FILESLOAD (COMPILED SYSLOAD)
TMAX)
(RPAQ? \\NUMBEROBJ.IMAGEFNS
(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 NUMBER.PREPRINTFN)))
(DECLARE\: EVAL@COMPILE DONTCOPY
(DECLARE\: EVAL@COMPILE
(RECORD NGCOUNTER (NCOUNT . ANCESTRY))
(RECORD NGTEMPLATE (NG.CHARTYPE NG.TEXT-AFTER NG.START NG.ADDTOTOC NG.CURRENTVAL NG.MANUALINDEX
NG.TEXT-BEFORE))
(RECORD NUMBEROBJ (REF.TYPE NUMSTRING USE NGROUP.MOTHER TEMPLATE UPDATED.OBJ TEXT.AFTER# PAGE.NUMBER
FONT TEXT.BEFORE# ABBREV-VAL))
)
)
(PUTPROPS TMAX-NUMBER COPYRIGHT ("Xerox Corporation" 1987 1999 2000))
(DECLARE\: DONTCOPY
(FILEMAP (NIL (2558 18256 (NUMBEROBJ 2568 . 3674) (NUMBEROBJP 3676 . 4216) (NGROUPP 4218 . 4572) (
NUMBER.DISPLAYFN 4574 . 7613) (NUMBER.PREPRINTFN 7615 . 8659) (NUMBER.IMAGEBOXFN 8661 . 11154) (
NUMBER.PUTFN 11156 . 12240) (NUMBER.GETFN 12242 . 14378) (NUMBER.COPYFN 14380 . 16077) (
NUMBER.BUTTONEVENTINFN 16079 . 17984) (NUMBEROBJ.TEDIT-TO-TEX-FN 17986 . 18254)) (18257 27428 (
COPY.NGROUP.BRANCH 18267 . 19723) (DUMP.NGROUP.GRAPH 19725 . 20601) (NGROUP.BUTTONEVENTINFN 20603 .
21303) (NGROUP.DEFINE.TAG 21305 . 21908) (NUMBER.DELETE.TAG 21910 . 22169) (NGROUP.SHOW.TAG 22171 .
22493) (CHANGE.INSERTED.NGROUP.FORMAT 22495 . 24290) (CHANGE.NGROUP.FORMAT.#TEXT 24292 . 25878) (
SHOW.INSERTED.NGROUP.FORMAT 25880 . 27426)))))
STOP

BIN
lispusers/TMAX/TMAX-NUMBER.LCOM Normal file
View File

Binary file not shown.

491
lispusers/TMAX/TMAX-XREF Normal file
View File

@@ -0,0 +1,491 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10)
(FILECREATED "18-Mar-2022 07:07:27" 
|{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>TMAX-XREF.;5| 23662
:CHANGES-TO (VARS TMAX-XREFCOMS)
:PREVIOUS-DATE "17-Mar-2022 23:36:37"
|{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>TMAX-XREF.;4|)
; Copyright (c) 1987, 1997, 2000 by Xerox Corporation.
(PRETTYCOMPRINT TMAX-XREFCOMS)
(RPAQQ TMAX-XREFCOMS
( (* \;
 "Developed under support from NIH grant RR-00785.")
(* \;
 "Written by Frank Gilmurray and Sami Shaio.")
(* |;;| "An XREF is a general-purpose cross-referencing imageobject. In order to create an instance of an XREF one simply calls the function XREF with a TAG that is supposed to link it with some imageobject that it is referencing. In order to add to the class of imageobjects that can be referenced with XREF one uses the function XREF.ADD.DISPLAYFN with the type of the imageobject and a function that operates on it to return some string that XREF will then display in the document.")
(* |;;;| "TMAX-XREFNIL Image Object functions")
(FNS XREF XREFP XREF.DISPLAYFN XREF.IMAGEBOXFN XREF.PUTFN XREF.GETFN XREF.COPYFN
XREF.BUTTONEVENTINFN XREF.WHENDELETEDFN XREF.TEDIT-TO-TEX-FN)
(FNS XREF.GET.DISPLAY.TEXT XREF.GET.TOOBJ TSPOBJ.GETTYPE)
(FNS UPDATE.XREFS INSERT.REF GET.REF GET.REFERENCE.BY TSP.LIST.REFS TSP.GET.INCODE
TSP.GETCODEVAL TSP.PUTCODE)
(* |;;;| "Functions for adding and retrieving the method for a gven imageobject.")
(FNS XREF.ADD.DISPLAYFN XREF.GET.DISPLAYFN)
(* |;;;| "Examples of some XREF display methods.")
(FNS NGROUP.XREF.DISPLAYFN NGROUP.XREF.DISPLAY.TEXT NOTE.XREF.DISPLAYFN)
(INITVARS (\\XREFOBJ.IMAGEFNS (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 XREF.GET.DISPLAY.TEXT))))
(UGLYVARS XREF.DISPLAY.METHODS)
(FILES (COMPILED SYSLOAD)
TMAX)))
(* \; "Developed under support from NIH grant RR-00785.")
(* \; "Written by Frank Gilmurray and Sami Shaio.")
(* |;;|
"An XREF is a general-purpose cross-referencing imageobject. In order to create an instance of an XREF one simply calls the function XREF with a TAG that is supposed to link it with some imageobject that it is referencing. In order to add to the class of imageobjects that can be referenced with XREF one uses the function XREF.ADD.DISPLAYFN with the type of the imageobject and a function that operates on it to return some string that XREF will then display in the document."
)
(* |;;;| "TMAX-XREFNIL Image Object functions")
(DEFINEQ
(XREF
(LAMBDA (TAG) (* |fsg| "23-Jul-87 13:33")
(* |Returns| \a |new| XREF |imageobject.|
 |The| TAG |argument| |is| |obligatory| |and| |should| |be| |the| |tag| |that|
 |is| |used| |to| |reference| |the| |object| |that| |this| XREF |object| |is|
 |referencing.|)
(LET ((NEWOBJ (IMAGEOBJCREATE TAG \\XREFOBJ.IMAGEFNS)))
(IMAGEOBJPROP NEWOBJ 'TYPE 'XREF)
(IMAGEOBJPROP NEWOBJ 'TEDIT-TO-TEX-FN (FUNCTION XREF.TEDIT-TO-TEX-FN))
NEWOBJ)))
(xrefp
(lambda (obj) (* |ss:| "27-Jun-87 16:39")
(* |Test| |whether| |something| |is|
 |an| xref |imageobject.|)
(and (imageobjp obj)
(eq (imageobjprop obj 'type)
'xref))))
(xref.displayfn
(lambda (obj stream) (* |fsg| "17-Sep-87 11:19")
(* * |General| |purpose| |display| |function| |for| |an| xref |imageobject.|
 |Relies| |on| xref.get.display.text |to| |get| |the| |actual| |text| |that|
 |must| |be| |displayed.|)
(tmax.shadeobj obj stream)
(prin1 (xref.get.display.text obj)
stream)))
(xref.imageboxfn
(lambda (obj stream) (* |ss:| "27-Jun-87 16:39")
(* |Returns| |the| |size| |of| |an| xref |imageobject| |based| |on| |the|
 |string| |that| |will| |be| |used| |to| |display| |it| |which| |is| |found|
 |using| xref.get.display.text.)
(dspfont (current.display.font stream)
stream)
(|create| imagebox
xsize _ (tedit.stringwidth (xref.get.display.text obj)
stream)
ysize _ (fontprop stream 'height)
ydesc _ (fontprop stream 'descent)
xkern _ 0)))
(xref.putfn
(lambda (obj stream) (* |fsg| "29-Jul-87 09:08")
(prin2 (list 'xref (|fetch| objectdatum |of| obj)
(imageobjprop obj 'reference.by))
stream)))
(xref.getfn
(lambda (stream copy.object) (* |fsg| "20-Aug-87 14:59")
(let ((window (|with| textobj textobj (car \\window))))
(tsp.setup.fmmenu window))
(let* ((xref.args (or copy.object (cdr (read stream))))
(xref.obj (xref (car xref.args))))
(imageobjprop xref.obj 'reference.by (or (cadr xref.args)
'|Value|))
xref.obj)))
(xref.copyfn
(lambda (image.obj source.stream target.stream) (* |fsg| "12-Aug-87 11:07")
(* * |Here| |to| copy |an| xref |Image| |Object.|)
(selectq (imagestreamtype target.stream)
(text (let ((textobj (textobj target.stream)))
(apply* (imageobjprop image.obj 'getfn)
target.stream
(list (|fetch| objectdatum |of| image.obj)
(imageobjprop image.obj 'reference.by)))))
(error "Unknown TARGET stream type" (imagestreamtype target.stream)))))
(XREF.BUTTONEVENTINFN
(LAMBDA (XREFOBJ STREAM SELECTION RELX RELY WINDOW HOSTSTREAM BUTTON)
(* \; "Edited 9-Nov-97 08:09 by rmk:")
(* |fsg| "29-Jul-87 16:43")
(* * |Show| |what| TAG |is| |being| |referenced| |and| |how| |it| |is|
 |referenced.|)
(LET ((XREF.TAG (|fetch| OBJECTDATUM |of| XREFOBJ))
(XREF.DISPLAY (IMAGEOBJPROP XREFOBJ 'REFERENCE.BY)))
(TEDIT.PROMPTPRINT STREAM (CONCAT "Reference to \"" XREF.TAG "\" by " XREF.DISPLAY)
T)
(AND (MOUSESTATE MIDDLE)
(SELECTQ (MENU (|create| MENU
TITLE _ (CONCAT XREF.TAG " Menu")
ITEMS _ '(|Find Definition| |Change Reference| |Change Display|)
CENTERFLG _ T))
(|Find Definition|
(LET ((DEF (TSP.LIST.OF.OBJECTS (TEXTOBJ HOSTSTREAM)
(FUNCTION (LAMBDA (OBJ TAG)
(AND (NUMBEROBJP OBJ)
(EQ TAG (IMAGEOBJPROP OBJ 'TAG)))))
(IMAGEOBJPROP XREFOBJ 'OBJECTDATUM))))
(IF DEF
THEN (CL:WHEN (CDR DEF)
(TEDIT.PROMPTPRINT STREAM
"NOTE: Reference has multipled definitions!!"
T))
(TEDIT.SETSEL HOSTSTREAM (CADR (CAR DEF))
1
'RIGHT NIL T 'INVERTED)
(AND NIL (TEDIT.SHOWSEL HOSTSTREAM T)
(TEDIT.NORMALIZECARET HOSTSTREAM))
(RETFROM (FUNCTION TEDIT.SELECT.LINE.SCANNER)
(TEDIT.GETSEL HOSTSTREAM))
ELSE (TEDIT.PROMPTPRINT STREAM "Reference has not definition!" T))
NIL))
(|Change Reference|
(LET ((NEW.REFERENCE (GET.REF WINDOW STREAM)))
(AND NEW.REFERENCE (PROGN (|replace| OBJECTDATUM |of| XREFOBJ
|with| NEW.REFERENCE)
'CHANGED))))
(|Change Display|
(PROGN (IMAGEOBJPROP XREFOBJ 'REFERENCE.BY (GET.REFERENCE.BY WINDOW T))
(TEDIT.PROMPTPRINT STREAM "" T)
'CHANGED))
NIL)))))
(xref.whendeletedfn
(lambda (imobj targ.window.stream source.str targ.str) (* |fsg| "29-Jul-87 16:35")
(* * |Note| |that| |this| |function| |is| not |called| |when| \a |Reference|
 |is| |deleted.| i\t |is| |called| |when| \a |NGroup| |or| |Endnote| |is|
 |deleted.|)
(tsp.putcode (imageobjprop imobj 'tag)
nil targ.window.stream)
(and (update? targ.window.stream)
(update.xrefs targ.window.stream))))
(XREF.TEDIT-TO-TEX-FN
(LAMBDA (OBJ STREAM)
(LET ((TOOBJ (XREF.GET.TOOBJ (IMAGEOBJPROP OBJ 'OBJECTDATUM)))
DATUM)
(CL:WHEN (AND (SETQ DATUM (IMAGEOBJPROP TOOBJ 'OBJECTDATUM))
TOOBJ)
(PRIN3 "\\exref{" STREAM)
(PRIN3 (CAR DATUM)
STREAM)
(PRIN3 (CADR DATUM)
STREAM)
(PRIN3 "}" STREAM)
T))))
)
(DEFINEQ
(xref.get.display.text
(lambda (obj) (* |fsg| "29-Jul-87 09:30")
(* |This| |function| |will| |first| |lookup| \a "TOOBJ" \, |in| |other|
 |words,| |the| |imageobject| |that| |the| xref |object| obj |is| |referencing.|
 |Then,| |if| |there| |is| |such| |an| |object,| \a |suitable| xref |display|
 |method| |is| |found| |using| xref.get.displayfn.
 i\f |such| \a |function| |is| |found,| |then| |it| |is| |applied| |to| toobj
 |and| \a |string| |to| |be| |displayed| |is| |returned.|)
(let ((toobj (xref.get.toobj (|fetch| objectdatum |of| obj)))
(reference.by (imageobjprop obj 'reference.by))
specific.displayfn)
(cond
(toobj (cond
((setq specific.displayfn (xref.get.displayfn toobj))
(apply* specific.displayfn toobj reference.by))
(t (ringbells)
(error "Unknown XREF display method" (tspobj.gettype toobj))
"<Unknown Reference>")))
(t (concat "<Reference " (|fetch| objectdatum |of| obj)
"/" reference.by ">"))))))
(xref.get.toobj
(lambda (tag) (* |fsg| "13-Jul-87 11:13")
(* |This| |function| |is| |called| |in| \a |specific| |context| |where| \a
 |reference| |must| |be| |displayed.| i\t |is| |called| |by| |an| xref |object|
 |and| |should| |return| |the| imageobject |that| |the| xref |object| |is|
 |referencing.|)
(gethash tag (windowprop (|with| textobj textobj (car \\window))
'tsp.code.array))))
(tspobj.gettype
(lambda (obj) (* |ss:| "27-Jun-87 16:36")
(imageobjprop obj 'type)))
)
(DEFINEQ
(update.xrefs
(lambda (window unupdating?) (* |fsg| "25-Sep-87 14:18")
(* * |Update| |all| |the| xref |objects| |in| |the| |window.|)
(let ((stream (textstream window))
(ref.list (tsp.list.of.objects (textobj window)
(function xrefp))))
(and ref.list (let ((textobj (textobj window)))
(tedit.promptprint stream (concat (cond
(unupdating? "Undoing Update of")
(t "Updating"))
" References...")
t)
(|for| ref |in| ref.list
|do| (let ((ref.tag (|fetch| objectdatum |of| (car ref))))
(cond
((or unupdating? (xref.get.toobj ref.tag))
(tedit.object.changed stream (car ref)))
(t (printout promptwindow t (concat
"Undefined Reference to \""
ref.tag
"\", delete it or just continte?"
)
t)
(flashwindow promptwindow)
(selectq (menu (|create| menu
title _ '|Undefined Ref|
items _ '(|Delete| |Continue|)
centerflg _ t))
(|Delete| (tedit.delete stream (cadr ref)
1))
nil)))))
(tedit.promptprint stream "done"))))))
(insert.ref
(lambda (stream display.prev) (* |fsg| "25-Sep-87 10:24")
(let* ((window (\\tedit.mainw stream))
(code (get.ref window stream display.prev))
(ref (and code (xref code))))
(and ref (progn (imageobjprop ref 'reference.by (get.reference.by window))
(tedit.insert.object ref stream))))))
(get.ref
(lambda (window stream display.prev) (* |fsg| " 2-Sep-87 11:24")
(* * i\f display.prev |is| |non-NIL| |then| |get| |the| |Reference| tag |from|
 \a |menu.| |Else| |prompt| |the| |user| |for| |the| tag |name.|)
(cond
(display.prev (let ((prevrefs (tsp.list.refs window)))
(cond
(prevrefs (tedit.promptprint stream "" t)
(menu (|create| menu
title _ '|Reference Tags|
items _ (sort prevrefs 'ualphorder)
menucolumns _ (fix (sqrt (length prevrefs)))
centerflg _ t)))
(t (tedit.promptprint stream "There are no References in this document."
t)))))
(t (mkatom (tedit.getinput stream "Reference to:"))))))
(get.reference.by
(lambda (window ask?) (* \; "Edited 29-Sep-87 15:24 by fsg")
(* * |Get| |the| "Reference By" |value| |from| |the| |FreeMenu.|
 i\f ask? |is| t |or| |the| |FreeMenu| |value| |is| "Ask" |then| |pop| |up| \a
 |menu| |to| |get| |Value| |or| |Number.|)
(let ((reference.by (cond
(ask? '|Ask|)
(t (fm.itemprop (fm.getitem 'defaultref nil (windowprop window
'imageobj.menuw))
'label)))))
(selectq reference.by
(|Ask| (or (menu (|create| menu
title _ '|Reference By|
centerflg _ t
items _ '(|Value| |Page|)))
'|Value|))
reference.by))))
(tsp.list.refs
(lambda (window) (* |ss:| "27-Jun-87 16:36")
(* * |Used| |to| |collect| |index| |references| |here| |but| |now| |use|
 index.list.refs |instead.|)
(let ((reflist nil))
(maphash (windowprop window 'tsp.code.array)
(function (lambda (val ky)
(setq reflist (cons ky reflist)))))
reflist)))
(tsp.get.incode
(lambda (stream) (* |fsg| " 4-Aug-87 16:13")
(* * |Get| \a |new| |Tag| id |and| |make| |sure| |it's| |not| |already|
 |defined.|)
(let ((tag.id (mkatom (tedit.getinput stream "Tag name:"))))
(|while| (and tag.id (tsp.getcodeval tag.id (\\tedit.mainw stream)))
|do| (setq tag.id (mkatom (tedit.getinput stream (concat tag.id
" already exists...Tag name:"))))
)
(or tag.id (tedit.promptprint stream "" t))
tag.id)))
(tsp.getcodeval
(lambda (code window) (* |ss:| "27-Jun-87 16:35")
(let ((tsp.code.array (windowprop window 'tsp.code.array)))
(gethash code tsp.code.array))))
(tsp.putcode
(lambda (code value window) (* |ss:| "27-Jun-87 16:36")
(puthash code value (list (windowprop window 'tsp.code.array)))))
)
(* |;;;| "Functions for adding and retrieving the method for a gven imageobject.")
(DEFINEQ
(xref.add.displayfn
(lambda (objtype name.of.function) (* |edited:| "22-Jan-87 21:08")
(* |Adds| |an| xref |display| |method| |for| |an| |imageobject| |of| |the|
 |given| |type.| |This| |means| |that| |the| |function| name.of.function |will|
 |be| |used| |to| |display| |text| |when| |an| xref |object| |references| |an|
 |imageobject| |of| |type| objtype.)
(puthash objtype name.of.function xref.display.methods)))
(xref.get.displayfn
(lambda (obj) (* |edited:| "22-Jan-87 21:11")
(* |Returns| |the| xref |display|
 |method| |for| |an| |imageobject| obj.)
(gethash (|fetch| use |of| (|fetch| objectdatum |of| obj))
xref.display.methods)))
)
(* |;;;| "Examples of some XREF display methods.")
(DEFINEQ
(ngroup.xref.displayfn
(lambda (ngroup.obj reference.by) (* |fsg| "29-Jul-87 10:25")
(* * |The| xref |display| |method| |for| ngroup |objects.|
 i\f |the| |NGroup| |has| |been| |updated| |and| |it| |has| \a |trailing|
 |delimiter,| |the| |delimiter| |is| |stripped| |off.|)
(|with| numberobj (|fetch| objectdatum |of| ngroup.obj)
(cond
(updated.obj (cond
((eq reference.by '|Page|)
(cond
(page.number (mkstring page.number))
(t (concat "<" (ngroup.xref.display.text template numstring)
"/" reference.by ">"))))
(t (ngroup.xref.display.text template numstring))))
(t (concat "<" ref.type "/" reference.by ">"))))))
(ngroup.xref.display.text
(lambda (template numstring) (* |fsg| "29-Jul-87 10:24")
(* * |Return| |the| |display| |text| |value| |for| |an| |updated| |NGroup|
 |reference.|)
(|with| ngtemplate template (cond
(ng.text-after (substring numstring 1 (minus (add1 (nchars
ng.text-after
)))))
(t numstring)))))
(note.xref.displayfn
(lambda (note.obj reference.by) (* |fsg| "29-Jul-87 10:35")
(* * |The| xref |display| |method| |for| |Endnote| |objects.|
 i\f |the| |ImageObj| |has| |not| |been| |updated| |yet,| |we| |enclose| |it|
 |in| |angle| |brackets.|)
(|with| numberobj (|fetch| objectdatum |of| note.obj)
(cond
((and updated.obj (or (neq reference.by '|Page|)
page.number))
(cond
((eq reference.by '|Page|)
(mkstring page.number))
(t (mkstring numstring))))
(t (concat "<" numstring "/" reference.by ">"))))))
)
(RPAQ? \\XREFOBJ.IMAGEFNS
(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 XREF.GET.DISPLAY.TEXT)))
(READVARS-FROM-STRINGS '(XREF.DISPLAY.METHODS)
"({H(24 ERROR) 2 NGROUP.XREF.DISPLAYFN NGROUP NOTE.XREF.DISPLAYFN NOTE })
")
(FILESLOAD (COMPILED SYSLOAD)
TMAX)
(PUTPROPS TMAX-XREF COPYRIGHT ("Xerox Corporation" 1987 1997 2000))
(DECLARE\: DONTCOPY
(FILEMAP (NIL (3709 11045 (XREF 3719 . 4286) (XREFP 4288 . 4675) (XREF.DISPLAYFN 4677 . 5111) (
XREF.IMAGEBOXFN 5113 . 5765) (XREF.PUTFN 5767 . 6013) (XREF.GETFN 6015 . 6489) (XREF.COPYFN 6491 .
7101) (XREF.BUTTONEVENTINFN 7103 . 10095) (XREF.WHENDELETEDFN 10097 . 10594) (XREF.TEDIT-TO-TEX-FN
10596 . 11043)) (11046 13030 (XREF.GET.DISPLAY.TEXT 11056 . 12340) (XREF.GET.TOOBJ 12342 . 12879) (
TSPOBJ.GETTYPE 12881 . 13028)) (13031 19405 (UPDATE.XREFS 13041 . 15424) (INSERT.REF 15426 . 15838) (
GET.REF 15840 . 16895) (GET.REFERENCE.BY 16897 . 17884) (TSP.LIST.REFS 17886 . 18338) (TSP.GET.INCODE
18340 . 18994) (TSP.GETCODEVAL 18996 . 19218) (TSP.PUTCODE 19220 . 19403)) (19497 20468 (
XREF.ADD.DISPLAYFN 19507 . 20021) (XREF.GET.DISPLAYFN 20023 . 20466)) (20528 22890 (
NGROUP.XREF.DISPLAYFN 20538 . 21498) (NGROUP.XREF.DISPLAY.TEXT 21500 . 22136) (NOTE.XREF.DISPLAYFN
22138 . 22888)))))
STOP

BIN
lispusers/TMAX/TMAX-XREF.LCOM Normal file
View File

Binary file not shown.

BIN
lispusers/TMAX/TMAX.LCOM Normal file
View File

Binary file not shown.

BIN
lispusers/TMAX/TMAX.TEDIT Normal file
View File

Binary file not shown.

BIN
lispusers/TMAX/TMAX.TOC Normal file
View File

Binary file not shown.