jh@Ist.CO.UK (Jeremy Huxtable) (08/31/88)
I keep hearing on the net about various NeWS class browsers but have yet
to see one. What I do have though, is my own object browser and editor
which I wrote one afternoon to rectify this loss. You may find this useful
if you don't already have something similar.
To go with the object browser, there is an error handler, which pops
up a browser on your process whenever an error occurs. I, at least,
find this extremely useful.
Notes: - This is an Object browser, not a Class browser.
- It was thrown together very quickly in order to answer a need,
and probably needs rewriting.
- I would like to do more work on it, but I am leaving for distant
parts in a couple of weeks, and will not be able to do more or
answer many questions unless you are quick.
- It needs lots of clever extensions, new features, etc., provided
by anyone who is willing. I won't be here to receive them though.
- It is, though, very useful.
Jeremy Huxtable.
----------------------cut here--------------------
#! /bin/sh
# This is a shell archive. Remove anything before this line, then unpack
# it by saving it into a file and typing "sh file". To overwrite existing
# files, type "sh file -c". You can also feed this as standard input via
# unshar, or by typing "sh <file", e.g.. If this archive is complete, you
# will see the following message at the end:
# "End of shell archive."
# Contents: browser.ps error.ps
# Wrapped by jh@iscream on Wed Aug 31 15:00:13 1988
PATH=/bin:/usr/bin:/usr/ucb ; export PATH
if test -f browser.ps -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"browser.ps\"
else
echo shar: Extracting \"browser.ps\" \(13449 characters\)
sed "s/^X//" >browser.ps <<'END_OF_browser.ps'
X%! /usr/NeWS/bin/psh
X
X% NeWS object browser and editor (NeWS1.1)
X%
X% Jeremy Huxtable
X%
X% Mon Jul 25 17:36:06 BST 1988
X
X% This file implements a NeWS object browser and editor. A browser is
X% a window which may be popped up onto any array or dictionary and
X% lets you view and alter the contents.
X% Firstly, the ArrayBrowser:
X%
X% Viewing:
X% This displays an array in vertical form, the first element at
X% the top. A scrollbar is provided to let you look at all of
X% long arrays. Clicking the PointButton on an element
X% in the display will pop up a sub-browser onto that element,
X% provided that it is an array or dictionary. There is no point
X% having browsers for integers etc.
X% Editing:
X% Clicking the AdjustButton on an element will pop up an editing
X% window for that element. This is a window containing a text item
X% and two buttons. The first button, marked "Put", evaluates the
X% contents of the text item and replaces it in the array where you
X% originally clicked. When the browser is redisplayed, you will
X% see the change displayed. The second button, marked "Null",
X% is a short cut, and sets the element to null. This is useful when
X% you are trying to break cyclic reference chains.
X%
X% Next the DictBrowser:
X%
X% This is essentially the same as an ArrayBrowser, but displays
X% pairs of keys/values in no particular order. The mouse buttons
X% can be used in the same way as for the ArrayBrowser.
X%
X% The FontBrowser:
X% This has two views: a) as a dictionary, and b) as a font.
X% Switch between the two by selecting from the menu.
X%
X% The ProcessBrowser, CanvasBrowser, and EventBrowser:
X%
X% These are the same as DictBrowsers, but have menu options which
X% allow you to manupulate the object being browsed. You can kill,
X% suspend, or continue processes, map/unmap canvases or move them
X% to the top or bottom, and revoke interest in events. The last
X% of these is particularly interesting as all processes waiting
X% on the events will die with "invalidaccess" errors. Revoking
X% interest is the quickest way of zapping cyclic references.
X
X% BUGS:
X% - reference counting problems, browsers will not zap until their
X% children have been zapped.
X% - display of dictionaries is not good, should calculate the widths
X% of keys and values.
X% - dictionary entries should be sorted.
X% - the horizontal scrollbar doesn't do anything yet.
X% - scrollbars don't work properly for FontBrowsers.
X% - should have different views of the same object, maybe combine
X% it with Don Hopkins' visualising window.
X% - the subclassing is bit messy and shows that this thing evolved.
X% It did only take an afternoon to write initially though.
X
Xsystemdict /Item known not { (NeWS/liteitem.ps) run } if
X
X/EditWindow DefaultWindow [
X /EditItems % Items in the window
X /EditObject % Object being edited
X /EditKey % Key in object
X]
Xclassbegin
X /FrameLabel (Object Editor) def
X
X /new { % object key => instance
X /new super send begin
X /EditKey exch cvlit def
X /EditObject exch cvlit def
X /EditItems null def
X /NewValue () def
X currentdict
X end
X } def
X
X /gettopleft {
X 320 140
X fboverlay setcanvas getclick 2 index sub % Subtract height from y to select top left
X 4 2 roll reshape
X } def
X
X /PaintClient {
X EditItems paintitems
X } def
X
X /do_proc { % proc =>
X errored {
X (Error: %) [$error /errorname get]
X /printf
X } {
X () /printstring
X } ifelse
X EditItems /message_item get send
X } def
X
X /set_value {
X /NewValue exch def
X } def
X
X /activate {
X /EditItems 6 dict dup begin
X /edit_string (Value:) EditObject EditKey get cvstring /Right
X [ /ItemValue cvx self /set_value exch /send cvx ] cvx
X ClientCanvas /new TextItem send
X 10 75 260 0 /reshape 5 index send def
X
X /message_item () () /Right
X nullproc
X ClientCanvas /new MessageItem send
X 10 45 240 0 /reshape 5 index send def
X
X /ok_button (Put)
X [ self /do_edit exch /send cvx ] cvx
X ClientCanvas /new ButtonItem send
X dup /ItemFrame 1 put
X dup /ItemRadius 0.2 put
X 80 10 60 15 /reshape 5 index send def
X
X /null_button (Null)
X [ self /do_null exch /send cvx ] cvx
X ClientCanvas /new ButtonItem send
X dup /ItemFrame 1 put
X dup /ItemRadius 0.2 put
X 150 10 60 15 /reshape 5 index send def
X
X end def
X EditItems forkitems pop
X map
X } def
X
X /do_edit {
X {
X {
X clear
X NewValue cvx exec
X EditObject EditKey 3 2 roll put
X } do_proc
X } fork waitprocess pop
X } def
X
X /do_null {
X { EditObject EditKey null put } do_proc
X } def
X
X /destroy {
X /EditItems null def
X /destroy super send
X } def
X
Xclassend def
X
X/ZapScrollWindow ScrollWindow []
Xclassbegin
X /CreateFrameControls { % - => -
X /CreateFrameControls super send
X gsave
X FrameCanvas setcanvas
X /ZapControl FrameCanvas newcanvas dup begin
X /Mapped true def
X /EventsConsumed /AllEvents def
X end def
X 0 0 BorderTop BorderRight rectpath ZapControl reshapecanvas
X grestore
X } def % CreateFrameControls
X
X /CreateFrameInterests { % - => -
X /CreateFrameInterests super send
X FrameInterests begin
X /FrameZapEvent
X PointButton /destroy
X DownTransition ZapControl eventmgrinterest def
X end
X } def % CreateFrameInterests
X
X /MoveFrameControls { % - => -
X /MoveFrameControls super send
X gsave
X ZapControl setcanvas
X FrameWidth BorderRight sub
X FrameHeight BorderTop sub movecanvas
X grestore
X } def % MoveFrameControls
X
X /PaintFrameControls { % - => -
X /PaintFrameControls super send
X gsave
X ZapControl setcanvas 2 4 moveto /panel_check_off showicon
X grestore
X } def % PaintFrameControls
X
Xclassend def
X
X/ScrollingWidget ZapScrollWindow [
X /EventMgr
X /Contents
X /ContentsCanvas
X /Lines
X /VisibleLines
X /StartLine
X /StartCol
X]
Xclassbegin
X /LMargin 3 def
X /TextFont /Times-Roman findfont 14 scalefont def
X
X /new { % label contents parent => instance
X /new super send begin
X /Contents exch def
X /FrameLabel exch def
X /Lines Contents length def
X /StartLine 0 def
X /VisibleLines 0 def
X currentdict
X end
X } def
X
X /autoshape { % x y =>
X 200
X Lines 40 min TextFont fontheight mul
X BorderTop add BorderBottom add LMargin add reshape
X } def
X
X /createscrollbars { % - => - (Create scrollbar canvases/items)
X /HScrollbar
X [0 1 .01 .1 null] 0
X [ /ItemValue cvx self /pan exch /send cvx ] cvx
X FrameCanvas /new SimpleScrollbar send
X dup /BarVertical? false put
X def
X /VScrollbar
X [1 0 .01 .1 null] 0
X [ /ItemValue cvx self /scroll exch /send cvx ] cvx
X FrameCanvas /new SimpleScrollbar send
X def
X } def
X
X /PaintClient { % - => -
X ClientCanvas setcanvas
X 1 fillcanvas 0 setgray
X TextFont setfont
X /VisibleLines ClientHeight currentfont fontheight div round def
X LMargin ClientHeight currentfont fontheight sub moveto
X StartLine 1 StartLine VisibleLines add Contents length 1 sub min {
X ShowLine
X LMargin currentpoint exch pop moveto
X 0 currentfont fontheight neg rmoveto
X } for
X } def
X
X /ShowLine {
X Contents exch get
X cvstring show
X } def
X
X /scroll { % lineno =>
X Lines mul
X /StartLine exch floor def
X PaintClient
X } def
X
X /pan {
X /StartCol exch def
X PaintClient
X } def
X
X /YValueToLine { % event => lineno true, or false
X ClientCanvas setcanvas
X /YLocation get
X ClientHeight exch sub
X TextFont fontheight div floor StartLine add
X dup dup 0 ge exch Lines lt and
X dup not { exch pop } if
X } def
X
X /pointbutton { % event => -
X YValueToLine {
X select
X } if
X } def
X
X /adjustbutton { % event => -
X YValueToLine {
X Contents exch start_editor
X } if
X } def
X
X /select { % lineno => -
X SubClassResponsibility!
X } def
X
X /map {
X /map super send
X /EventMgr [
X PointButton [ self /pointbutton exch /send cvx ] cvx
X DownTransition ClientCanvas eventmgrinterest
X AdjustButton [ self /adjustbutton exch /send cvx ] cvx
X DownTransition ClientCanvas eventmgrinterest
X ] forkeventmgr def
X } def
X
X /destroy {
X EventMgr null ne { EventMgr killprocess /EventMgr null def } if
X { /NotifyUser null def } HScrollbar send
X { /NotifyUser null def } VScrollbar send
X /ClientMenu null def
X /destroy super send
X } def
X
Xclassend def
X
X/Browser ScrollingWidget []
Xclassbegin
X /TextFont /Times-Roman findfont 14 scalefont def
X
X /new { % array parent => instance
X /new super send begin
X /ClientMenu [
X menuitems
X ] /new DefaultMenu send def
X currentdict
X end
X } def
X
X /select { % lineno => -
X SubClassResponsibility!
X } def
X
X /browse { % label object =>
X FrameX 30 add FrameY 30 add 4 2 roll ParentCanvas start_browser
X } def
X
X /menuitems {
X (Zap) [ self /destroy exch /send cvx ] cvx
X } def
X
X /start_editor { % object key =>
X {
X newprocessgroup
X framebuffer /new EditWindow send
X /gettopleft 1 index send
X /activate exch send
X } fork pop pop pop
X } def
X
Xclassend def
X
X/ArrayBrowser Browser []
Xclassbegin
X /select { % lineno => -
X Contents exch get dup cvstring exch browse
X } def
Xclassend def
X
X/DictBrowser Browser [
X /BrowserObject
X]
Xclassbegin
X /new {
X exch dup dictkeys exch 4 1 roll exch
X /new super send begin
X /BrowserObject exch def
X currentdict
X end
X } def
X
X /adjustbutton { % event => -
X YValueToLine {
X BrowserObject Contents 3 2 roll get start_editor
X } if
X } def
X
X /ShowLine {
X ClientWidth 2 div 0 rmoveto currentpoint
X Contents 3 index get
X cvstring rshow
X moveto
X ( : ) show
X Contents exch get
X BrowserObject exch get %cvlit
X cvstring show
X } def
X
X /select { % lineno => -
X Contents exch get dup cvstring exch
X BrowserObject exch get browse
X } def
X
X /do_proc { % proc =>
X BrowserObject exch load errored pop
X pause PaintClient
X } def
X
Xclassend def
X
X/FontBrowser DictBrowser
Xdictbegin
X /FontView false def
Xdictend
Xclassbegin
X /PaintClient { % - => -
X FontView {
X ClientCanvas setcanvas
X 1 fillcanvas 0 setgray
X BrowserObject setfont
X /VisibleLines ClientHeight currentfont fontheight div round def
X LMargin ClientHeight currentfont fontheight sub moveto
X StartLine 1 StartLine VisibleLines add Contents length 1 sub min {
X [
X 0 1 16 { dup 2 add index 16 mul add } for
X ] cvas show
X pop
X LMargin currentpoint exch pop moveto
X 0 currentfont fontheight neg rmoveto
X } for
X } {
X /PaintClient super send
X } ifelse
X } def
X
X /menuitems {
X (Font) [ true self /set_view exch /send cvx ] cvx
X (Dictionary) [ false self /set_view exch /send cvx ] cvx
X /menuitems super send
X } def
X
X /set_view { % bool =>
X /FontView exch def
X PaintClient
X } def
X
X /pointbutton { % - => -
X FontView not { /pointbutton super send } if
X } def
X
X /adjustbutton { % - => -
X FontView not { /adjustbutton super send } if
X } def
X
Xclassend def
X
X/ProcessBrowser DictBrowser []
Xclassbegin
X /menuitems {
X (Kill) [ /killprocess self /do_proc exch /send cvx ] cvx
X (Kill Group) [ /killprocessgroup self /do_proc exch /send cvx ] cvx
X (Suspend) [ /suspendprocess self /do_proc exch /send cvx ] cvx
X (Continue) [ /continueprocess self /do_proc exch /send cvx ] cvx
X /menuitems super send
X } def
Xclassend def
X
X/EventBrowser DictBrowser []
Xclassbegin
X /menuitems {
X (Revoke Interest) [ /revokeinterest self /do_proc exch /send cvx ] cvx
X /menuitems super send
X } def
Xclassend def
X
X/CanvasBrowser DictBrowser []
Xclassbegin
X /menuitems {
X (Top) [ /canvastotop self /do_proc exch /send cvx ] cvx
X (Bottom) [ /canvastobottom self /do_proc exch /send cvx ] cvx
X (Map) [ /mapcanvas self /do_proc exch /send cvx ] cvx
X (Unmap) [ /unmapcanvas self /do_proc exch /send cvx ] cvx
X /menuitems super send
X } def
Xclassend def
X
X/cvstring { % value => string
X dup type /stringtype eq {
X ((%)) sprintf
X } {
X dup type /nametype eq 1 index xcheck not and {
X (/%) sprintf
X } {
X 100 string cvs
X } ifelse
X } ifelse
X} def
X
X% This function sorts an array into alphabetic order, and should be used
X% for ordering dictionary keys so you can find them. Unfortunately, it is too
X% slow to be of much use. Anyone fancy writing a fast sort in PostScript?
X/sortarray { % array => array
X dup
X 4 dict begin
X /a exch def
X 0 1 a length 1 sub {
X /i exch def
X /ai a i get cvstring def
X 0 1 i 1 sub {
X /j exch def
X ai a j get cvstring lt {
X a i get a j get
X a i 3 2 roll put
X a j 3 2 roll put
X } if
X } for
X } for
X end
X} def
X
X/dictkeys { % dict => [keys]
X [ exch
X { pop } forall
X ]
X % comment out the next line to stop sorting dictionaries
X dup length 40 le { sortarray } if
X} def
X
X/BrowserDict 10 dict dup begin
X /dicttype { DictBrowser } def
X /arraytype { ArrayBrowser } def
X /canvastype { CanvasBrowser } def
X /fonttype { FontBrowser } def
X /processtype { ProcessBrowser } def
X /eventtype { EventBrowser } def
Xend def
X
X/start_browser { % x y label object parent =>
X exch cvlit
X BrowserDict 1 index type known {
X {
X newprocessgroup
X exch /new BrowserDict 3 index type get exec send
X 3 1 roll
X /autoshape 3 index send
X /map exch send
X } fork pop
X } if
X 5 {pop} repeat
X} def
X
X% The following pops up a browser onto systemdict:
X%
X% 0 0 (systemdict) systemdict framebuffer start_browser
X
X% End of browser code.
END_OF_browser.ps
if test 13449 -ne `wc -c <browser.ps`; then
echo shar: \"browser.ps\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f error.ps -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"error.ps\"
else
echo shar: Extracting \"error.ps\" \(2579 characters\)
sed "s/^X//" >error.ps <<'END_OF_error.ps'
X%! /usr/NeWS/bin/psh
X
X% NeWS error handler using the object browser (NeWS1.1)
X%
X% Jeremy Huxtable
X%
X% Mon Jul 25 17:36:06 BST 1988
X
X% This file implements a NeWS error handler which allow you to actually
X% read your error messages before they shoot of the top of your terminal
X% emulator. When an error occurs, the error handler creates a dictionary
X% containing useful information about the error and the current process
X% and pops up a browser onto it.
X% Thus when you get an error, instead of 546 lines of fast-moving text,
X% you get a neat little window and can admire the error at your leisure.
X% As well as this, you can of course follow all the links in the dictionary
X% and find just where the error occurred. If you are lucky, you might be
X% able to break all the cyclic references to things and get rid of all
X% those dead windows that tend to pile up during protracted debugging
X% sessions.
X
X% Bugs and missing features:
X% - There should be an execution stack browser thet lets you
X% see the execution stack in full, with the current operator
X% in bold print or something.
X% - I can't get this to load if I put it in my "user.ps" - I
X% get an error executing "acceptconnection" (interrupted
X% system call)!.
X
Xsystemdict begin
X
X% Change this path name to your own:-
Xsystemdict /Browser known not { (ps/lib/browser.ps) run } if
X
X/MyErrorDict dictbegin
X StandardErrorNames { {MyErrorHandler} def } forall
Xdictend def
X
X/MyErrorHandler {
X % Must be careful with manipulating the stacks here, as otherwise
X % our private stuff will appear in the browser!
X /errordict OldErrorDict store
X pop % Get rid of the "offending command" from stack
X % create a dictionary of useful info. Note that we must get the
X % process' stacks now as otherwise they disappear when the "killprocess"
X % is done.
X currentprocess /DictionaryStack get
X 7 dict begin
X /DictionaryStack exch def
X currentprocess /OperandStack get /OperandStack exch def
X /ExecutionStack
X currentprocess /ExecutionStack get
X 0 1 index length 4 sub getinterval
X def % Remove this error handler from exec stack
X /Interests currentprocess /Interests get def
X /Error $error /errorname get def
X /Executing $error /command get def
X /Process currentprocess def
X currentdict
X end
X 50 600 (Error) 4 3 roll
X framebuffer start_browser
X /errordict MyErrorDict store
X currentprocess killprocess
X} def
X
X/OldErrorDict systemdict /errordict known {errordict} {null} ifelse def
X/errordict MyErrorDict def
X
Xend
X% End of error handler code.
END_OF_error.ps
if test 2579 -ne `wc -c <error.ps`; then
echo shar: \"error.ps\" unpacked with wrong size!
fi
# end of overwriting check
fi
echo shar: End of shell archive.
exit 0