%! /usr/NeWS/bin/psh % NeWS object browser and editor (NeWS1.1) % % Jeremy Huxtable % % Mon Jul 25 17:36:06 BST 1988 % This file implements a NeWS object browser and editor. A browser is % a window which may be popped up onto any array or dictionary and % lets you view and alter the contents. % Firstly, the ArrayBrowser: % % Viewing: % This displays an array in vertical form, the first element at % the top. A scrollbar is provided to let you look at all of % long arrays. Clicking the PointButton on an element % in the display will pop up a sub-browser onto that element, % provided that it is an array or dictionary. There is no point % having browsers for integers etc. % Editing: % Clicking the AdjustButton on an element will pop up an editing % window for that element. This is a window containing a text item % and two buttons. The first button, marked "Put", evaluates the % contents of the text item and replaces it in the array where you % originally clicked. When the browser is redisplayed, you will % see the change displayed. The second button, marked "Null", % is a short cut, and sets the element to null. This is useful when % you are trying to break cyclic reference chains. % % Next the DictBrowser: % % This is essentially the same as an ArrayBrowser, but displays % pairs of keys/values in no particular order. The mouse buttons % can be used in the same way as for the ArrayBrowser. % % The FontBrowser: % This has two views: a) as a dictionary, and b) as a font. % Switch between the two by selecting from the menu. % % The ProcessBrowser, CanvasBrowser, and EventBrowser: % % These are the same as DictBrowsers, but have menu options which % allow you to manupulate the object being browsed. You can kill, % suspend, or continue processes, map/unmap canvases or move them % to the top or bottom, and revoke interest in events. The last % of these is particularly interesting as all processes waiting % on the events will die with "invalidaccess" errors. Revoking % interest is the quickest way of zapping cyclic references. % BUGS: % - reference counting problems, browsers will not zap until their % children have been zapped. % - dictionary entries should be sorted. % - scrollbars don't work properly for FontBrowsers. % - should have different views of the same object, maybe combine % it with Don Hopkins' visualising window. % - the subclassing is bit messy and shows that this thing evolved. % It did only take an afternoon to write initially though. systemdict /Item known not { (NeWS/liteitem.ps) run } if /browser_icon 64 64 1 [1 0 0 1 0 0] < FFFFFFFFFFFFFFFF8000000000000001 80000000000000018000000000000001 800000000FF800018000000070070001 800000018FF8C0018000000230062001 8000000CC00198018000001300006401 80000024000012018000004800000901 8000005FFFFF0501800000A000010281 80000120000102418003FE4000010141 80020243F9F9012180020283F9F900A1 80020280000100A18002050000010051 80027D000001005180020577F3F10051 80020577F3F100518002050000010051 80027D00000100518002050000010051 80020500000100518002051CFDD90051 80027D9CFDD900A180020280000100A1 80020240000101218002014000010141 80027F27FEF90241800200B1FE790281 80020098000105018002004400010901 800271F200011201800203B900016401 8002073CC001980180020E7E38062001 80021CF987F8C001800239F870030001 800273F00FFC00018002E7E000040001 8001CFC7FF04000180039F8000040001 80073F0000040001800E7E0000040001 801CFCFCFC6400018039F80000040001 8073F0000004000180E7E00000040001 81EFC0000004000183FFFFFFFFFC0001 87FF0000000000018FFE000000000001 8FFC0000000000018FF8000000000001 87F000000000000183E0000000000001 81C00000000000018000000000000001 8000000000000001FFFFFFFFFFFFFFFF > buildimage def /FilterWindow DefaultWindow [ /FilterItems % Items in the window /FilterDict ] classbegin /FrameLabel (Filter) def /new { % filterdict => instance /new super send begin /FilterDict exch def /EditItems null def currentdict end } def /gettopleft { 320 440 fboverlay setcanvas getclick 2 index sub % Subtract height from y to select top left 4 2 roll reshape } def /PaintClient { FilterItems paintitems } def /activate { /FilterItems 20 dict dup begin 10 BrowserIconDict { pop dup 50 string cvs [/panel_check_on /panel_check_off] /Left [ 4 index self /do_item exch /send cvx ] cvx ClientCanvas /new CycleItem send 10 3 index 20 20 /reshape 5 index send def 20 add } forall pop end def FilterItems forkitems pop map } def /do_item { % type FilterDict exch 2 copy get not put } def /destroy { /FilterItems null def /destroy super send } def classend def /EditWindow DefaultWindow [ /EditItems % Items in the window /EditObject % Object being edited /EditKey % Key in object ] classbegin /FrameLabel (Object Editor) def /new { % object key => instance /new super send begin /EditKey exch cvlit def /EditObject exch cvlit def /EditItems null def /NewValue () def currentdict end } def /gettopleft { 320 140 fboverlay setcanvas getclick 2 index sub % Subtract height from y to select top left 4 2 roll reshape } def /PaintClient { EditItems paintitems } def /do_proc { % proc => errored { (Error: %) [$error /errorname get] /printf } { () /printstring } ifelse EditItems /message_item get send } def /set_value { /NewValue exch def } def /activate { /EditItems 6 dict dup begin /edit_string (Value:) EditObject EditKey get cvstring /Right [ /ItemValue cvx self /set_value exch /send cvx ] cvx ClientCanvas /new TextItem send 10 75 260 0 /reshape 5 index send def /message_item () () /Right nullproc ClientCanvas /new MessageItem send 10 45 240 0 /reshape 5 index send def /ok_button (Put) [ self /do_edit exch /send cvx ] cvx ClientCanvas /new ButtonItem send dup /ItemFrame 1 put dup /ItemRadius 0.2 put 80 10 60 15 /reshape 5 index send def /null_button (Null) [ self /do_null exch /send cvx ] cvx ClientCanvas /new ButtonItem send dup /ItemFrame 1 put dup /ItemRadius 0.2 put 150 10 60 15 /reshape 5 index send def end def EditItems forkitems pop map } def /do_edit { { { clear NewValue cvx exec EditObject EditKey 3 2 roll put } do_proc } fork waitprocess pop } def /do_null { { EditObject EditKey null put } do_proc } def /destroy { /EditItems null def /destroy super send } def classend def /ZapScrollWindow ScrollWindow [] classbegin % start of top panel stuff /PanelHeight 20 def /ShapeClientCanvas { % - => - ([Re]set client canvas' shape) ClientCanvas null ne { gsave /ClientHeight ClientHeight PanelHeight sub def FrameCanvas setcanvas BorderLeft BorderBottom translate 0 0 ClientWidth ClientHeight ClientPath ClientCanvas reshapecanvas grestore } if } def /PaintFrameBorder { % - => - (Paint frame border areas) FrameFillColor fillcanvas FrameBorderColor strokecanvas BorderLeft .5 sub BorderBottom .5 sub FrameWidth BorderLeft BorderRight add sub 1 add FrameHeight BorderBottom BorderTop add sub 1 add FramePath stroke BorderLeft .5 sub BorderBottom .5 sub FrameWidth BorderLeft BorderRight add sub 1 add FrameHeight BorderBottom BorderTop add sub 1 add PanelHeight sub FramePath stroke } def /shapescrollbars { % - => - (Shape scrollbar canvases/items) BorderLeft 1 sub 0 FrameWidth BorderRight sub BorderLeft sub 2 add BorderBottom /reshape HScrollbar send FrameWidth BorderRight sub BorderBottom 1 sub BorderRight FrameHeight BorderBottom sub BorderTop sub PanelHeight sub 2 add /reshape VScrollbar send } def % end of top panel stuff /CreateFrameControls { % - => - /CreateFrameControls super send gsave FrameCanvas setcanvas /ZapControl FrameCanvas newcanvas dup begin /Mapped true def /EventsConsumed /AllEvents def end def 0 0 BorderTop BorderRight rectpath ZapControl reshapecanvas grestore } def % CreateFrameControls /CreateFrameInterests { % - => - /CreateFrameInterests super send FrameInterests begin /FrameZapEvent PointButton /destroy DownTransition ZapControl eventmgrinterest def end } def % CreateFrameInterests /MoveFrameControls { % - => - /MoveFrameControls super send gsave ZapControl setcanvas FrameWidth BorderRight sub FrameHeight BorderTop sub movecanvas grestore } def % MoveFrameControls /PaintFrameControls { % - => - /PaintFrameControls super send gsave ZapControl setcanvas 2 4 moveto /panel_check_off showicon grestore } def % PaintFrameControls classend def /ScrollingWidget ZapScrollWindow [ /EventMgr /Contents /Lines /VisibleLines /StartLine /StartCol ] classbegin /LMargin 3 def /TextFont /Times-Roman findfont 14 scalefont def /ItemHeight TextFont fontheight 1.3 mul def /new { % label contents parent => instance /new super send begin /Contents exch def /FrameLabel exch def /Lines Contents length def /StartLine 0 def /StartCol 0 def /VisibleLines 0 def currentdict end } def /autoshape { % x y => 200 Lines 40 min ItemHeight mul BorderTop add BorderBottom add LMargin add reshape } def /createscrollbars { % - => - (Create scrollbar canvases/items) /HScrollbar [0 1 .01 .1 null] 0 [ /ItemValue cvx self /pan exch /send cvx ] cvx FrameCanvas /new SimpleScrollbar send dup /BarVertical? false put def /VScrollbar [1 0 .01 .1 null] 0 [ /ItemValue cvx self /scroll exch /send cvx ] cvx FrameCanvas /new SimpleScrollbar send def } def /PaintIcon { gsave 1 fillcanvas 0 setgray 64 64 scale true browser_icon imagemaskcanvas grestore } def /PaintClient { % - => - gsave ClientCanvas setcanvas 1 fillcanvas 0 setgray ClientWidth StartCol mul neg 0 translate TextFont setfont /VisibleLines ClientHeight ItemHeight div round def LMargin ClientHeight ItemHeight sub moveto StartLine 1 StartLine VisibleLines add Contents length 1 sub min { filter { ShowLine } { pop } ifelse LMargin currentpoint exch pop moveto 0 ItemHeight neg rmoveto } for grestore } def /ShowLine { Contents exch get dup showbrowsericon cvstring show } def /filter { dup Contents exch get type FilterDict exch get } def /scroll { % lineno => Lines mul /StartLine exch floor def PaintClient } def /pan { /StartCol exch def PaintClient } def /YValueToLine { % event => lineno true, or false ClientCanvas setcanvas /YLocation get ClientHeight exch sub ItemHeight div floor StartLine add dup dup 0 ge exch Lines lt and dup not { exch pop } if } def /pointbutton { % event => - YValueToLine { select } if } def /adjustbutton { % event => - YValueToLine { Contents exch start_editor } if } def /select { % lineno => - SubClassResponsibility! } def /map { /map super send activate } def /activate { EventMgr null eq { /EventMgr [ PointButton [ self /pointbutton exch /send cvx ] cvx DownTransition ClientCanvas eventmgrinterest AdjustButton [ self /adjustbutton exch /send cvx ] cvx DownTransition ClientCanvas eventmgrinterest ] forkeventmgr def } if } def /deactivate { EventMgr null ne { EventMgr killprocess /EventMgr null def } if } def /destroy { deactivate { /NotifyUser null def } HScrollbar send { /NotifyUser null def } VScrollbar send /ClientMenu null def /destroy super send } def classend def /Browser ScrollingWidget [ /FilterDict ] classbegin /new { % array parent => instance /new super send begin /FilterDict 20 dict def BrowserIconDict { pop FilterDict exch true put } forall /ClientMenu [ menuitems ] /new DefaultMenu send def currentdict end } def /select { % lineno => - SubClassResponsibility! } def /browse { % label object => FrameX 30 add FrameY 30 add 4 2 roll ParentCanvas start_browser } def /menuitems { (Filter) [ self /start_filter exch /send cvx ] cvx (Zap) [ self /destroy exch /send cvx ] cvx } def /start_editor { % object key => { newprocessgroup framebuffer setcanvas framebuffer /new EditWindow send /gettopleft 1 index send /activate exch send } fork pop pop pop } def /start_filter { { newprocessgroup framebuffer setcanvas FilterDict framebuffer /new FilterWindow send /gettopleft 1 index send /activate exch send } fork pop } def classend def /ArrayBrowser Browser [] classbegin /select { % lineno => - Contents exch get dup cvstring exch browse } def classend def /DictBrowser Browser [ /BrowserObject ] classbegin /new { exch dup dictkeys exch 4 1 roll exch /new super send begin /BrowserObject exch def currentdict end } def /filter { dup Contents exch get BrowserObject exch get type FilterDict exch get } def /adjustbutton { % event => - YValueToLine { BrowserObject Contents 3 2 roll get start_editor } if } def /ShowLine { ClientWidth 2 div 0 rmoveto currentpoint Contents 3 index get cvstring rshow moveto ( ) show Contents 1 index get showbrowsericon (: ) show Contents exch get BrowserObject exch get %cvlit 4 0 rmoveto dup showbrowsericon cvstring show } def /select { % lineno => - Contents exch get dup cvstring exch BrowserObject exch get browse } def /do_proc { % proc => BrowserObject exch load errored pop pause PaintClient } def classend def /FontBrowser DictBrowser dictbegin /FontView false def dictend classbegin /PaintClient { % - => - FontView { ClientCanvas setcanvas 1 fillcanvas 0 setgray BrowserObject setfont /VisibleLines ClientHeight ItemHeight div round def LMargin ClientHeight ItemHeight sub moveto StartLine 1 StartLine VisibleLines add Contents length 1 sub min { [ 0 1 16 { dup 2 add index 16 mul add } for ] cvas show pop LMargin currentpoint exch pop moveto 0 ItemHeight neg rmoveto } for } { /PaintClient super send } ifelse } def /menuitems { (Font) [ true self /set_view exch /send cvx ] cvx (Dictionary) [ false self /set_view exch /send cvx ] cvx /menuitems super send } def /set_view { % bool => /FontView exch def FontView {deactivate} {activate} ifelse PaintClient } def classend def /ProcessBrowser DictBrowser [] classbegin /menuitems { (Kill) [ /killprocess self /do_proc exch /send cvx ] cvx (Kill Group) [ /killprocessgroup self /do_proc exch /send cvx ] cvx (Suspend) [ /suspendprocess self /do_proc exch /send cvx ] cvx (Continue) [ /continueprocess self /do_proc exch /send cvx ] cvx /menuitems super send } def classend def /EventBrowser DictBrowser [] classbegin /menuitems { (Revoke Interest) [ /revokeinterest self /do_proc exch /send cvx ] cvx /menuitems super send } def classend def /CanvasBrowser DictBrowser [] classbegin /menuitems { (Top) [ /canvastotop self /do_proc exch /send cvx ] cvx (Bottom) [ /canvastobottom self /do_proc exch /send cvx ] cvx (Map) [ /mapcanvas self /do_proc exch /send cvx ] cvx (Unmap) [ /unmapcanvas self /do_proc exch /send cvx ] cvx /menuitems super send } def classend def /cvstring { % value => string dup type /stringtype eq { ((%)) sprintf } { dup type /nametype eq 1 index xcheck not and { (/%) sprintf } { 100 string cvs } ifelse } ifelse } def % This function sorts an array into alphabetic order, and should be used % for ordering dictionary keys so you can find them. Unfortunately, it is too % slow to be of much use. Anyone fancy writing a fast sort in PostScript? /sortarray { % array => array dup 4 dict begin /a exch def 0 1 a length 1 sub { /i exch def /ai a i get cvstring def 0 1 i 1 sub { /j exch def ai a j get cvstring lt { a i get a j get a i 3 2 roll put a j 3 2 roll put } if } for } for end } def % There are two versions of "dictkeys" here. One just puts the keys in the % dictionary hashing order and is the fastest (it sorts alphabetically as % well for small dictinaries). The other sorts by object type and is a bit % slower. Simply comment out the one you don't want. %/dictkeys { % dict => [keys] % [ exch % { pop } forall % ] % % comment out the next line to stop sorting dictionaries % dup length 40 le { sortarray } if %} def /dictkeys { % dict => [keys] (sorts by object type) [ exch BrowserIconDict { pop % dict type 1 index { % dict type key value type 2 index eq { % dict type key eq 3 1 roll } { pop } ifelse } forall pop } forall pop ] } def /BrowserDict 10 dict dup begin /dicttype { DictBrowser } def /arraytype { ArrayBrowser } def /canvastype { CanvasBrowser } def /fonttype { FontBrowser } def /processtype { ProcessBrowser } def /eventtype { EventBrowser } def end def /BrowserIconDict 20 dict dup begin /dicttype <3FE04020FFA080A0B8A080A0BEA080A0B0A080A0B6A080A0B8A080A080C0FF80> def /canvastype <0400FFE08020802082209520AAA09F208020FFE0208020803F80404040404040> def /fonttype <00007FE0FFE08060BF60BF60AD608C608C608C608C608C608C609E608060FFC0> def /processtype def /eventtype <000000000000FFE0C060A0A091208E209520A0A0C060FFE00000000000000000> def /realtype <5540000080200000802031808A200400842004008A2031808020000080205540> def /stringtype <63C0102070209020782008208E208920890089008E0080E08100810081007CE0> def /proctype <7FC0802088209020B3A090208BA080208020BA208120B9A08120822080207FC0> def /arraytype def /filetype def /integertype <5540000080200000802036009920110091201100BBA000008020000080205540> def /booleantype def /nametype <32004C00200040005E00210059005080408020402040102010600B800C000000> def /nulltype <0000000004004440248011000000E0E000001100248044400400000000000000> def /monitortype <000000001F002080208020807FC040404040444044404440444040407FC00000> def /operatortype <000000001FE0206040A0FF208120812081208120812081408180FF0000000000> def /graphicsstate <000000008000840084008A008A008A20924091409080A000C0008000FFE00000> def /shapetype <1C0022004200420022C0132010202020472048A04440420022001C0000000000> def /colortype <000000000E001100208020803B8055408E208A208A2044403B80000000000000> def end def /browsertype { % object => type dup type dup /arraytype eq { pop xcheck { /proctype } { /arraytype } ifelse } { exch pop } ifelse } def /showbrowsericon { % object browsertype BrowserIconDict 1 index known { BrowserIconDict exch get matrix currentmatrix exch currentpoint currentfont fontdescent sub translate 16 16 scale 16 16 true [1 0 0 1 0 0] 5 -1 roll imagemask setmatrix } { pop } ifelse 16 0 rmoveto } def /start_browser { % x y label object parent => exch cvlit BrowserDict 1 index type known { { countdictstack 2 sub { end } repeat framebuffer setcanvas newprocessgroup exch /new BrowserDict 3 index type get exec send 3 1 roll /autoshape 3 index send /map exch send } fork pop } if 5 {pop} repeat } def % The following pops up a browser onto systemdict: % 0 0 (systemdict) systemdict framebuffer start_browser % End of browser code.