(FILECREATED "30-Jul-84 18:01:49" {ERIS}<LISPUSERS>BROWSER.;10 16587
changes to: (VARS BROWSERCOMS)
(FNS BRPATHS1)
previous date: "18-Jan-84 17:03:01" {ERIS}<LISPUSERS>BROWSER.;9)
(* Copyright (c) 1983, 1984 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT BROWSERCOMS)
(RPAQQ BROWSERCOMS ((FNS NUMSPATHS BROWSER BROWSER.WHENFNSCHANGED BRPATHS1 BROWSER.LEFTFN
GET.BROWSE.PP.WINDOW GET.BROWSE.DESCRIBE.WINDOW BROWSEPP PPREPAINTFN
DESCRIBEREPAINTFN BROWSERDESCRIBE BROWSER.MIDDLEFN DEDITPROCESSRUNNINGP
REDRAWBROWSEGRAPH STBROWSER)
(FILES (FROM VALUEOF LISPUSERSDIRECTORIES)
GRAPHER)
(DECLARE: EVAL@COMPILE DONTCOPY (FILES (LOADCOMP FROM VALUEOF LISPUSERSDIRECTORIES)
GRAPHER))
(GLOBALRESOURCES (BROWSEHASH (LIST (HARRAY 30))))
(DECLARE: DONTCOPY (RECORDS BROWSEWIN PATHSARGS))
(VARS (BROWSERBOXING)
(BROWSERFORMAT)
(BROWSERWINDOWS)
(NODESELECTIONWINDOW)
(PFWINDOW)
(BROWSER.DESCRIBE.WINDOW)
(BrowserPPWindowWidth 750)
(BROWSERFONT (QUOTE (GACHA 8))))
(P (MOVD? (QUOTE MSPATHS)
(QUOTE OLDMSPATHS))
(MOVD? (QUOTE \MSPATHSBLOCK/MSPATHS2)
(QUOTE MSPATHS2))
(PROG ((WC (FILEPKGTYPE (QUOTE FNS)
(QUOTE WHENCHANGED))))
(OR (MEMB (QUOTE BROWSER.WHENFNSCHANGED)
WC)
(FILEPKGTYPE (QUOTE FNS)
(QUOTE WHENCHANGED)
(CONS (QUOTE BROWSER.WHENFNSCHANGED)
WC)))))
(DECLARE: DONTEVAL@LOAD DOCOPY (P (SELECTQ (SYSTEMTYPE)
(D (BROWSER T))
NIL)))))
(DEFINEQ
(NUMSPATHS
[LAMBDA (FROM TO INVERTED AVOIDING SEPARATE NOTRACE MARKING)
(* rmk: "16-Dec-83 15:44")
(COND
[(AND TOPW (EQ (OUTPUT)
T))
[OR AVOIDING (SETQ AVOIDING (QUOTE (NIL (NIL NIL . FNS)
APPLY LAMBDA (X)
(OR (GETPROP X (QUOTE MACRO))
(GETPROP X (QUOTE AVOID]
(STBROWSER [RESOURCECONTEXT BROWSEHASH
(PROG [X NAMED TEM (UNDONE (MSLISTSET FROM T))
ROOTS GRAPHNODE.LIST (SEEN BROWSEHASH)
(CALLRELATION (PARSERELATION (QUOTE CALL]
(CLRHASH SEEN)
[MAPC UNDONE (FUNCTION (LAMBDA (X)
(PUTHASH X (COND
((AND NOTRACE (MSMEMBSET X NOTRACE))
-1)
(T 0))
SEEN]
[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 (QUOTE NUMSPATHS)
(QUOTE MSPATHS)))
(T (MOVD (QUOTE OLDMSPATHS)
(QUOTE MSPATHS])
(BROWSER.WHENFNSCHANGED
[LAMBDA (FNNAME TYPE REASON) (* DECLARATIONS: (RECORDS BROWSEWIN))
(* rmk: "16-Dec-83 15:31")
(* 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 (QUOTE FNBROWSED))
FNNAME))
(BROWSEPP FNNAME PFWINDOW)))
(COND
((AND (ACTIVEWP BROWSER.DESCRIBE.WINDOW)
(EQ (WINDOWPROP BROWSER.DESCRIBE.WINDOW (QUOTE 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 (QUOTE PAINT)
(fetch WINDOW of X))
(WINDOWPROP (fetch WINDOW of X)
(QUOTE BUTTONEVENTFN)
(FUNCTION REDRAWBROWSEGRAPH))
(replace GRAPH of X with NIL])
(BRPATHS1
(LAMBDA (FROM) (* JonL "30-Jul-84 18:00")
(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) (* rmk: "16-Dec-83 15:33")
(* function that is applied upon selection of a node.)
(COND
((NULL NODE))
((EQ (fetch NODELABEL of NODE)
(WINDOWPROP (GET.BROWSE.PP.WINDOW)
(QUOTE 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: "16-SEP-83 13:17")
(* returns the window for pretty printing from the
browser.)
(COND
((TYPENAMEP PFWINDOW (QUOTE WINDOW))
PFWINDOW)
(T (SETQ PFWINDOW (CREATEW NIL "Browser print out window"))
(WINDOWPROP PFWINDOW (QUOTE REPAINTFN)
(QUOTE PPREPAINTFN))
(WINDOWPROP PFWINDOW (QUOTE SCROLLFN)
(QUOTE SCROLLBYREPAINTFN))
PFWINDOW])
(GET.BROWSE.DESCRIBE.WINDOW
[LAMBDA NIL (* rmk: "16-Dec-83 15:31")
(* returns the window for describe action from the
browser.)
(COND
((TYPENAMEP BROWSER.DESCRIBE.WINDOW (QUOTE WINDOW))
BROWSER.DESCRIBE.WINDOW)
(T (SETQ BROWSER.DESCRIBE.WINDOW (CREATEW NIL "Browser describe window"))
(WINDOWPROP BROWSER.DESCRIBE.WINDOW (QUOTE REPAINTFN)
(QUOTE DESCRIBEREPAINTFN))
(WINDOWPROP BROWSER.DESCRIBE.WINDOW (QUOTE RESHAPEFN)
(QUOTE DESCRIBEREPAINTFN))
(WINDOWPROP BROWSER.DESCRIBE.WINDOW (QUOTE SCROLLFN)
(QUOTE SCROLLBYREPAINTFN))
BROWSER.DESCRIBE.WINDOW])
(BROWSEPP
[LAMBDA (FN WINDOW) (* rrb "14-JAN-82 11:41")
(DECLARE (GLOBALVARS BrowserPPWindowWidth))
(RESETFORM (CURSOR WAITINGCURSOR)
(PROG (WIDTH BOTTOM)
(WINDOWPROP WINDOW (QUOTE FNBROWSED)
FN)
(CLEARW WINDOW)
(WINDOWPROP WINDOW (QUOTE EXTENT)
NIL)
(SETQ WIDTH (PPREPAINTFN WINDOW)) (* set the extent of the window.)
(WINDOWPROP WINDOW (QUOTE EXTENT)
(create REGION
LEFT ← 0
BOTTOM ←(SETQ BOTTOM (DSPYPOSITION NIL WINDOW))
WIDTH ← WIDTH
HEIGHT ←(IDIFFERENCE (WINDOWPROP WINDOW (QUOTE HEIGHT))
BOTTOM])
(PPREPAINTFN
[LAMBDA (WINDOW REGION) (* rrb "14-JAN-82 12:27")
(* repaints the browser pp window WINDOW.
Returns the width of the image so that caller can set
the EXTENT.)
(DECLARE (GLOBALVARS TTYLINELENGTH))
(PROG [(FN (WINDOWPROP WINDOW (QUOTE FNBROWSED)))
(EXTENT (WINDOWPROP WINDOW (QUOTE EXTENT]
(RETURN (COND
[FN (RESETFORM (TTYDISPLAYSTREAM WINDOW)
(DSPSCROLL (QUOTE OFF)
WINDOW)
(COND
(EXTENT (MOVETOUPPERLEFT WINDOW EXTENT)))
(PAGEHEIGHT 0)
(COND
((OR (EXPRP (GETD FN))
(GETPROP FN (QUOTE EXPR)))
(* set up linelength characteristics.)
(RESETVARS ((TTYLINELENGTH (LINELENGTH NIL WINDOW)))
(APPLY* (FUNCTION PP*)
FN))
(fetch WIDTH of (DSPCLIPPINGREGION NIL WINDOW)))
(T (* set right margin out so wouldn't clip.)
(DSPRIGHTMARGIN 5000 WINDOW)
(APPLY* (FUNCTION PF*)
FN)
(DSPRIGHTMARGIN (fetch RIGHT of (DSPCLIPPINGREGION NIL WINDOW)
)
WINDOW)
BrowserPPWindowWidth]
(T 0])
(DESCRIBEREPAINTFN
[LAMBDA (WIN REG) (* rrb "24-JAN-82 10:07")
(* reprints the contents of a describe window.)
(PROG [(FN (WINDOWPROP WIN (QUOTE FNBROWSED)))
(EXTENT (WINDOWPROP WIN (QUOTE EXTENT]
(COND
(FN (RESETLST (RESETSAVE NIL (LIST (QUOTE DSPFONT)
(DSPFONT (FONTCREATE (QUOTE GACHA)
12
(QUOTE BOLD))
WIN)
WIN))
(RESETSAVE MSPRINTFLG NIL)
(RESETSAVE (TTYDISPLAYSTREAM WIN))
(DSPSCROLL (QUOTE OFF)
WIN)
(COND
(EXTENT (MOVETOUPPERLEFT WIN EXTENT)))
(PAGEHEIGHT 0)
(MASTERSCOPE (LIST (QUOTE DESCRIBE)
FN])
(BROWSERDESCRIBE
[LAMBDA (FN WIN) (* rrb "14-JAN-82 12:35")
(* 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 (QUOTE FNBROWSED)
FN)
(CLEARW WIN)
(DESCRIBEREPAINTFN WIN)
(WINDOWPROP WIN (QUOTE EXTENT)
(create REGION
LEFT ← 0
BOTTOM ←(DSPYPOSITION NIL WIN)
WIDTH ←(WINDOWPROP WIN (QUOTE WIDTH))
HEIGHT ←(IDIFFERENCE (WINDOWPROP WIN (QUOTE HEIGHT))
(DSPYPOSITION NIL WIN])
(BROWSER.MIDDLEFN
[LAMBDA (NODE NWINDOW) (* rrb "18-Jan-84 17:02")
(* called when yellow selection from brower.
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 (LIST (FUNCTION DF)
(fetch NODELABEL of NODE]
(T (APPLY* (FUNCTION DF)
(fetch NODELABEL of NODE])
(DEDITPROCESSRUNNINGP
[LAMBDA NIL (* rrb "18-Jan-84 16:22")
(* is there a dedit process running?)
\DEDITWINDOWS])
(REDRAWBROWSEGRAPH
[LAMBDA (WINDOW) (* DECLARATIONS: (RECORDS BROWSEWIN))
(* lmm "28-FEB-82 11:30")
(PROG [(WN (find X in BROWSERWINDOWS suchthat (EQ (fetch WINDOW of X)
WINDOW]
(AND WN (APPLY (QUOTE NUMSPATHS)
(fetch ARGS of WN))) (* (OR WN (SHOULDNT)))
(WINDOWPROP WINDOW (QUOTE BUTTONEVENTFN)
(FUNCTION APPLYTOSELECTEDNODE))
(APPLYTOSELECTEDNODE WINDOW])
(STBROWSER
[LAMBDA (GRAPH ARGS) (* DECLARATIONS: (RECORDS BROWSEWIN))
(* rrb "16-Dec-83 16:13")
(* 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))
(QUOTE 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])
)
(FILESLOAD (FROM VALUEOF LISPUSERSDIRECTORIES)
GRAPHER)
(DECLARE: EVAL@COMPILE DONTCOPY
(FILESLOAD (LOADCOMP FROM VALUEOF LISPUSERSDIRECTORIES)
GRAPHER)
)
(DECLARE: DONTCOPY
(DECLARE: EVAL@COMPILE
(PUTDEF (QUOTE BROWSEHASH)
(QUOTE RESOURCES)
(QUOTE (LIST (HARRAY 30))))
)
)
(/SETTOPVAL (QUOTE \BROWSEHASH.GLOBALRESOURCE))
(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? (QUOTE MSPATHS)
(QUOTE OLDMSPATHS))
(MOVD? (QUOTE \MSPATHSBLOCK/MSPATHS2)
(QUOTE MSPATHS2))
(PROG ((WC (FILEPKGTYPE (QUOTE FNS)
(QUOTE WHENCHANGED))))
(OR (MEMB (QUOTE BROWSER.WHENFNSCHANGED)
WC)
(FILEPKGTYPE (QUOTE FNS)
(QUOTE WHENCHANGED)
(CONS (QUOTE BROWSER.WHENFNSCHANGED)
WC))))
(DECLARE: DONTEVAL@LOAD DOCOPY
(SELECTQ (SYSTEMTYPE)
(D (BROWSER T))
NIL)
)
(PUTPROPS BROWSER COPYRIGHT ("Xerox Corporation" 1983 1984))
(DECLARE: DONTCOPY
(FILEMAP (NIL (1537 15188 (NUMSPATHS 1547 . 3259) (BROWSER 3261 . 3545) (BROWSER.WHENFNSCHANGED 3547
. 4848) (BRPATHS1 4850 . 5833) (BROWSER.LEFTFN 5835 . 6500) (GET.BROWSE.PP.WINDOW 6502 . 7051) (
GET.BROWSE.DESCRIBE.WINDOW 7053 . 7790) (BROWSEPP 7792 . 8469) (PPREPAINTFN 8471 . 9802) (
DESCRIBEREPAINTFN 9804 . 10561) (BROWSERDESCRIBE 10563 . 11231) (BROWSER.MIDDLEFN 11233 . 12069) (
DEDITPROCESSRUNNINGP 12071 . 12310) (REDRAWBROWSEGRAPH 12312 . 12891) (STBROWSER 12893 . 15186)))))
STOP