Add BROWSERMAX to limit depth of paths graph (#1158)
* Add BROWSERMAX to limit depth of paths graph * Update Browser to use left-button menu popup to select action
This commit is contained in:
Larry Masinter
GitHub
parent
3cca8c4940
commit
4fed40bb85
530
library/BROWSER
530
library/BROWSER
@ -1,17 +1,17 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED " 7-Feb-2022 14:06:19" {DSK}<Users>kaplan>Local>medley3.5>my-medley>library>BROWSER.;3 26344
|
||||
(FILECREATED "26-Apr-2023 12:41:36" {DSK}<home>larry>il>medley>library>BROWSER.;6 29801
|
||||
|
||||
:CHANGES-TO (VARS BROWSERCOMS)
|
||||
(FNS GET.BROWSE.PP.WINDOW NUMSPATHS)
|
||||
:EDIT-BY "lmm"
|
||||
|
||||
:PREVIOUS-DATE "25-Mar-94 13:43:20"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>my-medley>library>BROWSER.;1)
|
||||
:CHANGES-TO (FNS BROWSER.LEFTFN NUMSPATHS STBROWSER MSPATHS.DISPATCH BROWSER
|
||||
BROWSER.WHENFNSCHANGED BRPATHS1 GET.BROWSE.PP.WINDOW
|
||||
GET.BROWSE.DESCRIBE.WINDOW BROWSEPP PPREPAINTFN PPRESHAPEFN DESCRIBEREPAINTFN
|
||||
BROWSERDESCRIBE BROWSER.MIDDLEFN DEDITPROCESSRUNNINGP REDRAWBROWSEGRAPH)
|
||||
(VARS BROWSERCOMS BROWSER.BORDERS)
|
||||
|
||||
:PREVIOUS-DATE "15-Apr-2023 18:55:36" {DSK}<home>larry>il>medley>library>BROWSER.;1)
|
||||
|
||||
(* ; "
|
||||
Copyright (c) 1983-1984, 1987-1988, 1990, 1993-1994 by Venue & Xerox Corporation.
|
||||
")
|
||||
|
||||
(PRETTYCOMPRINT BROWSERCOMS)
|
||||
|
||||
@ -20,27 +20,26 @@ Copyright (c) 1983-1984, 1987-1988, 1990, 1993-1994 by Venue & Xerox Corporation
|
||||
(DECLARE%: EVAL@COMPILE DONTCOPY (FILES (LOADCOMP)
|
||||
GRAPHER)
|
||||
(CONSTANTS (CHANGEDSHADE 8840)))
|
||||
(FNS NUMSPATHS BROWSER BROWSER.WHENFNSCHANGED BRPATHS1 BROWSER.LEFTFN GET.BROWSE.PP.WINDOW
|
||||
GET.BROWSE.DESCRIBE.WINDOW BROWSEPP PPREPAINTFN PPRESHAPEFN DESCRIBEREPAINTFN
|
||||
BROWSERDESCRIBE BROWSER.MIDDLEFN DEDITPROCESSRUNNINGP REDRAWBROWSEGRAPH STBROWSER)
|
||||
(FNS MSPATHS.DISPATCH NUMSPATHS BROWSER BROWSER.WHENFNSCHANGED BRPATHS1 BROWSER.LEFTFN
|
||||
GET.BROWSE.PP.WINDOW GET.BROWSE.DESCRIBE.WINDOW BROWSEPP PPREPAINTFN PPRESHAPEFN
|
||||
DESCRIBEREPAINTFN BROWSERDESCRIBE BROWSER.MIDDLEFN DEDITPROCESSRUNNINGP
|
||||
REDRAWBROWSEGRAPH STBROWSER)
|
||||
(GLOBALRESOURCES BROWSEHASH)
|
||||
(DECLARE%: DONTCOPY (RECORDS BROWSEWIN PATHSARGS))
|
||||
[VARS (BROWSERBOXING)
|
||||
(BROWSERFORMAT)
|
||||
(BROWSERWINDOWS)
|
||||
(NODESELECTIONWINDOW)
|
||||
(PFWINDOW)
|
||||
(BROWSER.DESCRIBE.WINDOW)
|
||||
(BrowserPPWindowWidth 750)
|
||||
(BROWSERFONT '(GACHA 8]
|
||||
[P (MOVD? 'MSPATHS 'OLDMSPATHS)
|
||||
(MOVD? 'NILL 'MODERNWINDOW)
|
||||
(PROG [(WC (FILEPKGTYPE 'FNS 'WHENCHANGED]
|
||||
(OR (MEMB 'BROWSER.WHENFNSCHANGED WC)
|
||||
(FILEPKGTYPE 'FNS 'WHENCHANGED (CONS 'BROWSER.WHENFNSCHANGED WC]
|
||||
(DECLARE%: DONTEVAL@LOAD DOCOPY (P (SELECTQ (SYSTEMTYPE)
|
||||
(D (BROWSER T))
|
||||
NIL])
|
||||
[INITVARS (BROWSER T)
|
||||
(BROWSERBOXING)
|
||||
(BROWSERFORMAT)
|
||||
(BROWSERWINDOWS)
|
||||
(NODESELECTIONWINDOW)
|
||||
(PFWINDOW)
|
||||
(BROWSER.DESCRIBE.WINDOW)
|
||||
(BrowserPPWindowWidth 750)
|
||||
(BROWSERMAX 10)
|
||||
(BROWSERFONT '(GACHA 8]
|
||||
(P (MOVD? 'NILL 'MODERNWINDOW))
|
||||
(VARS BROWSER.BORDERS)
|
||||
(GLOBALVARS BROWSER.BORDERS BROWSERWINDOWS)
|
||||
(DECLARE%: DONTEVAL@LOAD DOCOPY (P (BROWSER T])
|
||||
|
||||
(FILESLOAD MASTERSCOPE GRAPHER)
|
||||
(DECLARE%: EVAL@COMPILE DONTCOPY
|
||||
@ -58,64 +57,74 @@ Copyright (c) 1983-1984, 1987-1988, 1990, 1993-1994 by Venue & Xerox Corporation
|
||||
)
|
||||
(DEFINEQ
|
||||
|
||||
(NUMSPATHS
|
||||
(MSPATHS.DISPATCH
|
||||
[LAMBDA (FROM TO INVERTED AVOIDING SEPARATE NOTRACE MARKING)
|
||||
(* ; "Edited 7-Feb-2022 13:57 by rmk")
|
||||
(* ; "Edited 11-Apr-88 11:08 by jrb:")
|
||||
(COND
|
||||
[(AND (WINDOWWORLD)
|
||||
(* ; "Edited 15-Apr-2023 11:33 by lmm")
|
||||
(IF (AND (GETD 'NUMSPATHS)
|
||||
(WINDOWWORLD)
|
||||
(EQ (OUTPUT)
|
||||
T))
|
||||
[OR AVOIDING (SETQ AVOIDING '(NIL (NIL NIL . FNS)
|
||||
APPLY LAMBDA (X)
|
||||
(GETPROP X 'AVOID]
|
||||
(RESETVARS ((MSPRINTFLG))
|
||||
(AND INVERTED (UPDATECHANGED))
|
||||
(STBROWSER
|
||||
[GLOBALRESOURCE
|
||||
BROWSEHASH
|
||||
(PROG [X NAMED TEM (UNDONE (MSLISTSET FROM T))
|
||||
ROOTS GRAPHNODE.LIST (SEEN BROWSEHASH)
|
||||
(CALLRELATION (PARSERELATION 'CALL]
|
||||
(DECLARE (SPECVARS SEEN UNDONE GRAPHNODE.LIST))
|
||||
(CLRHASH SEEN)
|
||||
(for X in UNDONE do (PUTHASH X (COND
|
||||
((AND NOTRACE (MSMEMBSET X NOTRACE))
|
||||
-1)
|
||||
(T 0))
|
||||
SEEN)
|
||||
(OR INVERTED (UPDATEFN X NIL 0)))
|
||||
[do (COND
|
||||
(NAMED (PUTHASH (CAR NAMED)
|
||||
0 SEEN)
|
||||
[push ROOTS (fetch (GRAPHNODE NODEID)
|
||||
of (BRPATHS1 (CAR NAMED]
|
||||
(SETQ NAMED (CDR NAMED)))
|
||||
(UNDONE [COND
|
||||
([OR (NULL (SETQ TEM (GETHASH (CAR UNDONE)
|
||||
SEEN)))
|
||||
(EQ TEM 0)
|
||||
(AND (LISTP TEM)
|
||||
(NULL (CAR TEM]
|
||||
(PUTHASH (CAR UNDONE)
|
||||
(LIST NIL)
|
||||
SEEN)
|
||||
(SETQ NAMED (LIST (CAR UNDONE]
|
||||
(SETQ UNDONE (CDR UNDONE)))
|
||||
(T (RETURN]
|
||||
(RETURN (LAYOUTFOREST GRAPHNODE.LIST ROOTS BROWSERFORMAT BROWSERBOXING]
|
||||
(PROG1 (LIST FROM TO INVERTED AVOIDING SEPARATE NOTRACE)
|
||||
(* ;
|
||||
"this LIST is actually an 'instance' of PATHSARGS")
|
||||
]
|
||||
(T (OLDMSPATHS FROM TO INVERTED AVOIDING SEPARATE NOTRACE MARKING])
|
||||
THEN (NUMSPATHS FROM TO INVERTED AVOIDING SEPARATE NOTRACE MARKING)
|
||||
ELSE (OLDMSPATHS FROM TO INVERTED AVOIDING SEPARATE NOTRACE MARKING])
|
||||
|
||||
(NUMSPATHS
|
||||
[LAMBDA (FROM TO INVERTED AVOIDING SEPARATE NOTRACE MARKING DEPTH)
|
||||
(DECLARE (SPECVARS INVERTED GRAPHNODE.LIST)) (* ; "Edited 26-Apr-2023 09:12 by lmm")
|
||||
(* ; "Edited 15-Apr-2023 18:43 by lmm")
|
||||
(* ; "Edited 7-Feb-2022 13:57 by rmk")
|
||||
(* ; "Edited 11-Apr-88 11:08 by jrb:")
|
||||
[OR AVOIDING (SETQ AVOIDING '(NIL (NIL NIL . FNS)
|
||||
APPLY LAMBDA (X)
|
||||
(GETPROP X 'AVOID]
|
||||
(AND INVERTED (UPDATECHANGED))
|
||||
(OR DEPTH (SETQ DEPTH BROWSERMAX))
|
||||
(WITH-RESOURCES BROWSEHASH (PROG [NAMED TEM (UNDONE (MSLISTSET FROM T))
|
||||
ROOTS GRAPHNODE.LIST (SEEN BROWSEHASH)
|
||||
(CALLRELATION (PARSERELATION 'CALL]
|
||||
(DECLARE (SPECVARS SEEN GRAPHNODE.LIST CALLRELATION))
|
||||
(CLRHASH SEEN)
|
||||
(for X in UNDONE do (PUTHASH X (COND
|
||||
((AND NOTRACE (MSMEMBSET
|
||||
X NOTRACE))
|
||||
-1)
|
||||
(T 0))
|
||||
SEEN)
|
||||
(OR INVERTED (UPDATEFN X NIL 0)))
|
||||
[do (COND
|
||||
(NAMED (PUTHASH (CAR NAMED)
|
||||
0 SEEN)
|
||||
(PUSH ROOTS (fetch (GRAPHNODE NODEID)
|
||||
of (BRPATHS1 (CAR NAMED)
|
||||
DEPTH)))
|
||||
(SETQ NAMED (CDR NAMED)))
|
||||
(UNDONE [COND
|
||||
([OR (NULL (SETQ TEM (GETHASH (CAR UNDONE)
|
||||
SEEN)))
|
||||
(EQ TEM 0)
|
||||
(AND (LISTP TEM)
|
||||
(NULL (CAR TEM]
|
||||
(PUTHASH (CAR UNDONE)
|
||||
(LIST NIL)
|
||||
SEEN)
|
||||
(SETQ NAMED (LIST (CAR UNDONE]
|
||||
(SETQ UNDONE (CDR UNDONE)))
|
||||
(T (RETURN]
|
||||
(RETURN (STBROWSER (LAYOUTGRAPH GRAPHNODE.LIST ROOTS
|
||||
(APPEND BROWSERFORMAT BROWSERBOXING))
|
||||
(LIST FROM TO INVERTED AVOIDING SEPARATE NOTRACE
|
||||
MARKING DEPTH])
|
||||
|
||||
(BROWSER
|
||||
[LAMBDA (DISPLAYFLG) (* rmk%: "16-Dec-83 15:39")
|
||||
(COND
|
||||
(DISPLAYFLG (SETQ BROWSERFONT (FONTCREATE BROWSERFONT))
|
||||
(MOVD 'NUMSPATHS 'MSPATHS))
|
||||
(T (MOVD 'OLDMSPATHS 'MSPATHS])
|
||||
[LAMBDA (DISPLAYFLG) (* ; "Edited 15-Apr-2023 14:55 by lmm")
|
||||
(* rmk%: "16-Dec-83 15:39")
|
||||
(MOVD? 'MSPATHS 'OLDMSPATHS)
|
||||
(MOVD 'MSPATHS.DISPATCH 'MSPATHS)
|
||||
(SETQ BROWSER DISPLAYFLG)
|
||||
(OR (FONTP BROWSERFONT)
|
||||
(SETQ BROWSERFONT (FONTCREATE BROWSERFONT)))
|
||||
(PROG [(WC (FILEPKGTYPE 'FNS 'WHENCHANGED]
|
||||
(OR (MEMB 'BROWSER.WHENFNSCHANGED WC)
|
||||
(FILEPKGTYPE 'FNS 'WHENCHANGED (CONS 'BROWSER.WHENFNSCHANGED WC])
|
||||
|
||||
(BROWSER.WHENFNSCHANGED
|
||||
[LAMBDA (FNNAME TYPE REASON) (* DECLARATIONS%: (RECORDS BROWSEWIN))
|
||||
@ -134,78 +143,122 @@ Copyright (c) 1983-1984, 1987-1988, 1990, 1993-1994 by Venue & Xerox Corporation
|
||||
FNNAME))
|
||||
(BROWSERDESCRIBE FNNAME BROWSER.DESCRIBE.WINDOW)))
|
||||
(for X in BROWSERWINDOWS do (COND
|
||||
((find GRAPHNODE
|
||||
in (fetch (GRAPH GRAPHNODES)
|
||||
of (fetch (BROWSEWIN GRAPH)
|
||||
of X))
|
||||
suchthat (EQ (fetch (GRAPHNODE NODELABEL)
|
||||
of GRAPHNODE)
|
||||
FNNAME))
|
||||
(COND
|
||||
((fetch (BROWSEWIN GRAPH) of X)
|
||||
(DSPFILL NIL CHANGEDSHADE 'PAINT
|
||||
(fetch (BROWSEWIN WINDOW) of
|
||||
X))
|
||||
(WINDOWPROP (fetch (BROWSEWIN WINDOW)
|
||||
of X)
|
||||
'BUTTONEVENTFN
|
||||
(FUNCTION REDRAWBROWSEGRAPH))
|
||||
(replace (BROWSEWIN GRAPH) of X
|
||||
with NIL])
|
||||
((find GRAPHNODE in (fetch (GRAPH GRAPHNODES)
|
||||
of (fetch (BROWSEWIN GRAPH) of X))
|
||||
suchthat (EQ (fetch (GRAPHNODE NODELABEL) of GRAPHNODE)
|
||||
FNNAME))
|
||||
(COND
|
||||
((fetch (BROWSEWIN GRAPH) of X)
|
||||
(DSPFILL NIL CHANGEDSHADE 'PAINT (fetch (BROWSEWIN WINDOW)
|
||||
of X))
|
||||
(WINDOWPROP (fetch (BROWSEWIN WINDOW) of X)
|
||||
'BUTTONEVENTFN
|
||||
(FUNCTION REDRAWBROWSEGRAPH))
|
||||
(replace (BROWSEWIN GRAPH) of X with NIL])
|
||||
|
||||
(BRPATHS1
|
||||
[LAMBDA (FROM) (* ; "Edited 11-Apr-88 11:27 by jrb:")
|
||||
(DECLARE (GLOBALVARS BROWSERFONT))
|
||||
(PROG (TEM)
|
||||
[LAMBDA (FROM DEPTH) (* ; "Edited 25-Apr-2023 10:59 by lmm")
|
||||
(* ; "Edited 11-Apr-88 11:27 by jrb:")
|
||||
(DECLARE (SPECVARS INVERTED)
|
||||
(GLOBALVARS BROWSERFONT MISSING.GRAPH.NODEBORDER))
|
||||
(PROG (TEM ENTRY TOFNS)
|
||||
(MSPATHS2 FROM)
|
||||
(COND
|
||||
((EQ (SETQ TEM (GETHASH FROM SEEN))
|
||||
-1) (* ;
|
||||
"on NOPATHS list - create a node for it with no subs")
|
||||
"on NOPATHS list - create a node for it with no subs")
|
||||
(SETQ TEM (create GRAPHNODE
|
||||
NODEID _ FROM
|
||||
NODELABEL _ FROM
|
||||
NODEFONT _ BROWSERFONT
|
||||
TONODES _ NIL))
|
||||
(push GRAPHNODE.LIST TEM)
|
||||
(PUAH GRAPHNODE.LIST TEM)
|
||||
(PUTHASH FROM TEM SEEN)
|
||||
(RETURN TEM))
|
||||
((NEQ TEM 0) (* ; "already expanded into a list")
|
||||
(RETURN TEM))
|
||||
(T (RETURN (PROG ((ENTRY (create GRAPHNODE
|
||||
NODEID _ FROM
|
||||
NODELABEL _ FROM
|
||||
NODEFONT _ BROWSERFONT)))
|
||||
(push GRAPHNODE.LIST ENTRY)
|
||||
(PUTHASH FROM ENTRY SEEN)
|
||||
(replace (GRAPHNODE TONODES) of ENTRY
|
||||
with (for X
|
||||
in (for Y
|
||||
in (COND
|
||||
((NOT INVERTED)
|
||||
(GETRELATION FROM CALLRELATION))
|
||||
(T (GETRELATION FROM CALLRELATION T)
|
||||
)) when (MSPATHS2 Y)
|
||||
collect Y) when (SETQ X (BRPATHS1
|
||||
X))
|
||||
collect (fetch (GRAPHNODE NODEID) of X)))
|
||||
(RETURN ENTRY])
|
||||
(T [SETQ TOFNS (COND
|
||||
((NOT INVERTED)
|
||||
(GETRELATION FROM CALLRELATION))
|
||||
(T (GETRELATION FROM CALLRELATION T]
|
||||
(SETQ ENTRY (create GRAPHNODE
|
||||
NODEID _ FROM
|
||||
NODELABEL _ FROM
|
||||
NODEFONT _ BROWSERFONT))
|
||||
(PUSH GRAPHNODE.LIST ENTRY)
|
||||
(PUTHASH FROM ENTRY SEEN)
|
||||
(IF (AND TOFNS (<= DEPTH 0))
|
||||
THEN (REPLACE (GRAPHNODE NODEBORDER) OF ENTRY WITH (CDDR (ASSOC 'ENDOFLINE
|
||||
BROWSER.BORDERS))
|
||||
)
|
||||
(RETURN ENTRY))
|
||||
(replace (GRAPHNODE TONODES) of ENTRY with (for X
|
||||
in (for Y in TOFNS
|
||||
when (MSPATHS2 Y) collect Y)
|
||||
when (SETQ X (BRPATHS1 X
|
||||
(- DEPTH 1)))
|
||||
collect (fetch (GRAPHNODE NODEID)
|
||||
of X)))
|
||||
(RETURN ENTRY])
|
||||
|
||||
(BROWSER.LEFTFN
|
||||
[LAMBDA (NODE NWINDOW) (* ; "Edited 31-Mar-87 11:16 by jop")
|
||||
[LAMBDA (NODE NWINDOW) (* ; "Edited 26-Apr-2023 12:41 by lmm")
|
||||
(* ; "Edited 31-Mar-87 11:16 by jop")
|
||||
(* ;
|
||||
"function that is applied upon selection of a node.")
|
||||
(COND
|
||||
((NULL NODE))
|
||||
((EQ (fetch NODELABEL of NODE)
|
||||
(WINDOWPROP (GET.BROWSE.PP.WINDOW)
|
||||
'FNBROWSED))
|
||||
(BROWSERDESCRIBE (fetch NODELABEL of NODE)
|
||||
(GET.BROWSE.DESCRIBE.WINDOW)))
|
||||
(T (* ;
|
||||
"if first time touched, pretty print it.")
|
||||
(BROWSEPP (fetch NODELABEL of NODE)
|
||||
(GET.BROWSE.PP.WINDOW])
|
||||
(PROG (FN SELECTION)
|
||||
(IF (NULL NODE)
|
||||
THEN (RETURN)
|
||||
(MOVEW NWINDOW) (* ;
|
||||
" really want to just drag the content around")
|
||||
(RETURN))
|
||||
(IF (NULL (SETQ FN (FETCH NODELABEL OF NODE)))
|
||||
THEN (RETURN))
|
||||
[SETQ SELECTION (MENU (CREATE MENU
|
||||
ITEMS _ '(CallsFrom CallsTo Edit Show InspectCode]
|
||||
|
||||
(* ;; "Mot implemented: Ignore Avoid")
|
||||
|
||||
(DESTRUCTURING-BIND (FROM TO INVERTED AVOIDING SEPARATE NOTRACE MARKING DEPTH)
|
||||
(FOR BW IN BROWSERWINDOWS WHEN (EQ (FETCH (BROWSEWIN WINDOW) OF BW)
|
||||
NWINDOW) DO (RETURN (FETCH (BROWSEWIN ARGS)
|
||||
OF BW))
|
||||
FINALLY (PROMPTPRINT "No browser window found for" FN)
|
||||
(RETURN))
|
||||
|
||||
(* ;; "Now we have the arguments to MSPATHS .. insert this node?")
|
||||
|
||||
(SELECTQ SELECTION
|
||||
((NIL)
|
||||
(RETURN))
|
||||
((CallsFrom CallsTo)
|
||||
(* ;; "new graph, FN at the root")
|
||||
|
||||
(NUMSPATHS (CREATE SENTENCE
|
||||
SUBJECT _ '(NIL NIL . FNS)
|
||||
MSPRED _ 'QUOTE
|
||||
OTHERSTUFF _ (LIST FN))
|
||||
(IF INVERTED
|
||||
THEN TO
|
||||
ELSE FROM)
|
||||
INVERTED AVOIDING NIL NOTRACE MARKING DEPTH))
|
||||
NIL
|
||||
(Ignore (* ; "local ignore"))
|
||||
(Avoid (* ; " global ignore"))
|
||||
(Edit (ED FN (IF (HASDEF FN 'FNS)
|
||||
THEN 'FNS
|
||||
ELSEIF (HASDEF FN 'FUNCTIONS)
|
||||
THEN 'FUNCTIONS
|
||||
ELSE (PROMPTPRINT FN "no definition")
|
||||
NIL)))
|
||||
(Show (CL:UNLESS (EQ FN (WINDOWPROP (GET.BROWSE.PP.WINDOW)
|
||||
'FNBROWSED))
|
||||
(BROWSEPP FN (GET.BROWSE.PP.WINDOW))))
|
||||
(Describe (BROWSERDESCRIBE FN (GET.BROWSE.DESCRIBE.WINDOW)))
|
||||
(InspectCode (IF (NOT (CCODEP FN))
|
||||
THEN (PROMPTPRINT FN "not compiled")
|
||||
ELSE (INSPECTCODE FN)))
|
||||
(HELP])
|
||||
|
||||
(GET.BROWSE.PP.WINDOW
|
||||
[LAMBDA NIL (* ; "Edited 7-Feb-2022 14:01 by rmk")
|
||||
@ -253,9 +306,9 @@ Copyright (c) 1983-1984, 1987-1988, 1990, 1993-1994 by Venue & Xerox Corporation
|
||||
BOTTOM])
|
||||
|
||||
(PPREPAINTFN
|
||||
[LAMBDA (WINDOW REGION RESHAPE) (* ; "Edited 11-Jun-90 14:11 by mitani")
|
||||
[LAMBDA (WINDOW REGION RESHAPE) (* ; "Edited 11-Jun-90 14:11 by mitani")
|
||||
|
||||
(* ;; "repaints the browser pp window WINDOW. Returns the width of the image so that caller can set the EXTENT.")
|
||||
(* ;; "repaints the browser pp window WINDOW. Returns the width of the image so that caller can set the EXTENT.")
|
||||
|
||||
(PROG ((FN (WINDOWPROP WINDOW 'FNBROWSED))
|
||||
(EXTENT (WINDOWPROP WINDOW 'EXTENT))
|
||||
@ -265,25 +318,23 @@ Copyright (c) 1983-1984, 1987-1988, 1990, 1993-1994 by Venue & Xerox Corporation
|
||||
(MOVETOUPPERLEFT WINDOW EXTENT)
|
||||
(printout WINDOW .FONT DEFAULTFONT)
|
||||
(COND
|
||||
((for FPTYPE in MSFNTYPES
|
||||
when (SETQ DEF (GETDEF FN (ffetch (MSANALYZABLE FILEPKGNAME)
|
||||
of FPTYPE)
|
||||
NIL
|
||||
'NOERROR))
|
||||
do (SETQ FNTYPE (ffetch (MSANALYZABLE FILEPKGNAME)
|
||||
of FPTYPE))
|
||||
(RETURN DEF) finally NIL)
|
||||
(* ;
|
||||
"set up linelength characteristics.")
|
||||
((for FPTYPE in MSFNTYPES when (SETQ DEF (GETDEF FN (ffetch (MSANALYZABLE
|
||||
FILEPKGNAME)
|
||||
of FPTYPE)
|
||||
NIL
|
||||
'NOERROR))
|
||||
do (SETQ FNTYPE (ffetch (MSANALYZABLE FILEPKGNAME) of FPTYPE))
|
||||
(RETURN DEF) finally NIL) (* ;
|
||||
"set up linelength characteristics.")
|
||||
(RESETLST
|
||||
(RESETSAVE (OUTPUT WINDOW))
|
||||
(RESETSAVE (SETREADTABLE T))
|
||||
(RESETSAVE **COMMENT**FLG)
|
||||
(if (EQ FNTYPE 'FNS)
|
||||
then (printout WINDOW "(" .FONT LAMBDAFONT |.P2| FN .FONT
|
||||
DEFAULTFONT T))
|
||||
(DSPRIGHTMARGIN (fetch (REGION RIGHT) of (DSPCLIPPINGREGION
|
||||
NIL WINDOW))
|
||||
then (printout WINDOW "(" .FONT LAMBDAFONT .P2 FN .FONT
|
||||
DEFAULTFONT T))
|
||||
(DSPRIGHTMARGIN (fetch (REGION RIGHT) of (DSPCLIPPINGREGION NIL
|
||||
WINDOW))
|
||||
WINDOW)
|
||||
(PRINTDEF DEF (AND (EQ FNTYPE 'FNS)
|
||||
2)
|
||||
@ -291,19 +342,19 @@ Copyright (c) 1983-1984, 1987-1988, 1990, 1993-1994 by Venue & Xerox Corporation
|
||||
(if (EQ FNTYPE 'FNS)
|
||||
then (PRIN1 ")" WINDOW)))
|
||||
(fetch (REGION WIDTH) of (DSPCLIPPINGREGION NIL WINDOW)))
|
||||
(T (* ;
|
||||
"set right margin out so wouldn't clip.")
|
||||
(T (* ;
|
||||
"set right margin out so wouldn't clip.")
|
||||
(DSPRIGHTMARGIN 5000 WINDOW)
|
||||
(APPLY* (FUNCTION PF*)
|
||||
FN NIL (GETSTREAM WINDOW))
|
||||
(DSPRIGHTMARGIN (fetch (REGION RIGHT) of (DSPCLIPPINGREGION
|
||||
NIL WINDOW))
|
||||
(DSPRIGHTMARGIN (fetch (REGION RIGHT) of (DSPCLIPPINGREGION NIL WINDOW
|
||||
))
|
||||
WINDOW)
|
||||
BrowserPPWindowWidth)))
|
||||
(T 0])
|
||||
|
||||
(PPRESHAPEFN
|
||||
[LAMBDA (WINDOW) (* lmm "20-Jul-84 15:48")
|
||||
[LAMBDA (WINDOW) (* lmm "20-Jul-84 15:48")
|
||||
(BROWSEPP (WINDOWPROP WINDOW 'FNBROWSED)
|
||||
WINDOW])
|
||||
|
||||
@ -314,17 +365,18 @@ Copyright (c) 1983-1984, 1987-1988, 1990, 1993-1994 by Venue & Xerox Corporation
|
||||
(PROG [(FN (WINDOWPROP WIN 'FNBROWSED))
|
||||
(EXTENT (WINDOWPROP WIN 'EXTENT]
|
||||
(COND
|
||||
(FN (RESETLST (RESETSAVE MSPRINTFLG NIL)
|
||||
(RESETSAVE (OUTPUT WIN))
|
||||
(DSPSCROLL 'OFF WIN)
|
||||
(COND
|
||||
(EXTENT (MOVETOUPPERLEFT WIN EXTENT)))
|
||||
(MSDESCRIBE FN])
|
||||
(FN (RESETLST
|
||||
(RESETSAVE MSPRINTFLG NIL)
|
||||
(RESETSAVE (OUTPUT WIN))
|
||||
(DSPSCROLL 'OFF WIN)
|
||||
(COND
|
||||
(EXTENT (MOVETOUPPERLEFT WIN EXTENT)))
|
||||
(MSDESCRIBE FN))])
|
||||
|
||||
(BROWSERDESCRIBE
|
||||
[LAMBDA (FN WIN) (* ; "Edited 31-Mar-87 11:15 by jop")
|
||||
|
||||
(* ;; "puts the masterscope DESCRIBE information in the window DS. Keeps tracks of which fn so if it changes the window can be updated.")
|
||||
|
||||
(* ;; "puts the masterscope DESCRIBE information in the window DS. Keeps tracks of which fn so if it changes the window can be updated.")
|
||||
|
||||
(WINDOWPROP WIN 'FNBROWSED FN)
|
||||
(CLEARW WIN)
|
||||
@ -337,9 +389,9 @@ Copyright (c) 1983-1984, 1987-1988, 1990, 1993-1994 by Venue & Xerox Corporation
|
||||
(DSPYPOSITION NIL WIN])
|
||||
|
||||
(BROWSER.MIDDLEFN
|
||||
[LAMBDA (NODE NWINDOW) (* ; "Edited 25-Mar-94 13:25 by jds")
|
||||
[LAMBDA (NODE NWINDOW) (* ; "Edited 25-Mar-94 13:25 by jds")
|
||||
(* ;
|
||||
"called when yellow selection from browser. Call display editor on the function.")
|
||||
"called when yellow selection from browser. Call display editor on the function.")
|
||||
(COND
|
||||
((NULL NODE))
|
||||
[(THIS.PROCESS) (* ; "processes are running.")
|
||||
@ -352,7 +404,7 @@ Copyright (c) 1983-1984, 1987-1988, 1990, 1993-1994 by Venue & Xerox Corporation
|
||||
" " "into the Dedit " "window then selecting 'Edit'."))
|
||||
(T (ADD.PROCESS `(ED ',(fetch NODELABEL of NODE])
|
||||
((SEDIT SEDIT:SEDIT) (* ;
|
||||
"SEdit doesn't have to worry about this stuff")
|
||||
"SEdit doesn't have to worry about this stuff")
|
||||
(ED (fetch NODELABEL of NODE)
|
||||
':DONTWAIT))
|
||||
(ED (fetch NODELABEL of NODE]
|
||||
@ -360,8 +412,8 @@ Copyright (c) 1983-1984, 1987-1988, 1990, 1993-1994 by Venue & Xerox Corporation
|
||||
|
||||
(DEDITPROCESSRUNNINGP
|
||||
[LAMBDA NIL (* ; "Edited 31-Mar-87 11:27 by jop")
|
||||
|
||||
(* ;; "is there a dedit process running?")
|
||||
|
||||
(* ;; "is there a dedit process running?")
|
||||
|
||||
(AND (EQ (EDITMODE)
|
||||
'DEDIT)
|
||||
@ -369,73 +421,69 @@ Copyright (c) 1983-1984, 1987-1988, 1990, 1993-1994 by Venue & Xerox Corporation
|
||||
|
||||
(REDRAWBROWSEGRAPH
|
||||
[LAMBDA (WINDOW) (* DECLARATIONS%: (RECORDS BROWSEWIN))
|
||||
(* ; "Edited 15-Apr-2023 16:12 by lmm")
|
||||
(* ; "Edited 31-Mar-87 11:24 by jop")
|
||||
(PROG [(WN (find X in BROWSERWINDOWS suchthat (EQ (fetch (BROWSEWIN WINDOW)
|
||||
of X)
|
||||
WINDOW]
|
||||
(AND WN (APPLY 'NUMSPATHS (fetch (BROWSEWIN ARGS) of WN)))
|
||||
(* ; "(OR WN (SHOULDNT))")
|
||||
(PROG [(WN (find X in BROWSERWINDOWS suchthat (EQ (fetch (BROWSEWIN WINDOW) of X)
|
||||
WINDOW]
|
||||
(AND WN (APPLY (FUNCTION NUMSPATHS)
|
||||
(fetch (BROWSEWIN ARGS) of WN))) (* ; "(OR WN (SHOULDNT))")
|
||||
(WINDOWPROP WINDOW 'BUTTONEVENTFN (FUNCTION APPLYTOSELECTEDNODE))
|
||||
(APPLYTOSELECTEDNODE WINDOW])
|
||||
|
||||
(STBROWSER
|
||||
[LAMBDA (GRAPH ARGS) (* DECLARATIONS%: (RECORDS BROWSEWIN))
|
||||
(* ; "Edited 25-Apr-2023 21:05 by lmm")
|
||||
(* ; "Edited 31-Mar-87 11:18 by jop")
|
||||
|
||||
(* ;; "puts a browser graph for the args FROMFN in a window. If a similar graph is already a window, that window is reused; otherwise a new window is created.")
|
||||
|
||||
(WINDOWADDPROP (bind TMP for W in BROWSERWINDOWS
|
||||
when (EQUAL (fetch (PATHSARGS DISCRIMINANT) of ARGS)
|
||||
(fetch (PATHSARGS DISCRIMINANT) of (fetch
|
||||
(BROWSEWIN ARGS)
|
||||
of W)))
|
||||
(WINDOWADDPROP (bind TMP for W in BROWSERWINDOWS when (EQUAL (fetch (PATHSARGS DISCRIMINANT)
|
||||
of ARGS)
|
||||
(fetch (PATHSARGS DISCRIMINANT)
|
||||
of (fetch (BROWSEWIN ARGS)
|
||||
of W)))
|
||||
do (replace (BROWSEWIN ARGS) of W with ARGS)
|
||||
(replace (BROWSEWIN GRAPH) of W with GRAPH)
|
||||
(SHOWGRAPH GRAPH (SETQ W (fetch (BROWSEWIN WINDOW) of W))
|
||||
(FUNCTION BROWSER.LEFTFN)
|
||||
(FUNCTION BROWSER.MIDDLEFN))
|
||||
(RETURN W)
|
||||
(replace (BROWSEWIN GRAPH) of W with GRAPH)
|
||||
(SHOWGRAPH GRAPH (SETQ W (fetch (BROWSEWIN WINDOW) of W))
|
||||
(FUNCTION BROWSER.LEFTFN)
|
||||
(FUNCTION BROWSER.MIDDLEFN))
|
||||
(RETURN W)
|
||||
finally (SETQ W (SHOWGRAPH GRAPH (CONCAT "PATHS"
|
||||
(COND
|
||||
((SETQ TMP (fetch
|
||||
(PATHSARGS FROM)
|
||||
of ARGS))
|
||||
(COND
|
||||
((SETQ TMP (fetch (PATHSARGS FROM)
|
||||
of ARGS))
|
||||
(CONCAT (COND
|
||||
((CADR (CADR TMP))
|
||||
" FROM ")
|
||||
(T " TO "))
|
||||
(CADDDR TMP)))
|
||||
(T ""))
|
||||
(COND
|
||||
((SETQ TMP (fetch (PATHSARGS TO)
|
||||
of ARGS))
|
||||
(* ;
|
||||
"CADDDR here gets the thing that looks like it might be a function name.")
|
||||
(CONCAT (COND
|
||||
((CADR (CADR TMP))
|
||||
" FROM ")
|
||||
(T " TO "))
|
||||
(CADDDR TMP)))
|
||||
(T ""))
|
||||
(COND
|
||||
((SETQ TMP (fetch
|
||||
(PATHSARGS TO)
|
||||
of ARGS))
|
||||
(* ;
|
||||
"CADDDR here gets the thing that looks like it might be a function name.")
|
||||
(CONCAT (COND
|
||||
((CADR (CADR TMP))
|
||||
" FROM ")
|
||||
(T " TO "))
|
||||
(CADDDR TMP)))
|
||||
(T "")))
|
||||
(FUNCTION BROWSER.LEFTFN)
|
||||
(FUNCTION BROWSER.MIDDLEFN)))
|
||||
"CADDDR here gets the thing that looks like it might be a function name.")
|
||||
(CONCAT (COND
|
||||
((CADR (CADR TMP))
|
||||
" FROM ")
|
||||
(T " TO "))
|
||||
(CADDDR TMP)))
|
||||
(T "")))
|
||||
(FUNCTION BROWSER.LEFTFN)
|
||||
(FUNCTION BROWSER.MIDDLEFN)))
|
||||
(push BROWSERWINDOWS
|
||||
(create BROWSEWIN
|
||||
ARGS _ ARGS
|
||||
GRAPH _ GRAPH
|
||||
WINDOW _ W))
|
||||
(create BROWSEWIN
|
||||
ARGS _ ARGS
|
||||
GRAPH _ GRAPH
|
||||
WINDOW _ W))
|
||||
(RETURN W))
|
||||
'CLOSEFN
|
||||
(FUNCTION (LAMBDA (WINDOW) (* ;
|
||||
"The closing function for browser windows. removes it from BROWSERWINDOWS")
|
||||
"The closing function for browser windows. removes it from BROWSERWINDOWS")
|
||||
(SETQ BROWSERWINDOWS (DREMOVE (for X in BROWSERWINDOWS
|
||||
when (EQ (fetch (BROWSEWIN WINDOW)
|
||||
of X)
|
||||
WINDOW)
|
||||
do (RETURN X))
|
||||
of X)
|
||||
WINDOW) do (RETURN X))
|
||||
BROWSERWINDOWS])
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
@ -457,41 +505,49 @@ Copyright (c) 1983-1984, 1987-1988, 1990, 1993-1994 by Venue & Xerox Corporation
|
||||
)
|
||||
)
|
||||
|
||||
(RPAQQ BROWSERBOXING NIL)
|
||||
(RPAQ? BROWSER T)
|
||||
|
||||
(RPAQQ BROWSERFORMAT NIL)
|
||||
(RPAQ? BROWSERBOXING )
|
||||
|
||||
(RPAQQ BROWSERWINDOWS NIL)
|
||||
(RPAQ? BROWSERFORMAT )
|
||||
|
||||
(RPAQQ NODESELECTIONWINDOW NIL)
|
||||
(RPAQ? BROWSERWINDOWS )
|
||||
|
||||
(RPAQQ PFWINDOW NIL)
|
||||
(RPAQ? NODESELECTIONWINDOW )
|
||||
|
||||
(RPAQQ BROWSER.DESCRIBE.WINDOW NIL)
|
||||
(RPAQ? PFWINDOW )
|
||||
|
||||
(RPAQQ BrowserPPWindowWidth 750)
|
||||
(RPAQ? BROWSER.DESCRIBE.WINDOW )
|
||||
|
||||
(RPAQQ BROWSERFONT (GACHA 8))
|
||||
(RPAQ? BrowserPPWindowWidth 750)
|
||||
|
||||
(MOVD? 'MSPATHS 'OLDMSPATHS)
|
||||
(RPAQ? BROWSERMAX 10)
|
||||
|
||||
(RPAQ? BROWSERFONT '(GACHA 8))
|
||||
|
||||
(MOVD? 'NILL 'MODERNWINDOW)
|
||||
|
||||
[PROG [(WC (FILEPKGTYPE 'FNS 'WHENCHANGED]
|
||||
(OR (MEMB 'BROWSER.WHENFNSCHANGED WC)
|
||||
(FILEPKGTYPE 'FNS 'WHENCHANGED (CONS 'BROWSER.WHENFNSCHANGED WC]
|
||||
(RPAQQ BROWSER.BORDERS
|
||||
((NORMAL "Normal" 2 -1)
|
||||
(GHOST "Shown elsewhere" 2 8840)
|
||||
(RECURSIVEGHOST "End of recursive chain" 2 0 -1)
|
||||
(MERGED "Includes other branches" 4 42405)
|
||||
(SELFRECURSIVE "Includes self-recursive calls" 2 61375)
|
||||
(RECURSIVE "Head of recursive chain" 4 28086)
|
||||
(ENDOFLINE "exceeded depth limit" 6 64510)))
|
||||
(DECLARE%: DOEVAL@COMPILE DONTCOPY
|
||||
|
||||
(GLOBALVARS BROWSER.BORDERS BROWSERWINDOWS)
|
||||
)
|
||||
(DECLARE%: DONTEVAL@LOAD DOCOPY
|
||||
|
||||
(SELECTQ (SYSTEMTYPE)
|
||||
(D (BROWSER T))
|
||||
NIL)
|
||||
(BROWSER T)
|
||||
)
|
||||
(PUTPROPS BROWSER COPYRIGHT ("Venue & Xerox Corporation" 1983 1984 1987 1988 1990 1993 1994))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (2054 25148 (NUMSPATHS 2064 . 5246) (BROWSER 5248 . 5511) (BROWSER.WHENFNSCHANGED 5513
|
||||
. 7812) (BRPATHS1 7814 . 10080) (BROWSER.LEFTFN 10082 . 10940) (GET.BROWSE.PP.WINDOW 10942 . 11767) (
|
||||
GET.BROWSE.DESCRIBE.WINDOW 11769 . 12517) (BROWSEPP 12519 . 13393) (PPREPAINTFN 13395 . 16529) (
|
||||
PPRESHAPEFN 16531 . 16711) (DESCRIBEREPAINTFN 16713 . 17409) (BROWSERDESCRIBE 17411 . 18169) (
|
||||
BROWSER.MIDDLEFN 18171 . 19478) (DEDITPROCESSRUNNINGP 19480 . 19751) (REDRAWBROWSEGRAPH 19753 . 20516)
|
||||
(STBROWSER 20518 . 25146)))))
|
||||
(FILEMAP (NIL (2085 28437 (MSPATHS.DISPATCH 2095 . 2569) (NUMSPATHS 2571 . 6158) (BROWSER 6160 . 6731)
|
||||
(BROWSER.WHENFNSCHANGED 6733 . 8518) (BRPATHS1 8520 . 11171) (BROWSER.LEFTFN 11173 . 14599) (
|
||||
GET.BROWSE.PP.WINDOW 14601 . 15426) (GET.BROWSE.DESCRIBE.WINDOW 15428 . 16176) (BROWSEPP 16178 . 17052
|
||||
) (PPREPAINTFN 17054 . 20180) (PPRESHAPEFN 20182 . 20358) (DESCRIBEREPAINTFN 20360 . 21064) (
|
||||
BROWSERDESCRIBE 21066 . 21808) (BROWSER.MIDDLEFN 21810 . 23125) (DEDITPROCESSRUNNINGP 23127 . 23382) (
|
||||
REDRAWBROWSEGRAPH 23384 . 24148) (STBROWSER 24150 . 28435)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
BIN
library/BROWSER.TEDIT
Normal file
BIN
library/BROWSER.TEDIT
Normal file
Binary file not shown.
Loading…
x
Reference in New Issue
Block a user