Compare commits
3 Commits
medley-220
...
medley-220
| Author | SHA1 | Date | |
|---|---|---|---|
|
66091a2375 | ||
|
|
fe90ac5f9f | ||
|
|
b791bff070 |
466
library/SKETCH
466
library/SKETCH
@@ -1,13 +1,15 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
(FILECREATED "21-Jan-93 11:59:03" {DSK}<python>lde>lispcore>library>SKETCH.;3 491018
|
||||
|
||||
changes to%: (FNS SK.BUILD.IMAGEOBJ)
|
||||
(FILECREATED " 1-Feb-2022 09:17:12" {DSK}<Users>kaplan>Local>medley3.5>my-medley>library>SKETCH.;2 490756
|
||||
|
||||
previous date%: "20-Jan-93 14:46:57" {DSK}<python>lde>lispcore>library>SKETCH.;2)
|
||||
:CHANGES-TO (FNS SKETCH.PUT)
|
||||
|
||||
:PREVIOUS-DATE "21-Jan-93 11:59:03"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>my-medley>library>SKETCH.;1)
|
||||
|
||||
|
||||
(* ; "
|
||||
Copyright (c) 1984, 1985, 1986, 1987, 1988, 1990, 1992, 1993 by Venue & Xerox Corporation. All rights reserved.
|
||||
Copyright (c) 1984-1988, 1990, 1992-1993 by Venue & Xerox Corporation.
|
||||
")
|
||||
|
||||
(PRETTYCOMPRINT SKETCHCOMS)
|
||||
@@ -19,8 +21,7 @@ Copyright (c) 1984, 1985, 1986, 1987, 1988, 1990, 1992, 1993 by Venue & Xerox Co
|
||||
ALL.SKETCHES))
|
||||
TEDITFLG)
|
||||
|
||||
(* ;;
|
||||
"current knows about SKETCH TEDIT and NOTECARDS. Everyone else loses.")
|
||||
(* ;; "current knows about SKETCH TEDIT and NOTECARDS. Everyone else loses.")
|
||||
|
||||
[MAP.PROCESSES (FUNCTION (LAMBDA (PROC PROCNAME PROCFORM)
|
||||
(AND (EQ (CAR PROCFORM)
|
||||
@@ -62,22 +63,22 @@ To abort loading the new version of Sketch, type '^'."]
|
||||
SK.CHECK.IMAGEOBJ.WHENDELETEDFN SK.APPLY.IMAGEOBJ.WHENDELETEDFN SK.RETURN.TTY
|
||||
SK.TAKE.TTY)
|
||||
(COMS (* ;
|
||||
"fns for dealing with the sketch menu")
|
||||
"fns for dealing with the sketch menu")
|
||||
(FNS SKETCH.COMMANDMENU SKETCH.COMMANDMENU.ITEMS CREATE.SKETCHW.COMMANDMENU
|
||||
SKETCHW.SELECTIONFN SKETCH.MONITORLOCK SK.EVAL.AS.PROCESS SK.EVAL.WITH.LOCK)
|
||||
(FNS SK.FIX.MENU SK.SET.UP.MENUS SK.INSURE.HAS.MENU SK.CREATE.STANDARD.MENU
|
||||
SK.ADD.ITEM.TO.MENU SK.GET.VIEWER.POPUP.MENU SK.CLEAR.POPUP.MENU))
|
||||
(COMS (* ;
|
||||
"fns for dealing with sketch structures")
|
||||
"fns for dealing with sketch structures")
|
||||
(FNS SKETCH.CREATE GETSKETCHPROP PUTSKETCHPROP CREATE.DEFAULT.SKETCH.CONTEXT)
|
||||
(PROP ARGNAMES SKETCH.CREATE))
|
||||
(COMS (* ;
|
||||
"fns for implementing copy and delete functions under keyboard control.")
|
||||
"fns for implementing copy and delete functions under keyboard control.")
|
||||
(FNS SK.COPY.BUTTONEVENTFN SK.BUTTONEVENT.MARK SK.BUILD.IMAGEOBJ SK.BUTTONEVENT.OVERP
|
||||
SK.BUTTONEVENT.SAME.KEYS)
|
||||
(MACROS .DELETEKEYDOWNP. .MOVEKEYDOWNP.))
|
||||
(COMS (* ;
|
||||
"fns for implementing the CHANGE command.")
|
||||
"fns for implementing the CHANGE command.")
|
||||
(FNS SK.SEL.AND.CHANGE SK.CHECK.WHENCHANGEDFN SK.CHECK.PRECHANGEFN SK.CHANGE.ELT
|
||||
SK.CHANGE.THING SKETCH.CHANGE.ELEMENTS SK.APPLY.SINGLE.CHANGEFN SK.DO.CHANGESPECS
|
||||
SK.VIEWER.FROM.SKETCH.ARG SK.DO.CHANGESPEC1 SK.CHANGEFN SK.READCHANGEFN
|
||||
@@ -109,7 +110,7 @@ To abort loading the new version of Sketch, type '^'."]
|
||||
SK.SHOW.FIG.FROM.INFO SK.MOVE.THING UPDATE.ELEMENT.IN.SKETCH SK.UPDATE.ELEMENT
|
||||
SK.UPDATE.ELEMENTS SK.UPDATE.ELEMENT1 SK.MOVE.ELEMENT.POINT)
|
||||
(* ;
|
||||
"fns for moving points or a collection of pts.")
|
||||
"fns for moving points or a collection of pts.")
|
||||
(FNS SK.MOVE.POINTS SK.SEL.AND.MOVE.POINTS SK.DO.MOVE.ELEMENT.POINTS
|
||||
SK.MOVE.ITEM.POINTS SK.TRANSLATEPTSFN SK.TRANSLATE.POINTS
|
||||
SK.SELECT.MULTIPLE.POINTS SK.CONTROL.POINTS.IN.REGION SK.ADD.PT.SELECTION
|
||||
@@ -124,7 +125,7 @@ To abort loading the new version of Sketch, type '^'."]
|
||||
SK.GET.SELECTED.ELEMENT.STRUCTURE SK.CORRESPONDING.CONTROL.PT
|
||||
SK.CONTROL.POINT.NUMBER SK.DO.ALIGN.SETVALUE))
|
||||
(COMS (* ;
|
||||
"stuff for supporting the GROUP sketch element.")
|
||||
"stuff for supporting the GROUP sketch element.")
|
||||
(FNS SKETCH.CREATE.GROUP SK.CREATE.GROUP1 SK.UPDATE.GROUP.AFTER.CHANGE SK.GROUP.ELTS
|
||||
SK.SEL.AND.GROUP SK.GROUP.ELEMENTS SK.UNGROUP.ELT SK.SEL.AND.UNGROUP
|
||||
SK.UNGROUP.ELEMENT SK.GLOBAL.REGION.OF.LOCAL.ELEMENTS
|
||||
@@ -134,17 +135,16 @@ To abort loading the new version of Sketch, type '^'."]
|
||||
GROUP.GLOBALREGIONFN GROUP.TRANSLATEFN GROUP.TRANSFORMFN GROUP.READCHANGEFN)
|
||||
(FNS REGION.CENTER REMOVE.LAST)
|
||||
(* ;
|
||||
"moving the control point of a group")
|
||||
"moving the control point of a group")
|
||||
(FNS SK.MOVE.GROUP.CONTROL.PT SK.SEL.AND.MOVE.CONTROL.PT
|
||||
SK.MOVE.GROUP.ELEMENT.CONTROL.POINT SK.READ.NEW.GROUP.CONTROL.PT)
|
||||
(RECORDS GROUP LOCALGROUP)
|
||||
(COMS (* ;
|
||||
"history and undo stuff for groups")
|
||||
(COMS (* ; "history and undo stuff for groups")
|
||||
(FNS SK.DO.GROUP SK.CHECK.WHENGROUPEDFN SK.DO.UNGROUP SK.CHECK.WHENUNGROUPEDFN
|
||||
SK.GROUP.UNDO SK.UNGROUP.UNDO)
|
||||
(IFPROP EVENTFNS GROUP UNGROUP)))
|
||||
(COMS (* ;
|
||||
"stuff for supporting the freezing of elements")
|
||||
"stuff for supporting the freezing of elements")
|
||||
(FNS SK.FREEZE.ELTS SK.SEL.AND.FREEZE SK.FREEZE.ELEMENTS SK.UNFREEZE.ELT
|
||||
SK.SEL.AND.UNFREEZE SK.UNFREEZE.ELEMENTS SK.FREEZE.UNDO SK.UNFREEZE.UNDO
|
||||
SK.DO.FREEZE SK.DO.UNFREEZE)
|
||||
@@ -154,13 +154,13 @@ To abort loading the new version of Sketch, type '^'."]
|
||||
SKETCH.DELETE.ELEMENT DELFROMGROUPELT SKETCH.ELEMENT.TYPE SKETCH.ELEMENT.CHANGED
|
||||
SK.ELEMENT.CHANGED1 SK.UPDATE.GLOBAL.IMAGE.OBJECT.ELEMENT))
|
||||
(* ;
|
||||
"utility routines for sketch windows.")
|
||||
"utility routines for sketch windows.")
|
||||
(FNS INSURE.SKETCH LOCALSPECS.FROM.VIEWER SK.LOCAL.ELT.FROM.GLOBALPART SKETCH.FROM.VIEWER
|
||||
INSPECT.SKETCH ELT.INSIDE.SKETCHWP SK.INSIDE.REGION)
|
||||
(FNS MAPSKETCHSPECS MAPCOLLECTSKETCHSPECS MAPSKETCHSPECSUNTIL MAPGLOBALSKETCHSPECS
|
||||
MAPGLOBALSKETCHELEMENTS)
|
||||
(COMS (* ;
|
||||
"multiple selection and copy select functions")
|
||||
"multiple selection and copy select functions")
|
||||
(FNS SK.ADD.SELECTION SK.COPY.INSERTFN SCREENELEMENTP SK.ITEM.REGION
|
||||
SK.ELEMENT.GLOBAL.REGION SK.LOCAL.ITEMS.IN.REGION SK.REGIONFN SK.GLOBAL.REGIONFN
|
||||
SK.REMOVE.SELECTION SK.SELECT.MULTIPLE.ITEMS SKETCH.GET.ELEMENTS SK.PUT.MARKS.UP
|
||||
@@ -169,11 +169,10 @@ To abort loading the new version of Sketch, type '^'."]
|
||||
(CONSTANTS (SK.NO.MOVE.DISTANCE 4))
|
||||
(DECLARE%: DONTCOPY (RECORDS SKFIGUREIMAGE)))
|
||||
(COMS (* ;
|
||||
"stuff for changing the input scale")
|
||||
"stuff for changing the input scale")
|
||||
(FNS SK.INPUT.SCALE SK.UPDATE.SKETCHCONTEXT SK.SET.INPUT.SCALE
|
||||
SK.SET.INPUT.SCALE.CURRENT SK.SET.INPUT.SCALE.VALUE))
|
||||
(COMS (* ;
|
||||
"stuff for setting feedback amount")
|
||||
(COMS (* ; "stuff for setting feedback amount")
|
||||
(FNS SK.SET.FEEDBACK.MODE SK.SET.FEEDBACK.POINT SK.SET.FEEDBACK.VERBOSE
|
||||
SK.SET.FEEDBACK.ALWAYS)
|
||||
(INITVARS (SKETCH.VERBOSE.FEEDBACK T))
|
||||
@@ -181,8 +180,7 @@ To abort loading the new version of Sketch, type '^'."]
|
||||
(COMS (* ; "sketch icon support")
|
||||
(FNS SKETCH.TITLE SK.SHRINK.ICONCREATE)
|
||||
(UGLYVARS SKETCH.TITLED.ICON.TEMPLATE))
|
||||
(COMS (* ;
|
||||
"fns for reading in various values")
|
||||
(COMS (* ; "fns for reading in various values")
|
||||
(FNS READBRUSHSHAPE READ.FUNCTION READBRUSHSIZE READANGLE READARCDIRECTION)
|
||||
(FNS SK.CHANGE.DASHING READ.AND.SAVE.NEW.DASHING READ.NEW.DASHING READ.DASHING.CHANGE
|
||||
SK.CACHE.DASHING SK.DASHING.LABEL)
|
||||
@@ -195,8 +193,7 @@ To abort loading the new version of Sketch, type '^'."]
|
||||
(SK.CACHE.FILLING BLACKSHADE)
|
||||
(SK.CACHE.FILLING GRAYSHADE)
|
||||
(SK.CACHE.FILLING HIGHLIGHTSHADE)))
|
||||
(COMS (* ;
|
||||
"stuff for reading input positions")
|
||||
(COMS (* ; "stuff for reading input positions")
|
||||
(FNS SK.GETGLOBALPOSITION SKETCH.TRACK.ELEMENTS SK.PICKOUT.WHOLE.MOVE.ELEMENTS
|
||||
MAP.SKETCH.ELEMENTS.INTO.VIEWER MAP.GLOBAL.POSITION.INTO.VIEWER
|
||||
SKETCH.TO.VIEWER.POSITION SKETCH.TRACK.IMAGE SK.TRACK.IMAGE1
|
||||
@@ -207,7 +204,7 @@ To abort loading the new version of Sketch, type '^'."]
|
||||
)
|
||||
(RECORDS INPUTPT)
|
||||
(COMS (* ;
|
||||
"stuff to allow reading positions from a number pad")
|
||||
"stuff to allow reading positions from a number pad")
|
||||
(INITVARS (SKETCH.USE.POSITION.PAD NIL))
|
||||
(GLOBALVARS SKETCH.USE.POSITION.PAD)
|
||||
(FNS SK.BRING.UP.POSITION.PAD SK.PAD.READER.POSITION SK.POSITION.READER.REPAINTFN
|
||||
@@ -227,7 +224,7 @@ To abort loading the new version of Sketch, type '^'."]
|
||||
(UGLYVARS SK.SELECTEDMARK SK.LOCATEMARK COPYSELECTIONMARK MOVESELECTIONMARK
|
||||
DELETESELECTIONMARK OTHERCONTROLPOINTMARK)
|
||||
(* ;
|
||||
"accessing functions for the methods of a sketch type.")
|
||||
"accessing functions for the methods of a sketch type.")
|
||||
(FNS SK.DRAWFN SK.TRANSFORMFN SK.EXPANDFN SK.INPUT SK.INSIDEFN SK.UPDATEFN)
|
||||
(INITRECORDS SKETCHTYPE)
|
||||
(DECLARE%: DONTCOPY (RECORDS SCREENELT GLOBALPART COMMONGLOBALPART INDIVIDUALGLOBALPART
|
||||
@@ -253,7 +250,7 @@ To abort loading the new version of Sketch, type '^'."]
|
||||
SKETCHOPS SKETCHELEMENTS SKETCHOBJ
|
||||
SKETCHEDIT))
|
||||
(* ;
|
||||
"recompute the sketch element types because loading SKETCH clobbers the previous ones.")
|
||||
"recompute the sketch element types because loading SKETCH clobbers the previous ones.")
|
||||
(P (INIT.BITMAP.ELEMENT)
|
||||
(INIT.SKETCH.ELEMENTS)
|
||||
(INIT.GROUP.ELEMENT))
|
||||
@@ -265,14 +262,14 @@ To abort loading the new version of Sketch, type '^'."]
|
||||
(GLOBALVARS SKETCH.RECORD.LENGTHS)
|
||||
(P (SK.SET.RECORD.LENGTHS)))
|
||||
[COMS (* ;
|
||||
"to correct for a bug in the file package that marks LOADCOMPed file as changed")
|
||||
"to correct for a bug in the file package that marks LOADCOMPed file as changed")
|
||||
(P (UNMARKASCHANGED 'SKETCH 'FILE)
|
||||
(UNMARKASCHANGED 'SKETCHELEMENTS 'FILE)
|
||||
(UNMARKASCHANGED 'SKETCHOPS 'FILE)
|
||||
(UNMARKASCHANGED 'SKETCHEDIT 'FILE)
|
||||
(UNMARKASCHANGED 'SKETCHOBJ 'FILE]
|
||||
(COMS (* ;
|
||||
"add sketch as option to file browser edit command")
|
||||
"add sketch as option to file browser edit command")
|
||||
(FNS SK.ADD.EDIT.COMMAND.TO.FILE.BROWSER)
|
||||
(P (SK.ADD.EDIT.COMMAND.TO.FILE.BROWSER)))
|
||||
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA)
|
||||
@@ -449,10 +446,11 @@ To abort loading the new version of Sketch, type '^'."]
|
||||
(T (FILENAMELESSVERSION SKETCHFILENAME])
|
||||
|
||||
(SKETCH.PUT
|
||||
[LAMBDA (FILENAME SKETCH VIEWER REGION SCALE GRID) (* ; "Edited 17-Nov-87 17:47 by rrb")
|
||||
|
||||
(* puts the sketch SKETCH on the file named FILENAME.
|
||||
VIEWER if given provides promptwindows and PUTFNs.)
|
||||
[LAMBDA (FILENAME SKETCH VIEWER REGION SCALE GRID) (* ; "Edited 1-Feb-2022 09:17 by rmk")
|
||||
(* ; "Edited 17-Nov-87 17:47 by rrb")
|
||||
|
||||
(* puts the sketch SKETCH on the file named FILENAME.
|
||||
VIEWER if given provides promptwindows and PUTFNs.)
|
||||
|
||||
(PROG (TEXTSTREAM FILESTREAM)
|
||||
[COND
|
||||
@@ -463,14 +461,13 @@ To abort loading the new version of Sketch, type '^'."]
|
||||
(FILESLOAD TEDIT))
|
||||
(T (STATUSPRINT VIEWER "Sketch not saved.")
|
||||
(RETURN NIL]
|
||||
[SETQ TEXTSTREAM (OPENTEXTSTREAM "" NIL NIL NIL (AND VIEWER (LIST 'PUTFN
|
||||
(WINDOWPROP VIEWER
|
||||
'TEDIT.PUTFN)
|
||||
'PROMPTWINDOW
|
||||
(GETPROMPTWINDOW VIEWER]
|
||||
|
||||
(* make a text stream with nothing in it except the sketch.)
|
||||
|
||||
[SETQ TEXTSTREAM (OPENTEXTSTREAM NIL NIL NIL NIL (AND VIEWER (LIST 'PUTFN
|
||||
(WINDOWPROP VIEWER
|
||||
'TEDIT.PUTFN)
|
||||
'PROMPTWINDOW
|
||||
(GETPROMPTWINDOW VIEWER]
|
||||
(* make a text stream with nothing in
|
||||
it except the sketch.)
|
||||
(TEDIT.INSERT.OBJECT [SKETCH.IMAGEOBJ (INSURE.SKETCH SKETCH)
|
||||
(COND
|
||||
((REGIONP REGION))
|
||||
@@ -482,16 +479,17 @@ To abort loading the new version of Sketch, type '^'."]
|
||||
((NUMBERP GRID))
|
||||
(VIEWER (SK.GRIDFACTOR VIEWER]
|
||||
TEXTSTREAM 1)
|
||||
|
||||
(* set the margins so that if the user hardcopies it directly the margins
|
||||
come out)
|
||||
|
||||
(TEDIT.PARALOOKS TEXTSTREAM '(LEFTMARGIN 0 RIGHTMARGIN 0 QUAD CENTER) 1 1)
|
||||
(* set the margins so that if the user hardcopies it directly the margins come
|
||||
out)
|
||||
|
||||
(TEDIT.PARALOOKS TEXTSTREAM '(LEFTMARGIN 0 RIGHTMARGIN 0 QUAD CENTER)
|
||||
1 1)
|
||||
(TEDIT.PAGEFORMAT TEXTSTREAM (TEDIT.SINGLE.PAGEFORMAT NIL NIL NIL NIL NIL 0 0 0 0))
|
||||
(* save the stream so that it can be
|
||||
closed.)
|
||||
closed.)
|
||||
(SETQ FILESTREAM (TEDIT.PUT TEXTSTREAM FILENAME)) (* grab the full file name if it is
|
||||
available.)
|
||||
available.)
|
||||
(AND (OPENP FILESTREAM)
|
||||
(SETQ FILENAME (CLOSEF FILESTREAM)))
|
||||
(SK.MARK.UNDIRTY SKETCH)
|
||||
@@ -2345,7 +2343,7 @@ This will be slow for arcs and curves."]
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(PUTPROPS .DELETEKEYDOWNP. MACRO [NIL (OR (KEYDOWNP 'CTRL)
|
||||
(KEYDOWNP 'DELETE])
|
||||
(KEYDOWNP 'DELETE])
|
||||
|
||||
(PUTPROPS .MOVEKEYDOWNP. MACRO (NIL (KEYDOWNP 'MOVE)))
|
||||
)
|
||||
@@ -4546,7 +4544,7 @@ This will be slow for arcs and curves."]
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(PUTPROPS .SHIFTKEYDOWNP. MACRO [NIL (OR (KEYDOWNP 'LSHIFT)
|
||||
(KEYDOWNP 'RSHIFT])
|
||||
(KEYDOWNP 'RSHIFT])
|
||||
)
|
||||
(DEFINEQ
|
||||
|
||||
@@ -5472,7 +5470,7 @@ This will be slow for arcs and curves."]
|
||||
(TYPERECORD GROUP (GROUPREGION LISTOFGLOBALELTS GROUPCONTROLPOINT))
|
||||
|
||||
(RECORD LOCALGROUP ((GROUPPOSITION)
|
||||
LOCALHOTREGION LOCALGROUPREGION LOCALELEMENTS))
|
||||
LOCALHOTREGION LOCALGROUPREGION LOCALELEMENTS))
|
||||
)
|
||||
|
||||
|
||||
@@ -7782,12 +7780,12 @@ Enter 'Abort' to leave the dashing unchanged.")
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(RECORD INPUTPT (INPUT.ONGRID? INPUT.POSITION INPUT.GLOBALPOSITION)
|
||||
[TYPE? (AND (LISTP DATUM)
|
||||
(OR (NULL (CAR DATUM))
|
||||
(EQ (CAR DATUM)
|
||||
T))
|
||||
(LISTP (CDR DATUM))
|
||||
(POSITIONP (CADR DATUM])
|
||||
[TYPE? (AND (LISTP DATUM)
|
||||
(OR (NULL (CAR DATUM))
|
||||
(EQ (CAR DATUM)
|
||||
T))
|
||||
(LISTP (CDR DATUM))
|
||||
(POSITIONP (CADR DATUM])
|
||||
)
|
||||
|
||||
|
||||
@@ -8508,14 +8506,14 @@ Otherwise, type '^'.")
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(RECORD SCREENELT (LOCALPART . GLOBALPART)
|
||||
(RECORD GLOBALPART (COMMONGLOBALPART INDIVIDUALGLOBALPART)
|
||||
(RECORD INDIVIDUALGLOBALPART (GTYPE . GOTHERINFO))
|
||||
(RECORD COMMONGLOBALPART (MINSCALE MAXSCALE SKELEMENTPROPLIST)))
|
||||
(RECORD LOCALPART (HOTSPOTS LOCALHOTREGION . OTHERLOCALINFO)))
|
||||
(RECORD GLOBALPART (COMMONGLOBALPART INDIVIDUALGLOBALPART)
|
||||
(RECORD INDIVIDUALGLOBALPART (GTYPE . GOTHERINFO))
|
||||
(RECORD COMMONGLOBALPART (MINSCALE MAXSCALE SKELEMENTPROPLIST)))
|
||||
(RECORD LOCALPART (HOTSPOTS LOCALHOTREGION . OTHERLOCALINFO)))
|
||||
|
||||
(RECORD GLOBALPART (COMMONGLOBALPART INDIVIDUALGLOBALPART)
|
||||
(RECORD INDIVIDUALGLOBALPART (GTYPE . RESTOFGLOBALPART))
|
||||
(RECORD COMMONGLOBALPART (MINSCALE MAXSCALE SKELEMENTPROPLIST)))
|
||||
(RECORD INDIVIDUALGLOBALPART (GTYPE . RESTOFGLOBALPART))
|
||||
(RECORD COMMONGLOBALPART (MINSCALE MAXSCALE SKELEMENTPROPLIST)))
|
||||
|
||||
(RECORD COMMONGLOBALPART (MINSCALE MAXSCALE SKELEMENTPROPLIST))
|
||||
|
||||
@@ -8524,41 +8522,39 @@ Otherwise, type '^'.")
|
||||
(RECORD LOCALPART (HOTSPOTS LOCALHOTREGION . OTHERLOCALINFO))
|
||||
|
||||
(RECORD SKETCH (ALLSKETCHPROPS . SKETCHTCELL)
|
||||
[RECORD ALLSKETCHPROPS (SKETCHKEY SKETCHNAME . SKETCHPROPS)
|
||||
(CREATE (LIST 'SKETCH NIL 'VERSION SKETCH.VERSION 'PRIRANGE
|
||||
(CONS 0 0]
|
||||
[RECORD SKETCHTCELL (SKETCHELTS)
|
||||
(CREATE (CONS SKETCHELTS (LAST SKETCHELTS]
|
||||
[TYPE? (AND (LISTP DATUM)
|
||||
(LISTP (CAR DATUM))
|
||||
(EQ (CAAR DATUM)
|
||||
'SKETCH])
|
||||
[RECORD ALLSKETCHPROPS (SKETCHKEY SKETCHNAME . SKETCHPROPS)
|
||||
(CREATE (LIST 'SKETCH NIL 'VERSION SKETCH.VERSION 'PRIRANGE (CONS 0 0]
|
||||
[RECORD SKETCHTCELL (SKETCHELTS)
|
||||
(CREATE (CONS SKETCHELTS (LAST SKETCHELTS]
|
||||
[TYPE? (AND (LISTP DATUM)
|
||||
(LISTP (CAR DATUM))
|
||||
(EQ (CAAR DATUM)
|
||||
'SKETCH])
|
||||
|
||||
(DATATYPE SKETCHTYPE (LABEL (* the label if it is non-NIL will
|
||||
be used in the sketch menu.)
|
||||
DOCSTR (* if put in the menu, this is the
|
||||
help string for its item.)
|
||||
DRAWFN EXPANDFN obsolete CHANGEFN INPUTFN INSIDEFN REGIONFN
|
||||
TRANSLATEFN UPDATEFN READCHANGEFN TRANSFORMFN
|
||||
(* fn to transform the control
|
||||
points of an element.
|
||||
takes args Gelt Tranfn trandata.)
|
||||
TRANSLATEPTSFN
|
||||
(DATATYPE SKETCHTYPE (LABEL (* the label if it is non-NIL will be
|
||||
used in the sketch menu.)
|
||||
DOCSTR (* if put in the menu, this is the
|
||||
help string for its item.)
|
||||
DRAWFN EXPANDFN obsolete CHANGEFN INPUTFN INSIDEFN REGIONFN TRANSLATEFN
|
||||
UPDATEFN READCHANGEFN TRANSFORMFN
|
||||
(* fn to transform the control points
|
||||
of an element. takes args Gelt Tranfn
|
||||
trandata.)
|
||||
TRANSLATEPTSFN
|
||||
|
||||
(* fn to move some but not all points of a screen element.
|
||||
Takes args%: LocalSelectedPts GlobalDeltaToTranslate ScreenElt SketchWindow)
|
||||
Takes args%: LocalSelectedPts GlobalDeltaToTranslate ScreenElt SketchWindow)
|
||||
|
||||
GLOBALREGIONFN
|
||||
GLOBALREGIONFN
|
||||
|
||||
(* takes a GLOBAL element and returns the global region it occupies.
|
||||
Note%: this is the only fn that takes a global rather that a local element.)
|
||||
Note%: this is the only fn that takes a global rather that a local element.)
|
||||
|
||||
))
|
||||
))
|
||||
|
||||
(RECORD SKETCHCONTEXT (SKETCHBRUSH SKETCHFONT SKETCHTEXTALIGNMENT SKETCHARROWHEAD SKETCHDASHING
|
||||
SKETCHUSEARROWHEAD SKETCHTEXTBOXALIGNMENT SKETCHFILLING
|
||||
SKETCHLINEMODE SKETCHARCDIRECTION SKETCHMOVEMODE SKETCHINPUTSCALE
|
||||
SKETCHDRAWINGMODE))
|
||||
SKETCHUSEARROWHEAD SKETCHTEXTBOXALIGNMENT SKETCHFILLING SKETCHLINEMODE
|
||||
SKETCHARCDIRECTION SKETCHMOVEMODE SKETCHINPUTSCALE SKETCHDRAWINGMODE))
|
||||
)
|
||||
|
||||
(/DECLAREDATATYPE 'SKETCHTYPE
|
||||
@@ -8710,7 +8706,7 @@ Otherwise, type '^'.")
|
||||
(PUTPROPS SK.SET.RECORD.LENGTHS.MACRO MACRO
|
||||
[ARGS (CONS 'LIST (for X in SKETCH.ELEMENT.TYPE.NAMES
|
||||
collect (LIST 'LIST (KWOTE X)
|
||||
(LIST 'LENGTH (LIST 'CREATE X])
|
||||
(LIST 'LENGTH (LIST 'CREATE X])
|
||||
)
|
||||
(DECLARE%: DOEVAL@COMPILE DONTCOPY
|
||||
|
||||
@@ -8767,149 +8763,149 @@ Otherwise, type '^'.")
|
||||
)
|
||||
(PUTPROPS SKETCH COPYRIGHT ("Venue & Xerox Corporation" 1984 1985 1986 1987 1988 1990 1992 1993))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (22416 85555 (SKETCH 22426 . 24531) (SKETCH.FROM.A.FILE 24533 . 24848) (SKETCHW.CREATE
|
||||
24850 . 29424) (SKETCH.RESET 29426 . 30948) (SKETCHW.FIG.CHANGED 30950 . 31290) (SK.WINDOW.TITLE 31292
|
||||
. 31679) (EDITSLIDE 31681 . 32087) (EDITSKETCH 32089 . 32413) (SK.PUT.ON.FILE 32415 . 33867) (
|
||||
SK.OUTPUT.FILE.NAME 33869 . 34243) (SKETCH.PUT 34245 . 36919) (SK.GET.FROM.FILE 36921 . 37814) (
|
||||
SK.INCLUDE.FILE 37816 . 40324) (SK.GET.IMAGEOBJ.FROM.FILE 40326 . 42529) (SKETCH.GET 42531 . 42838) (
|
||||
ADD.SKETCH.TO.VIEWER 42840 . 45426) (FILENAMELESSVERSION 45428 . 45704) (SK.ADD.ELEMENTS.TO.SKETCH
|
||||
45706 . 46220) (SKETCH.SET.A.DEFAULT 46222 . 53380) (SK.POPUP.SELECTIONFN 53382 . 53924) (
|
||||
GETSKETCHWREGION 53926 . 54132) (SK.ADD.ELEMENT 54134 . 55713) (SK.ADD.PRIORITY.ELEMENT.TO.SKETCH
|
||||
55715 . 57109) (SK.ELTS.BY.PRIORITY 57111 . 57407) (SK.ORDER.ELEMENTS 57409 . 57676) (
|
||||
SK.ADD.PRIORITY.LOCAL.ELEMENT.TO.SKETCH 57678 . 59172) (SK.ADD.ELEMENTS 59174 . 59698) (
|
||||
SK.CHECK.WHENADDEDFN 59700 . 60430) (SK.APPLY.MENU.COMMAND 60432 . 61230) (SK.DELETE.ELEMENT1 61232 .
|
||||
62810) (SK.MARK.DIRTY 62812 . 63478) (SK.MARK.UNDIRTY 63480 . 63811) (SK.MENU.AND.RETURN.FIELD 63813
|
||||
. 64478) (SKETCH.SET.BRUSH.SHAPE 64480 . 65065) (SKETCH.SET.BRUSH.SIZE 65067 . 65573) (
|
||||
SKETCHW.CLOSEFN 65575 . 67366) (SK.CONFIRM.DESTRUCTION 67368 . 68367) (SKETCHW.OUTFN 68369 . 68633) (
|
||||
SKETCHW.REOPENFN 68635 . 69047) (MAKE.LOCAL.SKETCH 69049 . 69779) (MAP.SKETCHSPEC.INTO.VIEWER 69781 .
|
||||
70991) (SKETCHW.REPAINTFN 70993 . 71821) (SKETCHW.REPAINTFN1 71823 . 72762) (SK.DRAWFIGURE.IF 72764 .
|
||||
73286) (SKETCHW.SCROLLFN 73288 . 77481) (SKETCHW.RESHAPEFN 77483 . 79741) (SK.UPDATE.EVENT.SELECTION
|
||||
79743 . 81798) (LIGHTGRAYWINDOW 81800 . 81963) (SK.ADD.SPACES 81965 . 82711) (SK.SKETCH.MENU 82713 .
|
||||
83035) (SK.CHECK.IMAGEOBJ.WHENDELETEDFN 83037 . 83889) (SK.APPLY.IMAGEOBJ.WHENDELETEDFN 83891 . 84851)
|
||||
(SK.RETURN.TTY 84853 . 85221) (SK.TAKE.TTY 85223 . 85553)) (85609 108602 (SKETCH.COMMANDMENU 85619 .
|
||||
85956) (SKETCH.COMMANDMENU.ITEMS 85958 . 105706) (CREATE.SKETCHW.COMMANDMENU 105708 . 106128) (
|
||||
SKETCHW.SELECTIONFN 106130 . 107233) (SKETCH.MONITORLOCK 107235 . 107706) (SK.EVAL.AS.PROCESS 107708
|
||||
. 108321) (SK.EVAL.WITH.LOCK 108323 . 108600)) (108603 116407 (SK.FIX.MENU 108613 . 109707) (
|
||||
SK.SET.UP.MENUS 109709 . 112010) (SK.INSURE.HAS.MENU 112012 . 112674) (SK.CREATE.STANDARD.MENU 112676
|
||||
. 113121) (SK.ADD.ITEM.TO.MENU 113123 . 113798) (SK.GET.VIEWER.POPUP.MENU 113800 . 116001) (
|
||||
SK.CLEAR.POPUP.MENU 116003 . 116405)) (116463 125285 (SKETCH.CREATE 116473 . 117259) (GETSKETCHPROP
|
||||
117261 . 120318) (PUTSKETCHPROP 120320 . 124252) (CREATE.DEFAULT.SKETCH.CONTEXT 124254 . 125283)) (
|
||||
125451 148347 (SK.COPY.BUTTONEVENTFN 125461 . 136689) (SK.BUTTONEVENT.MARK 136691 . 137074) (
|
||||
SK.BUILD.IMAGEOBJ 137076 . 146991) (SK.BUTTONEVENT.OVERP 146993 . 147616) (SK.BUTTONEVENT.SAME.KEYS
|
||||
147618 . 148345)) (148634 174449 (SK.SEL.AND.CHANGE 148644 . 148936) (SK.CHECK.WHENCHANGEDFN 148938 .
|
||||
149644) (SK.CHECK.PRECHANGEFN 149646 . 150247) (SK.CHANGE.ELT 150249 . 150441) (SK.CHANGE.THING 150443
|
||||
. 151694) (SKETCH.CHANGE.ELEMENTS 151696 . 152879) (SK.APPLY.SINGLE.CHANGEFN 152881 . 153454) (
|
||||
SK.DO.CHANGESPECS 153456 . 155115) (SK.VIEWER.FROM.SKETCH.ARG 155117 . 155559) (SK.DO.CHANGESPEC1
|
||||
155561 . 157436) (SK.CHANGEFN 157438 . 158018) (SK.READCHANGEFN 158020 . 158479) (SK.DEFAULT.CHANGEFN
|
||||
158481 . 160953) (CHANGEABLEFIELDITEMS 160955 . 161602) (SK.APPLY.CHANGE.COMMAND 161604 . 162221) (
|
||||
SK.DO.AND.RECORD.CHANGES 162223 . 163620) (SK.APPLY.CHANGE.COMMAND1 163622 . 165110) (
|
||||
SK.ELEMENTS.CHANGEFN 165112 . 167436) (READ.POINT.TO.ADD 167438 . 168382) (GLOBAL.KNOT.FROM.LOCAL
|
||||
168384 . 168844) (SK.ADD.KNOT.TO.ELEMENT 168846 . 169790) (SK.GROUP.CHANGEFN 169792 . 171004) (
|
||||
SK.GROUP.CHANGEFN1 171006 . 174447)) (174616 188349 (ADD.ELEMENT.TO.SKETCH 174626 . 176332) (
|
||||
ADD.SKETCH.VIEWER 176334 . 177002) (REMOVE.SKETCH.VIEWER 177004 . 177617) (ALL.SKETCH.VIEWERS 177619
|
||||
. 177859) (SKETCH.ALL.VIEWERS 177861 . 178121) (VIEWER.BUCKET 178123 . 178274) (ELT.INSIDE.REGION?
|
||||
178276 . 178603) (ELT.INSIDE.SKWP 178605 . 178896) (SCALE.FROM.SKW 178898 . 179148) (
|
||||
SK.ADDELT.TO.WINDOW 179150 . 180010) (SK.CALC.REGION.VIEWED 180012 . 180390) (SK.DRAWFIGURE 180392 .
|
||||
181681) (SK.DRAWFIGURE1 181683 . 182067) (SK.LOCAL.FROM.GLOBAL 182069 . 183304) (SKETCH.REGION.VIEWED
|
||||
183306 . 185993) (SKETCH.VIEW.FROM.NAME 185995 . 186425) (SK.UPDATE.REGION.VIEWED 186427 . 186819) (
|
||||
SKETCH.ADD.AND.DISPLAY 186821 . 187229) (SKETCH.ADD.AND.DISPLAY1 187231 . 187669) (SK.ADD.ITEM 187671
|
||||
. 188003) (SKETCHW.ADD.INSTANCE 188005 . 188347)) (188390 201578 (SK.SEL.AND.DELETE 188400 . 188788)
|
||||
(SK.ERASE.AND.DELETE.ITEM 188790 . 189209) (REMOVE.ELEMENT.FROM.SKETCH 189211 . 190322) (
|
||||
SK.DELETE.ELEMENT 190324 . 190882) (SK.DELETE.ELEMENT2 190884 . 191545) (SK.DELETE.KNOT 191547 .
|
||||
191838) (SK.SEL.AND.DELETE.KNOT 191840 . 192965) (SK.DELETE.ELEMENT.KNOT 192967 . 196174) (
|
||||
SK.CHECK.WHENDELETEDFN 196176 . 196956) (SK.CHECK.PREEDITFN 196958 . 197442) (
|
||||
SK.CHECK.END.INITIAL.EDIT 197444 . 197978) (SK.CHECK.WHENPOINTDELETEDFN 197980 . 198776) (SK.ERASE.ELT
|
||||
198778 . 199114) (SK.DELETE.ELT 199116 . 199491) (SK.DELETE.ITEM 199493 . 199901) (DELFROMTCONC
|
||||
199903 . 201576)) (201617 215451 (SK.COPY.ELT 201627 . 201997) (SK.SEL.AND.COPY 201999 . 202382) (
|
||||
SK.COPY.ELEMENTS 202384 . 208012) (SK.ADD.COPY.OF.ELEMENTS 208014 . 209781) (
|
||||
SK.GLOBAL.FROM.LOCAL.ELEMENTS 209783 . 210023) (SK.COPY.ITEM 210025 . 210822) (SK.INSERT.SKETCH 210824
|
||||
. 215449)) (215491 245512 (SK.MOVE.ELT 215501 . 215776) (SK.MOVE.ELT.OR.PT 215778 . 216091) (
|
||||
SK.APPLY.DEFAULT.MOVE 216093 . 216527) (SK.SEL.AND.MOVE 216529 . 217076) (SK.MOVE.ELEMENTS 217078 .
|
||||
227950) (SKETCH.MOVE.ELEMENTS 227952 . 229883) (SKETCH.COPY.ELEMENTS 229885 . 231932) (
|
||||
\SKETCH.COPY.ELEMENT 231934 . 232659) (SK.TRANSLATE.ELEMENT 232661 . 233144) (SK.COPY.GLOBAL.ELEMENT
|
||||
233146 . 233357) (SK.MAKE.ELEMENT.MOVE.ARG 233359 . 233979) (SK.MAKE.ELEMENTS.MOVE.ARG 233981 . 234503
|
||||
) (SK.MAKE.POINTS.AND.ELEMENTS.MOVE.ARG 234505 . 235574) (SK.SHOW.FIG.FROM.INFO 235576 . 235944) (
|
||||
SK.MOVE.THING 235946 . 236852) (UPDATE.ELEMENT.IN.SKETCH 236854 . 238909) (SK.UPDATE.ELEMENT 238911 .
|
||||
240470) (SK.UPDATE.ELEMENTS 240472 . 241191) (SK.UPDATE.ELEMENT1 241193 . 245093) (
|
||||
SK.MOVE.ELEMENT.POINT 245095 . 245510)) (245575 267864 (SK.MOVE.POINTS 245585 . 245872) (
|
||||
SK.SEL.AND.MOVE.POINTS 245874 . 246179) (SK.DO.MOVE.ELEMENT.POINTS 246181 . 254838) (
|
||||
SK.MOVE.ITEM.POINTS 254840 . 256511) (SK.TRANSLATEPTSFN 256513 . 256897) (SK.TRANSLATE.POINTS 256899
|
||||
. 257800) (SK.SELECT.MULTIPLE.POINTS 257802 . 263442) (SK.CONTROL.POINTS.IN.REGION 263444 . 264865) (
|
||||
SK.ADD.PT.SELECTION 264867 . 265331) (SK.REMOVE.PT.SELECTION 265333 . 265950) (SK.ADD.POINT 265952 .
|
||||
266575) (SK.ELTS.CONTAINING.PTS 266577 . 267202) (SK.HOTSPOTS.NOT.ON.LIST 267204 . 267862)) (268030
|
||||
270826 (SK.SET.MOVE.MODE 268040 . 268711) (SK.SET.MOVE.MODE.POINTS 268713 . 269052) (
|
||||
SK.SET.MOVE.MODE.ELEMENTS 269054 . 269398) (SK.SET.MOVE.MODE.COMBINED 269400 . 269750) (READMOVEMODE
|
||||
269752 . 270824)) (270827 289582 (SK.ALIGN.POINTS 270837 . 271127) (SK.SEL.AND.ALIGN.POINTS 271129 .
|
||||
271438) (SK.ALIGN.POINTS.LEFT 271440 . 271743) (SK.ALIGN.POINTS.RIGHT 271745 . 272050) (
|
||||
SK.ALIGN.POINTS.TOP 272052 . 272353) (SK.ALIGN.POINTS.BOTTOM 272355 . 272662) (
|
||||
SK.EVEN.SPACE.POINTS.IN.X 272664 . 272984) (SK.EVEN.SPACE.POINTS.IN.Y 272986 . 273306) (
|
||||
SK.DO.ALIGN.POINTS 273308 . 283930) (SK.NTH.CONTROL.POINT 283932 . 284393) (
|
||||
SK.GET.SELECTED.ELEMENT.STRUCTURE 284395 . 285061) (SK.CORRESPONDING.CONTROL.PT 285063 . 285617) (
|
||||
SK.CONTROL.POINT.NUMBER 285619 . 285989) (SK.DO.ALIGN.SETVALUE 285991 . 289580)) (289646 303078 (
|
||||
SKETCH.CREATE.GROUP 289656 . 290145) (SK.CREATE.GROUP1 290147 . 290694) (SK.UPDATE.GROUP.AFTER.CHANGE
|
||||
290696 . 291485) (SK.GROUP.ELTS 291487 . 291768) (SK.SEL.AND.GROUP 291770 . 292156) (SK.GROUP.ELEMENTS
|
||||
292158 . 293807) (SK.UNGROUP.ELT 293809 . 294093) (SK.SEL.AND.UNGROUP 294095 . 295764) (
|
||||
SK.UNGROUP.ELEMENT 295766 . 296702) (SK.GLOBAL.REGION.OF.LOCAL.ELEMENTS 296704 . 297626) (
|
||||
SK.LOCAL.REGION.OF.LOCAL.ELEMENTS 297628 . 298639) (SK.GLOBAL.REGION.OF.GLOBAL.ELEMENTS 298641 .
|
||||
299981) (SK.UNIONREGIONS 299983 . 302349) (SKETCH.REGION.OF.SKETCH 302351 . 302767) (SK.FLASHREGION
|
||||
302769 . 303076)) (303079 316550 (INIT.GROUP.ELEMENT 303089 . 303961) (GROUP.DRAWFN 303963 . 304413) (
|
||||
GROUP.EXPANDFN 304415 . 305978) (GROUP.INSIDEFN 305980 . 306389) (GROUP.REGIONFN 306391 . 306786) (
|
||||
GROUP.GLOBALREGIONFN 306788 . 307106) (GROUP.TRANSLATEFN 307108 . 309140) (GROUP.TRANSFORMFN 309142 .
|
||||
312622) (GROUP.READCHANGEFN 312624 . 316548)) (316551 317559 (REGION.CENTER 316561 . 317162) (
|
||||
REMOVE.LAST 317164 . 317557)) (317612 322719 (SK.MOVE.GROUP.CONTROL.PT 317622 . 317913) (
|
||||
SK.SEL.AND.MOVE.CONTROL.PT 317915 . 319319) (SK.MOVE.GROUP.ELEMENT.CONTROL.POINT 319321 . 321394) (
|
||||
SK.READ.NEW.GROUP.CONTROL.PT 321396 . 322717)) (322982 327606 (SK.DO.GROUP 322992 . 324444) (
|
||||
SK.CHECK.WHENGROUPEDFN 324446 . 325156) (SK.DO.UNGROUP 325158 . 326363) (SK.CHECK.WHENUNGROUPEDFN
|
||||
326365 . 326952) (SK.GROUP.UNDO 326954 . 327277) (SK.UNGROUP.UNDO 327279 . 327604)) (327847 332769 (
|
||||
SK.FREEZE.ELTS 327857 . 328141) (SK.SEL.AND.FREEZE 328143 . 328533) (SK.FREEZE.ELEMENTS 328535 .
|
||||
329086) (SK.UNFREEZE.ELT 329088 . 329377) (SK.SEL.AND.UNFREEZE 329379 . 330915) (SK.UNFREEZE.ELEMENTS
|
||||
330917 . 331476) (SK.FREEZE.UNDO 331478 . 331723) (SK.UNFREEZE.UNDO 331725 . 331972) (SK.DO.FREEZE
|
||||
331974 . 332367) (SK.DO.UNFREEZE 332369 . 332767)) (332999 342809 (SKETCH.ELEMENTS.OF.SKETCH 333009 .
|
||||
333844) (SKETCH.LIST.OF.ELEMENTS 333846 . 334564) (SKETCH.ADD.ELEMENT 334566 . 335641) (
|
||||
SKETCH.DELETE.ELEMENT 335643 . 337375) (DELFROMGROUPELT 337377 . 338177) (SKETCH.ELEMENT.TYPE 338179
|
||||
. 338528) (SKETCH.ELEMENT.CHANGED 338530 . 340098) (SK.ELEMENT.CHANGED1 340100 . 340751) (
|
||||
SK.UPDATE.GLOBAL.IMAGE.OBJECT.ELEMENT 340753 . 342807)) (342863 347475 (INSURE.SKETCH 342873 . 345488)
|
||||
(LOCALSPECS.FROM.VIEWER 345490 . 345850) (SK.LOCAL.ELT.FROM.GLOBALPART 345852 . 346320) (
|
||||
SKETCH.FROM.VIEWER 346322 . 346556) (INSPECT.SKETCH 346558 . 346883) (ELT.INSIDE.SKETCHWP 346885 .
|
||||
347158) (SK.INSIDE.REGION 347160 . 347473)) (347476 351806 (MAPSKETCHSPECS 347486 . 348107) (
|
||||
MAPCOLLECTSKETCHSPECS 348109 . 348858) (MAPSKETCHSPECSUNTIL 348860 . 349668) (MAPGLOBALSKETCHSPECS
|
||||
349670 . 350371) (MAPGLOBALSKETCHELEMENTS 350373 . 351804)) (351868 377760 (SK.ADD.SELECTION 351878 .
|
||||
352618) (SK.COPY.INSERTFN 352620 . 356251) (SCREENELEMENTP 356253 . 356726) (SK.ITEM.REGION 356728 .
|
||||
357215) (SK.ELEMENT.GLOBAL.REGION 357217 . 357745) (SK.LOCAL.ITEMS.IN.REGION 357747 . 359726) (
|
||||
SK.REGIONFN 359728 . 360050) (SK.GLOBAL.REGIONFN 360052 . 360410) (SK.REMOVE.SELECTION 360412 . 361140
|
||||
) (SK.SELECT.MULTIPLE.ITEMS 361142 . 371584) (SKETCH.GET.ELEMENTS 371586 . 373009) (SK.PUT.MARKS.UP
|
||||
373011 . 373350) (SK.TAKE.MARKS.DOWN 373352 . 373691) (SK.TRANSLATE.GLOBALPART 373693 . 375820) (
|
||||
SK.TRANSLATE.ITEM 375822 . 376749) (SK.TRANSLATEFN 376751 . 376947) (TRANSLATE.SKETCH 376949 . 377758)
|
||||
) (378026 380933 (SK.INPUT.SCALE 378036 . 378883) (SK.UPDATE.SKETCHCONTEXT 378885 . 379482) (
|
||||
SK.SET.INPUT.SCALE 379484 . 380133) (SK.SET.INPUT.SCALE.CURRENT 380135 . 380426) (
|
||||
SK.SET.INPUT.SCALE.VALUE 380428 . 380931)) (380984 382896 (SK.SET.FEEDBACK.MODE 380994 . 382300) (
|
||||
SK.SET.FEEDBACK.POINT 382302 . 382470) (SK.SET.FEEDBACK.VERBOSE 382472 . 382641) (
|
||||
SK.SET.FEEDBACK.ALWAYS 382643 . 382894)) (383047 384324 (SKETCH.TITLE 383057 . 383320) (
|
||||
SK.SHRINK.ICONCREATE 383322 . 384322)) (390014 392828 (READBRUSHSHAPE 390024 . 390483) (READ.FUNCTION
|
||||
390485 . 391000) (READBRUSHSIZE 391002 . 391460) (READANGLE 391462 . 391954) (READARCDIRECTION 391956
|
||||
. 392826)) (392829 403240 (SK.CHANGE.DASHING 392839 . 396787) (READ.AND.SAVE.NEW.DASHING 396789 .
|
||||
398557) (READ.NEW.DASHING 398559 . 400299) (READ.DASHING.CHANGE 400301 . 401776) (SK.CACHE.DASHING
|
||||
401778 . 402780) (SK.DASHING.LABEL 402782 . 403238)) (403241 406946 (READ.FILLING.CHANGE 403251 .
|
||||
405232) (SK.CACHE.FILLING 405234 . 405952) (READ.AND.SAVE.NEW.FILLING 405954 . 406552) (
|
||||
SK.FILLING.LABEL 406554 . 406944)) (407330 443583 (SK.GETGLOBALPOSITION 407340 . 407645) (
|
||||
SKETCH.TRACK.ELEMENTS 407647 . 411167) (SK.PICKOUT.WHOLE.MOVE.ELEMENTS 411169 . 411728) (
|
||||
MAP.SKETCH.ELEMENTS.INTO.VIEWER 411730 . 412122) (MAP.GLOBAL.POSITION.INTO.VIEWER 412124 . 412504) (
|
||||
SKETCH.TO.VIEWER.POSITION 412506 . 412865) (SKETCH.TRACK.IMAGE 412867 . 413721) (SK.TRACK.IMAGE1
|
||||
413723 . 415135) (MAP.VIEWER.XY.INTO.GLOBAL 415137 . 416131) (SK.SET.POSITION 416133 . 416469) (
|
||||
MAP.VIEWER.PT.INTO.GLOBAL 416471 . 417577) (VIEWER.TO.SKETCH.POSITION 417579 . 418214) (
|
||||
SK.INSURE.SCALE 418216 . 418476) (SKETCH.TO.VIEWER.REGION 418478 . 419284) (VIEWER.TO.SKETCH.REGION
|
||||
419286 . 419624) (SK.READ.POINT.WITH.FEEDBACK 419626 . 430629) (SKETCH.GET.POSITION 430631 . 432511) (
|
||||
\CLOBBER.POSITION 432513 . 432961) (NEAREST.HOT.SPOT 432963 . 434491) (GETWREGION 434493 . 435254) (
|
||||
GET.BITMAP.POSITION 435256 . 436040) (SK.TRACK.BITMAP1 436042 . 443581)) (444196 475082 (
|
||||
SK.BRING.UP.POSITION.PAD 444206 . 450066) (SK.PAD.READER.POSITION 450068 . 451717) (
|
||||
SK.POSITION.READER.REPAINTFN 451719 . 453503) (SK.POSITION.PAD.FROM.VIEWER 453505 . 454847) (
|
||||
SK.INIT.POSITION.NUMBER.PAD.MENU 454849 . 455199) (SK.READ.POSITION.PAD.HANDLER 455201 . 460933) (
|
||||
DISPLAY.POSITION.READER.TOTAL 460935 . 463233) (POSITION.PAD.READER.HANDLER 463235 . 471278) (
|
||||
POSITIONPAD.HELDFN 471280 . 472764) (\POSITION.PAD.ADD.DIGIT.MENU 472766 . 474345) (
|
||||
\POSITION.READER.NUMBERPAD 474347 . 475080)) (476708 479386 (SK.DRAWFN 476718 . 477084) (
|
||||
SK.TRANSFORMFN 477086 . 477467) (SK.EXPANDFN 477469 . 477746) (SK.INPUT 477748 . 478129) (SK.INSIDEFN
|
||||
478131 . 478771) (SK.UPDATEFN 478773 . 479384)) (485115 489060 (SK.CHECK.SKETCH.VERSION 485125 .
|
||||
486365) (SK.INSURE.RECORD.LENGTH 486367 . 487850) (SK.INSURE.HAS.LENGTH 487852 . 488590) (
|
||||
SK.RECORD.LENGTH 488592 . 488766) (SK.SET.RECORD.LENGTHS 488768 . 489058)) (489805 490692 (
|
||||
SK.ADD.EDIT.COMMAND.TO.FILE.BROWSER 489815 . 490690)))))
|
||||
(FILEMAP (NIL (22155 85518 (SKETCH 22165 . 24270) (SKETCH.FROM.A.FILE 24272 . 24587) (SKETCHW.CREATE
|
||||
24589 . 29163) (SKETCH.RESET 29165 . 30687) (SKETCHW.FIG.CHANGED 30689 . 31029) (SK.WINDOW.TITLE 31031
|
||||
. 31418) (EDITSLIDE 31420 . 31826) (EDITSKETCH 31828 . 32152) (SK.PUT.ON.FILE 32154 . 33606) (
|
||||
SK.OUTPUT.FILE.NAME 33608 . 33982) (SKETCH.PUT 33984 . 36882) (SK.GET.FROM.FILE 36884 . 37777) (
|
||||
SK.INCLUDE.FILE 37779 . 40287) (SK.GET.IMAGEOBJ.FROM.FILE 40289 . 42492) (SKETCH.GET 42494 . 42801) (
|
||||
ADD.SKETCH.TO.VIEWER 42803 . 45389) (FILENAMELESSVERSION 45391 . 45667) (SK.ADD.ELEMENTS.TO.SKETCH
|
||||
45669 . 46183) (SKETCH.SET.A.DEFAULT 46185 . 53343) (SK.POPUP.SELECTIONFN 53345 . 53887) (
|
||||
GETSKETCHWREGION 53889 . 54095) (SK.ADD.ELEMENT 54097 . 55676) (SK.ADD.PRIORITY.ELEMENT.TO.SKETCH
|
||||
55678 . 57072) (SK.ELTS.BY.PRIORITY 57074 . 57370) (SK.ORDER.ELEMENTS 57372 . 57639) (
|
||||
SK.ADD.PRIORITY.LOCAL.ELEMENT.TO.SKETCH 57641 . 59135) (SK.ADD.ELEMENTS 59137 . 59661) (
|
||||
SK.CHECK.WHENADDEDFN 59663 . 60393) (SK.APPLY.MENU.COMMAND 60395 . 61193) (SK.DELETE.ELEMENT1 61195 .
|
||||
62773) (SK.MARK.DIRTY 62775 . 63441) (SK.MARK.UNDIRTY 63443 . 63774) (SK.MENU.AND.RETURN.FIELD 63776
|
||||
. 64441) (SKETCH.SET.BRUSH.SHAPE 64443 . 65028) (SKETCH.SET.BRUSH.SIZE 65030 . 65536) (
|
||||
SKETCHW.CLOSEFN 65538 . 67329) (SK.CONFIRM.DESTRUCTION 67331 . 68330) (SKETCHW.OUTFN 68332 . 68596) (
|
||||
SKETCHW.REOPENFN 68598 . 69010) (MAKE.LOCAL.SKETCH 69012 . 69742) (MAP.SKETCHSPEC.INTO.VIEWER 69744 .
|
||||
70954) (SKETCHW.REPAINTFN 70956 . 71784) (SKETCHW.REPAINTFN1 71786 . 72725) (SK.DRAWFIGURE.IF 72727 .
|
||||
73249) (SKETCHW.SCROLLFN 73251 . 77444) (SKETCHW.RESHAPEFN 77446 . 79704) (SK.UPDATE.EVENT.SELECTION
|
||||
79706 . 81761) (LIGHTGRAYWINDOW 81763 . 81926) (SK.ADD.SPACES 81928 . 82674) (SK.SKETCH.MENU 82676 .
|
||||
82998) (SK.CHECK.IMAGEOBJ.WHENDELETEDFN 83000 . 83852) (SK.APPLY.IMAGEOBJ.WHENDELETEDFN 83854 . 84814)
|
||||
(SK.RETURN.TTY 84816 . 85184) (SK.TAKE.TTY 85186 . 85516)) (85572 108565 (SKETCH.COMMANDMENU 85582 .
|
||||
85919) (SKETCH.COMMANDMENU.ITEMS 85921 . 105669) (CREATE.SKETCHW.COMMANDMENU 105671 . 106091) (
|
||||
SKETCHW.SELECTIONFN 106093 . 107196) (SKETCH.MONITORLOCK 107198 . 107669) (SK.EVAL.AS.PROCESS 107671
|
||||
. 108284) (SK.EVAL.WITH.LOCK 108286 . 108563)) (108566 116370 (SK.FIX.MENU 108576 . 109670) (
|
||||
SK.SET.UP.MENUS 109672 . 111973) (SK.INSURE.HAS.MENU 111975 . 112637) (SK.CREATE.STANDARD.MENU 112639
|
||||
. 113084) (SK.ADD.ITEM.TO.MENU 113086 . 113761) (SK.GET.VIEWER.POPUP.MENU 113763 . 115964) (
|
||||
SK.CLEAR.POPUP.MENU 115966 . 116368)) (116426 125248 (SKETCH.CREATE 116436 . 117222) (GETSKETCHPROP
|
||||
117224 . 120281) (PUTSKETCHPROP 120283 . 124215) (CREATE.DEFAULT.SKETCH.CONTEXT 124217 . 125246)) (
|
||||
125414 148310 (SK.COPY.BUTTONEVENTFN 125424 . 136652) (SK.BUTTONEVENT.MARK 136654 . 137037) (
|
||||
SK.BUILD.IMAGEOBJ 137039 . 146954) (SK.BUTTONEVENT.OVERP 146956 . 147579) (SK.BUTTONEVENT.SAME.KEYS
|
||||
147581 . 148308)) (148589 174404 (SK.SEL.AND.CHANGE 148599 . 148891) (SK.CHECK.WHENCHANGEDFN 148893 .
|
||||
149599) (SK.CHECK.PRECHANGEFN 149601 . 150202) (SK.CHANGE.ELT 150204 . 150396) (SK.CHANGE.THING 150398
|
||||
. 151649) (SKETCH.CHANGE.ELEMENTS 151651 . 152834) (SK.APPLY.SINGLE.CHANGEFN 152836 . 153409) (
|
||||
SK.DO.CHANGESPECS 153411 . 155070) (SK.VIEWER.FROM.SKETCH.ARG 155072 . 155514) (SK.DO.CHANGESPEC1
|
||||
155516 . 157391) (SK.CHANGEFN 157393 . 157973) (SK.READCHANGEFN 157975 . 158434) (SK.DEFAULT.CHANGEFN
|
||||
158436 . 160908) (CHANGEABLEFIELDITEMS 160910 . 161557) (SK.APPLY.CHANGE.COMMAND 161559 . 162176) (
|
||||
SK.DO.AND.RECORD.CHANGES 162178 . 163575) (SK.APPLY.CHANGE.COMMAND1 163577 . 165065) (
|
||||
SK.ELEMENTS.CHANGEFN 165067 . 167391) (READ.POINT.TO.ADD 167393 . 168337) (GLOBAL.KNOT.FROM.LOCAL
|
||||
168339 . 168799) (SK.ADD.KNOT.TO.ELEMENT 168801 . 169745) (SK.GROUP.CHANGEFN 169747 . 170959) (
|
||||
SK.GROUP.CHANGEFN1 170961 . 174402)) (174571 188304 (ADD.ELEMENT.TO.SKETCH 174581 . 176287) (
|
||||
ADD.SKETCH.VIEWER 176289 . 176957) (REMOVE.SKETCH.VIEWER 176959 . 177572) (ALL.SKETCH.VIEWERS 177574
|
||||
. 177814) (SKETCH.ALL.VIEWERS 177816 . 178076) (VIEWER.BUCKET 178078 . 178229) (ELT.INSIDE.REGION?
|
||||
178231 . 178558) (ELT.INSIDE.SKWP 178560 . 178851) (SCALE.FROM.SKW 178853 . 179103) (
|
||||
SK.ADDELT.TO.WINDOW 179105 . 179965) (SK.CALC.REGION.VIEWED 179967 . 180345) (SK.DRAWFIGURE 180347 .
|
||||
181636) (SK.DRAWFIGURE1 181638 . 182022) (SK.LOCAL.FROM.GLOBAL 182024 . 183259) (SKETCH.REGION.VIEWED
|
||||
183261 . 185948) (SKETCH.VIEW.FROM.NAME 185950 . 186380) (SK.UPDATE.REGION.VIEWED 186382 . 186774) (
|
||||
SKETCH.ADD.AND.DISPLAY 186776 . 187184) (SKETCH.ADD.AND.DISPLAY1 187186 . 187624) (SK.ADD.ITEM 187626
|
||||
. 187958) (SKETCHW.ADD.INSTANCE 187960 . 188302)) (188345 201533 (SK.SEL.AND.DELETE 188355 . 188743)
|
||||
(SK.ERASE.AND.DELETE.ITEM 188745 . 189164) (REMOVE.ELEMENT.FROM.SKETCH 189166 . 190277) (
|
||||
SK.DELETE.ELEMENT 190279 . 190837) (SK.DELETE.ELEMENT2 190839 . 191500) (SK.DELETE.KNOT 191502 .
|
||||
191793) (SK.SEL.AND.DELETE.KNOT 191795 . 192920) (SK.DELETE.ELEMENT.KNOT 192922 . 196129) (
|
||||
SK.CHECK.WHENDELETEDFN 196131 . 196911) (SK.CHECK.PREEDITFN 196913 . 197397) (
|
||||
SK.CHECK.END.INITIAL.EDIT 197399 . 197933) (SK.CHECK.WHENPOINTDELETEDFN 197935 . 198731) (SK.ERASE.ELT
|
||||
198733 . 199069) (SK.DELETE.ELT 199071 . 199446) (SK.DELETE.ITEM 199448 . 199856) (DELFROMTCONC
|
||||
199858 . 201531)) (201572 215406 (SK.COPY.ELT 201582 . 201952) (SK.SEL.AND.COPY 201954 . 202337) (
|
||||
SK.COPY.ELEMENTS 202339 . 207967) (SK.ADD.COPY.OF.ELEMENTS 207969 . 209736) (
|
||||
SK.GLOBAL.FROM.LOCAL.ELEMENTS 209738 . 209978) (SK.COPY.ITEM 209980 . 210777) (SK.INSERT.SKETCH 210779
|
||||
. 215404)) (215446 245467 (SK.MOVE.ELT 215456 . 215731) (SK.MOVE.ELT.OR.PT 215733 . 216046) (
|
||||
SK.APPLY.DEFAULT.MOVE 216048 . 216482) (SK.SEL.AND.MOVE 216484 . 217031) (SK.MOVE.ELEMENTS 217033 .
|
||||
227905) (SKETCH.MOVE.ELEMENTS 227907 . 229838) (SKETCH.COPY.ELEMENTS 229840 . 231887) (
|
||||
\SKETCH.COPY.ELEMENT 231889 . 232614) (SK.TRANSLATE.ELEMENT 232616 . 233099) (SK.COPY.GLOBAL.ELEMENT
|
||||
233101 . 233312) (SK.MAKE.ELEMENT.MOVE.ARG 233314 . 233934) (SK.MAKE.ELEMENTS.MOVE.ARG 233936 . 234458
|
||||
) (SK.MAKE.POINTS.AND.ELEMENTS.MOVE.ARG 234460 . 235529) (SK.SHOW.FIG.FROM.INFO 235531 . 235899) (
|
||||
SK.MOVE.THING 235901 . 236807) (UPDATE.ELEMENT.IN.SKETCH 236809 . 238864) (SK.UPDATE.ELEMENT 238866 .
|
||||
240425) (SK.UPDATE.ELEMENTS 240427 . 241146) (SK.UPDATE.ELEMENT1 241148 . 245048) (
|
||||
SK.MOVE.ELEMENT.POINT 245050 . 245465)) (245530 267819 (SK.MOVE.POINTS 245540 . 245827) (
|
||||
SK.SEL.AND.MOVE.POINTS 245829 . 246134) (SK.DO.MOVE.ELEMENT.POINTS 246136 . 254793) (
|
||||
SK.MOVE.ITEM.POINTS 254795 . 256466) (SK.TRANSLATEPTSFN 256468 . 256852) (SK.TRANSLATE.POINTS 256854
|
||||
. 257755) (SK.SELECT.MULTIPLE.POINTS 257757 . 263397) (SK.CONTROL.POINTS.IN.REGION 263399 . 264820) (
|
||||
SK.ADD.PT.SELECTION 264822 . 265286) (SK.REMOVE.PT.SELECTION 265288 . 265905) (SK.ADD.POINT 265907 .
|
||||
266530) (SK.ELTS.CONTAINING.PTS 266532 . 267157) (SK.HOTSPOTS.NOT.ON.LIST 267159 . 267817)) (267977
|
||||
270773 (SK.SET.MOVE.MODE 267987 . 268658) (SK.SET.MOVE.MODE.POINTS 268660 . 268999) (
|
||||
SK.SET.MOVE.MODE.ELEMENTS 269001 . 269345) (SK.SET.MOVE.MODE.COMBINED 269347 . 269697) (READMOVEMODE
|
||||
269699 . 270771)) (270774 289529 (SK.ALIGN.POINTS 270784 . 271074) (SK.SEL.AND.ALIGN.POINTS 271076 .
|
||||
271385) (SK.ALIGN.POINTS.LEFT 271387 . 271690) (SK.ALIGN.POINTS.RIGHT 271692 . 271997) (
|
||||
SK.ALIGN.POINTS.TOP 271999 . 272300) (SK.ALIGN.POINTS.BOTTOM 272302 . 272609) (
|
||||
SK.EVEN.SPACE.POINTS.IN.X 272611 . 272931) (SK.EVEN.SPACE.POINTS.IN.Y 272933 . 273253) (
|
||||
SK.DO.ALIGN.POINTS 273255 . 283877) (SK.NTH.CONTROL.POINT 283879 . 284340) (
|
||||
SK.GET.SELECTED.ELEMENT.STRUCTURE 284342 . 285008) (SK.CORRESPONDING.CONTROL.PT 285010 . 285564) (
|
||||
SK.CONTROL.POINT.NUMBER 285566 . 285936) (SK.DO.ALIGN.SETVALUE 285938 . 289527)) (289593 303025 (
|
||||
SKETCH.CREATE.GROUP 289603 . 290092) (SK.CREATE.GROUP1 290094 . 290641) (SK.UPDATE.GROUP.AFTER.CHANGE
|
||||
290643 . 291432) (SK.GROUP.ELTS 291434 . 291715) (SK.SEL.AND.GROUP 291717 . 292103) (SK.GROUP.ELEMENTS
|
||||
292105 . 293754) (SK.UNGROUP.ELT 293756 . 294040) (SK.SEL.AND.UNGROUP 294042 . 295711) (
|
||||
SK.UNGROUP.ELEMENT 295713 . 296649) (SK.GLOBAL.REGION.OF.LOCAL.ELEMENTS 296651 . 297573) (
|
||||
SK.LOCAL.REGION.OF.LOCAL.ELEMENTS 297575 . 298586) (SK.GLOBAL.REGION.OF.GLOBAL.ELEMENTS 298588 .
|
||||
299928) (SK.UNIONREGIONS 299930 . 302296) (SKETCH.REGION.OF.SKETCH 302298 . 302714) (SK.FLASHREGION
|
||||
302716 . 303023)) (303026 316497 (INIT.GROUP.ELEMENT 303036 . 303908) (GROUP.DRAWFN 303910 . 304360) (
|
||||
GROUP.EXPANDFN 304362 . 305925) (GROUP.INSIDEFN 305927 . 306336) (GROUP.REGIONFN 306338 . 306733) (
|
||||
GROUP.GLOBALREGIONFN 306735 . 307053) (GROUP.TRANSLATEFN 307055 . 309087) (GROUP.TRANSFORMFN 309089 .
|
||||
312569) (GROUP.READCHANGEFN 312571 . 316495)) (316498 317506 (REGION.CENTER 316508 . 317109) (
|
||||
REMOVE.LAST 317111 . 317504)) (317559 322666 (SK.MOVE.GROUP.CONTROL.PT 317569 . 317860) (
|
||||
SK.SEL.AND.MOVE.CONTROL.PT 317862 . 319266) (SK.MOVE.GROUP.ELEMENT.CONTROL.POINT 319268 . 321341) (
|
||||
SK.READ.NEW.GROUP.CONTROL.PT 321343 . 322664)) (322925 327549 (SK.DO.GROUP 322935 . 324387) (
|
||||
SK.CHECK.WHENGROUPEDFN 324389 . 325099) (SK.DO.UNGROUP 325101 . 326306) (SK.CHECK.WHENUNGROUPEDFN
|
||||
326308 . 326895) (SK.GROUP.UNDO 326897 . 327220) (SK.UNGROUP.UNDO 327222 . 327547)) (327790 332712 (
|
||||
SK.FREEZE.ELTS 327800 . 328084) (SK.SEL.AND.FREEZE 328086 . 328476) (SK.FREEZE.ELEMENTS 328478 .
|
||||
329029) (SK.UNFREEZE.ELT 329031 . 329320) (SK.SEL.AND.UNFREEZE 329322 . 330858) (SK.UNFREEZE.ELEMENTS
|
||||
330860 . 331419) (SK.FREEZE.UNDO 331421 . 331666) (SK.UNFREEZE.UNDO 331668 . 331915) (SK.DO.FREEZE
|
||||
331917 . 332310) (SK.DO.UNFREEZE 332312 . 332710)) (332942 342752 (SKETCH.ELEMENTS.OF.SKETCH 332952 .
|
||||
333787) (SKETCH.LIST.OF.ELEMENTS 333789 . 334507) (SKETCH.ADD.ELEMENT 334509 . 335584) (
|
||||
SKETCH.DELETE.ELEMENT 335586 . 337318) (DELFROMGROUPELT 337320 . 338120) (SKETCH.ELEMENT.TYPE 338122
|
||||
. 338471) (SKETCH.ELEMENT.CHANGED 338473 . 340041) (SK.ELEMENT.CHANGED1 340043 . 340694) (
|
||||
SK.UPDATE.GLOBAL.IMAGE.OBJECT.ELEMENT 340696 . 342750)) (342806 347418 (INSURE.SKETCH 342816 . 345431)
|
||||
(LOCALSPECS.FROM.VIEWER 345433 . 345793) (SK.LOCAL.ELT.FROM.GLOBALPART 345795 . 346263) (
|
||||
SKETCH.FROM.VIEWER 346265 . 346499) (INSPECT.SKETCH 346501 . 346826) (ELT.INSIDE.SKETCHWP 346828 .
|
||||
347101) (SK.INSIDE.REGION 347103 . 347416)) (347419 351749 (MAPSKETCHSPECS 347429 . 348050) (
|
||||
MAPCOLLECTSKETCHSPECS 348052 . 348801) (MAPSKETCHSPECSUNTIL 348803 . 349611) (MAPGLOBALSKETCHSPECS
|
||||
349613 . 350314) (MAPGLOBALSKETCHELEMENTS 350316 . 351747)) (351811 377703 (SK.ADD.SELECTION 351821 .
|
||||
352561) (SK.COPY.INSERTFN 352563 . 356194) (SCREENELEMENTP 356196 . 356669) (SK.ITEM.REGION 356671 .
|
||||
357158) (SK.ELEMENT.GLOBAL.REGION 357160 . 357688) (SK.LOCAL.ITEMS.IN.REGION 357690 . 359669) (
|
||||
SK.REGIONFN 359671 . 359993) (SK.GLOBAL.REGIONFN 359995 . 360353) (SK.REMOVE.SELECTION 360355 . 361083
|
||||
) (SK.SELECT.MULTIPLE.ITEMS 361085 . 371527) (SKETCH.GET.ELEMENTS 371529 . 372952) (SK.PUT.MARKS.UP
|
||||
372954 . 373293) (SK.TAKE.MARKS.DOWN 373295 . 373634) (SK.TRANSLATE.GLOBALPART 373636 . 375763) (
|
||||
SK.TRANSLATE.ITEM 375765 . 376692) (SK.TRANSLATEFN 376694 . 376890) (TRANSLATE.SKETCH 376892 . 377701)
|
||||
) (377969 380876 (SK.INPUT.SCALE 377979 . 378826) (SK.UPDATE.SKETCHCONTEXT 378828 . 379425) (
|
||||
SK.SET.INPUT.SCALE 379427 . 380076) (SK.SET.INPUT.SCALE.CURRENT 380078 . 380369) (
|
||||
SK.SET.INPUT.SCALE.VALUE 380371 . 380874)) (380927 382839 (SK.SET.FEEDBACK.MODE 380937 . 382243) (
|
||||
SK.SET.FEEDBACK.POINT 382245 . 382413) (SK.SET.FEEDBACK.VERBOSE 382415 . 382584) (
|
||||
SK.SET.FEEDBACK.ALWAYS 382586 . 382837)) (382990 384267 (SKETCH.TITLE 383000 . 383263) (
|
||||
SK.SHRINK.ICONCREATE 383265 . 384265)) (389957 392771 (READBRUSHSHAPE 389967 . 390426) (READ.FUNCTION
|
||||
390428 . 390943) (READBRUSHSIZE 390945 . 391403) (READANGLE 391405 . 391897) (READARCDIRECTION 391899
|
||||
. 392769)) (392772 403183 (SK.CHANGE.DASHING 392782 . 396730) (READ.AND.SAVE.NEW.DASHING 396732 .
|
||||
398500) (READ.NEW.DASHING 398502 . 400242) (READ.DASHING.CHANGE 400244 . 401719) (SK.CACHE.DASHING
|
||||
401721 . 402723) (SK.DASHING.LABEL 402725 . 403181)) (403184 406889 (READ.FILLING.CHANGE 403194 .
|
||||
405175) (SK.CACHE.FILLING 405177 . 405895) (READ.AND.SAVE.NEW.FILLING 405897 . 406495) (
|
||||
SK.FILLING.LABEL 406497 . 406887)) (407273 443526 (SK.GETGLOBALPOSITION 407283 . 407588) (
|
||||
SKETCH.TRACK.ELEMENTS 407590 . 411110) (SK.PICKOUT.WHOLE.MOVE.ELEMENTS 411112 . 411671) (
|
||||
MAP.SKETCH.ELEMENTS.INTO.VIEWER 411673 . 412065) (MAP.GLOBAL.POSITION.INTO.VIEWER 412067 . 412447) (
|
||||
SKETCH.TO.VIEWER.POSITION 412449 . 412808) (SKETCH.TRACK.IMAGE 412810 . 413664) (SK.TRACK.IMAGE1
|
||||
413666 . 415078) (MAP.VIEWER.XY.INTO.GLOBAL 415080 . 416074) (SK.SET.POSITION 416076 . 416412) (
|
||||
MAP.VIEWER.PT.INTO.GLOBAL 416414 . 417520) (VIEWER.TO.SKETCH.POSITION 417522 . 418157) (
|
||||
SK.INSURE.SCALE 418159 . 418419) (SKETCH.TO.VIEWER.REGION 418421 . 419227) (VIEWER.TO.SKETCH.REGION
|
||||
419229 . 419567) (SK.READ.POINT.WITH.FEEDBACK 419569 . 430572) (SKETCH.GET.POSITION 430574 . 432454) (
|
||||
\CLOBBER.POSITION 432456 . 432904) (NEAREST.HOT.SPOT 432906 . 434434) (GETWREGION 434436 . 435197) (
|
||||
GET.BITMAP.POSITION 435199 . 435983) (SK.TRACK.BITMAP1 435985 . 443524)) (444095 474981 (
|
||||
SK.BRING.UP.POSITION.PAD 444105 . 449965) (SK.PAD.READER.POSITION 449967 . 451616) (
|
||||
SK.POSITION.READER.REPAINTFN 451618 . 453402) (SK.POSITION.PAD.FROM.VIEWER 453404 . 454746) (
|
||||
SK.INIT.POSITION.NUMBER.PAD.MENU 454748 . 455098) (SK.READ.POSITION.PAD.HANDLER 455100 . 460832) (
|
||||
DISPLAY.POSITION.READER.TOTAL 460834 . 463132) (POSITION.PAD.READER.HANDLER 463134 . 471177) (
|
||||
POSITIONPAD.HELDFN 471179 . 472663) (\POSITION.PAD.ADD.DIGIT.MENU 472665 . 474244) (
|
||||
\POSITION.READER.NUMBERPAD 474246 . 474979)) (476607 479285 (SK.DRAWFN 476617 . 476983) (
|
||||
SK.TRANSFORMFN 476985 . 477366) (SK.EXPANDFN 477368 . 477645) (SK.INPUT 477647 . 478028) (SK.INSIDEFN
|
||||
478030 . 478670) (SK.UPDATEFN 478672 . 479283)) (484857 488802 (SK.CHECK.SKETCH.VERSION 484867 .
|
||||
486107) (SK.INSURE.RECORD.LENGTH 486109 . 487592) (SK.INSURE.HAS.LENGTH 487594 . 488332) (
|
||||
SK.RECORD.LENGTH 488334 . 488508) (SK.SET.RECORD.LENGTHS 488510 . 488800)) (489543 490430 (
|
||||
SK.ADD.EDIT.COMMAND.TO.FILE.BROWSER 489553 . 490428)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,12 +1,11 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "26-Oct-2021 08:44:02"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>TEDITMENU.;3 276285
|
||||
(FILECREATED "31-Jan-2022 22:54:59" {DSK}<Users>kaplan>Local>medley3.5>my-medley>library>TEDITMENU.;3 275091
|
||||
|
||||
changes to%: (FNS \TEXTMENU.START)
|
||||
:CHANGES-TO (FNS \TEXTMENU.DOC.CREATE)
|
||||
|
||||
previous date%: "29-Apr-2021 22:44:22"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>TEDITMENU.;1)
|
||||
:PREVIOUS-DATE "26-Oct-2021 08:44:02"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>my-medley>library>TEDITMENU.;2)
|
||||
|
||||
|
||||
(* ; "
|
||||
@@ -33,7 +32,7 @@ Copyright (c) 1983-1995, 2021 by Venue & Xerox Corporation.
|
||||
(ADDVARS (IMAGEOBJTYPES (TEditMenuButton FILE TEDITMENU GETFN MB.GETFN]
|
||||
[COMS
|
||||
(* ;;
|
||||
"Three-state (ON-OFF-NEUTRAL) menu buttons, for, e.g., character properties like BOLD")
|
||||
"Three-state (ON-OFF-NEUTRAL) menu buttons, for, e.g., character properties like BOLD")
|
||||
|
||||
(FNS MB.CREATE.THREESTATEBUTTON MB.THREESTATE.DISPLAY MB.THREESTATE.SHOWSELFN
|
||||
MB.THREESTATE.WHENOPERATEDFN MB.THREESTATEBUTTON.FN THREESTATE.INIT)
|
||||
@@ -2123,155 +2122,141 @@ Copyright (c) 1983-1995, 2021 by Venue & Xerox Corporation.
|
||||
(AND MAINWINDOW (TTY.PROCESS (WINDOWPROP MAINWINDOW 'PROCESS])
|
||||
|
||||
(\TEXTMENU.DOC.CREATE
|
||||
[LAMBDA (MENUDESC MENUPROPS) (* ; "Edited 12-Jun-90 19:00 by mitani")
|
||||
[LAMBDA (MENUDESC MENUPROPS) (* ; "Edited 31-Jan-2022 22:48 by rmk")
|
||||
(* ; "Edited 12-Jun-90 19:00 by mitani")
|
||||
|
||||
(* Create the TEXTSTREAM for a menu, given a description.
|
||||
That stream is passed to \TEXTMENU.START to get the menu up on screen)
|
||||
(* Create the TEXTSTREAM for a menu, given a description.
|
||||
That stream is passed to \TEXTMENU.START to get the menu up on screen)
|
||||
|
||||
(PROG ((CH#1 NIL)
|
||||
MENUW MENUTEXT)
|
||||
[SETQ MENUTEXT (OPENTEXTSTREAM "" NIL NIL NIL (OR MENUPROPS '(FONT (MODERN 10]
|
||||
[SETQ MENUTEXT (OPENTEXTSTREAM NIL NIL NIL NIL (OR MENUPROPS '(FONT (MODERN 10]
|
||||
(bind (CH# _ 1)
|
||||
OBJ for DESC in MENUDESC
|
||||
OBJ for DESC in MENUDESC
|
||||
do (SELECTQ (CAR DESC)
|
||||
(* (* This is a comment within a menu
|
||||
description -- Ignore it.))
|
||||
(MB.BUTTON (* A menu button --
|
||||
hitting it calls a function)
|
||||
(TEDIT.INSERT.OBJECT (MBUTTON.CREATE
|
||||
(MKATOM (fetch (MB.BUTTON MBLABEL)
|
||||
of DESC))
|
||||
(fetch (MB.BUTTON MBBUTTONEVENTFN)
|
||||
of DESC)
|
||||
(fetch (MB.BUTTON MBFONT) of DESC))
|
||||
MENUTEXT CH#)
|
||||
(TEDIT.LOOKS (fetch (TEXTSTREAM TEXTOBJ) of MENUTEXT)
|
||||
'(PROTECTED OFF)
|
||||
CH# 1)
|
||||
(add CH# 1))
|
||||
(MB.3STATE (* 3-state button;
|
||||
hitting it changes state among ON,
|
||||
OFF, and NEUTRAL.)
|
||||
(TEDIT.INSERT.OBJECT (MB.CREATE.THREESTATEBUTTON
|
||||
(MKATOM (fetch (MB.3STATE MBLABEL)
|
||||
of DESC))
|
||||
(fetch (MB.3STATE MBFONT) of DESC)
|
||||
(fetch (MB.3STATE MBCHANGESTATEFN)
|
||||
of DESC)
|
||||
(fetch (MB.3STATE MBINITSTATE)
|
||||
of DESC))
|
||||
MENUTEXT CH#)
|
||||
(TEDIT.LOOKS (fetch (TEXTSTREAM TEXTOBJ) of MENUTEXT)
|
||||
'(PROTECTED OFF)
|
||||
CH# 1)
|
||||
(add CH# 1))
|
||||
(MB.TOGGLE (* TOGGLE button; hitting it
|
||||
switches between ON and OFF.)
|
||||
(TEDIT.INSERT.OBJECT (\TEXTMENU.TOGGLE.CREATE
|
||||
(MKATOM (fetch (MB.TOGGLE MBTEXT)
|
||||
of DESC))
|
||||
(fetch (MB.TOGGLE MBFONT) of DESC)
|
||||
(fetch (MB.TOGGLE MBCHANGESTATEFN)
|
||||
of DESC)
|
||||
(fetch (MB.TOGGLE MBINITSTATE)
|
||||
of DESC))
|
||||
MENUTEXT CH#)
|
||||
(TEDIT.LOOKS (fetch (TEXTSTREAM TEXTOBJ) of MENUTEXT)
|
||||
'(PROTECTED OFF)
|
||||
CH# 1)
|
||||
(add CH# 1))
|
||||
(MB.NWAY (* N-way buttons; choosing one turns
|
||||
the others off.)
|
||||
(SETQ OBJ (MB.CREATE.NWAYBUTTON (fetch (MB.NWAY MBBUTTONS)
|
||||
of DESC)
|
||||
(fetch (MB.NWAY MBFONT) of DESC)
|
||||
(fetch (MB.NWAY MBCHANGESTATEFN) of DESC)
|
||||
(fetch (MB.NWAY MBINITSTATE) of DESC)
|
||||
(fetch (MB.NWAY MBMAXITEMSPERLINE) of
|
||||
DESC)))
|
||||
(TEDIT.INSERT.OBJECT OBJ MENUTEXT CH#)
|
||||
(TEDIT.LOOKS (fetch (TEXTSTREAM TEXTOBJ) of MENUTEXT)
|
||||
'(PROTECTED OFF)
|
||||
CH# 1)
|
||||
(add CH# 1))
|
||||
(MENU (* Real menu, except the selection
|
||||
sticks)
|
||||
(TEDIT.INSERT.OBJECT (MB.CREATE.FULLMENU (CADR DESC))
|
||||
MENUTEXT CH#)
|
||||
(TEDIT.LOOKS (fetch (TEXTSTREAM TEXTOBJ) of MENUTEXT)
|
||||
'(PROTECTED OFF)
|
||||
CH# 1)
|
||||
(add CH# 1))
|
||||
(MB.MARGINBAR (* Margin ruler for TEdit formatting)
|
||||
(TEDIT.INSERT.OBJECT (MARGINBAR.CREATE -0.5 -0.5 -39.5 NIL
|
||||
12)
|
||||
MENUTEXT CH#)
|
||||
(TEDIT.LOOKS (fetch (TEXTSTREAM TEXTOBJ) of MENUTEXT)
|
||||
'(PROTECTED OFF)
|
||||
CH# 1)
|
||||
(add CH# 1))
|
||||
(MB.TEXT (* Arbitrary text, which will be
|
||||
protected from the user.)
|
||||
(TEDIT.INSERT MENUTEXT (fetch (MB.TEXT MBSTRING) of DESC)
|
||||
CH#)
|
||||
[AND (fetch (MB.TEXT MBFONT) of DESC)
|
||||
(TEDIT.LOOKS (fetch (TEXTSTREAM TEXTOBJ) of MENUTEXT)
|
||||
(LIST 'MBFONT (fetch (MB.TEXT MBFONT) of DESC))
|
||||
CH#
|
||||
(NCHARS (fetch (MB.TEXT MBSTRING) of DESC]
|
||||
(TEDIT.LOOKS (fetch (TEXTSTREAM TEXTOBJ) of MENUTEXT)
|
||||
'(PROTECTED ON)
|
||||
CH#
|
||||
(NCHARS (fetch (MB.TEXT MBSTRING) of DESC)))
|
||||
(add CH# (NCHARS (fetch (MB.TEXT MBSTRING) of DESC))))
|
||||
(MB.INSERT (* An insertion point, with optional
|
||||
text to put there)
|
||||
(TEDIT.INSERT MENUTEXT " {}" CH#)
|
||||
(TEDIT.LOOKS (fetch (TEXTSTREAM TEXTOBJ) of MENUTEXT)
|
||||
'(PROTECTED ON)
|
||||
CH# 4)
|
||||
(TEDIT.LOOKS (fetch (TEXTSTREAM TEXTOBJ) of MENUTEXT)
|
||||
'(PROTECTED ON SELECTPOINT ON)
|
||||
(IPLUS CH# 2)
|
||||
1)
|
||||
(OR CH#1 (SETQ CH#1 (IPLUS CH# 3)))
|
||||
[COND
|
||||
((fetch (MB.INSERT MBINITENTRY) of DESC)
|
||||
(* There is an initial entry to be
|
||||
made. Make it)
|
||||
[COND
|
||||
((IMAGEOBJP (fetch (MB.INSERT MBINITENTRY) of
|
||||
DESC))
|
||||
(* It is an imageobj.)
|
||||
(TEDIT.INSERT.OBJECT (fetch (MB.INSERT MBINITENTRY)
|
||||
of DESC)
|
||||
MENUTEXT
|
||||
(IPLUS CH# 3)))
|
||||
(T (* It's regular text.)
|
||||
(TEDIT.INSERT MENUTEXT (MKSTRING (fetch (MB.INSERT
|
||||
MBINITENTRY
|
||||
(* (* This is a comment within a menu
|
||||
description -- Ignore it.))
|
||||
(MB.BUTTON (* A menu button -- hitting it calls a
|
||||
function)
|
||||
(TEDIT.INSERT.OBJECT (MBUTTON.CREATE (MKATOM (fetch (MB.BUTTON MBLABEL
|
||||
)
|
||||
of DESC))
|
||||
(IPLUS CH# 3]
|
||||
[TEDIT.LOOKS (fetch (TEXTSTREAM TEXTOBJ) of MENUTEXT)
|
||||
'(PROTECTED OFF SELECTPOINT OFF)
|
||||
(IPLUS CH# 3)
|
||||
(NCHARS (MKSTRING (fetch (MB.INSERT MBINITENTRY)
|
||||
of DESC]
|
||||
(add CH# (NCHARS (fetch (MB.INSERT MBINITENTRY)
|
||||
of DESC))
|
||||
(fetch (MB.BUTTON MBBUTTONEVENTFN)
|
||||
of DESC)
|
||||
(fetch (MB.BUTTON MBFONT) of DESC))
|
||||
MENUTEXT CH#)
|
||||
(TEDIT.LOOKS (fetch (TEXTSTREAM TEXTOBJ) of MENUTEXT)
|
||||
'(PROTECTED OFF)
|
||||
CH# 1)
|
||||
(add CH# 1))
|
||||
(MB.3STATE (* 3-state button; hitting it changes
|
||||
state among ON, OFF, and NEUTRAL.)
|
||||
(TEDIT.INSERT.OBJECT (MB.CREATE.THREESTATEBUTTON
|
||||
(MKATOM (fetch (MB.3STATE MBLABEL) of DESC))
|
||||
(fetch (MB.3STATE MBFONT) of DESC)
|
||||
(fetch (MB.3STATE MBCHANGESTATEFN) of DESC)
|
||||
(fetch (MB.3STATE MBINITSTATE) of DESC))
|
||||
MENUTEXT CH#)
|
||||
(TEDIT.LOOKS (fetch (TEXTSTREAM TEXTOBJ) of MENUTEXT)
|
||||
'(PROTECTED OFF)
|
||||
CH# 1)
|
||||
(add CH# 1))
|
||||
(MB.TOGGLE (* TOGGLE button; hitting it switches
|
||||
between ON and OFF.)
|
||||
(TEDIT.INSERT.OBJECT (\TEXTMENU.TOGGLE.CREATE
|
||||
(MKATOM (fetch (MB.TOGGLE MBTEXT) of DESC))
|
||||
(fetch (MB.TOGGLE MBFONT) of DESC)
|
||||
(fetch (MB.TOGGLE MBCHANGESTATEFN) of DESC)
|
||||
(fetch (MB.TOGGLE MBINITSTATE) of DESC))
|
||||
MENUTEXT CH#)
|
||||
(TEDIT.LOOKS (fetch (TEXTSTREAM TEXTOBJ) of MENUTEXT)
|
||||
'(PROTECTED OFF)
|
||||
CH# 1)
|
||||
(add CH# 1))
|
||||
(MB.NWAY (* N-way buttons; choosing one turns
|
||||
the others off.)
|
||||
(SETQ OBJ (MB.CREATE.NWAYBUTTON (fetch (MB.NWAY MBBUTTONS) of DESC)
|
||||
(fetch (MB.NWAY MBFONT) of DESC)
|
||||
(fetch (MB.NWAY MBCHANGESTATEFN) of DESC)
|
||||
(fetch (MB.NWAY MBINITSTATE) of DESC)
|
||||
(fetch (MB.NWAY MBMAXITEMSPERLINE) of DESC)))
|
||||
(TEDIT.INSERT.OBJECT OBJ MENUTEXT CH#)
|
||||
(TEDIT.LOOKS (fetch (TEXTSTREAM TEXTOBJ) of MENUTEXT)
|
||||
'(PROTECTED OFF)
|
||||
CH# 1)
|
||||
(add CH# 1))
|
||||
(MENU (* Real menu, except the selection
|
||||
sticks)
|
||||
(TEDIT.INSERT.OBJECT (MB.CREATE.FULLMENU (CADR DESC))
|
||||
MENUTEXT CH#)
|
||||
(TEDIT.LOOKS (fetch (TEXTSTREAM TEXTOBJ) of MENUTEXT)
|
||||
'(PROTECTED OFF)
|
||||
CH# 1)
|
||||
(add CH# 1))
|
||||
(MB.MARGINBAR (* Margin ruler for TEdit formatting)
|
||||
(TEDIT.INSERT.OBJECT (MARGINBAR.CREATE -0.5 -0.5 -39.5 NIL 12)
|
||||
MENUTEXT CH#)
|
||||
(TEDIT.LOOKS (fetch (TEXTSTREAM TEXTOBJ) of MENUTEXT)
|
||||
'(PROTECTED OFF)
|
||||
CH# 1)
|
||||
(add CH# 1))
|
||||
(MB.TEXT (* Arbitrary text, which will be
|
||||
protected from the user.)
|
||||
(TEDIT.INSERT MENUTEXT (fetch (MB.TEXT MBSTRING) of DESC)
|
||||
CH#)
|
||||
[AND (fetch (MB.TEXT MBFONT) of DESC)
|
||||
(TEDIT.LOOKS (fetch (TEXTSTREAM TEXTOBJ) of MENUTEXT)
|
||||
(LIST 'MBFONT (fetch (MB.TEXT MBFONT) of DESC))
|
||||
CH#
|
||||
(NCHARS (fetch (MB.TEXT MBSTRING) of DESC]
|
||||
(TEDIT.LOOKS (fetch (TEXTSTREAM TEXTOBJ) of MENUTEXT)
|
||||
'(PROTECTED ON)
|
||||
CH#
|
||||
(NCHARS (fetch (MB.TEXT MBSTRING) of DESC)))
|
||||
(add CH# (NCHARS (fetch (MB.TEXT MBSTRING) of DESC))))
|
||||
(MB.INSERT (* An insertion point, with optional
|
||||
text to put there)
|
||||
(TEDIT.INSERT MENUTEXT " {}" CH#)
|
||||
(TEDIT.LOOKS (fetch (TEXTSTREAM TEXTOBJ) of MENUTEXT)
|
||||
'(PROTECTED ON)
|
||||
CH# 4)
|
||||
(TEDIT.LOOKS (fetch (TEXTSTREAM TEXTOBJ) of MENUTEXT)
|
||||
'(PROTECTED ON SELECTPOINT ON)
|
||||
(IPLUS CH# 2)
|
||||
1)
|
||||
(OR CH#1 (SETQ CH#1 (IPLUS CH# 3)))
|
||||
[COND
|
||||
((fetch (MB.INSERT MBINITENTRY) of DESC)
|
||||
(* There is an initial entry to be
|
||||
made. Make it)
|
||||
[COND
|
||||
((IMAGEOBJP (fetch (MB.INSERT MBINITENTRY) of DESC))
|
||||
(* It is an imageobj.)
|
||||
(TEDIT.INSERT.OBJECT (fetch (MB.INSERT MBINITENTRY)
|
||||
of DESC)
|
||||
MENUTEXT
|
||||
(IPLUS CH# 3)))
|
||||
(T (* It's regular text.)
|
||||
(TEDIT.INSERT MENUTEXT (MKSTRING (fetch (MB.INSERT
|
||||
MBINITENTRY)
|
||||
of DESC))
|
||||
(IPLUS CH# 3]
|
||||
[TEDIT.LOOKS (fetch (TEXTSTREAM TEXTOBJ) of MENUTEXT)
|
||||
'(PROTECTED OFF SELECTPOINT OFF)
|
||||
(IPLUS CH# 3)
|
||||
(NCHARS (MKSTRING (fetch (MB.INSERT MBINITENTRY)
|
||||
of DESC]
|
||||
(add CH# 4))
|
||||
(\ILLEGAL.ARG DESC)))
|
||||
(replace (TEXTOBJ MENUFLG) of (fetch (TEXTSTREAM TEXTOBJ) of MENUTEXT)
|
||||
with T) (* Remember that this is a menu)
|
||||
(add CH# (NCHARS (fetch (MB.INSERT MBINITENTRY) of DESC]
|
||||
(add CH# 4))
|
||||
(\ILLEGAL.ARG DESC)))
|
||||
(replace (TEXTOBJ MENUFLG) of (fetch (TEXTSTREAM TEXTOBJ) of MENUTEXT) with T)
|
||||
(* Remember that this is a menu)
|
||||
[COND
|
||||
(CH#1 (* We actually inserted some text,
|
||||
so it makes sense to put up a
|
||||
selection)
|
||||
(push (fetch (TEXTOBJ EDITPROPS) of (fetch (TEXTSTREAM TEXTOBJ)
|
||||
of MENUTEXT))
|
||||
(LIST 'SEL CH#1] (* And where the first selection
|
||||
should be.)
|
||||
(CH#1 (* We actually inserted some text, so
|
||||
it makes sense to put up a selection)
|
||||
(push (fetch (TEXTOBJ EDITPROPS) of (fetch (TEXTSTREAM TEXTOBJ) of MENUTEXT))
|
||||
(LIST 'SEL CH#1] (* And where the first selection
|
||||
should be.)
|
||||
(RETURN MENUTEXT])
|
||||
|
||||
(TEXTMENU.CLOSEFN
|
||||
@@ -4509,42 +4494,42 @@ Tab Type: "
|
||||
(PUTPROPS TEDITMENU COPYRIGHT ("Venue & Xerox Corporation" 1983 1984 1985 1986 1987 1988 1989 1990
|
||||
1991 1992 1993 1994 1995 2021))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (6266 33108 (MB.BUTTONEVENTINFN 6276 . 7607) (MB.DISPLAY 7609 . 9977) (MB.SETIMAGE 9979
|
||||
. 10937) (MB.SELFN 10939 . 12354) (MB.SIZEFN 12356 . 13373) (MB.WHENOPERATEDFN 13375 . 13707) (
|
||||
MB.COPYFN 13709 . 14171) (MB.GETFN 14173 . 14781) (MB.PUTFN 14783 . 15560) (MB.SHOWSELFN 15562 . 16534
|
||||
) (MBUTTON.CREATE 16536 . 17820) (MBUTTON.CHANGENAME 17822 . 18217) (MBUTTON.FIND.BUTTON 18219 . 19235
|
||||
) (MBUTTON.FIND.NEXT.BUTTON 19237 . 20632) (MBUTTON.FIND.NEXT.FIELD 20634 . 24348) (MBUTTON.INIT 24350
|
||||
. 25140) (MBUTTON.NEXT.FIELD.AS.NUMBER 25142 . 25495) (MBUTTON.NEXT.FIELD.AS.PIECES 25497 . 25927) (
|
||||
MBUTTON.NEXT.FIELD.AS.TEXT 25929 . 26351) (MBUTTON.NEXT.FIELD.AS.ATOM 26353 . 27226) (
|
||||
MBUTTON.SET.FIELD 27228 . 29284) (MBUTTON.SET.NEXT.FIELD 29286 . 30503) (MBUTTON.SET.NEXT.BUTTON.STATE
|
||||
30505 . 31001) (TEDITMENU.STREAM 31003 . 31612) (\TEDITMENU.SELSCREENER 31614 . 33106)) (33412 43835
|
||||
(MB.CREATE.THREESTATEBUTTON 33422 . 34593) (MB.THREESTATE.DISPLAY 34595 . 37185) (
|
||||
MB.THREESTATE.SHOWSELFN 37187 . 40289) (MB.THREESTATE.WHENOPERATEDFN 40291 . 41670) (
|
||||
MB.THREESTATEBUTTON.FN 41672 . 42769) (THREESTATE.INIT 42771 . 43833)) (43936 63172 (
|
||||
MB.CREATE.NWAYBUTTON 43946 . 47914) (MB.NB.DISPLAYFN 47916 . 50188) (MB.NB.WHENOPERATEDFN 50190 .
|
||||
51222) (MB.NB.SIZEFN 51224 . 54763) (MB.NWAYBUTTON.SELFN 54765 . 56709) (MB.NWAYMENU.NEWBUTTON 56711
|
||||
. 57297) (NWAYBUTTON.INIT 57299 . 58152) (MB.NB.PACKITEMS 58154 . 60151) (MB.NWAYBUTTON.ADDITEM 60153
|
||||
. 63170)) (63426 74074 (\TEXTMENU.TOGGLE.CREATE 63436 . 64837) (\TEXTMENU.TOGGLE.DISPLAY 64839 .
|
||||
67191) (\TEXTMENU.TOGGLE.SHOWSELFN 67193 . 69555) (\TEXTMENU.TOGGLE.WHENOPERATEDFN 69557 . 70945) (
|
||||
\TEXTMENU.TOGGLEFN 70947 . 72027) (\TEXTMENU.TOGGLE.INIT 72029 . 72864) (\TEXTMENU.SET.TOGGLE 72866 .
|
||||
74072)) (74326 111698 (DRAWMARGINSCALE 74336 . 77880) (MARGINBAR 77882 . 85252) (MARGINBAR.CREATE
|
||||
85254 . 88164) (MB.MARGINBAR.SELFN 88166 . 100760) (MB.MARGINBAR.SIZEFN 100762 . 101124) (
|
||||
MB.MARGINBAR.DISPLAYFN 101126 . 103811) (MDESCALE 103813 . 104252) (MSCALE 104254 . 104588) (
|
||||
MB.MARGINBAR.SHOWTAB 104590 . 106761) (MB.MARGINBAR.TABTRACK 106763 . 108098) (\TEDIT.TABTYPE.SET
|
||||
108100 . 110807) (MARGINBAR.INIT 110809 . 111696)) (112715 130838 (\TEXTMENU.START 112725 . 116438) (
|
||||
\TEXTMENU.DOC.CREATE 116440 . 127964) (TEXTMENU.CLOSEFN 127966 . 130836)) (131148 151212 (
|
||||
\TEDITMENU.CREATE 131158 . 131458) (\TEDIT.EXPANDED.MENU 131460 . 132164) (MB.DEFAULTBUTTON.FN 132166
|
||||
. 135038) (\TEDITMENU.RECORD.UNFORMATTED 135040 . 135378) (MB.DEFAULTBUTTON.ACTIONFN 135380 . 151210)
|
||||
) (151213 178596 (\TEDIT.CHARLOOKSMENU.CREATE 151223 . 153363) (\TEDIT.EXPANDEDCHARLOOKS.MENU 153365
|
||||
. 153739) (\TEDIT.APPLY.BOLDNESS 153741 . 154026) (\TEDIT.APPLY.CHARLOOKS 154028 . 155959) (
|
||||
\TEDIT.APPLY.OLINE 155961 . 156242) (\TEDIT.SHOW.CHARLOOKS 156244 . 158157) (
|
||||
\TEDIT.NEUTRALIZE.CHARLOOKS 158159 . 159085) (\TEDIT.FILL.IN.CHARLOOKS.MENU 159087 . 166740) (
|
||||
\TEDIT.NEUTRALIZE.CHARLOOKS.MENU 166742 . 169625) (\TEDIT.PARSE.CHARLOOKS.MENU 169627 . 177735) (
|
||||
\TEDIT.APPLY.SLOPE 177737 . 178020) (\TEDIT.APPLY.STRIKEOUT 178022 . 178309) (\TEDIT.APPLY.ULINE
|
||||
178311 . 178594)) (178597 210663 (\TEDITPARAMENU.CREATE 178607 . 178987) (\TEDIT.EXPANDEDPARA.MENU
|
||||
178989 . 179309) (\TEDIT.APPLY.PARALOOKS 179311 . 191541) (\TEDIT.SHOW.PARALOOKS 191543 . 203070) (
|
||||
\TEDIT.NEUTRALIZE.PARALOOKS.MENU 203072 . 209143) (\TEDIT.RECORD.TABLEADERS 209145 . 210661)) (210664
|
||||
248666 (\TEDIT.SHOW.PAGEFORMATTING 210674 . 227214) (\TEDITPAGEMENU.CREATE 227216 . 228259) (
|
||||
\TEDIT.APPLY.PAGEFORMATTING 228261 . 240632) (TEDIT.UNPARSE.PAGEFORMAT 240634 . 248664)) (248971
|
||||
275820 (\TEDIT.MENU.INIT 248981 . 275818)))))
|
||||
(FILEMAP (NIL (6267 33109 (MB.BUTTONEVENTINFN 6277 . 7608) (MB.DISPLAY 7610 . 9978) (MB.SETIMAGE 9980
|
||||
. 10938) (MB.SELFN 10940 . 12355) (MB.SIZEFN 12357 . 13374) (MB.WHENOPERATEDFN 13376 . 13708) (
|
||||
MB.COPYFN 13710 . 14172) (MB.GETFN 14174 . 14782) (MB.PUTFN 14784 . 15561) (MB.SHOWSELFN 15563 . 16535
|
||||
) (MBUTTON.CREATE 16537 . 17821) (MBUTTON.CHANGENAME 17823 . 18218) (MBUTTON.FIND.BUTTON 18220 . 19236
|
||||
) (MBUTTON.FIND.NEXT.BUTTON 19238 . 20633) (MBUTTON.FIND.NEXT.FIELD 20635 . 24349) (MBUTTON.INIT 24351
|
||||
. 25141) (MBUTTON.NEXT.FIELD.AS.NUMBER 25143 . 25496) (MBUTTON.NEXT.FIELD.AS.PIECES 25498 . 25928) (
|
||||
MBUTTON.NEXT.FIELD.AS.TEXT 25930 . 26352) (MBUTTON.NEXT.FIELD.AS.ATOM 26354 . 27227) (
|
||||
MBUTTON.SET.FIELD 27229 . 29285) (MBUTTON.SET.NEXT.FIELD 29287 . 30504) (MBUTTON.SET.NEXT.BUTTON.STATE
|
||||
30506 . 31002) (TEDITMENU.STREAM 31004 . 31613) (\TEDITMENU.SELSCREENER 31615 . 33107)) (33413 43836
|
||||
(MB.CREATE.THREESTATEBUTTON 33423 . 34594) (MB.THREESTATE.DISPLAY 34596 . 37186) (
|
||||
MB.THREESTATE.SHOWSELFN 37188 . 40290) (MB.THREESTATE.WHENOPERATEDFN 40292 . 41671) (
|
||||
MB.THREESTATEBUTTON.FN 41673 . 42770) (THREESTATE.INIT 42772 . 43834)) (43937 63173 (
|
||||
MB.CREATE.NWAYBUTTON 43947 . 47915) (MB.NB.DISPLAYFN 47917 . 50189) (MB.NB.WHENOPERATEDFN 50191 .
|
||||
51223) (MB.NB.SIZEFN 51225 . 54764) (MB.NWAYBUTTON.SELFN 54766 . 56710) (MB.NWAYMENU.NEWBUTTON 56712
|
||||
. 57298) (NWAYBUTTON.INIT 57300 . 58153) (MB.NB.PACKITEMS 58155 . 60152) (MB.NWAYBUTTON.ADDITEM 60154
|
||||
. 63171)) (63427 74075 (\TEXTMENU.TOGGLE.CREATE 63437 . 64838) (\TEXTMENU.TOGGLE.DISPLAY 64840 .
|
||||
67192) (\TEXTMENU.TOGGLE.SHOWSELFN 67194 . 69556) (\TEXTMENU.TOGGLE.WHENOPERATEDFN 69558 . 70946) (
|
||||
\TEXTMENU.TOGGLEFN 70948 . 72028) (\TEXTMENU.TOGGLE.INIT 72030 . 72865) (\TEXTMENU.SET.TOGGLE 72867 .
|
||||
74073)) (74327 111699 (DRAWMARGINSCALE 74337 . 77881) (MARGINBAR 77883 . 85253) (MARGINBAR.CREATE
|
||||
85255 . 88165) (MB.MARGINBAR.SELFN 88167 . 100761) (MB.MARGINBAR.SIZEFN 100763 . 101125) (
|
||||
MB.MARGINBAR.DISPLAYFN 101127 . 103812) (MDESCALE 103814 . 104253) (MSCALE 104255 . 104589) (
|
||||
MB.MARGINBAR.SHOWTAB 104591 . 106762) (MB.MARGINBAR.TABTRACK 106764 . 108099) (\TEDIT.TABTYPE.SET
|
||||
108101 . 110808) (MARGINBAR.INIT 110810 . 111697)) (112716 129644 (\TEXTMENU.START 112726 . 116439) (
|
||||
\TEXTMENU.DOC.CREATE 116441 . 126770) (TEXTMENU.CLOSEFN 126772 . 129642)) (129954 150018 (
|
||||
\TEDITMENU.CREATE 129964 . 130264) (\TEDIT.EXPANDED.MENU 130266 . 130970) (MB.DEFAULTBUTTON.FN 130972
|
||||
. 133844) (\TEDITMENU.RECORD.UNFORMATTED 133846 . 134184) (MB.DEFAULTBUTTON.ACTIONFN 134186 . 150016)
|
||||
) (150019 177402 (\TEDIT.CHARLOOKSMENU.CREATE 150029 . 152169) (\TEDIT.EXPANDEDCHARLOOKS.MENU 152171
|
||||
. 152545) (\TEDIT.APPLY.BOLDNESS 152547 . 152832) (\TEDIT.APPLY.CHARLOOKS 152834 . 154765) (
|
||||
\TEDIT.APPLY.OLINE 154767 . 155048) (\TEDIT.SHOW.CHARLOOKS 155050 . 156963) (
|
||||
\TEDIT.NEUTRALIZE.CHARLOOKS 156965 . 157891) (\TEDIT.FILL.IN.CHARLOOKS.MENU 157893 . 165546) (
|
||||
\TEDIT.NEUTRALIZE.CHARLOOKS.MENU 165548 . 168431) (\TEDIT.PARSE.CHARLOOKS.MENU 168433 . 176541) (
|
||||
\TEDIT.APPLY.SLOPE 176543 . 176826) (\TEDIT.APPLY.STRIKEOUT 176828 . 177115) (\TEDIT.APPLY.ULINE
|
||||
177117 . 177400)) (177403 209469 (\TEDITPARAMENU.CREATE 177413 . 177793) (\TEDIT.EXPANDEDPARA.MENU
|
||||
177795 . 178115) (\TEDIT.APPLY.PARALOOKS 178117 . 190347) (\TEDIT.SHOW.PARALOOKS 190349 . 201876) (
|
||||
\TEDIT.NEUTRALIZE.PARALOOKS.MENU 201878 . 207949) (\TEDIT.RECORD.TABLEADERS 207951 . 209467)) (209470
|
||||
247472 (\TEDIT.SHOW.PAGEFORMATTING 209480 . 226020) (\TEDITPAGEMENU.CREATE 226022 . 227065) (
|
||||
\TEDIT.APPLY.PAGEFORMATTING 227067 . 239438) (TEDIT.UNPARSE.PAGEFORMAT 239440 . 247470)) (247777
|
||||
274626 (\TEDIT.MENU.INIT 247787 . 274624)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,19 +1,94 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
(FILECREATED "25-Aug-94 10:55:28" {DSK}<king>export>lispcore>library>TEDITPAGE.;3 123769
|
||||
|
||||
changes to%: (VARS TEDITPAGECOMS) (FILES TEDITDCL)
|
||||
(FILECREATED "31-Jan-2022 23:33:37" {DSK}<Users>kaplan>Local>medley3.5>my-medley>library>TEDITPAGE.;2 124691
|
||||
|
||||
previous date%: " 4-Jul-93 00:42:12" {DSK}<king>export>lispcore>library>TEDITPAGE.;2)
|
||||
:CHANGES-TO (FNS TEDIT.FORMATHEADING TEDIT.FORMATFOLIO)
|
||||
|
||||
:PREVIOUS-DATE "25-Aug-94 10:55:28"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>my-medley>library>TEDITPAGE.;1)
|
||||
|
||||
|
||||
(* ; "
|
||||
Copyright (c) 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1993, 1994 by Venue & Xerox Corporation. All rights reserved.
|
||||
Copyright (c) 1984-1991, 1993-1994 by Venue & Xerox Corporation.
|
||||
")
|
||||
|
||||
(PRETTYCOMPRINT TEDITPAGECOMS)
|
||||
|
||||
(RPAQQ TEDITPAGECOMS ((FILES TEDITDCL) (DECLARE%: EVAL@COMPILE DONTCOPY (CONSTANTS (\SCRATCHLEN 64)) (FILES (LOADCOMP) TEDITDCL)) (COMS (* ;; "Page-numbering font specification/default") (* ;; "(Must come before calls to TEDIT.SINGLE.PAGEFORMAT below.)") (GLOBALVARS TEDIT.DEFAULT.FOLIO.LOOKS) (INITVARS (TEDIT.DEFAULT.FOLIO.LOOKS (\TEDIT.PARSE.CHARLOOKS.LIST (QUOTE (FAMILY MODERN SIZE 10 WEIGHT MEDIUM SLOPE REGULAR))))) (* ;; "If non-nil, TEdit appends the start & end fileptrs for pages here.") (INITVARS (*TEDIT-PAGE-BREAKS* NIL))) (VARS (MAXPAGE# 65535) (MINPAGE# 1) (TEDIT.PAGE.FRAMES (LIST (TEDIT.SINGLE.PAGEFORMAT NIL NIL NIL NIL NIL 72 72 72 72 NIL 1) (TEDIT.SINGLE.PAGEFORMAT T 72 756 NIL (QUOTE LEFT) 72 72 72 72 NIL 1) (TEDIT.SINGLE.PAGEFORMAT T 540 756 NIL (QUOTE RIGHT) 72 72 72 72 NIL 1)))) (COMS (* ;; "Creation, GET, and PUT of page frames.") (FNS TEDIT.GET.PAGEFRAMES TEDIT.PARSE.PAGEFRAMES TEDIT.PUT.PAGEFRAMES TEDIT.UNPARSE.PAGEFRAMES)) (COMS (* ;; "For setting up page layouts") (FNS TEDIT.SINGLE.PAGEFORMAT TEDIT.COMPOUND.PAGEFORMAT TEDIT.PAGEFORMAT)) (COMS (* ;; "Perform page layout, based on a regular expression of typed regions.") (FNS TEDIT.FORMAT.HARDCOPY TEDIT.FORMATBOX TEDIT.FORMATHEADING TEDIT.FORMATPAGE TEDIT.FORMATTEXTBOX TEDIT.FORMATFOLIO \TEDIT.FORMAT.FOUNDBOX? TEDIT.SKIP.SPECIALCOND) (* ;; "Aux function to capture page headings during line formatting:") (FNS TEDIT.HARDCOPY.PAGEHEADING) (* ;; " Aux function to handle end-of-column processing (paragraph keep, widow elimination, etc):") (FNS TEDIT.HARDCOPY-COLUMN-END)) (COMS (* ;; "Handle varying paper sizes") (FNS SCALEPAGEUNITS SCALEPAGEXUNITS SCALEPAGEYUNITS \TEDIT.PAPERHEIGHT \TEDIT.PAPERWIDTH) (GLOBALVARS TEDIT.PAPER.SIZES) (VARS (TEDIT.PAPER.SIZES (QUOTE ((A0 2384 3370) (A1 1684 2384) (A2 1191 1684) (A3 842 1191) (A4 595 842) (A5 420 595) (B0 2835 4008) (B1 2004 2835) (B2 1417 2004) (B3 1001 1417) (B4 709 1001) (B5 499 709)))))) (COMS (* ; "Page numbering option support") (FNS ROMANNUMERALS)) (COMS (* ;; "Foot note support") (FNS \TEDIT.FORMAT.FOOTNOTE)))
|
||||
)
|
||||
(RPAQQ TEDITPAGECOMS
|
||||
((FILES TEDITDCL)
|
||||
(DECLARE%: EVAL@COMPILE DONTCOPY (CONSTANTS (\SCRATCHLEN 64))
|
||||
(FILES (LOADCOMP)
|
||||
TEDITDCL))
|
||||
(COMS
|
||||
(* ;; "Page-numbering font specification/default")
|
||||
|
||||
|
||||
(* ;; "(Must come before calls to TEDIT.SINGLE.PAGEFORMAT below.)")
|
||||
|
||||
(GLOBALVARS TEDIT.DEFAULT.FOLIO.LOOKS)
|
||||
[INITVARS (TEDIT.DEFAULT.FOLIO.LOOKS (\TEDIT.PARSE.CHARLOOKS.LIST '(FAMILY MODERN SIZE
|
||||
10 WEIGHT
|
||||
MEDIUM SLOPE
|
||||
REGULAR]
|
||||
|
||||
(* ;; "If non-nil, TEdit appends the start & end fileptrs for pages here.")
|
||||
|
||||
(INITVARS (*TEDIT-PAGE-BREAKS* NIL)))
|
||||
[VARS (MAXPAGE# 65535)
|
||||
(MINPAGE# 1)
|
||||
(TEDIT.PAGE.FRAMES (LIST (TEDIT.SINGLE.PAGEFORMAT NIL NIL NIL NIL NIL 72 72 72 72 NIL 1
|
||||
)
|
||||
(TEDIT.SINGLE.PAGEFORMAT T 72 756 NIL 'LEFT 72 72 72 72 NIL 1)
|
||||
(TEDIT.SINGLE.PAGEFORMAT T 540 756 NIL 'RIGHT 72 72 72 72 NIL
|
||||
1]
|
||||
(COMS
|
||||
(* ;; "Creation, GET, and PUT of page frames.")
|
||||
|
||||
(FNS TEDIT.GET.PAGEFRAMES TEDIT.PARSE.PAGEFRAMES TEDIT.PUT.PAGEFRAMES
|
||||
TEDIT.UNPARSE.PAGEFRAMES))
|
||||
(COMS
|
||||
(* ;; "For setting up page layouts")
|
||||
|
||||
(FNS TEDIT.SINGLE.PAGEFORMAT TEDIT.COMPOUND.PAGEFORMAT TEDIT.PAGEFORMAT))
|
||||
(COMS
|
||||
(* ;; "Perform page layout, based on a regular expression of typed regions.")
|
||||
|
||||
(FNS TEDIT.FORMAT.HARDCOPY TEDIT.FORMATBOX TEDIT.FORMATHEADING TEDIT.FORMATPAGE
|
||||
TEDIT.FORMATTEXTBOX TEDIT.FORMATFOLIO \TEDIT.FORMAT.FOUNDBOX?
|
||||
TEDIT.SKIP.SPECIALCOND)
|
||||
|
||||
(* ;; "Aux function to capture page headings during line formatting:")
|
||||
|
||||
(FNS TEDIT.HARDCOPY.PAGEHEADING)
|
||||
|
||||
(* ;;
|
||||
" Aux function to handle end-of-column processing (paragraph keep, widow elimination, etc):")
|
||||
|
||||
(FNS TEDIT.HARDCOPY-COLUMN-END))
|
||||
[COMS
|
||||
(* ;; "Handle varying paper sizes")
|
||||
|
||||
(FNS SCALEPAGEUNITS SCALEPAGEXUNITS SCALEPAGEYUNITS \TEDIT.PAPERHEIGHT
|
||||
\TEDIT.PAPERWIDTH)
|
||||
(GLOBALVARS TEDIT.PAPER.SIZES)
|
||||
(VARS (TEDIT.PAPER.SIZES '((A0 2384 3370)
|
||||
(A1 1684 2384)
|
||||
(A2 1191 1684)
|
||||
(A3 842 1191)
|
||||
(A4 595 842)
|
||||
(A5 420 595)
|
||||
(B0 2835 4008)
|
||||
(B1 2004 2835)
|
||||
(B2 1417 2004)
|
||||
(B3 1001 1417)
|
||||
(B4 709 1001)
|
||||
(B5 499 709]
|
||||
(COMS (* ; "Page numbering option support")
|
||||
(FNS ROMANNUMERALS))
|
||||
(COMS
|
||||
(* ;; "Foot note support")
|
||||
|
||||
(FNS \TEDIT.FORMAT.FOOTNOTE))))
|
||||
|
||||
(FILESLOAD TEDITDCL)
|
||||
(DECLARE%: EVAL@COMPILE DONTCOPY
|
||||
@@ -26,7 +101,8 @@ Copyright (c) 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1993, 1994 by Venu
|
||||
)
|
||||
|
||||
|
||||
(FILESLOAD (LOADCOMP) TEDITDCL)
|
||||
(FILESLOAD (LOADCOMP)
|
||||
TEDITDCL)
|
||||
)
|
||||
|
||||
|
||||
@@ -43,8 +119,8 @@ Copyright (c) 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1993, 1994 by Venu
|
||||
(GLOBALVARS TEDIT.DEFAULT.FOLIO.LOOKS)
|
||||
)
|
||||
|
||||
(RPAQ? TEDIT.DEFAULT.FOLIO.LOOKS (\TEDIT.PARSE.CHARLOOKS.LIST (QUOTE (FAMILY MODERN SIZE 10 WEIGHT MEDIUM SLOPE REGULAR)))
|
||||
)
|
||||
(RPAQ? TEDIT.DEFAULT.FOLIO.LOOKS (\TEDIT.PARSE.CHARLOOKS.LIST '(FAMILY MODERN SIZE 10 WEIGHT MEDIUM
|
||||
SLOPE REGULAR)))
|
||||
|
||||
|
||||
|
||||
@@ -57,8 +133,10 @@ Copyright (c) 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1993, 1994 by Venu
|
||||
|
||||
(RPAQQ MINPAGE# 1)
|
||||
|
||||
(RPAQ TEDIT.PAGE.FRAMES (LIST (TEDIT.SINGLE.PAGEFORMAT NIL NIL NIL NIL NIL 72 72 72 72 NIL 1) (TEDIT.SINGLE.PAGEFORMAT T 72 756 NIL (QUOTE LEFT) 72 72 72 72 NIL 1) (TEDIT.SINGLE.PAGEFORMAT T 540 756 NIL (QUOTE RIGHT) 72 72 72 72 NIL 1))
|
||||
)
|
||||
(RPAQ TEDIT.PAGE.FRAMES
|
||||
(LIST (TEDIT.SINGLE.PAGEFORMAT NIL NIL NIL NIL NIL 72 72 72 72 NIL 1)
|
||||
(TEDIT.SINGLE.PAGEFORMAT T 72 756 NIL 'LEFT 72 72 72 72 NIL 1)
|
||||
(TEDIT.SINGLE.PAGEFORMAT T 540 756 NIL 'RIGHT 72 72 72 72 NIL 1)))
|
||||
|
||||
|
||||
|
||||
@@ -677,25 +755,26 @@ Copyright (c) 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1993, 1994 by Venu
|
||||
(replace (PAGEFORMATTINGSTATE CHNO) of FORMATTINGSTATE with CHNO])
|
||||
|
||||
(TEDIT.FORMATHEADING
|
||||
[LAMBDA (TEXTOBJ PRSTREAM FORMATTINGSTATE PAGEREGION) (* ; "Edited 9-Oct-90 13:24 by jds")
|
||||
[LAMBDA (TEXTOBJ PRSTREAM FORMATTINGSTATE PAGEREGION) (* ; "Edited 31-Jan-2022 23:30 by rmk")
|
||||
(* ; "Edited 9-Oct-90 13:24 by jds")
|
||||
|
||||
(* ;; "Grab text from the TEXTOBJ, starting with CH#, and use it to fill REGION on a page. Return a list of line descriptors which, taken together, fill the region.")
|
||||
|
||||
(PROG ((CHNO 1)
|
||||
[REGION (for VALUE in (fetch (PAGEREGION REGIONSPEC) of PAGEREGION)
|
||||
collect (FIXR (FTIMES (DSPSCALE NIL PRSTREAM)
|
||||
VALUE]
|
||||
VALUE]
|
||||
(LOCALINFO (fetch (PAGEREGION REGIONLOCALINFO) of PAGEREGION))
|
||||
HEADINGSTREAM HEADINGTEXTOBJ PRECONDITIONS THISLINE LINE YBOT (FORCENEXTPAGE NIL)
|
||||
LINES HEADING)
|
||||
[COND
|
||||
((SETQ PRECONDITIONS (LISTGET LOCALINFO 'PRECONDITIONS))
|
||||
(* ;
|
||||
"There are preconditions for this heading to appear. Check them.")
|
||||
"There are preconditions for this heading to appear. Check them.")
|
||||
(COND
|
||||
((for FORM inside PRECONDITIONS thereis (NOT (EVAL FORM)))
|
||||
(* ;
|
||||
"One of the predicates returned NIL, so don't display this heading.")
|
||||
"One of the predicates returned NIL, so don't display this heading.")
|
||||
(RETURN]
|
||||
(COND
|
||||
([NOT (SETQ HEADING (LISTGET (fetch (PAGEFORMATTINGSTATE PAGEHEADINGS) of
|
||||
@@ -703,23 +782,20 @@ Copyright (c) 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1993, 1994 by Venu
|
||||
)
|
||||
(LISTGET LOCALINFO 'HEADINGTYPE]
|
||||
(* ;
|
||||
"There's no text for this heading. Punt.")
|
||||
"There's no text for this heading. Punt.")
|
||||
(RETURN)))
|
||||
[SETQ HEADINGTEXTOBJ (fetch (TEXTSTREAM TEXTOBJ)
|
||||
of (SETQ HEADINGSTREAM (OPENTEXTSTREAM
|
||||
"" NIL NIL NIL
|
||||
(LIST 'PARALOOKS (fetch
|
||||
(PIECE PPARALOOKS)
|
||||
of (CAR HEADING
|
||||
]
|
||||
[SETQ HEADINGTEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of (SETQ HEADINGSTREAM
|
||||
(OPENTEXTSTREAM
|
||||
NIL NIL NIL NIL
|
||||
(LIST 'PARALOOKS (fetch (PIECE
|
||||
PPARALOOKS
|
||||
)
|
||||
of (CAR HEADING]
|
||||
(\TEDIT.INSERT.PIECES HEADINGTEXTOBJ 1 HEADING)
|
||||
(for PC in HEADING do (add (fetch (TEXTOBJ TEXTLEN) of
|
||||
HEADINGTEXTOBJ
|
||||
)
|
||||
(fetch (PIECE PLEN) of PC)))
|
||||
(SETQ LINES (while (AND (ILESSP CHNO (fetch (TEXTOBJ TEXTLEN) of HEADINGTEXTOBJ
|
||||
))
|
||||
(NOT FORCENEXTPAGE))
|
||||
(for PC in HEADING do (add (fetch (TEXTOBJ TEXTLEN) of HEADINGTEXTOBJ)
|
||||
(fetch (PIECE PLEN) of PC)))
|
||||
(SETQ LINES (while (AND (ILESSP CHNO (fetch (TEXTOBJ TEXTLEN) of HEADINGTEXTOBJ))
|
||||
(NOT FORCENEXTPAGE))
|
||||
collect (SETQ THISLINE (create THISLINE))
|
||||
(SETQ FORCENEXTPAGE (\TEDIT.HARDCOPY.FORMATLINE HEADINGTEXTOBJ
|
||||
(fetch (REGION WIDTH) of REGION)
|
||||
@@ -729,36 +805,31 @@ Copyright (c) 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1993, 1994 by Venu
|
||||
PRSTREAM T))
|
||||
(replace (LINEDESCRIPTOR CACHE) of LINE with THISLINE)
|
||||
(* ;
|
||||
"Mark this line as having cached print info.")
|
||||
(replace (LINEDESCRIPTOR LTEXTOBJ) of LINE with
|
||||
HEADINGSTREAM
|
||||
) (* ;
|
||||
"And remember the document it came from.")
|
||||
"Mark this line as having cached print info.")
|
||||
(replace (LINEDESCRIPTOR LTEXTOBJ) of LINE with HEADINGSTREAM)
|
||||
(* ;
|
||||
"And remember the document it came from.")
|
||||
(add (fetch (LINEDESCRIPTOR LEFTMARGIN) of LINE)
|
||||
(fetch (REGION LEFT) of REGION))
|
||||
(fetch (REGION LEFT) of REGION))
|
||||
(add (fetch (LINEDESCRIPTOR RIGHTMARGIN) of LINE)
|
||||
(fetch (REGION LEFT) of REGION))
|
||||
(fetch (REGION LEFT) of REGION))
|
||||
(* ; "Format the next possible line")
|
||||
[COND
|
||||
[YBOT (* ;
|
||||
"We're into it; take account of this line's height")
|
||||
(SETQ YBOT (IDIFFERENCE YBOT (fetch (LINEDESCRIPTOR
|
||||
LHEIGHT)
|
||||
"We're into it; take account of this line's height")
|
||||
(SETQ YBOT (IDIFFERENCE YBOT (fetch (LINEDESCRIPTOR LHEIGHT)
|
||||
of LINE]
|
||||
(T (* ;
|
||||
"Just starting out; find the line's position with respect to the top of the region to be filled.")
|
||||
(SETQ YBOT (IDIFFERENCE (fetch (REGION BOTTOM) of REGION
|
||||
)
|
||||
(fetch (LINEDESCRIPTOR DESCENT)
|
||||
of LINE]
|
||||
"Just starting out; find the line's position with respect to the top of the region to be filled.")
|
||||
(SETQ YBOT (IDIFFERENCE (fetch (REGION BOTTOM) of REGION)
|
||||
(fetch (LINEDESCRIPTOR DESCENT) of LINE]
|
||||
(* ; "This line is good; use it.")
|
||||
(replace (LINEDESCRIPTOR YBOT) of LINE with YBOT)
|
||||
(replace (LINEDESCRIPTOR YBASE) of LINE
|
||||
with (IPLUS YBOT (fetch (LINEDESCRIPTOR DESCENT)
|
||||
of LINE)))
|
||||
with (IPLUS YBOT (fetch (LINEDESCRIPTOR DESCENT) of LINE)))
|
||||
(SETQ CHNO (ADD1 (fetch (LINEDESCRIPTOR CHARLIM) of LINE)))
|
||||
(* ;
|
||||
"Keep track of the next character...")
|
||||
"Keep track of the next character...")
|
||||
LINE))
|
||||
(RETURN LINES])
|
||||
|
||||
@@ -1216,13 +1287,14 @@ Copyright (c) 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1993, 1994 by Venu
|
||||
FORMATTINGSTATE FINAL-CHNO])
|
||||
|
||||
(TEDIT.FORMATFOLIO
|
||||
[LAMBDA (TEXTOBJ PRSTREAM FORMATTINGSTATE REGIONSPEC) (* ; "Edited 30-May-91 12:51 by jds")
|
||||
[LAMBDA (TEXTOBJ PRSTREAM FORMATTINGSTATE REGIONSPEC) (* ; "Edited 31-Jan-2022 23:33 by rmk")
|
||||
(* ; "Edited 30-May-91 12:51 by jds")
|
||||
|
||||
(* ;; "Print a page number (called a %"folio%" in the biz) at the location and with the alignment specified in the REGIONSPEC.")
|
||||
|
||||
(PROG ([REGION (for VALUE in (fetch (PAGEREGION REGIONSPEC) of REGIONSPEC)
|
||||
collect (FIXR (FTIMES (DSPSCALE NIL PRSTREAM)
|
||||
VALUE]
|
||||
VALUE]
|
||||
(FOLIOINFO (fetch (PAGEREGION REGIONLOCALINFO) of REGIONSPEC))
|
||||
(FORCENEXTPAGE NIL)
|
||||
(CHNO 1)
|
||||
@@ -1233,36 +1305,33 @@ Copyright (c) 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1993, 1994 by Venu
|
||||
TEDIT.DEFAULT.FOLIO.LOOKS))
|
||||
(SETQ NOFIRSTPAGE (LISTGET FOLIOINFO 'NOFIRSTPAGE))
|
||||
(SETQ INFOLIST (LISTGET FOLIOINFO 'FORMATINFO)) (* ;
|
||||
"A LIST OF (FORMAT PRETEXT POSTTEXT)")
|
||||
"A LIST OF (FORMAT PRETEXT POSTTEXT)")
|
||||
(SETQ FOLIOFORMAT (CAR INFOLIST))
|
||||
(SETQ PRETEXT (CADR INFOLIST))
|
||||
(SETQ POSTTEXT (CADDR INFOLIST))
|
||||
[SETQ PAGE# (COND
|
||||
((fetch (PAGEFORMATTINGSTATE PAGE#TEXT) of FORMATTINGSTATE)
|
||||
(MKSTRING (fetch (PAGEFORMATTINGSTATE PAGE#TEXT) of FORMATTINGSTATE
|
||||
)))
|
||||
(MKSTRING (fetch (PAGEFORMATTINGSTATE PAGE#TEXT) of FORMATTINGSTATE)))
|
||||
(T (SELECTQ FOLIOFORMAT
|
||||
(LOWERROMAN (ROMANNUMERALS (fetch (PAGEFORMATTINGSTATE PAGE#)
|
||||
of FORMATTINGSTATE)))
|
||||
of FORMATTINGSTATE)))
|
||||
(UPPERROMAN (ROMANNUMERALS (fetch (PAGEFORMATTINGSTATE PAGE#)
|
||||
of FORMATTINGSTATE)
|
||||
of FORMATTINGSTATE)
|
||||
T))
|
||||
(MKSTRING (fetch (PAGEFORMATTINGSTATE PAGE#) of
|
||||
FORMATTINGSTATE
|
||||
]
|
||||
(MKSTRING (fetch (PAGEFORMATTINGSTATE PAGE#) of FORMATTINGSTATE]
|
||||
[COND
|
||||
(PRETEXT (SETQ PAGE# (CONCAT PRETEXT PAGE#]
|
||||
[COND
|
||||
(POSTTEXT (SETQ PAGE# (CONCAT PAGE# POSTTEXT]
|
||||
[SETQ FOLIOTEXTOBJ (TEXTOBJ (SETQ FOLIOSTREAM (OPENTEXTSTREAM PAGE# NIL NIL NIL
|
||||
(LIST 'PARALOOKS PARALOOKS
|
||||
'LOOKS CHARLOOKS]
|
||||
[SETQ FOLIOTEXTOBJ (TEXTOBJ (SETQ FOLIOSTREAM (OPENTEXTSTREAM (OPENSTRINGSTREAM PAGE#)
|
||||
NIL NIL NIL (LIST 'PARALOOKS PARALOOKS
|
||||
'LOOKS CHARLOOKS]
|
||||
(COND
|
||||
((OR (NOT (fetch (PAGEFORMATTINGSTATE FIRSTPAGE) of FORMATTINGSTATE))
|
||||
(NOT NOFIRSTPAGE)) (* ;
|
||||
"If this isn't the first page, OR we want a page # on the first page, go ahead and format it.")
|
||||
"If this isn't the first page, OR we want a page # on the first page, go ahead and format it.")
|
||||
(RETURN (while (AND (ILEQ CHNO (fetch (TEXTOBJ TEXTLEN) of FOLIOTEXTOBJ))
|
||||
(NOT FORCENEXTPAGE))
|
||||
(NOT FORCENEXTPAGE))
|
||||
collect (SETQ THISLINE (create THISLINE))
|
||||
(SETQ FORCENEXTPAGE (\TEDIT.HARDCOPY.FORMATLINE FOLIOTEXTOBJ
|
||||
(fetch (REGION WIDTH) of REGION)
|
||||
@@ -1271,41 +1340,36 @@ Copyright (c) 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1993, 1994 by Venu
|
||||
))
|
||||
PRSTREAM))
|
||||
(replace (LINEDESCRIPTOR CACHE) of LINE with THISLINE)
|
||||
(replace (LINEDESCRIPTOR LTEXTOBJ) of LINE with
|
||||
FOLIOSTREAM)
|
||||
(replace (LINEDESCRIPTOR LTEXTOBJ) of LINE with FOLIOSTREAM)
|
||||
(add (fetch (LINEDESCRIPTOR LEFTMARGIN) of LINE)
|
||||
(fetch (REGION LEFT) of REGION))
|
||||
(fetch (REGION LEFT) of REGION))
|
||||
(add (fetch (LINEDESCRIPTOR RIGHTMARGIN) of LINE)
|
||||
(fetch (REGION LEFT) of REGION))
|
||||
(fetch (REGION LEFT) of REGION))
|
||||
(* ; "Format the next possible line")
|
||||
(SETQ CHNO (ADD1 (fetch (LINEDESCRIPTOR CHARLIM) of LINE)))
|
||||
(* ;
|
||||
"Keep track of the next character...")
|
||||
"Keep track of the next character...")
|
||||
[COND
|
||||
[YBOT (* ;
|
||||
"We're into it; take account of this line's height")
|
||||
(SETQ YBOT (IDIFFERENCE YBOT (fetch (LINEDESCRIPTOR
|
||||
LHEIGHT)
|
||||
"We're into it; take account of this line's height")
|
||||
(SETQ YBOT (IDIFFERENCE YBOT (fetch (LINEDESCRIPTOR LHEIGHT)
|
||||
of LINE]
|
||||
(T (* ;
|
||||
"Just starting out; find the line's position with respect to the top of the region to be filled.")
|
||||
"Just starting out; find the line's position with respect to the top of the region to be filled.")
|
||||
(SETQ YBOT (SETQ YBOT (IDIFFERENCE (fetch (REGION BOTTOM)
|
||||
of REGION)
|
||||
(fetch (LINEDESCRIPTOR DESCENT)
|
||||
of LINE]
|
||||
(COND
|
||||
((ILESSP YBOT (IDIFFERENCE (fetch (REGION BOTTOM) of REGION
|
||||
)
|
||||
(fetch (LINEDESCRIPTOR DESCENT)
|
||||
of LINE)))
|
||||
((ILESSP YBOT (IDIFFERENCE (fetch (REGION BOTTOM) of REGION)
|
||||
(fetch (LINEDESCRIPTOR DESCENT) of LINE)))
|
||||
(* ;
|
||||
"This line hangs off the bottom; punt it.")
|
||||
"This line hangs off the bottom; punt it.")
|
||||
NIL)
|
||||
(T (* ; "This line is good; use it.")
|
||||
(replace (LINEDESCRIPTOR YBOT) of LINE with YBOT)
|
||||
(replace (LINEDESCRIPTOR YBASE) of LINE
|
||||
with (IPLUS YBOT (fetch (LINEDESCRIPTOR DESCENT)
|
||||
of LINE)))
|
||||
with (IPLUS YBOT (fetch (LINEDESCRIPTOR DESCENT) of LINE)))
|
||||
LINE])
|
||||
|
||||
(\TEDIT.FORMAT.FOUNDBOX?
|
||||
@@ -1696,8 +1760,19 @@ Copyright (c) 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1993, 1994 by Venu
|
||||
(GLOBALVARS TEDIT.PAPER.SIZES)
|
||||
)
|
||||
|
||||
(RPAQQ TEDIT.PAPER.SIZES ((A0 2384 3370) (A1 1684 2384) (A2 1191 1684) (A3 842 1191) (A4 595 842) (A5 420 595) (B0 2835 4008) (B1 2004 2835) (B2 1417 2004) (B3 1001 1417) (B4 709 1001) (B5 499 709))
|
||||
)
|
||||
(RPAQQ TEDIT.PAPER.SIZES
|
||||
((A0 2384 3370)
|
||||
(A1 1684 2384)
|
||||
(A2 1191 1684)
|
||||
(A3 842 1191)
|
||||
(A4 595 842)
|
||||
(A5 420 595)
|
||||
(B0 2835 4008)
|
||||
(B1 2004 2835)
|
||||
(B2 1417 2004)
|
||||
(B3 1001 1417)
|
||||
(B4 709 1001)
|
||||
(B5 499 709)))
|
||||
|
||||
|
||||
|
||||
@@ -1825,15 +1900,15 @@ Copyright (c) 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1993, 1994 by Venu
|
||||
(PUTPROPS TEDITPAGE COPYRIGHT ("Venue & Xerox Corporation" 1984 1985 1986 1987 1988 1989 1990 1991
|
||||
1993 1994))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (3553 7108 (TEDIT.GET.PAGEFRAMES 3563 . 3915) (TEDIT.PARSE.PAGEFRAMES 3917 . 5620) (
|
||||
TEDIT.PUT.PAGEFRAMES 5622 . 6250) (TEDIT.UNPARSE.PAGEFRAMES 6252 . 7106)) (7154 19997 (
|
||||
TEDIT.SINGLE.PAGEFORMAT 7164 . 17723) (TEDIT.COMPOUND.PAGEFORMAT 17725 . 18351) (TEDIT.PAGEFORMAT
|
||||
18353 . 19995)) (20084 97190 (TEDIT.FORMAT.HARDCOPY 20094 . 31166) (TEDIT.FORMATBOX 31168 . 46475) (
|
||||
TEDIT.FORMATHEADING 46477 . 53053) (TEDIT.FORMATPAGE 53055 . 64626) (TEDIT.FORMATTEXTBOX 64628 . 84946
|
||||
) (TEDIT.FORMATFOLIO 84948 . 91873) (\TEDIT.FORMAT.FOUNDBOX? 91875 . 94064) (TEDIT.SKIP.SPECIALCOND
|
||||
94066 . 97188)) (97270 100471 (TEDIT.HARDCOPY.PAGEHEADING 97280 . 100469)) (100580 110247 (
|
||||
TEDIT.HARDCOPY-COLUMN-END 100590 . 110245)) (110292 115296 (SCALEPAGEUNITS 110302 . 111530) (
|
||||
SCALEPAGEXUNITS 111532 . 112296) (SCALEPAGEYUNITS 112298 . 113063) (\TEDIT.PAPERHEIGHT 113065 . 113994
|
||||
) (\TEDIT.PAPERWIDTH 113996 . 115294)) (115618 119532 (ROMANNUMERALS 115628 . 119530)) (119568 123634
|
||||
(\TEDIT.FORMAT.FOOTNOTE 119578 . 123632)))))
|
||||
(FILEMAP (NIL (5196 8751 (TEDIT.GET.PAGEFRAMES 5206 . 5558) (TEDIT.PARSE.PAGEFRAMES 5560 . 7263) (
|
||||
TEDIT.PUT.PAGEFRAMES 7265 . 7893) (TEDIT.UNPARSE.PAGEFRAMES 7895 . 8749)) (8797 21640 (
|
||||
TEDIT.SINGLE.PAGEFORMAT 8807 . 19366) (TEDIT.COMPOUND.PAGEFORMAT 19368 . 19994) (TEDIT.PAGEFORMAT
|
||||
19996 . 21638)) (21727 98018 (TEDIT.FORMAT.HARDCOPY 21737 . 32809) (TEDIT.FORMATBOX 32811 . 48118) (
|
||||
TEDIT.FORMATHEADING 48120 . 54287) (TEDIT.FORMATPAGE 54289 . 65860) (TEDIT.FORMATTEXTBOX 65862 . 86180
|
||||
) (TEDIT.FORMATFOLIO 86182 . 92701) (\TEDIT.FORMAT.FOUNDBOX? 92703 . 94892) (TEDIT.SKIP.SPECIALCOND
|
||||
94894 . 98016)) (98098 101299 (TEDIT.HARDCOPY.PAGEHEADING 98108 . 101297)) (101408 111075 (
|
||||
TEDIT.HARDCOPY-COLUMN-END 101418 . 111073)) (111120 116124 (SCALEPAGEUNITS 111130 . 112358) (
|
||||
SCALEPAGEXUNITS 112360 . 113124) (SCALEPAGEYUNITS 113126 . 113891) (\TEDIT.PAPERHEIGHT 113893 . 114822
|
||||
) (\TEDIT.PAPERWIDTH 114824 . 116122)) (116540 120454 (ROMANNUMERALS 116550 . 120452)) (120490 124556
|
||||
(\TEDIT.FORMAT.FOOTNOTE 120500 . 124554)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
213
library/TEXEC
213
library/TEXEC
@@ -1,27 +1,23 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10)
|
||||
(FILECREATED "30-May-91 19:21:21" |{PELE:MV:ENVOS}<LISPCORE>LIBRARY>TEXEC.;5| 197129
|
||||
|
||||
|changes| |to:| (FNS TEXEC.GET TEXEC.INCLUDE TEXEC.FIND.FORWARD TEXEC.FIND.BACKWARD
|
||||
TEDIT.FIND.BACKWARD TEDIT.BASICFIND.BACKWARD TEXEC.FILLBUFFER
|
||||
TEXEC.FILLBUFFER.TCLASS TEXEC.CHSELPENDING TEXEC.FILLBUFFER.WORDDELETE
|
||||
TEXEC.FILLBUFFER.LINEDELETE TEXEC.FLASHCARET TEXEC.NTHBACKCHNUM
|
||||
TEXEC.EOTP TEXEC.INSERTCHAR TEXEC.\\CHDEL1 TEDIT.SCROLL?
|
||||
TEXEC.DISPLAYTEXT \\TEXEC.TEXTBOUT \\TEXEC.TEXTBOUT1 \\TEXEC.TEXTBOUT2
|
||||
\\TEXEC.TEXTBOUT4 \\TEXEC.SELFN)
|
||||
(VARS TEXECCOMS)
|
||||
(FILECREATED " 1-Feb-2022 09:24:13" |{DSK}<Users>kaplan>Local>medley3.5>my-medley>library>TEXEC.;2| 195948
|
||||
|
||||
|previous| |date:| "13-Jun-90 00:19:00" |{PELE:MV:ENVOS}<LISPCORE>LIBRARY>TEXEC.;2|)
|
||||
:CHANGES-TO (VARS TEXECCOMS TEXEC.ICON TEXEC.ICON.MASK TEXEC.TITLED.ICON.TEMPLATE)
|
||||
(FNS TEXEC.OPENTEXTSTREAM TEXEC.INCLUDE)
|
||||
|
||||
:PREVIOUS-DATE "30-May-91 19:21:21"
|
||||
|{DSK}<Users>kaplan>Local>medley3.5>my-medley>library>TEXEC.;1|)
|
||||
|
||||
|
||||
; Copyright (c) 1985, 1900, 1986, 1987, 1988, 1989, 1990, 1991 by Venue & Xerox Corporation. All rights reserved.
|
||||
; Copyright (c) 1985, 1900, 1986-1991 by Venue & Xerox Corporation.
|
||||
|
||||
(PRETTYCOMPRINT TEXECCOMS)
|
||||
|
||||
(RPAQQ TEXECCOMS
|
||||
((COMS (* \;
|
||||
"To support development and compilation")
|
||||
"To support development and compilation")
|
||||
(DECLARE\: DONTCOPY EVAL@COMPILE (FILES (LOADCOMP)
|
||||
ATERM TEDITDECLS)))
|
||||
ATERM TEDITDCL)))
|
||||
(COMS
|
||||
(* |;;| "THE FILLBUFFER REPLACEMENT CODE")
|
||||
|
||||
@@ -61,7 +57,7 @@
|
||||
(DECLARE\: DONTCOPY EVAL@COMPILE
|
||||
|
||||
(FILESLOAD (LOADCOMP)
|
||||
ATERM TEDITDECLS)
|
||||
ATERM TEDITDCL)
|
||||
)
|
||||
|
||||
|
||||
@@ -160,35 +156,32 @@
|
||||
(GO LP))))
|
||||
|
||||
(TEXEC.OPENTEXTSTREAM
|
||||
(LAMBDA (WINDOW MENUFN) (* \; "Edited 13-Jun-90 00:17 by mitani")
|
||||
(LAMBDA (WINDOW MENUFN) (* \; "Edited 13-Jun-90 00:17 by mitani")
|
||||
|
||||
(* |;;| "Initialize and return TEDIT TEXTSTREAM")
|
||||
(* |;;| "Initialize and return TEDIT TEXTSTREAM")
|
||||
|
||||
(LET* ((TEXSTREAM (OPENTEXTSTREAM NIL WINDOW NIL NIL (LIST 'TERMTABLE \\PRIMTERMTABLE
|
||||
'PROMPTWINDOW
|
||||
'DON\'T)))
|
||||
(TEXTOBJ (TEXTOBJ TEXSTREAM))
|
||||
(TEXLEN (|fetch| (TEXTOBJ TEXTLEN)
|
||||
TEXTOBJ))) (* \;
|
||||
"force shift select typein to be put in keyboard buffer ")
|
||||
TEXTOBJ))) (* \;
|
||||
"force shift select typein to be put in keyboard buffer ")
|
||||
(|replace| (TEXTOBJ TXTEDITING) |of| TEXTOBJ |with| T)
|
||||
(TEXTPROP TEXSTREAM 'STARTINGEOF TEXLEN)
|
||||
(TEXTPROP TEXSTREAM 'COPYBYBKSYSBUF T) (* \;
|
||||
"forces COPY-SELECT to unread chars into TTY buffer")
|
||||
(TEXTPROP TEXSTREAM 'COPYBYBKSYSBUF T) (* \;
|
||||
"forces COPY-SELECT to unread chars into TTY buffer")
|
||||
(TEXTPROP TEXSTREAM 'SELFN (FUNCTION \\TEXEC.SELFN))
|
||||
(* \;
|
||||
"Limits selection to current input")
|
||||
(* \;
|
||||
"Limits selection to current input")
|
||||
(|replace| (STREAM STRMBOUTFN) |of| TEXSTREAM |with| '\\TEXEC.TEXTBOUT)
|
||||
(|replace| (SELECTION SET) |of| (|fetch| (TEXTOBJ SEL) |of| TEXTOBJ)
|
||||
|with| T)
|
||||
(|replace| (SELECTION SET) |of| (|fetch| (TEXTOBJ SEL) |of| TEXTOBJ) |with| T)
|
||||
(|replace| (SELECTION L1) |of| (|fetch| (TEXTOBJ SEL) |of| TEXTOBJ)
|
||||
|with| (LIST (|fetch| DESC |of| (|fetch| (TEXTOBJ THISLINE) |of|
|
||||
TEXTOBJ))))
|
||||
(* \;
|
||||
"hookup middle button menu instead of TEDIT menu")
|
||||
|with| (LIST (|fetch| DESC |of| (|fetch| (TEXTOBJ THISLINE) |of| TEXTOBJ))))
|
||||
(* \;
|
||||
"hookup middle button menu instead of TEDIT menu")
|
||||
(WINDOWPROP WINDOW 'TEDIT.TITLEMENUFN MENUFN)
|
||||
(CHANGEFONT (|fetch| (CHARLOOKS CLFONT) |of| (|fetch| (TEXTOBJ CARETLOOKS)
|
||||
|of| TEXTOBJ))
|
||||
(CHANGEFONT (|fetch| (CHARLOOKS CLFONT) |of| (|fetch| (TEXTOBJ CARETLOOKS) |of| TEXTOBJ))
|
||||
TEXSTREAM)
|
||||
TEXSTREAM)))
|
||||
|
||||
@@ -483,30 +476,30 @@
|
||||
(T (TEDIT.PROMPTPRINT TEXTOBJ "[Get aborted.]" T))))))
|
||||
|
||||
(TEXEC.INCLUDE
|
||||
(LAMBDA (STREAM FILE START END) (* \; "Edited 30-May-91 19:17 by jds")
|
||||
(LAMBDA (STREAM FILE START END) (* \; "Edited 30-May-91 19:17 by jds")
|
||||
|
||||
(* |Obtain| \a |file| |name,| |and| |include| |that| |file's| |contents| |at|
|
||||
|the| |place| |where| |the| |caret| |is.|)
|
||||
|the| |place| |where| |the| |caret| |is.|)
|
||||
|
||||
(* |Returns| T |if| |the| |insertion| |happened,| NIL |if| |there| |was| |no|
|
||||
|place| |to| |put| |it.|)
|
||||
|place| |to| |put| |it.|)
|
||||
|
||||
(SETQ STREAM (TEXTOBJ STREAM))
|
||||
(PROG ((SEL (|fetch| (TEXTOBJ SEL) |of| STREAM))
|
||||
PCTB TEXTLEN NFILE NNFILE INSERTCH# INSPC LEN INSPC# PCLST NPC WASOPEN PCCOUNT NSTREAM)
|
||||
(COND
|
||||
((|fetch| (SELECTION SET) |of| SEL) (* |There| |is| \a |place| |to| |do|
|
||||
|the| |include.|)
|
||||
((|fetch| (SELECTION SET) |of| SEL) (* |There| |is| \a |place| |to| |do|
|
||||
|the| |include.|)
|
||||
(SETQ NFILE (OR FILE (\\TEDIT.MAKEFILENAME (TEDIT.GETINPUT STREAM
|
||||
"Name of the file to load: "))))
|
||||
(COND
|
||||
((NOT NFILE) (* I\f |no| |file| |was| |given,|
|
||||
|don't| |bother| |INCLUDEing.|)
|
||||
|don't| |bother| |INCLUDEing.|)
|
||||
(TEDIT.PROMPTPRINT STREAM "[Include aborted.]" T)
|
||||
(RETURN))
|
||||
((STREAMP NFILE))
|
||||
((NOT (INFILEP NFILE)) (* |Can't| |find| |the| |file.|
|
||||
|Put| |out| \a |message.|)
|
||||
|Put| |out| \a |message.|)
|
||||
(TEDIT.PROMPTPRINT STREAM "[File not found.]")
|
||||
(RETURN)))
|
||||
(SETQ NNFILE (OPENSTREAM '{NODIRCORE} 'OUTPUT 'NEW))
|
||||
@@ -516,81 +509,78 @@
|
||||
(SETQ WASOPEN T)
|
||||
NFILE)
|
||||
(T (* |Wasn't| |open| --
|
||||
|need| |to| |open| |it| |for|
|
||||
|input...|)
|
||||
|need| |to| |open| |it| |for|
|
||||
|input...|)
|
||||
(OPENFILE NFILE 'INPUT)))) (* |And| |copy| |the| |file-section|
|
||||
|into| |it.|)
|
||||
|into| |it.|)
|
||||
(COPYBYTES NFILE NNFILE (OR START 0)
|
||||
(OR END (GETEOFPTR NFILE)))
|
||||
|
||||
(* |Have| |to| |explicitly| |fill| |in| 0 |and| EOFPTR\, |because| |if| |the|
|
||||
|file| |was| |open| |already,| NIL\s |would| |only| |copy| |from| |current|
|
||||
|fileptr| |to| EOF.)
|
||||
|file| |was| |open| |already,| NIL\s |would| |only| |copy| |from| |current|
|
||||
|fileptr| |to| EOF.)
|
||||
|
||||
(OR WASOPEN (CLOSEF NFILE)) (* I\f |the| |file| |didn't| |come|
|
||||
|to| |use| |open,| |close| |it.|)
|
||||
|to| |use| |open,| |close| |it.|)
|
||||
(CLOSEF NNFILE)
|
||||
(SETQ NFILE NNFILE)
|
||||
(SETQ START (SETQ END NIL)) (* |Then| |pretend| |nothing|
|
||||
|happened.|)
|
||||
(TEDIT.DO.BLUEPENDINGDELETE SEL STREAM) (* |Delete| |any| |text,| |if|
|
||||
|need| |be|)
|
||||
|happened.|)
|
||||
(TEDIT.DO.BLUEPENDINGDELETE SEL STREAM) (* |Delete| |any| |text,| |if| |need|
|
||||
|be|)
|
||||
(SETQ TEXTLEN (|fetch| (TEXTOBJ TEXTLEN) |of| STREAM))
|
||||
|
||||
(* W\e |need| |the| |POST-deletion| |text| |length| |for| |later,| |so| |this|
|
||||
|must| |come| |after| |the| |b-p-d.|)
|
||||
|must| |come| |after| |the| |b-p-d.|)
|
||||
|
||||
(\\SHOWSEL SEL NIL NIL) (* |Turn| |off| SEL\s |before| |we|
|
||||
|go| |any| |further|)
|
||||
|go| |any| |further|)
|
||||
(SETQ NFILE (TEXTOBJ (SETQ NSTREAM (OPENTEXTSTREAM (OPENSTREAM NFILE 'INPUT)
|
||||
NIL NIL NIL (LIST 'FONT (
|
||||
\\TEDIT.GET.INSERT.CHARLOOKS
|
||||
STREAM SEL)
|
||||
'PARALOOKS
|
||||
(|fetch| (TEXTOBJ
|
||||
FMTSPEC)
|
||||
(|fetch| (TEXTOBJ FMTSPEC)
|
||||
|of| STREAM))))))
|
||||
(* |Get| \a |textobj| |to|
|
||||
|describe| |the| |include| |source|
|
||||
|file| (|need| NSTREAM |so| |that|
|
||||
|if| |we| |have| |to| |convert| |it|
|
||||
|to| |formatted,| |we| |won't|
|
||||
|have| |lost| |the|
|
||||
|textstream--and| |thus| |smash|
|
||||
|the| |free| |list.|))
|
||||
(* |Get| \a |textobj| |to| |describe|
|
||||
|the| |include| |source| |file|
|
||||
(|need| NSTREAM |so| |that| |if| |we|
|
||||
|have| |to| |convert| |it| |to|
|
||||
|formatted,| |we| |won't| |have|
|
||||
|lost| |the| |textstream--and| |thus|
|
||||
|smash| |the| |free| |list.|))
|
||||
(COND
|
||||
((AND (|fetch| (TEXTOBJ FORMATTEDP) |of| NFILE)
|
||||
(NOT (|fetch| (TEXTOBJ FORMATTEDP) |of| STREAM)))
|
||||
(* I\f |the| |includED| |text| |is|
|
||||
|formatted| |but| |this| |file|
|
||||
|isn't,| |let's| |format| |it!|)
|
||||
|formatted| |but| |this| |file|
|
||||
|isn't,| |let's| |format| |it!|)
|
||||
(\\TEDIT.CONVERT.TO.FORMATTED STREAM))
|
||||
((AND (|fetch| (TEXTOBJ FORMATTEDP) |of| STREAM)
|
||||
(NOT (|fetch| (TEXTOBJ FORMATTEDP) |of| NFILE)))
|
||||
|
||||
(* |The| TARGET |document| |is| |formatted,| |but| |the| INCLUDE\d |text|
|
||||
|isn't.| |Better| |format| |it| |before| |completing| |the| |include.|)
|
||||
|isn't.| |Better| |format| |it| |before| |completing| |the| |include.|)
|
||||
|
||||
(\\TEDIT.CONVERT.TO.FORMATTED NFILE)))
|
||||
(SETQ PCTB (|fetch| (TEXTOBJ PCTB) |of| STREAM))
|
||||
(* HERE\, |because| |the|
|
||||
|conversion| |to| |formatted| |will|
|
||||
|lengthen| |the| |pctb|)
|
||||
(* HERE\, |because| |the| |conversion|
|
||||
|to| |formatted| |will| |lengthen|
|
||||
|the| |pctb|)
|
||||
(SETQ INSERTCH# (COND
|
||||
((EQ (|fetch| (SELECTION POINT) |of| SEL)
|
||||
'LEFT)
|
||||
(|fetch| (SELECTION CH#) |of| SEL))
|
||||
(T (|fetch| (SELECTION CHLIM) |of| SEL))))
|
||||
(* |Find| |the| |place| |to| |make|
|
||||
|the| |insertion.|)
|
||||
|the| |insertion.|)
|
||||
(SETQ INSPC# (OR (\\CHTOPCNO INSERTCH# PCTB)
|
||||
(\\EDITELT PCTB |\\PCTBLastPieceOffset|)))
|
||||
(* |Likewise,| |this| |is|
|
||||
|affected| |by| |the|
|
||||
|convert-to-formatted|)
|
||||
(* |Likewise,| |this| |is| |affected|
|
||||
|by| |the| |convert-to-formatted|)
|
||||
(SETQ INSPC (\\EDITELT (|fetch| (TEXTOBJ PCTB) |of| STREAM)
|
||||
(ADD1 INSPC#))) (* |The| |piece| |to| |make| |the|
|
||||
|insertion| |in|)
|
||||
|insertion| |in|)
|
||||
(COND
|
||||
((NEQ INSPC 'LASTPIECE)
|
||||
(COND
|
||||
@@ -600,17 +590,17 @@
|
||||
(|add| INSPC# |\\EltsPerPiece|)
|
||||
(SETQ PCTB (|fetch| (TEXTOBJ PCTB) |of| STREAM))
|
||||
(* |Refresh| |the| PCTB |in| |case|
|
||||
|it| |grew.|)
|
||||
|it| |grew.|)
|
||||
))))
|
||||
(SETQ PCLST (|fetch| (TEXTOBJ PCTB) |of| NFILE))
|
||||
(* A |temporary| |pctb,| |holding|
|
||||
|the| |pieces| |which| |describe|
|
||||
|the| INCLUDE\d |text|)
|
||||
|the| |pieces| |which| |describe|
|
||||
|the| INCLUDE\d |text|)
|
||||
(SETQ LEN (SUB1 (\\EDITELT PCLST (SUB1 (\\EDITELT PCLST |\\PCTBLastPieceOffset|)))))
|
||||
(SETQ PCCOUNT (IDIFFERENCE (SUB1 (\\EDITELT PCLST |\\PCTBLastPieceOffset|))
|
||||
|\\FirstPieceOffset|)) (* |Remember| |how| |many| |slots|
|
||||
|in| |the| PCTB |we| |took| |up|
|
||||
(|i.e.| 2 \x \# |of| |pieces|))
|
||||
|in| |the| PCTB |we| |took| |up|
|
||||
(|i.e.| 2 \x \# |of| |pieces|))
|
||||
(\\TEDIT.INSERT.PIECES STREAM INSERTCH# (SETQ PCLST (\\EDITELT PCLST (ADD1
|
||||
|\\FirstPieceOffset|
|
||||
)))
|
||||
@@ -619,8 +609,8 @@
|
||||
((AND (|fetch| (TEXTOBJ FORMATTEDP) |of| STREAM)
|
||||
(NOT (|fetch| (TEXTOBJ FORMATTEDP) |of| NFILE)))
|
||||
(* I\f |the| |includED| |text| |is|
|
||||
|formatted| |but| |this| |file|
|
||||
|isn't,| |let's| |format| |it!|)
|
||||
|formatted| |but| |this| |file|
|
||||
|isn't,| |let's| |format| |it!|)
|
||||
(\\TEDIT.CONVERT.TO.FORMATTED STREAM INSERTCH# (IPLUS INSERTCH# LEN))))
|
||||
(\\TEDIT.HISTORYADD STREAM (|create| TEDITHISTORYEVENT
|
||||
THACTION _ '|Include|
|
||||
@@ -628,39 +618,34 @@
|
||||
THLEN _ LEN
|
||||
THFIRSTPIECE _ PCLST))
|
||||
(* |Remember| |that| |we| |did|
|
||||
|this,| |so| |it| |can| |be|
|
||||
|undone.|)
|
||||
|this,| |so| |it| |can| |be| |undone.|)
|
||||
(|replace| (TEXTOBJ TEXTLEN) |of| STREAM |with| (IPLUS TEXTLEN LEN))
|
||||
|
||||
(* |Inserting| |the| |pieces| |didn't| |fix| |up| |things| |like| |the|
|
||||
|length| |of| |the| |document,| |so| |do| |it| |now.|)
|
||||
(* |Inserting| |the| |pieces| |didn't| |fix| |up| |things| |like| |the| |length|
|
||||
|of| |the| |document,| |so| |do| |it| |now.|)
|
||||
|
||||
(AND (|fetch| (TEXTOBJ \\WINDOW) |of| STREAM)
|
||||
(\\FIXILINES STREAM SEL INSERTCH# LEN TEXTLEN))
|
||||
(* |Mark| |any| |changed| |lines|
|
||||
|dirty.|)
|
||||
(|replace| (SELECTION CHLIM) |of| SEL |with| (|replace| (SELECTION
|
||||
CH#)
|
||||
|of| SEL
|
||||
|with| (IPLUS INSERTCH#
|
||||
LEN)))
|
||||
|dirty.|)
|
||||
(|replace| (SELECTION CHLIM) |of| SEL |with| (|replace| (SELECTION CH#) |of| SEL
|
||||
|with| (IPLUS INSERTCH# LEN)))
|
||||
|
||||
(* |Now| |fix| |up| |the| |selection| |to| |be| |at| |the| |end| |of| |the|
|
||||
|included| |text,| |point_left,| |character| |selection| |grain.|)
|
||||
|included| |text,| |point_left,| |character| |selection| |grain.|)
|
||||
|
||||
(|replace| (SELECTION DCH) |of| SEL |with| 0)
|
||||
(|replace| (SELECTION DX) |of| SEL |with| 0)
|
||||
(|replace| (SELECTION POINT) |of| SEL |with| 'LEFT)
|
||||
(* S\o |that| |several| |things|
|
||||
INCLUDED |in| |sequence| |fall| |in|
|
||||
|sequence.|)
|
||||
INCLUDED |in| |sequence| |fall| |in|
|
||||
|sequence.|)
|
||||
(|replace| (SELECTION SELKIND) |of| SEL |with| 'CHAR)
|
||||
(|replace| (SELECTION SELOBJ) |of| SEL |with| NIL)
|
||||
(COND
|
||||
((|fetch| (TEXTOBJ \\WINDOW) |of| STREAM)
|
||||
(* |We're| |displaying;|
|
||||
|update| |the| |display| |and| |the|
|
||||
|selection's| |line| |references|)
|
||||
((|fetch| (TEXTOBJ \\WINDOW) |of| STREAM) (* |We're| |displaying;|
|
||||
|update| |the| |display| |and| |the|
|
||||
|selection's| |line| |references|)
|
||||
(TEDIT.UPDATE.SCREEN STREAM)
|
||||
(\\FIXSEL SEL STREAM)
|
||||
(\\SHOWSEL SEL NIL T)))
|
||||
@@ -671,9 +656,9 @@
|
||||
PCOFF _ 0
|
||||
PCNO _ (IPLUS INSPC# PCCOUNT))
|
||||
STREAM) (* |Set| |the| |fileptr| |to| |the|
|
||||
|end| |of| |the| |insertion.|)
|
||||
(TEDIT.SCROLL? STREAM) (* |Scroll| |the| |end| |into|
|
||||
|view| |if| |necessary|)
|
||||
|end| |of| |the| |insertion.|)
|
||||
(TEDIT.SCROLL? STREAM) (* |Scroll| |the| |end| |into| |view|
|
||||
|if| |necessary|)
|
||||
T)
|
||||
(T (TEDIT.PROMPTPRINT STREAM "Please choose the place for the INCLUDE first." T))))))
|
||||
|
||||
@@ -2845,7 +2830,7 @@
|
||||
)
|
||||
|
||||
(APPENDTOVAR |BackgroundMenuCommands| (TEXEC '(TEXEC)
|
||||
"Starts TEXEC in a new window."))
|
||||
"Starts TEXEC in a new window."))
|
||||
|
||||
(READVARS-FROM-STRINGS '(TEXEC.ICON TEXEC.ICON.MASK TEXEC.TITLED.ICON.TEMPLATE)
|
||||
" ( {(READBITMAP)(64 77
|
||||
@@ -3175,21 +3160,21 @@
|
||||
(RPAQ? TEXEC.BUFFERLIMIT 10000)
|
||||
(PUTPROPS TEXEC COPYRIGHT ("Venue & Xerox Corporation" 1985 1900 1986 1987 1988 1989 1990 1991))
|
||||
(DECLARE\: DONTCOPY
|
||||
(FILEMAP (NIL (3793 183206 (TEXEC.BACKSKREAD 3803 . 8427) (TEXEC.OPENTEXTSTREAM 8429 . 10643) (
|
||||
TEXEC.DEFAULT.MENUFN 10645 . 15199) (TEXEC.DO?CMD 15201 . 20519) (TEXEC.CREATEMENU 20521 . 20979) (
|
||||
TEXEC.GET 20981 . 29816) (TEXEC.INCLUDE 29818 . 43700) (TEXEC.FIND.FORWARD 43702 . 56590) (
|
||||
TEXEC.FIND.BACKWARD 56592 . 70094) (TEDIT.FIND.BACKWARD 70096 . 75573) (TEDIT.BASICFIND.BACKWARD 75575
|
||||
. 80229) (TEXEC.MENU.WHENHELDFN 80231 . 80890) (TEXEC.SHRINK.ICONCREATE 80892 . 83695) (
|
||||
TEXEC.FILLBUFFER 83697 . 100131) (TEXEC.FILLBUFFER.TCLASS 100133 . 106473) (TEXEC.CHSELPENDING 106475
|
||||
. 114965) (TEXEC.FILLBUFFER.CHARDELETE 114967 . 117022) (TEXEC.FILLBUFFER.WORDDELETE 117024 . 122152)
|
||||
(TEXEC.FILLBUFFER.LINEDELETE 122154 . 125036) (TEXEC.PARENCOUNT 125038 . 126427) (TEXEC.PARENMATCH
|
||||
126429 . 127969) (TEXEC.FLASHCARET 127971 . 130630) (TEXEC.TEXTSTREAM.TO.LINEBUF 130632 . 133319) (
|
||||
TEXEC.FIX 133321 . 136490) (TEXEC.NTHBUFCHARBACK 136492 . 137555) (TEXEC.NTHBACKCHNUM 137557 . 138842)
|
||||
(TEXEC.EOTP 138844 . 139577) (TEXEC.GETKEY 139579 . 142495) (TEXEC.INSERTCHAR 142497 . 144798) (
|
||||
TEXEC.DELETE 144800 . 145575) (TEXEC.\\CHDEL1 145577 . 148702) (TEXEC.?EQUAL 148704 . 149753) (
|
||||
TEDIT.SCROLL? 149755 . 154718) (TEXEC.DISPLAYTEXT 154720 . 161495) (\\TEXEC.TEXTBOUT 161497 . 164505)
|
||||
(\\TEXEC.TEXTBOUT1 164507 . 170141) (\\TEXEC.TEXTBOUT2 170143 . 172474) (\\TEXEC.TEXTBOUT3 172476 .
|
||||
173866) (\\TEXEC.TEXTBOUT4 173868 . 175911) (\\TEXEC.SELFN 175913 . 177288) (TEXEC.PRINTARGS 177290 .
|
||||
182253) (TEXEC.PROCENTRYFN 182255 . 182796) (TEXEC.PROCEXITFN 182798 . 183204)) (183266 189641 (TEXEC
|
||||
183276 . 187698) (TTEXEC 187700 . 189639)))))
|
||||
(FILEMAP (NIL (3269 182029 (TEXEC.BACKSKREAD 3279 . 7903) (TEXEC.OPENTEXTSTREAM 7905 . 9963) (
|
||||
TEXEC.DEFAULT.MENUFN 9965 . 14519) (TEXEC.DO?CMD 14521 . 19839) (TEXEC.CREATEMENU 19841 . 20299) (
|
||||
TEXEC.GET 20301 . 29136) (TEXEC.INCLUDE 29138 . 42523) (TEXEC.FIND.FORWARD 42525 . 55413) (
|
||||
TEXEC.FIND.BACKWARD 55415 . 68917) (TEDIT.FIND.BACKWARD 68919 . 74396) (TEDIT.BASICFIND.BACKWARD 74398
|
||||
. 79052) (TEXEC.MENU.WHENHELDFN 79054 . 79713) (TEXEC.SHRINK.ICONCREATE 79715 . 82518) (
|
||||
TEXEC.FILLBUFFER 82520 . 98954) (TEXEC.FILLBUFFER.TCLASS 98956 . 105296) (TEXEC.CHSELPENDING 105298 .
|
||||
113788) (TEXEC.FILLBUFFER.CHARDELETE 113790 . 115845) (TEXEC.FILLBUFFER.WORDDELETE 115847 . 120975) (
|
||||
TEXEC.FILLBUFFER.LINEDELETE 120977 . 123859) (TEXEC.PARENCOUNT 123861 . 125250) (TEXEC.PARENMATCH
|
||||
125252 . 126792) (TEXEC.FLASHCARET 126794 . 129453) (TEXEC.TEXTSTREAM.TO.LINEBUF 129455 . 132142) (
|
||||
TEXEC.FIX 132144 . 135313) (TEXEC.NTHBUFCHARBACK 135315 . 136378) (TEXEC.NTHBACKCHNUM 136380 . 137665)
|
||||
(TEXEC.EOTP 137667 . 138400) (TEXEC.GETKEY 138402 . 141318) (TEXEC.INSERTCHAR 141320 . 143621) (
|
||||
TEXEC.DELETE 143623 . 144398) (TEXEC.\\CHDEL1 144400 . 147525) (TEXEC.?EQUAL 147527 . 148576) (
|
||||
TEDIT.SCROLL? 148578 . 153541) (TEXEC.DISPLAYTEXT 153543 . 160318) (\\TEXEC.TEXTBOUT 160320 . 163328)
|
||||
(\\TEXEC.TEXTBOUT1 163330 . 168964) (\\TEXEC.TEXTBOUT2 168966 . 171297) (\\TEXEC.TEXTBOUT3 171299 .
|
||||
172689) (\\TEXEC.TEXTBOUT4 172691 . 174734) (\\TEXEC.SELFN 174736 . 176111) (TEXEC.PRINTARGS 176113 .
|
||||
181076) (TEXEC.PROCENTRYFN 181078 . 181619) (TEXEC.PROCEXITFN 181621 . 182027)) (182089 188464 (TEXEC
|
||||
182099 . 186521) (TTEXEC 186523 . 188462)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,11 +1,11 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
(FILECREATED "13-Jun-2021 09:46:34"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>TFBRAVO.;3 74596
|
||||
|
||||
changes to%: (FNS \TFBRAVO.WRITE.RUN \TFBRAVO.WRITE.RUNS \TFBRAVO.PARSE.PARA)
|
||||
(FILECREATED "31-Jan-2022 23:28:20" {DSK}<Users>kaplan>Local>medley3.5>my-medley>library>TFBRAVO.;4 74716
|
||||
|
||||
previous date%: "19-Apr-2018 12:19:55"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>TFBRAVO.;2)
|
||||
:CHANGES-TO (FNS TEDITFROMBRAVO)
|
||||
|
||||
:PREVIOUS-DATE "13-Jun-2021 09:46:34"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>my-medley>library>TFBRAVO.;3)
|
||||
|
||||
|
||||
(* ; "
|
||||
@@ -20,7 +20,7 @@ Copyright (c) 1984-1987, 1990-1991, 2018, 2021 by Venue & Xerox Corporation.
|
||||
(FILES (LOADCOMP)
|
||||
TEDITDCL))
|
||||
[DECLARE%: EVAL@COMPILE DONTCOPY
|
||||
(COMS (* ; "Compile-time needs")
|
||||
(COMS (* ; "Compile-time needs")
|
||||
(RECORDS FONT PARA RUN TFBRAVOPAGEFRAMES)
|
||||
(CONSTANTS (PTSPERINCH 72.27)
|
||||
(DefaultLeftMargin 2540)
|
||||
@@ -50,8 +50,8 @@ Copyright (c) 1984-1987, 1990-1991, 2018, 2021 by Venue & Xerox Corporation.
|
||||
(SETSYNTAX (CHARCODE ^Z)
|
||||
'SEPRCHAR PROFILE.PARA.RDTBL))
|
||||
(GLOBALVARS \NAMEDTAB.IMAGEFNS)
|
||||
(DECLARE%: DONTEVAL@LOAD DOCOPY (P (ADDTOVAR TEDIT.INPUT.FORMATS (\TEDIT.BRAVOFILE?
|
||||
TEDITFROMBRAVO))
|
||||
(DECLARE%: DONTEVAL@LOAD DOCOPY (P (ADDTOVAR TEDIT.INPUT.FORMATS (\TEDIT.BRAVOFILE?
|
||||
TEDITFROMBRAVO))
|
||||
(\NAMEDTAB.INIT])
|
||||
|
||||
(FILESLOAD TEDITDCL)
|
||||
@@ -732,22 +732,22 @@ Copyright (c) 1984-1987, 1990-1991, 2018, 2021 by Venue & Xerox Corporation.
|
||||
MARGIN.CANDIDATE])
|
||||
|
||||
(TEDITFROMBRAVO
|
||||
[LAMBDA (FILIN USER.CM TEXTSTREAM) (* ; "Edited 13-Jun-90 01:00 by mitani")
|
||||
[LAMBDA (FILIN USER.CM TEXTSTREAM) (* ; "Edited 31-Jan-2022 23:28 by rmk")
|
||||
(* ; "Edited 13-Jun-90 01:00 by mitani")
|
||||
|
||||
(* * Top level entry for conversion from Bravo to a Textstream which is
|
||||
returned)
|
||||
(* * Top level entry for conversion from Bravo to a Textstream which is returned)
|
||||
|
||||
(INFILE FILIN)
|
||||
(PROG (OLDPLOOKS CURRENT.PARAGRAPH USER.CM.ALIST START NEXTPARAPTR TEDITWINDOW TEXTOBJ
|
||||
(NONFEATURES NIL)
|
||||
(SMALLEST.MARGIN MAX.FIXP)
|
||||
(NEWSTREAM (OR TEXTSTREAM (OPENTEXTSTREAM "")))
|
||||
(NEWSTREAM (OR TEXTSTREAM (OPENTEXTSTREAM NIL)))
|
||||
USER.CM.PARALOOKS USER.CM.CHARLOOKS)
|
||||
(DECLARE (SPECVARS NOUT))
|
||||
(SETQ TEXTOBJ (TEXTOBJ NEWSTREAM))
|
||||
(SETQ USER.CM.ALIST (\TFBRAVO.READ.USER.CM USER.CM))
|
||||
(* read the user.cm file and produce
|
||||
the alist of default values)
|
||||
(* read the user.cm file and produce
|
||||
the alist of default values)
|
||||
(CLOSEF? USER.CM)
|
||||
(SETQ OLDPLOOKS (SETQ USER.CM.PARALOOKS (\TFBRAVO.INIT.PARALOOKS USER.CM.ALIST)))
|
||||
(SETQ USER.CM.CHARLOOKS (\TFBRAVO.INIT.CHARLOOKS))
|
||||
@@ -757,17 +757,17 @@ Copyright (c) 1984-1987, 1990-1991, 2018, 2021 by Venue & Xerox Corporation.
|
||||
(SETQ CURRENT.PARAGRAPH (\TFBRAVO.PARSE.PARA OLDPLOOKS FILIN))
|
||||
while (fetch RUNS of CURRENT.PARAGRAPH)
|
||||
do (SETQ NEXTPARAPTR (GETFILEPTR FILIN))
|
||||
(SETFILEPTR FILIN START)
|
||||
(SETQ SMALLEST.MARGIN (\TFBRAVO.WRITE.PARAGRAPH CURRENT.PARAGRAPH
|
||||
FILIN TEXTOBJ SMALLEST.MARGIN))
|
||||
(SETFILEPTR FILIN NEXTPARAPTR)
|
||||
(SETQ OLDPLOOKS (fetch PARALOOKS of CURRENT.PARAGRAPH))
|
||||
(SETQ START (GETFILEPTR FILIN))
|
||||
(SETQ CURRENT.PARAGRAPH (\TFBRAVO.PARSE.PARA OLDPLOOKS FILIN))
|
||||
finally (* (\SHIFT.DOCUMENT
|
||||
(fetch (TEXTOBJ PCTB) of TEXTOBJ)
|
||||
(MINUS SMALLEST.MARGIN)))
|
||||
NIL))
|
||||
(SETFILEPTR FILIN START)
|
||||
(SETQ SMALLEST.MARGIN (\TFBRAVO.WRITE.PARAGRAPH CURRENT.PARAGRAPH FILIN
|
||||
TEXTOBJ SMALLEST.MARGIN))
|
||||
(SETFILEPTR FILIN NEXTPARAPTR)
|
||||
(SETQ OLDPLOOKS (fetch PARALOOKS of CURRENT.PARAGRAPH))
|
||||
(SETQ START (GETFILEPTR FILIN))
|
||||
(SETQ CURRENT.PARAGRAPH (\TFBRAVO.PARSE.PARA OLDPLOOKS FILIN)) finally
|
||||
(* (\SHIFT.DOCUMENT (fetch
|
||||
(TEXTOBJ PCTB) of TEXTOBJ)
|
||||
(MINUS SMALLEST.MARGIN)))
|
||||
NIL))
|
||||
(CLOSEF (INPUT))
|
||||
(\TFBRAVO.INSTALL.PAGEFORMAT TEXTOBJ)
|
||||
(RETURN NEWSTREAM])
|
||||
@@ -1327,19 +1327,19 @@ Copyright (c) 1984-1987, 1990-1991, 2018, 2021 by Venue & Xerox Corporation.
|
||||
)
|
||||
(PUTPROPS TFBRAVO COPYRIGHT ("Venue & Xerox Corporation" 1984 1985 1986 1987 1990 1991 2018 2021))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (4259 34161 (\TFBRAVO.FIND.LAST.TRAILER 4269 . 5762) (\TFBRAVO.HANDLE.HEADING 5764 .
|
||||
7642) (\TFBRAVO.INIT.CHARLOOKS 7644 . 8460) (\TFBRAVO.INIT.PAGEFORMAT 8462 . 8940) (
|
||||
\TFBRAVO.INSTALL.PAGEFORMAT 8942 . 13579) (\TFBRAVO.PARSE.PROFILE.PARA 13581 . 22094) (
|
||||
\TFBRAVO.PARSE.PROFILE.VALUE 22096 . 22863) (\TFBRAVO.GET.FONTSIZE 22865 . 23181) (
|
||||
\TFBRAVO.GET.FONTSTYLE 23183 . 23511) (\TFBRAVO.WRITE.RUN 23513 . 24646) (\TFBRAVO.ASSERT 24648 .
|
||||
24960) (\SHIFT.DOCUMENT 24962 . 28838) (\TEDIT.BRAVOFILE? 28840 . 30887) (\TEST.CHARACTER.LOOKS 30889
|
||||
. 32529) (\TEST.PARAGRAPH.LOOKS 32531 . 34159)) (34162 37709 (\TFBRAVO.COPY.NAMEDTAB 34172 . 34531) (
|
||||
\TFBRAVO.PUT.NAMEDTAB 34533 . 34829) (\TFBRAVO.GET.NAMEDTAB 34831 . 35108) (\TFBRAVO.ADD.NAMEDTAB
|
||||
35110 . 36087) (\NAMEDTABNYET 36089 . 36254) (\NAMEDTABSIZE 36256 . 37141) (\NAMEDTAB.INIT 37143 .
|
||||
37707)) (37710 73994 (\TFBRAVO.APPLY.PARALOOKS 37720 . 38751) (TEDITFROMBRAVO 38753 . 41155) (
|
||||
\TFBRAVO.WRITE.PARAGRAPH 41157 . 42179) (\TFBRAVO.WRITE.RUNS 42181 . 42950) (\TFBRAVO.SPREAD.LOOKS
|
||||
42952 . 45924) (\TFBRAVO.PARSE.PARA 45926 . 47923) (\TFBRAVO.INIT.PARALOOKS 47925 . 51249) (
|
||||
\TFBRAVO.READ.PARALOOKS 51251 . 58427) (\TFBRAVO.READ.CHARLOOKS 58429 . 66562) (\TFBRAVO.READ.USER.CM
|
||||
66564 . 69894) (\TFBRAVO.GETPARAMS 69896 . 70725) (\TFBRAVO.PARAMNAMEP 70727 . 71175) (\TFBRAVO.EOLS
|
||||
71177 . 71590) (\TFBRAVO.LCASER 71592 . 72144) (\TFBRAVO.FONT.FROM.CHARLOOKS 72146 . 73992)))))
|
||||
(FILEMAP (NIL (4213 34115 (\TFBRAVO.FIND.LAST.TRAILER 4223 . 5716) (\TFBRAVO.HANDLE.HEADING 5718 .
|
||||
7596) (\TFBRAVO.INIT.CHARLOOKS 7598 . 8414) (\TFBRAVO.INIT.PAGEFORMAT 8416 . 8894) (
|
||||
\TFBRAVO.INSTALL.PAGEFORMAT 8896 . 13533) (\TFBRAVO.PARSE.PROFILE.PARA 13535 . 22048) (
|
||||
\TFBRAVO.PARSE.PROFILE.VALUE 22050 . 22817) (\TFBRAVO.GET.FONTSIZE 22819 . 23135) (
|
||||
\TFBRAVO.GET.FONTSTYLE 23137 . 23465) (\TFBRAVO.WRITE.RUN 23467 . 24600) (\TFBRAVO.ASSERT 24602 .
|
||||
24914) (\SHIFT.DOCUMENT 24916 . 28792) (\TEDIT.BRAVOFILE? 28794 . 30841) (\TEST.CHARACTER.LOOKS 30843
|
||||
. 32483) (\TEST.PARAGRAPH.LOOKS 32485 . 34113)) (34116 37663 (\TFBRAVO.COPY.NAMEDTAB 34126 . 34485) (
|
||||
\TFBRAVO.PUT.NAMEDTAB 34487 . 34783) (\TFBRAVO.GET.NAMEDTAB 34785 . 35062) (\TFBRAVO.ADD.NAMEDTAB
|
||||
35064 . 36041) (\NAMEDTABNYET 36043 . 36208) (\NAMEDTABSIZE 36210 . 37095) (\NAMEDTAB.INIT 37097 .
|
||||
37661)) (37664 74114 (\TFBRAVO.APPLY.PARALOOKS 37674 . 38705) (TEDITFROMBRAVO 38707 . 41275) (
|
||||
\TFBRAVO.WRITE.PARAGRAPH 41277 . 42299) (\TFBRAVO.WRITE.RUNS 42301 . 43070) (\TFBRAVO.SPREAD.LOOKS
|
||||
43072 . 46044) (\TFBRAVO.PARSE.PARA 46046 . 48043) (\TFBRAVO.INIT.PARALOOKS 48045 . 51369) (
|
||||
\TFBRAVO.READ.PARALOOKS 51371 . 58547) (\TFBRAVO.READ.CHARLOOKS 58549 . 66682) (\TFBRAVO.READ.USER.CM
|
||||
66684 . 70014) (\TFBRAVO.GETPARAMS 70016 . 70845) (\TFBRAVO.PARAMNAMEP 70847 . 71295) (\TFBRAVO.EOLS
|
||||
71297 . 71710) (\TFBRAVO.LCASER 71712 . 72264) (\TFBRAVO.FONT.FROM.CHARLOOKS 72266 . 74112)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -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
|
||||
|
||||
Binary file not shown.
@@ -1,12 +1,13 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "30-Dec-2021 18:22:13"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>COMPAREDIRECTORIES.;116 100755
|
||||
(FILECREATED "29-Jan-2022 00:03:59"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>COMPAREDIRECTORIES.;169 111694
|
||||
|
||||
:CHANGES-TO (FNS CD-MENUFN)
|
||||
(VARS CDTABLEBROWSER.MENUITEMS)
|
||||
|
||||
:PREVIOUS-DATE "25-Dec-2021 12:59:47"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>COMPAREDIRECTORIES.;114)
|
||||
:PREVIOUS-DATE "28-Jan-2022 17:12:22"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>COMPAREDIRECTORIES.;162)
|
||||
|
||||
|
||||
(* ; "
|
||||
@@ -19,11 +20,12 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp
|
||||
(
|
||||
(* ;; "Compare the contents of two directories.")
|
||||
|
||||
(FNS COMPAREDIRECTORIES COMPAREDIRECTORIES.INFOS COMPAREDIRECTORIES.INFOS.TYPE MATCHNAME
|
||||
CD.INSURECDVALUE CD.UPDATEWIDTHS)
|
||||
(FNS COMPAREDIRECTORIES COMPAREDIRECTORIES.INFOS CDENTRIES.SELECT
|
||||
COMPAREDIRECTORIES.INFOS.TYPE MATCHNAME CD.INSURECDVALUE CD.UPDATEWIDTHS)
|
||||
(FNS CDFILES CDFILES.MATCH CDFILES.PATS)
|
||||
(FNS CDPRINT CDPRINT.LINE CDPRINT.MAXWIDTHS CDPRINT.COLHEADERS CDPRINT.COLUMNS CDTEDIT)
|
||||
(FNS CDMAP CDENTRY CDSUBSET)
|
||||
(FNS CDPRINT CDPRINT.HEADER CDPRINT.LINE CDPRINT.MAXWIDTHS CDPRINT.COLHEADERS CDPRINT.COLUMNS
|
||||
CDTEDIT)
|
||||
(FNS CDMAP CDENTRY CDSUBSET CDMERGE CDMERGE.COMMON)
|
||||
(FNS BINCOMP EOLTYPE EOLTYPE.SHOW)
|
||||
(RECORDS CDVALUE CDENTRY CDINFO CDMAXNCHARS)
|
||||
|
||||
@@ -63,13 +65,10 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp
|
||||
|
||||
(COMPAREDIRECTORIES
|
||||
[LAMBDA (DIR1 DIR2 SELECT INCLUDEDFILES EXCLUDEDFILES USEDIRECTORYDATE OUTPUTFILE ALLVERSIONS
|
||||
FIXDIRECTORYDATES) (* ; "Edited 23-Dec-2021 18:59 by rmk")
|
||||
(* ; "Edited 19-Dec-2021 20:07 by rmk")
|
||||
(* ; "Edited 30-Nov-2021 13:51 by rmk:")
|
||||
(* ; "Edited 23-Nov-2021 12:57 by rmk:")
|
||||
(* ; "Edited 6-Nov-2021 12:08 by rmk:")
|
||||
(* ; "Edited 31-Oct-2021 11:01 by rmk:")
|
||||
(* ; "Edited 7-Jan-2021 23:21 by rmk:")
|
||||
FIXDIRECTORYDATES) (* ; "Edited 26-Jan-2022 13:33 by rmk")
|
||||
(* ; "Edited 4-Jan-2022 12:09 by rmk")
|
||||
(* ; "Edited 31-Oct-2021 11:01 by rmk:")
|
||||
(* ; "Edited 7-Jan-2021 23:21 by rmk:")
|
||||
|
||||
(* ;; "Compare the contents of two directories, e.g., for change-control purposes. Compares files matching FILEPATTERN (or *.*;) on DIR1 and DIR2, listing which is newer, or when one is not found on the other. If SELECT is or contains SAME/=, BEFORE/<, AFTER/>, then files where DIR1 is the same as, earlier than, or later than DIR2 are selected. SELECT= NIL is the same as (< >), T is the same as (< > =). Also allows selection based on file-length criteria.")
|
||||
|
||||
@@ -96,8 +95,7 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp
|
||||
(*- '*-)
|
||||
(~= '~=)
|
||||
(ERROR "UNRECOGNIZED SELECT PARAMETER" S]
|
||||
(PROG (INFOS1 INFOS2 CANDIDATES CDENTRIES COMPAREDATE DEPTH1 DEPTH2 CDVALUE)
|
||||
[SETQ COMPAREDATE (INTERSECTION SELECT '(< > =]
|
||||
(PROG (INFOS1 INFOS2 CANDIDATES CDENTRIES DEPTH1 DEPTH2 CDVALUE (DATE (DATE)))
|
||||
|
||||
(* ;; "DIRECTORYNAME here to get unrelativized specifications for header.")
|
||||
|
||||
@@ -117,8 +115,8 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp
|
||||
(PRINTOUT T "Fixing directory dates" T)
|
||||
(FIX-DIRECTORY-DATES DIR1)
|
||||
(FIX-DIRECTORY-DATES DIR2))
|
||||
(PRINTOUT T "Comparing " DIR1 6 "vs. " DIR2 T "as of " (DATE)
|
||||
" selecting " SELECT " ... ")
|
||||
(CDPRINT.HEADER DIR1 DIR2 SELECT DATE T)
|
||||
(PRINTOUT T " ... ")
|
||||
(SETQ INFOS1 (COMPAREDIRECTORIES.INFOS (CDFILES DIR1 INCLUDEDFILES EXCLUDEDFILES
|
||||
ALLVERSIONS DEPTH1)
|
||||
USEDIRECTORYDATE DIR1))
|
||||
@@ -128,7 +126,7 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp
|
||||
(SETQ CDVALUE (CREATE CDVALUE
|
||||
CDDIR1 _ DIR1
|
||||
CDDIR2 _ DIR2
|
||||
CDCOMPAREDATE _ (DATE)
|
||||
CDCOMPAREDATE _ DATE
|
||||
CDSELECT _ SELECT))
|
||||
(CL:UNLESS (OR INFOS2 INFOS1)
|
||||
(RETURN CDVALUE))
|
||||
@@ -166,58 +164,7 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp
|
||||
|
||||
(* ;; "Do the SELECT filtering and insert the date relation.")
|
||||
|
||||
[SETQ CDENTRIES
|
||||
(for C MATCHNAME INFO1 INFO2 IDATE1 IDATE2 DATEREL BINCOMP in CANDIDATES
|
||||
eachtime (SETQ MATCHNAME (pop C))
|
||||
(SETQ INFO1 (pop C))
|
||||
(SETQ INFO2 (pop C))
|
||||
(if (AND INFO1 INFO2)
|
||||
then (SETQ IDATE1 (IDATE (fetch DATE of INFO1)))
|
||||
(SETQ IDATE2 (IDATE (fetch DATE of INFO2)))
|
||||
(SETQ DATEREL (if (IGREATERP IDATE1 IDATE2)
|
||||
then '>
|
||||
elseif (ILESSP IDATE1 IDATE2)
|
||||
then '<
|
||||
else '=))
|
||||
else
|
||||
(* ;; "Just for printing--no comparison")
|
||||
|
||||
(SETQ DATEREL '*))
|
||||
when (if (AND INFO1 INFO2)
|
||||
then (CL:WHEN (OR (NULL COMPAREDATE)
|
||||
(SELECTQ DATEREL
|
||||
(> (MEMB '> SELECT))
|
||||
(< (MEMB '< SELECT))
|
||||
(= (MEMB '= SELECT))
|
||||
(SHOULDNT)))
|
||||
(SETQ BINCOMP (BINCOMP (fetch (CDINFO FULLNAME) OF INFO1)
|
||||
(fetch (CDINFO FULLNAME) OF INFO2)
|
||||
T
|
||||
(fetch (CDINFO EOL) OF INFO1)
|
||||
(fetch (CDINFO EOL) OF INFO2)))
|
||||
|
||||
(* ;; "We want the ~= test to reflect exact byte equivalence, including the same EOL. We use the BINCOMP value below to indicate EOL differences, so we check it here.")
|
||||
|
||||
[NOT (AND (MEMB '~= SELECT)
|
||||
BINCOMP
|
||||
(EQ (fetch (CDINFO EOL) OF INFO1)
|
||||
(fetch (CDINFO EOL) OF INFO2])
|
||||
elseif INFO1
|
||||
then
|
||||
(* ;; "OK if INFO2 is missing?")
|
||||
|
||||
(MEMB '*- SELECT)
|
||||
else
|
||||
(* ;; "OK if INFO1 is missing?")
|
||||
|
||||
(MEMB '-* SELECT))
|
||||
collect (create CDENTRY
|
||||
MATCHNAME _ MATCHNAME
|
||||
INFO1 _ INFO1
|
||||
DATEREL _ DATEREL
|
||||
INFO2 _ INFO2
|
||||
EQUIV _ (CL:UNLESS (EQ DATEREL '*)
|
||||
BINCOMP]
|
||||
(SETQ CDENTRIES (CDENTRIES.SELECT CANDIDATES SELECT))
|
||||
(PRINTOUT T (LENGTH CDENTRIES)
|
||||
" entries" T)
|
||||
(REPLACE CDENTRIES OF CDVALUE WITH CDENTRIES)
|
||||
@@ -227,37 +174,118 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp
|
||||
(RETURN (CDPRINT CDVALUE OUTPUTFILE NIL (MEMB 'AUTHOR SELECT])
|
||||
|
||||
(COMPAREDIRECTORIES.INFOS
|
||||
[LAMBDA (FILES USEDIRECTORYDATE DIR) (* ; "Edited 23-Dec-2021 18:59 by rmk")
|
||||
[LAMBDA (FILES USEDIRECTORYDATE DIR) (* ; "Edited 4-Jan-2022 15:23 by rmk")
|
||||
(* ; "Edited 23-Dec-2021 18:59 by rmk")
|
||||
(* ; "Edited 12-Dec-2021 22:50 by rmk")
|
||||
(* ; "Edited 23-Nov-2021 12:27 by rmk:")
|
||||
(* ; "Edited 13-Oct-2020 08:42 by rmk:")
|
||||
|
||||
(* ;; "Value is a list of CDINFOS with the match-name consed on to the front")
|
||||
|
||||
(FOR FULLNAME TYPE LDATE (STARTPOS _ (ADD1 (NCHARS DIR))) IN FILES
|
||||
(FOR FULLNAME TYPE LDATE STREAM (STARTPOS _ (ADD1 (NCHARS DIR))) IN FILES
|
||||
COLLECT
|
||||
|
||||
(* ;; "GDATE/IDATE in case Y2K")
|
||||
|
||||
(SETQ LDATE (OR (FILEDATE FULLNAME T)
|
||||
(FILEDATE FULLNAME))) (* ;
|
||||
(* ;
|
||||
"Is it a Lisp file? Get it's internal filecreated date. ")
|
||||
(CONS (MATCHNAME FULLNAME STARTPOS)
|
||||
(CREATE CDINFO
|
||||
FULLNAME _ FULLNAME
|
||||
DATE _ [GDATE (IDATE (IF USEDIRECTORYDATE
|
||||
THEN (GETFILEINFO FULLNAME 'CREATIONDATE)
|
||||
ELSEIF (OR LDATE (GETFILEINFO FULLNAME
|
||||
'CREATIONDATE]
|
||||
LENGTH _ (GETFILEINFO FULLNAME 'LENGTH)
|
||||
AUTHOR _ (GETFILEINFO FULLNAME 'AUTHOR)
|
||||
TYPE _ (COMPAREDIRECTORIES.INFOS.TYPE FULLNAME LDATE)
|
||||
EOL _ (EOLTYPE FULLNAME])
|
||||
(SETQ STREAM (OPENSTREAM FULLNAME 'INPUT)) (* ;
|
||||
"So all the GETFILEINFO's, FILEDATES, etc. don't have to do the directory searching.")
|
||||
(SETQ LDATE (OR (FILEDATE STREAM T)
|
||||
(FILEDATE STREAM)))
|
||||
(PROG1 (CONS (MATCHNAME FULLNAME STARTPOS)
|
||||
(CREATE CDINFO
|
||||
FULLNAME _ FULLNAME
|
||||
DATE _ (GDATE (IDATE (IF (OR USEDIRECTORYDATE (NULL LDATE))
|
||||
THEN (GETFILEINFO STREAM 'CREATIONDATE)
|
||||
ELSE (SETFILEINFO STREAM 'CREATIONDATE LDATE)
|
||||
LDATE)))
|
||||
LENGTH _ (GETFILEINFO STREAM 'LENGTH)
|
||||
AUTHOR _ (GETFILEINFO STREAM 'AUTHOR)
|
||||
TYPE _ (COMPAREDIRECTORIES.INFOS.TYPE STREAM LDATE)
|
||||
EOL _ (EOLTYPE STREAM)))
|
||||
(CLOSEF? STREAM])
|
||||
|
||||
(CDENTRIES.SELECT
|
||||
[LAMBDA (CANDIDATES SELECT) (* ; "Edited 4-Jan-2022 21:31 by rmk")
|
||||
|
||||
(* ;; "Does the pairwise select filter and inserts the date relation")
|
||||
|
||||
(for C MATCHNAME INFO1 INFO2 IDATE1 IDATE2 DATEREL BINCOMP [COMPAREDATE
|
||||
_
|
||||
(INTERSECTION SELECT
|
||||
'(< > =] in CANDIDATES
|
||||
eachtime (SETQ MATCHNAME (pop C))
|
||||
(SETQ INFO1 (pop C))
|
||||
(SETQ INFO2 (pop C))
|
||||
(if (AND INFO1 INFO2)
|
||||
then (SETQ IDATE1 (IDATE (fetch DATE of INFO1)))
|
||||
(SETQ IDATE2 (IDATE (fetch DATE of INFO2)))
|
||||
(SETQ DATEREL (if (IGREATERP IDATE1 IDATE2)
|
||||
then '>
|
||||
elseif (ILESSP IDATE1 IDATE2)
|
||||
then '<
|
||||
else '=))
|
||||
else
|
||||
(* ;; "Just for printing--no comparison")
|
||||
|
||||
(SETQ DATEREL '*))
|
||||
when (if (AND INFO1 INFO2)
|
||||
then (CL:WHEN (OR (NULL COMPAREDATE)
|
||||
(SELECTQ DATEREL
|
||||
(> (MEMB '> COMPAREDATE))
|
||||
(< (MEMB '< COMPAREDATE))
|
||||
(= (MEMB '= COMPAREDATE))
|
||||
(SHOULDNT)))
|
||||
(SETQ BINCOMP (BINCOMP (fetch (CDINFO FULLNAME) OF INFO1)
|
||||
(fetch (CDINFO FULLNAME) OF INFO2)
|
||||
T
|
||||
(fetch (CDINFO EOL) OF INFO1)
|
||||
(fetch (CDINFO EOL) OF INFO2)))
|
||||
(CL:WHEN (EQ T BINCOMP)
|
||||
|
||||
(* ;; "Byte-equivalent files with different dates. Presumably the earlier date is more accurate, move back the date of the later file and make DATEREL be =. Perhaps we should do this even if there is only an EOL difference (BINCOMP non-NIL).;; Byte-equivalent files with different dates. Presumably the earlier date is more accurate, move back the date of the earlier file and make DATEREL be =. Perhaps we should do this even if there is only an EOL difference (BINCOMP non-NIL). ")
|
||||
|
||||
(* ;; "We do this even if FIXDIRECTORYDATES is false, that addresses a property of individual Lisp source files.")
|
||||
|
||||
(SELECTQ DATEREL
|
||||
(> (SETFILEINFO (FETCH (CDINFO FULLNAME) OF INFO1)
|
||||
'CREATIONDATE
|
||||
(REPLACE (CDINFO DATE) OF INFO1 WITH (FETCH (CDINFO DATE)
|
||||
OF INFO2))))
|
||||
(< (SETFILEINFO (FETCH (CDINFO FULLNAME) OF INFO2)
|
||||
'CREATIONDATE
|
||||
(REPLACE (CDINFO DATE) OF INFO2 WITH (FETCH (CDINFO DATE)
|
||||
OF INFO1))))
|
||||
NIL)
|
||||
(SETQ DATEREL '=))
|
||||
|
||||
(* ;; "We want the ~= test to reflect exact byte equivalence, including the same EOL. We use the BINCOMP value below to indicate EOL differences, so we check it here.")
|
||||
|
||||
[NOT (AND (MEMB '~= SELECT)
|
||||
BINCOMP
|
||||
(EQ (fetch (CDINFO EOL) OF INFO1)
|
||||
(fetch (CDINFO EOL) OF INFO2])
|
||||
elseif INFO1
|
||||
then
|
||||
(* ;; "OK if INFO2 is missing?")
|
||||
|
||||
(MEMB '*- SELECT)
|
||||
else
|
||||
(* ;; "OK if INFO1 is missing?")
|
||||
|
||||
(MEMB '-* SELECT))
|
||||
collect (create CDENTRY
|
||||
MATCHNAME _ MATCHNAME
|
||||
INFO1 _ INFO1
|
||||
DATEREL _ DATEREL
|
||||
INFO2 _ INFO2
|
||||
EQUIV _ (CL:UNLESS (EQ DATEREL '*)
|
||||
BINCOMP])
|
||||
|
||||
(COMPAREDIRECTORIES.INFOS.TYPE
|
||||
[LAMBDA (FULLNAME LDATE) (* ; "Edited 12-Dec-2021 22:50 by rmk")
|
||||
(IF (OR LDATE (FILEDATE FULLNAME T)
|
||||
(FILEDATE FULLNAME))
|
||||
[LAMBDA (FULLNAME LDATE) (* ; "Edited 4-Jan-2022 13:10 by rmk")
|
||||
(* ; "Edited 12-Dec-2021 22:50 by rmk")
|
||||
(IF LDATE
|
||||
THEN (CL:IF (MEMB (FILENAMEFIELD FULLNAME 'EXTENSION)
|
||||
*COMPILED-EXTENSIONS*)
|
||||
'COMPILED
|
||||
@@ -318,9 +346,12 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp
|
||||
(DEFINEQ
|
||||
|
||||
(CDFILES
|
||||
[LAMBDA (DIR INCLUDEDFILES EXCLUDEDFILES ALLVERSIONS DEPTH)(* ; "Edited 23-Dec-2021 22:49 by rmk")
|
||||
(* ; "Edited 6-Nov-2021 12:08 by rmk:")
|
||||
(* ; "Edited 16-Oct-2020 13:42 by rmk:")
|
||||
[LAMBDA (DIR INCLUDEDFILES EXCLUDEDFILES ALLVERSIONS DEPTH)(* ; "Edited 26-Jan-2022 15:25 by rmk")
|
||||
(* ; "Edited 21-Jan-2022 22:40 by rmk")
|
||||
(* ; "Edited 5-Jan-2022 15:07 by rmk")
|
||||
(* ; "Edited 23-Dec-2021 22:49 by rmk")
|
||||
(* ; "Edited 6-Nov-2021 12:08 by rmk:")
|
||||
(* ; "Edited 16-Oct-2020 13:42 by rmk:")
|
||||
|
||||
(* ;; "Returns a list of fullnames for files that satisfy the criteria. We generate all candidates that match INCLUDEDFILES but not EXCLUDEDFILES in DIR.")
|
||||
|
||||
@@ -338,7 +369,7 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp
|
||||
|
||||
(* ;; "EXCLUDEDFILES is a filepattern with * meaning everything, COM means *.LCOM and *.DFASL")
|
||||
|
||||
[SETQ EXCLUDEDFILES `(.DS_Store
|
||||
[SETQ EXCLUDEDFILES `(*>.DS_Store
|
||||
,@(MKLIST EXCLUDEDFILES]
|
||||
(CL:UNLESS (EQMEMB '.* INCLUDEDFILES) (* ;
|
||||
"Excluded dot files unless specifically asked for")
|
||||
@@ -372,9 +403,14 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp
|
||||
(CL:UNLESS (OR (EQ SD '*)
|
||||
(EQ SD (CAR P)))
|
||||
(SETQ SD NIL)) FINALLY (CL:WHEN (EQ SD '*)
|
||||
(SETQ SD ""))
|
||||
(SETQ SD ""))
|
||||
|
||||
(* ;;
|
||||
"If We don't prefix TOPDIR with <, then if TOPDIR contains a colon it is interpreted as a device.")
|
||||
|
||||
(SETQ ENUMPAT (PACKFILENAME 'HOST HOST 'DIRECTORY
|
||||
(CONCAT TOPDIR ">" (OR SD ""))
|
||||
(CONCAT "<" TOPDIR ">"
|
||||
(OR SD ""))
|
||||
'NAME N 'EXTENSION E 'VERSION
|
||||
(CL:IF ALLVERSIONS
|
||||
'*
|
||||
@@ -387,48 +423,52 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp
|
||||
(* ;; "We enumerate all the files, checking to see that")
|
||||
|
||||
(FOR FULLNAME NAME EXT SUBDIR UNPACK THISDEPTH (STARTPOS _ (ADD1 (NCHARS TOPDIR)))
|
||||
IN (DIRECTORY ENUMPAT) EACHTIME (CL:WHEN (DIRECTORYNAMEP FULLNAME)
|
||||
(* ; "Skip directories")
|
||||
(GO $$ITERATE))
|
||||
(SETQ UNPACK (UNPACKFILENAME FULLNAME))
|
||||
(SETQ NAME (LISTGET UNPACK 'NAME))
|
||||
(SETQ EXT (LISTGET UNPACK 'EXTENSION))
|
||||
(SETQ SUBDIR (SUBATOM (LISTGET UNPACK 'DIRECTORY)
|
||||
STARTPOS))
|
||||
(CL:UNLESS NAME
|
||||
(CL:WHEN EXT (* ; ".XY")
|
||||
(SETQ NAME (PACK* "." EXT))
|
||||
(SETQ EXT NIL)))
|
||||
(SETQ THISDEPTH (FOR I (CNT _ 1) FROM 1
|
||||
DO (SELCHARQ (NTHCHARCODE SUBDIR I)
|
||||
((> /)
|
||||
(ADD CNT 1))
|
||||
(NIL (RETURN CNT))
|
||||
NIL)))
|
||||
IN (DIRECTORY ENUMPAT NIL NIL (CL:IF ALLVERSIONS
|
||||
"*"
|
||||
""))
|
||||
EACHTIME (SETQ UNPACK (UNPACKFILENAME FULLNAME))
|
||||
(SETQ NAME (LISTGET UNPACK 'NAME))
|
||||
(SETQ EXT (LISTGET UNPACK 'EXTENSION))
|
||||
(CL:UNLESS NAME
|
||||
(CL:WHEN EXT (* ; ".XY")
|
||||
(SETQ NAME (PACK* "." EXT))
|
||||
(SETQ EXT NIL)))
|
||||
(CL:UNLESS (OR NAME EXT) (* ; "Must have been a directory")
|
||||
(GO $$ITERATE))
|
||||
(SETQ SUBDIR (SUBATOM (LISTGET UNPACK 'DIRECTORY)
|
||||
STARTPOS))
|
||||
(SETQ THISDEPTH (FOR I (CNT _ 1) FROM 1 DO (SELCHARQ (NTHCHARCODE SUBDIR I)
|
||||
((> /)
|
||||
(ADD CNT 1))
|
||||
(NIL (RETURN CNT))
|
||||
NIL)))
|
||||
WHEN (OR (NULL INCLUDES)
|
||||
(CDFILES.MATCH SUBDIR NAME EXT THISDEPTH INCLUDES))
|
||||
UNLESS (CDFILES.MATCH SUBDIR NAME EXT THISDEPTH EXCLUDES) COLLECT FULLNAME])
|
||||
|
||||
(CDFILES.MATCH
|
||||
[LAMBDA (SUBDIR NAME EXT THISDEPTH PATTERNS) (* ; "Edited 23-Dec-2021 21:47 by rmk")
|
||||
[LAMBDA (SUBDIR NAME EXT THISDEPTH PATTERNS) (* ; "Edited 26-Jan-2022 15:33 by rmk")
|
||||
(* ; "Edited 23-Dec-2021 21:47 by rmk")
|
||||
|
||||
(* ;; "True if the components of the fullname match at least one of the patterns")
|
||||
|
||||
(THEREIS P IN PATTERNS SUCHTHAT (AND [OR (STRING.EQUAL NAME (CAR P))
|
||||
(THEREIS P IN PATTERNS SUCHTHAT (AND [OR (STRING.EQUAL NAME (CAR P)
|
||||
FILEDIRCASEARRAY)
|
||||
(EQ '* (CAR P))
|
||||
(AND (EQ (CHARCODE %.)
|
||||
(CHCON1 (CAR P)))
|
||||
(EQ (EQ (CHARCODE %.)
|
||||
(CHCON1 NAME)))
|
||||
(EQ (CHARCODE %.)
|
||||
(CHCON1 NAME))
|
||||
(OR (STRING.EQUAL NAME (SUBATOM (CAR P)
|
||||
2))
|
||||
(EQ (CHARCODE *1)
|
||||
(EQ (CHARCODE *)
|
||||
(NTHCHARCODE (CAR P)
|
||||
2]
|
||||
(OR (STRING.EQUAL EXT (CADR P))
|
||||
(EQ '* (CADR P)))
|
||||
(OR (STRING.EQUAL SUBDIR (CADDR P))
|
||||
(NULL (CADDR P)))
|
||||
(NULL (CADDR P))
|
||||
(EQ '* (CADDR P)))
|
||||
(ILEQ THISDEPTH (CADDDR P])
|
||||
|
||||
(CDFILES.PATS
|
||||
@@ -479,9 +519,10 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp
|
||||
(DEFINEQ
|
||||
|
||||
(CDPRINT
|
||||
[LAMBDA (CDVALUE FILE COLHEADINGS PRINTAUTHOR) (* ; "Edited 19-Dec-2021 20:10 by rmk")
|
||||
(* ; "Edited 30-Nov-2021 20:59 by rmk:")
|
||||
(* ; "Edited 13-Oct-2020 08:38 by rmk:")
|
||||
[LAMBDA (CDVALUE FILE COLHEADINGS PRINTAUTHOR) (* ; "Edited 26-Jan-2022 13:43 by rmk")
|
||||
(* ; "Edited 19-Dec-2021 20:10 by rmk")
|
||||
(* ; "Edited 30-Nov-2021 20:59 by rmk:")
|
||||
(* ; "Edited 13-Oct-2020 08:38 by rmk:")
|
||||
|
||||
(* ;; "Typically CDVALUE will have a provdenance header. If not, we fake one up, at least for the directories and today's date.")
|
||||
|
||||
@@ -502,11 +543,7 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp
|
||||
'(PROGN (CLOSEF? OLDVALUE])
|
||||
(LINELENGTH 1000 STREAM) (* ; "Don't wrap")
|
||||
(CL:WHEN (FETCH (CDVALUE CDDIR1) OF CDVALUE)
|
||||
(PRINTOUT STREAM "Comparing " (FETCH (CDVALUE CDDIR1) OF CDVALUE)
|
||||
6 "vs. " (FETCH (CDVALUE CDDIR2) OF CDVALUE)
|
||||
T "as of " (FETCH (CDVALUE CDCOMPAREDATE) OF CDVALUE))
|
||||
(CL:WHEN (FETCH (CDVALUE CDSELECT) OF CDVALUE)
|
||||
(PRINTOUT STREAM " selecting " (FETCH (CDVALUE CDSELECT) OF CDVALUE)))
|
||||
(CDPRINT.HEADER CDVALUE STREAM)
|
||||
(PRINTOUT STREAM -2 (LENGTH (fetch CDENTRIES of CDVALUE))
|
||||
" entries" T T))
|
||||
(if (fetch CDENTRIES of CDVALUE)
|
||||
@@ -517,6 +554,27 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp
|
||||
else (PRINTOUT T "CDVALUE is empty" T))
|
||||
(AND STREAM (CLOSEF? STREAM))))])
|
||||
|
||||
(CDPRINT.HEADER
|
||||
[LAMBDA (DIR1 DIR2 SELECT DATE STREAM) (* ; "Edited 26-Jan-2022 13:36 by rmk")
|
||||
(CL:WHEN (LISTP DIR1)
|
||||
|
||||
(* ;; "A CDVALUE")
|
||||
|
||||
(CL:UNLESS STREAM (SETQ STREAM DIR2))
|
||||
(SETQ DIR2 (FETCH CDDIR2 OF DIR1))
|
||||
(SETQ SELECT (FETCH CDSELECT OF DIR1))
|
||||
(SETQ DATE (FETCH CDCOMPAREDATE OF DIR1))
|
||||
(SETQ DIR1 (FETCH CDDIR1 OF DIR1)))
|
||||
(CL:WHEN DIR1
|
||||
(PRINTOUT STREAM "Comparing ")
|
||||
(PRINTOUT STREAM DIR1 %# (CL:WHEN (IGREATERP (IPLUS (NCHARS DIR1)
|
||||
(NCHARS DIR2))
|
||||
70)
|
||||
(TAB 5))
|
||||
" vs. " DIR2)
|
||||
(PRINTOUT STREAM T 3 "as of " DATE)
|
||||
(CL:WHEN SELECT (PRINTOUT STREAM " selecting " SELECT)))])
|
||||
|
||||
(CDPRINT.LINE
|
||||
[LAMBDA (STREAM ENTRY PRINTAUTHOR DATE1POS ENDDATE1 NCHARSDIR1 NCHARSDIR2)
|
||||
(* ; "Edited 22-Nov-2021 22:38 by rmk:")
|
||||
@@ -752,6 +810,89 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp
|
||||
(SETQ INFO2 (FETCH INFO2 OF CDE))
|
||||
(SETQ EQUIV (FETCH EQUIV OF CDE))
|
||||
WHEN (APPLY* FN CDE) COLLECT CDE])
|
||||
|
||||
(CDMERGE
|
||||
[LAMBDA (CDVALUES) (* ; "Edited 24-Jan-2022 17:01 by rmk")
|
||||
|
||||
(* ;; "This merges a collection of CDVALUES on different directories into a single CDVALUE with the union of the CDENTRIES, provided that they have the same selection criteria. The merged directories will be the minimal common prefix of all of the entries on each side, and the residual of the directory will be packed onto all the names.")
|
||||
|
||||
(IF (CDR CDVALUES)
|
||||
THEN
|
||||
[LET
|
||||
(CDSELECTS)
|
||||
|
||||
(* ;; "Group by selects")
|
||||
|
||||
(FOR CDV TMP IN CDVALUES
|
||||
DO (PUSH [CDR (OR (SASSOC (FETCH CDSELECT OF CDV)
|
||||
CDSELECTS)
|
||||
(CAR (PUSH CDSELECTS (CONS (FETCH CDSELECT OF CDV]
|
||||
CDV))
|
||||
|
||||
(* ;; "For each group, find the longest common directory prefixes")
|
||||
|
||||
(FOR CDS IDATE DIR1 DIR2 MERGEDENTRIES IN CDSELECTS
|
||||
COLLECT (SETQ DIR1 (FETCH CDDIR1 OF (CADR CDS)))
|
||||
(SETQ DIR2 (FETCH CDDIR2 OF (CADR CDS)))
|
||||
[SETQ IDATE (IDATE (FETCH CDCOMPAREDATE OF (CADR CDS]
|
||||
|
||||
(* ;; "Calculate the common directory prefixes and latest date")
|
||||
|
||||
[FOR CDV IN (CDDR CDS) DO (SETQ DIR1 (CDMERGE.COMMON DIR1 (FETCH CDDIR1
|
||||
OF CDV)))
|
||||
(SETQ DIR2 (CDMERGE.COMMON DIR2 (FETCH CDDIR2
|
||||
OF CDV)))
|
||||
(CL:WHEN (IGREATERP IDATE (IDATE (FETCH CDCOMPAREDATE
|
||||
OF CDV)))
|
||||
(SETQ IDATE (IDATE (FETCH CDCOMPAREDATE OF CDV))))]
|
||||
|
||||
(* ;;
|
||||
"Merge the CDENTRIES with matchnames pulled back so that subdirectories show up")
|
||||
|
||||
(SETQ MERGEDENTRIES
|
||||
(SORT [FOR CDV NC1 _ (ADD1 (NCHARS DIR1))
|
||||
NC2 _ (ADD1 (NCHARS DIR2)) IN (CDR CDS)
|
||||
JOIN (FOR CDE IN (FETCH CDENTRIES OF CDV)
|
||||
COLLECT (CREATE CDENTRY
|
||||
USING CDE MATCHNAME _
|
||||
(IF (FETCH INFO1 OF CDE)
|
||||
THEN (MATCHNAME (FETCH (CDINFO FULLNAME)
|
||||
OF (FETCH INFO1
|
||||
OF CDE))
|
||||
NC1)
|
||||
ELSE (MATCHNAME (FETCH (CDINFO FULLNAME)
|
||||
OF (FETCH INFO2
|
||||
OF CDE))
|
||||
NC2]
|
||||
T))
|
||||
(CD.UPDATEWIDTHS (CREATE CDVALUE
|
||||
CDDIR1 _ DIR1
|
||||
CDDIR2 _ DIR2
|
||||
CDCOMPAREDATE _ (GDATE IDATE)
|
||||
CDSELECT _ (CAR CDS)
|
||||
CDENTRIES _ MERGEDENTRIES]
|
||||
ELSE CDVALUES])
|
||||
|
||||
(CDMERGE.COMMON
|
||||
[LAMBDA (DIRX DIRY) (* ; "Edited 24-Jan-2022 16:40 by rmk")
|
||||
|
||||
(* ;;
|
||||
"Returns the longest common prefix of DIRX and DIRY, collapsing brackets, slashes, and case")
|
||||
|
||||
(FOR I CX CY (LASTDIRPOS _ 1) FROM 1 EACHTIME (SETQ CX (NTHCHARCODE DIRX I))
|
||||
(SETQ CY (NTHCHARCODE DIRY I))
|
||||
(CL:WHEN (MEMB CX (CHARCODE (< > /)))
|
||||
(SETQ CX (CHARCODE /)))
|
||||
(CL:WHEN (MEMB CY (CHARCODE (< > /)))
|
||||
(SETQ CY (CHARCODE /)))
|
||||
(CL:WHEN (AND (EQ CX (CHARCODE /))
|
||||
(EQ CY (CHARCODE /)))
|
||||
(SETQ LASTDIRPOS I))
|
||||
UNLESS [AND CX CY (OR (EQ CX CY)
|
||||
(EQ (L-CASECODE CX)
|
||||
(L-CASECODE CY] DO (RETURN (CL:IF (EQ I 1)
|
||||
""
|
||||
(SUBSTRING DIRX 1 LASTDIRPOS))])
|
||||
)
|
||||
(DEFINEQ
|
||||
|
||||
@@ -827,40 +968,51 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp
|
||||
FINALLY (RETURN (OR EOLDIFF T]))])
|
||||
|
||||
(EOLTYPE
|
||||
[LAMBDA (FILE SHOWCONTEXT) (* ; "Edited 21-Feb-2021 20:34 by rmk:")
|
||||
[LAMBDA (FILE SHOWCONTEXT)
|
||||
|
||||
(* ;; "Returns the EOLCONVENTION of FILE if it only sees one kind, NIL if it can't decide.")
|
||||
(* ;; "Edited 4-Jan-2022 15:10 by rmk: Allow FILE to be an already open stream")
|
||||
|
||||
(* ;; "If SHOWCONTEXT, it is the number of bytes before and after an EOL inconsistency (e.g. seeing CR after having seen LF) that will be displayed on the TTY. The position of the inconsistency will be marked with ##.")
|
||||
(* ;; "Edited 21-Feb-2021 20:34 by rmk:")
|
||||
|
||||
(* ;; "Returns the EOLCONVENTION of FILE if it only sees one kind, NIL if it can't decide.")
|
||||
|
||||
(* ;; "If SHOWCONTEXT, it is the number of bytes before and after an EOL inconsistency (e.g. seeing CR after having seen LF) that will be displayed on the TTY. The position of the inconsistency will be marked with ##.")
|
||||
|
||||
(SELECTQ SHOWCONTEXT
|
||||
(NIL)
|
||||
(T (SETQ SHOWCONTEXT 100))
|
||||
(CL:UNLESS (FIXP SHOWCONTEXT)
|
||||
(ERROR "SHOWCONTEXT must be an integer" SHOWCONTEXT)))
|
||||
(CL:WITH-OPEN-FILE
|
||||
(STREAM FILE :DIRECTION :INPUT)
|
||||
(SETFILEINFO STREAM 'ENDOFSTREAMOP (FUNCTION NILL))
|
||||
(BIND EOLTYPE
|
||||
DO (SELCHARQ (OR (\BIN STREAM)
|
||||
(RETURN EOLTYPE))
|
||||
(CR (IF (EQ (CHARCODE LF)
|
||||
(RESETLST
|
||||
(LET (STREAM)
|
||||
[IF (GETSTREAM FILE 'INPUT T)
|
||||
THEN (SETQ STREAM FILE)
|
||||
[RESETSAVE NIL `(PROGN (SETFILEPTR ,STREAM ,(GETFILEPTR STREAM))
|
||||
(STREAMPROP ,STREAM 'ENDOFSTREAMOP
|
||||
',(STREAMPROP STREAM 'ENDOFSTREAMOP]
|
||||
(SETFILEPTR STREAM 0)
|
||||
ELSE (RESETSAVE NIL `(CLOSEF? ,(SETQ STREAM (OPENSTREAM FILE 'INPUT]
|
||||
(SETFILEINFO STREAM 'ENDOFSTREAMOP (FUNCTION NILL))
|
||||
(BIND EOLTYPE
|
||||
DO (SELCHARQ (OR (\BIN STREAM)
|
||||
(RETURN EOLTYPE))
|
||||
(CR (IF (EQ (CHARCODE LF)
|
||||
(\PEEKBIN STREAM T))
|
||||
THEN (\BIN STREAM)
|
||||
(IF (MEMB EOLTYPE '(LF CR))
|
||||
THEN (CL:UNLESS (EOLTYPE.SHOW SHOWCONTEXT EOLTYPE
|
||||
'LF STREAM)
|
||||
(RETURN NIL))
|
||||
ELSE (SETQ EOLTYPE 'CRLF))
|
||||
ELSEIF (MEMB EOLTYPE '(LF CRLF))
|
||||
THEN (CL:UNLESS (EOLTYPE.SHOW SHOWCONTEXT EOLTYPE 'CR STREAM)
|
||||
THEN (\BIN STREAM)
|
||||
(IF (MEMB EOLTYPE '(LF CR))
|
||||
THEN (CL:UNLESS (EOLTYPE.SHOW SHOWCONTEXT EOLTYPE
|
||||
'LF STREAM)
|
||||
(RETURN NIL))
|
||||
ELSE (SETQ EOLTYPE 'CRLF))
|
||||
ELSEIF (MEMB EOLTYPE '(LF CRLF))
|
||||
THEN (CL:UNLESS (EOLTYPE.SHOW SHOWCONTEXT EOLTYPE 'CR STREAM)
|
||||
(RETURN NIL))
|
||||
ELSE (SETQ EOLTYPE 'CR)))
|
||||
(LF (IF (MEMB EOLTYPE '(CR CRLF))
|
||||
THEN (CL:UNLESS (EOLTYPE.SHOW SHOWCONTEXT EOLTYPE 'LF STREAM)
|
||||
ELSE (SETQ EOLTYPE 'CR)))
|
||||
(LF (IF (MEMB EOLTYPE '(CR CRLF))
|
||||
THEN (CL:UNLESS (EOLTYPE.SHOW SHOWCONTEXT EOLTYPE 'LF STREAM)
|
||||
(RETURN NIL))
|
||||
ELSE (SETQ EOLTYPE 'LF)))
|
||||
NIL])
|
||||
ELSE (SETQ EOLTYPE 'LF)))
|
||||
NIL))))])
|
||||
|
||||
(EOLTYPE.SHOW
|
||||
[LAMBDA (SHOWCONTEXT OLDTYPE NEWTYPE STREAM) (* ; "Edited 21-Feb-2021 20:20 by rmk:")
|
||||
@@ -1435,18 +1587,16 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp
|
||||
|
||||
(CDBROWSER
|
||||
[LAMBDA (CDVALUE TITLE COLHEADINGS BROWSERPROPS SEPARATEDIRECTIONS MENUITEMS)
|
||||
(* ; "Edited 25-Dec-2021 12:50 by rmk")
|
||||
(* ; "Edited 16-Dec-2021 11:51 by rmk")
|
||||
(* ; "Edited 14-Dec-2021 21:41 by rmk")
|
||||
(* ; "Edited 10-Dec-2021 21:38 by rmk")
|
||||
(* ; "Edited 30-Nov-2021 15:03 by rmk:")
|
||||
(* ; "Edited 29-Nov-2021 14:18 by rmk:")
|
||||
|
||||
(* ;; "Edited 28-Jan-2022 17:01 by rmk: a table browser for the differences in CDVALUE.")
|
||||
|
||||
(* ;; "Creates a table browser for the differences in CDVALUE.")
|
||||
|
||||
(SETQ MENUITEMS (IF MENUITEMS
|
||||
THEN (FOR I IN MENUITEMS COLLECT (OR (LISTP I)
|
||||
(SASSOC I CDTABLEBROWSER.MENUITEMS)
|
||||
(AND (STREQUAL I "")
|
||||
"")
|
||||
(ERROR "UNKNOWN CDBROWSER MENU ITEM" I))
|
||||
)
|
||||
ELSE CDTABLEBROWSER.MENUITEMS))
|
||||
@@ -1464,19 +1614,17 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp
|
||||
FINALLY (RETURN (WIDTHIFWINDOW (IMAX $$EXTREME (STRINGWIDTH
|
||||
" CD commands "
|
||||
DEFAULTFONT]
|
||||
|
||||
(* ;; "2 allows for the prompt window")
|
||||
|
||||
[SETQ REGION (GETREGION (PLUS TB.LEFT.MARGIN ITEMWIDTH (TIMES 2 WBorder)
|
||||
MENUWIDTH)
|
||||
(TIMES [IMIN 15 (IMAX (IPLUS 4 (LENGTH STRINGS))
|
||||
(ADD1 (LENGTH MENUITEMS]
|
||||
(TIMES (IPLUS 2 (IMAX (IMIN 15 (LENGTH STRINGS))
|
||||
(LENGTH MENUITEMS)))
|
||||
(FONTPROP DEFAULTFONT 'HEIGHT]
|
||||
|
||||
(* ;; "Promptwindow seems to do its own thing, even if under construction. So we preshrink the main window.")
|
||||
|
||||
[SETQ REGION (CREATE REGION USING REGION HEIGHT _ (DIFFERENCE (FETCH (REGION HEIGHT)
|
||||
OF REGION)
|
||||
(FONTPROP DEFAULTFONT
|
||||
'HEIGHT]
|
||||
(SETQ WINDOW (CREATEW REGION (OR TITLE "Compare directories")
|
||||
(SETQ WINDOW (CREATEW REGION (OR TITLE (CONCAT "Compare directories " (LENGTH
|
||||
STRINGS)
|
||||
" files"))
|
||||
NIL T))
|
||||
(WINDOWPROP WINDOW 'UNDERCONSTRUCTION T)
|
||||
|
||||
@@ -1610,105 +1758,153 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp
|
||||
'DON'T])
|
||||
|
||||
(CD.COMMANDSELECTEDFN
|
||||
[LAMBDA (MENUITEM MENU KEY) (* ; "Edited 25-Dec-2021 11:20 by rmk")
|
||||
(* ; "Edited 16-Dec-2021 13:45 by rmk")
|
||||
(* ; "Edited 13-Dec-2021 17:13 by rmk")
|
||||
(* ; "Edited 9-Dec-2021 21:36 by rmk")
|
||||
(* ; "Edited 8-Dec-2021 11:27 by rmk")
|
||||
(* ; "Edited 5-Dec-2021 13:28 by rmk")
|
||||
(* ; "Edited 3-Dec-2021 00:21 by rmk:")
|
||||
(* ; "Edited 29-Nov-2021 23:08 by rmk:")
|
||||
[LAMBDA (MENUITEM MENU KEY) (* ; "Edited 27-Jan-2022 17:46 by rmk")
|
||||
(* ; "Edited 10-Jan-2022 22:51 by rmk")
|
||||
(* ; "Edited 25-Dec-2021 11:20 by rmk")
|
||||
(* ; "Edited 12-Jan-87 12:57 by bvm:")
|
||||
|
||||
(* ;; "Cobbled from FB.COMMANDSELECTEDFN. But here we assume that the menu item is of the form (display-string FN . EXTRAS), we peel out the FN to apply, leave the rest alone.")
|
||||
|
||||
(DECLARE (SPECVARS MENUITEM MENU KEY))
|
||||
(RESETLST
|
||||
[LET* [(WINDOW (WINDOWPROP (WFROMMENU MENU)
|
||||
'MAINWINDOW))
|
||||
(PROMPTWINDOW (GETPROMPTWINDOW WINDOW))
|
||||
(CDBROWSER (WINDOWPROP WINDOW 'TABLEBROWSER))
|
||||
(USERDATA (TB.USERDATA CDBROWSER))
|
||||
(CDVALUE (LISTGET USERDATA 'CDVALUE))
|
||||
(FN (CADR (LISTP MENUITEM]
|
||||
(DECLARE (SPECVARS WINDOW PROMPTWINDOW CDVALUE USERDATA))
|
||||
(GIVE.TTY.PROCESS PROMPTWINDOW)
|
||||
(TTYDISPLAYSTREAM PROMPTWINDOW) (* ; "Pwindow")
|
||||
(IF (EQ 0 (TB.NUMBER.OF.ITEMS CDBROWSER 'SELECTED))
|
||||
THEN (FLASHWINDOW PROMPTWINDOW)
|
||||
(PRIN3 "Please make a selection" T)
|
||||
ELSE (TB.MAP.SELECTED.ITEMS CDBROWSER
|
||||
[FUNCTION (LAMBDA (CDBROWSER TBITEM)
|
||||
(LET* ((CDENTRY (CADR (FETCH TIDATA OF TBITEM)))
|
||||
(FILE1 (FETCH (CDINFO FULLNAME)
|
||||
(FETCH (CDENTRY INFO1) OF CDENTRY)))
|
||||
(FILE2 (FETCH (CDINFO FULLNAME)
|
||||
(FETCH (CDENTRY INFO2) OF CDENTRY)))
|
||||
(TYPE (FETCH (CDINFO TYPE) OF (FETCH (CDENTRY INFO1)
|
||||
OF CDENTRY)))
|
||||
(LABELS (APPLY* (OR (LISTGET USERDATA 'LABELFN)
|
||||
(FUNCTION NILL))
|
||||
FILE1 FILE2 USERDATA))
|
||||
(LABEL1 (OR (CAR LABELS)
|
||||
FILE1))
|
||||
(LABEL2 (OR (CADR LABELS)
|
||||
FILE2)))
|
||||
(DECLARE (SPECVARS . T))
|
||||
(CL:UNLESS (STREQUAL MENUITEM "") (* ; "For blank lines")
|
||||
(RESETLST
|
||||
[LET* [(WINDOW (WINDOWPROP (WFROMMENU MENU)
|
||||
'MAINWINDOW))
|
||||
(PWINDOW (GETPROMPTWINDOW WINDOW))
|
||||
(CDBROWSER (WINDOWPROP WINDOW 'TABLEBROWSER))
|
||||
(USERDATA (TB.USERDATA CDBROWSER))
|
||||
(CDVALUE (LISTGET USERDATA 'CDVALUE))
|
||||
(FN (CADR (LISTP MENUITEM]
|
||||
(DECLARE (SPECVARS WINDOW PWINDOW CDVALUE USERDATA))
|
||||
(GIVE.TTY.PROCESS PWINDOW)
|
||||
(TTYDISPLAYSTREAM PWINDOW) (* ; "Pwindow")
|
||||
(COND
|
||||
((EQ 0 (TB.NUMBER.OF.ITEMS CDBROWSER 'SELECTED))
|
||||
(FLASHWINDOW PWINDOW)
|
||||
(PRIN3 "Please make a selection" T))
|
||||
(T (TB.MAP.SELECTED.ITEMS
|
||||
CDBROWSER
|
||||
[FUNCTION (LAMBDA (CDBROWSER TBITEM)
|
||||
(LET* ((CDENTRY (CADR (FETCH TIDATA OF TBITEM)))
|
||||
(FILE1 (FETCH (CDINFO FULLNAME)
|
||||
(FETCH (CDENTRY INFO1) OF CDENTRY)))
|
||||
(FILE2 (FETCH (CDINFO FULLNAME)
|
||||
(FETCH (CDENTRY INFO2) OF CDENTRY)))
|
||||
(TYPE (FETCH (CDINFO TYPE) OF (FETCH (CDENTRY INFO1)
|
||||
OF CDENTRY)))
|
||||
(LABELS (APPLY* (OR (LISTGET USERDATA 'LABELFN)
|
||||
(FUNCTION NILL))
|
||||
FILE1 FILE2 USERDATA))
|
||||
(LABEL1 (OR (CAR LABELS)
|
||||
FILE1))
|
||||
(LABEL2 (OR (CADR LABELS)
|
||||
FILE2)))
|
||||
(DECLARE (SPECVARS . T))
|
||||
|
||||
(* ;; "If USERDATA contains a LABELFN, then it is applied to the files and the rest of the USERDATA to produce abbreviated labels for titles and headers.")
|
||||
|
||||
(CLEARW T)
|
||||
(CL:FUNCALL FN TBITEM MENUITEM CDBROWSER KEY]
|
||||
(FUNCTION NILL])])
|
||||
(CLEARW T)
|
||||
(CL:FUNCALL FN TBITEM MENUITEM CDBROWSER KEY]
|
||||
(FUNCTION NILL]))])
|
||||
|
||||
(CD-MENUFN
|
||||
[LAMBDA (TBITEM MENUITEM CDBROWSER KEY) (* ; "Edited 30-Dec-2021 18:21 by rmk")
|
||||
(* ; "Edited 20-Dec-2021 09:56 by rmk")
|
||||
(* ; "Edited 16-Dec-2021 13:30 by rmk")
|
||||
(* ; "Edited 13-Dec-2021 22:11 by rmk")
|
||||
(* ; "Edited 10-Dec-2021 21:42 by rmk")
|
||||
(* ; "Edited 9-Dec-2021 21:24 by rmk")
|
||||
[LAMBDA (TBITEM MENUITEM CDBROWSER KEY)
|
||||
|
||||
(* ;; "Edited 29-Jan-2022 00:03 by rmk: FILELABELFN, if provided, can be used to calculate abbreviated labels for the file, for example, to strip off any long common prefixes.")
|
||||
|
||||
(* ;; "The FILELABELFN, if provided, can be used to calculate abbreviated labels for the file, for example, to strip off any long common prefixes.")
|
||||
|
||||
(* ;; "MENUITEM is of the form (display-atom <this function> . extrainfo). The selector for the selectq is either the CAR of the extrainfo or the display atom.")
|
||||
|
||||
(SELECTQ (OR (CADDR MENUITEM)
|
||||
(CAR MENUITEM))
|
||||
(Compare (IF (AND FILE1 FILE2)
|
||||
THEN (SELECTQ TYPE
|
||||
(SOURCE (CSBROWSER FILE1 FILE2 NIL LABEL1 LABEL2))
|
||||
(COMPILED (PRIN3 "Cannot compare compiled files" T))
|
||||
((TEXT TEDIT)
|
||||
(* ;;
|
||||
(CL:WHEN (MEMB (OR (CADDR MENUITEM)
|
||||
(CAR MENUITEM))
|
||||
'(Compare See See% right See% both See% left))
|
||||
(* ; "Close the previous ones")
|
||||
(CLOSEWITH.DOIT WINDOW))
|
||||
(LET
|
||||
(CHILDREN)
|
||||
(SETQ CHILDREN
|
||||
(SELECTQ (OR (CADDR MENUITEM)
|
||||
(CAR MENUITEM))
|
||||
(Compare (IF (AND FILE1 FILE2)
|
||||
THEN (SELECTQ TYPE
|
||||
(SOURCE (CSBROWSER FILE1 FILE2 NIL LABEL1 LABEL2
|
||||
(RELCREATEREGION
|
||||
[FIXR (TIMES 0.75 (FETCH (REGION WIDTH)
|
||||
OF (WINDOWPROP WINDOW
|
||||
'REGION]
|
||||
200
|
||||
'LEFT
|
||||
'TOP
|
||||
`(,WINDOW 0.125)
|
||||
(IPLUS (FETCH (REGION BOTTOM)
|
||||
OF (WINDOWPROP WINDOW 'REGION))
|
||||
20)
|
||||
T)))
|
||||
(COMPILED (FLASHWINDOW T)
|
||||
(PRIN3 "Cannot compare compiled files" T))
|
||||
((TEXT TEDIT)
|
||||
(* ;;
|
||||
"Works for TEDIT, but doesn't detect image object differences")
|
||||
|
||||
(COMPARETEXT FILE1 FILE2 'LINE NIL (LIST LABEL1 LABEL2)))
|
||||
(PROGN (PRIN3 "Unable to compare, showing both" T)
|
||||
(TEDIT-SEE-VERSIONS FILE1 FILE2 LABEL1 LABEL2)))
|
||||
ELSE (PRIN3 "Only one file" T)))
|
||||
(See% left (IF FILE1
|
||||
THEN (TEDIT-SEE FILE1 NIL NIL (CONCAT "SEE window for " LABEL1))
|
||||
(COMPARETEXT FILE1 FILE2 'LINE
|
||||
(RELCREATEPOSITION `(,WINDOW 0.5)
|
||||
(IPLUS (FETCH (REGION BOTTOM)
|
||||
OF (WINDOWPROP WINDOW 'REGION))
|
||||
20))
|
||||
(LIST LABEL1 LABEL2)))
|
||||
(PROGN (FLASHWINDOW T)
|
||||
(PRIN3 "Unable to compare, showing both" T)
|
||||
(TEDIT-SEE-VERSIONS FILE1 FILE2 LABEL1 LABEL2)))
|
||||
ELSE (FLASHWINDOW T)
|
||||
(PRIN3 "No file to print" T)))
|
||||
(See% right (IF FILE2
|
||||
THEN (TEDIT-SEE FILE2 NIL NIL (CONCAT "SEE window for " LABEL2))
|
||||
ELSE (FLASHWINDOW T)
|
||||
(PRIN3 "No file to print" T)))
|
||||
(See% both (IF (AND FILE1 FILE2)
|
||||
THEN (EXAMINEFILES FILE1 FILE2 LABEL1 LABEL2)
|
||||
ELSE (PRIN3 "Only one file" T)))
|
||||
(Copy% -> (LET [(DEST (COPYFILE FILE1 (PACKFILENAME 'VERSION NIL FILE2]
|
||||
(PRIN3 (CL:IF DEST
|
||||
(CONCAT "Copied to " DEST)
|
||||
(CONCAT FILE2 " could not be copied"))
|
||||
T)))
|
||||
(Copy% <- (LET [(DEST (COPYFILE FILE2 (PACKFILENAME 'VERSION NIL FILE1]
|
||||
(PRIN3 (CL:IF DEST
|
||||
(CONCAT "Copied to " DEST)
|
||||
(CONCAT FILE1 " could not be copied"))
|
||||
T)))
|
||||
(SHOULDNT])
|
||||
(PRIN3 "Only one file" T)))
|
||||
(See% left (IF FILE1
|
||||
THEN (TEDIT-SEE FILE1 (RELCREATEREGION 700 700 'RIGHT 'TOP
|
||||
`(,WINDOW 0.5)
|
||||
(IPLUS (FETCH (REGION BOTTOM)
|
||||
OF (WINDOWPROP WINDOW 'REGION))
|
||||
-1)
|
||||
T)
|
||||
NIL
|
||||
(CONCAT "SEE window for " LABEL1))
|
||||
ELSE (FLASHWINDOW T)
|
||||
(PRIN3 "No file to print" T)))
|
||||
(See% right (IF FILE2
|
||||
THEN (TEDIT-SEE FILE2 (RELCREATEREGION 700 700 'LEFT 'TOP
|
||||
`(,WINDOW 0.5)
|
||||
(IPLUS (FETCH (REGION BOTTOM)
|
||||
OF (WINDOWPROP WINDOW 'REGION))
|
||||
-1)
|
||||
T)
|
||||
NIL
|
||||
(CONCAT "SEE window for " LABEL2))
|
||||
ELSE (FLASHWINDOW T)
|
||||
(PRIN3 "No file to print" T)))
|
||||
((See See% both)
|
||||
(IF (AND FILE1 FILE2)
|
||||
THEN (EXAMINEFILES FILE1 FILE2 LABEL1 LABEL2
|
||||
(RELCREATEREGION 1400 700 'LEFT 'TOP `(,WINDOW 0.5 -701)
|
||||
(IPLUS (FETCH (REGION BOTTOM) OF (WINDOWPROP WINDOW
|
||||
'REGION))
|
||||
-1)
|
||||
T))
|
||||
ELSE (FLASHWINDOW T)
|
||||
(PRIN3 "Only one file" T)))
|
||||
(Copy% -> (LET [(DEST (COPYFILE FILE1 (PACKFILENAME 'VERSION NIL FILE2]
|
||||
(PRIN3 (CL:IF DEST
|
||||
(CONCAT "Copied to " DEST)
|
||||
(PROGN (FLASHWINDOW T)
|
||||
(CONCAT FILE2 " could not be copied")))
|
||||
T)))
|
||||
(Copy% <- (LET [(DEST (COPYFILE FILE2 (PACKFILENAME 'VERSION NIL FILE1]
|
||||
(PRIN3 (CL:IF DEST
|
||||
(CONCAT "Copied to " DEST)
|
||||
(PROGN (FLASHWINDOW T)
|
||||
(CONCAT FILE1 " could not be copied")))
|
||||
T)))
|
||||
(SHOULDNT)))
|
||||
(CLOSEWITH CHILDREN WINDOW)
|
||||
(MOVEWITH CHILDREN WINDOW])
|
||||
)
|
||||
|
||||
(RPAQQ CDTABLEBROWSER.MENUITEMS ((Compare CD-MENUFN)
|
||||
@@ -1716,28 +1912,31 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp
|
||||
(Copy% <- CD-MENUFN)
|
||||
(See% left CD-MENUFN)
|
||||
(See% right CD-MENUFN)
|
||||
(See% both CD-MENUFN)))
|
||||
(See% both CD-MENUFN)
|
||||
(See CD-MENUFN)))
|
||||
|
||||
(FILESLOAD (SYSLOAD)
|
||||
COMPARESOURCES COMPARETEXT)
|
||||
(PUTPROPS COMPAREDIRECTORIES COPYRIGHT ("Venue & Xerox Corporation" 1985 1986 1987 1988 1990 1994 1998
|
||||
2018 2020 2021))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (2418 17067 (COMPAREDIRECTORIES 2428 . 12186) (COMPAREDIRECTORIES.INFOS 12188 . 13867) (
|
||||
COMPAREDIRECTORIES.INFOS.TYPE 13869 . 14451) (MATCHNAME 14453 . 14983) (CD.INSURECDVALUE 14985 . 16599
|
||||
) (CD.UPDATEWIDTHS 16601 . 17065)) (17068 26728 (CDFILES 17078 . 23061) (CDFILES.MATCH 23063 . 24449)
|
||||
(CDFILES.PATS 24451 . 26726)) (26729 41174 (CDPRINT 26739 . 29343) (CDPRINT.LINE 29345 . 31901) (
|
||||
CDPRINT.MAXWIDTHS 31903 . 36018) (CDPRINT.COLHEADERS 36020 . 36658) (CDPRINT.COLUMNS 36660 . 40539) (
|
||||
CDTEDIT 40541 . 41172)) (41175 44371 (CDMAP 41185 . 42617) (CDENTRY 42619 . 42928) (CDSUBSET 42930 .
|
||||
44369)) (44372 51313 (BINCOMP 44382 . 48671) (EOLTYPE 48673 . 50638) (EOLTYPE.SHOW 50640 . 51311)) (
|
||||
51841 65048 (FIND-UNCOMPILED-FILES 51851 . 55494) (FIND-UNSOURCED-FILES 55496 . 58305) (
|
||||
FIND-SOURCE-FILES 58307 . 60011) (FIND-COMPILED-FILES 60013 . 62091) (FIND-UNLOADED-FILES 62093 .
|
||||
62837) (FIND-LOADED-FILES 62839 . 63393) (FIND-MULTICOMPILED-FILES 63395 . 65046)) (65049 73251 (
|
||||
CREATED-AS 65059 . 69856) (SOURCE-FOR-COMPILED-P 69858 . 72556) (COMPILE-SOURCE-DATE-DIFF 72558 .
|
||||
73249)) (73252 83558 (FIX-DIRECTORY-DATES 73262 . 76255) (FIX-EQUIV-DATES 76257 . 77782) (
|
||||
COPY-COMPARED-FILES 77784 . 79605) (COPY-MISSING-FILES 79607 . 81764) (COMPILED-ON-SAME-SOURCE 81766
|
||||
. 83556)) (83752 91440 (CDBROWSER 83762 . 88335) (CDBROWSER.STRINGS 88337 . 91438)) (91602 92874 (
|
||||
CD.TABLEITEM 91612 . 91832) (CD.TABLEITEM.PRINTFN 91834 . 92033) (CD.TABLEITEM.COPYFN 92035 . 92629) (
|
||||
CDTABLEBROWSER.HEADING.REPAINTFN 92631 . 92872)) (92875 100220 (CDTABLEBROWSER.WHENSELECTEDFN 92885 .
|
||||
93353) (CD.COMMANDSELECTEDFN 93355 . 97161) (CD-MENUFN 97163 . 100218)))))
|
||||
(FILEMAP (NIL (2536 19051 (COMPAREDIRECTORIES 2546 . 8995) (COMPAREDIRECTORIES.INFOS 8997 . 11117) (
|
||||
CDENTRIES.SELECT 11119 . 15805) (COMPAREDIRECTORIES.INFOS.TYPE 15807 . 16435) (MATCHNAME 16437 . 16967
|
||||
) (CD.INSURECDVALUE 16969 . 18583) (CD.UPDATEWIDTHS 18585 . 19049)) (19052 29324 (CDFILES 19062 .
|
||||
25418) (CDFILES.MATCH 25420 . 27045) (CDFILES.PATS 27047 . 29322)) (29325 44410 (CDPRINT 29335 . 31680
|
||||
) (CDPRINT.HEADER 31682 . 32579) (CDPRINT.LINE 32581 . 35137) (CDPRINT.MAXWIDTHS 35139 . 39254) (
|
||||
CDPRINT.COLHEADERS 39256 . 39894) (CDPRINT.COLUMNS 39896 . 43775) (CDTEDIT 43777 . 44408)) (44411
|
||||
52780 (CDMAP 44421 . 45853) (CDENTRY 45855 . 46164) (CDSUBSET 46166 . 47605) (CDMERGE 47607 . 51461) (
|
||||
CDMERGE.COMMON 51463 . 52778)) (52781 60319 (BINCOMP 52791 . 57080) (EOLTYPE 57082 . 59644) (
|
||||
EOLTYPE.SHOW 59646 . 60317)) (60847 74054 (FIND-UNCOMPILED-FILES 60857 . 64500) (FIND-UNSOURCED-FILES
|
||||
64502 . 67311) (FIND-SOURCE-FILES 67313 . 69017) (FIND-COMPILED-FILES 69019 . 71097) (
|
||||
FIND-UNLOADED-FILES 71099 . 71843) (FIND-LOADED-FILES 71845 . 72399) (FIND-MULTICOMPILED-FILES 72401
|
||||
. 74052)) (74055 82257 (CREATED-AS 74065 . 78862) (SOURCE-FOR-COMPILED-P 78864 . 81562) (
|
||||
COMPILE-SOURCE-DATE-DIFF 81564 . 82255)) (82258 92564 (FIX-DIRECTORY-DATES 82268 . 85261) (
|
||||
FIX-EQUIV-DATES 85263 . 86788) (COPY-COMPARED-FILES 86790 . 88611) (COPY-MISSING-FILES 88613 . 90770)
|
||||
(COMPILED-ON-SAME-SOURCE 90772 . 92562)) (92758 99800 (CDBROWSER 92768 . 96695) (CDBROWSER.STRINGS
|
||||
96697 . 99798)) (99962 101234 (CD.TABLEITEM 99972 . 100192) (CD.TABLEITEM.PRINTFN 100194 . 100393) (
|
||||
CD.TABLEITEM.COPYFN 100395 . 100989) (CDTABLEBROWSER.HEADING.REPAINTFN 100991 . 101232)) (101235
|
||||
111110 (CDTABLEBROWSER.WHENSELECTEDFN 101245 . 101713) (CD.COMMANDSELECTEDFN 101715 . 105106) (
|
||||
CD-MENUFN 105108 . 111108)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
File diff suppressed because one or more lines are too long
@@ -1,13 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED " 3-Jan-2022 08:40:38"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>COMPARESOURCES.;106 42666
|
||||
(FILECREATED "28-Jan-2022 18:22:40"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>COMPARESOURCES.;118 41270
|
||||
|
||||
:CHANGES-TO (FNS CSOBJ.BUTTONEVENTINFN CSOBJ.COPYBUTTONEVENTINFN)
|
||||
(VARS COMPARESOURCESCOMS)
|
||||
:CHANGES-TO (FNS CSOBJ.BUTTONEVENTINFN)
|
||||
|
||||
:PREVIOUS-DATE "27-Dec-2021 11:56:48"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>COMPARESOURCES.;105)
|
||||
:PREVIOUS-DATE "28-Jan-2022 17:12:39"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>COMPARESOURCES.;116)
|
||||
|
||||
|
||||
(* ; "
|
||||
@@ -38,13 +37,9 @@ Copyright (c) 1985-1988, 2018, 2020-2021 by Xerox Corporation.
|
||||
(DEFINEQ
|
||||
|
||||
(COMPARESOURCES
|
||||
[LAMBDA (FILEX FILEY EXAMINE DW? LISTSTREAM) (* ; "Edited 26-Dec-2021 21:32 by rmk")
|
||||
(* ; "Edited 20-Dec-2021 09:51 by rmk")
|
||||
(* ; "Edited 9-Dec-2021 23:13 by rmk")
|
||||
(* ; "Edited 4-Dec-2021 19:54 by rmk")
|
||||
(* ; "Edited 23-Nov-2021 19:46 by rmk:")
|
||||
(* ; "Edited 30-Oct-2021 20:13 by rmk:")
|
||||
(* ; "Edited 19-Apr-2018 10:49 by rmk:")
|
||||
[LAMBDA (FILEX FILEY EXAMINE DW? LISTSTREAM) (* ; "Edited 28-Jan-2022 17:10 by rmk")
|
||||
(* ; "Edited 26-Dec-2021 21:32 by rmk")
|
||||
(* ; "Edited 19-Apr-2018 10:49 by rmk:")
|
||||
|
||||
(* ;;; "Compare two lisp source files, reporting differences. LISTSTREAM if given is an open stream")
|
||||
|
||||
@@ -95,7 +90,7 @@ Copyright (c) 1985-1988, 2018, 2020-2021 by Xerox Corporation.
|
||||
'DECLARE%:]
|
||||
(SETQ BODYY (CL:SET-DIFFERENCE BODYY DECLAREY))
|
||||
(WITH-READER-ENVIRONMENT (OR ENVX ENVY (MAKE-READER-ENVIRONMENT))
|
||||
(\CS.COMPARE.MASTERS BODYX BODYY DW? CONTEXTSTREAM COMPARESTREAM)
|
||||
(\CS.COMPARE.MASTERS BODYX BODYY DW?)
|
||||
|
||||
(* ;; "Done with the non-DECLARE: expressions. Nw sort what's left according to when it is eval'ed so that we can hopefully further reduce the amount of stuff to compare")
|
||||
|
||||
@@ -128,7 +123,7 @@ Copyright (c) 1985-1988, 2018, 2020-2021 by Xerox Corporation.
|
||||
"REVERSE because \CS.SORT.DECLARES delivered expressions in reverse order")
|
||||
(\CS.COMPARE.MASTERS (REVERSE X)
|
||||
(REVERSE Y)
|
||||
DW? CONTEXTSTREAM COMPARESTREAM]
|
||||
DW?]
|
||||
(TERPRI CONTEXTSTREAM))
|
||||
(SELECTQ INSERTOBJECTS
|
||||
(OBJECTWINDOW (CL:UNLESS (EQ 0 (GETFILEPTR CONTEXTSTREAM))
|
||||
@@ -143,15 +138,17 @@ Copyright (c) 1985-1988, 2018, 2020-2021 by Xerox Corporation.
|
||||
'SAME])
|
||||
|
||||
(\CS.COMPARE.MASTERS
|
||||
[LAMBDA (BODYX BODYY DW?) (* ; "Edited 19-Dec-2021 21:05 by rmk")
|
||||
(* ; "Edited 9-Dec-2021 23:26 by rmk")
|
||||
(* ; "Edited 4-Dec-2021 10:00 by rmk")
|
||||
(* ; "Edited 2-Dec-2021 14:25 by rmk:")
|
||||
(* ; "Edited 27-Nov-2021 12:31 by rmk:")
|
||||
[LAMBDA (BODYX BODYY DW?) (* ; "Edited 18-Jan-2022 22:00 by rmk")
|
||||
(* ; "Edited 19-Dec-2021 21:05 by rmk")
|
||||
(* ; "Edited 5-Sep-2020 19:01 by rmk:")
|
||||
(* ; "Edited 15-Apr-88 14:41 by bvm")
|
||||
(DECLARE (USEDFREE DIFFERENCES COMPARESTREAM))
|
||||
(LET (YTHING XTHING PRED DIFS TMP)
|
||||
(SETQ BODYX (CL:REMOVE-IF (FUNCTION EDITDATE?)
|
||||
BODYX)) (* ;
|
||||
"We don't care about editdate comments")
|
||||
(SETQ BODYY (CL:REMOVE-IF (FUNCTION EDITDATE?)
|
||||
BODYY))
|
||||
(SETQ BODYX (\CS.FIXFNS BODYX))
|
||||
(SETQ BODYY (\CS.FIXFNS BODYY))
|
||||
(CL:WHEN (AND (SETQ XTHING (ASSOC 'DEFINE-FILE-INFO BODYX))
|
||||
@@ -555,50 +552,50 @@ Copyright (c) 1985-1988, 2018, 2020-2021 by Xerox Corporation.
|
||||
ELSE (ADD LINELENGTH (CHARWIDTH C FONT])
|
||||
|
||||
(CSOBJ.BUTTONEVENTINFN
|
||||
[LAMBDA (OBJ WINDOW) (* ; "Edited 26-Dec-2021 16:28 by rmk")
|
||||
(* ; "Edited 24-Dec-2021 14:09 by rmk")
|
||||
(* ; "Edited 20-Dec-2021 11:01 by rmk")
|
||||
(* ; "Edited 12-Dec-2021 21:30 by rmk")
|
||||
(* ; "Edited 10-Dec-2021 10:21 by rmk")
|
||||
(* ; "Edited 7-Dec-2021 17:49 by rmk")
|
||||
(* ; "Edited 4-Dec-2021 20:05 by rmk")
|
||||
[LAMBDA (OBJ WINDOW) (* ; "Edited 28-Jan-2022 18:22 by rmk")
|
||||
(* ; "Edited 25-Jan-2022 16:04 by rmk")
|
||||
(* ; "Edited 23-Jan-2022 18:11 by rmk")
|
||||
(LET
|
||||
[(COMPAREDATA (IMAGEOBJPROP OBJ 'COMPAREDATA]
|
||||
(CL:WHEN (AND COMPAREDATA (MOUSESTATE LEFT)
|
||||
(UNTILMOUSESTATE (NOT LEFT)))
|
||||
[LET ((NAME (POP COMPAREDATA))
|
||||
(TYPE (POP COMPAREDATA))
|
||||
(DEF1 (POP COMPAREDATA))
|
||||
(DEF2 (POP COMPAREDATA))
|
||||
(TITLE1 (POP COMPAREDATA))
|
||||
(TITLE2 (CAR COMPAREDATA)))
|
||||
(LET
|
||||
((NAME (POP COMPAREDATA))
|
||||
(TYPE (POP COMPAREDATA))
|
||||
(DEF1 (POP COMPAREDATA))
|
||||
(DEF2 (POP COMPAREDATA))
|
||||
(TITLE1 (POP COMPAREDATA))
|
||||
(TITLE2 (CAR COMPAREDATA)))
|
||||
|
||||
(* ;; "Move the cursor to just slightly below the current object, so that the edit windows are well aligned. We have to figure out the bottom of the current object, in screen coordinates.")
|
||||
(* ;; "Move the cursor to just slightly below the current object, so that the edit windows are well aligned. We have to figure out the bottom of the current object, in screen coordinates.")
|
||||
|
||||
[LET ((OBJREGION (OBJ.FIND.REGION WINDOW OBJ)))
|
||||
(\CURSORPOSITION (IPLUS 20 LASTMOUSEX)
|
||||
(IPLUS (IDIFFERENCE (FETCH (REGION BOTTOM) OF (OBJ.FIND.REGION WINDOW OBJ))
|
||||
(FETCH (REGION HEIGHT)
|
||||
OBJREGION))
|
||||
(FETCH (REGION TOP) OF (WINDOWREGION WINDOW]
|
||||
(IF (IMAGEOBJPROP OBJ 'ONLYONE)
|
||||
THEN [SEDIT:SEDIT
|
||||
(OR DEF1 DEF2)
|
||||
`(:REGION ,(RELGETREGION 600 (CL:IF (ILESSP (COUNT (OR DEF1 DEF2))
|
||||
100)
|
||||
150
|
||||
400)
|
||||
'LEFT
|
||||
'TOP NIL NIL T]
|
||||
ELSE (* ; "Spread the arguments")
|
||||
(EXAMINEDEFS NAME TYPE DEF1 DEF2 TITLE1 TITLE2
|
||||
(RELGETREGION 800 (CL:IF (ILESSP (IMAX (COUNT DEF1)
|
||||
(COUNT DEF2))
|
||||
100)
|
||||
150
|
||||
400)
|
||||
'LEFT
|
||||
'TOP NIL NIL T])])
|
||||
[LET ((OBJREGION (OBJ.FIND.REGION WINDOW OBJ)))
|
||||
(\CURSORPOSITION (IPLUS 20 LASTMOUSEX)
|
||||
(IPLUS (IDIFFERENCE (FETCH (REGION BOTTOM) OF OBJREGION)
|
||||
(FETCH (REGION HEIGHT) OF OBJREGION))
|
||||
(FETCH (REGION TOP) OF (WINDOWREGION WINDOW]
|
||||
(LET
|
||||
[EWINDOW (RELPOS (RELCREATEPOSITION `(,WINDOW 0.5)
|
||||
`(,WINDOW 0 -2]
|
||||
(CLOSEWITH.DOIT WINDOW)
|
||||
(SETQ EWINDOW
|
||||
(IF (IMAGEOBJPROP OBJ 'ONLYONE)
|
||||
THEN
|
||||
[SEDIT:GET-WINDOW
|
||||
(SEDIT:SEDIT (OR DEF1 DEF2)
|
||||
`(:REGION ,(RELCREATEREGION 600 (CL:IF (ILESSP (COUNT (OR DEF1 DEF2))
|
||||
100)
|
||||
150
|
||||
400)
|
||||
(CL:IF DEF1
|
||||
'RIGHT
|
||||
'LEFT)
|
||||
'TOP RELPOS NIL T]
|
||||
ELSE (* ; "Spread the arguments")
|
||||
(EXAMINEDEFS NAME TYPE DEF1 DEF2 TITLE1 TITLE2 RELPOS)))
|
||||
(CLOSEWITH EWINDOW WINDOW)
|
||||
(MOVEWITH EWINDOW WINDOW)
|
||||
EWINDOW)))])
|
||||
|
||||
(CSOBJ.COPYBUTTONEVENTINFN
|
||||
[LAMBDA (OBJ WINDOW REGION) (* ; "Edited 3-Jan-2022 08:36 by rmk")
|
||||
@@ -625,14 +622,14 @@ Copyright (c) 1985-1988, 2018, 2020-2021 by Xerox Corporation.
|
||||
(DEFINEQ
|
||||
|
||||
(CSBROWSER
|
||||
[LAMBDA (FILEX FILEY DW? LABEL1 LABEL2 REGION) (* ; "Edited 26-Dec-2021 21:06 by rmk")
|
||||
(* ; "Edited 24-Dec-2021 22:48 by rmk")
|
||||
(* ; "Edited 20-Dec-2021 09:55 by rmk")
|
||||
(* ; "Edited 16-Dec-2021 12:38 by rmk")
|
||||
(* ; "Edited 10-Dec-2021 12:03 by rmk")
|
||||
[LAMBDA (FILEX FILEY DW? LABEL1 LABEL2 REGION)
|
||||
|
||||
(* ;; "Edited 24-Jan-2022 23:11 by rmk: EXAMINE is non-NIL, we run the compare twice. Once to get the TEDIT up as a kind of table of contents, and the second time to run through all of the SEDIT windows.")
|
||||
|
||||
(* ;; "If EXAMINE is non-NIL, we run the compare twice. Once to get the TEDIT up as a kind of table of contents, and the second time to run through all of the SEDIT windows.")
|
||||
|
||||
(* ;; "Returns browser window")
|
||||
|
||||
(* ;; "Don't use the INFILEP value, because that might screw with capitalization that the caller prefers. If the file can be found that way, then lower functions will find it.")
|
||||
|
||||
(DECLARE (SPECVARS LABEL1 LABEL2))
|
||||
@@ -651,24 +648,24 @@ Copyright (c) 1985-1988, 2018, 2020-2021 by Xerox Corporation.
|
||||
" and "
|
||||
(OR LABEL2 (PACKFILENAME 'HOST NIL 'DIRECTORY NIL 'BODY FILEY]
|
||||
(SELECTQ COMPARESOURCES-BROWSER-TYPE
|
||||
(OBJECTWINDOW (LET [(WINDOW (OBJ.CREATEW 'VERTICAL NIL TITLE NIL T (FONTPROP
|
||||
DEFAULTFONT
|
||||
'HEIGHT]
|
||||
(OBJECTWINDOW (LET [(WINDOW (OBJ.CREATEW 'VERTICAL REGION TITLE NIL T
|
||||
(FONTPROP DEFAULTFONT 'HEIGHT]
|
||||
(WINDOWPROP WINDOW 'UNDERSCONTRUCTION T)
|
||||
(GETPROMPTWINDOW WINDOW T)
|
||||
(WINDOWPROP WINDOW 'UNDERSCONTRUCTION NIL)
|
||||
(PROG1 (COMPARESOURCES FILEX FILEY '(T 2WINDOWS)
|
||||
DW? WINDOW)
|
||||
(OPENW WINDOW))))
|
||||
(TEDIT [LET ((TSTREAM (OPENTEXTSTREAM)))
|
||||
(COMPARESOURCES FILEX FILEY '(T 2WINDOWS)
|
||||
DW? WINDOW)
|
||||
(OPENW WINDOW)
|
||||
WINDOW))
|
||||
(TEDIT (LET ((TSTREAM (OPENTEXTSTREAM)))
|
||||
(DSPFONT DEFAULTFONT TSTREAM)
|
||||
(PROG1 (COMPARESOURCES FILEX FILEY EXAMINE DW? TSTREAM)
|
||||
[TEDIT TSTREAM NIL NIL `(READONLY T WINDOWTYPE COMPARESOURCES-TEDIT
|
||||
TITLE ,TITLE]
|
||||
(CL:WHEN NIL
|
||||
EXAMINE
|
||||
(COMPARESOURCES FILEX FILEY EXAMINE DW? (OPENSTREAM '{NULL}
|
||||
'OUTPUT))))])
|
||||
(COMPARESOURCES FILEX FILEY EXAMINE DW? TSTREAM)
|
||||
[TEDIT TSTREAM REGION NIL `(READONLY T WINDOWTYPE COMPARESOURCES-TEDIT TITLE
|
||||
,TITLE]
|
||||
(CL:WHEN NIL
|
||||
EXAMINE
|
||||
(COMPARESOURCES FILEX FILEY EXAMINE DW? (OPENSTREAM '{NULL} 'OUTPUT)))
|
||||
(WFROMDS TSTREAM)))
|
||||
(HELP])
|
||||
)
|
||||
|
||||
@@ -689,16 +686,16 @@ Copyright (c) 1985-1988, 2018, 2020-2021 by Xerox Corporation.
|
||||
)
|
||||
(PUTPROPS COMPARESOURCES COPYRIGHT ("Xerox Corporation" 1985 1986 1987 1988 2018 2020 2021))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (1920 27703 (COMPARESOURCES 1930 . 8443) (\CS.COMPARE.MASTERS 8445 . 16581) (
|
||||
\CS.COMPARE.TYPES 16583 . 19721) (\CS.EXAMINE 19723 . 23950) (\CS.FIXFNS 23952 . 25454) (
|
||||
\CS.SORT.DECLARES 25456 . 25799) (\CS.SORT.DECLARE1 25801 . 27221) (\CS.FILTER.GARBAGE 27223 . 27701))
|
||||
(27704 31684 (\CS.ISFNFORM 27714 . 27982) (\CS.COMPARE.FNS 27984 . 28226) (\CS.FNSID 28228 . 28372) (
|
||||
\CS.ISVARFORM 28374 . 28479) (\CS.COMPARE.VARS 28481 . 29143) (\CS.ISMACROFORM 29145 . 29283) (
|
||||
\CS.ISRECFORM 29285 . 29378) (\CS.ISCOURIERFORM 29380 . 29480) (\CS.ISTEMPLATEFORM 29482 . 29580) (
|
||||
\CS.COMPARE.TEMPLATES 29582 . 29947) (\CS.ISPROPFORM 29949 . 30104) (\CS.PROP.NAME 30106 . 30251) (
|
||||
\CS.COMPARE.PROPS 30253 . 30410) (\CS.ISADDVARFORM 30412 . 30505) (\CS.COMPARE.ADDVARS 30507 . 30672)
|
||||
(\CS.ISFPKGCOMFORM 30674 . 30881) (\CS.COMPARE.FPKGCOMS 30883 . 31090) (\CS.COMPARE.DEFINE-FILE-INFO
|
||||
31092 . 31682)) (31685 38243 (CSOBJ.CREATE 31695 . 32108) (CSOBJ.DISPLAYFN 32110 . 32863) (
|
||||
CSOBJ.IMAGEBOXFN 32865 . 35026) (CSOBJ.BUTTONEVENTINFN 35028 . 37993) (CSOBJ.COPYBUTTONEVENTINFN 37995
|
||||
. 38241)) (39107 42184 (CSBROWSER 39117 . 42182)))))
|
||||
(FILEMAP (NIL (1850 27174 (COMPARESOURCES 1860 . 7906) (\CS.COMPARE.MASTERS 7908 . 16052) (
|
||||
\CS.COMPARE.TYPES 16054 . 19192) (\CS.EXAMINE 19194 . 23421) (\CS.FIXFNS 23423 . 24925) (
|
||||
\CS.SORT.DECLARES 24927 . 25270) (\CS.SORT.DECLARE1 25272 . 26692) (\CS.FILTER.GARBAGE 26694 . 27172))
|
||||
(27175 31155 (\CS.ISFNFORM 27185 . 27453) (\CS.COMPARE.FNS 27455 . 27697) (\CS.FNSID 27699 . 27843) (
|
||||
\CS.ISVARFORM 27845 . 27950) (\CS.COMPARE.VARS 27952 . 28614) (\CS.ISMACROFORM 28616 . 28754) (
|
||||
\CS.ISRECFORM 28756 . 28849) (\CS.ISCOURIERFORM 28851 . 28951) (\CS.ISTEMPLATEFORM 28953 . 29051) (
|
||||
\CS.COMPARE.TEMPLATES 29053 . 29418) (\CS.ISPROPFORM 29420 . 29575) (\CS.PROP.NAME 29577 . 29722) (
|
||||
\CS.COMPARE.PROPS 29724 . 29881) (\CS.ISADDVARFORM 29883 . 29976) (\CS.COMPARE.ADDVARS 29978 . 30143)
|
||||
(\CS.ISFPKGCOMFORM 30145 . 30352) (\CS.COMPARE.FPKGCOMS 30354 . 30561) (\CS.COMPARE.DEFINE-FILE-INFO
|
||||
30563 . 31153)) (31156 37220 (CSOBJ.CREATE 31166 . 31579) (CSOBJ.DISPLAYFN 31581 . 32334) (
|
||||
CSOBJ.IMAGEBOXFN 32336 . 34497) (CSOBJ.BUTTONEVENTINFN 34499 . 36970) (CSOBJ.COPYBUTTONEVENTINFN 36972
|
||||
. 37218)) (38084 40788 (CSBROWSER 38094 . 40786)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
Binary file not shown.
Binary file not shown.
@@ -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
BIN
lispusers/DICTTOOL.LCOM
Normal file
Binary file not shown.
106
lispusers/DINFO
106
lispusers/DINFO
@@ -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
|
||||
|
||||
Binary file not shown.
@@ -1,22 +1,28 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED " 2-Jan-2022 23:15:58"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>EXAMINEDEFS.;19 6871
|
||||
(FILECREATED "28-Jan-2022 23:36:31"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>EXAMINEDEFS.;32 11715
|
||||
|
||||
:CHANGES-TO (FNS EXAMINEFILES)
|
||||
:CHANGES-TO (FNS TEDITDEF)
|
||||
|
||||
:PREVIOUS-DATE "30-Dec-2021 21:49:58"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>EXAMINEDEFS.;18)
|
||||
:PREVIOUS-DATE "25-Jan-2022 10:20:31"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>EXAMINEDEFS.;31)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT EXAMINEDEFSCOMS)
|
||||
|
||||
(RPAQQ EXAMINEDEFSCOMS ((FNS EXAMINEDEFS EXAMINEFILES)
|
||||
(INITVARS (EXAMINEDEFS-PROCESS-LIST))))
|
||||
(RPAQQ EXAMINEDEFSCOMS ((FNS EXAMINEDEFS EXAMINEFILES TEDITDEF)
|
||||
(INITVARS (EXAMINEDEFS-PROCESS-LIST)
|
||||
(EXAMINEWITH 'COMPARETEXT))
|
||||
(FILES (SYSLOAD)
|
||||
COMPARETEXT)))
|
||||
(DEFINEQ
|
||||
|
||||
(EXAMINEDEFS
|
||||
[LAMBDA (NAME TYPE SOURCE1 SOURCE2 TITLE1 TITLE2 REGION) (* ; "Edited 24-Dec-2021 22:39 by rmk")
|
||||
[LAMBDA (NAME TYPE SOURCE1 SOURCE2 TITLE1 TITLE2 REGION) (* ; "Edited 23-Jan-2022 17:40 by rmk")
|
||||
(* ; "Edited 18-Jan-2022 22:40 by rmk")
|
||||
(* ; "Edited 12-Jan-2022 17:29 by rmk")
|
||||
(* ; "Edited 24-Dec-2021 22:39 by rmk")
|
||||
(* ; "Edited 20-Dec-2021 11:06 by rmk")
|
||||
|
||||
(* ;; "This provides for side-by-side examination of separate but presumably related expressions. The (LISTP) expressions can be provided directly as SOURCE1 and SOURCE2 or, if NAME is given the copies of the definitions of NAME as TYPE on the two sources are examined.")
|
||||
@@ -30,6 +36,8 @@
|
||||
(ERROR SOURCE1 " cannot be examined"))
|
||||
(CL:UNLESS (LISTP SOURCE2)
|
||||
(ERROR SOURCE2 " cannot be examined")))
|
||||
(CL:UNLESS TYPE
|
||||
(SETQ TYPE 'FNS))
|
||||
|
||||
(* ;; "TITLE1 and TITLE2 are optional strings that will be used to construct the titles of the SEDIT windows. We would like to know where GETDEF got the definition so we can use that, but there isn't an interface that provides that information (extended WHEREIS?)")
|
||||
|
||||
@@ -68,65 +76,129 @@
|
||||
(* ;;
|
||||
"Crude suggestions for height, width, position. Suggest shorter window for smaller structures")
|
||||
|
||||
(CL:UNLESS (REGIONP REGION)
|
||||
(SETQ REGION (GETREGION)))
|
||||
(LET (W1 W2 HALFWIDTH)
|
||||
(SETQ HALFWIDTH (IQUOTIENT (FETCH (REGION WIDTH) OF REGION)
|
||||
2))
|
||||
[SETQ W1
|
||||
(SEDIT:GET-WINDOW (SEDIT:SEDIT DEF1
|
||||
`(:NAME ,(CONCAT NAME " from " TITLE1)
|
||||
:REGION
|
||||
,(CREATE REGION
|
||||
USING REGION WIDTH _ HALFWIDTH)
|
||||
:DONT-KEEP-WINDOW-REGION T]
|
||||
[SETQ W2
|
||||
(SEDIT:GET-WINDOW
|
||||
(SEDIT:SEDIT DEF2
|
||||
`(:NAME ,(CONCAT NAME " from " TITLE2)
|
||||
:REGION
|
||||
,(CREATE REGION USING REGION LEFT _
|
||||
(IPLUS (FETCH (REGION LEFT)
|
||||
OF REGION)
|
||||
HALFWIDTH)
|
||||
WIDTH _ HALFWIDTH)
|
||||
:DONT-KEEP-WINDOW-REGION T]
|
||||
(SELECTQ EXAMINEWITH
|
||||
(SEDIT (CL:UNLESS (REGIONP REGION)
|
||||
(SETQ REGION (GETREGION)))
|
||||
[LET (R1 R2 HALFWIDTH W1 W2)
|
||||
(SETQ HALFWIDTH (IQUOTIENT (FETCH (REGION WIDTH)
|
||||
OF REGION)
|
||||
2))
|
||||
(SETQ R1 (CREATE REGION USING REGION WIDTH _ HALFWIDTH))
|
||||
(SETQ R2 (CREATE REGION USING REGION LEFT _
|
||||
(IPLUS (FETCH (REGION LEFT)
|
||||
OF REGION)
|
||||
HALFWIDTH)
|
||||
WIDTH _ HALFWIDTH))
|
||||
[SETQ W1
|
||||
(SEDIT:GET-WINDOW (SEDIT:SEDIT
|
||||
DEF1
|
||||
`(:NAME ,(CONCAT NAME " from " TITLE1)
|
||||
:REGION
|
||||
,(CREATE REGION
|
||||
USING REGION WIDTH _
|
||||
HALFWIDTH)
|
||||
R1 :DONT-KEEP-WINDOW-REGION T]
|
||||
[SETQ W2
|
||||
(SEDIT:GET-WINDOW (SEDIT:SEDIT
|
||||
DEF2
|
||||
`(:NAME ,(CONCAT NAME " from " TITLE2)
|
||||
:REGION
|
||||
,R2 :DONT-KEEP-WINDOW-REGION T]
|
||||
(ATTACHWINDOW W2 W1 'RIGHT 'JUSTIFY)
|
||||
(MODERNWINDOW W2)
|
||||
|
||||
(* ;;
|
||||
(* ;;
|
||||
"So we can kill the processes on the next call, if they still exist after the windows are closed.")
|
||||
|
||||
[PUSH EXAMINEDEFS-PROCESS-LIST (CONS W1 (WINDOWPROP W1 'PROCESS))
|
||||
(CONS W2 (WINDOWPROP W2 'PROCESS]
|
||||
(ATTACHWINDOW W2 W1 'RIGHT 'JUSTIFY)
|
||||
(MODERNWINDOW W2)))
|
||||
(PUSH EXAMINEDEFS-PROCESS-LIST (CONS W1 (WINDOWPROP
|
||||
W1
|
||||
'PROCESS))
|
||||
(CONS W2 (WINDOWPROP W2 'PROCESS])
|
||||
(COMPARETEXT [LET (COMPARETEXT.ALLCHUNKS CTWINDOW
|
||||
(KEY (LIST NAME TYPE SOURCE1 SOURCE2 TITLE1
|
||||
TITLE2)))
|
||||
(DECLARE (SPECVARS COMPARETEXT.ALLCHUNKS))
|
||||
(* ; "Reuse an existing CT graph window")
|
||||
(OR [FIND W IN (OPENWINDOWS)
|
||||
SUCHTHAT (EQUAL KEY (WINDOWPROP W
|
||||
'EXAMINEDEFS]
|
||||
(PROG1 (SETQ CTWINDOW
|
||||
(COMPARETEXT (TEDITDEF NAME DEF1 TYPE)
|
||||
(TEDITDEF NAME DEF2 TYPE)
|
||||
'LINE REGION (LIST TITLE1 TITLE2)
|
||||
(CONCAT "Compare sources of " NAME
|
||||
" as " TYPE)))
|
||||
(WINDOWPROP CTWINDOW 'EXAMINEDEFS
|
||||
(LIST NAME TYPE SOURCE1 SOURCE2 TITLE1
|
||||
TITLE2)))])
|
||||
(SHOULDNT)))
|
||||
(PROGN (EDITE DEF1)
|
||||
(EDITE DEF2])
|
||||
|
||||
(EXAMINEFILES
|
||||
[LAMBDA (FILE1 FILE2 TITLE1 TITLE2 REGION) (* ; "Edited 2-Jan-2022 23:15 by rmk")
|
||||
[LAMBDA (FILE1 FILE2 TITLE1 TITLE2 REGION) (* ; "Edited 25-Jan-2022 10:08 by rmk")
|
||||
(* ; "Edited 2-Jan-2022 23:15 by rmk")
|
||||
(* ; "Edited 30-Dec-2021 21:49 by rmk")
|
||||
|
||||
(* ;; "We get a region, then split it in half. Should we attach or at least co-move and co-close the 2 windows?")
|
||||
|
||||
(CL:UNLESS REGION
|
||||
(SETQ REGION (GETREGION)))
|
||||
(TEDIT-SEE FILE1 (RELCREATEREGION `(,REGION 0.5 -1)
|
||||
REGION
|
||||
'RIGHT
|
||||
'TOP
|
||||
`(,REGION 0.5)
|
||||
(FETCH (REGION TOP) OF REGION))
|
||||
NIL TITLE1)
|
||||
(TEDIT-SEE FILE2 (RELCREATEREGION `(,REGION 0.5 1)
|
||||
REGION
|
||||
'LEFT
|
||||
'TOP
|
||||
`(,REGION 0.5)
|
||||
(FETCH (REGION TOP) OF REGION))
|
||||
NIL TITLE2])
|
||||
(LIST (TEDIT-SEE FILE1 (RELCREATEREGION `(,REGION 0.5 -1)
|
||||
REGION
|
||||
'RIGHT
|
||||
'TOP
|
||||
`(,REGION 0.5)
|
||||
(FETCH (REGION TOP) OF REGION))
|
||||
NIL TITLE1)
|
||||
(TEDIT-SEE FILE2 (RELCREATEREGION `(,REGION 0.5 1)
|
||||
REGION
|
||||
'LEFT
|
||||
'TOP
|
||||
`(,REGION 0.5)
|
||||
(FETCH (REGION TOP) OF REGION))
|
||||
NIL TITLE2])
|
||||
|
||||
(TEDITDEF
|
||||
[LAMBDA (NAME DEF TYPE READERENVIRONMENT) (* ; "Edited 28-Jan-2022 23:36 by rmk")
|
||||
(* ; "Edited 12-Jan-2022 17:27 by rmk")
|
||||
(LET ((TSTREAM (OPENTEXTSTREAM)))
|
||||
(DSPFONT DEFAULTFONT TSTREAM)
|
||||
(SELECTQ (CAR DEF)
|
||||
(DEFINEQ (SETQ DEF (CADR DEF))
|
||||
(PRINTOUT TSTREAM .FONT BOLDFONT .P2 NAME T .FONT DEFAULTFONT 2)
|
||||
(PRINTDEF (CADR DEF)
|
||||
2 T NIL NIL TSTREAM))
|
||||
((DEFMACRO DEFUN) (* ; "Has args after name")
|
||||
(PRINTOUT TSTREAM "(" .P2 (CAR DEF)
|
||||
" " .FONT BOLDFONT .P2 (CADR DEF)
|
||||
.FONT DEFAULTFONT " " .P2 (CADDR DEF)
|
||||
T)
|
||||
(PRINTDEF (CDDDR DEF)
|
||||
3 T T NIL TSTREAM)
|
||||
(PRIN3 ")" TSTREAM))
|
||||
(IF (EQ NAME (CADR DEF))
|
||||
THEN
|
||||
(* ;; "Like RPAQQ, bold the name")
|
||||
|
||||
[PRINTOUT TSTREAM "(" .P2 (CAR DEF)
|
||||
" " .FONT BOLDFONT .P2 (CADR DEF)
|
||||
.FONT DEFAULTFONT T .TAB (IPLUS 2 (NCHARS (CAR DEF]
|
||||
(PRINTDEF (CDDR DEF)
|
||||
(IPLUS 2 (NCHARS (CAR DEF)))
|
||||
T T NIL TSTREAM)
|
||||
(PRIN3 ")" TSTREAM)
|
||||
ELSE (PRINTDEF DEF 3 NIL NIL NIL TSTREAM)))
|
||||
TSTREAM])
|
||||
)
|
||||
|
||||
(RPAQ? EXAMINEDEFS-PROCESS-LIST )
|
||||
|
||||
(RPAQ? EXAMINEWITH 'COMPARETEXT)
|
||||
|
||||
(FILESLOAD (SYSLOAD)
|
||||
COMPARETEXT)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (510 6809 (EXAMINEDEFS 520 . 5811) (EXAMINEFILES 5813 . 6807)))))
|
||||
(FILEMAP (NIL (658 11573 (EXAMINEDEFS 668 . 8787) (EXAMINEFILES 8789 . 9984) (TEDITDEF 9986 . 11571)))
|
||||
))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
Binary file not shown.
@@ -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
|
||||
|
||||
Binary file not shown.
1137
lispusers/GITFNS
Normal file
1137
lispusers/GITFNS
Normal file
File diff suppressed because it is too large
Load Diff
BIN
lispusers/GITFNS.LCOM
Normal file
BIN
lispusers/GITFNS.LCOM
Normal file
Binary file not shown.
BIN
lispusers/GITFNS.TEDIT
Normal file
BIN
lispusers/GITFNS.TEDIT
Normal file
Binary file not shown.
@@ -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
|
||||
|
||||
Binary file not shown.
@@ -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
|
||||
|
||||
Binary file not shown.
1097
lispusers/MTP
1097
lispusers/MTP
File diff suppressed because it is too large
Load Diff
@@ -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
BIN
lispusers/MULTIPLE-HARDCOPY.LCOM
Normal file
Binary file not shown.
482
lispusers/PSEUDOHOSTS
Normal file
482
lispusers/PSEUDOHOSTS
Normal file
@@ -0,0 +1,482 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "30-Jan-2022 08:58:48"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>PSEUDOHOSTS.;135 25556
|
||||
|
||||
:CHANGES-TO (FNS PSEUDOHOST CONTRACT.PH EXPAND.PH PSEUDOFILENAME)
|
||||
(RECORDS PHDEVICE TARGETDEVICE)
|
||||
(VARS PSEUDOHOSTSCOMS)
|
||||
|
||||
:PREVIOUS-DATE "28-Jan-2022 09:06:55"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>PSEUDOHOSTS.;123)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT PSEUDOHOSTSCOMS)
|
||||
|
||||
(RPAQQ PSEUDOHOSTSCOMS
|
||||
[
|
||||
(* ;; "Public entries")
|
||||
|
||||
(FNS PSEUDOHOST PSEUDOHOSTP PSEUDOHOSTS TARGETHOST TRUEFILENAME PSEUDOFILENAME)
|
||||
|
||||
(* ;; "Internals")
|
||||
|
||||
(FNS EXPAND.PH CONTRACT.PH SLASHIT UNSLASHIT)
|
||||
(FNS OPENFILE.PH GETFILENAME.PH DIRECTORYNAMEP.PH CLOSEFILE.PH REOPENFILE.PH DELETEFILE.PH
|
||||
OPENP.PH UNREGISTERFILE.PH REGISTERFILE.PH GENERATEFILES.PH GETFILEINFO.PH
|
||||
SETFILEINFO.PH NEXTFILEFN.PH FILEINFOFN.PH RENAMEFILE.PH)
|
||||
(P (PSEUDOHOST 'LI LOGINHOST/DIR))
|
||||
(DECLARE%: EVAL@COMPILE DONTCOPY (RECORDS PHDEVICE PHGENFILESTATE TARGETDEVICE)
|
||||
(MACROS PSEUDOHOST.NAME PSEUDOHOST.TARGETVAL)
|
||||
(P (CL:UNLESS (GETP 'EXPORTS.ALL 'FILE)
|
||||
(LOAD 'EXPORTS.ALL))])
|
||||
|
||||
|
||||
|
||||
(* ;; "Public entries")
|
||||
|
||||
(DEFINEQ
|
||||
|
||||
(PSEUDOHOST
|
||||
[LAMBDA (HOST PREFIX)
|
||||
|
||||
(* ;; "Edited 30-Jan-2022 08:58 by rmk: Expand prefix so that it is rooted in a real host and not a previously defined pseudohost.")
|
||||
|
||||
(CL:WHEN (AND (LISTP HOST)
|
||||
(NULL PREFIX))
|
||||
(SETQ PREFIX (CADR HOST))
|
||||
(SETQ HOST (CAR HOST)))
|
||||
(SETQ HOST (U-CASE (MKATOM HOST)))
|
||||
[IF PREFIX
|
||||
THEN (CL:WHEN (PSEUDOHOSTP HOST) (* ;
|
||||
"Redefining: first clear out the previous one")
|
||||
(PSEUDOHOST HOST NIL))
|
||||
[LET (TARGETHOST TARGETDEVICE PREFIXHOST)
|
||||
(CL:UNLESS [SETQ PREFIXHOST (U-CASE (FILENAMEFIELD PREFIX 'HOST]
|
||||
(SETQ PREFIX (UNSLASHIT (PACKFILENAME 'HOST (SETQ PREFIXHOST 'DSK)
|
||||
'BODY PREFIX))))
|
||||
|
||||
(* ;; "We want the maximal prefix. If {LI} is a pseudohost with prefix {DSK}<abc> and we are defining {FOO} with prefix {LI}<xyz>, we want FOO's prefix to be {DSK}<abc>xyz>. , And if FUM is then defined as {FOO}<mno>, we want its prefix to be {DSK}<abc>xyz>mno>. This gives the true filenames.")
|
||||
|
||||
(SETQ PREFIX (EXPAND.PH PREFIX PREFIXHOST))
|
||||
(CL:UNLESS (MEMB (NTHCHARCODE PREFIX -1)
|
||||
(CHARCODE (> / <)))
|
||||
(SETQ PREFIX (CONCAT PREFIX (IF (STRPOS "/" PREFIX)
|
||||
THEN "/"
|
||||
ELSE ">"))))
|
||||
[SETQ TARGETHOST (U-CASE (FILENAMEFIELD PREFIX 'HOST]
|
||||
|
||||
(* ;; "We know about the directory separators for these particular devices. Maybe there should be separate list of slash-hosts somewhere that we can use.")
|
||||
|
||||
(SELECTQ TARGETHOST
|
||||
((DSK CORE)
|
||||
(SETQ PREFIX (UNSLASHIT PREFIX)))
|
||||
(UNIX (SETQ PREFIX (SLASHIT PREFIX)))
|
||||
NIL)
|
||||
(SETQ TARGETDEVICE (OR (\GETDEVICEFROMHOSTNAME TARGETHOST)
|
||||
(ERROR "UNKNOWN TARGET HOST" TARGETHOST)))
|
||||
|
||||
(* ;; "Save the last directory marker to pack on if needed.")
|
||||
|
||||
(\DEFINEDEVICE HOST
|
||||
(CREATE FDEV
|
||||
USING TARGETDEVICE DEVICENAME _ HOST FDEV1 _ TARGETDEVICE FDEV2 _ PREFIX
|
||||
OPENFILE _ (FUNCTION OPENFILE.PH)
|
||||
GETFILENAME _ (FUNCTION GETFILENAME.PH)
|
||||
DIRECTORYNAMEP _ (FUNCTION DIRECTORYNAMEP.PH)
|
||||
CLOSEFILE _ (FUNCTION CLOSEFILE.PH)
|
||||
REOPENFILE _ (FUNCTION REOPENFILE.PH)
|
||||
DELETEFILE _ (FUNCTION DELETEFILE.PH)
|
||||
OPENP _ (FUNCTION OPENP.PH)
|
||||
UNREGISTERFILE _ (FUNCTION UNREGISTERFILE.PH)
|
||||
REGISTERFILE _ (FUNCTION REGISTERFILE.PH)
|
||||
GENERATEFILES _ (FUNCTION GENERATEFILES.PH)
|
||||
GETFILEINFO _ (FUNCTION GETFILEINFO.PH)
|
||||
SETFILEINFO _ (FUNCTION SETFILEINFO.PH)
|
||||
RENAMEFILE _ (FUNCTION RENAMEFILE.PH)))
|
||||
|
||||
(* ;; "The ultimate target device keeps a map of prefixes and the hostnames they map to. The longest matching prefix is chosen when a name that expands to the target device is contracted.")
|
||||
|
||||
(CHANGE (FETCH (TARGETDEVICE PREFIXMAP) OF TARGETDEVICE)
|
||||
(SORT (CONS (LIST PREFIX HOST (CL:IF (EQ (CHARCODE /)
|
||||
(NTHCHARCODE PREFIX -1))
|
||||
'/
|
||||
'<))
|
||||
DATUM)
|
||||
(FUNCTION (LAMBDA (P1 P2)
|
||||
(IGREATERP (NCHARS (CAR P1))
|
||||
(NCHARS (CAR P2]
|
||||
ELSEIF (SETQ PREFIX (CADR (PSEUDOHOSTP HOST)))
|
||||
THEN
|
||||
(* ;; "\DEFINEDEVICE removes the name-mapping but doesn't remove the device. Maybe that's on purpose for other devices, but not here.")
|
||||
|
||||
(LET* ((PHHOST (\GETDEVICEFROMNAME HOST \FILEDEVICES))
|
||||
(TARGETDEV (FETCH (PHDEVICE TARGETDEV) OF PHHOST)))
|
||||
(UNINTERRUPTABLY
|
||||
(CL:WHEN TARGETDEV (* ;
|
||||
"Don't want to fail uninterruptably")
|
||||
(CHANGE (FETCH (TARGETDEVICE PREFIXMAP) OF TARGETDEV)
|
||||
(DREMOVE (ASSOC PREFIX DATUM)
|
||||
DATUM)))
|
||||
(SETQ \FILEDEVICES (DREMOVE PHHOST \FILEDEVICES))
|
||||
(\DEFINEDEVICE HOST NIL))]
|
||||
HOST])
|
||||
|
||||
(PSEUDOHOSTP
|
||||
[LAMBDA (HOST) (* ; "Edited 18-Jan-2022 11:29 by rmk")
|
||||
(LET ((DEV (\GETDEVICEFROMNAME HOST T T)))
|
||||
(CL:WHEN (AND DEV (TYPE? FDEV (FETCH (PHDEVICE TARGETDEV) OF DEV)))
|
||||
(LIST HOST (FETCH (PHDEVICE PREFIX)
|
||||
DEV)))])
|
||||
|
||||
(PSEUDOHOSTS
|
||||
[LAMBDA NIL (* ; "Edited 17-Jan-2022 18:15 by rmk")
|
||||
(FOR DEV IN \FILEDEVICES WHEN (TYPE? FDEV (FETCH (PHDEVICE TARGETDEV) OF DEV))
|
||||
COLLECT (LIST (FETCH (FDEV DEVICENAME) OF DEV)
|
||||
(FETCH (PHDEVICE PREFIX) OF DEV])
|
||||
|
||||
(TARGETHOST
|
||||
[LAMBDA (HOST) (* ; "Edited 22-Jan-2022 09:00 by rmk")
|
||||
(CL:WHEN (PSEUDOHOSTP HOST)
|
||||
(FETCH (FDEV DEVICENAME) OF (FETCH (PHDEVICE TARGETDEV) OF (\GETDEVICEFROMNAME HOST))))])
|
||||
|
||||
(TRUEFILENAME
|
||||
[LAMBDA (FILE) (* ; "Edited 26-Jan-2022 23:33 by rmk")
|
||||
(* ; "Edited 25-Jan-2022 08:47 by rmk")
|
||||
(LET (FILENAME DEVICE)
|
||||
(IF (STREAMP FILE)
|
||||
THEN (SETQ FILENAME (FETCH (STREAM FULLFILENAME) OF FILE))
|
||||
(SETQ DEVICE (FETCH (STREAM DEVICE) OF FILE))
|
||||
ELSE (SETQ FILENAME (\ADD.CONNECTED.DIR FILE))
|
||||
(SETQ DEVICE (\GETDEVICEFROMNAME FILENAME)))
|
||||
(CL:IF (TYPE? PHDEVICE DEVICE)
|
||||
(EXPAND.PH FILENAME DEVICE)
|
||||
FILENAME)])
|
||||
|
||||
(PSEUDOFILENAME
|
||||
[LAMBDA (FILE) (* ; "Edited 29-Jan-2022 23:08 by rmk")
|
||||
(* ; "Edited 28-Jan-2022 09:06 by rmk")
|
||||
(FOR D PN (FILENAME _ (IF (STREAMP FILE)
|
||||
THEN (FETCH (STREAM FULLFILENAME) OF FILE)
|
||||
ELSE (\ADD.CONNECTED.DIR FILE))) IN \FILEDEVICES
|
||||
WHEN (TYPE? PHDEVICE D) UNLESS (EQ FILENAME (SETQ PN (CONTRACT.PH FILENAME D)))
|
||||
DO (RETURN PN) FINALLY (RETURN FILENAME])
|
||||
)
|
||||
|
||||
|
||||
|
||||
(* ;; "Internals")
|
||||
|
||||
(DEFINEQ
|
||||
|
||||
(EXPAND.PH
|
||||
[LAMBDA (FILENAME PHDEV)
|
||||
|
||||
(* ;; "Edited 30-Jan-2022 00:15 by rmk: that FILENAME contains }, because HOST was identified in it. If FILENAME is a stream, expand its full name")
|
||||
|
||||
(* ;; "Assumes that FILENAME contains }, because HOST was identified in it. If FILENAME is a stream, expand its full name")
|
||||
|
||||
[IF (TYPE? STREAM FILENAME)
|
||||
THEN (CL:UNLESS PHDEV
|
||||
(SETQ PHDEV (FETCH (STREAM DEVICE) OF FILENAME)))
|
||||
(SETQ FILENAME (FETCH (STREAM FULLNAME) OF FILENAME))
|
||||
ELSEIF (NOT (TYPE? FDEV PHDEV))
|
||||
THEN (SETQ PHDEV (\GETDEVICEFROMNAME (OR PHDEV (FILENAMEFIELD FILENAME 'HOST]
|
||||
(IF (TYPE? PHDEVICE PHDEV)
|
||||
THEN (LET (SUFFIX SUFFIXPOS)
|
||||
(CL:WHEN (SETQ SUFFIXPOS (STRPOS "}" FILENAME))
|
||||
(SETQ SUFFIX (SUBSTRING FILENAME (ADD1 SUFFIXPOS)))
|
||||
(CL:WHEN (FMEMB (CHCON1 SUFFIX)
|
||||
(CHARCODE (< > /)))
|
||||
(SETQ SUFFIX (SUBSTRING SUFFIX 2)))
|
||||
(CONCAT (FETCH (PHDEVICE PREFIX) OF PHDEV)
|
||||
SUFFIX)))
|
||||
ELSE FILENAME])
|
||||
|
||||
(CONTRACT.PH
|
||||
[LAMBDA (NAME PHDEV)
|
||||
|
||||
(* ;; "Edited 30-Jan-2022 00:20 by rmk: the smallest pseudoname for NAME. If the NAME was constructed by expanding, then")
|
||||
|
||||
(* ;; "Finds the smallest pseudoname for NAME. The PHDEV is used only to find its targetdev, that's where we scan for matching prefixes. This is so we can find the lowest matching pseudohost in the target's prefix map. If the hosts are defined as {DSK}...{H1}...{H2}, DSK knows the prefixes that lead to H1 and H2, picks the longest matching prefix and replaces it by the corresponding host.")
|
||||
|
||||
(* ;; "If pseudohosts are defined in terms of other pseudohosts (e.g. FUM is defined in terms of FOO which is defined in terms of LI which is rooted in DSK, then the pseudodevices presumably were created in that order, so the first name we encounter will be the one with the longest prefix. So {DSK}... might collapse to {FUM}. But {FOO}... will not. ")
|
||||
|
||||
(CL:UNLESS (TYPE? FDEV PHDEV)
|
||||
(SETQ PHDEV (\GETDEVICEFROMNAME PHDEV)))
|
||||
(CL:WHEN NAME
|
||||
(FOR PM PREFIX SUFFIX CONNECTOR IN (FETCH (TARGETDEVICE PREFIXMAP) OF (FETCH (PHDEVICE
|
||||
TARGETDEV
|
||||
)
|
||||
OF PHDEV))
|
||||
WHEN (STRPOS (SETQ PREFIX (CAR PM))
|
||||
NAME 1 NIL T NIL FILEDIRCASEARRAY)
|
||||
DO
|
||||
(* ;; "This is the lowest host. ")
|
||||
|
||||
[SETQ SUFFIX (SUBSTRING NAME (ADD1 (NCHARS PREFIX]
|
||||
(CL:WHEN (STRPOS ">" SUFFIX 1 NIL NIL NIL FILEDIRCASEARRAY)
|
||||
|
||||
(* ;; "CONNECTOR tells us whether to use / or > depending on what the prefix has")
|
||||
|
||||
(SETQ CONNECTOR (CADDR PM))
|
||||
[SETQ SUFFIX (CONCAT CONNECTOR (IF (EQ CONNECTOR '/)
|
||||
THEN (SLASHIT SUFFIX)
|
||||
ELSE (UNSLASHIT SUFFIX])
|
||||
(RETURN (PACK* '{ (CADR PM)
|
||||
"}"
|
||||
(OR SUFFIX ""))) FINALLY
|
||||
|
||||
(* ;; "If we didn't match a prefix, then this was not related to any pseudhost descending from the target, it is a pure target name, presumably because something like a relative .. reference took it off all paths. We return the original name.")
|
||||
|
||||
(RETURN NAME)))])
|
||||
|
||||
(SLASHIT
|
||||
[LAMBDA (X LCASEDIRS) (* ; "Edited 26-Jan-2022 15:08 by rmk")
|
||||
(* ; "Edited 3-Jan-2022 11:44 by rmk")
|
||||
(* ; "Edited 22-Dec-2021 20:18 by rmk")
|
||||
(* ; "Edited 2-Nov-2021 22:54 by rmk:")
|
||||
(LET [LASTDIRPOS SLASHED (DIRPOS (ADD1 (OR (STRPOS "}" X)
|
||||
0]
|
||||
[SETQ SLASHED (CONCATCODES (FOR I C FROM DIRPOS WHILE (SETQ C (NTHCHARCODE X I))
|
||||
COLLECT (SELCHARQ C
|
||||
((< >)
|
||||
(SETQ LASTDIRPOS I)
|
||||
(CHARCODE /))
|
||||
(/ (SETQ LASTDIRPOS I)
|
||||
C)
|
||||
C]
|
||||
(CL:WHEN (AND LCASEDIRS LASTDIRPOS)
|
||||
(SETQ LASTDIRPOS (ADD1 (IDIFFERENCE LASTDIRPOS DIRPOS)))
|
||||
(SETQ SLASHED (CONCAT (L-CASE (SUBSTRING SLASHED 1 LASTDIRPOS))
|
||||
(OR (SUBSTRING SLASHED (ADD1 LASTDIRPOS))
|
||||
""))))
|
||||
(CL:IF (EQ DIRPOS 1)
|
||||
SLASHED
|
||||
(CONCAT (SUBSTRING X 1 (SUB1 DIRPOS))
|
||||
SLASHED))])
|
||||
|
||||
(UNSLASHIT
|
||||
[LAMBDA (X LCASEDIRS) (* ; "Edited 26-Jan-2022 15:09 by rmk")
|
||||
(* ; "Edited 22-Dec-2021 20:18 by rmk")
|
||||
(* ; "Edited 21-Nov-2021 23:00 by rmk:")
|
||||
|
||||
(* ;; "Tricky to get the first one right.")
|
||||
|
||||
(LET [LASTDIRPOS UNSLASHED (DIRPOS (ADD1 (OR (STRPOS "}" X)
|
||||
0]
|
||||
[SETQ UNSLASHED
|
||||
(CONCATCODES (FOR I C LASTC FROM DIRPOS WHILE (SETQ C (NTHCHARCODE X I))
|
||||
COLLECT (PROG1 (SELCHARQ C
|
||||
(/ (SETQ LASTDIRPOS I)
|
||||
(IF (AND LASTC (NEQ LASTC (CHARCODE })))
|
||||
THEN (CHARCODE >)
|
||||
ELSE (CHARCODE <)))
|
||||
((< >)
|
||||
(SETQ LASTDIRPOS I)
|
||||
C)
|
||||
C)
|
||||
(SETQ LASTC C]
|
||||
(CL:WHEN (AND LCASEDIRS LASTDIRPOS)
|
||||
(SETQ LASTDIRPOS (ADD1 (IDIFFERENCE LASTDIRPOS DIRPOS)))
|
||||
(SETQ UNSLASHED (CONCAT (L-CASE (SUBSTRING UNSLASHED 1 LASTDIRPOS))
|
||||
(OR (SUBSTRING UNSLASHED (ADD1 LASTDIRPOS))
|
||||
""))))
|
||||
(CL:IF (EQ DIRPOS 1)
|
||||
UNSLASHED
|
||||
(CONCAT (SUBSTRING X 1 (SUB1 DIRPOS))
|
||||
UNSLASHED))])
|
||||
)
|
||||
(DEFINEQ
|
||||
|
||||
(OPENFILE.PH
|
||||
[LAMBDA (FILE ACCESS RECOG OTHERINFO FDEV OLDSTRING) (* ; "Edited 25-Jan-2022 08:45 by rmk")
|
||||
(* ; "Edited 18-Jan-2022 10:29 by rmk")
|
||||
(LET ((STREAM (PSEUDOHOST.TARGETVAL OPENFILE (FILE ACCESS RECOG OTHERINFO FDEV OLDSTRING)
|
||||
FDEV)))
|
||||
(CHANGE (FETCH (STREAM FULLFILENAME) OF STREAM)
|
||||
(CONTRACT.PH DATUM FDEV))
|
||||
(REPLACE (STREAM DEVICE) OF STREAM WITH FDEV)
|
||||
STREAM])
|
||||
|
||||
(GETFILENAME.PH
|
||||
[LAMBDA (NAME RECOG FDEV) (* ; "Edited 25-Jan-2022 22:56 by rmk")
|
||||
(* ; "Edited 16-Jan-2022 20:27 by rmk")
|
||||
(PSEUDOHOST.NAME GETFILENAME (NAME RECOG FDEV])
|
||||
|
||||
(DIRECTORYNAMEP.PH
|
||||
[LAMBDA (DIRSPEC DEV CREATE?) (* ; "Edited 25-Jan-2022 22:56 by rmk")
|
||||
(* ; "Edited 18-Jan-2022 11:32 by rmk")
|
||||
|
||||
(* ;; "{FOO} by itself is always a legitimate directory--you should be able to connect to it when you are starting up")
|
||||
(* ; "Edited 16-Jan-2022 20:35 by rmk")
|
||||
(OR (EQ (CHARCODE })
|
||||
(NTHCHARCODE DIRSPEC -1))
|
||||
(PSEUDOHOST.NAME DIRECTORYNAMEP (DIRSPEC DEV CREATE?)
|
||||
DEV])
|
||||
|
||||
(CLOSEFILE.PH
|
||||
[LAMBDA (STREAM ABORTFLG) (* ; "Edited 16-Jan-2022 15:38 by rmk")
|
||||
(APPLY* (FETCH (FDEV CLOSEFILE) OF (FETCH (PHDEVICE TARGETDEV) OF (FETCH (STREAM DEVICE)
|
||||
OF STREAM)))
|
||||
STREAM ABORTFLG])
|
||||
|
||||
(REOPENFILE.PH
|
||||
[LAMBDA (FILE ACCESS RECOG OTHERINFO FDEV OLDSTREAM) (* ; "Edited 25-Jan-2022 12:50 by rmk")
|
||||
(* ; "Edited 18-Jan-2022 11:41 by rmk")
|
||||
(LET ((STREAM (PSEUDOHOST.TARGETVAL REOPENFILE (FILE ACCESS RECOG OTHERINFO FDEV OLDSTREAM)
|
||||
FDEV)))
|
||||
(CHANGE (FETCH (STREAM FULLFILENAME) OF STREAM)
|
||||
(CONTRACT.PH DATUM FDEV))
|
||||
(REPLACE (STREAM DEVICE) OF STREAM WITH FDEV)
|
||||
STREAM])
|
||||
|
||||
(DELETEFILE.PH
|
||||
[LAMBDA (FILENAME DEV) (* ; "Edited 25-Jan-2022 22:56 by rmk")
|
||||
(* ; "Edited 18-Jan-2022 10:23 by rmk")
|
||||
(PSEUDOHOST.NAME DELETEFILE (FILENAME DEV])
|
||||
|
||||
(OPENP.PH
|
||||
[LAMBDA (FILENAME ACCESS DEVICE) (* ; "Edited 18-Jan-2022 10:29 by rmk")
|
||||
(PSEUDOHOST.TARGETVAL OPENP (FILENAME ACCESS DEVICE])
|
||||
|
||||
(UNREGISTERFILE.PH
|
||||
[LAMBDA (DEVICE STREAM) (* ; "Edited 16-Jan-2022 16:47 by rmk")
|
||||
(APPLY* (FETCH (FDEV UNREGISTERFILE) OF (FETCH (PHDEVICE TARGETDEV) OF DEVICE))
|
||||
(FETCH (PHDEVICE TARGETDEV) OF DEVICE)
|
||||
STREAM])
|
||||
|
||||
(REGISTERFILE.PH
|
||||
[LAMBDA (DEVICE STREAM) (* ; "Edited 16-Jan-2022 16:46 by rmk")
|
||||
(APPLY* (FETCH (FDEV REGISTERFILE) OF (FETCH (PHDEVICE TARGETDEV) OF DEVICE))
|
||||
(FETCH (PHDEVICE TARGETDEV) OF DEVICE)
|
||||
STREAM])
|
||||
|
||||
(GENERATEFILES.PH
|
||||
[LAMBDA (FDEV PATTERN DESIREDPROPS OPTIONS) (* ; "Edited 17-Jan-2022 20:46 by rmk")
|
||||
|
||||
(* ;; "FDEV is the pseudohost. We will generate from the target directory using its GENFILESTATE, but fiddle the output so that it looks like it is coming from the pseudo host.")
|
||||
|
||||
(LET ((TARGETGENOBJ (APPLY* (FETCH (FDEV GENERATEFILES) OF (FETCH (PHDEVICE TARGETDEV)
|
||||
OF FDEV))
|
||||
(FETCH (PHDEVICE TARGETDEV) OF FDEV)
|
||||
(EXPAND.PH PATTERN FDEV)
|
||||
DESIREDPROPS OPTIONS)))
|
||||
|
||||
(* ;; "The TARGETGENOBJ contains the targets functions as well as its GENFILESTATE. We need the ph FDEV to contract the generated names")
|
||||
|
||||
(CREATE FILEGENOBJ
|
||||
NEXTFILEFN _ (FUNCTION NEXTFILEFN.PH)
|
||||
FILEINFOFN _ (FUNCTION FILEINFOFN.PH)
|
||||
GENFILESTATE _ (LIST FDEV TARGETGENOBJ])
|
||||
|
||||
(GETFILEINFO.PH
|
||||
[LAMBDA (STREAM ATTRIBUTE DEVICE) (* ; "Edited 25-Jan-2022 12:43 by rmk")
|
||||
(* ; "Edited 17-Jan-2022 18:21 by rmk")
|
||||
(PSEUDOHOST.TARGETVAL GETFILEINFO (STREAM ATTRIBUTE DEVICE])
|
||||
|
||||
(SETFILEINFO.PH
|
||||
[LAMBDA (STREAM ATTRIBUTE VALUE DEVICE) (* ; "Edited 25-Jan-2022 12:37 by rmk")
|
||||
(PSEUDOHOST.TARGETVAL SETFILEINFO (STREAM ATTRIBUTE VALUE DEVICE])
|
||||
|
||||
(NEXTFILEFN.PH
|
||||
[LAMBDA (GENFILESTATE NAMEONLY) (* ; "Edited 17-Jan-2022 21:27 by rmk")
|
||||
(LET* ((TARGETGENOBJ (CADR GENFILESTATE))
|
||||
(TARGETGENFILESTATE (FETCH GENFILESTATE OF TARGETGENOBJ))
|
||||
(FILENAME (APPLY* (FETCH NEXTFILEFN OF TARGETGENOBJ)
|
||||
TARGETGENFILESTATE NAMEONLY)))
|
||||
(CL:WHEN FILENAME
|
||||
(CL:UNLESS NAMEONLY
|
||||
(SETQ FILENAME (CONTRACT.PH FILENAME (CAR GENFILESTATE)))))
|
||||
FILENAME])
|
||||
|
||||
(FILEINFOFN.PH
|
||||
[LAMBDA (GENFILESTATE ATTRIBUTE) (* ; "Edited 17-Jan-2022 20:52 by rmk")
|
||||
(APPLY* (FETCH FILEINFOFN OF (CADR GENFILESTATE))
|
||||
(FETCH GENFILESTATE OF (CADR GENFILESTATE))
|
||||
ATTRIBUTE])
|
||||
|
||||
(RENAMEFILE.PH
|
||||
[LAMBDA (OLD-DEVICE OLD-NAME NEW-DEVICE NEW-NAME) (* ; "Edited 18-Jan-2022 09:52 by rmk")
|
||||
(LET ((OLDTARGETDEV (FETCH (PHDEVICE TARGETDEV) OF OLD-DEVICE))
|
||||
(NEWTARGETDEV (FETCH (PHDEVICE TARGETDEV) OF NEW-DEVICE))
|
||||
(NEWTARGETNAME NEW-NAME)
|
||||
RESULT)
|
||||
(CL:WHEN (TYPE? FDEV NEWTARGETDEV) (* ; "NEW-DEVICE is a pseudo host")
|
||||
(SETQ NEWTARGETNAME (EXPAND.PH NEW-NAME NEW-DEVICE)))
|
||||
(SETQ RESULT (APPLY* (FETCH (FDEV RENAMEFILE) OF OLDTARGETDEV)
|
||||
OLDTARGETDEV
|
||||
(EXPAND.PH OLD-NAME OLD-DEVICE)
|
||||
(OR NEWTARGETDEV NEW-DEVICE)
|
||||
NEWTARGETNAME))
|
||||
(CL:WHEN (AND RESULT (NEQ NEWTARGETDEV NEW-DEVICE))
|
||||
(SETQ RESULT (CONTRACT.PH RESULT NEW-DEVICE)))
|
||||
RESULT])
|
||||
)
|
||||
|
||||
(PSEUDOHOST 'LI LOGINHOST/DIR)
|
||||
(DECLARE%: EVAL@COMPILE DONTCOPY
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(ACCESSFNS PHDEVICE ((PREFIX (FETCH (FDEV FDEV2) OF DATUM))
|
||||
(TARGETDEV (FETCH (FDEV FDEV1) OF DATUM)
|
||||
(REPLACE (FDEV FDEV1) OF DATUM WITH NEWVALUE)))
|
||||
(TYPE? (FETCH (PHDEVICE PREFIX) OF DATUM)))
|
||||
|
||||
(RECORD PHGENFILESTATE (PHDEVICE . TARGETGENFILESTATE))
|
||||
|
||||
(ACCESSFNS TARGETDEVICE ((PREFIXMAP (FETCH (FDEV FDEV3) OF DATUM)
|
||||
(REPLACE (FDEV FDEV3) OF DATUM WITH NEWVALUE))))
|
||||
)
|
||||
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(PUTPROPS PSEUDOHOST.NAME MACRO
|
||||
[TAIL (LET [(OPNAME (CAR TAIL))
|
||||
(ARGS (CADR TAIL))
|
||||
(DEV (OR (CADDR TAIL)
|
||||
(CAR (LAST (CADR TAIL]
|
||||
|
||||
(* ;;
|
||||
"Assumes that the name is (CAR ARGS), the device is the last or args if not specified separately")
|
||||
|
||||
`(CONTRACT.PH [APPLY* (FETCH (FDEV ,OPNAME) OF (FETCH (PHDEVICE TARGETDEV)
|
||||
OF ,DEV))
|
||||
(EXPAND.PH ,(CAR ARGS)
|
||||
,DEV)
|
||||
,@(SUBST `(FETCH (PHDEVICE TARGETDEV) OF ,DEV)
|
||||
DEV
|
||||
(CDR ARGS]
|
||||
,DEV])
|
||||
|
||||
(PUTPROPS PSEUDOHOST.TARGETVAL MACRO
|
||||
[TAIL (LET [(OPNAME (CAR TAIL))
|
||||
(ARGS (CADR TAIL))
|
||||
(DEV (OR (CADDR TAIL)
|
||||
(CAR (LAST (CADR TAIL]
|
||||
|
||||
(* ;; "Assumes that the name is (CAR ARGS), the device is the last or args if not specified separately. Unlike PSEUDOHOST.OP, this returns the target value, doesn't assume it is a name to be contracted.")
|
||||
|
||||
`(APPLY* (FETCH (FDEV ,OPNAME) OF (FETCH (PHDEVICE TARGETDEV)
|
||||
OF ,DEV))
|
||||
(EXPAND.PH ,(CAR ARGS)
|
||||
,DEV)
|
||||
,@(SUBST `(FETCH (PHDEVICE TARGETDEV) OF ,DEV)
|
||||
DEV
|
||||
(CDR ARGS])
|
||||
)
|
||||
|
||||
|
||||
(CL:UNLESS (GETP 'EXPORTS.ALL 'FILE)
|
||||
(LOAD 'EXPORTS.ALL))
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (1355 8925 (PSEUDOHOST 1365 . 6625) (PSEUDOHOSTP 6627 . 6977) (PSEUDOHOSTS 6979 . 7336)
|
||||
(TARGETHOST 7338 . 7612) (TRUEFILENAME 7614 . 8301) (PSEUDOFILENAME 8303 . 8923)) (8953 16177 (
|
||||
EXPAND.PH 8963 . 10190) (CONTRACT.PH 10192 . 12857) (SLASHIT 12859 . 14427) (UNSLASHIT 14429 . 16175))
|
||||
(16178 22968 (OPENFILE.PH 16188 . 16749) (GETFILENAME.PH 16751 . 17040) (DIRECTORYNAMEP.PH 17042 .
|
||||
17666) (CLOSEFILE.PH 17668 . 18022) (REOPENFILE.PH 18024 . 18589) (DELETEFILE.PH 18591 . 18875) (
|
||||
OPENP.PH 18877 . 19053) (UNREGISTERFILE.PH 19055 . 19360) (REGISTERFILE.PH 19362 . 19663) (
|
||||
GENERATEFILES.PH 19665 . 20705) (GETFILEINFO.PH 20707 . 21009) (SETFILEINFO.PH 21011 . 21210) (
|
||||
NEXTFILEFN.PH 21212 . 21754) (FILEINFOFN.PH 21756 . 22027) (RENAMEFILE.PH 22029 . 22966)))))
|
||||
STOP
|
||||
BIN
lispusers/PSEUDOHOSTS.LCOM
Normal file
BIN
lispusers/PSEUDOHOSTS.LCOM
Normal file
Binary file not shown.
BIN
lispusers/PSEUDOHOSTS.TEDIT
Normal file
BIN
lispusers/PSEUDOHOSTS.TEDIT
Normal file
Binary file not shown.
@@ -1,12 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED " 2-Jan-2022 16:01:26"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>REGIONMANAGER.;99 31663
|
||||
(FILECREATED "28-Jan-2022 23:52:21"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>REGIONMANAGER.;113 36064
|
||||
|
||||
:CHANGES-TO (FNS SET-TYPED-REGIONS \RELCREATEREGION.REF \RELCREATEREGION.SIZE)
|
||||
:CHANGES-TO (FNS CLOSEWITH MOVEWITH MOVEWITH.DOIT CLOSEWITH.DOIT)
|
||||
|
||||
:PREVIOUS-DATE " 1-Jan-2022 23:14:42"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>REGIONMANAGER.;95)
|
||||
:PREVIOUS-DATE "28-Jan-2022 16:55:38"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>REGIONMANAGER.;108)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT REGIONMANAGERCOMS)
|
||||
@@ -30,12 +30,13 @@
|
||||
|
||||
(* ;; "Relative regions")
|
||||
|
||||
(COMS (FNS RELCREATEREGION RELGETREGION)
|
||||
(COMS (FNS RELCREATEREGION RELGETREGION RELCREATEPOSITION)
|
||||
(FNS \RELCREATEREGION.REF \RELCREATEREGION.SIZE))
|
||||
|
||||
(* ;; "Composite application construction")
|
||||
|
||||
(COMS (FNS RM-ATTACHWINDOW)
|
||||
(FNS CLOSEWITH CLOSEWITH.DOIT MOVEWITH MOVEWITH.DOIT)
|
||||
(P (MOVD? 'ATTACHWINDOW 'ATTACHWINDOW.ORIG)
|
||||
(MOVD 'RM-ATTACHWINDOW 'ATTACHWINDOW))
|
||||
(DECLARE%: EVAL@COMPILE DONTCOPY (MACROS RFIELDDIFF])
|
||||
@@ -250,7 +251,11 @@
|
||||
(DEFINEQ
|
||||
|
||||
(RELCREATEREGION
|
||||
[LAMBDA (WIDTH HEIGHT CORNERX CORNERY REFX REFY ONSCREEN) (* ; "Edited 30-Dec-2021 20:54 by rmk")
|
||||
[LAMBDA (WIDTH HEIGHT CORNERX CORNERY REFX REFY ONSCREEN) (* ; "Edited 27-Jan-2022 13:23 by rmk")
|
||||
(* ; "Edited 25-Jan-2022 15:29 by rmk")
|
||||
(* ; "Edited 23-Jan-2022 21:18 by rmk")
|
||||
(* ; "Edited 12-Jan-2022 17:50 by rmk")
|
||||
(* ; "Edited 30-Dec-2021 20:54 by rmk")
|
||||
(* ; "Edited 27-Dec-2021 15:54 by rmk")
|
||||
|
||||
(* ;; "The region is oriented so that he REFX and REFY are at the corner named by CORNERX/Y. ")
|
||||
@@ -274,99 +279,129 @@
|
||||
|
||||
(* ;; "")
|
||||
|
||||
(* ;; "Resolve the width and height, if based on a region or window ")
|
||||
(* ;; "The arguments can be given as a list to be spread out, so that region relative region specifications can be passed through intermediate functions. The test here is not very tight, if it is incorrect the recursive call will fail.")
|
||||
|
||||
(SETQ WIDTH (\RELCREATEREGION.SIZE WIDTH 'X))
|
||||
(SETQ HEIGHT (\RELCREATEREGION.SIZE HEIGHT 'Y))
|
||||
(IF (AND (LISTP WIDTH)
|
||||
(NOT (REGIONP WIDTH))
|
||||
(NULL HEIGHT)
|
||||
(IGREATERP (LENGTH WIDTH)
|
||||
3))
|
||||
THEN
|
||||
(* ;; "If less than 3, presumably a relative width")
|
||||
|
||||
(* ;; "Resolve the corner")
|
||||
(APPLY (FUNCTION RELCREATEREGION)
|
||||
WIDTH)
|
||||
ELSE
|
||||
(* ;; "Resolve the width and height, if based on a region or window ")
|
||||
|
||||
(CL:UNLESS CORNERX
|
||||
(SETQ CORNERX 'LEFT))
|
||||
(CL:UNLESS CORNERY
|
||||
(SETQ CORNERY 'BOTTOM))
|
||||
(CL:WHEN (AND (LISTP CORNERX)
|
||||
(NULL CORNERY))
|
||||
(SETQ CORNERY (CADR CORNERX))
|
||||
(SETQ CORNERX (CAR CORNERX)))
|
||||
(SETQ WIDTH (\RELCREATEREGION.SIZE WIDTH 'X))
|
||||
(SETQ HEIGHT (\RELCREATEREGION.SIZE HEIGHT 'Y))
|
||||
|
||||
(* ;; "Resolve the reference point")
|
||||
(* ;; "Resolve the corner")
|
||||
|
||||
[IF (AND (POSITIONP REFX)
|
||||
(NULL REFY))
|
||||
THEN (SETQ REFY (FETCH (POSITION YCOORD) OF REFX))
|
||||
(SETQ REFX (FETCH (POSITION XCOORD) OF REFX))
|
||||
ELSE (GETMOUSESTATE)
|
||||
(SETQ REFX (\RELCREATEREGION.REF REFX 'X))
|
||||
(SETQ REFY (\RELCREATEREGION.REF REFY 'Y]
|
||||
(CL:UNLESS CORNERX
|
||||
(SETQ CORNERX 'LEFT))
|
||||
(CL:UNLESS CORNERY
|
||||
(SETQ CORNERY 'BOTTOM))
|
||||
(CL:WHEN (AND (LISTP CORNERX)
|
||||
(NULL CORNERY))
|
||||
(SETQ CORNERY (CADR CORNERX))
|
||||
(SETQ CORNERX (CAR CORNERX)))
|
||||
|
||||
(* ;; "Align the new-region corner with the reference point")
|
||||
(* ;; "Resolve the reference point")
|
||||
|
||||
(LET* ((LEFT REFX)
|
||||
(BOTTOM REFY)
|
||||
(RIGHT (IPLUS LEFT WIDTH))
|
||||
(TOP (IPLUS BOTTOM HEIGHT)))
|
||||
(CL:WHEN (EQ 'RIGHT CORNERX)
|
||||
(SETQ RIGHT LEFT)
|
||||
(SETQ LEFT (IDIFFERENCE LEFT WIDTH)))
|
||||
(CL:WHEN (EQ 'TOP CORNERY)
|
||||
(SETQ TOP BOTTOM)
|
||||
(SETQ BOTTOM (IDIFFERENCE BOTTOM HEIGHT)))
|
||||
(CL:WHEN ONSCREEN (* ; "Keep the region on the screen. ")
|
||||
(CL:WHEN (ILESSP LEFT 0)
|
||||
(ADD WIDTH LEFT)
|
||||
(SETQ LEFT 0))
|
||||
(CL:WHEN (ILESSP BOTTOM 0)
|
||||
(ADD HEIGHT BOTTOM)
|
||||
(SETQ BOTTOM 0))
|
||||
(CL:WHEN (IGREATERP RIGHT SCREENWIDTH)
|
||||
(ADD WIDTH (IDIFFERENCE SCREENWIDTH RIGHT)))
|
||||
(CL:WHEN (IGREATERP TOP SCREENHEIGHT)
|
||||
(ADD HEIGHT (IDIFFERENCE SCREENHEIGHT TOP))))
|
||||
(CREATEREGION LEFT BOTTOM WIDTH HEIGHT])
|
||||
[IF (AND (POSITIONP REFX)
|
||||
(NULL REFY))
|
||||
THEN (SETQ REFY (FETCH (POSITION YCOORD) OF REFX))
|
||||
(SETQ REFX (FETCH (POSITION XCOORD) OF REFX))
|
||||
ELSE (GETMOUSESTATE)
|
||||
(SETQ REFX (\RELCREATEREGION.REF REFX 'X))
|
||||
(SETQ REFY (\RELCREATEREGION.REF REFY 'Y]
|
||||
|
||||
(* ;; "Align the new-region corner with the reference point")
|
||||
|
||||
(LET* ((LEFT REFX)
|
||||
(BOTTOM REFY)
|
||||
(RIGHT (IPLUS LEFT WIDTH))
|
||||
(TOP (IPLUS BOTTOM HEIGHT)))
|
||||
(CL:WHEN (EQ 'RIGHT CORNERX)
|
||||
(SETQ RIGHT LEFT)
|
||||
(SETQ LEFT (IDIFFERENCE LEFT WIDTH)))
|
||||
(CL:WHEN (EQ 'TOP CORNERY)
|
||||
(SETQ TOP BOTTOM)
|
||||
(SETQ BOTTOM (IDIFFERENCE BOTTOM HEIGHT)))
|
||||
(CL:WHEN ONSCREEN (* ; "Keep the region on the screen. Not clear whether we should keep the width and height and just move the left and bottom. Here we allow some shrinkage")
|
||||
(CL:WHEN (ILESSP LEFT 0)
|
||||
(ADD WIDTH (IMIN 100 LEFT))
|
||||
(SETQ LEFT 0))
|
||||
(CL:WHEN (ILESSP BOTTOM 0)
|
||||
(ADD HEIGHT (IMIN 100 BOTTOM))
|
||||
(SETQ BOTTOM 0))
|
||||
(CL:WHEN (IGREATERP RIGHT SCREENWIDTH)
|
||||
(ADD WIDTH (IDIFFERENCE SCREENWIDTH RIGHT)))
|
||||
(CL:WHEN (IGREATERP TOP SCREENHEIGHT)
|
||||
(ADD HEIGHT (IDIFFERENCE SCREENHEIGHT TOP))))
|
||||
(CREATEREGION LEFT BOTTOM WIDTH HEIGHT])
|
||||
|
||||
(RELGETREGION
|
||||
[LAMBDA (WIDTH HEIGHT CORNERX CORNERY REFX REFY MINSIZE) (* ; "Edited 28-Dec-2021 23:13 by rmk")
|
||||
[LAMBDA (WIDTH HEIGHT CORNERX CORNERY REFX REFY MINSIZE) (* ; "Edited 27-Jan-2022 13:24 by rmk")
|
||||
(* ; "Edited 25-Jan-2022 15:30 by rmk")
|
||||
(* ; "Edited 23-Jan-2022 21:20 by rmk")
|
||||
(* ; "Edited 28-Dec-2021 23:13 by rmk")
|
||||
(* ; "Edited 10-Dec-2021 10:15 by rmk")
|
||||
|
||||
(* ;; "Prompts for a relative region as created by RELCREATEREGION. Initially the anchored corner is fixed and the cursor is moved to the diagonally opposite corner. If MINSIZE, the WIDTH and HEIGHT are taken to be the minimums that are acceptable, modulo the fact that the opposite corner is guaranteed to be visibleand, the size of the ghost region can only grow. If not MINSIZE, we also allow the user to shrink the ghost region.")
|
||||
|
||||
(CL:WHEN (AND (LISTP CORNERX)
|
||||
(NULL CORNERY))
|
||||
(SETQ CORNERY (CADR CORNERX))
|
||||
(SETQ CORNERX (CAR CORNERX)))
|
||||
(CL:UNLESS CORNERX
|
||||
(SETQ CORNERX 'LEFT))
|
||||
(CL:UNLESS CORNERY
|
||||
(SETQ CORNERY 'BOTTOM))
|
||||
(LET* ((REGION (OR (REGIONP WIDTH)
|
||||
(RELCREATEREGION WIDTH HEIGHT CORNERX CORNERY REFX REFY T)))
|
||||
(BASEX (FETCH (REGION LEFT) OF REGION))
|
||||
(BASEY (FETCH (REGION BOTTOM) OF REGION))
|
||||
(RWIDTH (FETCH (REGION WIDTH) OF REGION))
|
||||
(RHEIGHT (FETCH (REGION HEIGHT) OF REGION))
|
||||
(OPPX (IPLUS BASEX RWIDTH))
|
||||
(OPPY (IPLUS BASEY RHEIGHT)))
|
||||
(COND
|
||||
((AND (LISTP WIDTH)
|
||||
(NOT (REGIONP WIDTH))
|
||||
(NULL HEIGHT)
|
||||
(IGREATERP (LENGTH WIDTH)
|
||||
3))
|
||||
(APPLY (FUNCTION RELGETREGION)
|
||||
WIDTH))
|
||||
(T (CL:WHEN (AND (LISTP CORNERX)
|
||||
(NULL CORNERY))
|
||||
(SETQ CORNERY (CADR CORNERX))
|
||||
(SETQ CORNERX (CAR CORNERX)))
|
||||
(CL:UNLESS CORNERX
|
||||
(SETQ CORNERX 'LEFT))
|
||||
(CL:UNLESS CORNERY
|
||||
(SETQ CORNERY 'BOTTOM))
|
||||
(LET* ((REGION (OR (REGIONP WIDTH)
|
||||
(RELCREATEREGION WIDTH HEIGHT CORNERX CORNERY REFX REFY T)))
|
||||
(BASEX (FETCH (REGION LEFT) OF REGION))
|
||||
(BASEY (FETCH (REGION BOTTOM) OF REGION))
|
||||
(RWIDTH (FETCH (REGION WIDTH) OF REGION))
|
||||
(RHEIGHT (FETCH (REGION HEIGHT) OF REGION))
|
||||
(OPPX (IPLUS BASEX RWIDTH))
|
||||
(OPPY (IPLUS BASEY RHEIGHT)))
|
||||
|
||||
(* ;; "Default parameters assume the anchor is (LEFT BOTTOM)")
|
||||
(* ;; "Default parameters assume the anchor is (LEFT BOTTOM)")
|
||||
|
||||
(CL:WHEN (EQ 'RIGHT CORNERX)
|
||||
(SWAP BASEX OPPX))
|
||||
(CL:WHEN (EQ 'TOP CORNERY)
|
||||
(SWAP BASEY OPPY))
|
||||
(\CURSORPOSITION OPPX OPPY)
|
||||
(CL:UNLESS MINSIZE (* ; "No minimum size constraint")
|
||||
(SETQ RWIDTH NIL)
|
||||
(SETQ RHEIGHT NIL))
|
||||
(GETREGION RWIDTH RHEIGHT REGION NIL NIL (LIST BASEX BASEY OPPX OPPY])
|
||||
(CL:WHEN (EQ 'RIGHT CORNERX)
|
||||
(SWAP BASEX OPPX))
|
||||
(CL:WHEN (EQ 'TOP CORNERY)
|
||||
(SWAP BASEY OPPY))
|
||||
(\CURSORPOSITION OPPX OPPY)
|
||||
(CL:UNLESS MINSIZE (* ; "No minimum size constraint")
|
||||
(SETQ RWIDTH NIL)
|
||||
(SETQ RHEIGHT NIL))
|
||||
(GETREGION RWIDTH RHEIGHT REGION NIL NIL (LIST BASEX BASEY OPPX OPPY])
|
||||
|
||||
(RELCREATEPOSITION
|
||||
[LAMBDA (REFX REFY) (* ; "Edited 23-Jan-2022 17:08 by rmk")
|
||||
(CREATEPOSITION (\RELCREATEREGION.REF REFX 'X)
|
||||
(\RELCREATEREGION.REF REFY 'Y])
|
||||
)
|
||||
(DEFINEQ
|
||||
|
||||
(\RELCREATEREGION.REF
|
||||
[LAMBDA (REF WHICH) (* ; "Edited 2-Jan-2022 11:01 by rmk")
|
||||
[LAMBDA (REF WHICH) (* ; "Edited 23-Jan-2022 20:20 by rmk")
|
||||
(* ; "Edited 2-Jan-2022 11:01 by rmk")
|
||||
|
||||
(* ;; "REF can be NIL, an absolute screen position, the atom SCREEN, or a list of (anchor fraction adjustment) where anchor can be a region, window, or the atom SCREEN, fraction can be a number or atoms LEFT/RIGHT/BOTTOM/TOP as apropriate.")
|
||||
(* ; "Edited 30-Dec-2021 17:49 by rmk")
|
||||
(* ; "Edited 30-Dec-2021 17:49 by rmk")
|
||||
(LET (ANCHOR VAL SIZE FRACTION SPEC (BASE 0))
|
||||
|
||||
(* ;; "Would be nice if the screen had a region")
|
||||
@@ -386,7 +421,8 @@
|
||||
ELSEIF [AND (LISTP REF)
|
||||
(SETQ ANCHOR (OR (REGIONP (CAR REF))
|
||||
(AND (WINDOWP (CAR REF))
|
||||
(WINDOWREGION (CAR REF)))
|
||||
(WINDOWPROP (CAR REF)
|
||||
'REGION))
|
||||
(AND (EQ (CAR REF)
|
||||
'SCREEN)
|
||||
'SCREEN]
|
||||
@@ -417,7 +453,7 @@
|
||||
ELSE (\ILLEGAL.ARG REF])
|
||||
|
||||
(\RELCREATEREGION.SIZE
|
||||
[LAMBDA (PARAM WHICH) (* ; "Edited 2-Jan-2022 11:00 by rmk")
|
||||
[LAMBDA (PARAM WHICH) (* ; "Edited 2-Jan-2022 11:00 by rmk")
|
||||
(* ; "Edited 30-Dec-2021 17:51 by rmk")
|
||||
|
||||
(* ;;
|
||||
@@ -578,6 +614,39 @@
|
||||
(WINDOWPROP WINDOWTOATTACH 'PASSTOMAINCOMS WINDOWCOMACTION))))
|
||||
VAL])
|
||||
)
|
||||
(DEFINEQ
|
||||
|
||||
(CLOSEWITH
|
||||
[LAMBDA (CHILDREN PARENT) (* ; "Edited 28-Jan-2022 23:51 by rmk")
|
||||
[FOR C ONE INSIDE CHILDREN WHEN (AND C (SETQ C (WFROMDS C))) DO (SETQ ONE T)
|
||||
(WINDOWADDPROP PARENT
|
||||
'CLOSECHILDREN C)
|
||||
FINALLY (CL:WHEN ONE
|
||||
(WINDOWADDPROP PARENT 'CLOSEFN (FUNCTION CLOSEWITH.DOIT)))]
|
||||
PARENT])
|
||||
|
||||
(CLOSEWITH.DOIT
|
||||
[LAMBDA (PARENT) (* ; "Edited 28-Jan-2022 17:54 by rmk")
|
||||
(FOR C IN (WINDOWPROP PARENT 'CLOSECHILDREN) WHEN (OPENWP C) DO (CLOSEW C))
|
||||
(WINDOWPROP PARENT 'CLOSECHILDREN NIL)
|
||||
PARENT])
|
||||
|
||||
(MOVEWITH
|
||||
[LAMBDA (CHILDREN PARENT) (* ; "Edited 28-Jan-2022 23:43 by rmk")
|
||||
[FOR C ONE INSIDE CHILDREN WHEN (AND C (SETQ C (WFROMDS C))) DO (SETQ ONE T)
|
||||
(WINDOWADDPROP PARENT
|
||||
'MOVECHILDREN C)
|
||||
FINALLY (CL:WHEN ONE
|
||||
(WINDOWADDPROP PARENT 'MOVEFN (FUNCTION MOVEWITH.DOIT)))]
|
||||
PARENT])
|
||||
|
||||
(MOVEWITH.DOIT
|
||||
[LAMBDA (PARENT NEWPOS) (* ; "Edited 28-Jan-2022 22:34 by rmk")
|
||||
[FOR C (DELTA _ (PTDIFFERENCE NEWPOS (WINDOWPOSITION PARENT))) IN (WINDOWPROP PARENT
|
||||
'MOVECHILDREN)
|
||||
DO (MOVEW C (PTPLUS DELTA (WINDOWPOSITION C]
|
||||
PARENT])
|
||||
)
|
||||
|
||||
(MOVD? 'ATTACHWINDOW 'ATTACHWINDOW.ORIG)
|
||||
|
||||
@@ -591,8 +660,10 @@
|
||||
)
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (1602 3789 (SET-TYPED-REGIONS 1612 . 3787)) (3790 10791 (RM-CREATEW 3800 . 6307) (
|
||||
RM-CLOSEW 6309 . 7710) (RM-GETREGION 7712 . 10298) (CLOSE-TYPED-W 10300 . 10789)) (11707 16778 (
|
||||
RELCREATEREGION 11717 . 14876) (RELGETREGION 14878 . 16776)) (16779 21898 (\RELCREATEREGION.REF 16789
|
||||
. 19646) (\RELCREATEREGION.SIZE 19648 . 21896)) (21951 31293 (RM-ATTACHWINDOW 21961 . 31291)))))
|
||||
(FILEMAP (NIL (1677 3864 (SET-TYPED-REGIONS 1687 . 3862)) (3865 10866 (RM-CREATEW 3875 . 6382) (
|
||||
RM-CLOSEW 6384 . 7785) (RM-GETREGION 7787 . 10373) (CLOSE-TYPED-W 10375 . 10864)) (11782 19261 (
|
||||
RELCREATEREGION 11792 . 16415) (RELGETREGION 16417 . 19024) (RELCREATEPOSITION 19026 . 19259)) (19262
|
||||
24564 (\RELCREATEREGION.REF 19272 . 22304) (\RELCREATEREGION.SIZE 22306 . 24562)) (24617 33959 (
|
||||
RM-ATTACHWINDOW 24627 . 33957)) (33960 35694 (CLOSEWITH 33970 . 34497) (CLOSEWITH.DOIT 34499 . 34779)
|
||||
(MOVEWITH 34781 . 35304) (MOVEWITH.DOIT 35306 . 35692)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -37,23 +37,72 @@ NIL: LASTMOUSEX/LASTMOUSEY
|
||||
(RELCREATEREGION WIDTH HEIGHT CORNERX CORNERY REFX REFY ONSCREEN) [Function]
|
||||
RELCREATEREGION creates a region of dimensions WIDTH and HEIGHT. One of its corners is identified by CORNERX and CORNERY and that corner will be aligned with a reference screen-point determined by REFX and REFY. If ONSCREEN, the WIDTH or HEIGHT will be adjusted with respect to that alignment so that the resulting region is entirely within the screen.
|
||||
WIDTH and HEIGHT can be given as absolute (natural) numbers) or specified relative to the WIDTH and HEIGHT of another region or of the screen. The possibilities are interpreted as follows:
|
||||
natural number: the number of screen points
|
||||
list of the form (anchor fraction adjustment), where anchor is a region, window, or the atom SCREEN. The corres-ponding dimension of the anchor is mutiplied by fraction and adjustment is added to the result. For example, specifying (<window> .5 -1) results in a WIDTH that is one point smaller than half the width of window's region. Fraction and adjustment default to 1 and 0 respectively.
|
||||
region/window/SCREEN: equivalent to (region/window/SCREEN 1 0).
|
||||
CORNERX can be LEFT, RIGHT, or NIL=LEFT, CORNERY can be BOTTOM, TOP, or NIL=BOTTOM. If LEFT/TOP are specified, for example, the region will be splayed down and to the right of the reference point. If RIGHT/BOTTOM, then up and to the left.
|
||||
CORNERX can be LEFT, RIGHT, or NIL=LEFT, CORNERY can be BOTTOM, TOP, or NIL=BOTTOM. If LEFT/TOP are specified, for example, the region will be splayed down and to the right of the reference point. If RIGHT/BOTTOM, then up and to the left.
|
||||
The reference-point arguments REFX and REFY are interpreted as follows:
|
||||
NIL: LASTMOUSEX/LASTMOUSEY
|
||||
natural number: an absolute screen coordinate
|
||||
(anchor fraction adjustment) or just region/window/SCREEN: the quantity determined relative to the size of anchor (as above) is added to the anchors left/bottom produce the REFX/REFY coordinate. In this case, fractions specified as LEFT/BOTTOM/NIL are interpreted as 0 and RIGHT/TOP are interpreted as 1. For example, a specification (<window> .4 -2) for REFY will produce a coordinate 2 points below the level that is 40% of the distance between the bottom and top of the window's region.
|
||||
For convenience, if REFX is a position and REFY is NIL, then the XCOORD and YCOORD of REFX are taken as absolute values for REFX and REFY.
|
||||
Also for convenience, if WIDTH is a potentially a list of RELCREATEREGION arguments, then the elements of that list are spread out in a recursive call.
|
||||
|
||||
(RELGETREGION WIDTH HEIGHT CORNERX CORNERY REFX REFY MINSIZE) [Function]
|
||||
(RELGETREGION WIDTH HEIGHT CORNERX CORNERY REFX REFY MINSIZE) [Function]
|
||||
Calls GETREGION with an initial ghost region as created by RELCREATEREGION. CORNERX and CORNERY determine the ghost region's fixed corner, and the cursor starts at the region's diagonally opposite corner. If MINSIZE is true, then WIDTH and HEIGHT are taken as the minimum sizes of the region, except for adjustments that may be needed to ensure that all corners of the ghost region are initially visible on the screen.
|
||||
(RELCREATEPOSITION REFX REFY) [Function]
|
||||
Creates a position with X and Y coordinates specified by REFX and REFY references as above.
|
||||
Constellation regions
|
||||
Applications are often set up as a constellation of windows, a central or primary window surrounded by some number of satellites for menus, headers, prompts, and secondary outputs. The main panel of a file browser, for example, displays the list of files, but above it are carefully arranged windows for the column headers, summary information, and prompts, and off to the side is the menu of file browser commands. FILEBROWSER interprets the screen region that the user sweeps out for a new browser as the region for the whole constellation,the smallest region that will enclose the central window and all of its satellites. Similarly, the screen region given to TEDIT and SEDIT is divided between the prompt window and the central editing window, again so that the whole constellation (a pair in these cases) fit within the provided region.
|
||||
Each of these applications is constructed by anticipating the subregions that the satellite windows will occupy after they are attached, decreasing the constellation region by their estimated (using WIDTHIFWINDOW HEIGHTIFWINDOW) or actual sizes, and then using remainder as the region for the central window.
|
||||
An alternative approach is to construct the central window first, giving it the entire constellation region, and then to have ATTACHWINDOW reshape that window to accomodate the satellite windows as they are attached in sequence. This leads to the same final configuration, but there is no need for separate calculations to pre-adjust the region of the central window.
|
||||
REGIONMANAGER provides an overlay veneer for ATTACHWINDOW that implements this strategy. If the new argument TAKEFROMCENTRAL is true, then the region of the WINDOWTOATTACH will be substracted from the region of the existing central window according to the EDGE parameter of the attachment.
|
||||
(ATTACHWINDOW WINDOWTOATTACH MAINWINDOW EDGE POSITIONONEDGE WINDOWCOMACTION TAKEFROMCENTRAL) [Function]
|
||||
This behavior is also triggered if the UNDERCONSTRUCTION property of the central window is true. Thus, a constellation can be set up by creating all of the satellites and the central window, marking the central window as under construction, and then doing the sequence of attachments. The property can be reset to NIL when the construction is complete, so the central window does not shrink if other other attachments (e.g. expanded menus) by later user actions.
|
||||
|
||||
A somewhat weaker form of a constellation is a collection of windows that are not attached around a central window but stand in a parent-child relationship at least with respect to closing and moving. A parent windows spawns children that respond independently to ordinary window commands (move, shape, close). But the children close when the parent closes, and the children move when the parent moves so that they continue to appear in the same relative positions. These primitives allow the construction of a tree of windows that are dependent in this way.
|
||||
(CLOSEWITH CHILDREN PARENT) [Function]
|
||||
Establishes a link between the PARENT window and any number of CHILDREN windows such that all CHILDREN will close when PARENT closes. The closing is accomplished by CLOSEWITH.DOIT:
|
||||
(CLOSEWITH.DOIT PARENT) [Function]
|
||||
|
||||
Constellation regions
|
||||
Applications are often set up as a constellation of windows, a central or primary window surrounded by some number of satellites for menus, headers, prompts, and secondary outputs. The main panel of a file browser, for example, displays the list of files, but above it are carefully arranged windows for the column headers, summary information, and prompts, and off to the side is the menu of file browser commands. FILEBROWSER interprets the screen region that the user sweeps out for a new browser as the region for the whole constellation,the smallest region that will enclose the central window and all of its satellites. Similarly, the screen region given to TEDIT and SEDIT is divided between the prompt window and the central editing window, again so that the whole constellation (a pair in these cases) fit within the provided region.
|
||||
Closes the close-with children of PARENT.
|
||||
(MOVEWITH CHILDREN PARENT) [Function]
|
||||
Establishes a link between the PARENT window and any number of CHILDREN windows such that all CHILDREN will move when PARENT closes. The closing is accomplished by MOVEWITH.DOIT:
|
||||
(MOVEWITH.DOIT PARENT NEWPOS) [Function]
|
||||
If NEWPOS is the new position of PARENT, moves each of the move-children so that they stand in the same relation to PARENT after it moves as before.
|
||||
|
||||
|
||||
(LIST ((PAGE NIL (PAPERSIZE Letter FOLIOINFO (ARABIC) STARTINGPAGE# 1) (0 0 612 792) ((FOLIO NIL (PARALOOKS (QUAD CENTERED) CHARLOOKS (SUPERSCRIPT 0 INVISIBLE OFF SELECTPOINT OFF PROTECTED OFF SIZE 10 FAMILY MODERN OVERLINE OFF STRIKEOUT OFF UNDERLINE OFF EXPANSION REGULAR SLOPE REGULAR WEIGHT MEDIUM INVERTED OFF USERINFO NIL STYLE NIL) FORMATINFO (ARABIC)) (174 36 288 36) NIL) (HEADING NIL (HEADINGTYPE RUNNINGHEAD) (84 744 528 36) NIL) (TEXT NIL NIL (84 96 456 600) NIL))) (PAGE NIL (PAPERSIZE Letter FOLIOINFO (ARABIC)) (0 0 612 792) ((FOLIO NIL (PARALOOKS (QUAD CENTERED) CHARLOOKS (SUPERSCRIPT 0 INVISIBLE OFF SELECTPOINT OFF PROTECTED OFF SIZE 10 FAMILY MODERN OVERLINE OFF STRIKEOUT OFF UNDERLINE OFF EXPANSION REGULAR SLOPE REGULAR WEIGHT MEDIUM INVERTED OFF USERINFO NIL STYLE NIL) FORMATINFO (ARABIC)) (174 36 288 36) NIL) (HEADING NIL (HEADINGTYPE RUNNINGHEAD) (84 744 528 36) NIL) (TEXT NIL NIL (84 96 456 600) NIL))) (PAGE NIL (PAPERSIZE Letter FOLIOINFO (ARABIC)) (0 0 612 792) ((FOLIO NIL (PARALOOKS (QUAD CENTERED) CHARLOOKS (SUPERSCRIPT 0 INVISIBLE OFF SELECTPOINT OFF PROTECTED OFF SIZE 10 FAMILY MODERN OVERLINE OFF STRIKEOUT OFF UNDERLINE OFF EXPANSION REGULAR SLOPE REGULAR WEIGHT MEDIUM INVERTED OFF USERINFO NIL STYLE NIL) FORMATINFO (ARABIC)) (174 36 288 36) NIL) (HEADING NIL (HEADINGTYPE RUNNINGHEAD) (84 744 528 36) NIL) (TEXT NIL NIL (84 96 456 600) NIL))))) 4 È º 4 È È 4 È È 4 È È 4 È È 4 È È . $È . È . È 4 È È . È . Š Š8 . Š Š8 J È È PAGEHEADING RUNNINGHEAD TERMINAL ÿü TERMINAL ÿü
|
||||
TIMESROMAN $ TERMINAL MODERN MODERN
|
||||
HRULE.GETFN
|
||||
An alternative approach is to construct the central window first, giving it the entire constellation region, and then to have ATTACHWINDOW reshape that window to accomodate the satellite windows as they are attached in sequence. This leads to the same final configuration, but there is no need for separate calculations to pre-adjust the region of the central window.
|
||||
HRULE.GETFN MODERN
|
||||
|
||||
HRULE.GETFN MODERN
|
||||
HRULE.GETFN MODERN
|
||||
HRULE.GETFN MODERN
|
||||
(
|
||||
|
||||
È
|
||||
(ATTACHWINDOW WINDOWTOATTACH MAINWINDOW EDGE POSITIONONEDGE WINDOWCOMACTION TAKEFROMCENTRAL) [Function]
|
||||
This behavior is also triggered if the UNDERCONSTRUCTION property of the central window is true. Thus, a constellation can be set up by creating all of the satellites and the central window, marking the central window as under construction, and then doing the sequence of attachments. The property can be reset to NIL when the construction is complete, so the central window does not shrink if other other attachments (e.g. expanded menus) by later user actions. (LIST ((PAGE NIL (PAPERSIZE Letter FOLIOINFO (ARABIC) STARTINGPAGE# 1) (0 0 612 792) ((FOLIO NIL (PARALOOKS (QUAD CENTERED) CHARLOOKS (SUPERSCRIPT 0 INVISIBLE OFF SELECTPOINT OFF PROTECTED OFF SIZE 10 FAMILY MODERN OVERLINE OFF STRIKEOUT OFF UNDERLINE OFF EXPANSION REGULAR SLOPE REGULAR WEIGHT MEDIUM INVERTED OFF USERINFO NIL STYLE NIL) FORMATINFO (ARABIC)) (174 36 288 36) NIL) (HEADING NIL (HEADINGTYPE RUNNINGHEAD) (84 744 528 36) NIL) (TEXT NIL NIL (84 96 456 600) NIL))) (PAGE NIL (PAPERSIZE Letter FOLIOINFO (ARABIC)) (0 0 612 792) ((FOLIO NIL (PARALOOKS (QUAD CENTERED) CHARLOOKS (SUPERSCRIPT 0 INVISIBLE OFF SELECTPOINT OFF PROTECTED OFF SIZE 10 FAMILY MODERN OVERLINE OFF STRIKEOUT OFF UNDERLINE OFF EXPANSION REGULAR SLOPE REGULAR WEIGHT MEDIUM INVERTED OFF USERINFO NIL STYLE NIL) FORMATINFO (ARABIC)) (174 36 288 36) NIL) (HEADING NIL (HEADINGTYPE RUNNINGHEAD) (84 744 528 36) NIL) (TEXT NIL NIL (84 96 456 600) NIL))) (PAGE NIL (PAPERSIZE Letter FOLIOINFO (ARABIC)) (0 0 612 792) ((FOLIO NIL (PARALOOKS (QUAD CENTERED) CHARLOOKS (SUPERSCRIPT 0 INVISIBLE OFF SELECTPOINT OFF PROTECTED OFF SIZE 10 FAMILY MODERN OVERLINE OFF STRIKEOUT OFF UNDERLINE OFF EXPANSION REGULAR SLOPE REGULAR WEIGHT MEDIUM INVERTED OFF USERINFO NIL STYLE NIL) FORMATINFO (ARABIC)) (174 36 288 36) NIL) (HEADING NIL (HEADINGTYPE RUNNINGHEAD) (84 744 528 36) NIL) (TEXT NIL NIL (84 96 456 600) NIL))))) 4 È È 4 È È 4 È È 4 È È . $È . È . È 4 È È . È . Š Š8 . Š Š8 J È È PAGEHEADING RUNNINGHEAD TERMINAL ÿü TERMINAL ÿü
|
||||
„ • ‘
|
||||
}
|
||||
|
||||
|
||||
/ ¯
|
||||
[ <01>
|
||||
C h
|
||||
<00> T Û
|
||||
|
||||
Á
|
||||
?
|
||||
|
||||
|
||||
; 3 o )
|
||||
M
|
||||
|
||||
A
|
||||
& M m
|
||||
J S -
|
||||
|
||||
j
|
||||
/ 3 t 2 C ƒ
|
||||
"
|
||||
O
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
Binary file not shown.
@@ -1,12 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED " 2-Jan-2022 22:03:27"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>TEDIT-PF-SEE.;104 6489
|
||||
(FILECREATED "12-Jan-2022 13:16:00"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>TEDIT-PF-SEE.;110 7695
|
||||
|
||||
:CHANGES-TO (VARS TEDIT-PF-SEECOMS)
|
||||
:CHANGES-TO (FNS PF-TEDIT)
|
||||
|
||||
:PREVIOUS-DATE "30-Dec-2021 23:17:58"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>TEDIT-PF-SEE.;103)
|
||||
:PREVIOUS-DATE " 2-Jan-2022 22:03:27"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>TEDIT-PF-SEE.;104)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT TEDIT-PF-SEECOMS)
|
||||
@@ -22,7 +22,8 @@
|
||||
(DEFINEQ
|
||||
|
||||
(PF-TEDIT
|
||||
[LAMBDA (FN IFILES REPRINT) (* ; "Edited 30-Dec-2021 23:17 by rmk")
|
||||
[LAMBDA (FN IFILES REPRINT) (* ; "Edited 12-Jan-2022 13:15 by rmk")
|
||||
(* ; "Edited 30-Dec-2021 23:17 by rmk")
|
||||
|
||||
(* ;; "PF* to a read-only TEDIT window. First argument is the function name, second if given is the input file.")
|
||||
|
||||
@@ -76,13 +77,27 @@
|
||||
THEN (SETFILEPTR ISTREAM (POP LOC))
|
||||
(SETQ EXPR (WITH-READER-ENVIRONMENT ENV (READ ISTREAM))
|
||||
)
|
||||
(IF (EQ FN (CAR EXPR))
|
||||
THEN (DSPFONT BOLDFONT TSTREAM)
|
||||
(PRINT FN TSTREAM)
|
||||
(DSPFONT DEFAULTFONT TSTREAM)
|
||||
(SETQ EXPR (CADR EXPR))
|
||||
(PRINTDEF EXPR 3 NIL NIL NIL TSTREAM)
|
||||
ELSE (PRINTDEF EXPR NIL NIL NIL NIL TSTREAM))
|
||||
(WITH-READER-ENVIRONMENT ENV
|
||||
(IF (EQ FN (CAR EXPR))
|
||||
THEN (DSPFONT BOLDFONT TSTREAM)
|
||||
(PRINT FN TSTREAM)
|
||||
(DSPFONT DEFAULTFONT TSTREAM)
|
||||
(SETQ EXPR (CADR EXPR))
|
||||
(PRINTDEF EXPR 3 T NIL NIL TSTREAM)
|
||||
ELSEIF (EQ FN (CADR EXPR))
|
||||
THEN
|
||||
(* ;;
|
||||
"Presumably a DEFUN. Print the CAR, boldface the cadr")
|
||||
|
||||
(PRINTOUT TSTREAM "(" .P2 (CAR EXPR)
|
||||
" " .FONT BOLDFONT .P2 (CADR EXPR)
|
||||
.FONT DEFAULTFONT " " .P2
|
||||
(CADDR EXPR)
|
||||
T 3)
|
||||
(PRINTDEF (CDDDR EXPR)
|
||||
3 T T NIL TSTREAM)
|
||||
(PRIN3 ")" TSTREAM)
|
||||
ELSE (PRINTDEF EXPR 3 NIL NIL NIL TSTREAM)))
|
||||
ELSE (PFCOPYBYTES ISTREAM TSTREAM (POP LOC)
|
||||
(POP LOC)))
|
||||
(TERPRI TSTREAM)
|
||||
@@ -127,5 +142,5 @@
|
||||
(ADDTOVAR LAMA )
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (956 6010 (PF-TEDIT 966 . 6008)))))
|
||||
(FILEMAP (NIL (947 7216 (PF-TEDIT 957 . 7214)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,12 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "30-Dec-2021 21:22:01"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>comparetext.;100 48929
|
||||
(FILECREATED "30-Jan-2022 09:03:52"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>comparetext.;112 47459
|
||||
|
||||
:CHANGES-TO (FNS COMPARETEXT.TEXTOBJ)
|
||||
|
||||
:PREVIOUS-DATE "27-Dec-2021 15:56:54"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>comparetext.;98)
|
||||
:PREVIOUS-DATE "28-Jan-2022 17:12:30"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>comparetext.;110)
|
||||
|
||||
|
||||
(* ; "
|
||||
@@ -33,11 +33,9 @@ Copyright (c) 1984-1985, 1993, 1998 by Xerox Corporation.
|
||||
(DEFINEQ
|
||||
|
||||
(COMPARETEXT
|
||||
[LAMBDA (FILE1 FILE2 HASH.TYPE REGION FILELABELS) (* ; "Edited 22-Dec-2021 23:49 by rmk")
|
||||
(* ; "Edited 15-Dec-2021 16:23 by rmk")
|
||||
(* ; "Edited 13-Dec-2021 12:21 by rmk")
|
||||
(* ; "Edited 8-Nov-2021 08:44 by rmk:")
|
||||
(* mjs " 8-Jan-84 21:06")
|
||||
[LAMBDA (FILE1 FILE2 HASH.TYPE REGION FILELABELS TITLE) (* ; "Edited 12-Jan-2022 16:32 by rmk")
|
||||
(* ; "Edited 8-Nov-2021 08:44 by rmk")
|
||||
(* ; "Edited 8-Jan-84 21:06 by mjs")
|
||||
|
||||
(* ;; "Compares the two files, and produces a graph showing their corresponding chunks. The courseness of the 'chunking' is determined by HASH.TYPE, which may be PARA, LINE, or WORD. HASH.TYPE = NIL defaults to PARA. The file difference graph is displayed at REGION. If REGION = NIL, the user is asked to specify a region. If REGION = T, a standard region is used.")
|
||||
|
||||
@@ -45,8 +43,10 @@ Copyright (c) 1984-1985, 1993, 1998 by Xerox Corporation.
|
||||
((PARA LINE WORD))
|
||||
(NIL (SETQ HASH.TYPE 'PARA))
|
||||
(ERROR (CONCAT "Unrecognize HASHTYPE " HASH.TYPE)))
|
||||
(LET ((FULLFILE1 (FINDFILE FILE1 T))
|
||||
(FULLFILE2 (FINDFILE FILE2 T)))
|
||||
(LET [(FULLFILE1 (OR (GETSTREAM FILE1 'INPUT T)
|
||||
(FINDFILE FILE1 T)))
|
||||
(FULLFILE2 (OR (GETSTREAM FILE2 'INPUT T)
|
||||
(FINDFILE FILE2 T]
|
||||
(CL:UNLESS (AND FULLFILE1 FULLFILE2)
|
||||
(ERROR "Can't find both files" (LIST FILE1 FILE2)))
|
||||
(IMCOMPARE.CHUNKS (create IMCOMPARE.CHUNK
|
||||
@@ -55,17 +55,22 @@ Copyright (c) 1984-1985, 1993, 1998 by Xerox Corporation.
|
||||
(create IMCOMPARE.CHUNK
|
||||
FILENAME _ FULLFILE2
|
||||
FILEPTR _ 0)
|
||||
HASH.TYPE NIL FILELABELS])
|
||||
HASH.TYPE REGION FILELABELS TITLE])
|
||||
|
||||
(COMPARETEXT.WINDOW
|
||||
[LAMBDA (GRAPH REGION) (* ; "Edited 27-Dec-2021 13:47 by rmk")
|
||||
(* ; "Edited 25-Dec-2021 11:40 by rmk")
|
||||
[LAMBDA (GRAPH REGION TITLE) (* ; "Edited 23-Jan-2022 18:18 by rmk")
|
||||
(* ; "Edited 12-Jan-2022 10:06 by rmk")
|
||||
(* ; "Edited 22-Dec-2021 15:51 by rmk")
|
||||
|
||||
(* ;; "Set up the graph WINDOW. If REGION isn't provided we prompt with a region that is wide enough for the graph and high enough for at least an initial segment.")
|
||||
|
||||
(LET [WINDOW GRAPHREGION GWIDTH (FILEPREFIX (CAR (GRAPHERPROP GRAPH 'FILELABELS]
|
||||
[SETQ REGION
|
||||
(LET [WINDOW GRAPHREGION WIDTH HEIGHT (FILEPREFIX (CAR (GRAPHERPROP GRAPH 'FILELABELS]
|
||||
(SETQ GRAPHREGION (GRAPHREGION GRAPH))
|
||||
(SETQ WIDTH (IPLUS (TIMES 2 WBorder)
|
||||
(FETCH (REGION WIDTH) OF GRAPHREGION)))
|
||||
[SETQ HEIGHT (IMIN 200 (IPLUS (FETCH (REGION HEIGHT) OF GRAPHREGION)
|
||||
(ITIMES 2 (FONTHEIGHT DEFAULTFONT]
|
||||
(SETQ REGION
|
||||
(if (EQ REGION T)
|
||||
then (create REGION
|
||||
LEFT _ 25
|
||||
@@ -73,35 +78,38 @@ Copyright (c) 1984-1985, 1993, 1998 by Xerox Corporation.
|
||||
WIDTH _ 500
|
||||
HEIGHT _ 150)
|
||||
elseif (REGIONP REGION)
|
||||
else (CLRPROMPT)
|
||||
(printout PROMPTWINDOW "Please specify a region for the comparison graph" T)
|
||||
(SETQ GRAPHREGION (GRAPHREGION GRAPH))
|
||||
(SETQ GWIDTH (FETCH (REGION WIDTH) OF GRAPHREGION))
|
||||
elseif (POSITIONP REGION)
|
||||
THEN
|
||||
(* ;;
|
||||
"This is a reference position providing the horizontal midpoint of the graph region and the top")
|
||||
|
||||
(RELCREATEREGION WIDTH HEIGHT 'LEFT 'TOP (IDIFFERENCE (FETCH (POSITION XCOORD)
|
||||
OF REGION)
|
||||
(IQUOTIENT WIDTH 2))
|
||||
(FETCH (POSITION YCOORD) OF REGION))
|
||||
ELSE (CLEARW (GETPROMPTWINDOW WINDOW))
|
||||
(printout (GETPROMPTWINDOW WINDOW)
|
||||
"Please specify a region for the comparison graph" T)
|
||||
|
||||
(* ;; "I don't know why the graphregion doesn't include the last line")
|
||||
|
||||
(SETQ REGION (RELGETREGION (IPLUS (TIMES 2 WBorder)
|
||||
GWIDTH)
|
||||
[IMIN 200 (IPLUS (FETCH (REGION HEIGHT) OF GRAPHREGION)
|
||||
(ITIMES 2 (FONTHEIGHT DEFAULTFONT]
|
||||
'RIGHT
|
||||
'TOP]
|
||||
[SETQ WINDOW (CREATEW REGION (CONCAT "Compare text" (CL:IF FILEPREFIX
|
||||
(CONCAT " of " FILEPREFIX)
|
||||
"")
|
||||
" showing "
|
||||
(CL:IF (GRAPHERPROP GRAPH 'ALLCHUNKS)
|
||||
"all"
|
||||
"only different")
|
||||
" chunks, hashed by "
|
||||
(SELECTQ (GRAPHERPROP GRAPH 'HASH.TYPE)
|
||||
(PARA "paragraph")
|
||||
(LINE "line")
|
||||
(WORD "word")
|
||||
(SHOULDNT]
|
||||
(RELCREATEREGION WIDTH HEIGHT 'RIGHT 'TOP REGION)))
|
||||
[SETQ WINDOW (CREATEW REGION (OR TITLE (CONCAT "Compare text" (CL:IF FILEPREFIX
|
||||
(CONCAT " of " FILEPREFIX)
|
||||
"")
|
||||
" showing "
|
||||
(CL:IF (GRAPHERPROP GRAPH 'ALLCHUNKS)
|
||||
"all"
|
||||
"only different")
|
||||
" chunks, hashed by "
|
||||
(SELECTQ (GRAPHERPROP GRAPH 'HASH.TYPE)
|
||||
(PARA "paragraph")
|
||||
(LINE "line")
|
||||
(WORD "word")
|
||||
(SHOULDNT]
|
||||
(GETPROMPTWINDOW WINDOW)
|
||||
(CL:WHEN (EQ GWIDTH (FETCH (REGION WIDTH) OF (WINDOWREGION WINDOW)))
|
||||
(WINDOWPROP WINDOW 'MAXSIZE (CONS GWIDTH MAX.SMALLP)))
|
||||
(CL:WHEN (EQ WIDTH (FETCH (REGION WIDTH) OF (WINDOWREGION WINDOW)))
|
||||
(WINDOWPROP WINDOW 'MAXSIZE (CONS WIDTH MAX.SMALLP)))
|
||||
(GETPROMPTWINDOW WINDOW)
|
||||
[WINDOWADDPROP WINDOW 'CLOSEFN (FUNCTION (LAMBDA (W)
|
||||
(LET (TOBJ TWINDOW)
|
||||
@@ -122,41 +130,33 @@ Copyright (c) 1984-1985, 1993, 1998 by Xerox Corporation.
|
||||
WINDOW])
|
||||
|
||||
(COMPARETEXT.TEXTOBJ
|
||||
[LAMBDA (NODE WINDOW INCOL1) (* ; "Edited 30-Dec-2021 21:21 by rmk")
|
||||
(* ; "Edited 27-Dec-2021 15:56 by rmk")
|
||||
[LAMBDA (NODE WINDOW INCOL1) (* ; "Edited 30-Jan-2022 09:03 by rmk")
|
||||
(* ; "Edited 28-Jan-2022 22:37 by rmk")
|
||||
|
||||
(* ;; "Returns the text object for the chunk column in the graphwindow WINDOW, on the left if INCOL1. If the windows are automatic, they are lined up under the middle of WINDOW.")
|
||||
|
||||
(DECLARE (USEDFREE COMPARETEXT.AUTOTEDIT))
|
||||
(LET (TEXTOBJ TSTREAM TWINDOW REGION (NODEID (FETCH (GRAPHNODE NODEID) OF NODE)))
|
||||
(LET (TEXTOBJ TSTREAM TWINDOW REGION REGIONARGS (NODEID (FETCH (GRAPHNODE NODEID) OF NODE)))
|
||||
(CL:UNLESS [AND [SETQ TEXTOBJ (WINDOWPROP WINDOW (CL:IF INCOL1
|
||||
'COL1TEXTOBJ
|
||||
'COL2TEXTOBJ)]
|
||||
(OPENWP (WFROMDS (TEXTSTREAM TEXTOBJ]
|
||||
(SETQ REGION (RELCREATEREGION 475 600 (CL:IF INCOL1
|
||||
'RIGHT
|
||||
'LEFT)
|
||||
'TOP
|
||||
(CL:IF INCOL1
|
||||
`(,WINDOW 0.5 -1)
|
||||
`(,WINDOW 0.5 1))
|
||||
`(,WINDOW BOTTOM -2)
|
||||
T))
|
||||
(SETQ REGIONARGS (LIST 700 600 (CL:IF INCOL1
|
||||
'RIGHT
|
||||
'LEFT)
|
||||
'TOP
|
||||
`(,WINDOW 0.5 ,(CL:IF INCOL1
|
||||
-1
|
||||
1))
|
||||
`(,WINDOW BOTTOM -2)
|
||||
T))
|
||||
(SETQ REGION (CL:IF COMPARETEXT.AUTOTEDIT
|
||||
(RELCREATEREGION REGIONARGS)
|
||||
(RELGETREGION REGIONARGS)))
|
||||
[SETQ TSTREAM (TEXTSTREAM (TEDIT (CL:IF (FIXP (CAR NODEID))
|
||||
(FETCH (IMCOMPARE.CHUNK FILENAME) of NODEID)
|
||||
NODEID)
|
||||
(IF COMPARETEXT.AUTOTEDIT
|
||||
THEN
|
||||
(* ;;
|
||||
"Just use it as created, don't prompt for adjustments")
|
||||
|
||||
REGION
|
||||
ELSE (RELGETREGION REGION NIL (CL:IF INCOL1
|
||||
'RIGHT
|
||||
'LEFT)
|
||||
'TOP))
|
||||
NIL
|
||||
`(READONLY T LEAVETTY T]
|
||||
REGION NIL `(READONLY T LEAVETTY T]
|
||||
(SETQ TWINDOW (WFROMDS TSTREAM))
|
||||
(SETQ TEXTOBJ (TEXTOBJ TSTREAM))
|
||||
(WINDOWPROP WINDOW (CL:IF INCOL1
|
||||
@@ -168,26 +168,8 @@ Copyright (c) 1984-1985, 1993, 1998 by Xerox Corporation.
|
||||
'FILELABELS))
|
||||
(CADDR (GRAPHERPROP (WINDOWPROP WINDOW 'GRAPH)
|
||||
'FILELABELS)))]
|
||||
[WINDOWADDPROP WINDOW 'MOVEFN (FUNCTION (LAMBDA (W NEWPOS)
|
||||
(LET ((DELTA (PTDIFFERENCE NEWPOS (
|
||||
WINDOWPOSITION
|
||||
W)))
|
||||
TOBJ TW)
|
||||
(CL:WHEN (SETQ TOBJ (WINDOWPROP
|
||||
W
|
||||
'COL1TEXTOBJ))
|
||||
(MOVEW (SETQ TW (WFROMDS (TEXTSTREAM
|
||||
TOBJ)))
|
||||
(PTPLUS DELTA (WINDOWPOSITION
|
||||
TW))))
|
||||
(CL:WHEN (SETQ TOBJ (WINDOWPROP
|
||||
W
|
||||
'COL2TEXTOBJ))
|
||||
(MOVEW (SETQ TW (WFROMDS (TEXTSTREAM
|
||||
TOBJ)))
|
||||
(PTPLUS DELTA (WINDOWPOSITION
|
||||
TW))))
|
||||
NIL])
|
||||
(MOVEWITH TWINDOW WINDOW)
|
||||
(CLOSEWITH TWINDOW WINDOW))
|
||||
TEXTOBJ])
|
||||
|
||||
(COMPARETEXT.SETSEL
|
||||
@@ -246,7 +228,7 @@ Copyright (c) 1984-1985, 1993, 1998 by Xerox Corporation.
|
||||
(WINDOWPROP WINDOW 'LASTNODES (LIST NODE1 NODE2])
|
||||
|
||||
(IMCOMPARE.CHUNKS
|
||||
[LAMBDA (CHUNK1 CHUNK2 HASH.TYPE REGION FILELABELS) (* ; "Edited 25-Dec-2021 13:02 by rmk")
|
||||
[LAMBDA (CHUNK1 CHUNK2 HASH.TYPE REGION FILELABELS TITLE) (* ; "Edited 12-Jan-2022 10:06 by rmk")
|
||||
(* ; "Edited 23-Dec-2021 00:02 by rmk")
|
||||
(* ; "Edited 8-Sep-1984 00:06 by rmk")
|
||||
|
||||
@@ -302,11 +284,13 @@ Copyright (c) 1984-1985, 1993, 1998 by Xerox Corporation.
|
||||
|
||||
(* ;; "The file comparison is complete. Format and display the file difference graph")
|
||||
|
||||
(IMCOMPARE.DISPLAYGRAPH CHUNK1 CHUNK2 HASH.TYPE REGION CHUNKLIST1 CHUNKLIST2 FILELABELS])
|
||||
(IMCOMPARE.DISPLAYGRAPH CHUNK1 CHUNK2 HASH.TYPE REGION CHUNKLIST1 CHUNKLIST2 FILELABELS
|
||||
TITLE])
|
||||
|
||||
(IMCOMPARE.COLLECT.HASH.CHUNKS
|
||||
[LAMBDA (CHUNK HASH.TYPE) (* ; "Edited 24-Dec-2021 22:30 by rmk")
|
||||
(* ; "Edited 13-Dec-2021 16:32 by rmk")
|
||||
[LAMBDA (CHUNK HASH.TYPE) (* ; "Edited 20-Jan-2022 23:09 by rmk")
|
||||
(* ; "Edited 24-Dec-2021 22:30 by rmk")
|
||||
(* ; "Edited 13-Dec-2021 16:32 by rmk")
|
||||
(* ; "Edited 23-Dec-98 16:54 by rmk:")
|
||||
(* mjs " 8-Jan-84 20:57")
|
||||
|
||||
@@ -338,11 +322,12 @@ Copyright (c) 1984-1985, 1993, 1998 by Xerox Corporation.
|
||||
(fetch (IMCOMPARE.CHUNK CHUNKLENGTH)
|
||||
of CHUNK)))
|
||||
WHILE (SETQ CHUNK (IMCOMPARE.HASH STREAM HASH.TYPE ENDPOS))
|
||||
COLLECT (REPLACE FILENAME OF CHUNK WITH FILENAME)
|
||||
COLLECT (REPLACE (IMCOMPARE.CHUNK FILENAME) OF CHUNK WITH FILENAME)
|
||||
CHUNK))])
|
||||
|
||||
(IMCOMPARE.DISPLAYGRAPH
|
||||
[LAMBDA (CHUNK1 CHUNK2 HASH.TYPE REGION CHUNKLIST1 CHUNKLIST2 FILELABELS)
|
||||
[LAMBDA (CHUNK1 CHUNK2 HASH.TYPE REGION CHUNKLIST1 CHUNKLIST2 FILELABELS TITLE)
|
||||
(* ; "Edited 12-Jan-2022 09:58 by rmk")
|
||||
(* ; "Edited 27-Dec-2021 11:58 by rmk")
|
||||
(* ; "Edited 23-Dec-2021 00:14 by rmk")
|
||||
(* mjs "11-Jul-85 09:10")
|
||||
@@ -459,7 +444,7 @@ Copyright (c) 1984-1985, 1993, 1998 by Xerox Corporation.
|
||||
COL1X
|
||||
,COL1X COL2X ,COL2X ALLCHUNKS
|
||||
,COMPARETEXT.ALLCHUNKS]
|
||||
(SHOWGRAPH GRAPH (COMPARETEXT.WINDOW GRAPH REGION)
|
||||
(SHOWGRAPH GRAPH (COMPARETEXT.WINDOW GRAPH REGION TITLE)
|
||||
(FUNCTION IMCOMPARE.LEFTBUTTONFN)
|
||||
(FUNCTION IMCOMPARE.MIDDLEBUTTONFN)
|
||||
T NIL])
|
||||
@@ -770,12 +755,12 @@ Copyright (c) 1984-1985, 1993, 1998 by Xerox Corporation.
|
||||
)
|
||||
(PUTPROPS COMPARETEXT COPYRIGHT ("Xerox Corporation" 1984 1985 1993 1998))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (1344 41549 (COMPARETEXT 1354 . 2933) (COMPARETEXT.WINDOW 2935 . 7132) (
|
||||
COMPARETEXT.TEXTOBJ 7134 . 12023) (COMPARETEXT.SETSEL 12025 . 12815) (CHUNKNODELABEL 12817 . 13938) (
|
||||
IMCOMPARE.BOXNODE 13940 . 14707) (IMCOMPARE.CHUNKS 14709 . 19062) (IMCOMPARE.COLLECT.HASH.CHUNKS 19064
|
||||
. 21842) (IMCOMPARE.DISPLAYGRAPH 21844 . 29570) (IMCOMPARE.HASH 29572 . 33759) (
|
||||
IMCOMPARE.MERGE.CONNECTED.CHUNKS 33761 . 37257) (IMCOMPARE.MERGE.UNCONNECTED.CHUNKS 37259 . 39214) (
|
||||
IMCOMPARE.SHOW.DIST 39216 . 39662) (IMCOMPARE.UPDATE.SYMBOL.TABLE 39664 . 41547)) (41550 47707 (
|
||||
IMCOMPARE.LEFTBUTTONFN 41560 . 44137) (IMCOMPARE.MIDDLEBUTTONFN 44139 . 47255) (IMCOMPARE.COPYBUTTONFN
|
||||
47257 . 47705)) (47760 48451 (TAIL1 47770 . 48124) (TAIL2 48126 . 48449)))))
|
||||
(FILEMAP (NIL (1345 40079 (COMPARETEXT 1355 . 2855) (COMPARETEXT.WINDOW 2857 . 7675) (
|
||||
COMPARETEXT.TEXTOBJ 7677 . 10274) (COMPARETEXT.SETSEL 10276 . 11066) (CHUNKNODELABEL 11068 . 12189) (
|
||||
IMCOMPARE.BOXNODE 12191 . 12958) (IMCOMPARE.CHUNKS 12960 . 17336) (IMCOMPARE.COLLECT.HASH.CHUNKS 17338
|
||||
. 20255) (IMCOMPARE.DISPLAYGRAPH 20257 . 28100) (IMCOMPARE.HASH 28102 . 32289) (
|
||||
IMCOMPARE.MERGE.CONNECTED.CHUNKS 32291 . 35787) (IMCOMPARE.MERGE.UNCONNECTED.CHUNKS 35789 . 37744) (
|
||||
IMCOMPARE.SHOW.DIST 37746 . 38192) (IMCOMPARE.UPDATE.SYMBOL.TABLE 38194 . 40077)) (40080 46237 (
|
||||
IMCOMPARE.LEFTBUTTONFN 40090 . 42667) (IMCOMPARE.MIDDLEBUTTONFN 42669 . 45785) (IMCOMPARE.COPYBUTTONFN
|
||||
45787 . 46235)) (46290 46981 (TAIL1 46300 . 46654) (TAIL2 46656 . 46979)))))
|
||||
STOP
|
||||
|
||||
File diff suppressed because one or more lines are too long
Binary file not shown.
File diff suppressed because one or more lines are too long
Binary file not shown.
Reference in New Issue
Block a user