github.com/Interlisp.medley
1
0
Fork 0
mirror of synced 2026-01-12 00:42:56 +00:00
Code Issues Projects Releases Wiki Activity

Add BROWSERMAX to limit depth of paths graph (#1158)

Browse Source 
* 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 2023-06-30 16:56:54 -07:00 committed by GitHub
parent 3cca8c4940
commit 4fed40bb85
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
3 changed files with 293 additions and 237 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

530
library/BROWSER
View File

@ -1,17 +1,17 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) (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) :EDIT-BY "lmm"
(FNS GET.BROWSE.PP.WINDOW NUMSPATHS)
:PREVIOUS-DATE "25-Mar-94 13:43:20" :CHANGES-TO (FNS BROWSER.LEFTFN NUMSPATHS STBROWSER MSPATHS.DISPATCH BROWSER
{DSK}<Users>kaplan>Local>medley3.5>my-medley>library>BROWSER.;1) 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) (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) (DECLARE%: EVAL@COMPILE DONTCOPY (FILES (LOADCOMP)
GRAPHER) GRAPHER)
(CONSTANTS (CHANGEDSHADE 8840))) (CONSTANTS (CHANGEDSHADE 8840)))
(FNS NUMSPATHS BROWSER BROWSER.WHENFNSCHANGED BRPATHS1 BROWSER.LEFTFN GET.BROWSE.PP.WINDOW (FNS MSPATHS.DISPATCH NUMSPATHS BROWSER BROWSER.WHENFNSCHANGED BRPATHS1 BROWSER.LEFTFN
GET.BROWSE.DESCRIBE.WINDOW BROWSEPP PPREPAINTFN PPRESHAPEFN DESCRIBEREPAINTFN GET.BROWSE.PP.WINDOW GET.BROWSE.DESCRIBE.WINDOW BROWSEPP PPREPAINTFN PPRESHAPEFN
BROWSERDESCRIBE BROWSER.MIDDLEFN DEDITPROCESSRUNNINGP REDRAWBROWSEGRAPH STBROWSER) DESCRIBEREPAINTFN BROWSERDESCRIBE BROWSER.MIDDLEFN DEDITPROCESSRUNNINGP
REDRAWBROWSEGRAPH STBROWSER)
(GLOBALRESOURCES BROWSEHASH) (GLOBALRESOURCES BROWSEHASH)
(DECLARE%: DONTCOPY (RECORDS BROWSEWIN PATHSARGS)) (DECLARE%: DONTCOPY (RECORDS BROWSEWIN PATHSARGS))
[VARS (BROWSERBOXING) [INITVARS (BROWSER T)
(BROWSERFORMAT) (BROWSERBOXING)
(BROWSERWINDOWS) (BROWSERFORMAT)
(NODESELECTIONWINDOW) (BROWSERWINDOWS)
(PFWINDOW) (NODESELECTIONWINDOW)
(BROWSER.DESCRIBE.WINDOW) (PFWINDOW)
(BrowserPPWindowWidth 750) (BROWSER.DESCRIBE.WINDOW)
(BROWSERFONT '(GACHA 8] (BrowserPPWindowWidth 750)
[P (MOVD? 'MSPATHS 'OLDMSPATHS) (BROWSERMAX 10)
(MOVD? 'NILL 'MODERNWINDOW) (BROWSERFONT '(GACHA 8]
(PROG [(WC (FILEPKGTYPE 'FNS 'WHENCHANGED] (P (MOVD? 'NILL 'MODERNWINDOW))
(OR (MEMB 'BROWSER.WHENFNSCHANGED WC) (VARS BROWSER.BORDERS)
(FILEPKGTYPE 'FNS 'WHENCHANGED (CONS 'BROWSER.WHENFNSCHANGED WC] (GLOBALVARS BROWSER.BORDERS BROWSERWINDOWS)
(DECLARE%: DONTEVAL@LOAD DOCOPY (P (SELECTQ (SYSTEMTYPE) (DECLARE%: DONTEVAL@LOAD DOCOPY (P (BROWSER T])
(D (BROWSER T))
NIL])
(FILESLOAD MASTERSCOPE GRAPHER) (FILESLOAD MASTERSCOPE GRAPHER)
(DECLARE%: EVAL@COMPILE DONTCOPY (DECLARE%: EVAL@COMPILE DONTCOPY
@ -58,64 +57,74 @@ Copyright (c) 1983-1984, 1987-1988, 1990, 1993-1994 by Venue & Xerox Corporation
) )
(DEFINEQ (DEFINEQ
(NUMSPATHS (MSPATHS.DISPATCH
[LAMBDA (FROM TO INVERTED AVOIDING SEPARATE NOTRACE MARKING) [LAMBDA (FROM TO INVERTED AVOIDING SEPARATE NOTRACE MARKING)
(* ; "Edited 7-Feb-2022 13:57 by rmk") (* ; "Edited 15-Apr-2023 11:33 by lmm")
(* ; "Edited 11-Apr-88 11:08 by jrb:") (IF (AND (GETD 'NUMSPATHS)
(COND (WINDOWWORLD)
[(AND (WINDOWWORLD)
(EQ (OUTPUT) (EQ (OUTPUT)
T)) T))
[OR AVOIDING (SETQ AVOIDING '(NIL (NIL NIL . FNS) THEN (NUMSPATHS FROM TO INVERTED AVOIDING SEPARATE NOTRACE MARKING)
APPLY LAMBDA (X) ELSE (OLDMSPATHS FROM TO INVERTED AVOIDING SEPARATE NOTRACE MARKING])
(GETPROP X 'AVOID]
(RESETVARS ((MSPRINTFLG)) (NUMSPATHS
(AND INVERTED (UPDATECHANGED)) [LAMBDA (FROM TO INVERTED AVOIDING SEPARATE NOTRACE MARKING DEPTH)
(STBROWSER (DECLARE (SPECVARS INVERTED GRAPHNODE.LIST)) (* ; "Edited 26-Apr-2023 09:12 by lmm")
[GLOBALRESOURCE (* ; "Edited 15-Apr-2023 18:43 by lmm")
BROWSEHASH (* ; "Edited 7-Feb-2022 13:57 by rmk")
(PROG [X NAMED TEM (UNDONE (MSLISTSET FROM T)) (* ; "Edited 11-Apr-88 11:08 by jrb:")
ROOTS GRAPHNODE.LIST (SEEN BROWSEHASH) [OR AVOIDING (SETQ AVOIDING '(NIL (NIL NIL . FNS)
(CALLRELATION (PARSERELATION 'CALL] APPLY LAMBDA (X)
(DECLARE (SPECVARS SEEN UNDONE GRAPHNODE.LIST)) (GETPROP X 'AVOID]
(CLRHASH SEEN) (AND INVERTED (UPDATECHANGED))
(for X in UNDONE do (PUTHASH X (COND (OR DEPTH (SETQ DEPTH BROWSERMAX))
((AND NOTRACE (MSMEMBSET X NOTRACE)) (WITH-RESOURCES BROWSEHASH (PROG [NAMED TEM (UNDONE (MSLISTSET FROM T))
-1) ROOTS GRAPHNODE.LIST (SEEN BROWSEHASH)
(T 0)) (CALLRELATION (PARSERELATION 'CALL]
SEEN) (DECLARE (SPECVARS SEEN GRAPHNODE.LIST CALLRELATION))
(OR INVERTED (UPDATEFN X NIL 0))) (CLRHASH SEEN)
[do (COND (for X in UNDONE do (PUTHASH X (COND
(NAMED (PUTHASH (CAR NAMED) ((AND NOTRACE (MSMEMBSET
0 SEEN) X NOTRACE))
[push ROOTS (fetch (GRAPHNODE NODEID) -1)
of (BRPATHS1 (CAR NAMED] (T 0))
(SETQ NAMED (CDR NAMED))) SEEN)
(UNDONE [COND (OR INVERTED (UPDATEFN X NIL 0)))
([OR (NULL (SETQ TEM (GETHASH (CAR UNDONE) [do (COND
SEEN))) (NAMED (PUTHASH (CAR NAMED)
(EQ TEM 0) 0 SEEN)
(AND (LISTP TEM) (PUSH ROOTS (fetch (GRAPHNODE NODEID)
(NULL (CAR TEM] of (BRPATHS1 (CAR NAMED)
(PUTHASH (CAR UNDONE) DEPTH)))
(LIST NIL) (SETQ NAMED (CDR NAMED)))
SEEN) (UNDONE [COND
(SETQ NAMED (LIST (CAR UNDONE] ([OR (NULL (SETQ TEM (GETHASH (CAR UNDONE)
(SETQ UNDONE (CDR UNDONE))) SEEN)))
(T (RETURN] (EQ TEM 0)
(RETURN (LAYOUTFOREST GRAPHNODE.LIST ROOTS BROWSERFORMAT BROWSERBOXING] (AND (LISTP TEM)
(PROG1 (LIST FROM TO INVERTED AVOIDING SEPARATE NOTRACE) (NULL (CAR TEM]
(* ; (PUTHASH (CAR UNDONE)
 "this LIST is actually an 'instance' of PATHSARGS") (LIST NIL)
] SEEN)
(T (OLDMSPATHS FROM TO INVERTED AVOIDING SEPARATE NOTRACE MARKING]) (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 (BROWSER
[LAMBDA (DISPLAYFLG) (* rmk%: "16-Dec-83 15:39") [LAMBDA (DISPLAYFLG) (* ; "Edited 15-Apr-2023 14:55 by lmm")
(COND (* rmk%: "16-Dec-83 15:39")
(DISPLAYFLG (SETQ BROWSERFONT (FONTCREATE BROWSERFONT)) (MOVD? 'MSPATHS 'OLDMSPATHS)
(MOVD 'NUMSPATHS 'MSPATHS)) (MOVD 'MSPATHS.DISPATCH 'MSPATHS)
(T (MOVD 'OLDMSPATHS '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 (BROWSER.WHENFNSCHANGED
[LAMBDA (FNNAME TYPE REASON) (* DECLARATIONS%: (RECORDS BROWSEWIN)) [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)) FNNAME))
(BROWSERDESCRIBE FNNAME BROWSER.DESCRIBE.WINDOW))) (BROWSERDESCRIBE FNNAME BROWSER.DESCRIBE.WINDOW)))
(for X in BROWSERWINDOWS do (COND (for X in BROWSERWINDOWS do (COND
((find GRAPHNODE ((find GRAPHNODE in (fetch (GRAPH GRAPHNODES)
in (fetch (GRAPH GRAPHNODES) of (fetch (BROWSEWIN GRAPH) of X))
of (fetch (BROWSEWIN GRAPH) suchthat (EQ (fetch (GRAPHNODE NODELABEL) of GRAPHNODE)
of X)) FNNAME))
suchthat (EQ (fetch (GRAPHNODE NODELABEL) (COND
of GRAPHNODE) ((fetch (BROWSEWIN GRAPH) of X)
FNNAME)) (DSPFILL NIL CHANGEDSHADE 'PAINT (fetch (BROWSEWIN WINDOW)
(COND of X))
((fetch (BROWSEWIN GRAPH) of X) (WINDOWPROP (fetch (BROWSEWIN WINDOW) of X)
(DSPFILL NIL CHANGEDSHADE 'PAINT 'BUTTONEVENTFN
(fetch (BROWSEWIN WINDOW) of (FUNCTION REDRAWBROWSEGRAPH))
X)) (replace (BROWSEWIN GRAPH) of X with NIL])
(WINDOWPROP (fetch (BROWSEWIN WINDOW)
of X)
'BUTTONEVENTFN
(FUNCTION REDRAWBROWSEGRAPH))
(replace (BROWSEWIN GRAPH) of X
with NIL])
(BRPATHS1 (BRPATHS1
[LAMBDA (FROM) (* ; "Edited 11-Apr-88 11:27 by jrb:") [LAMBDA (FROM DEPTH) (* ; "Edited 25-Apr-2023 10:59 by lmm")
(DECLARE (GLOBALVARS BROWSERFONT)) (* ; "Edited 11-Apr-88 11:27 by jrb:")
(PROG (TEM) (DECLARE (SPECVARS INVERTED)
(GLOBALVARS BROWSERFONT MISSING.GRAPH.NODEBORDER))
(PROG (TEM ENTRY TOFNS)
(MSPATHS2 FROM) (MSPATHS2 FROM)
(COND (COND
((EQ (SETQ TEM (GETHASH FROM SEEN)) ((EQ (SETQ TEM (GETHASH FROM SEEN))
-1) (* ; -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 (SETQ TEM (create GRAPHNODE
NODEID _ FROM NODEID _ FROM
NODELABEL _ FROM NODELABEL _ FROM
NODEFONT _ BROWSERFONT NODEFONT _ BROWSERFONT
TONODES _ NIL)) TONODES _ NIL))
(push GRAPHNODE.LIST TEM) (PUAH GRAPHNODE.LIST TEM)
(PUTHASH FROM TEM SEEN) (PUTHASH FROM TEM SEEN)
(RETURN TEM)) (RETURN TEM))
((NEQ TEM 0) (* ; "already expanded into a list") ((NEQ TEM 0) (* ; "already expanded into a list")
(RETURN TEM)) (RETURN TEM))
(T (RETURN (PROG ((ENTRY (create GRAPHNODE (T [SETQ TOFNS (COND
NODEID _ FROM ((NOT INVERTED)
NODELABEL _ FROM (GETRELATION FROM CALLRELATION))
NODEFONT _ BROWSERFONT))) (T (GETRELATION FROM CALLRELATION T]
(push GRAPHNODE.LIST ENTRY) (SETQ ENTRY (create GRAPHNODE
(PUTHASH FROM ENTRY SEEN) NODEID _ FROM
(replace (GRAPHNODE TONODES) of ENTRY NODELABEL _ FROM
with (for X NODEFONT _ BROWSERFONT))
in (for Y (PUSH GRAPHNODE.LIST ENTRY)
in (COND (PUTHASH FROM ENTRY SEEN)
((NOT INVERTED) (IF (AND TOFNS (<= DEPTH 0))
(GETRELATION FROM CALLRELATION)) THEN (REPLACE (GRAPHNODE NODEBORDER) OF ENTRY WITH (CDDR (ASSOC 'ENDOFLINE
(T (GETRELATION FROM CALLRELATION T) BROWSER.BORDERS))
)) when (MSPATHS2 Y) )
collect Y) when (SETQ X (BRPATHS1 (RETURN ENTRY))
X)) (replace (GRAPHNODE TONODES) of ENTRY with (for X
collect (fetch (GRAPHNODE NODEID) of X))) in (for Y in TOFNS
(RETURN ENTRY]) when (MSPATHS2 Y) collect Y)
when (SETQ X (BRPATHS1 X
(- DEPTH 1)))
collect (fetch (GRAPHNODE NODEID)
of X)))
(RETURN ENTRY])
(BROWSER.LEFTFN (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.")  "function that is applied upon selection of a node.")
(COND (PROG (FN SELECTION)
((NULL NODE)) (IF (NULL NODE)
((EQ (fetch NODELABEL of NODE) THEN (RETURN)
(WINDOWPROP (GET.BROWSE.PP.WINDOW) (MOVEW NWINDOW) (* ;
'FNBROWSED))  " really want to just drag the content around")
(BROWSERDESCRIBE (fetch NODELABEL of NODE) (RETURN))
(GET.BROWSE.DESCRIBE.WINDOW))) (IF (NULL (SETQ FN (FETCH NODELABEL OF NODE)))
(T (* ; THEN (RETURN))
 "if first time touched, pretty print it.") [SETQ SELECTION (MENU (CREATE MENU
(BROWSEPP (fetch NODELABEL of NODE) ITEMS _ '(CallsFrom CallsTo Edit Show InspectCode]
(GET.BROWSE.PP.WINDOW])
(* ;; "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 (GET.BROWSE.PP.WINDOW
[LAMBDA NIL (* ; "Edited 7-Feb-2022 14:01 by rmk") [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]) BOTTOM])
(PPREPAINTFN (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)) (PROG ((FN (WINDOWPROP WINDOW 'FNBROWSED))
(EXTENT (WINDOWPROP WINDOW 'EXTENT)) (EXTENT (WINDOWPROP WINDOW 'EXTENT))
@ -265,25 +318,23 @@ Copyright (c) 1983-1984, 1987-1988, 1990, 1993-1994 by Venue & Xerox Corporation
(MOVETOUPPERLEFT WINDOW EXTENT) (MOVETOUPPERLEFT WINDOW EXTENT)
(printout WINDOW .FONT DEFAULTFONT) (printout WINDOW .FONT DEFAULTFONT)
(COND (COND
((for FPTYPE in MSFNTYPES ((for FPTYPE in MSFNTYPES when (SETQ DEF (GETDEF FN (ffetch (MSANALYZABLE
when (SETQ DEF (GETDEF FN (ffetch (MSANALYZABLE FILEPKGNAME) FILEPKGNAME)
of FPTYPE) of FPTYPE)
NIL NIL
'NOERROR)) 'NOERROR))
do (SETQ FNTYPE (ffetch (MSANALYZABLE FILEPKGNAME) do (SETQ FNTYPE (ffetch (MSANALYZABLE FILEPKGNAME) of FPTYPE))
of FPTYPE)) (RETURN DEF) finally NIL) (* ;
(RETURN DEF) finally NIL)  "set up linelength characteristics.")
(* ;
 "set up linelength characteristics.")
(RESETLST (RESETLST
(RESETSAVE (OUTPUT WINDOW)) (RESETSAVE (OUTPUT WINDOW))
(RESETSAVE (SETREADTABLE T)) (RESETSAVE (SETREADTABLE T))
(RESETSAVE **COMMENT**FLG) (RESETSAVE **COMMENT**FLG)
(if (EQ FNTYPE 'FNS) (if (EQ FNTYPE 'FNS)
then (printout WINDOW "(" .FONT LAMBDAFONT |.P2| FN .FONT then (printout WINDOW "(" .FONT LAMBDAFONT .P2 FN .FONT
DEFAULTFONT T)) DEFAULTFONT T))
(DSPRIGHTMARGIN (fetch (REGION RIGHT) of (DSPCLIPPINGREGION (DSPRIGHTMARGIN (fetch (REGION RIGHT) of (DSPCLIPPINGREGION NIL
NIL WINDOW)) WINDOW))
WINDOW) WINDOW)
(PRINTDEF DEF (AND (EQ FNTYPE 'FNS) (PRINTDEF DEF (AND (EQ FNTYPE 'FNS)
2) 2)
@ -291,19 +342,19 @@ Copyright (c) 1983-1984, 1987-1988, 1990, 1993-1994 by Venue & Xerox Corporation
(if (EQ FNTYPE 'FNS) (if (EQ FNTYPE 'FNS)
then (PRIN1 ")" WINDOW))) then (PRIN1 ")" WINDOW)))
(fetch (REGION WIDTH) of (DSPCLIPPINGREGION NIL WINDOW))) (fetch (REGION WIDTH) of (DSPCLIPPINGREGION NIL WINDOW)))
(T (* ; (T (* ;
 "set right margin out so wouldn't clip.")  "set right margin out so wouldn't clip.")
(DSPRIGHTMARGIN 5000 WINDOW) (DSPRIGHTMARGIN 5000 WINDOW)
(APPLY* (FUNCTION PF*) (APPLY* (FUNCTION PF*)
FN NIL (GETSTREAM WINDOW)) FN NIL (GETSTREAM WINDOW))
(DSPRIGHTMARGIN (fetch (REGION RIGHT) of (DSPCLIPPINGREGION (DSPRIGHTMARGIN (fetch (REGION RIGHT) of (DSPCLIPPINGREGION NIL WINDOW
NIL WINDOW)) ))
WINDOW) WINDOW)
BrowserPPWindowWidth))) BrowserPPWindowWidth)))
(T 0]) (T 0])
(PPRESHAPEFN (PPRESHAPEFN
[LAMBDA (WINDOW) (* lmm "20-Jul-84 15:48") [LAMBDA (WINDOW) (* lmm "20-Jul-84 15:48")
(BROWSEPP (WINDOWPROP WINDOW 'FNBROWSED) (BROWSEPP (WINDOWPROP WINDOW 'FNBROWSED)
WINDOW]) WINDOW])
@ -314,17 +365,18 @@ Copyright (c) 1983-1984, 1987-1988, 1990, 1993-1994 by Venue & Xerox Corporation
(PROG [(FN (WINDOWPROP WIN 'FNBROWSED)) (PROG [(FN (WINDOWPROP WIN 'FNBROWSED))
(EXTENT (WINDOWPROP WIN 'EXTENT] (EXTENT (WINDOWPROP WIN 'EXTENT]
(COND (COND
(FN (RESETLST (RESETSAVE MSPRINTFLG NIL) (FN (RESETLST
(RESETSAVE (OUTPUT WIN)) (RESETSAVE MSPRINTFLG NIL)
(DSPSCROLL 'OFF WIN) (RESETSAVE (OUTPUT WIN))
(COND (DSPSCROLL 'OFF WIN)
(EXTENT (MOVETOUPPERLEFT WIN EXTENT))) (COND
(MSDESCRIBE FN]) (EXTENT (MOVETOUPPERLEFT WIN EXTENT)))
(MSDESCRIBE FN))])
(BROWSERDESCRIBE (BROWSERDESCRIBE
[LAMBDA (FN WIN) (* ; "Edited 31-Mar-87 11:15 by jop") [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) (WINDOWPROP WIN 'FNBROWSED FN)
(CLEARW WIN) (CLEARW WIN)
@ -337,9 +389,9 @@ Copyright (c) 1983-1984, 1987-1988, 1990, 1993-1994 by Venue & Xerox Corporation
(DSPYPOSITION NIL WIN]) (DSPYPOSITION NIL WIN])
(BROWSER.MIDDLEFN (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 (COND
((NULL NODE)) ((NULL NODE))
[(THIS.PROCESS) (* ; "processes are running.") [(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'.")) " " "into the Dedit " "window then selecting 'Edit'."))
(T (ADD.PROCESS `(ED ',(fetch NODELABEL of NODE]) (T (ADD.PROCESS `(ED ',(fetch NODELABEL of NODE])
((SEDIT SEDIT:SEDIT) (* ; ((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) (ED (fetch NODELABEL of NODE)
':DONTWAIT)) ':DONTWAIT))
(ED (fetch NODELABEL of NODE] (ED (fetch NODELABEL of NODE]
@ -360,8 +412,8 @@ Copyright (c) 1983-1984, 1987-1988, 1990, 1993-1994 by Venue & Xerox Corporation
(DEDITPROCESSRUNNINGP (DEDITPROCESSRUNNINGP
[LAMBDA NIL (* ; "Edited 31-Mar-87 11:27 by jop") [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) (AND (EQ (EDITMODE)
'DEDIT) 'DEDIT)
@ -369,73 +421,69 @@ Copyright (c) 1983-1984, 1987-1988, 1990, 1993-1994 by Venue & Xerox Corporation
(REDRAWBROWSEGRAPH (REDRAWBROWSEGRAPH
[LAMBDA (WINDOW) (* DECLARATIONS%: (RECORDS BROWSEWIN)) [LAMBDA (WINDOW) (* DECLARATIONS%: (RECORDS BROWSEWIN))
(* ; "Edited 15-Apr-2023 16:12 by lmm")
(* ; "Edited 31-Mar-87 11:24 by jop") (* ; "Edited 31-Mar-87 11:24 by jop")
(PROG [(WN (find X in BROWSERWINDOWS suchthat (EQ (fetch (BROWSEWIN WINDOW) (PROG [(WN (find X in BROWSERWINDOWS suchthat (EQ (fetch (BROWSEWIN WINDOW) of X)
of X) WINDOW]
WINDOW] (AND WN (APPLY (FUNCTION NUMSPATHS)
(AND WN (APPLY 'NUMSPATHS (fetch (BROWSEWIN ARGS) of WN))) (fetch (BROWSEWIN ARGS) of WN))) (* ; "(OR WN (SHOULDNT))")
(* ; "(OR WN (SHOULDNT))")
(WINDOWPROP WINDOW 'BUTTONEVENTFN (FUNCTION APPLYTOSELECTEDNODE)) (WINDOWPROP WINDOW 'BUTTONEVENTFN (FUNCTION APPLYTOSELECTEDNODE))
(APPLYTOSELECTEDNODE WINDOW]) (APPLYTOSELECTEDNODE WINDOW])
(STBROWSER (STBROWSER
[LAMBDA (GRAPH ARGS) (* DECLARATIONS%: (RECORDS BROWSEWIN)) [LAMBDA (GRAPH ARGS) (* DECLARATIONS%: (RECORDS BROWSEWIN))
(* ; "Edited 25-Apr-2023 21:05 by lmm")
(* ; "Edited 31-Mar-87 11:18 by jop") (* ; "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.") (* ;; "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 (WINDOWADDPROP (bind TMP for W in BROWSERWINDOWS when (EQUAL (fetch (PATHSARGS DISCRIMINANT)
when (EQUAL (fetch (PATHSARGS DISCRIMINANT) of ARGS) of ARGS)
(fetch (PATHSARGS DISCRIMINANT) of (fetch (fetch (PATHSARGS DISCRIMINANT)
(BROWSEWIN ARGS) of (fetch (BROWSEWIN ARGS)
of W))) of W)))
do (replace (BROWSEWIN ARGS) of W with ARGS) do (replace (BROWSEWIN ARGS) of W with ARGS)
(replace (BROWSEWIN GRAPH) of W with GRAPH) (replace (BROWSEWIN GRAPH) of W with GRAPH)
(SHOWGRAPH GRAPH (SETQ W (fetch (BROWSEWIN WINDOW) of W)) (SHOWGRAPH GRAPH (SETQ W (fetch (BROWSEWIN WINDOW) of W))
(FUNCTION BROWSER.LEFTFN) (FUNCTION BROWSER.LEFTFN)
(FUNCTION BROWSER.MIDDLEFN)) (FUNCTION BROWSER.MIDDLEFN))
(RETURN W) (RETURN W)
finally (SETQ W (SHOWGRAPH GRAPH (CONCAT "PATHS" finally (SETQ W (SHOWGRAPH GRAPH (CONCAT "PATHS"
(COND (COND
((SETQ TMP (fetch ((SETQ TMP (fetch (PATHSARGS FROM)
(PATHSARGS FROM) of ARGS))
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.")  "CADDDR here gets the thing that looks like it might be a function name.")
(CONCAT (COND (CONCAT (COND
((CADR (CADR TMP)) ((CADR (CADR TMP))
" FROM ") " FROM ")
(T " TO ")) (T " TO "))
(CADDDR TMP))) (CADDDR TMP)))
(T "")) (T "")))
(COND (FUNCTION BROWSER.LEFTFN)
((SETQ TMP (fetch (FUNCTION BROWSER.MIDDLEFN)))
(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)))
(push BROWSERWINDOWS (push BROWSERWINDOWS
(create BROWSEWIN (create BROWSEWIN
ARGS _ ARGS ARGS _ ARGS
GRAPH _ GRAPH GRAPH _ GRAPH
WINDOW _ W)) WINDOW _ W))
(RETURN W)) (RETURN W))
'CLOSEFN 'CLOSEFN
(FUNCTION (LAMBDA (WINDOW) (* ; (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 (SETQ BROWSERWINDOWS (DREMOVE (for X in BROWSERWINDOWS
when (EQ (fetch (BROWSEWIN WINDOW) when (EQ (fetch (BROWSEWIN WINDOW)
of X) of X)
WINDOW) WINDOW) do (RETURN X))
do (RETURN X))
BROWSERWINDOWS]) BROWSERWINDOWS])
) )
(DECLARE%: DONTCOPY (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) (MOVD? 'NILL 'MODERNWINDOW)
[PROG [(WC (FILEPKGTYPE 'FNS 'WHENCHANGED] (RPAQQ BROWSER.BORDERS
(OR (MEMB 'BROWSER.WHENFNSCHANGED WC) ((NORMAL "Normal" 2 -1)
(FILEPKGTYPE 'FNS 'WHENCHANGED (CONS 'BROWSER.WHENFNSCHANGED WC] (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 (DECLARE%: DONTEVAL@LOAD DOCOPY
(SELECTQ (SYSTEMTYPE) (BROWSER T)
(D (BROWSER T))
NIL)
) )
(PUTPROPS BROWSER COPYRIGHT ("Venue & Xerox Corporation" 1983 1984 1987 1988 1990 1993 1994))
(DECLARE%: DONTCOPY (DECLARE%: DONTCOPY
(FILEMAP (NIL (2054 25148 (NUMSPATHS 2064 . 5246) (BROWSER 5248 . 5511) (BROWSER.WHENFNSCHANGED 5513 (FILEMAP (NIL (2085 28437 (MSPATHS.DISPATCH 2095 . 2569) (NUMSPATHS 2571 . 6158) (BROWSER 6160 . 6731)
. 7812) (BRPATHS1 7814 . 10080) (BROWSER.LEFTFN 10082 . 10940) (GET.BROWSE.PP.WINDOW 10942 . 11767) ( (BROWSER.WHENFNSCHANGED 6733 . 8518) (BRPATHS1 8520 . 11171) (BROWSER.LEFTFN 11173 . 14599) (
GET.BROWSE.DESCRIBE.WINDOW 11769 . 12517) (BROWSEPP 12519 . 13393) (PPREPAINTFN 13395 . 16529) ( GET.BROWSE.PP.WINDOW 14601 . 15426) (GET.BROWSE.DESCRIBE.WINDOW 15428 . 16176) (BROWSEPP 16178 . 17052
PPRESHAPEFN 16531 . 16711) (DESCRIBEREPAINTFN 16713 . 17409) (BROWSERDESCRIBE 17411 . 18169) ( ) (PPREPAINTFN 17054 . 20180) (PPRESHAPEFN 20182 . 20358) (DESCRIBEREPAINTFN 20360 . 21064) (
BROWSER.MIDDLEFN 18171 . 19478) (DEDITPROCESSRUNNINGP 19480 . 19751) (REDRAWBROWSEGRAPH 19753 . 20516) BROWSERDESCRIBE 21066 . 21808) (BROWSER.MIDDLEFN 21810 . 23125) (DEDITPROCESSRUNNINGP 23127 . 23382) (
(STBROWSER 20518 . 25146))))) REDRAWBROWSEGRAPH 23384 . 24148) (STBROWSER 24150 . 28435)))))
STOP STOP

BIN
library/BROWSER.LCOM
View File

Binary file not shown.

BIN
library/BROWSER.TEDIT Normal file
View File

Binary file not shown.