(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "24-Apr-87 10:58:58" {ERIS}<LISPCORE>LIBRARY>BROWSER.;6 22298
changes to%: (FNS NUMSPATHS)
previous date%: "23-Apr-87 19:18:28" {ERIS}<LISPCORE>LIBRARY>BROWSER.;4)
(* "
Copyright (c) 1983, 1984, 1987 by Xerox Corporation. All rights reserved.
")
(PRETTYCOMPRINT BROWSERCOMS)
(RPAQQ BROWSERCOMS
[(FILES MASTERSCOPE GRAPHER)
(DECLARE%: EVAL@COMPILE DONTCOPY (FILES (LOADCOMP)
GRAPHER))
(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)
(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)
(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])
(FILESLOAD MASTERSCOPE GRAPHER)
(DECLARE%: EVAL@COMPILE DONTCOPY
(FILESLOAD (LOADCOMP)
GRAPHER)
)
(DEFINEQ
(NUMSPATHS
[LAMBDA (FROM TO INVERTED AVOIDING SEPARATE NOTRACE MARKING)
(* ; "Edited 24-Apr-87 10:55 by Snow")
(COND
[(AND (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))
(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])
(BROWSER
[LAMBDA (DISPLAYFLG) (* rmk%: "16-Dec-83 15:39")
(COND
(DISPLAYFLG (SETQ BROWSERFONT (FONTCREATE BROWSERFONT))
(MOVD 'NUMSPATHS 'MSPATHS))
(T (MOVD 'OLDMSPATHS 'MSPATHS])
(BROWSER.WHENFNSCHANGED
[LAMBDA (FNNAME TYPE REASON) (* DECLARATIONS%: (RECORDS BROWSEWIN))
(* ; "Edited 31-Mar-87 11:22 by jop")
(* ;; "called by system when FNNAME has changed If FNNAME is in a browser window, it reprints and redescribes it.")
(COND
((AND (ACTIVEWP PFWINDOW)
(EQ (WINDOWPROP PFWINDOW 'FNBROWSED)
FNNAME))
(BROWSEPP FNNAME PFWINDOW)))
(COND
((AND (ACTIVEWP BROWSER.DESCRIBE.WINDOW)
(EQ (WINDOWPROP BROWSER.DESCRIBE.WINDOW 'FNBROWSED)
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 GRAPH of X)
(DSPFILL NIL CHANGEDSHADE 'PAINT (fetch WINDOW of X))
(WINDOWPROP (fetch WINDOW of X)
'BUTTONEVENTFN
(FUNCTION REDRAWBROWSEGRAPH))
(replace GRAPH of X with NIL])
(BRPATHS1
[LAMBDA (FROM) (* ; "Edited 31-Mar-87 11:22 by jop")
(DECLARE (GLOBALVARS BROWSERFONT))
(PROG (TEM)
(MSPATHS2 FROM)
(COND
((NEQ (SETQ TEM (GETHASH FROM SEEN))
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])
(BROWSER.LEFTFN
[LAMBDA (NODE NWINDOW) (* ; "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])
(GET.BROWSE.PP.WINDOW
[LAMBDA NIL (* ; "Edited 31-Mar-87 11:23 by jop")
(* ;
"returns the window for pretty printing from the browser.")
(COND
((WINDOWP PFWINDOW)
PFWINDOW)
(T (SETQ PFWINDOW (CREATEW NIL "Browser print out window"))
(WINDOWPROP PFWINDOW 'REPAINTFN 'PPREPAINTFN)
(WINDOWPROP PFWINDOW 'REPAINTFN 'PPREPAINTFN)
(WINDOWPROP PFWINDOW 'RESHAPEFN 'PPRESHAPEFN)
(WINDOWPROP PFWINDOW 'SCROLLFN 'SCROLLBYREPAINTFN)
PFWINDOW])
(GET.BROWSE.DESCRIBE.WINDOW
[LAMBDA NIL (* ; "Edited 31-Mar-87 11:23 by jop")
(* ;
"returns the window for describe action from the browser.")
(COND
((WINDOWP BROWSER.DESCRIBE.WINDOW)
BROWSER.DESCRIBE.WINDOW)
(T (SETQ BROWSER.DESCRIBE.WINDOW (CREATEW NIL "Browser describe window"))
(WINDOWPROP BROWSER.DESCRIBE.WINDOW 'REPAINTFN 'DESCRIBEREPAINTFN)
(WINDOWPROP BROWSER.DESCRIBE.WINDOW 'RESHAPEFN 'DESCRIBEREPAINTFN)
(WINDOWPROP BROWSER.DESCRIBE.WINDOW 'SCROLLFN 'SCROLLBYREPAINTFN)
BROWSER.DESCRIBE.WINDOW])
(BROWSEPP
[LAMBDA (FN WINDOW) (* ; "Edited 31-Mar-87 11:16 by jop")
(DECLARE (GLOBALVARS BrowserPPWindowWidth))
(PROG (WIDTH BOTTOM)
(WINDOWPROP WINDOW 'FNBROWSED FN)
(CLEARW WINDOW)
(MOVETOUPPERLEFT WINDOW)
(WINDOWPROP WINDOW 'EXTENT NIL)
(SETQ WIDTH (PPREPAINTFN WINDOW)) (* ; "set the extent of the window.")
(WINDOWPROP WINDOW 'EXTENT (create REGION
LEFT ← 0
BOTTOM ← (SETQ BOTTOM (DSPYPOSITION NIL WINDOW))
WIDTH ← WIDTH
HEIGHT ← (IDIFFERENCE (WINDOWPROP WINDOW 'HEIGHT)
BOTTOM])
(PPREPAINTFN
[LAMBDA (WINDOW REGION RESHAPE) (* ; "Edited 31-Mar-87 11:24 by jop")
(* ;; "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))
DEF)
(RETURN (COND
(FN (printout WINDOW .FONT LAMBDAFONT)
(MOVETOUPPERLEFT WINDOW EXTENT)
(printout WINDOW .FONT DEFAULTFONT)
(COND
([OR (EXPRP (SETQ DEF (GETD FN)))
(SETQ DEF (GETPROP FN 'EXPR](* ;
"set up linelength characteristics.")
(RESETLST (RESETSAVE (OUTPUT WINDOW))
(RESETSAVE (SETREADTABLE T))
(RESETSAVE **COMMENT**FLG)
(printout WINDOW "(" .FONT LAMBDAFONT |.P2| FN .FONT DEFAULTFONT
T)
(DSPRIGHTMARGIN (fetch RIGHT of (DSPCLIPPINGREGION NIL WINDOW))
WINDOW)
(PRINTDEF DEF 2 'FNS)
(PRIN1 ")" WINDOW))
(fetch WIDTH of (DSPCLIPPINGREGION NIL WINDOW)))
(T (* ;
"set right margin out so wouldn't clip.")
(DSPRIGHTMARGIN 5000 WINDOW)
(APPLY* (FUNCTION PF*)
FN NIL WINDOW)
(DSPRIGHTMARGIN (fetch RIGHT of (DSPCLIPPINGREGION NIL WINDOW))
WINDOW)
BrowserPPWindowWidth)))
(T 0])
(PPRESHAPEFN
[LAMBDA (WINDOW) (* lmm "20-Jul-84 15:48")
(BROWSEPP (WINDOWPROP WINDOW 'FNBROWSED)
WINDOW])
(DESCRIBEREPAINTFN
[LAMBDA (WIN REG) (* ; "Edited 31-Mar-87 11:24 by jop")
(* ;
"reprints the contents of a describe window.")
(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])
(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.")
(WINDOWPROP WIN 'FNBROWSED FN)
(CLEARW WIN)
(DESCRIBEREPAINTFN WIN)
(WINDOWPROP WIN 'EXTENT (create REGION
LEFT ← 0
BOTTOM ← (DSPYPOSITION NIL WIN)
WIDTH ← (WINDOWPROP WIN 'WIDTH)
HEIGHT ← (IDIFFERENCE (WINDOWPROP WIN 'HEIGHT)
(DSPYPOSITION NIL WIN])
(BROWSER.MIDDLEFN
[LAMBDA (NODE NWINDOW) (* ; "Edited 23-Apr-87 19:10 by Snow")
(* ;
"called when yellow selection from browser. Call display editor on the function.")
(COND
((NULL NODE))
[(THIS.PROCESS) (* ; "processes are running.")
(COND
((DEDITPROCESSRUNNINGP)
(printout PROMPTWINDOW T T "Dedit can't run in two processes at once, yet." T
"You can call Dedit in the same process by typing " (fetch NODELABEL of NODE)
" " "into the Dedit " "window then selecting 'Edit'."))
(T (ADD.PROCESS `(EDITDEF ',(fetch NODELABEL of NODE) 'FNS]
(T (APPLY* (FUNCTION EDITDEF)
(fetch NODELABEL of NODE)
'FNS])
(DEDITPROCESSRUNNINGP
[LAMBDA NIL (* ; "Edited 31-Mar-87 11:27 by jop")
(* ;; "is there a dedit process running?")
(AND (EQ (EDITMODE)
'DEDIT)
\DEDITWINDOWS])
(REDRAWBROWSEGRAPH
[LAMBDA (WINDOW) (* DECLARATIONS%: (RECORDS BROWSEWIN))
(* ; "Edited 31-Mar-87 11:24 by jop")
(PROG [(WN (find X in BROWSERWINDOWS suchthat (EQ (fetch WINDOW of X)
WINDOW]
(AND WN (APPLY 'NUMSPATHS (fetch ARGS of WN))) (* ; "(OR WN (SHOULDNT))")
(WINDOWPROP WINDOW 'BUTTONEVENTFN (FUNCTION APPLYTOSELECTEDNODE))
(APPLYTOSELECTEDNODE WINDOW])
(STBROWSER
[LAMBDA (GRAPH ARGS) (* DECLARATIONS%: (RECORDS BROWSEWIN))
(* ; "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 DISCRIMINANT of ARGS)
(fetch DISCRIMINANT
of (fetch ARGS of W)))
do (replace ARGS of W with ARGS)
(replace GRAPH of W with GRAPH)
(SHOWGRAPH GRAPH (SETQ W (fetch 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))
(* ;
"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)))
(push BROWSERWINDOWS
(create BROWSEWIN
ARGS ← ARGS
GRAPH ← GRAPH
WINDOW ← W))
(RETURN W))
'CLOSEFN
(FUNCTION (LAMBDA (WINDOW) (* ;
"The closing function for browser windows. removes it from BROWSERWINDOWS")
(SETQ BROWSERWINDOWS (DREMOVE (for X in BROWSERWINDOWS
when (EQ (fetch WINDOW of X)
WINDOW) do (RETURN X))
BROWSERWINDOWS])
)
(DECLARE%: DONTCOPY
(DECLARE%: EVAL@COMPILE
[PUTDEF 'BROWSEHASH 'RESOURCES '(NEW (LIST (HARRAY 30]
)
)
(/SETTOPVAL '\BROWSEHASH.GLOBALRESOURCE NIL)
(DECLARE%: DONTCOPY
(DECLARE%: EVAL@COMPILE
(RECORD BROWSEWIN (ARGS GRAPH WINDOW))
(RECORD PATHSARGS (FROM TO . ETC)
[ACCESSFNS PATHSARGS ((DISCRIMINANT (CONS (fetch (PATHSARGS FROM) of DATUM)
(fetch (PATHSARGS TO) of DATUM])
)
)
(RPAQQ BROWSERBOXING NIL)
(RPAQQ BROWSERFORMAT NIL)
(RPAQQ BROWSERWINDOWS NIL)
(RPAQQ NODESELECTIONWINDOW NIL)
(RPAQQ PFWINDOW NIL)
(RPAQQ BROWSER.DESCRIBE.WINDOW NIL)
(RPAQQ BrowserPPWindowWidth 750)
(RPAQQ BROWSERFONT (GACHA 8))
(MOVD? 'MSPATHS 'OLDMSPATHS)
[PROG [(WC (FILEPKGTYPE 'FNS 'WHENCHANGED]
(OR (MEMB 'BROWSER.WHENFNSCHANGED WC)
(FILEPKGTYPE 'FNS 'WHENCHANGED (CONS 'BROWSER.WHENFNSCHANGED WC]
(DECLARE%: DONTEVAL@LOAD DOCOPY
(SELECTQ (SYSTEMTYPE)
(D (BROWSER T))
NIL)
)
(PUTPROPS BROWSER COPYRIGHT ("Xerox Corporation" 1983 1984 1987))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (1748 21162 (NUMSPATHS 1758 . 4818) (BROWSER 4820 . 5083) (BROWSER.WHENFNSCHANGED 5085
. 6762) (BRPATHS1 6764 . 8314) (BROWSER.LEFTFN 8316 . 9174) (GET.BROWSE.PP.WINDOW 9176 . 9858) (
GET.BROWSE.DESCRIBE.WINDOW 9860 . 10608) (BROWSEPP 10610 . 11484) (PPREPAINTFN 11486 . 13609) (
PPRESHAPEFN 13611 . 13791) (DESCRIBEREPAINTFN 13793 . 14489) (BROWSERDESCRIBE 14491 . 15249) (
BROWSER.MIDDLEFN 15251 . 16202) (DEDITPROCESSRUNNINGP 16204 . 16475) (REDRAWBROWSEGRAPH 16477 . 17078)
(STBROWSER 17080 . 21160)))))
STOP