github.com/Interlisp.medley
1
0
Fork 0
mirror of synced 2026-02-21 23:17:51 +00:00
Code Issues Projects Releases Wiki Activity

Rmk20: Eliminate string arguments to TEDIT, move some bogus files to obsolete (#668)

Browse Source 
* Eliminate string arguments to OPENTEXTSTREAM  #666

Empty string replaced by NIL, mostly.  Otherwise, string wrapped in OPENSTRINGSTREAM.  TEDIT hasn't yet been modified, just all the callers.

* INDEX, NGROUP:  move to obsolete   #667

* HELPSYS:  Add proper FILETYPE property

* ROOMS files:  Also updated for TEDIT string arguments
This commit is contained in:
rmkaplan
2022-02-07 13:56:05 -08:00
committed by GitHub
parent fe90ac5f9f
commit 66091a2375
34 changed files with 2796 additions and 2029 deletions
Download Patch File Download Diff File Expand all files Collapse all files

281
lispusers/CALENDAR
View File

@@ -1,20 +1,20 @@
(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")
(FILECREATED "21-Aug-90 09:16:22" {DSK}/lisp/ice/lyric/CALENDAR.;4 175016
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
changes to%: (FNS DOREMINDER CIRCLETODAY DAYSIN PRINTMONTH SHOWMOON MDMENUITEMREGION
SHOWREMSINMONTH WEEKOF CALLOADFILE)
(VARS CALENDARCOMS)
(FILECREATED " 1-Feb-2022 17:14:32" {DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>CALENDAR.;2 173369
previous date%: "21-Feb-90 15:20:05" {DSK}/lisp/ice/lyric/CALENDAR.;2)
:CHANGES-TO (FNS CALTEDITSTRING)
:PREVIOUS-DATE "21-Aug-90 09:16:22"
{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>CALENDAR.;1)
(* "
Copyright (c) 1985, 1986, 1987, 1988, 1989, 1990 by Xerox Corporation. All rights reserved.
(* ; "
Copyright (c) 1985-1990 by Xerox Corporation.
")
(PRETTYCOMPRINT CALENDARCOMS)
(RPAQQ CALENDARCOMS
(RPAQQ CALENDARCOMS
((VARS (CALCIRCLEDAY)
(CALCIRCLEMONTH)
(CALENDARVERSION "Calendar Version 2.1")
@@ -79,77 +79,69 @@ Copyright (c) 1985, 1986, 1987, 1988, 1989, 1990 by Xerox Corporation. All righ
(RPAQ CALENDARVERSION "Calendar Version 2.1")
(RPAQQ CALOPTIONSDESC (((TYPE TITLE LABEL Alert%: FONT (HELVETICA 10 BOLD))
(TYPE NWAY ID CALALERTFLG LABEL Yes MESSAGE
"Reminders will alert you when they fire.")
(TYPE NWAY ID CALALERTFLG LABEL No MESSAGE
"Reminders will not alert you when they fire."))
((TYPE TITLE LABEL "Keep expired rems.:" FONT (HELVETICA 10 BOLD))
(TYPE NWAY ID CALKEEPEXPIREDREMSFLG LABEL Yes MESSAGE
"Expired reminders will not be deleted.")
(TYPE NWAY ID CALKEEPEXPIREDREMSFLG LABEL No MESSAGE
"Reminders are deleted automatically when they fire."))
((TYPE TITLE LABEL "Auto. file update:" FONT (HELVETICA 10 BOLD))
(TYPE NWAY ID CALUPDATEONSHRINKFLG LABEL Always MESSAGE
"Update after each reminder is created.")
(TYPE NWAY ID CALUPDATEONSHRINKFLG LABEL Shrink MESSAGE
"Update only when you shrink a month window.")
(TYPE NWAY ID CALUPDATEONSHRINKFLG LABEL Never MESSAGE
"No automatic updates - use Update in day browser menu."))
((TYPE EDITSTART LABEL "Alert delta:" ITEMS (CALDEFAULTALERTDELTA)
FONT
(HELVETICA 10 BOLD)
MESSAGE
"Default alert time offset in minutes: - for before, + for after.")
(TYPE EDIT ID CALDEFAULTALERTDELTA LABEL 0))
((TYPE EDITSTART LABEL "Host & dir.:" ITEMS (CALDEFAULTHOST&DIR)
FONT
(HELVETICA 10 BOLD))
(TYPE EDIT ID CALDEFAULTHOST&DIR LABEL ""))
((TYPE MOMENTARY LABEL Apply! FONT (HELVETICA 10 BOLD)
SELECTEDFN CALDOOPTIONS MESSAGE
"Puts the selected options into effect and closes this window."))
(WINDOWPROPS TITLE "Calendar Options")))
(RPAQQ CALOPTIONSDESC
(((TYPE TITLE LABEL Alert%: FONT (HELVETICA 10 BOLD))
(TYPE NWAY ID CALALERTFLG LABEL Yes MESSAGE "Reminders will alert you when they fire.")
(TYPE NWAY ID CALALERTFLG LABEL No MESSAGE "Reminders will not alert you when they fire."))
((TYPE TITLE LABEL "Keep expired rems.:" FONT (HELVETICA 10 BOLD))
(TYPE NWAY ID CALKEEPEXPIREDREMSFLG LABEL Yes MESSAGE
"Expired reminders will not be deleted.")
(TYPE NWAY ID CALKEEPEXPIREDREMSFLG LABEL No MESSAGE
"Reminders are deleted automatically when they fire."))
((TYPE TITLE LABEL "Auto. file update:" FONT (HELVETICA 10 BOLD))
(TYPE NWAY ID CALUPDATEONSHRINKFLG LABEL Always MESSAGE
"Update after each reminder is created.")
(TYPE NWAY ID CALUPDATEONSHRINKFLG LABEL Shrink MESSAGE
"Update only when you shrink a month window.")
(TYPE NWAY ID CALUPDATEONSHRINKFLG LABEL Never MESSAGE
"No automatic updates - use Update in day browser menu."))
((TYPE EDITSTART LABEL "Alert delta:" ITEMS (CALDEFAULTALERTDELTA)
FONT
(HELVETICA 10 BOLD)
MESSAGE "Default alert time offset in minutes: - for before, + for after.")
(TYPE EDIT ID CALDEFAULTALERTDELTA LABEL 0))
((TYPE EDITSTART LABEL "Host & dir.:" ITEMS (CALDEFAULTHOST&DIR)
FONT
(HELVETICA 10 BOLD))
(TYPE EDIT ID CALDEFAULTHOST&DIR LABEL ""))
((TYPE MOMENTARY LABEL Apply! FONT (HELVETICA 10 BOLD)
SELECTEDFN CALDOOPTIONS MESSAGE
"Puts the selected options into effect and closes this window."))
(WINDOWPROPS TITLE "Calendar Options")))
(RPAQQ CALOPTIONSDESCLYRIC ([(GROUP (PROPS ID ALERTGROUP)
((TYPE DISPLAY LABEL "Alert:" FONT (HELVETICA 10 BOLD))
(TYPE NWAY COLLECTION CALALERTFLG LABEL Yes MESSAGE
"Reminders will alert you when they fire.")
(TYPE NWAY COLLECTION CALALERTFLG LABEL No MESSAGE
"Reminders will not alert you when they fire."]
[(GROUP (PROPS ID XGROUP)
((TYPE DISPLAY LABEL "Keep expired rems.:" FONT
(HELVETICA 10 BOLD))
(TYPE NWAY COLLECTION CALKEEPEXPIREDREMSFLG LABEL Yes
MESSAGE "Expired reminders will not be deleted.")
(TYPE NWAY COLLECTION CALKEEPEXPIREDREMSFLG LABEL No MESSAGE
"Reminders are deleted automatically when they fire."]
[(GROUP (PROPS ID UPGROUP)
((TYPE DISPLAY LABEL "Auto. file update:" FONT
(HELVETICA 10 BOLD))
(TYPE NWAY COLLECTION CALUPDATEONSHRINKFLG LABEL Always
MESSAGE "Update after each reminder is created.")
(TYPE NWAY COLLECTION CALUPDATEONSHRINKFLG LABEL Shrink
MESSAGE "Update only when you shrink a month window.")
(TYPE NWAY COLLECTION CALUPDATEONSHRINKFLG LABEL Never
MESSAGE
"No automatic updates - use Update in day browser menu."
]
((TYPE EDITSTART LABEL "Alert delta:" ITEMS (CALDEFAULTALERTDELTA)
FONT
(HELVETICA 10 BOLD)
MESSAGE
"Default alert time offset in minutes: - for before, + for after."
)
(TYPE EDIT ID CALDEFAULTALERTDELTA LABEL 0))
((TYPE EDITSTART LABEL "Host & dir.:" ITEMS (CALDEFAULTHOST&DIR)
FONT
(HELVETICA 10 BOLD))
(TYPE EDIT ID CALDEFAULTHOST&DIR LABEL ""))
((TYPE MOMENTARY LABEL Apply! FONT (HELVETICA 10 BOLD)
SELECTEDFN CALDOOPTIONS MESSAGE
"Puts the selected options into effect and closes this window."
))))
(RPAQQ CALOPTIONSDESCLYRIC
([(GROUP (PROPS ID ALERTGROUP)
((TYPE DISPLAY LABEL "Alert:" FONT (HELVETICA 10 BOLD))
(TYPE NWAY COLLECTION CALALERTFLG LABEL Yes MESSAGE
"Reminders will alert you when they fire.")
(TYPE NWAY COLLECTION CALALERTFLG LABEL No MESSAGE
"Reminders will not alert you when they fire."]
[(GROUP (PROPS ID XGROUP)
((TYPE DISPLAY LABEL "Keep expired rems.:" FONT (HELVETICA 10 BOLD))
(TYPE NWAY COLLECTION CALKEEPEXPIREDREMSFLG LABEL Yes MESSAGE
"Expired reminders will not be deleted.")
(TYPE NWAY COLLECTION CALKEEPEXPIREDREMSFLG LABEL No MESSAGE
"Reminders are deleted automatically when they fire."]
[(GROUP (PROPS ID UPGROUP)
((TYPE DISPLAY LABEL "Auto. file update:" FONT (HELVETICA 10 BOLD))
(TYPE NWAY COLLECTION CALUPDATEONSHRINKFLG LABEL Always MESSAGE
"Update after each reminder is created.")
(TYPE NWAY COLLECTION CALUPDATEONSHRINKFLG LABEL Shrink MESSAGE
"Update only when you shrink a month window.")
(TYPE NWAY COLLECTION CALUPDATEONSHRINKFLG LABEL Never MESSAGE
"No automatic updates - use Update in day browser menu."]
((TYPE EDITSTART LABEL "Alert delta:" ITEMS (CALDEFAULTALERTDELTA)
FONT
(HELVETICA 10 BOLD)
MESSAGE "Default alert time offset in minutes: - for before, + for after.")
(TYPE EDIT ID CALDEFAULTALERTDELTA LABEL 0))
((TYPE EDITSTART LABEL "Host & dir.:" ITEMS (CALDEFAULTHOST&DIR)
FONT
(HELVETICA 10 BOLD))
(TYPE EDIT ID CALDEFAULTHOST&DIR LABEL ""))
((TYPE MOMENTARY LABEL Apply! FONT (HELVETICA 10 BOLD)
SELECTEDFN CALDOOPTIONS MESSAGE
"Puts the selected options into effect and closes this window."))))
(RPAQQ LAFITE.AFTER.GETMAIL.FN CALPEEKNEWMAIL)
@@ -210,7 +202,7 @@ Copyright (c) 1985, 1986, 1987, 1988, 1989, 1990 by Xerox Corporation. All righ
(RPAQ? CALTEDITWINDOW )
(RPAQ? CALTUNE '((750 . 20000)
(650 . 20000)))
(650 . 20000)))
(RPAQ? CALUPDATEONSHRINKFLG 'Never)
@@ -1126,7 +1118,8 @@ Copyright (c) 1985, 1986, 1987, 1988, 1989, 1990 by Xerox Corporation. All righ
'Abort])
(CALTEDITSTRING
[LAMBDA (STRING M D YR) (* ; "Edited 14-Oct-88 12:48 by MJD")
[LAMBDA (STRING M D YR) (* ; "Edited 1-Feb-2022 17:13 by rmk")
(* ; "Edited 14-Oct-88 12:48 by MJD")
(* T.Bigham "12-Nov-84 11:03")
(* ;; "this may not be needed in Carol. In harmony, this makes tedit put the value into the item editor without the confirmation that always pops up when changes have been made without saving the file.")
@@ -1136,47 +1129,49 @@ Copyright (c) 1985, 1986, 1987, 1988, 1989, 1990 by Xerox Corporation. All righ
STREAM)
(if (NOT (WINDOWP CALTEDITWINDOW))
then (SETQ CALTEDITWINDOW (CREATEW CALREMCREATEREGION "" NIL T))
(ATTACHMENU (create MENU
ITEMS _ '(Save Abort)
ITEMWIDTH _ 199
CENTERFLG _ T
MENUROWS _ 1
MENUFONT _ (FONTCREATE 'HELVETICA 12 'BOLD)
MENUBORDERSIZE _ 1
WHENSELECTEDFN _ 'CALTEDITEXIT)
CALTEDITWINDOW
'TOP
'LEFT))
(ATTACHMENU (create MENU
ITEMS _ '(Save Abort)
ITEMWIDTH _ 199
CENTERFLG _ T
MENUROWS _ 1
MENUFONT _ (FONTCREATE 'HELVETICA 12 'BOLD)
MENUBORDERSIZE _ 1
WHENSELECTEDFN _ 'CALTEDITEXIT)
CALTEDITWINDOW
'TOP
'LEFT))
(WINDOWPROP CALTEDITWINDOW 'TITLE (CONCAT "Calendar message editor for "
(MKSTRING (MONTHNAME M))
" " D ", " (MKSTRING YR)))
(RETURN (EVAL.IN.TTY.PROCESS
`(PROGN [SETQ STREAM (OPENTEXTSTREAM
(OR %, STRING (CONCAT "Date: "
(GDATE (\PACKDATE ,YR
(SUB1 ,M)
,D 0 0 0)
(DATEFORMAT NO.TIME))
(CHARACTER 13)
"Title: >>One line<<"
(CHARACTER 13)
"Event time: >>Time<<"
(CHARACTER 13)
"Alert time: >>Time<<"
(CHARACTER 9)
"Alert: >>Yes No<<"
(CHARACTER 13)
"Duration: >>hh:mm<<"
(CHARACTER 13)
"Message: >>Any text<<"))
NIL NIL NIL '(QUITFN T]
(TEDIT.SETSEL STREAM 24 12 NIL T)
(SPAWN.MOUSE)
[SETQ RESULT (TEDIT STREAM CALTEDITWINDOW T '(QUITFN T]
(IF (EQ RESULT 'Abort)
THEN NIL
ELSE STREAM))
T])
(RETURN
(EVAL.IN.TTY.PROCESS
`(PROGN [SETQ STREAM (OPENTEXTSTREAM
(OPENSTRINGSTREAM (OR ,STRING
(CONCAT "Date: "
(GDATE (\PACKDATE ,YR
(SUB1 ,M)
,D 0 0 0)
(DATEFORMAT NO.TIME))
(CHARACTER 13)
"Title: >>One line<<"
(CHARACTER 13)
"Event time: >>Time<<"
(CHARACTER 13)
"Alert time: >>Time<<"
(CHARACTER 9)
"Alert: >>Yes No<<"
(CHARACTER 13)
"Duration: >>hh:mm<<"
(CHARACTER 13)
"Message: >>Any text<<")))
NIL NIL NIL '(QUITFN T]
(TEDIT.SETSEL STREAM 24 12 NIL T)
(SPAWN.MOUSE)
[SETQ RESULT (TEDIT STREAM CALTEDITWINDOW T '(QUITFN T]
(IF (EQ RESULT 'Abort)
THEN NIL
ELSE STREAM))
T])
(CALUPDATEFILE
[LAMBDA (FILE) (* ; "Edited 24-Oct-88 16:09 by MJD")
@@ -3049,28 +3044,28 @@ Copyright (c) 1985, 1986, 1987, 1988, 1989, 1990 by Xerox Corporation. All righ
FREEMENU TABLEBROWSER)
(PUTPROPS CALENDAR COPYRIGHT ("Xerox Corporation" 1985 1986 1987 1988 1989 1990))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (10435 169896 (CALADDEVENT 10445 . 17549) (CALCREATEREM 17551 . 20144) (CALDELETEREM
20146 . 23056) (CALDISPEVENT 23058 . 31241) (CALDOOPTIONS 31243 . 33026) (CALENDAR 33028 . 36102) (
CALENDARWATCHER 36104 . 36381) (CALEXTENDSEL 36383 . 38331) (CALLOADFILE 38333 . 48175) (CALMAKEKEY
48177 . 48378) (CALMONTHBEF 48380 . 49473) (CALMONTHICONFN 49475 . 49982) (CALMONTHRBF 49984 . 50776)
(CALOPTIONMENU 50778 . 53033) (CALPEEKNEWMAIL 53035 . 56226) (CALPRINTREM 56228 . 57846) (CALREMDEF
57848 . 58089) (CALTBCLOSEFN 58091 . 58493) (CALTBCOPYFN 58495 . 60863) (CALTBNULLFN 60865 . 61091) (
CALTBSELECTEDFN 61093 . 61490) (CALTEDITEXIT 61492 . 61785) (CALTEDITSTRING 61787 . 65215) (
CALUPDATEFILE 65217 . 72172) (CALUPDATEINIT 72174 . 75543) (CALYEARICONFN 75545 . 76028) (
CALYEARINRANGE 76030 . 76304) (CIRCLETODAY 76306 . 79783) (CLEARDAY 79785 . 81308) (CLOSEMONTH 81310
. 81879) (DAYABBR 81881 . 82143) (DAYNAME 82145 . 82338) (DAYOF 82340 . 83372) (DAYPLUS 83374 . 83671
) (DAYSIN 83673 . 84505) (DERIVENEWDATE 84507 . 88246) (DOREMINDER 88248 . 92582) (FMNWAYITEM 92584 .
92985) (GETREMDEF 92987 . 93299) (INVERTGROUP 93301 . 93569) (LISPDATEDAY 93571 . 93849) (
LISPDATEMONTH 93851 . 93999) (LISPDATEYEAR 94001 . 94365) (MDMENUITEMREGION 94367 . 94831) (MENUITEM
94833 . 95024) (MENUREGIONITEM 95026 . 95394) (MONTHABBR 95396 . 95573) (MONTHNAME 95575 . 95814) (
MONTHNUM 95816 . 96022) (MONTHOFDAYPLUS 96024 . 96252) (MONTHPLUS 96254 . 96559) (MONTHYEARPLUS 96561
. 96849) (NEWPARSETIME 96851 . 102502) (NEXTMDISPLAYREGION 102504 . 105075) (PACKDATE 105077 . 105792
) (PARSETIME 105794 . 106921) (PICKFONTSIZE 106923 . 107577) (POM 107579 . 110233) (POMDAYS 110235 .
111576) (PRINTMONTH 111578 . 115444) (REMINDERSOF 115446 . 116364) (REMINDERTIME 116366 . 116608) (
REMINDERTIMELT 116610 . 117309) (REMSINMONTH 117311 . 117500) (REPAINTMONTH 117502 . 117904) (
REPAINTYEAR 117906 . 118236) (SAMEDAYAS 118238 . 118641) (SAMEMONTHAS 118643 . 118928) (SCALEBITMAP
118930 . 127982) (SHOWDAY 127984 . 136230) (SHOWMONTH 136232 . 156310) (SHOWMONTHSMALL 156312 . 157448
) (SHOWMOON 157450 . 160389) (SHOWREMSINDAY 160391 . 161881) (SHOWREMSINMONTH 161883 . 164333) (
SHOWYEAR 164335 . 167849) (SHRINKMONTH 167851 . 168277) (SHRINKYEAR 168279 . 168808) (TIMEDREMP 168810
. 168934) (TPLUS 168936 . 169470) (WEEKOF 169472 . 169726) (YNCONVERT 169728 . 169894)))))
(FILEMAP (NIL (8660 168249 (CALADDEVENT 8670 . 15774) (CALCREATEREM 15776 . 18369) (CALDELETEREM 18371
. 21281) (CALDISPEVENT 21283 . 29466) (CALDOOPTIONS 29468 . 31251) (CALENDAR 31253 . 34327) (
CALENDARWATCHER 34329 . 34606) (CALEXTENDSEL 34608 . 36556) (CALLOADFILE 36558 . 46400) (CALMAKEKEY
46402 . 46603) (CALMONTHBEF 46605 . 47698) (CALMONTHICONFN 47700 . 48207) (CALMONTHRBF 48209 . 49001)
(CALOPTIONMENU 49003 . 51258) (CALPEEKNEWMAIL 51260 . 54451) (CALPRINTREM 54453 . 56071) (CALREMDEF
56073 . 56314) (CALTBCLOSEFN 56316 . 56718) (CALTBCOPYFN 56720 . 59088) (CALTBNULLFN 59090 . 59316) (
CALTBSELECTEDFN 59318 . 59715) (CALTEDITEXIT 59717 . 60010) (CALTEDITSTRING 60012 . 63568) (
CALUPDATEFILE 63570 . 70525) (CALUPDATEINIT 70527 . 73896) (CALYEARICONFN 73898 . 74381) (
CALYEARINRANGE 74383 . 74657) (CIRCLETODAY 74659 . 78136) (CLEARDAY 78138 . 79661) (CLOSEMONTH 79663
. 80232) (DAYABBR 80234 . 80496) (DAYNAME 80498 . 80691) (DAYOF 80693 . 81725) (DAYPLUS 81727 . 82024
) (DAYSIN 82026 . 82858) (DERIVENEWDATE 82860 . 86599) (DOREMINDER 86601 . 90935) (FMNWAYITEM 90937 .
91338) (GETREMDEF 91340 . 91652) (INVERTGROUP 91654 . 91922) (LISPDATEDAY 91924 . 92202) (
LISPDATEMONTH 92204 . 92352) (LISPDATEYEAR 92354 . 92718) (MDMENUITEMREGION 92720 . 93184) (MENUITEM
93186 . 93377) (MENUREGIONITEM 93379 . 93747) (MONTHABBR 93749 . 93926) (MONTHNAME 93928 . 94167) (
MONTHNUM 94169 . 94375) (MONTHOFDAYPLUS 94377 . 94605) (MONTHPLUS 94607 . 94912) (MONTHYEARPLUS 94914
. 95202) (NEWPARSETIME 95204 . 100855) (NEXTMDISPLAYREGION 100857 . 103428) (PACKDATE 103430 . 104145
) (PARSETIME 104147 . 105274) (PICKFONTSIZE 105276 . 105930) (POM 105932 . 108586) (POMDAYS 108588 .
109929) (PRINTMONTH 109931 . 113797) (REMINDERSOF 113799 . 114717) (REMINDERTIME 114719 . 114961) (
REMINDERTIMELT 114963 . 115662) (REMSINMONTH 115664 . 115853) (REPAINTMONTH 115855 . 116257) (
REPAINTYEAR 116259 . 116589) (SAMEDAYAS 116591 . 116994) (SAMEMONTHAS 116996 . 117281) (SCALEBITMAP
117283 . 126335) (SHOWDAY 126337 . 134583) (SHOWMONTH 134585 . 154663) (SHOWMONTHSMALL 154665 . 155801
) (SHOWMOON 155803 . 158742) (SHOWREMSINDAY 158744 . 160234) (SHOWREMSINMONTH 160236 . 162686) (
SHOWYEAR 162688 . 166202) (SHRINKMONTH 166204 . 166630) (SHRINKYEAR 166632 . 167161) (TIMEDREMP 167163
. 167287) (TPLUS 167289 . 167823) (WEEKOF 167825 . 168079) (YNCONVERT 168081 . 168247)))))
STOP

BIN
lispusers/CALENDAR.LCOM
View File

Binary file not shown.

123
lispusers/DICTTOOL
View File

@@ -1,41 +1,45 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED " 1-Mar-94 10:43:44" |{IE:PARC:XEROX}<LISPUSERS>MEDLEY>DICTTOOL.;4| 92411
changes to%: (FILES DICTCLIENT)
(VARS DICTTOOLCOMS)
(FNS TEdit.SearchMenu)
(FILECREATED " 1-Feb-2022 16:42:35" {DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>DICTTOOL.;2 92394
previous date%: "27-Mar-91 17:20:45" {DSK}<import>medley2.0>lispusers>DICTTOOL.;1)
:CHANGES-TO (VARS DICTTOOLCOMS)
:PREVIOUS-DATE " 1-Mar-94 10:43:44"
{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>DICTTOOL.;1)
(* ; "
Copyright (c) 1986, 1987, 1988, 1989, 1991, 1994 by Xerox Corporation. All rights reserved.
Copyright (c) 1986-1989, 1991, 1994 by Xerox Corporation.
")
(PRETTYCOMPRINT DICTTOOLCOMS)
(RPAQQ DICTTOOLCOMS
((COMS * DICTTOOLDEPENDENCIES)
(FILES ANALYZER (FROM {NFS}<PROJECT>DICTSERVER>LISP>)
DICTCLIENT)
(FILES ANALYZER)
(* ;; "1/6/89 jtm: fixed TEdit.PrintDefinition so that SimpleDicts would print their entries in the definition window.")
(* ;; "RMK 2022: DICTCLIENT has disappeared")
(* (FILES (FROM {NFS}<PROJECT>DICTSERVER>LISP>)
DICTCLIENT))
(* ;; "1/6/89 jtm: fixed TEdit.PrintDefinition so that SimpleDicts would print their entries in the definition window.")
(* ;; "1/6/89 jtm: changed TEdit.SetDictionary and DictForStream so that TEdit.DefaultDictionary reflects the default dictionary to use if no other is specified.")
(* ;; "1/6/89 jtm: changed TEdit.SetDictionary and DictForStream so that TEdit.DefaultDictionary reflects the default dictionary to use if no other is specified.")
(* ;; "2/28/89 jtm: changed FILES so that DICTCLIENT is loaded from PIGLET.")
(* ;; "2/28/89 jtm: changed FILES so that DICTCLIENT is loaded from PIGLET.")
(* ;;
 "5/31/89 jtm: changed Dict.AddCommands to put Dictionary menu item on Lafite display windows.")
(* ;;
 "5/31/89 jtm: changed Dict.AddCommands to put Dictionary menu item on Lafite display windows.")
(* ;; "3/27/91 jtm: added TEdit interface to the SearchMenu module")
(* ;; "3/27/91 jtm: added TEdit interface to the SearchMenu module")
(* ;; "3/1/94 jtm: changed the loading of DICTCLIENT and SEARCHMENU")
(* ;; "3/1/94 jtm: changed the loading of DICTCLIENT and SEARCHMENU")
(FNS TEDIT.INCLUDESTREAM TEdit.PrintDefinition DictTool.PrintDefinition Dict.PrintDefinition
DictTool.GetEntry TEdit.SetDictionary DictForStream DictTool.Dictionaries PARSEBYCOLONS
@@ -86,28 +90,36 @@ Copyright (c) 1986, 1987, 1988, 1989, 1991, 1994 by Xerox Corporation. All righ
T)
(PUTPROP (CAR FILE)
'FILEDATES NIL])
(* * code to make sure that the right versions of everything are loaded. The P must be executed
before any FILES commands.)
(* * code to make sure that the right versions of everything are loaded. The P must be executed before
any FILES commands.)
(PUTPROPS DICTTOOL DEPENDENCIES ((ANALYZER . " 9-Mar-89 15:24:58")
(DICTCLIENT . " 8-Aug-88 16:01:50")))
(PUTPROPS DICTTOOL DEPENDENCIES ((ANALYZER . " 9-Mar-89 15:24:58")))
[for FILE FILEDATE in (GETPROP 'DICTTOOL 'DEPENDENCIES)
do [SETQ FILEDATE (CAAR (GETPROP (CAR FILE)
'FILEDATES]
(COND
([AND FILEDATE (CDR FILE)
(ILESSP (IDATE FILEDATE)
(IDATE (CDR FILE] (* clear FILEDATES to force
 FILESLOAD to reload the file.)
(printout T "Flushing old version of " (CAR FILE)
T)
(PUTPROP (CAR FILE)
'FILEDATES NIL]
'FILEDATES]
(COND
([AND FILEDATE (CDR FILE)
(ILESSP (IDATE FILEDATE)
(IDATE (CDR FILE] (* clear FILEDATES to force FILESLOAD
 to reload the file.)
(printout T "Flushing old version of " (CAR FILE)
T)
(PUTPROP (CAR FILE)
'FILEDATES NIL]
(FILESLOAD ANALYZER)
(* ;; "RMK 2022: DICTCLIENT has disappeared")
(* (FILES (FROM {NFS}<PROJECT>DICTSERVER>LISP>) DICTCLIENT))
(FILESLOAD ANALYZER (FROM {NFS}<PROJECT>DICTSERVER>LISP>)
DICTCLIENT)
@@ -130,8 +142,7 @@ before any FILES commands.)
(* ;; "5/31/89 jtm: changed Dict.AddCommands to put Dictionary menu item on Lafite display windows."
)
(* ;; "5/31/89 jtm: changed Dict.AddCommands to put Dictionary menu item on Lafite display windows.")
@@ -1743,27 +1754,27 @@ before any FILES commands.)
(q Æ a)))
(PUTPROPS DICTTOOL COPYRIGHT ("Xerox Corporation" 1986 1987 1988 1989 1991 1994))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (6223 19029 (TEDIT.INCLUDESTREAM 6233 . 6744) (TEdit.PrintDefinition 6746 . 9000) (
DictTool.PrintDefinition 9002 . 11539) (Dict.PrintDefinition 11541 . 12504) (DictTool.GetEntry 12506
. 12805) (TEdit.SetDictionary 12807 . 14966) (DictForStream 14968 . 15335) (DictTool.Dictionaries
15337 . 15491) (PARSEBYCOLONS 15493 . 16542) (PrintPronunciationGuide 16544 . 18015) (
ConvertPronunciation 18017 . 19027)) (19030 28623 (TEdit.SearchMenu 19040 . 19270) (TEdit.PrintSearch
19272 . 19722) (DictTool.PrintSearch 19724 . 21987) (DictTool.MergeSearch 21989 . 23817) (
NerdForStream 23819 . 24129) (TEdit.SetNerd 24131 . 26203) (DictTool.PromptForCutoff 26205 . 26752) (
DictTool.PromptForKeywordCutoff 26754 . 27402) (PARSESELECTION 27404 . 28621)) (28624 30679 (
TEdit.PrintPhraseSearch 28634 . 29096) (DictTool.PrintPhraseSearch 29098 . 30677)) (30680 35475 (
TEdit.PrintSynonyms 30690 . 31019) (REMOVEALL 31021 . 31521) (CONVERTFUNCTIONSTOFORMS 31523 . 32013) (
TEdit.PrintNounSynonyms 32015 . 32366) (DictTool.PrintNounSynonyms 32368 . 32552) (
DictTool.PrintVerbSynonyms 32554 . 32738) (DictTool.PrintAdjSynonyms 32740 . 32925) (
TEdit.PrintVerbSynonyms 32927 . 33269) (TEdit.PrintAdjSynonyms 33271 . 33616) (DictTool.PrintSynonyms
33618 . 35473)) (35476 41064 (DictTool.TEditWrapper 35486 . 38724) (Dict.OutputStream 38726 . 40520) (
DictTool.PromptStream 40522 . 41062)) (41065 59074 (DictTool.Init 41075 . 42805) (DictTool.Open 42807
. 46658) (DictTool.OpenDictionary 46660 . 48555) (DictTool.OpenAnalyzer 48557 . 50740) (
DictTool.OpenNerd 50742 . 54106) (Dict.AddCommands 54108 . 58923) (DictTool.Close 58925 . 59072)) (
59075 66681 (DictTool.Analyze 59085 . 63133) (DictTool.Analyzers 63135 . 63365) (
DictTool.Pronunciation 63367 . 63687) (DictTool.Corrections 63689 . 64055) (DictTool.CountWords 64057
. 66679)) (66720 84052 (DictTool.FindWord 66730 . 68741) (DictTool.SubstituteWord 68743 . 78958) (
DictTool.CreateConjugationMap 78960 . 81835) (DictTool.FindWordInit 81837 . 84050)) (84053 89855 (
LingFns.FindWord 84063 . 87881) (LingFns.Capitalize 87883 . 89495) (LingFns.Capitalization 89497 .
89853)))))
(FILEMAP (NIL (6206 19012 (TEDIT.INCLUDESTREAM 6216 . 6727) (TEdit.PrintDefinition 6729 . 8983) (
DictTool.PrintDefinition 8985 . 11522) (Dict.PrintDefinition 11524 . 12487) (DictTool.GetEntry 12489
. 12788) (TEdit.SetDictionary 12790 . 14949) (DictForStream 14951 . 15318) (DictTool.Dictionaries
15320 . 15474) (PARSEBYCOLONS 15476 . 16525) (PrintPronunciationGuide 16527 . 17998) (
ConvertPronunciation 18000 . 19010)) (19013 28606 (TEdit.SearchMenu 19023 . 19253) (TEdit.PrintSearch
19255 . 19705) (DictTool.PrintSearch 19707 . 21970) (DictTool.MergeSearch 21972 . 23800) (
NerdForStream 23802 . 24112) (TEdit.SetNerd 24114 . 26186) (DictTool.PromptForCutoff 26188 . 26735) (
DictTool.PromptForKeywordCutoff 26737 . 27385) (PARSESELECTION 27387 . 28604)) (28607 30662 (
TEdit.PrintPhraseSearch 28617 . 29079) (DictTool.PrintPhraseSearch 29081 . 30660)) (30663 35458 (
TEdit.PrintSynonyms 30673 . 31002) (REMOVEALL 31004 . 31504) (CONVERTFUNCTIONSTOFORMS 31506 . 31996) (
TEdit.PrintNounSynonyms 31998 . 32349) (DictTool.PrintNounSynonyms 32351 . 32535) (
DictTool.PrintVerbSynonyms 32537 . 32721) (DictTool.PrintAdjSynonyms 32723 . 32908) (
TEdit.PrintVerbSynonyms 32910 . 33252) (TEdit.PrintAdjSynonyms 33254 . 33599) (DictTool.PrintSynonyms
33601 . 35456)) (35459 41047 (DictTool.TEditWrapper 35469 . 38707) (Dict.OutputStream 38709 . 40503) (
DictTool.PromptStream 40505 . 41045)) (41048 59057 (DictTool.Init 41058 . 42788) (DictTool.Open 42790
. 46641) (DictTool.OpenDictionary 46643 . 48538) (DictTool.OpenAnalyzer 48540 . 50723) (
DictTool.OpenNerd 50725 . 54089) (Dict.AddCommands 54091 . 58906) (DictTool.Close 58908 . 59055)) (
59058 66664 (DictTool.Analyze 59068 . 63116) (DictTool.Analyzers 63118 . 63348) (
DictTool.Pronunciation 63350 . 63670) (DictTool.Corrections 63672 . 64038) (DictTool.CountWords 64040
. 66662)) (66703 84035 (DictTool.FindWord 66713 . 68724) (DictTool.SubstituteWord 68726 . 78941) (
DictTool.CreateConjugationMap 78943 . 81818) (DictTool.FindWordInit 81820 . 84033)) (84036 89838 (
LingFns.FindWord 84046 . 87864) (LingFns.Capitalize 87866 . 89478) (LingFns.Capitalization 89480 .
89836)))))
STOP

BIN
lispusers/DICTTOOL.LCOM Normal file
View File

Binary file not shown.

106
lispusers/DINFO
View File

@@ -1,12 +1,11 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "25-Oct-2021 23:24:46" 
{DSK}<Users>kaplan>Local>medley3.5>git-medley>lispusers>DINFO.;2 65213
(FILECREATED " 3-Feb-2022 11:57:39" {DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>DINFO.;5 65271
changes to%: (FNS DINFO.CREATE.FMENU)
:CHANGES-TO (FNS DINFO.UPDATE.TEXT.DISPLAY)
previous date%: "14-Feb-2021 23:11:36"
{DSK}<Users>kaplan>Local>medley3.5>git-medley>lispusers>DINFO.;1)
:PREVIOUS-DATE "21-Jan-2022 23:16:01"
{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>DINFO.;3)
(* ; "
@@ -64,7 +63,7 @@ Copyright (c) 1985-1987, 2020-2021 by Xerox Corporation.
(SYSTEM))
(RECORD DINFONODE (ID LABEL FILE FROMBYTE TOBYTE PARENT CHILDREN NEXTNODE PREVIOUSNODE USERDATA)
(SYSTEM))
(SYSTEM))
)
(/DECLAREDATATYPE 'DINFOGRAPH
@@ -109,24 +108,20 @@ Copyright (c) 1985-1987, 2020-2021 by Xerox Corporation.
(CADR PROP]
(IF NEW-VALUE-SUPPLIED
THEN [IF REAL-FIELD
THEN `(REPLACE (DINFOGRAPH ,REAL-FIELD) OF ,GRAPH
WITH ,NEW-VALUE)
ELSE `(LET* ((SI::$GRAPH$ ,GRAPH)
(SI::$USERDATA$ (FETCH (DINFOGRAPH USERDATA)
OF SI::$GRAPH$))
(SI::$PROP$ ,PROP)
(SI::$NEW-VALUE$ ,NEW-VALUE))
(IF (LISTP SI::$USERDATA$)
THEN (LISTPUT SI::$USERDATA$ SI::$PROP$
SI::$NEW-VALUE$)
ELSE (REPLACE (DINFOGRAPH USERDATA) OF
SI::$GRAPH$
WITH (LIST SI::$PROP$ SI::$NEW-VALUE$))
SI::$NEW-VALUE$]
THEN `(REPLACE (DINFOGRAPH ,REAL-FIELD) OF ,GRAPH WITH ,NEW-VALUE)
ELSE `(LET* ((SI::$GRAPH$ ,GRAPH)
(SI::$USERDATA$ (FETCH (DINFOGRAPH USERDATA) OF SI::$GRAPH$))
(SI::$PROP$ ,PROP)
(SI::$NEW-VALUE$ ,NEW-VALUE))
(IF (LISTP SI::$USERDATA$)
THEN (LISTPUT SI::$USERDATA$ SI::$PROP$ SI::$NEW-VALUE$)
ELSE (REPLACE (DINFOGRAPH USERDATA) OF SI::$GRAPH$
WITH (LIST SI::$PROP$ SI::$NEW-VALUE$))
SI::$NEW-VALUE$]
ELSE (IF REAL-FIELD
THEN `(FETCH (DINFOGRAPH ,REAL-FIELD) OF ,GRAPH)
ELSE `(LISTGET (FETCH (DINFOGRAPH USERDATA) OF ,GRAPH)
,PROP])
THEN `(FETCH (DINFOGRAPH ,REAL-FIELD) OF ,GRAPH)
ELSE `(LISTGET (FETCH (DINFOGRAPH USERDATA) OF ,GRAPH)
,PROP])
)
(/DECLAREDATATYPE 'DINFOGRAPH
@@ -376,7 +371,8 @@ Copyright (c) 1985-1987, 2020-2021 by Xerox Corporation.
NIL])
(DINFO.FIND
[LAMBDA (GRAPH BUTTONS) (* drc%: "25-Jan-86 18:23")
[LAMBDA (GRAPH BUTTONS) (* ; "Edited 21-Jan-2022 23:15 by rmk")
(* drc%: "25-Jan-86 18:23")
(LET ((DINFOW (fetch (DINFOGRAPH WINDOW) of GRAPH)))
(if (NOT (OBTAIN.MONITORLOCK (fetch (DINFOGRAPH MONITORLOCK) of GRAPH)
T))
@@ -386,8 +382,9 @@ Copyright (c) 1985-1987, 2020-2021 by Xerox Corporation.
(TERPRI T)
(LET ([STRING (if (AND (FMEMB 'MIDDLE BUTTONS)
(fetch (DINFOGRAPH FIND.STRING) of GRAPH))
else (PROMPTFORWORD "Find: " (fetch (DINFOGRAPH FIND.STRING)
of GRAPH)
else (TTYINPROMPTFORWORD "Find: " (fetch (DINFOGRAPH
FIND.STRING)
of GRAPH)
NIL NIL NIL 'TTY (CONSTANT (CHARCODE (EOL ESCAPE
LF]
(TEXTSTREAM (WINDOWPROP DINFOW 'TEXTSTREAM))
@@ -404,11 +401,12 @@ Copyright (c) 1985-1987, 2020-2021 by Xerox Corporation.
(NCHARS STRING)
'RIGHT T)))
else (printout T "not found.")
(TEDIT.NORMALIZECARET TEXTSTREAM (TEDIT.SETSEL TEXTSTREAM
(TEDIT.NORMALIZECARET TEXTSTREAM (TEDIT.SETSEL TEXTSTREAM
0 0])
(DINFO.LOOKUP
[LAMBDA (GRAPH BUTTONS) (* drc%: "25-Jan-86 18:22")
[LAMBDA (GRAPH BUTTONS) (* ; "Edited 21-Jan-2022 23:15 by rmk")
(* drc%: "25-Jan-86 18:22")
(LET
((DINFOW (fetch (DINFOGRAPH WINDOW) of GRAPH)))
(if (OBTAIN.MONITORLOCK (fetch (DINFOGRAPH MONITORLOCK) of GRAPH)
@@ -422,7 +420,7 @@ Copyright (c) 1985-1987, 2020-2021 by Xerox Corporation.
(LET* [(OLD.STRING (fetch (DINFOGRAPH LOOKUP.STRING) of GRAPH))
(STRING (if (AND OLD.STRING (FMEMB 'MIDDLE BUTTONS))
then OLD.STRING
else (PROMPTFORWORD "Lookup: " OLD.STRING NIL NIL NIL
else (TTYINPROMPTFORWORD "Lookup: " OLD.STRING NIL NIL NIL
'TTY
(CONSTANT (CHARCODE (EOL ESCAPE LF]
(replace (DINFOGRAPH LOOKUP.STRING) of GRAPH with STRING)
@@ -996,7 +994,8 @@ Copyright (c) 1985-1987, 2020-2021 by Xerox Corporation.
(DEFINEQ
(DINFO.UPDATE.TEXT.DISPLAY
[LAMBDA (GRAPH NODE SEL OFF?) (* drc%: "25-Jan-86 18:18")
[LAMBDA (GRAPH NODE SEL OFF?) (* ; "Edited 3-Feb-2022 11:50 by rmk")
(* drc%: "25-Jan-86 18:18")
(LET ((WINDOW (fetch (DINFOGRAPH WINDOW) of GRAPH))
(FILENAME (DINFO.GET.FILENAME GRAPH NODE))
(FROM (fetch (DINFONODE FROMBYTE) of NODE))
@@ -1007,17 +1006,15 @@ Copyright (c) 1985-1987, 2020-2021 by Xerox Corporation.
'TEXTSTREAM))
TEXTSTREAM FULLFILENAME) (* Default directory and host.)
(if (OR OFF? (NULL FILENAME))
then (OPENTEXTSTREAM (if OFF?
then ""
else "This node has no text")
then (OPENTEXTSTREAM (CL:UNLESS OFF? (OPENSTRINGSTREAM "This node has no text"))
WINDOW NIL NIL PROPS)
(replace (DINFOGRAPH LAST.TEXT) of GRAPH with NIL)
elseif (SETQ FULLFILENAME (MKATOM (INFILEP FILENAME)))
then (SETQ TEXTSTREAM (DINFO.OPENTEXTSTREAM FULLFILENAME WINDOW FROM TO PROPS))
(DINFO.SHOWSEL TEXTSTREAM SEL)
else (OPENTEXTSTREAM (CONCAT "Sorry, can't find the text for this node."
(MKSTRING (CHARACTER (CHARCODE CR)))
"Missing file is: " FILENAME)
else (OPENTEXTSTREAM (OPENSTRINGSTREAM (CONCAT "Sorry, can't find the text for this node."
(MKSTRING (CHARACTER (CHARCODE CR)))
"Missing file is: " FILENAME))
WINDOW NIL NIL PROPS)
(replace (DINFOGRAPH LAST.TEXT) of GRAPH with NIL))
(CLOSEF? OLD.TEXTSTREAM)
@@ -1095,7 +1092,7 @@ Copyright (c) 1985-1987, 2020-2021 by Xerox Corporation.
)
(ADDTOVAR BackgroundMenuCommands (DInfo (DINFO.SELECT.GRAPH)
"Open a DInfo window for browsing documentation."))
"Open a DInfo window for browsing documentation."))
(RPAQQ BackgroundMenu NIL)
@@ -1111,27 +1108,28 @@ Copyright (c) 1985-1987, 2020-2021 by Xerox Corporation.
(GLOBALVARS DINFO.GRAPH.FILES DINFOMODES DINFO.HISTORY.LENGTH \DINFO.MAX.MENU.LEN)
)
(PUTPROPS DINFO FILETYPE :COMPILE-FILE)
(PUTPROPS DINFO FILETYPE :FAKE-COMPILE-FILE)
(DECLARE%: DONTCOPY
(SETTEMPLATE 'DINFOGRAPHPROP 'MACRO)
)
(PUTPROPS DINFO COPYRIGHT ("Xerox Corporation" 1985 1986 1987 2020 2021))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (7733 24559 (DINFO 7743 . 9357) (DINFO.UPDATE 9359 . 12223) (DINFOGRAPH 12225 . 12643) (
DINFO.SPECIAL.UPDATE 12645 . 14343) (DINFO.READ.GRAPH 14345 . 16200) (DINFO.WRITE.GRAPH 16202 . 17292)
(DINFO.SELECT.GRAPH 17294 . 18201) (DINFO.DEFAULT.MENU 18203 . 20727) (DINFO.FIND 20729 . 23113) (
DINFO.LOOKUP 23115 . 24557)) (24560 27254 (DINFO.READ.KOTO.GRAPH 24570 . 27252)) (27255 29569 (
DINFO.SETUP.WINDOW 27265 . 27946) (DINFO.CLOSEFN 27948 . 28381) (DINFO.SHRINKFN 28383 . 28579) (
DINFO.EXPANDFN 28581 . 29138) (DINFO.ICONFN 29140 . 29567)) (29570 40830 (DINFO.ADD.FMENU 29580 .
30675) (DINFO.CREATE.FMENU 30677 . 34626) (DINFO.FMW.CLOSEFN 34628 . 35473) (DINFO.FMENU.HANDLER 35475
. 36114) (DINFO.UPDATE.FMENU 36116 . 38321) (DINFO.TOGGLE.MENU 38323 . 38913) (DINFO.TOGGLE.GRAPH
38915 . 39414) (DINFO.TOGGLE.HISTORY 39416 . 39960) (DINFO.TOGGLE.TEXT 39962 . 40828)) (40831 48529 (
DINFO.UPDATE.MENU.DISPLAY 40841 . 44861) (DINFO.UPDATE.FROM.MENU 44863 . 45162) (DINFO.UPDATE.HISTORY
45164 . 47698) (DINFO.HISTORIC.UPDATE 47700 . 48527)) (48530 58696 (DINFO.UPDATE.GRAPH.DISPLAY 48540
. 49858) (DINFO.UPDATE.FROM.GRAPH 49860 . 50303) (DINFO.GET.GRAPH.WINDOW 50305 . 50890) (
DINFO.CREATE.GRAPH.WINDOW 50892 . 52009) (DINFO.SHOWGRAPH 52011 . 53736) (DINFO.INVERT.NODE 53738 .
55126) (DINFO.LAYOUTGRAPH 55128 . 58694)) (58697 64553 (DINFO.UPDATE.TEXT.DISPLAY 58707 . 60568) (
DINFO.TITLEMENUFN 60570 . 61695) (DINFO.OPENTEXTSTREAM 61697 . 62913) (DINFO.SHOWSEL 62915 . 63648) (
DINFO.GET.FILENAME 63650 . 64551)))))
(FILEMAP (NIL (4678 6137 (DINFOGRAPHPROP 4678 . 6137)) (7391 24529 (DINFO 7401 . 9015) (DINFO.UPDATE
9017 . 11881) (DINFOGRAPH 11883 . 12301) (DINFO.SPECIAL.UPDATE 12303 . 14001) (DINFO.READ.GRAPH 14003
. 15858) (DINFO.WRITE.GRAPH 15860 . 16950) (DINFO.SELECT.GRAPH 16952 . 17859) (DINFO.DEFAULT.MENU
17861 . 20385) (DINFO.FIND 20387 . 22973) (DINFO.LOOKUP 22975 . 24527)) (24530 27224 (
DINFO.READ.KOTO.GRAPH 24540 . 27222)) (27225 29539 (DINFO.SETUP.WINDOW 27235 . 27916) (DINFO.CLOSEFN
27918 . 28351) (DINFO.SHRINKFN 28353 . 28549) (DINFO.EXPANDFN 28551 . 29108) (DINFO.ICONFN 29110 .
29537)) (29540 40800 (DINFO.ADD.FMENU 29550 . 30645) (DINFO.CREATE.FMENU 30647 . 34596) (
DINFO.FMW.CLOSEFN 34598 . 35443) (DINFO.FMENU.HANDLER 35445 . 36084) (DINFO.UPDATE.FMENU 36086 . 38291
) (DINFO.TOGGLE.MENU 38293 . 38883) (DINFO.TOGGLE.GRAPH 38885 . 39384) (DINFO.TOGGLE.HISTORY 39386 .
39930) (DINFO.TOGGLE.TEXT 39932 . 40798)) (40801 48499 (DINFO.UPDATE.MENU.DISPLAY 40811 . 44831) (
DINFO.UPDATE.FROM.MENU 44833 . 45132) (DINFO.UPDATE.HISTORY 45134 . 47668) (DINFO.HISTORIC.UPDATE
47670 . 48497)) (48500 58666 (DINFO.UPDATE.GRAPH.DISPLAY 48510 . 49828) (DINFO.UPDATE.FROM.GRAPH 49830
. 50273) (DINFO.GET.GRAPH.WINDOW 50275 . 50860) (DINFO.CREATE.GRAPH.WINDOW 50862 . 51979) (
DINFO.SHOWGRAPH 51981 . 53706) (DINFO.INVERT.NODE 53708 . 55096) (DINFO.LAYOUTGRAPH 55098 . 58664)) (
58667 64610 (DINFO.UPDATE.TEXT.DISPLAY 58677 . 60625) (DINFO.TITLEMENUFN 60627 . 61752) (
DINFO.OPENTEXTSTREAM 61754 . 62970) (DINFO.SHOWSEL 62972 . 63705) (DINFO.GET.FILENAME 63707 . 64608)))
))
STOP

BIN
lispusers/DINFO.LCOM
View File

Binary file not shown.

510
lispusers/FM-CREATOR
View File

@@ -1,18 +1,21 @@
(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")
(FILECREATED "18-Aug-88 14:32:54" {DSK}<LISPFILES>ANDRE>FM-CREATOR.;12 173736
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
changes to%: (VARS FM-CREATORCOMS)
(FILECREATED " 1-Feb-2022 17:09:01" 
{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>FM-CREATOR.;2 171676
previous date%: "18-Aug-88 14:11:30" {DSK}<LISPFILES>ANDRE>FM-CREATOR.;11)
:CHANGES-TO (FNS FMC-EDIT.INFO)
:PREVIOUS-DATE "18-Aug-88 14:32:54"
{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>FM-CREATOR.;1)
(* "
Copyright (c) 1988 by Rank Xerox France. Author Andre BLAVIER. All rights reserved.
(* ; "
Copyright (c) 1988 by Rank Xerox France. Author Andre BLAVIER.
")
(PRETTYCOMPRINT FM-CREATORCOMS)
(RPAQQ FM-CREATORCOMS
(RPAQQ FM-CREATORCOMS
((PROP MAKEFILE-ENVIRONMENT FM-CREATOR)
(* * FMC items record)
(RECORDS FMC-ITEM)
@@ -71,13 +74,14 @@ Copyright (c) 1988 by Rank Xerox France. Author Andre BLAVIER. All rights reser
TITLEREG _ (CREATEREGION 2 2 70 28]
(* *)
(COMS (P [OR (SASSOC 'FMCreator BackgroundMenuCommands)
(NCONC1 BackgroundMenuCommands '(FMCreator '(FMC-CREATE)
(NCONC1 BackgroundMenuCommands '(FMCreator '(FMC-CREATE)
"Opens a Free Menu Creator window for use"
]
(SETQ BackgroundMenu NIL)))
(CURSORS MOVINGCURSOR)))
(PUTPROPS FM-CREATOR MAKEFILE-ENVIRONMENT (:READTABLE "INTERLISP" :PACKAGE "INTERLISP"))
(PUTPROPS FM-CREATOR MAKEFILE-ENVIRONMENT (:READTABLE "INTERLISP" :PACKAGE "INTERLISP"))
(* * FMC items record)
(DECLARE%: EVAL@COMPILE
@@ -611,57 +615,66 @@ Copyright (c) 1988 by Rank Xerox France. Author Andre BLAVIER. All rights reser
(* * FMC macros)
(DEFMACRO FM-GET.ITEM.LABEL (ID.OR.LABEL WINDOW) (LIST 'FM.ITEMPROP (LIST 'FM.GETITEM ID.OR.LABEL NIL
WINDOW)
''LABEL))
(DEFMACRO FM-GET.ITEM.LABEL (ID.OR.LABEL WINDOW)
(LIST 'FM.ITEMPROP (LIST 'FM.GETITEM ID.OR.LABEL NIL WINDOW)
''LABEL))
(DEFMACRO FM-GET.ITEM.STATE (ID.OR.LABEL WINDOW)
(LIST 'FM.ITEMPROP (LIST 'FM.GETITEM ID.OR.LABEL NIL WINDOW)
''STATE))
(DEFMACRO FM-GET.ITEM.STATE (ID.OR.LABEL WINDOW) (LIST 'FM.ITEMPROP (LIST 'FM.GETITEM ID.OR.LABEL NIL
WINDOW)
''STATE))
(DEFMACRO FMC-CLEAR.REGION (REGION WINDOW)
(LIST 'DSPFILL REGION 'WHITESHADE ''REPLACE WINDOW))
(DEFMACRO FMC-GET.ITEM (ITEM FIELD)
(LIST 'fetch `(FMC-ITEM ,FIELD)
'of ITEM))
(DEFMACRO FMC-CLEAR.REGION (REGION WINDOW) (LIST 'DSPFILL REGION 'WHITESHADE ''REPLACE WINDOW))
(DEFMACRO FMC-GROUP? (OBJECT)
(LIST 'EQ `(FMC-GET.ITEM ,OBJECT TYPE)
''GROUP))
(DEFMACRO FMC-MARK.AS.CHANGED (W)
(LIST 'WINDOWPROP W ''FMC.CHANGED T))
(DEFMACRO FMC-GET.ITEM (ITEM FIELD) (LIST 'fetch `(FMC-ITEM ,FIELD) 'of ITEM))
(DEFMACRO FMC-PUT.ITEM (ITEM FIELD VALUE)
(LIST 'replace `(FMC-ITEM ,FIELD)
'of ITEM 'with VALUE))
(DEFMACRO GET.REGION.BOTTOM (REGION)
(LIST 'fetch '(REGION BOTTOM)
'of REGION))
(DEFMACRO FMC-GROUP? (OBJECT) (LIST 'EQ `(FMC-GET.ITEM ,OBJECT TYPE) ''GROUP))
(DEFMACRO GET.REGION.HEIGHT (REGION)
(LIST 'fetch '(REGION HEIGHT)
'of REGION))
(DEFMACRO GET.REGION.LEFT (REGION)
(LIST 'fetch '(REGION LEFT)
'of REGION))
(DEFMACRO FMC-MARK.AS.CHANGED (W) (LIST 'WINDOWPROP W ''FMC.CHANGED T))
(DEFMACRO GET.REGION.WIDTH (REGION)
(LIST 'fetch '(REGION WIDTH)
'of REGION))
(DEFMACRO NULLSTR (STR)
(LIST 'STREQUAL STR ""))
(DEFMACRO FMC-PUT.ITEM (ITEM FIELD VALUE) (LIST 'replace `(FMC-ITEM ,FIELD) 'of ITEM 'with VALUE))
(DEFMACRO PUT.REGION.BOTTOM (REGION VALUE)
(LIST 'replace '(REGION BOTTOM)
'of REGION 'with VALUE))
(DEFMACRO PUT.REGION.HEIGHT (REGION VALUE)
(LIST 'replace '(REGION HEIGHT)
'of REGION 'with VALUE))
(DEFMACRO GET.REGION.BOTTOM (REGION) (LIST 'fetch '(REGION BOTTOM) 'of REGION))
(DEFMACRO GET.REGION.HEIGHT (REGION) (LIST 'fetch '(REGION HEIGHT) 'of REGION))
(DEFMACRO GET.REGION.LEFT (REGION) (LIST 'fetch '(REGION LEFT) 'of REGION))
(DEFMACRO GET.REGION.WIDTH (REGION) (LIST 'fetch '(REGION WIDTH) 'of REGION))
(DEFMACRO NULLSTR (STR) (LIST 'STREQUAL STR ""))
(DEFMACRO PUT.REGION.BOTTOM (REGION VALUE) (LIST 'replace '(REGION BOTTOM) 'of REGION 'with VALUE))
(DEFMACRO PUT.REGION.HEIGHT (REGION VALUE) (LIST 'replace '(REGION HEIGHT) 'of REGION 'with VALUE))
(DEFMACRO PUT.REGION.LEFT (REGION VALUE) (LIST 'replace '(REGION LEFT) 'of REGION 'with VALUE))
(DEFMACRO PUT.REGION.WIDTH (REGION VALUE) (LIST 'replace '(REGION WIDTH) 'of REGION 'with VALUE))
(DEFMACRO PUT.REGION.LEFT (REGION VALUE)
(LIST 'replace '(REGION LEFT)
'of REGION 'with VALUE))
(DEFMACRO PUT.REGION.WIDTH (REGION VALUE)
(LIST 'replace '(REGION WIDTH)
'of REGION 'with VALUE))
(* * Right menu functions)
(DEFINEQ
@@ -1457,160 +1470,146 @@ Copyright (c) 1988 by Rank Xerox France. Author Andre BLAVIER. All rights reser
(* * Property windows descriptions)
(RPAQQ FMC-IP-DESC ((PROPS FORMAT EXPLICIT)
(LABEL APPLY TYPE MOMENTARY LEFT 0 BOTTOM 195 BOX 1 BOXSHADE 65535 BOXSPACE 1
FONT (MODERN 14 BOLDITALIC)
SELECTEDFN FMC-APPLY)
(LABEL SHOW TYPE MOMENTARY LEFT 49 BOTTOM 195 BOX 1 BOXSHADE 65535 BOXSPACE 1
FONT (MODERN 14 BOLDITALIC)
SELECTEDFN FMC-SHOW.ITEM)
(LABEL NEW TYPE MOMENTARY LEFT 111 BOTTOM 195 BOX 1 BOXSHADE 65535 BOXSPACE 1
FONT (MODERN 14 BOLDITALIC)
SELECTEDFN FMC-NEWITEM)
(LABEL TYPE TYPE STATE LEFT -1 BOTTOM 178 FONT (MODERN 12 BOLD)
MENUITEMS
(MOMENTARY TOGGLE 3STATE STATE NWAY EDIT NUMBER EDITSTART DISPLAY)
LINKS
(DISPLAY TYPELINK)
INITSTATE MOMENTARY)
(LABEL MOMENTARY TYPE DISPLAY LEFT 31 BOTTOM 177 ID TYPELINK FONT
(MODERN 12 STANDARD))
(LABEL LABEL TYPE MOMENTARY LEFT 113 BOTTOM 178 FONT (MODERN 12 BOLD)
SELECTEDFN FMC-GET.LABEL LINKS (EDIT LABELLINK))
(LABEL "" TYPE EDIT LEFT 151 BOTTOM 177 ID LABELLINK FONT (MODERN 12 STANDARD)
INITSTATE "IIIIMMMMMMMMMMMMMMM")
(LABEL ID TYPE EDITSTART LEFT -1 BOTTOM 162 FONT (MODERN 12 BOLD)
LINKS
(EDIT IDLINK))
(LABEL "" TYPE EDIT LEFT 14 BOTTOM 161 ID IDLINK FONT (MODERN 12 STANDARD)
INITSTATE "")
(LABEL FONT TYPE DISPLAY LEFT -1 BOTTOM 146 FONT (MODERN 12 ITALIC))
(LABEL FAMILY TYPE STATE LEFT 32 BOTTOM 146 ID FAMILY FONT (MODERN 12 BOLD)
MENUITEMS
(CLASSIC MODERN TERMINAL TITAN GACHA HELVETICA TIMESROMAN)
LINKS
(DISPLAY FAMILYLINK)
INITSTATE GACHA)
(LABEL GACHA TYPE DISPLAY LEFT 77 BOTTOM 145 ID FAMILYLINK FONT (MODERN 12
(RPAQQ FMC-IP-DESC
((PROPS FORMAT EXPLICIT)
(LABEL APPLY TYPE MOMENTARY LEFT 0 BOTTOM 195 BOX 1 BOXSHADE 65535 BOXSPACE 1 FONT
(MODERN 14 BOLDITALIC)
SELECTEDFN FMC-APPLY)
(LABEL SHOW TYPE MOMENTARY LEFT 49 BOTTOM 195 BOX 1 BOXSHADE 65535 BOXSPACE 1 FONT
(MODERN 14 BOLDITALIC)
SELECTEDFN FMC-SHOW.ITEM)
(LABEL NEW TYPE MOMENTARY LEFT 111 BOTTOM 195 BOX 1 BOXSHADE 65535 BOXSPACE 1 FONT
(MODERN 14 BOLDITALIC)
SELECTEDFN FMC-NEWITEM)
(LABEL TYPE TYPE STATE LEFT -1 BOTTOM 178 FONT (MODERN 12 BOLD)
MENUITEMS
(MOMENTARY TOGGLE 3STATE STATE NWAY EDIT NUMBER EDITSTART DISPLAY)
LINKS
(DISPLAY TYPELINK)
INITSTATE MOMENTARY)
(LABEL MOMENTARY TYPE DISPLAY LEFT 31 BOTTOM 177 ID TYPELINK FONT (MODERN 12 STANDARD))
(LABEL LABEL TYPE MOMENTARY LEFT 113 BOTTOM 178 FONT (MODERN 12 BOLD)
SELECTEDFN FMC-GET.LABEL LINKS (EDIT LABELLINK))
(LABEL "" TYPE EDIT LEFT 151 BOTTOM 177 ID LABELLINK FONT (MODERN 12 STANDARD)
INITSTATE "IIIIMMMMMMMMMMMMMMM")
(LABEL ID TYPE EDITSTART LEFT -1 BOTTOM 162 FONT (MODERN 12 BOLD)
LINKS
(EDIT IDLINK))
(LABEL "" TYPE EDIT LEFT 14 BOTTOM 161 ID IDLINK FONT (MODERN 12 STANDARD)
INITSTATE "")
(LABEL FONT TYPE DISPLAY LEFT -1 BOTTOM 146 FONT (MODERN 12 ITALIC))
(LABEL FAMILY TYPE STATE LEFT 32 BOTTOM 146 ID FAMILY FONT (MODERN 12 BOLD)
MENUITEMS
(CLASSIC MODERN TERMINAL TITAN GACHA HELVETICA TIMESROMAN)
LINKS
(DISPLAY FAMILYLINK)
INITSTATE GACHA)
(LABEL GACHA TYPE DISPLAY LEFT 77 BOTTOM 145 ID FAMILYLINK FONT (MODERN 12 STANDARD))
(LABEL SIZE TYPE STATE LEFT 161 BOTTOM 146 ID SIZE FONT (MODERN 12 BOLD)
MENUITEMS
(6 7 8 9 10 11 12 14 18 24 30 36)
LINKS
(DISPLAY SIZELINK)
INITSTATE 12)
(LABEL 10 TYPE DISPLAY LEFT 191 BOTTOM 145 ID SIZELINK FONT (MODERN 12 STANDARD))
(LABEL FACE TYPE STATE LEFT 210 BOTTOM 146 ID FACE FONT (MODERN 12 BOLD)
MENUITEMS
(REGULAR ITALIC BOLD BOLDITALIC)
LINKS
(DISPLAY FACELINK)
INITSTATE BOLDITALIC)
(LABEL REGULAR TYPE DISPLAY LEFT 241 BOTTOM 145 ID FACELINK FONT (MODERN 12 STANDARD))
(LABEL BOX TYPE STATE LEFT -1 BOTTOM 130 FONT (MODERN 12 BOLD)
MENUITEMS
(0 1 2 3 4 5 6 7 8 9 10)
LINKS
(DISPLAY BOXLINK)
INITSTATE 0)
(LABEL 0 TYPE DISPLAY LEFT 26 BOTTOM 129 ID BOXLINK FONT (MODERN 12 STANDARD))
(LABEL BOXSHADE TYPE STATE LEFT 40 BOTTOM 130 FONT (MODERN 12 BOLD)
SELECTEDFN FMC-CHOOSE.ITEM.BOXSHADE LINKS (DISPLAY BOXSHADELINK))
(LABEL "" TYPE DISPLAY LEFT 107 BOTTOM 130 ID BOXSHADELINK FONT (MODERN 12 STANDARD)
MAXWIDTH 60)
(LABEL BACKGROUND TYPE STATE LEFT 176 BOTTOM 130 ID BACKGROUND FONT (MODERN 12 BOLD)
SELECTEDFN FMC-CHOOSE.ITEM.BG LINKS (DISPLAY BACKGROUNDLINK))
(LABEL "" TYPE DISPLAY LEFT 262 BOTTOM 130 ID BACKGROUNDLINK FONT (MODERN 12 STANDARD)
MAXWIDTH 60)
(LABEL MENU TYPE STATE LEFT -1 BOTTOM 114 FONT (MODERN 12 BOLD)
SELECTEDFN FMC-GET.MENUPROPS LINKS (DISPLAY MENULINK)
INITSTATE "(NIL)")
(LABEL "(NIL)" TYPE DISPLAY LEFT 39 BOTTOM 113 ID MENULINK FONT (MODERN 12 STANDARD))
(LABEL INITSTATE TYPE STATE LEFT 195 BOTTOM 114 ID INITSTATE FONT (MODERN 12 BOLD)
SELECTEDFN FMC-GET.INITSTATE LINKS (DISPLAY INITSTATELINK))
(LABEL "#NOLABEL#" TYPE DISPLAY LEFT 257 BOTTOM 113 ID INITSTATELINK FONT (MODERN 12 STANDARD
))
(LABEL CHANGESTATE TYPE STATE LEFT -1 BOTTOM 98 ID CHANGESTATE FONT (MODERN 12 BOLD)
SELECTEDFN FMC-EDIT.FN LINKS (DISPLAY CHANGESTATELINK)
INITSTATE "(FUNCTION NILL)")
(LABEL "(FUNCTION NILL)" TYPE DISPLAY LEFT 89 BOTTOM 97 ID CHANGESTATELINK FONT
(MODERN 12 STANDARD))
(LABEL SELECTEDFN TYPE STATE LEFT -1 BOTTOM 81 ID SELECTEDFN FONT (MODERN 12 BOLD)
SELECTEDFN FMC-EDIT.FN LINKS (DISPLAY SELECTEDFNLINK)
INITSTATE "(FUNCTION NILL)")
(LABEL "(FUNCTION NILL)" TYPE DISPLAY LEFT 75 BOTTOM 80 ID SELECTEDFNLINK FONT
(MODERN 12 STANDARD))
(LABEL "DOWNFN" TYPE STATE LEFT -1 BOTTOM 65 ID DOWNFN FONT (MODERN 12 BOLD)
SELECTEDFN FMC-EDIT.FN LINKS (DISPLAY DOWNFNLINK)
INITSTATE "(FUNCTION NILL)")
(LABEL "(FUNCTION NILL)" TYPE DISPLAY LEFT 57 BOTTOM 64 ID DOWNFNLINK FONT (MODERN 12
STANDARD))
(LABEL "HELDFN" TYPE STATE LEFT -1 BOTTOM 49 ID HELDFN FONT (MODERN 12 BOLD)
SELECTEDFN FMC-EDIT.FN LINKS (DISPLAY HELDFNLINK)
INITSTATE "(FUNCTION NILL)")
(LABEL "(FUNCTION NILL)" TYPE DISPLAY LEFT 49 BOTTOM 48 ID HELDFNLINK FONT (MODERN 12
STANDARD))
(LABEL "MOVEDFN" TYPE STATE LEFT -1 BOTTOM 33 ID MOVEDFN FONT (MODERN 12 BOLD)
SELECTEDFN FMC-EDIT.FN LINKS (DISPLAY MOVEDFNLINK)
INITSTATE "(FUNCTION NILL)")
(LABEL "(FUNCTION NILL)" TYPE DISPLAY LEFT 62 BOTTOM 32 ID MOVEDFNLINK FONT (MODERN 12
STANDARD))
(LABEL SIZE TYPE STATE LEFT 161 BOTTOM 146 ID SIZE FONT (MODERN 12 BOLD)
MENUITEMS
(6 7 8 9 10 11 12 14 18 24 30 36)
LINKS
(DISPLAY SIZELINK)
INITSTATE 12)
(LABEL 10 TYPE DISPLAY LEFT 191 BOTTOM 145 ID SIZELINK FONT (MODERN 12 STANDARD))
(LABEL FACE TYPE STATE LEFT 210 BOTTOM 146 ID FACE FONT (MODERN 12 BOLD)
MENUITEMS
(REGULAR ITALIC BOLD BOLDITALIC)
LINKS
(DISPLAY FACELINK)
INITSTATE BOLDITALIC)
(LABEL REGULAR TYPE DISPLAY LEFT 241 BOTTOM 145 ID FACELINK FONT (MODERN 12
STANDARD)
)
(LABEL BOX TYPE STATE LEFT -1 BOTTOM 130 FONT (MODERN 12 BOLD)
MENUITEMS
(0 1 2 3 4 5 6 7 8 9 10)
LINKS
(DISPLAY BOXLINK)
INITSTATE 0)
(LABEL 0 TYPE DISPLAY LEFT 26 BOTTOM 129 ID BOXLINK FONT (MODERN 12 STANDARD))
(LABEL BOXSHADE TYPE STATE LEFT 40 BOTTOM 130 FONT (MODERN 12 BOLD)
SELECTEDFN FMC-CHOOSE.ITEM.BOXSHADE LINKS (DISPLAY BOXSHADELINK))
(LABEL "" TYPE DISPLAY LEFT 107 BOTTOM 130 ID BOXSHADELINK FONT (MODERN 12
STANDARD)
MAXWIDTH 60)
(LABEL BACKGROUND TYPE STATE LEFT 176 BOTTOM 130 ID BACKGROUND FONT
(MODERN 12 BOLD)
SELECTEDFN FMC-CHOOSE.ITEM.BG LINKS (DISPLAY BACKGROUNDLINK))
(LABEL "" TYPE DISPLAY LEFT 262 BOTTOM 130 ID BACKGROUNDLINK FONT
(MODERN 12 STANDARD)
MAXWIDTH 60)
(LABEL MENU TYPE STATE LEFT -1 BOTTOM 114 FONT (MODERN 12 BOLD)
SELECTEDFN FMC-GET.MENUPROPS LINKS (DISPLAY MENULINK)
INITSTATE "(NIL)")
(LABEL "(NIL)" TYPE DISPLAY LEFT 39 BOTTOM 113 ID MENULINK FONT (MODERN 12
STANDARD))
(LABEL INITSTATE TYPE STATE LEFT 195 BOTTOM 114 ID INITSTATE FONT
(MODERN 12 BOLD)
SELECTEDFN FMC-GET.INITSTATE LINKS (DISPLAY INITSTATELINK))
(LABEL "#NOLABEL#" TYPE DISPLAY LEFT 257 BOTTOM 113 ID INITSTATELINK FONT
(MODERN 12 STANDARD))
(LABEL CHANGESTATE TYPE STATE LEFT -1 BOTTOM 98 ID CHANGESTATE FONT
(MODERN 12 BOLD)
SELECTEDFN FMC-EDIT.FN LINKS (DISPLAY CHANGESTATELINK)
INITSTATE "(FUNCTION NILL)")
(LABEL "(FUNCTION NILL)" TYPE DISPLAY LEFT 89 BOTTOM 97 ID CHANGESTATELINK FONT
(MODERN 12 STANDARD))
(LABEL SELECTEDFN TYPE STATE LEFT -1 BOTTOM 81 ID SELECTEDFN FONT
(MODERN 12 BOLD)
SELECTEDFN FMC-EDIT.FN LINKS (DISPLAY SELECTEDFNLINK)
INITSTATE "(FUNCTION NILL)")
(LABEL "(FUNCTION NILL)" TYPE DISPLAY LEFT 75 BOTTOM 80 ID SELECTEDFNLINK FONT
(MODERN 12 STANDARD))
(LABEL "DOWNFN" TYPE STATE LEFT -1 BOTTOM 65 ID DOWNFN FONT (MODERN 12 BOLD)
SELECTEDFN FMC-EDIT.FN LINKS (DISPLAY DOWNFNLINK)
INITSTATE "(FUNCTION NILL)")
(LABEL "(FUNCTION NILL)" TYPE DISPLAY LEFT 57 BOTTOM 64 ID DOWNFNLINK FONT
(MODERN 12 STANDARD))
(LABEL "HELDFN" TYPE STATE LEFT -1 BOTTOM 49 ID HELDFN FONT (MODERN 12 BOLD)
SELECTEDFN FMC-EDIT.FN LINKS (DISPLAY HELDFNLINK)
INITSTATE "(FUNCTION NILL)")
(LABEL "(FUNCTION NILL)" TYPE DISPLAY LEFT 49 BOTTOM 48 ID HELDFNLINK FONT
(MODERN 12 STANDARD))
(LABEL "MOVEDFN" TYPE STATE LEFT -1 BOTTOM 33 ID MOVEDFN FONT (MODERN 12 BOLD)
SELECTEDFN FMC-EDIT.FN LINKS (DISPLAY MOVEDFNLINK)
INITSTATE "(FUNCTION NILL)")
(LABEL "(FUNCTION NILL)" TYPE DISPLAY LEFT 62 BOTTOM 32 ID MOVEDFNLINK FONT
(MODERN 12 STANDARD))
(LABEL LINKS TYPE STATE LEFT -1 BOTTOM 16 FONT (MODERN 12 BOLD)
SELECTEDFN FMC-LINKS LINKS (DISPLAY LINKSLINK)
INITSTATE "(NIL)")
(LABEL "(NIL)" TYPE DISPLAY LEFT 36 BOTTOM 15 ID LINKSLINK FONT (MODERN 12
STANDARD))
(LABEL "INFINITEWIDTH" TYPE TOGGLE LEFT 239 BOTTOM 16 ID INFINITEWIDTH FONT
(MODERN 12 BOLD))
(LABEL MESSAGE TYPE EDITSTART LEFT -1 BOTTOM 0 FONT (MODERN 12 BOLD)
LINKS
(EDIT MESSAGELINK))
(LABEL "" TYPE EDIT LEFT 61 BOTTOM -1 ID MESSAGELINK FONT (MODERN 12 STANDARD)
INITSTATE "MMMMMMMMMMMMMMMMMMMMMMMM")))
(LABEL LINKS TYPE STATE LEFT -1 BOTTOM 16 FONT (MODERN 12 BOLD)
SELECTEDFN FMC-LINKS LINKS (DISPLAY LINKSLINK)
INITSTATE "(NIL)")
(LABEL "(NIL)" TYPE DISPLAY LEFT 36 BOTTOM 15 ID LINKSLINK FONT (MODERN 12 STANDARD))
(LABEL "INFINITEWIDTH" TYPE TOGGLE LEFT 239 BOTTOM 16 ID INFINITEWIDTH FONT (MODERN 12 BOLD))
(LABEL MESSAGE TYPE EDITSTART LEFT -1 BOTTOM 0 FONT (MODERN 12 BOLD)
LINKS
(EDIT MESSAGELINK))
(LABEL "" TYPE EDIT LEFT 61 BOTTOM -1 ID MESSAGELINK FONT (MODERN 12 STANDARD)
INITSTATE "MMMMMMMMMMMMMMMMMMMMMMMM")))
(RPAQQ FMC-GP-DESC ((PROPS FORMAT EXPLICIT)
(LABEL APPLY TYPE MOMENTARY LEFT 0 BOTTOM 106 BOX 1 BOXSHADE 65535 BOXSPACE 1
FONT (MODERN 14 BOLDITALIC)
SELECTEDFN FMC-APPLY)
(LABEL SHOW TYPE MOMENTARY LEFT 49 BOTTOM 106 BOX 1 BOXSHADE 65535 BOXSPACE 1
FONT (MODERN 14 BOLDITALIC)
SELECTEDFN FMC-SHOW.GROUP)
(LABEL "ID" TYPE EDITSTART LEFT 0 BOTTOM 83 FONT (MODERN 12 BOLD)
LINKS
(EDIT IDLINK))
(LABEL "" TYPE EDIT LEFT 17 BOTTOM 82 ID IDLINK FONT (MODERN 12 STANDARD))
(LABEL "COLLECTION" TYPE EDITSTART LEFT 0 BOTTOM 67 FONT (MODERN 12 BOLD)
LINKS
(EDIT COLLECTIONLINK))
(LABEL "" TYPE EDIT LEFT 75 BOTTOM 66 ID COLLECTIONLINK FONT (MODERN 12 STANDARD)
)
(LABEL "DESELECT" ID DESELECT TYPE TOGGLE LEFT 0 BOTTOM 50 FONT (MODERN 12 BOLD))
(LABEL BOX TYPE STATE LEFT 0 BOTTOM 33 FONT (MODERN 12 BOLD)
MENUITEMS
(1 2 3 4 5 6 7 8 9 10)
LINKS
(DISPLAY BOXLINK)
INITSTATE 1)
(LABEL 1 TYPE DISPLAY LEFT 27 BOTTOM 32 ID BOXLINK FONT (MODERN 12 STANDARD))
(LABEL BOXSHADE TYPE STATE LEFT 0 BOTTOM 16 FONT (MODERN 12 BOLD)
SELECTEDFN FMC-CHOOSE.ITEM.BOXSHADE LINKS (DISPLAY BOXSHADELINK))
(LABEL "" TYPE DISPLAY LEFT 86 BOTTOM 16 ID BOXSHADELINK FONT (MODERN 12 STANDARD
)
MAXWIDTH 60)
(LABEL BACKGROUND TYPE STATE LEFT 0 BOTTOM 0 ID BACKGROUND FONT (MODERN 12 BOLD)
SELECTEDFN FMC-CHOOSE.ITEM.BG LINKS (DISPLAY BACKGROUNDLINK))
(LABEL "" TYPE DISPLAY LEFT 86 BOTTOM 0 ID BACKGROUNDLINK FONT (MODERN 12
STANDARD)
MAXWIDTH 60)))
(RPAQQ FMC-GP-DESC
((PROPS FORMAT EXPLICIT)
(LABEL APPLY TYPE MOMENTARY LEFT 0 BOTTOM 106 BOX 1 BOXSHADE 65535 BOXSPACE 1 FONT
(MODERN 14 BOLDITALIC)
SELECTEDFN FMC-APPLY)
(LABEL SHOW TYPE MOMENTARY LEFT 49 BOTTOM 106 BOX 1 BOXSHADE 65535 BOXSPACE 1 FONT
(MODERN 14 BOLDITALIC)
SELECTEDFN FMC-SHOW.GROUP)
(LABEL "ID" TYPE EDITSTART LEFT 0 BOTTOM 83 FONT (MODERN 12 BOLD)
LINKS
(EDIT IDLINK))
(LABEL "" TYPE EDIT LEFT 17 BOTTOM 82 ID IDLINK FONT (MODERN 12 STANDARD))
(LABEL "COLLECTION" TYPE EDITSTART LEFT 0 BOTTOM 67 FONT (MODERN 12 BOLD)
LINKS
(EDIT COLLECTIONLINK))
(LABEL "" TYPE EDIT LEFT 75 BOTTOM 66 ID COLLECTIONLINK FONT (MODERN 12 STANDARD))
(LABEL "DESELECT" ID DESELECT TYPE TOGGLE LEFT 0 BOTTOM 50 FONT (MODERN 12 BOLD))
(LABEL BOX TYPE STATE LEFT 0 BOTTOM 33 FONT (MODERN 12 BOLD)
MENUITEMS
(1 2 3 4 5 6 7 8 9 10)
LINKS
(DISPLAY BOXLINK)
INITSTATE 1)
(LABEL 1 TYPE DISPLAY LEFT 27 BOTTOM 32 ID BOXLINK FONT (MODERN 12 STANDARD))
(LABEL BOXSHADE TYPE STATE LEFT 0 BOTTOM 16 FONT (MODERN 12 BOLD)
SELECTEDFN FMC-CHOOSE.ITEM.BOXSHADE LINKS (DISPLAY BOXSHADELINK))
(LABEL "" TYPE DISPLAY LEFT 86 BOTTOM 16 ID BOXSHADELINK FONT (MODERN 12 STANDARD)
MAXWIDTH 60)
(LABEL BACKGROUND TYPE STATE LEFT 0 BOTTOM 0 ID BACKGROUND FONT (MODERN 12 BOLD)
SELECTEDFN FMC-CHOOSE.ITEM.BG LINKS (DISPLAY BACKGROUNDLINK))
(LABEL "" TYPE DISPLAY LEFT 86 BOTTOM 0 ID BACKGROUNDLINK FONT (MODERN 12 STANDARD)
MAXWIDTH 60)))
(* * Creating bitmaps)
(DEFINEQ
@@ -2671,30 +2670,35 @@ Copyright (c) 1988 by Rank Xerox France. Author Andre BLAVIER. All rights reser
(DEFINEQ
(FMC-EDIT.INFO
[LAMBDA (WINDOW) (* ; "Edited 17-Aug-88 16:57 by A.BLAVIER")
(* ;; "Create a %"dead%" TEdit window, listing a summary of the items.")
[LAMBDA (WINDOW) (* ; "Edited 1-Feb-2022 17:08 by rmk")
(* ; "Edited 17-Aug-88 16:57 by A.BLAVIER")
(* ;; "Create a %"dead%" TEdit window, listing a summary of the items.")
(LET ((ItemList (WINDOWPROP WINDOW 'ITEMLIST))
Stream TEdWindow)
(RESETLST (RESETSAVE (CURSOR WAITINGCURSOR))
(SETQ Stream (OPENTEXTSTREAM ""))
(RESETSAVE NIL (LIST 'CLOSEF Stream))
(FMC-PROMPTPRINT "Creating summary ..." WINDOW)
(SETCURSOR WAITINGCURSOR)
(FMC-SORT.ITEM.LIST ItemList)
(* ;; "")
(RESETLST
(RESETSAVE (CURSOR WAITINGCURSOR))
(SETQ Stream (OPENTEXTSTREAM NIL))
(RESETSAVE NIL (LIST 'CLOSEF Stream))
(FMC-PROMPTPRINT "Creating summary ..." WINDOW)
(SETCURSOR WAITINGCURSOR)
(FMC-SORT.ITEM.LIST ItemList)
(PRINTOUT Stream .FONT '(MODERN 14 BOLD) "- Free Menu Creator Summary -" T T)
(PRINTOUT Stream .FONT '(MODERN 10 REGULAR) (DATE)
T T)
(for item in ItemList do (FMC-EDIT.INFO.ITEM item Stream 0))
(TEDIT.PARALOOKS Stream '(QUAD CENTERED) 1 2)
(SETCURSOR DEFAULTCURSOR)
(FMC-PROMPTPRINT "Creating summary ... done" WINDOW)
(SETQ TEdWindow (CREATEW NIL "FMC Items Summary"))
(OPENTEXTSTREAM Stream TEdWindow])
(* ;; "")
(PRINTOUT Stream .FONT '(MODERN 14 BOLD)
"- Free Menu Creator Summary -" T T)
(PRINTOUT Stream .FONT '(MODERN 10 REGULAR)
(DATE)
T T)
(for item in ItemList do (FMC-EDIT.INFO.ITEM item Stream 0))
(TEDIT.PARALOOKS Stream '(QUAD CENTERED)
1 2)
(SETCURSOR DEFAULTCURSOR)
(FMC-PROMPTPRINT "Creating summary ... done" WINDOW)
(SETQ TEdWindow (CREATEW NIL "FMC Items Summary"))
(OPENTEXTSTREAM Stream TEdWindow))])
(FMC-EDIT.INFO.ITEM
[LAMBDA (ITEM STREAM SPACES) (* ; "Edited 8-Aug-88 17:00 by A.BLAVIER")
@@ -3312,42 +3316,52 @@ Copyright (c) 1988 by Rank Xerox France. Author Andre BLAVIER. All rights reser
(CREATEREGION 2 2 70 28)))
(* *)
[OR (SASSOC 'FMCreator BackgroundMenuCommands)
(NCONC1 BackgroundMenuCommands '(FMCreator '(FMC-CREATE)
(NCONC1 BackgroundMenuCommands '(FMCreator '(FMC-CREATE)
"Opens a Free Menu Creator window for use"]
(SETQ BackgroundMenu NIL)
(RPAQ MOVINGCURSOR (CURSORCREATE (QUOTE #*(16 16)@@@@@A@@@CH@@ED@@A@@@A@@BA@HD@@DOLGND@@DBA@H@A@@@A@@@ED@@CH@@A@@
) (QUOTE NIL) 7 7))
(PUTPROPS FM-CREATOR COPYRIGHT ("Rank Xerox France. Author Andre BLAVIER" 1988))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (4362 15980 (FMC-CREATE 4372 . 10712) (FMC-INSTALL.IP.WINDOW 10714 . 13291) (
FMC-INSTALL.GP.WINDOW 13293 . 14616) (FMC-CREATE.SHADE.MENU 14618 . 15281) (FMC-CREATE.SHADE.ITEM
15283 . 15978)) (16015 29619 (FMC-BUTTONEVENTFN 16025 . 23020) (FMC-CLOSEFN 23022 . 23823) (
FMC-COPYBUTTONEVENTFN 23825 . 24785) (FMC-COPYINSERTFN 24787 . 26407) (FMC-CURSORMOVEDFN 26409 . 27296
) (FMC-CURSOROUTFN 27298 . 27459) (FMC-EXPANDFN 27461 . 27741) (FMC-ICONFN 27743 . 28755) (
FMC-SHRINKFN 28757 . 29061) (FMC-WINDOWENTRYFN 29063 . 29617)) (31454 35400 (FMC-FIXRIGHTMENU 31464 .
33117) (FMC-DORIGHTSELECTION 33119 . 35398)) (35433 42932 (FMC-SELECT.ITEM 35443 . 36551) (
FMC-SELECT.LIST 36553 . 36874) (FMC-SELECT.LIST.ITEM 36876 . 37932) (FMC-SELECTALL 37934 . 38328) (
FMC-GET.SELECTION 38330 . 40066) (FMC-DESELECT 40068 . 40446) (FMC-DESELECT.ITEM 40448 . 41526) (
FMC-DESELECT.LIST 41528 . 41897) (FMC-DESELECT.LIST.ITEM 41899 . 42930)) (42972 71259 (FMC-APPLY 42982
. 47323) (FMC-SHOW.ITEM 47325 . 52244) (FMC-SHOW.GROUP 52246 . 54394) (FMC-NEWITEM 54396 . 55927) (
FMC-UPDATE.ITEM 55929 . 61952) (FMC-UPDATE.GROUP 61954 . 63772) (FMC-GET.LABEL 63774 . 64522) (
FMC-CHOOSE.ITEM.BOXSHADE 64524 . 65106) (FMC-CHOOSE.ITEM.BG 65108 . 65695) (FMC-GET.MENUPROPS 65697 .
66591) (FMC-GET.INITSTATE 66593 . 68971) (FMC-EDIT.FN 68973 . 69590) (FMC-LINKS 69592 . 71257)) (81842
84551 (FMC-MAKEBITMAP 81852 . 82544) (FMC-COMPOUND.BITMAP 82546 . 84005) (FMC-SNAPBM 84007 . 84549))
(84577 95636 (FMC-MOVE.SELECTION 84587 . 88458) (FMC-MOVE.BITMAP 88460 . 92852) (FMC-TRACK.NEW.ITEM
92854 . 93904) (FMC-UPDATE.BM.POSITION 93906 . 94629) (FMC-UPDATE.REGION 94631 . 95634)) (95663 108537
(FMC-COMPUTE.SHAPE.REGS 95673 . 97851) (FMC-SHAPE 97853 . 106662) (FMC-BOX.NEWREGIONFN 106664 .
108106) (FMC-NOBOX.NEWREGIONFN 108108 . 108535)) (108566 110451 (FMC-REDRAW 108576 . 109224) (
FMC-REDRAW.ITEM 109226 . 110449)) (110494 113925 (FMC-DELETE 110504 . 111854) (FMC-UNDELETE 111856 .
113923)) (113962 117670 (FMC-GROUP 113972 . 116637) (FMC-UNGROUP 116639 . 117668)) (117710 127034 (
FMC-ALIGN 117720 . 121191) (FMC-HCENTER 121193 . 123497) (FMC-VCENTER 123499 . 125877) (FMC-REL.MOVE
125879 . 127032)) (127071 136665 (FMC-GET 127081 . 129946) (FMC-GET.ONE.OBJECT 129948 . 132185) (
FMC-PUT 132187 . 134238) (FMC-PUT.OBJECT 134240 . 136663)) (136697 141636 (FMC-EDIT.INFO 136707 .
137943) (FMC-EDIT.INFO.ITEM 137945 . 141634)) (141668 147722 (FMC-HARDCOPY 141678 . 144920) (
FMC-HARDCOPY.ITEM 144922 . 147720)) (147764 155916 (FMC-COMPUTE 147774 . 149790) (FMC-COMPUTE.OBJECT
149792 . 155914)) (155943 169254 (FMC-CREATE.ITEM.FROM.LIST 155953 . 157160) (FMC-DRAW.BOX 157162 .
158498) (FMC-CHOOSE.WINDOW.BG 158500 . 159017) (FMC-DISPLAY.GRID 159019 . 159523) (FMC-SET.GRIDSIZE
159525 . 160305) (FMC-FONT->LIST 160307 . 161008) (FMC-LIST->FONT 161010 . 161357) (FMC-SORT.ITEM.LIST
161359 . 162401) (FMC-IMPORT 162403 . 168871) (FMC-PROMPTPRINT 168873 . 169252)))))
(FILEMAP (NIL (4478 16096 (FMC-CREATE 4488 . 10828) (FMC-INSTALL.IP.WINDOW 10830 . 13407) (
FMC-INSTALL.GP.WINDOW 13409 . 14732) (FMC-CREATE.SHADE.MENU 14734 . 15397) (FMC-CREATE.SHADE.ITEM
15399 . 16094)) (16131 29735 (FMC-BUTTONEVENTFN 16141 . 23136) (FMC-CLOSEFN 23138 . 23939) (
FMC-COPYBUTTONEVENTFN 23941 . 24901) (FMC-COPYINSERTFN 24903 . 26523) (FMC-CURSORMOVEDFN 26525 . 27412
) (FMC-CURSOROUTFN 27414 . 27575) (FMC-EXPANDFN 27577 . 27857) (FMC-ICONFN 27859 . 28871) (
FMC-SHRINKFN 28873 . 29177) (FMC-WINDOWENTRYFN 29179 . 29733)) (29760 29895 (FM-GET.ITEM.LABEL 29760
. 29895)) (29897 30032 (FM-GET.ITEM.STATE 29897 . 30032)) (30034 30136 (FMC-CLEAR.REGION 30034 .
30136)) (30138 30232 (FMC-GET.ITEM 30138 . 30232)) (30234 30332 (FMC-GROUP? 30234 . 30332)) (30334
30412 (FMC-MARK.AS.CHANGED 30334 . 30412)) (30414 30528 (FMC-PUT.ITEM 30414 . 30528)) (30530 30625 (
GET.REGION.BOTTOM 30530 . 30625)) (30627 30722 (GET.REGION.HEIGHT 30627 . 30722)) (30724 30815 (
GET.REGION.LEFT 30724 . 30815)) (30817 30910 (GET.REGION.WIDTH 30817 . 30910)) (30912 30967 (NULLSTR
30912 . 30967)) (30969 31084 (PUT.REGION.BOTTOM 30969 . 31084)) (31086 31201 (PUT.REGION.HEIGHT 31086
. 31201)) (31203 31314 (PUT.REGION.LEFT 31203 . 31314)) (31316 31429 (PUT.REGION.WIDTH 31316 . 31429)
) (31463 35409 (FMC-FIXRIGHTMENU 31473 . 33126) (FMC-DORIGHTSELECTION 33128 . 35407)) (35442 42941 (
FMC-SELECT.ITEM 35452 . 36560) (FMC-SELECT.LIST 36562 . 36883) (FMC-SELECT.LIST.ITEM 36885 . 37941) (
FMC-SELECTALL 37943 . 38337) (FMC-GET.SELECTION 38339 . 40075) (FMC-DESELECT 40077 . 40455) (
FMC-DESELECT.ITEM 40457 . 41535) (FMC-DESELECT.LIST 41537 . 41906) (FMC-DESELECT.LIST.ITEM 41908 .
42939)) (42981 71268 (FMC-APPLY 42991 . 47332) (FMC-SHOW.ITEM 47334 . 52253) (FMC-SHOW.GROUP 52255 .
54403) (FMC-NEWITEM 54405 . 55936) (FMC-UPDATE.ITEM 55938 . 61961) (FMC-UPDATE.GROUP 61963 . 63781) (
FMC-GET.LABEL 63783 . 64531) (FMC-CHOOSE.ITEM.BOXSHADE 64533 . 65115) (FMC-CHOOSE.ITEM.BG 65117 .
65704) (FMC-GET.MENUPROPS 65706 . 66600) (FMC-GET.INITSTATE 66602 . 68980) (FMC-EDIT.FN 68982 . 69599)
(FMC-LINKS 69601 . 71266)) (79657 82366 (FMC-MAKEBITMAP 79667 . 80359) (FMC-COMPOUND.BITMAP 80361 .
81820) (FMC-SNAPBM 81822 . 82364)) (82392 93451 (FMC-MOVE.SELECTION 82402 . 86273) (FMC-MOVE.BITMAP
86275 . 90667) (FMC-TRACK.NEW.ITEM 90669 . 91719) (FMC-UPDATE.BM.POSITION 91721 . 92444) (
FMC-UPDATE.REGION 92446 . 93449)) (93478 106352 (FMC-COMPUTE.SHAPE.REGS 93488 . 95666) (FMC-SHAPE
95668 . 104477) (FMC-BOX.NEWREGIONFN 104479 . 105921) (FMC-NOBOX.NEWREGIONFN 105923 . 106350)) (106381
108266 (FMC-REDRAW 106391 . 107039) (FMC-REDRAW.ITEM 107041 . 108264)) (108309 111740 (FMC-DELETE
108319 . 109669) (FMC-UNDELETE 109671 . 111738)) (111777 115485 (FMC-GROUP 111787 . 114452) (
FMC-UNGROUP 114454 . 115483)) (115525 124849 (FMC-ALIGN 115535 . 119006) (FMC-HCENTER 119008 . 121312)
(FMC-VCENTER 121314 . 123692) (FMC-REL.MOVE 123694 . 124847)) (124886 134480 (FMC-GET 124896 . 127761
) (FMC-GET.ONE.OBJECT 127763 . 130000) (FMC-PUT 130002 . 132053) (FMC-PUT.OBJECT 132055 . 134478)) (
134512 139571 (FMC-EDIT.INFO 134522 . 135878) (FMC-EDIT.INFO.ITEM 135880 . 139569)) (139603 145657 (
FMC-HARDCOPY 139613 . 142855) (FMC-HARDCOPY.ITEM 142857 . 145655)) (145699 153851 (FMC-COMPUTE 145709
. 147725) (FMC-COMPUTE.OBJECT 147727 . 153849)) (153878 167189 (FMC-CREATE.ITEM.FROM.LIST 153888 .
155095) (FMC-DRAW.BOX 155097 . 156433) (FMC-CHOOSE.WINDOW.BG 156435 . 156952) (FMC-DISPLAY.GRID 156954
. 157458) (FMC-SET.GRIDSIZE 157460 . 158240) (FMC-FONT->LIST 158242 . 158943) (FMC-LIST->FONT 158945
. 159292) (FMC-SORT.ITEM.LIST 159294 . 160336) (FMC-IMPORT 160338 . 166806) (FMC-PROMPTPRINT 166808
. 167187)))))
STOP

BIN
lispusers/FM-CREATOR.LCOM
View File

Binary file not shown.

66
lispusers/HELPSYS
View File

@@ -1,19 +1,21 @@
(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")
(FILECREATED "27-Nov-2020 09:47:44" {DSK}<home>larry>ilisp>medley>lispusers>HELPSYS.;4 28861
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
changes to%: (FNS IRM.LOOKUP)
(FILECREATED " 3-Feb-2022 12:04:29" {DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>HELPSYS.;2 28963
previous date%: "27-Nov-2020 08:54:23" {DSK}<home>larry>ilisp>medley>lispusers>HELPSYS.;2)
:CHANGES-TO (VARS HELPSYSCOMS)
:PREVIOUS-DATE "27-Nov-2020 09:47:44"
{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>HELPSYS.;1)
(* ; "
Copyright (c) 1985, 1986, 1987, 2020 by Xerox Corporation. All rights reserved.
Copyright (c) 1985-1987, 2020 by Xerox Corporation.
")
(PRETTYCOMPRINT HELPSYSCOMS)
(RPAQQ HELPSYSCOMS
[(FILES DINFO HASH)
((FILES DINFO HASH)
(RECORDS IRMREFERENCE)
(DECLARE%: EVAL@COMPILE DONTCOPY (FILES (LOADCOMP)
DINFO HASH))
@@ -58,23 +60,25 @@ Copyright (c) 1985, 1986, 1987, 2020 by Xerox Corporation. All rights reserved.
(\IRM.KEYWORDS))
(GLOBALVARS \IRM.HASHFILE \IRM.KEYWORDS)
(FUNCTIONS \IRM.AROUND-EXIT)
(ADDVARS (AROUNDEXITFNS \IRM.AROUND-EXIT])
(ADDVARS (AROUNDEXITFNS \IRM.AROUND-EXIT))
(PROP (FILETYPE)
HELPSYS))))
(FILESLOAD DINFO HASH)
(DECLARE%: EVAL@COMPILE
(RECORD IRMREFERENCE
(* ;; "A reference to something in the IRM. There is a list of these for each entry in the index of the IRM. Each element of the list corresponds to one of the page references. These lists are stored under the ITEM in a hash file. ")
(* ;; "A reference to something in the IRM. There is a list of these for each entry in the index of the IRM. Each element of the list corresponds to one of the page references. These lists are stored under the ITEM in a hash file. ")
(TYPE (* ; "The type of index entry -- typically a capitalized symbol in IL, eg. il:|Functions|. Yes, it's ugly.")
ITEM (* ; "The name indexed")
PRIMARYFLG (* ;
 "True iff this is the primary reference for this name/type")
NODE (* ;
 "The ID of the node in the IRM DInfo graph containing this reference")
CH# (* ; "The character number of the beginning of the reference. If unspecified we search for the first existence of NAME in the text of the node.")
)
(SYSTEM))
(TYPE (* ; "The type of index entry -- typically a capitalized symbol in IL, eg. il:|Functions|. Yes, it's ugly.")
ITEM (* ; "The name indexed")
PRIMARYFLG (* ;
 "True iff this is the primary reference for this name/type")
NODE (* ;
 "The ID of the node in the IRM DInfo graph containing this reference")
CH# (* ; "The character number of the beginning of the reference. If unspecified we search for the first existence of NAME in the text of the node.")
)
(SYSTEM))
)
(DECLARE%: EVAL@COMPILE DONTCOPY
@@ -352,11 +356,11 @@ Copyright (c) 1985, 1986, 1987, 2020 by Xerox Corporation. All rights reserved.
(RPAQ? IRM.CREF.FONT (FONTCREATE 'MODERN 8 'MRR))
(RPAQ? \IRM.CREF.IMAGEFNS (IMAGEFNSCREATE (FUNCTION IRM.DISPLAY.CREF)
(FUNCTION IRM.CREF.BOX)
(FUNCTION IRM.PUT.CREF)
(FUNCTION IRM.GET.CREF)
(FUNCTION NILL)
(FUNCTION IRM.CREF.BUTTONEVENTFN)))
(FUNCTION IRM.CREF.BOX)
(FUNCTION IRM.PUT.CREF)
(FUNCTION IRM.GET.CREF)
(FUNCTION NILL)
(FUNCTION IRM.CREF.BUTTONEVENTFN)))
(DECLARE%: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS IRM.CREF.FONT \IRM.CREF.IMAGEFNS)
@@ -578,14 +582,16 @@ Copyright (c) 1985, 1986, 1987, 2020 by Xerox Corporation. All rights reserved.
((BEFORELOGOUT BEFOREMAKESYS BEFORESYSOUT) (AND \IRM.HASHFILE (CLOSEHASHFILE \IRM.HASHFILE)))))
(ADDTOVAR AROUNDEXITFNS \IRM.AROUND-EXIT)
(PUTPROPS HELPSYS FILETYPE :FAKE-COMPILE-FILE)
(PUTPROPS HELPSYS COPYRIGHT ("Xerox Corporation" 1985 1986 1987 2020))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (4149 8000 (HELPSYS 4159 . 5963) (IRM.LOOKUP 5965 . 7421) (IRM.SMART.LOOKUP 7423 . 7579)
(IRM.RESET 7581 . 7998)) (8247 9766 (IRM.GET.DINFOGRAPH 8257 . 9128) (IRM.DISPLAY.REF 9130 . 9764)) (
9768 10130 (IRM.LOAD-GRAPH 9768 . 10130)) (10455 16304 (IRM.DISPLAY.CREF 10465 . 12208) (IRM.CREF.BOX
12210 . 13037) (IRM.PUT.CREF 13039 . 13264) (IRM.GET.CREF 13266 . 13637) (IRM.CREF.BUTTONEVENTFN 13639
. 16302)) (16879 28427 (\IRM.GET.REF 16889 . 19643) (\IRM.SMART.REF 19645 . 21766) (\IRM.CHOOSE.REF
21768 . 23114) (\IRM.WILD.REF 23116 . 25858) (\IRM.WILDCARD 25860 . 26238) (\IRM.WILD.MATCH 26240 .
27478) (\IRM.GET.HASHFILE 27480 . 27943) (\IRM.GET.KEYWORDS 27945 . 28425)) (28564 28720 (
\IRM.AROUND-EXIT 28564 . 28720)))))
(FILEMAP (NIL (4215 8066 (HELPSYS 4225 . 6029) (IRM.LOOKUP 6031 . 7487) (IRM.SMART.LOOKUP 7489 . 7645)
(IRM.RESET 7647 . 8064)) (8313 9832 (IRM.GET.DINFOGRAPH 8323 . 9194) (IRM.DISPLAY.REF 9196 . 9830)) (
9834 10196 (IRM.LOAD-GRAPH 9834 . 10196)) (10521 16370 (IRM.DISPLAY.CREF 10531 . 12274) (IRM.CREF.BOX
12276 . 13103) (IRM.PUT.CREF 13105 . 13330) (IRM.GET.CREF 13332 . 13703) (IRM.CREF.BUTTONEVENTFN 13705
. 16368)) (16925 28473 (\IRM.GET.REF 16935 . 19689) (\IRM.SMART.REF 19691 . 21812) (\IRM.CHOOSE.REF
21814 . 23160) (\IRM.WILD.REF 23162 . 25904) (\IRM.WILDCARD 25906 . 26284) (\IRM.WILD.MATCH 26286 .
27524) (\IRM.GET.HASHFILE 27526 . 27989) (\IRM.GET.KEYWORDS 27991 . 28471)) (28610 28766 (
\IRM.AROUND-EXIT 28610 . 28766)))))
STOP

BIN
lispusers/HELPSYS.LCOM
View File

Binary file not shown.

588
lispusers/INDEX
View File

@@ -1,588 +0,0 @@
(FILECREATED "18-Feb-87 15:44:37" {SUMEX-AIM}PS:<TMAX.SOURCES>INDEX.;4 23471
changes to: (FNS INSERT.KNOWN.INDEX)
previous date: "17-Feb-87 14:27:45" {SUMEX-AIM}PS:<GILMURRAY.LISP>INDEX.;5)
(* Copyright (c) 1987 by Leland Stanford Junior University. All rights reserved.)
(PRETTYCOMPRINT INDEXCOMS)
(RPAQQ INDEXCOMS ((* Developed under support from NIH grant RR-00785.)
(* Written by Frank Gilmurray and Sami Shaio.)
(FNS INDEXOBJ INDEXOBJP INDEX.DISPLAYFN INDEX.IMAGEBOXFN INDEX.PUTFN INDEX.GETFN
INDEX.BUTTONEVENTINFN CHANGE.INDEX CHANGE.INDEXENTRY INDEX.WHENDELETEDFN)
(FNS ADD.NEW.INDEX INDEX.STRING INSERT.INDEX INSERT.INDEXENTRY
GET.INDEXENTRY.NUMBER INSERT.KNOWN.INDEX INDEX.LIST.REFS
LIST.OF.INDEXENTRIES CREATE.INDEX.FILE VIEW.INDEX.FILE GET.INDEX.FILE
WRITE.INDEX.FILE WRITE.INDEX.PAGENUMBERS)
(RECORDS INDEX.ENTRY.RECORD)))
(* Developed under support from NIH grant RR-00785.)
(* Written by Frank Gilmurray and Sami Shaio.)
(DEFINEQ
(INDEXOBJ
(LAMBDA (KEY INDEXENTRY.PARMS) (* fsg "15-Jan-87 09:53")
(* * Create an instance of an Index or IndexEntry imageobject. The difference between the two is the OBJECTDATUM.
For a simple Index, OBJECTDATUM is NIL. For an IndexEntry, OBJECTDATUM is a record containing the Entry, Entry's 
font, and Number option. In either case, the INDEX.KEY property is the hash key and is also the text to index for a
simple Index.)
(LET ((NEWOBJ (IMAGEOBJCREATE INDEXENTRY.PARMS (IMAGEFNSCREATE (FUNCTION INDEX.DISPLAYFN)
(FUNCTION INDEX.IMAGEBOXFN)
(FUNCTION INDEX.PUTFN)
(FUNCTION INDEX.GETFN)
(FUNCTION NILL)
(FUNCTION
INDEX.BUTTONEVENTINFN)
(FUNCTION NILL)
(FUNCTION NILL)
(FUNCTION NILL)
(FUNCTION
INDEX.WHENDELETEDFN)
(FUNCTION NILL)
(FUNCTION NILL)
(FUNCTION NILL)))))
(IMAGEOBJPROP NEWOBJ 'INDEX.KEY
KEY)
(IMAGEOBJPROP NEWOBJ 'TYPE
'INDEXOBJ)
NEWOBJ)))
(INDEXOBJP
(LAMBDA (OBJ) (* fsg "15-Jan-87 09:55")
(* * Tests an imageobject to see if it an Index or IndexEntry imageobject. By convention, testing functions for an 
imageobject are named <CONCAT type-of-imageobj "P" >.)
(AND OBJ (EQ (IMAGEOBJPROP OBJ 'TYPE)
'INDEXOBJ))))
(INDEX.DISPLAYFN
(LAMBDA (OBJ STREAM) (* fsg "17-Feb-87 10:18")
(* * Display an Index or IndexEntry imageobject. If the output is to the display imagestream, then just type Index 
or IndexEntry followed by their args. Otherwise the output is to a hardcopy imagestream. In this case type nothing 
and replace the CAR of the hash array entry with a list of page numbers in which this index entry appears.
<CAR FORMATTINGSTATE> is the current TEdit page number iff doing a hardcopy.)
(LET ((WINDOW (CAR (fetch \WINDOW of TEXTOBJ)))
PGS/IMOBJS CURRENT.PAGE)
(SELECTQ (IMAGESTREAMTYPE STREAM)
(DISPLAY (PROGN (DSPFONT GP.DefaultFont STREAM)
(PRIN3 (INDEX.STRING OBJ)
STREAM)))
(PROGN (SETQ PGS/IMOBJS (GETHASH (MKATOM (IMAGEOBJPROP OBJ
'INDEX.KEY))
(WINDOWPROP WINDOW
'TSP.INDEX.ARRAY)))
(SETQ CURRENT.PAGE (CAR FORMATTINGSTATE))
(COND
(PGS/IMOBJS (COND
((LISTP (CAR PGS/IMOBJS))
(OR (MEMBER CURRENT.PAGE (CAR PGS/IMOBJS))
(RPLACA PGS/IMOBJS
(SORT (APPEND (CAR PGS/IMOBJS)
(LIST CURRENT.PAGE)
)
'ILESSP))))
(T (RPLACA PGS/IMOBJS (LIST CURRENT.PAGE)))))
(T (SHOULDNT "No array entry for this INDEX"))))))))
(INDEX.IMAGEBOXFN
(LAMBDA (OBJ STREAM CURRENTX RIGHTMARGIN) (* fsg "15-Feb-87 14:37")
(* * Return the ImageBox for an Index or IndexEntry request.)
(SELECTQ (IMAGESTREAMTYPE STREAM)
(DISPLAY (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) (* fsg "11-Feb-87 11:07")
(* * Puts the Index or IndexEntry imageobject in a file.)
(LET ((DATUM (fetch OBJECTDATUM of OBJ)))
(PRIN2 (COND
(DATUM (LIST 'IndexEntry
(IMAGEOBJPROP OBJ 'INDEX.KEY)
DATUM))
(T (LIST 'Index
(IMAGEOBJPROP OBJ 'INDEX.KEY))))
STREAM))))
(INDEX.GETFN
(LAMBDA (STREAM) (* fsg "11-Feb-87 10:42")
(* * Create the Index or IndexEntry imageobject when it is read from file.)
(LET* ((INDEX.ARGS (CDR (READ STREAM)))
(NEWOBJ (APPLY 'INDEXOBJ
INDEX.ARGS))
(WINDOW (PROCESSPROP (THIS.PROCESS)
'WINDOW)))
(OR (WINDOWPROP WINDOW 'IMAGEOBJ.MENUW)
(TSP.FMMENU (TEXTSTREAM WINDOW)))
(ADD.NEW.INDEX WINDOW (CAR INDEX.ARGS)
NEWOBJ)
NEWOBJ)))
(INDEX.BUTTONEVENTINFN
(LAMBDA (OBJ STREAM SEL RELX RELY WINDOW HOSTSTREAM BUTTON)
(* fsg "15-Jan-87 11:26")
(* * Process the MIDDLE button pressed inside an Index or IndexEntry imageobject. This means the user wants to 
Change this index.)
(AND (MOUSESTATE MIDDLE)
(MENU (create MENU
ITEMS _ '((Change 'CHANGE
"Change this Index or IndexEntry"))
CENTERFLG _ T))
(LET* ((OBJDATUM (fetch OBJECTDATUM of OBJ))
(NEW.INDEX (COND
(OBJDATUM (CHANGE.INDEXENTRY OBJ STREAM OBJDATUM))
(T (CHANGE.INDEX OBJ STREAM)))))
(AND (CAR NEW.INDEX)
(PROGN (INDEX.WHENDELETEDFN OBJ STREAM)
(IMAGEOBJPROP OBJ 'INDEX.KEY
(CAR NEW.INDEX))
(AND OBJDATUM (replace OBJECTDATUM of OBJ
with (CADR NEW.INDEX)))
(ADD.NEW.INDEX WINDOW (CAR NEW.INDEX)
OBJ)
'CHANGED))))))
(CHANGE.INDEX
(LAMBDA (OBJ STREAM) (* fsg "15-Jan-87 10:54")
(* * Here when CHANGE buttoned inside an Index ImageObject.)
(LIST (MKATOM (TEDIT.GETINPUT STREAM (CONCAT "Change Index name %""
(IMAGEOBJPROP OBJ 'INDEX.KEY)
"%" to: "))))))
(CHANGE.INDEXENTRY
(LAMBDA (OBJ STREAM OBJDATUM) (* fsg "15-Jan-87 11:17")
(* * Here when CHANGE buttoned inside an IndexEntry ImageObject.)
(LET ((WINDOW (\TEDIT.MAINW STREAM))
NEWINDEX.KEY NEWINDEX.ENTRY NEWINDEX.FONT NEWINDEX.NUMBER)
(COND
((SETQ NEWINDEX.KEY (MKATOM (TEDIT.GETINPUT STREAM (CONCAT
"Change IndexEntry Key %""
(IMAGEOBJPROP
OBJ
'INDEX.KEY)
"%" to: "))))
(SETQ NEWINDEX.ENTRY (OR (MKATOM (TEDIT.GETINPUT STREAM
(CONCAT
"Change IndexEntry Entry %""
(fetch INDEX.ENTRY
of OBJDATUM)
"%" to: ")))
(fetch INDEX.ENTRY of OBJDATUM)))
(TEDIT.PROMPTPRINT STREAM (CONCAT "Change IndexEntry Entry font %""
(ABBREVIATE.FONT (fetch INDEX.ENTRYFONT
of OBJDATUM))
"%" to...")
T)
(until (SETQ NEWINDEX.FONT (GET.TSP.FONT WINDOW (OR (fetch INDEX.ENTRYFONT
of OBJDATUM)
GP.DefaultFont)))
do (TEDIT.PROMPTPRINT STREAM "Invalid font specification...try again." T))
(TEDIT.PROMPTPRINT STREAM (CONCAT "Change IndexEntry Number option %""
(fetch INDEX.NUMBER of OBJDATUM)
"%" to...")
T)
(SETQ NEWINDEX.NUMBER (GET.INDEXENTRY.NUMBER WINDOW (fetch INDEX.NUMBER
of OBJDATUM)))
(TEDIT.PROMPTPRINT STREAM "" T)
(LIST NEWINDEX.KEY (create INDEX.ENTRY.RECORD
INDEX.ENTRY _ NEWINDEX.ENTRY
INDEX.ENTRYFONT _ NEWINDEX.FONT
INDEX.NUMBER _ NEWINDEX.NUMBER)))
(T (LIST NEWINDEX.KEY))))))
(INDEX.WHENDELETEDFN
(LAMBDA (OBJ WINDOW) (* fsg "15-Jan-87 11:30")
(* * Delete the selected Index or IndexEntry imageobject.)
(LET* ((INDEXKEY (IMAGEOBJPROP OBJ 'INDEX.KEY))
(INDEX.ARRAY (WINDOWPROP WINDOW 'TSP.INDEX.ARRAY))
(HASH.VALUE (GETHASH INDEXKEY INDEX.ARRAY)))
(COND
((DREMOVE OBJ (COND
((fetch OBJECTDATUM of OBJ)
(CADDR HASH.VALUE))
(T (CADR HASH.VALUE))))
NIL)
(T (DSUBST NIL (LIST OBJ)
HASH.VALUE)
(PUTHASH INDEXKEY (COND
((OR (CADR HASH.VALUE)
(CADDR HASH.VALUE))
HASH.VALUE)
(T NIL))
INDEX.ARRAY)))
NIL)))
)
(DEFINEQ
(ADD.NEW.INDEX
(LAMBDA (WINDOW INDEXKEY OBJ) (* fsg "28-Jan-87 11:37")
(* * Add an Index or IndexEntry 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 IndexEntry imageobjects.)
(LET* ((CODE.ARRAY (WINDOWPROP WINDOW 'TSP.INDEX.ARRAY))
(HASH.VALUE (GETHASH INDEXKEY CODE.ARRAY))
(INDEX.OBJS (CADR HASH.VALUE))
(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 '"[Pages (?)]"
INDEX.OBJS ENTRY.OBJS)
CODE.ARRAY))))
(INDEX.STRING
(LAMBDA (OBJ) (* fsg "15-Feb-87 14:40")
(* * Returns the display imagestream text for an Index or IndexEntry ImageObject.)
(LET ((OBJDATUM (fetch OBJECTDATUM of OBJ))
INDEXNUMBER)
(COND
(OBJDATUM (CONCAT "[Index Key=" (MKATOM (IMAGEOBJPROP OBJ 'INDEX.KEY))
",Entry="
(fetch INDEX.ENTRY of OBJDATUM)
(COND
((EQ (SETQ INDEXNUMBER (fetch INDEX.NUMBER of OBJDATUM))
'YES)
",Number]")
((NUMBERP INDEXNUMBER)
(CONCAT ",Number=" INDEXNUMBER "]"))
(T "]"))))
(T (CONCAT "[Index " (MKATOM (IMAGEOBJPROP OBJ 'INDEX.KEY))
"]"))))))
(INSERT.INDEX
(LAMBDA (STREAM WINDOW) (* fsg "15-Jan-87 11:37")
(* * Process the "Index" function in the ImageObjects menu.)
(LET ((NEWINDEX.KEY (MKATOM (TEDIT.GETINPUT STREAM "Index Key: "))))
(TEDIT.PROMPTPRINT STREAM "" T)
(AND NEWINDEX.KEY (LET ((NEW.INDEX.OBJ (INDEXOBJ NEWINDEX.KEY)))
(ADD.NEW.INDEX WINDOW NEWINDEX.KEY NEW.INDEX.OBJ)
(TEDIT.INSERT.OBJECT NEW.INDEX.OBJ STREAM))))))
(INSERT.INDEXENTRY
(LAMBDA (STREAM WINDOW) (* fsg "15-Jan-87 11:39")
(* * Process the "IndexEntry" function in the ImageObjects menu.)
(LET ((NEWINDEX.KEY (MKATOM (TEDIT.GETINPUT STREAM "IndexEntry Key: ")))
NEWINDEX.ENTRY NEWINDEX.FONT NEWINDEX.NUMBER)
(COND
(NEWINDEX.KEY (SETQ NEWINDEX.ENTRY (OR (MKATOM (TEDIT.GETINPUT STREAM
"IndexEntry Entry: "
(MKSTRING
NEWINDEX.KEY)))
NEWINDEX.KEY))
(TEDIT.PROMPTPRINT STREAM "IndexEntry Entry font..." T)
(until (SETQ NEWINDEX.FONT (GET.TSP.FONT WINDOW GP.DefaultFont))
do (TEDIT.PROMPTPRINT STREAM
"Invalid font specification...try again."
T))
(TEDIT.PROMPTPRINT STREAM "IndexEntry Number option..." T)
(SETQ NEWINDEX.NUMBER (GET.INDEXENTRY.NUMBER WINDOW))
(TEDIT.PROMPTPRINT STREAM "" T)
(LET ((NEW.INDEX.OBJ (INDEXOBJ NEWINDEX.KEY
(create INDEX.ENTRY.RECORD
INDEX.ENTRY _ NEWINDEX.ENTRY
INDEX.ENTRYFONT _ NEWINDEX.FONT
INDEX.NUMBER _ NEWINDEX.NUMBER))))
(ADD.NEW.INDEX WINDOW NEWINDEX.KEY NEW.INDEX.OBJ)
(TEDIT.INSERT.OBJECT NEW.INDEX.OBJ STREAM)))
(T (TEDIT.PROMPTPRINT STREAM "" T))))))
(GET.INDEXENTRY.NUMBER
(LAMBDA (WINDOW DEFAULTNUMBER) (* fsg "15-Jan-87 11:43")
(* * 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)))
(INSERT.KNOWN.INDEX
(LAMBDA (STREAM WINDOW) (* fsg "18-Feb-87 14:48")
(* * Process the "Known Indices" function in the ImageObjects menu. A menu of all the known Indices and 
IndexEntries pops up and the user may button one of these to insert the corrsponding Index or IndexEntry.
Any buttoning outside of this menu will make it disappear.)
(LET* ((PREVINDICES (INDEX.LIST.REFS WINDOW))
(NEWINDEX.KEY (COND
(PREVINDICES (LET ((NMENU (create MENU
TITLE _ "Index Keys"
ITEMS _ PREVINDICES))
MENU.SELECTION)
(SETQ MENU.SELECTION (MENU NMENU))
(AND MENU.SELECTION (OR (LISTP MENU.SELECTION)
(LIST MENU.SELECTION)))))
(T (TEDIT.PROMPTPRINT STREAM
"There are no Indicies/IndexEntries in this document."
T)
NIL))))
(AND NEWINDEX.KEY (LET ((NEWINDEX.OBJ (APPLY 'INDEXOBJ
NEWINDEX.KEY)))
(ADD.NEW.INDEX WINDOW (CAR NEWINDEX.KEY)
NEWINDEX.OBJ)
(TEDIT.INSERT.OBJECT NEWINDEX.OBJ STREAM)
(TEDIT.PROMPTPRINT STREAM "" T))))))
(INDEX.LIST.REFS
(LAMBDA (WINDOW) (* fsg "15-Jan-87 11:46")
(* * Return a sorted list of the Index and IndexEntry keys. Simple Index keys are just added to the list.
For an IndexEntry key, there are SUBITEMS for each IndexEntry 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 (WINDOWPROP WINDOW '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 IndexEntry subitem."
(CONS 'SUBITEMS
(LIST.OF.INDEXENTRIES
KEY
(CADDR INDEX.VALUE))))))))
(CDR INDEX.ITEMS))))
(LIST.OF.INDEXENTRIES
(LAMBDA (KEY OBJLIST) (* fsg "15-Jan-87 11:48")
(* * Returns a list of the IndexEntries sorted by Entry)
(LET ((ENTRY.LIST (CONS))
OBJDATUM)
(for OBJ in OBJLIST
do (SETQ OBJDATUM (fetch OBJECTDATUM of OBJ))
(NCONC ENTRY.LIST (LIST (LIST (CONCAT (fetch INDEX.ENTRY of OBJDATUM)
", "
(ABBREVIATE.FONT (fetch
INDEX.ENTRYFONT
of OBJDATUM))
", "
(fetch INDEX.NUMBER of OBJDATUM))
(KWOTE (LIST KEY OBJDATUM))))))
(SORT (INTERSECTION (CDR ENTRY.LIST)
(CDR ENTRY.LIST))
(FUNCTION (LAMBDA (A B)
(UALPHORDER (CAADR (CADADR A))
(CAADR (CADADR B)))))))))
(CREATE.INDEX.FILE
(LAMBDA (STREAM WINDOW) (* fsg "15-Dec-86 13:22")
(* * Writes the indices and their corresponding page numbers or strings to the index file. The indices are sorted 
alphabetically regardless of case.)
(LET* ((INDEX.ARRAY (WINDOWPROP WINDOW 'TSP.INDEX.ARRAY))
(INDEX.LIST (INDEX.LIST.REFS WINDOW))
(INDEX.FILE (GET.INDEX.FILE (WINDOWPROP WINDOW 'IMAGEOBJ.MENUW)))
(INDEX.STREAM (AND INDEX.FILE (OPENTEXTSTREAM))))
(COND
((AND INDEX.LIST INDEX.FILE)
(TEDIT.PROMPTPRINT STREAM (CONCAT "Putting indices in: " INDEX.FILE "...")
T)
(WRITE.INDEX.FILE INDEX.STREAM INDEX.LIST INDEX.ARRAY)
(TEDIT.PROMPTPRINT STREAM "done")
(TEDIT.PUT INDEX.STREAM INDEX.FILE)
INDEX.FILE)
(INDEX.LIST (TEDIT.PROMPTPRINT STREAM "Specify a file name for the indices first." T)
NIL)
(T (TEDIT.PROMPTPRINT STREAM "There are no indices in this document." T)
NIL)))))
(VIEW.INDEX.FILE
(LAMBDA (STREAM WINDOW) (* fsg "15-Dec-86 15:22")
(* * Writes out the index file via CREATE.INDEX.FILE and then opens another TEdit window where this new file is 
displayed.)
(LET ((INDEX.FILE (CREATE.INDEX.FILE STREAM WINDOW))
(INDEX.FILEW (WINDOWPROP WINDOW 'INDEX.WINDOW)))
(AND INDEX.FILE (COND
((WINDOWP INDEX.FILEW)
(COND
((OPENWP INDEX.FILEW)
(TEDIT.GET (TEXTOBJ INDEX.FILEW)
INDEX.FILE))
((OPENW INDEX.FILEW)
(TEDIT INDEX.FILE INDEX.FILEW))))
(T (WINDOWPROP WINDOW 'INDEX.WINDOW
(SETQ INDEX.FILEW (CREATEW NIL (CONCAT
"Viewing index file: "
INDEX.FILE))))
(TEDIT INDEX.FILE INDEX.FILEW)))))))
(GET.INDEX.FILE
(LAMBDA (MENUW) (* fsg "19-Aug-86 09:09")
(* * Return the user specified index file name.)
(LET* ((ITEM (FM.ITEMFROMID MENUW 'INDEX.FILE))
(FILENAME (FM.ITEMPROP ITEM 'LABEL)))
(COND
((NOT (STREQUAL FILENAME ""))
(MKATOM FILENAME))))))
(WRITE.INDEX.FILE
(LAMBDA (INDEX.STREAM INDEX.LIST INDEX.ARRAY) (* fsg "28-Jan-87 13:31")
(* * Do the output to the index file. For each Index, the Key is printed followed by the list of page numbers in 
which this Index Key appears. Each IndexEntry is printed on a separate line and the page number depends on the 
IndexEntry Number option. After all indices/indexentries are printed, the array page number list is converted back 
to a string. This insures that the next DISPLAYFN call will reconvert the string back to a page number list.)
(DSPFONT (FONTCREATE '(HELVETICA 14 BRR))
INDEX.STREAM)
(PRINTOUT INDEX.STREAM "Index" T T)
(for INDEX.ITEM in INDEX.LIST
do (COND
((LISTP INDEX.ITEM)
(LET ((PGS.AND.IMOBJS (GETHASH (CAR INDEX.ITEM)
INDEX.ARRAY)))
(for INDEX.SUBITEM in (CDR (CADDDR INDEX.ITEM))
do (for (INDEX.ENTRYARGS INDEX.FONT) in (CDR (CADADR INDEX.SUBITEM))
do (DSPFONT (SETQ INDEX.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))
(DSPFONT INDEX.FONT INDEX.STREAM)
(PRINTOUT INDEX.STREAM T)))))
(T (DSPFONT GP.DefaultFont INDEX.STREAM)
(LET ((PGS.AND.IMOBJS (GETHASH INDEX.ITEM INDEX.ARRAY)))
(COND
((CAR PGS.AND.IMOBJS)
(PRINTOUT INDEX.STREAM (MKSTRING INDEX.ITEM))
(WRITE.INDEX.PAGENUMBERS INDEX.STREAM PGS.AND.IMOBJS NIL)
(PRINTOUT INDEX.STREAM T))
(T NIL))))))
(for (INDEX.ITEM PAGES/IMOBJS) in INDEX.LIST
do (SETQ PAGES/IMOBJS (GETHASH (COND
((LISTP INDEX.ITEM)
(CAR INDEX.ITEM))
(T INDEX.ITEM))
INDEX.ARRAY))
(RPLACA PAGES/IMOBJS (COND
((STRINGP (CAR PAGES/IMOBJS))
(CAR PAGES/IMOBJS))
(T (CONCAT "[Pages " (MKSTRING (CAR PAGES/IMOBJS))
"]")))))))
(WRITE.INDEX.PAGENUMBERS
(LAMBDA (STREAM PAGES.AND.IMOBJS NUMBER.OPTION) (* fsg "15-Jan-87 11:53")
(* * Here to write the actual page or pages nubers that this Index or IndexEntry appears in.
NUMBER.OPTION is the Number field of an IndexEntry.)
(DSPFONT GP.DefaultFont STREAM)
(LET ((PAGE.NBRS (COND
(NUMBER.OPTION (SELECTQ NUMBER.OPTION
(NO "")
(YES (CAR PAGES.AND.IMOBJS))
(MKSTRING NUMBER.OPTION)))
(T (CAR PAGES.AND.IMOBJS))))
(PAGE#.STRING " "))
(COND
((LISTP PAGE.NBRS)
(for PAGE in PAGE.NBRS do (SETQ PAGE#.STRING (CONCAT PAGE#.STRING " "
(MKSTRING PAGE)))
finally (PRINTOUT STREAM PAGE#.STRING)))
(T (PRINTOUT STREAM (CONCAT PAGE#.STRING PAGE.NBRS)))))))
)
[DECLARE: EVAL@COMPILE
(RECORD INDEX.ENTRY.RECORD (INDEX.ENTRY INDEX.ENTRYFONT INDEX.NUMBER))
]
(PUTPROPS INDEX COPYRIGHT ("Leland Stanford Junior University" 1987))
(DECLARE: DONTCOPY
(FILEMAP (NIL (1056 9971 (INDEXOBJ 1068 . 2331) (INDEXOBJP 2335 . 2718) (INDEX.DISPLAYFN 2722 . 4281)
(INDEX.IMAGEBOXFN 4285 . 4863) (INDEX.PUTFN 4867 . 5325) (INDEX.GETFN 5329 . 5903) (
INDEX.BUTTONEVENTINFN 5907 . 6972) (CHANGE.INDEX 6976 . 7324) (CHANGE.INDEXENTRY 7328 . 9178) (
INDEX.WHENDELETEDFN 9182 . 9968)) (9973 23270 (ADD.NEW.INDEX 9985 . 10986) (INDEX.STRING 10990 . 11779
) (INSERT.INDEX 11783 . 12319) (INSERT.INDEXENTRY 12323 . 13738) (GET.INDEXENTRY.NUMBER 13742 . 14360)
(INSERT.KNOWN.INDEX 14364 . 15630) (INDEX.LIST.REFS 15634 . 16840) (LIST.OF.INDEXENTRIES 16844 .
17764) (CREATE.INDEX.FILE 17768 . 18867) (VIEW.INDEX.FILE 18871 . 19740) (GET.INDEX.FILE 19744 . 20129
) (WRITE.INDEX.FILE 20133 . 22381) (WRITE.INDEX.PAGENUMBERS 22385 . 23267)))))
STOP

123
lispusers/LOOKUPINFILES
View File

@@ -1,14 +1,16 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "23-Feb-89 13:20:33" |{FS8:PARC:XEROX}<BOBROW>LISP>LOOKUPINFILES.;20| 32443
changes to%: (FNS Lookup-CacheFile)
(VARS LOOKUPINFILESCOMS)
(FILECREATED " 1-Feb-2022 17:00:03" 
{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>LOOKUPINFILES.;2 32247
previous date%: "23-Feb-89 09:48:41" |{FS8:PARC:XEROX}<BOBROW>LISP>LOOKUPINFILES.;19|)
:CHANGES-TO (FNS MakeLookupWindow ShowLookUpString)
:PREVIOUS-DATE "23-Feb-89 13:20:33"
{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>LOOKUPINFILES.;1)
(* "
Copyright (c) 1986, 1988, 1989 by Xerox Corporation. All rights reserved.
(* ; "
Copyright (c) 1986, 1988-1989 by Xerox Corporation.
")
(PRETTYCOMPRINT LOOKUPINFILESCOMS)
@@ -16,7 +18,7 @@ Copyright (c) 1986, 1988, 1989 by Xerox Corporation. All rights reserved.
(RPAQQ LOOKUPINFILESCOMS
(
(* ;;; "Fast lookup in files")
(* ;;; "Fast lookup in files")
(LOCALVARS . T)
(SPECVARS PROMPTWINDOW)
@@ -414,10 +416,11 @@ to close this Lookup window?
until (NOT (OPENWP w])
(MakeLookupWindow
[LAMBDA (fileList processName editRegion iconBM iconMask iconPosition iconTitle)
(* ; "Edited 25-Jan-89 13:37 by dgb:")
[LAMBDA (fileList processName editRegion iconBM iconMask iconPosition iconTitle)
(* ; "Edited 1-Feb-2022 16:59 by rmk")
(* ; "Edited 25-Jan-89 13:37 by dgb:")
(* ;; "Compute defaults")
(* ;; "Compute defaults")
(LET [(window (CREATEMENUEDWINDOW (create MENU
CENTERFLG _ T
@@ -430,20 +433,20 @@ to close this Lookup window?
'TOP
(OR editRegion LOOKUP-DEFAULT-EDITREGION]
(* ;;; "Create Menued window with prompt")
(* ;;; "Create Menued window with prompt")
(GETPROMPTWINDOW window 2 '(HELVETICA 12 BOLD))
(* ;;; "Create icon")
(* ;;; "Create icon")
(Lookup-MakeIconWindow window iconBM iconMask iconPosition iconTitle)
(* ;;; "Opening starts process, and checks if caching needed")
(* ;;; "Opening starts process, and checks if caching needed")
(WINDOWADDPROP window 'OPENFN (FUNCTION Lookup-WhenOpenedFn))
(WINDOWADDPROP window 'EXPANDFN (FUNCTION Lookup-WhenOpenedFn))
(* ;;; "Shrinking and closing kills the process. ")
(* ;;; "Shrinking and closing kills the process. ")
[WINDOWPROP window 'CLOSEFN (CONS (FUNCTION Lookup-KillProcess)
(WINDOWPROP window 'CLOSEFN]
@@ -451,72 +454,69 @@ to close this Lookup window?
[WINDOWPROP window 'SHRINKFN (CONS (FUNCTION Lookup-KillProcess)
(WINDOWPROP window 'SHRINKFN]
(* ;;; "Fix title menu for this TEDIT window")
(* ;;; "Fix title menu for this TEDIT window")
(OPENTEXTSTREAM "" window NIL NIL '(READONLY T TEDIT.TITLEMENUFN Lookup-TitleMenuFn))
(OPENTEXTSTREAM NIL window NIL NIL '(READONLY T TEDIT.TITLEMENUFN Lookup-TitleMenuFn))
(WINDOWPROP window 'TEDIT.TITLEMENUFN 'Lookup-TitleMenuFn)
(* ;;; "Cache FileList in Window")
(* ;;; "Cache FileList in Window")
(WINDOWPROP window 'FileList (MKLIST fileList))
(* ;;; "Store name for PSW")
(* ;;; "Store name for PSW")
(WINDOWPROP window 'ProcessName (OR processName 'Lookup))
(* ;;; "This should be default for attached window")
(* ;;; "This should be default for attached window")
(for w1 in (ALLATTACHEDWINDOWS window) do (WINDOWPROP w1 'PASSTOMAINCOMS T)
(WINDOWPROP w1 'RIGHTBUTTONFN
'NILL))
(WINDOWPROP w1 'RIGHTBUTTONFN 'NILL))
[ADD.PROCESS `(Lookup-CacheFiles ,window]
(SHRINKW window)
window])
(ShowLookUpString
[LAMBDA (name-or-string window lst-index start-pos) (* ; "Edited 22-Nov-88 15:10 by dgb:")
[LAMBDA (name-or-string window lst-index start-pos) (* ; "Edited 1-Feb-2022 16:59 by rmk")
(* ; "Edited 22-Nov-88 15:10 by dgb:")
(OR lst-index (SETQ lst-index 1))
(OR start-pos (SETQ start-pos 0))
(WINDOWPROP window 'searchString name-or-string)
(for elt in (NTH (WINDOWPROP window 'CacheForFiles)
lst-index) as file-index from lst-index
bind pos openStream sel textStream when (SETQ openStream (fetch openStream
of elt))
lst-index) as file-index from lst-index bind pos openStream sel textStream
when (SETQ openStream (fetch openStream of elt))
do (if (NOT (OPENP openStream))
then (OPENSTREAM openStream 'INPUT)
(WINDOWPROP window 'lastFileIndex NIL))
(if (SETQ pos (FILEPOS name-or-string openStream start-pos (fetch textLength
of elt)
NIL NIL UPPERCASEARRAY))
then (WINDOWPROP window 'lastEntryIndex pos)
(SETQ sel (TEDIT.SETSEL (SETQ textStream (fetch textStream of elt))
(ADD1 pos)
(NCHARS name-or-string)))
[if (EQP file-index (WINDOWPROP window 'lastFileIndex))
then (TEDIT.NORMALIZECARET textStream sel)
else (WINDOWPROP window 'TITLE (CONCAT "Looking in: "
(fetch fileName of elt)))
(WINDOWPROP window 'lastFileIndex file-index)
(OPENTEXTSTREAM textStream window NIL NIL '(READONLY T]
(RETURN (PROG1 (TEDIT.SET.SEL.LOOKS sel 'PENDINGDEL)
(TEDIT.SHOWSEL textStream T sel)))
else (SETQ start-pos 0)) finally (WINDOWPROP window 'lastFileIndex NIL)
(WINDOWPROP window 'lastEntryIndex NIL)
(WINDOWPROP window 'TITLE "")
(TEDIT.SETSEL (OPENTEXTSTREAM (CONCAT
name-or-string
" not found.")
window NIL NIL
'(READONLY T))
1
(NCHARS name-or-string)
'RIGHT T])
then (OPENSTREAM openStream 'INPUT)
(WINDOWPROP window 'lastFileIndex NIL))
(if (SETQ pos (FILEPOS name-or-string openStream start-pos (fetch textLength of elt)
NIL NIL UPPERCASEARRAY))
then (WINDOWPROP window 'lastEntryIndex pos)
(SETQ sel (TEDIT.SETSEL (SETQ textStream (fetch textStream of elt))
(ADD1 pos)
(NCHARS name-or-string)))
[if (EQP file-index (WINDOWPROP window 'lastFileIndex))
then (TEDIT.NORMALIZECARET textStream sel)
else (WINDOWPROP window 'TITLE (CONCAT "Looking in: " (fetch fileName
of elt)))
(WINDOWPROP window 'lastFileIndex file-index)
(OPENTEXTSTREAM textStream window NIL NIL '(READONLY T]
(RETURN (PROG1 (TEDIT.SET.SEL.LOOKS sel 'PENDINGDEL)
(TEDIT.SHOWSEL textStream T sel)))
else (SETQ start-pos 0)) finally (WINDOWPROP window 'lastFileIndex NIL)
(WINDOWPROP window 'lastEntryIndex NIL)
(WINDOWPROP window 'TITLE "")
(TEDIT.SETSEL (OPENTEXTSTREAM (OPENSTREAMSTRING
(CONCAT name-or-string
" not found."))
window NIL NIL '(READONLY T))
1
(NCHARS name-or-string)
'RIGHT T])
)
(DEFMACRO Lookup-Notify (WINDOW &REST BODY)
`(PRINTOUT (OR (OPENWP ,WINDOW)
PROMPTWINDOW)
. ,BODY))
\, BODY))
(DEFMACRO busy-protect (WINDOW NEW-BUSY-ACTION body-form unwind-form)
`(CL:UNLESS (WINDOWPROP ,WINDOW 'BUSYACTION)
@@ -554,11 +554,12 @@ to close this Lookup window?
)
(PUTPROPS LOOKUPINFILES COPYRIGHT ("Xerox Corporation" 1986 1988 1989))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (1646 28175 (AddFileToList 1656 . 3004) (DeleteFileFromList 3006 . 4253) (
Lookup-CacheFile 4255 . 6155) (Lookup-CacheFiles 6157 . 7720) (Lookup-EditFile 7722 . 8986) (
Lookup-KillProcess 8988 . 9569) (Lookup-MakeIconWindow 9571 . 11063) (Lookup-RecacheFile 11065 . 12499
) (Lookup-RightbuttonFn 12501 . 13125) (Lookup-CacheFile 13127 . 15027) (Lookup-RightbuttonFn 15029 .
15653) (Lookup-StartProcess 15655 . 16371) (Lookup-TitleMenuFn 16373 . 19425) (Lookup-WhenClosedFn
19427 . 19745) (Lookup-WhenOpenedFn 19747 . 20061) (LookupAttachedMenu 20063 . 21060) (LookupString
21062 . 22675) (MakeLookupWindow 22677 . 25299) (ShowLookUpString 25301 . 28173)))))
(FILEMAP (NIL (1645 27979 (AddFileToList 1655 . 3003) (DeleteFileFromList 3005 . 4252) (
Lookup-CacheFile 4254 . 6154) (Lookup-CacheFiles 6156 . 7719) (Lookup-EditFile 7721 . 8985) (
Lookup-KillProcess 8987 . 9568) (Lookup-MakeIconWindow 9570 . 11062) (Lookup-RecacheFile 11064 . 12498
) (Lookup-RightbuttonFn 12500 . 13124) (Lookup-CacheFile 13126 . 15026) (Lookup-RightbuttonFn 15028 .
15652) (Lookup-StartProcess 15654 . 16370) (Lookup-TitleMenuFn 16372 . 19424) (Lookup-WhenClosedFn
19426 . 19744) (Lookup-WhenOpenedFn 19746 . 20060) (LookupAttachedMenu 20062 . 21059) (LookupString
21061 . 22674) (MakeLookupWindow 22676 . 25328) (ShowLookUpString 25330 . 27977)) (27981 28116 (
Lookup-Notify 27981 . 28116)) (28118 28624 (busy-protect 28118 . 28624)))))
STOP

BIN
lispusers/LOOKUPINFILES.LCOM
View File

Binary file not shown.

1097
lispusers/MTP
View File

File diff suppressed because it is too large Load Diff

316
lispusers/MULTIPLE-HARDCOPY
View File

@@ -1,194 +1,190 @@
(FILECREATED "22-Aug-86 12:23:34" {CSLI}PS:<SAMI>MULTIPLE-HARDCOPY.;2 8769
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
changes to: (FILEVARS MULTIPLE-HARDCOPYCOMS)
(FNS MH.MAKE.GLOSSARY MULTIPLE.HARDCOPY MH.GET.INPUT.FILE MH.GET.PAGE#
MH.SET.STARTINGPAGE#)
(VARS MULTIPLE-HARDCOPYCOMS)
(FILECREATED " 1-Feb-2022 16:50:25" 
{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>MULTIPLE-HARDCOPY.;2 10662
previous date: "22-Aug-86 11:37:58" {CSLI}PS:<SAMI>MULTIPLE-HARDCOPY.;1)
:CHANGES-TO (FNS TOC)
:PREVIOUS-DATE "22-Aug-86 12:23:34"
{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>MULTIPLE-HARDCOPY.;1)
(PRETTYCOMPRINT MULTIPLE-HARDCOPYCOMS)
(RPAQQ MULTIPLE-HARDCOPYCOMS [(FNS MH.GET.INPUT.FILE MH.MAKE.GLOSSARY MULTIPLE.HARDCOPY
MH.SET.STARTINGPAGE# MH.GET.PAGE# TOC)
(P (TEDIT.ADD.MENUITEM TEDIT.DEFAULT.MENU (QUOTE (MULTIPLE% HARDCOPY
(QUOTE
MULTIPLE.HARDCOPY)
"HARDCOPY A LIST OF FILES."])
MH.SET.STARTINGPAGE# MH.GET.PAGE# TOC)
(P (TEDIT.ADD.MENUITEM TEDIT.DEFAULT.MENU '(MULTIPLE% HARDCOPY
'MULTIPLE.HARDCOPY
"HARDCOPY A LIST OF FILES."
])
(DEFINEQ
(MH.GET.INPUT.FILE
[LAMBDA (FILE) (* edited: "22-Aug-86 12:11")
[LAMBDA (FILE) (* edited%: "22-Aug-86 12:11")
(* Returns the file if the file is accessible or otherwise pesters the unwitting user until an existing file is 
supplied or nil to abort)
(* Returns the file if the file is accessible or otherwise pesters the unwitting
 user until an existing file is supplied or nil to abort)
(PROG NIL
LOOP(OR FILE (RETURN))
(AND (INFILEP FILE)
(RETURN FILE))
(printout T (CONCAT FILE " [not found.] ")
T "TYPE ANOTHER INPUT FILE (NIL TO ABORT): ")
(SETQ FILE (READ T))
(OR FILE (RETURN))
(GO LOOP])
(PROG NIL
LOOP
(OR FILE (RETURN))
(AND (INFILEP FILE)
(RETURN FILE))
(printout T (CONCAT FILE " [not found.] ")
T "TYPE ANOTHER INPUT FILE (NIL TO ABORT): ")
(SETQ FILE (READ T))
(OR FILE (RETURN))
(GO LOOP])
(MH.MAKE.GLOSSARY
[LAMBDA (FILENAME) (* edited: "22-Aug-86 12:14")
[LAMBDA (FILENAME) (* edited%: "22-Aug-86 12:14")
(* This function relies on the function TOC (written by Nick Briggs) to produce a table of contents.
It just takes the TEdit stream returned by TOC and TEDIT.PUTs it to a file.)
(* This function relies on the function TOC
 (written by Nick Briggs) to produce a table of contents.
 It just takes the TEdit stream returned by TOC and TEDIT.PUTs it to a file.)
(COND
((BOUNDP (QUOTE MULTIPLE.HARDCOPY.LIST))
(TEDIT.PUT (TOC MULTIPLE.HARDCOPY.LIST)
FILENAME))
(T (PRINTOUT T "MULTIPLE.HARDCOPY MUST BE RUN FIRST" T])
(COND
((BOUNDP 'MULTIPLE.HARDCOPY.LIST)
(TEDIT.PUT (TOC MULTIPLE.HARDCOPY.LIST)
FILENAME))
(T (PRINTOUT T "MULTIPLE.HARDCOPY MUST BE RUN FIRST" T])
(MULTIPLE.HARDCOPY
[LAMBDA (STREAM FILELST GLOSSARY.FILE TOFILE? DONTSEND UNFORMATTED? BREAKPAGETITLE SERVER
PRINTOPTIONS) (* edited: "22-Aug-86 12:23")
(* HARDCOPIES all the files in FILELST making sure that the files are numbered consecutively.
If STREAM is supplied then it should be a TEdit stream. The intent is that one could set up one's desired page 
looks in a TEdit window and then pass that TEdit stream to MULTIPLE.HARDCOPY which will use those page looks.
If a STREAM is not given then a fresh TEdit window is started. FILELST should be a list of files to hardcopy in the
order that they should be numbered. GLOSSARY.FILE, if given, should be the name of a file. If given then after 
MULTIPLE.HARDCOPY is done hardcopying it will use the MH.MAKE.GLOSSARY to make a table of contents for the files 
and save the table of contents in GLOSSARY.FILE. If TOFILE? is NON-NIL then an IP file will be created for each 
file in FILELST that is the same name as the file but with extension IP. If DONTSEND is NON-NIL then the files will
not be sent to the printer (this only makes sense if you're creating IP files). If UNFORMATTED? is NON-NIL then the
files will be hardcopied without formatting information. BREAKPAGETITLE, SERVER and PRINTOPTIONS are the same as 
per TEDIT.HARDCOPY. After MULTIPLE.HARDCOPY is done, it returns a variable MULTIPLE.HARDCOPY.LIST which is a useful
list of information about this hardcopy process. The list is of the form: (<starting page#> %.
<list of pairs>) where each pair is of the form (<name of file> <start page# of file>))
PRINTOPTIONS) (* edited%: "22-Aug-86 12:23")
(* HARDCOPIES all the files in FILELST making sure that the files are numbered
 consecutively. If STREAM is supplied then it should be a TEdit stream.
 The intent is that one could set up one's desired page looks in a TEdit window
 and then pass that TEdit stream to MULTIPLE.HARDCOPY which will use those page
 looks. If a STREAM is not given then a fresh TEdit window is started.
 FILELST should be a list of files to hardcopy in the order that they should be
 numbered. GLOSSARY.FILE, if given, should be the name of a file.
 If given then after MULTIPLE.HARDCOPY is done hardcopying it will use the
 MH.MAKE.GLOSSARY to make a table of contents for the files and save the table of
 contents in GLOSSARY.FILE. If TOFILE? is NON-NIL then an IP file will be created
 for each file in FILELST that is the same name as the file but with extension IP.
 If DONTSEND is NON-NIL then the files will not be sent to the printer
 (this only makes sense if you're creating IP files)%.
 If UNFORMATTED? is NON-NIL then the files will be hardcopied without formatting
 information. BREAKPAGETITLE, SERVER and PRINTOPTIONS are the same as per
 TEDIT.HARDCOPY. After MULTIPLE.HARDCOPY is done, it returns a variable
 MULTIPLE.HARDCOPY.LIST which is a useful list of information about this hardcopy
 process. The list is of the form%: (<starting page#> %.
 <list of pairs>) where each pair is of the form
 (<name of file> <start page# of file>))
(PROG* (FRAME LOCALINFO INITIAL.DEFAULTPG PG)
(OR FILELST (SETQ FILELST (TTYIN "FILELST TO HARDCOPY>>"))
(RETURN (PRINTOUT T "No filelst specified.")))
[OR STREAM (SETQ STREAM (TEXTSTREAM (PROCESSPROP (TEDIT (MH.GET.INPUT.FILE
(CAR FILELST)))
(QUOTE WINDOW]
(COND
((ATOM FILELST)
(SETQ FILELST (LIST FILELST)))
(FILELST))
(SETQ FRAME (OR (fetch TXTPAGEFRAMES of (TEXTOBJ STREAM))
TEDIT.PAGE.FRAMES))
[SETQ LOCALINFO (fetch REGIONLOCALINFO of (COND
((LISTP FRAME)
(CAR FRAME))
(T FRAME]
[SETQ INITIAL.DEFAULTPG (AND (LISTGET LOCALINFO (QUOTE STARTINGPAGE#))
(SUB1 (LISTGET LOCALINFO (QUOTE STARTINGPAGE#]
(SETQ PG (OR INITIAL.DEFAULTPG 0))
(SETQ MULTIPLE.HARDCOPY.LIST NIL)
(ADVISE (QUOTE TEDIT.PROMPTPRINT)
(QUOTE BEFORE)
(QUOTE (SETQ PG MSG)))
[for FILE in FILELST do (PROGN (SETQ FILE (MH.GET.INPUT.FILE FILE))
(OR FILE (RETURN))
(PROMPTPRINT "MULTIPLE.HARDCOPY: " (FULLNAME
FILE))
(TEDIT.GET (TEXTOBJ STREAM)
FILE UNFORMATTED?)
(replace TXTPAGEFRAMES of (TEXTOBJ STREAM)
with FRAME)
(MH.SET.STARTINGPAGE# (ADD1 PG)
FRAME)
(TEDIT.HARDCOPY STREAM
(COND
(TOFILE? (PACKFILENAME
(QUOTE NAME)
TOFILE?
(QUOTE EXTENSION)
(QUOTE IP)))
(T NIL))
DONTSEND BREAKPAGETITLE SERVER
PRINTOPTIONS)
(SETQ PG (MKATOM (MH.GET.PAGE# PG)))
(SETQ MULTIPLE.HARDCOPY.LIST
(NCONC1 MULTIPLE.HARDCOPY.LIST
(CONS FILE PG]
(UNADVISE TEDIT.PROMPTPRINT)
(MH.SET.STARTINGPAGE# (AND INITIAL.DEFAULTPG (ADD1 INITIAL.DEFAULTPG))
FRAME)
(RETURN (COND
(MULTIPLE.HARDCOPY.LIST (SETQ MULTIPLE.HARDCOPY.LIST
(CONS (OR (AND INITIAL.DEFAULTPG (ADD1
INITIAL.DEFAULTPG))
1)
MULTIPLE.HARDCOPY.LIST))
(COND
(GLOSSARY.FILE (MH.MAKE.GLOSSARY GLOSSARY.FILE)
(PRINTOUT T (CONCAT
"Glossary file in: "
(FULLNAME
GLOSSARY.FILE)
)
T)))
MULTIPLE.HARDCOPY.LIST])
(OR FILELST (SETQ FILELST (TTYIN "FILELST TO HARDCOPY>>"))
(RETURN (PRINTOUT T "No filelst specified.")))
[OR STREAM (SETQ STREAM (TEXTSTREAM (PROCESSPROP (TEDIT (MH.GET.INPUT.FILE (CAR FILELST)))
'WINDOW]
(COND
((ATOM FILELST)
(SETQ FILELST (LIST FILELST)))
(FILELST))
(SETQ FRAME (OR (fetch TXTPAGEFRAMES of (TEXTOBJ STREAM))
TEDIT.PAGE.FRAMES))
[SETQ LOCALINFO (fetch REGIONLOCALINFO of (COND
((LISTP FRAME)
(CAR FRAME))
(T FRAME]
[SETQ INITIAL.DEFAULTPG (AND (LISTGET LOCALINFO 'STARTINGPAGE#)
(SUB1 (LISTGET LOCALINFO 'STARTINGPAGE#]
(SETQ PG (OR INITIAL.DEFAULTPG 0))
(SETQ MULTIPLE.HARDCOPY.LIST NIL)
(ADVISE 'TEDIT.PROMPTPRINT 'BEFORE '(SETQ PG MSG))
[for FILE in FILELST do (PROGN (SETQ FILE (MH.GET.INPUT.FILE FILE))
(OR FILE (RETURN))
(PROMPTPRINT "MULTIPLE.HARDCOPY: " (FULLNAME FILE))
(TEDIT.GET (TEXTOBJ STREAM)
FILE UNFORMATTED?)
(replace TXTPAGEFRAMES of (TEXTOBJ STREAM) with FRAME)
(MH.SET.STARTINGPAGE# (ADD1 PG)
FRAME)
(TEDIT.HARDCOPY STREAM (COND
(TOFILE? (PACKFILENAME
'NAME TOFILE?
'EXTENSION
'IP))
(T NIL))
DONTSEND BREAKPAGETITLE SERVER PRINTOPTIONS)
(SETQ PG (MKATOM (MH.GET.PAGE# PG)))
(SETQ MULTIPLE.HARDCOPY.LIST (NCONC1 MULTIPLE.HARDCOPY.LIST
(CONS FILE PG]
(UNADVISE TEDIT.PROMPTPRINT)
(MH.SET.STARTINGPAGE# (AND INITIAL.DEFAULTPG (ADD1 INITIAL.DEFAULTPG))
FRAME)
(RETURN (COND
(MULTIPLE.HARDCOPY.LIST (SETQ MULTIPLE.HARDCOPY.LIST
(CONS (OR (AND INITIAL.DEFAULTPG (ADD1
INITIAL.DEFAULTPG
))
1)
MULTIPLE.HARDCOPY.LIST))
(COND
(GLOSSARY.FILE (MH.MAKE.GLOSSARY GLOSSARY.FILE)
(PRINTOUT T (CONCAT "Glossary file in: " (FULLNAME
GLOSSARY.FILE)
)
T)))
MULTIPLE.HARDCOPY.LIST])
(MH.SET.STARTINGPAGE#
[LAMBDA (PG# PAGE.FRAMES) (* edited: "22-Aug-86 12:15")
(* Sets the starting page of a PAGE.FRAME.)
[COND
((LISTP PAGE.FRAMES)
(SETQ PAGE.FRAMES (CAR PAGE.FRAMES]
[LAMBDA (PG# PAGE.FRAMES) (* edited%: "22-Aug-86 12:15")
(* Sets the starting page of a
 PAGE.FRAME.)
[COND
((LISTP PAGE.FRAMES)
(SETQ PAGE.FRAMES (CAR PAGE.FRAMES]
(LET ((LOCAL.INFO (fetch REGIONLOCALINFO of PAGE.FRAMES)))
(COND
(LOCAL.INFO (LISTPUT (fetch REGIONLOCALINFO of PAGE.FRAMES)
(QUOTE STARTINGPAGE#)
PG#))
(T (replace REGIONLOCALINFO of PAGE.FRAMES with (LIST (QUOTE STARTINGPAGE#)
PG#])
(COND
(LOCAL.INFO (LISTPUT (fetch REGIONLOCALINFO of PAGE.FRAMES)
'STARTINGPAGE# PG#))
(T (replace REGIONLOCALINFO of PAGE.FRAMES with (LIST 'STARTINGPAGE# PG#])
(MH.GET.PAGE#
[LAMBDA (STR) (* edited: "22-Aug-86 12:13")
[LAMBDA (STR) (* edited%: "22-Aug-86 12:13")
(* This is meant to extract a number from a string such as "2pgs done." which is what TEdit prints out when it's 
finished hardcopying something. This is unfortunately the way this program relies on to extract how many pages a 
file was hardcopied.)
(* This is meant to extract a number from a string such as "2pgs done." which is
 what TEdit prints out when it's finished hardcopying something.
 This is unfortunately the way this program relies on to extract how many pages a
 file was hardcopied.)
(LET ((CH (GNC STR)))
(COND
((NUMBERP (MKATOM CH))
(CONCAT CH (MH.GET.PAGE# STR)))
(T ""])
(LET ((CH (GNC STR)))
(COND
((NUMBERP (MKATOM CH))
(CONCAT CH (MH.GET.PAGE# STR)))
(T ""])
(TOC
[LAMBDA (FILE) (* edited: "22-Aug-86 11:48")
(* (* N.H.Briggs " 8-Apr-86 11:23"))
[LAMBDA (FILE) (* ; "Edited 1-Feb-2022 16:47 by rmk")
(* edited%: "22-Aug-86 11:48")
(* (* N.H.Briggs " 8-Apr-86 11:23"))
(LET (TOCSTREAM TOCINFO TOCOUTSTREAM STARTPAGE)
(if (LISTP FILE)
then (SETQ TOCINFO FILE)
else [SETQ TOCINFO (READ (SETQ TOCSTREAM (OPENSTREAM FILE (QUOTE INPUT]
(CLOSEF TOCSTREAM))
(SETQ TOCOUTSTREAM (OPENTEXTSTREAM ""))
(SETQ STARTPAGE (CAR TOCINFO))
[for TOCENTRY in (CDR TOCINFO)
do (TEDIT.INSERT TOCOUTSTREAM (FILENAMEFIELD (CAR TOCENTRY)
(QUOTE NAME)))
(TEDIT.INSERT TOCOUTSTREAM (CHARACTER (CHARCODE TAB)))
(TEDIT.INSERT TOCOUTSTREAM (MKSTRING STARTPAGE))
(TEDIT.INSERT TOCOUTSTREAM (CHARACTER (CHARCODE CR)))
(SETQ STARTPAGE (ADD1 (CDR TOCENTRY]
(TEDIT.PARALOOKS TOCOUTSTREAM (QUOTE (TABS (NIL (360 . DOTTEDLEFT))
RIGHTMARGIN 456))
1
(GETEOFPTR TOCOUTSTREAM))
TOCOUTSTREAM])
(if (LISTP FILE)
then (SETQ TOCINFO FILE)
else [SETQ TOCINFO (READ (SETQ TOCSTREAM (OPENSTREAM FILE 'INPUT]
(CLOSEF TOCSTREAM))
(SETQ TOCOUTSTREAM (OPENTEXTSTREAM NIL))
(SETQ STARTPAGE (CAR TOCINFO))
[for TOCENTRY in (CDR TOCINFO) do (TEDIT.INSERT TOCOUTSTREAM (FILENAMEFIELD (CAR TOCENTRY)
'NAME))
(TEDIT.INSERT TOCOUTSTREAM (CHARACTER (CHARCODE TAB)))
(TEDIT.INSERT TOCOUTSTREAM (MKSTRING STARTPAGE))
(TEDIT.INSERT TOCOUTSTREAM (CHARACTER (CHARCODE CR)))
(SETQ STARTPAGE (ADD1 (CDR TOCENTRY]
(TEDIT.PARALOOKS TOCOUTSTREAM '(TABS (NIL (360 . DOTTEDLEFT))
RIGHTMARGIN 456)
1
(GETEOFPTR TOCOUTSTREAM))
TOCOUTSTREAM])
)
(TEDIT.ADD.MENUITEM TEDIT.DEFAULT.MENU (QUOTE (MULTIPLE% HARDCOPY (QUOTE MULTIPLE.HARDCOPY)
"HARDCOPY A LIST OF FILES.")))
(DECLARE: DONTCOPY
(FILEMAP (NIL (717 8614 (MH.GET.INPUT.FILE 727 . 1306) (MH.MAKE.GLOSSARY 1308 . 1825) (
MULTIPLE.HARDCOPY 1827 . 6270) (MH.SET.STARTINGPAGE# 6272 . 6917) (MH.GET.PAGE# 6919 . 7454) (TOC 7456
. 8612)))))
(TEDIT.ADD.MENUITEM TEDIT.DEFAULT.MENU '(MULTIPLE% HARDCOPY 'MULTIPLE.HARDCOPY
"HARDCOPY A LIST OF FILES."))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (925 10481 (MH.GET.INPUT.FILE 935 . 1531) (MH.MAKE.GLOSSARY 1533 . 2062) (
MULTIPLE.HARDCOPY 2064 . 7788) (MH.SET.STARTINGPAGE# 7790 . 8485) (MH.GET.PAGE# 8487 . 9049) (TOC 9051
. 10479)))))
STOP

BIN
lispusers/MULTIPLE-HARDCOPY.LCOM Normal file
View File

Binary file not shown.

1102
lispusers/NGROUP
View File

File diff suppressed because it is too large Load Diff

40
lispusers/REGISTER-MACHINE
View File

@@ -1,28 +1,31 @@
(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")
(FILECREATED " 8-Jan-88 18:02:00" {ERINYES}<LISPUSERS>LYRIC>REGISTER-MACHINE.;2 4471
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
changes to%: (FNS Requst-NS-Registry AmIRegistered)
(VARS REGISTER-MACHINECOMS)
(FILECREATED " 1-Feb-2022 16:51:58" 
{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>REGISTER-MACHINE.;2 4416
previous date%: "13-Feb-87 16:07:50" {PHYLUM}<ISLINFO>FORMS>REGISTER-MACHINE.;3)
:CHANGES-TO (FNS Requst-NS-Registry)
:PREVIOUS-DATE " 8-Jan-88 18:02:00"
{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>REGISTER-MACHINE.;1)
(* "
Copyright (c) 1986, 1987, 1988 by Xerox Corporation. All rights reserved.
(* ; "
Copyright (c) 1986-1988 by Xerox Corporation.
")
(PRETTYCOMPRINT REGISTER-MACHINECOMS)
(RPAQQ REGISTER-MACHINECOMS (
(RPAQQ REGISTER-MACHINECOMS
(
(* ;;; "Add a Lafite form that will request that the current machine be registered with the local Clearinghouse")
(FNS Requst-NS-Registry AmIRegistered)
(ADDVARS (LAFITESPECIALFORMS ("Clearinghouse registry request"
'Requst-NS-Registry
(FNS Requst-NS-Registry AmIRegistered)
(ADDVARS (LAFITESPECIALFORMS ("Clearinghouse registry request" 'Requst-NS-Registry
"Make a form to request that the current machine be registered on the local Clearinghouse"
)))
(P (UNMARKASCHANGED 'LAFITESPECIALFORMS 'VARS)
(SETQ LAFITEFORMSMENU NIL))))
)))
(P (UNMARKASCHANGED 'LAFITESPECIALFORMS 'VARS)
(SETQ LAFITEFORMSMENU NIL))))
@@ -33,12 +36,13 @@ Copyright (c) 1986, 1987, 1988 by Xerox Corporation. All rights reserved.
(DEFINEQ
(Requst-NS-Registry
[LAMBDA NIL (* ; "Edited 8-Jan-88 18:00 by Masinter")
[LAMBDA NIL (* ; "Edited 1-Feb-2022 16:46 by rmk")
(* ; "Edited 8-Jan-88 18:00 by Masinter")
(* ;;;
"Format a nice note requsting that the current machine be registered on the local Clearinghouse.")
(LET ((*STANDARD-OUTPUT* (OPENTEXTSTREAM "" NIL NIL NIL (LIST 'FONT LAFITEEDITORFONT)))
(LET ((*STANDARD-OUTPUT* (OPENTEXTSTREAM NIL NIL NIL NIL (LIST 'FONT LAFITEEDITORFONT)))
(netNumber (fetch NSNET \MY.NSADDRESS))
(me (FULLUSERNAME))
(CURRENTLY (AmIRegistered)))
@@ -87,9 +91,11 @@ Copyright (c) 1986, 1987, 1988 by Xerox Corporation. All rights reserved.
(ADDTOVAR LAFITESPECIALFORMS ("Clearinghouse registry request" 'Requst-NS-Registry
"Make a form to request that the current machine be registered on the local Clearinghouse"
))
(UNMARKASCHANGED 'LAFITESPECIALFORMS 'VARS)
(SETQ LAFITEFORMSMENU NIL)
(PUTPROPS REGISTER-MACHINE COPYRIGHT ("Xerox Corporation" 1986 1987 1988))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (1298 4072 (Requst-NS-Registry 1308 . 3473) (AmIRegistered 3475 . 4070)))))
(FILEMAP (NIL (1131 4015 (Requst-NS-Registry 1141 . 3416) (AmIRegistered 3418 . 4013)))))
STOP

88
lispusers/SEARCHMENU
View File

@@ -1,19 +1,27 @@
(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")
(FILECREATED "10-Apr-89 17:14:26" {ERINYES}<LISPUSERS>MEDLEY>SEARCHMENU.;5 32974
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
previous date%: "21-Nov-88 08:18:13" {ERINYES}<LISPUSERS>MEDLEY>SEARCHMENU.;4)
(FILECREATED " 1-Feb-2022 16:36:19" 
{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>SEARCHMENU.;5 33088
:CHANGES-TO (VARS SEARCHMENUCOMS)
:PREVIOUS-DATE " 1-Feb-2022 16:35:43"
{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>SEARCHMENU.;4)
(* "
Copyright (c) 1987, 1988, 1989 by Xerox Corporation. All rights reserved.
(* ; "
Copyright (c) 1987-1989 by Xerox Corporation.
")
(PRETTYCOMPRINT SEARCHMENUCOMS)
(RPAQQ SEARCHMENUCOMS
((COMS * SEARCHMENUDEPENDENCIES)
(FILES DICTTOOL ANALYZER FREEMENU (FROM {PIGLET/N}<PIGLET>DICTSERVER>LISP>)
DICTCLIENT)
[(COMS * SEARCHMENUDEPENDENCIES)
(FILES DICTTOOL ANALYZER FREEMENU)
(* ;; "RMK: 2022: DICTCLIENT doesn't seem to exist")
(* (FILES DICTCLIENT))
(INITVARS SearchMenu SearchMenu.Stream (SearchMenu.Cutoff 39))
(FNS SearchMenu.Create SearchMenu.GetData SearchMenu.PrintData SearchMenu.PrintDef
SearchMenu.PrintSearch SearchMenu.ToggleKey SearchMenu.ToggleSample SearchMenu.PrintUses
@@ -22,8 +30,8 @@ Copyright (c) 1987, 1988, 1989 by Xerox Corporation. All rights reserved.
(FNS TEdit.MatchWords DictTool.MatchWords)
(VARS SearchKey SearchDelete SearchMatch SearchPrint SearchDatabase SearchClear SearchUses
SearchDef SearchSample SearchExamples SearchMatchKeys SearchMenuIcon SearchMenuMask)
(P (SETQ SearchIcon NIL)
(SearchMenu.Create))))
(INITVARS (SearchIcon NIL))
(DECLARE%: DONTEVAL@LOAD DOCOPY (P (SearchMenu.Create])
(RPAQQ SEARCHMENUDEPENDENCIES
[(* * code to make sure that the right versions of everything are loaded. The P must be
@@ -42,28 +50,36 @@ Copyright (c) 1987, 1988, 1989 by Xerox Corporation. All rights reserved.
(* clear FILEDATES to force FILESLOAD to reload the file.)
(PUTPROP (CAR FILE)
'FILEDATES NIL])
(* * code to make sure that the right versions of everything are loaded. The P must be executed
before any FILES commands.)
(* * code to make sure that the right versions of everything are loaded. The P must be executed before
any FILES commands.)
(PUTPROPS SEARCHMENU DEPENDENCIES ((DICTTOOL . "28-Feb-89 10:54:26")
(ANALYZER . " 9-Mar-89 15:24:58")
(FREEMENU . " 7-Jan-88 16:23:54")
(DICTCLIENT . " 8-Oct-87 15:15:08")))
(PUTPROPS SEARCHMENU DEPENDENCIES ((DICTTOOL . " 1-Mar-94 10:43:44")
(ANALYZER . " 9-Mar-89 15:24:58")
(FREEMENU . " 6-Dec-94 10:55:40")))
[for FILE FILEDATE in (GETPROP 'SEARCHMENU 'DEPENDENCIES)
do [SETQ FILEDATE (CAAR (GETPROP (CAR FILE)
'FILEDATES]
(COND
([AND FILEDATE (CDR FILE)
(ILESSP (IDATE FILEDATE)
(IDATE (CDR FILE] (* clear FILEDATES to force
 FILESLOAD to reload the file.)
(PUTPROP (CAR FILE)
'FILEDATES NIL]
'FILEDATES]
(COND
([AND FILEDATE (CDR FILE)
(ILESSP (IDATE FILEDATE)
(IDATE (CDR FILE] (* clear FILEDATES to force FILESLOAD
 to reload the file.)
(PUTPROP (CAR FILE)
'FILEDATES NIL]
(FILESLOAD DICTTOOL ANALYZER FREEMENU)
(* ;; "RMK: 2022: DICTCLIENT doesn't seem to exist")
(* (FILES DICTCLIENT))
(FILESLOAD DICTTOOL ANALYZER FREEMENU (FROM {PIGLET/N}<PIGLET>DICTSERVER>LISP>)
DICTCLIENT)
(RPAQ? SearchMenu NIL)
@@ -520,17 +536,19 @@ before any FILES commands.)
(RPAQQ SearchMenuMask #*(44 29)@@@GN@GN@@@@@@AOOIOOH@@@@@COOOOOL@@@@@GOOOOON@@@@@OOOOOOO@@@@COOOOOOOH@@OOOOOOOOOOO@COOOOOOOOOL@AOOOOOOOOO@@@COOOOOOON@@@AOOOOOOOL@@@@OOOOOOOH@@@AOOOOOON@@@@GOOOOOOL@@@@OOOOOOOH@@@AOOOOOOO@@@@COOOOOON@@@@GOOOOOO@@@@@GOOOOOH@@@@@OOOOL@@@@@@@OOOOL@@@@@@@OOOOH@@@@@@@OOOOH@@@@@@@OOOO@@@@@@@@GOON@@@@@@@@GOOL@@@@@@@@COOH@@@@@@@@AOO@@@@@@@@@@OL@@@@@@@@@
)
(SETQ SearchIcon NIL)
(RPAQ? SearchIcon NIL)
(DECLARE%: DONTEVAL@LOAD DOCOPY
(SearchMenu.Create)
)
(PUTPROPS SEARCHMENU COPYRIGHT ("Xerox Corporation" 1987 1988 1989))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (3464 25282 (SearchMenu.Create 3474 . 11127) (SearchMenu.GetData 11129 . 13392) (
SearchMenu.PrintData 13394 . 15703) (SearchMenu.PrintDef 15705 . 16179) (SearchMenu.PrintSearch 16181
. 16875) (SearchMenu.ToggleKey 16877 . 17173) (SearchMenu.ToggleSample 17175 . 17480) (
SearchMenu.PrintUses 17482 . 17753) (SearchMenu.Clear 17755 . 18015) (SearchMenu.MatchWords 18017 .
19528) (SearchMenu.MatchKeys 19530 . 20746) (SearchMenu.SearchFn 20748 . 21176) (
SearchMenu.SetDatabase 21178 . 21753) (SearchMenu.DeleteKey 21755 . 23310) (SearchMenu.DeleteKeys
23312 . 24971) (SearchMenu.IconFn 24973 . 25280)) (25283 27304 (TEdit.MatchWords 25293 . 25738) (
DictTool.MatchWords 25740 . 27302)))))
(FILEMAP (NIL (3538 25356 (SearchMenu.Create 3548 . 11201) (SearchMenu.GetData 11203 . 13466) (
SearchMenu.PrintData 13468 . 15777) (SearchMenu.PrintDef 15779 . 16253) (SearchMenu.PrintSearch 16255
. 16949) (SearchMenu.ToggleKey 16951 . 17247) (SearchMenu.ToggleSample 17249 . 17554) (
SearchMenu.PrintUses 17556 . 17827) (SearchMenu.Clear 17829 . 18089) (SearchMenu.MatchWords 18091 .
19602) (SearchMenu.MatchKeys 19604 . 20820) (SearchMenu.SearchFn 20822 . 21250) (
SearchMenu.SetDatabase 21252 . 21827) (SearchMenu.DeleteKey 21829 . 23384) (SearchMenu.DeleteKeys
23386 . 25045) (SearchMenu.IconFn 25047 . 25354)) (25357 27378 (TEdit.MatchWords 25367 . 25812) (
DictTool.MatchWords 25814 . 27376)))))
STOP

BIN
lispusers/SEARCHMENU.LCOM
View File

Binary file not shown.