Self and NeWS
Ian Wilkinson
iw at canon.co.uk
Fri May 7 00:30:52 UTC 1993
As an alternative to X, perhaps the use of NeWS
with PostScript imaging might be a fun choice.
Sometime ago I built a foreign interface to NeWS,
including support for Jot, the NeWS Toolkit text
editor.
The following shar file includes the necessary support;
it also includes participant.self and synthetics.self
as possible idioms for building applications. (I should
mention participant.self and synthetics.self are
incomplete; they belong to a project that is still happening.)
I would be interested in any experiences you may have
with this stuff.
ian
#! /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: SelfNews SelfNews/Makefile SelfNews/fabrication.self
# SelfNews/jotI.self SelfNews/participant.self
# SelfNews/synthetics.self SelfNews/tEdit.self SelfNews/wireI.C
# SelfNews/wireI.self SelfNews/wireIPS.cps
# Wrapped by iw at isolde on Fri May 7 00:15:49 1993
PATH=/bin:/usr/bin:/usr/ucb ; export PATH
if test ! -d SelfNews ; then
echo shar: Creating directory \"SelfNews\"
mkdir SelfNews
fi
if test -f SelfNews/Makefile -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"SelfNews/Makefile\"
else
echo shar: Extracting \"SelfNews/Makefile\" \(1120 characters\)
sed "s/^X//" >SelfNews/Makefile <<'END_OF_SelfNews/Makefile'
X# Makefile for wireI
X# created by Ian Wilkinson on Sat Sep 12 23:08:54 1992
X#
X# Makefile...
X# Borrows from that in self/applications/serverDemo.
X#
X# Copyright (c) Canon Research Centre Europe, 1992.
X# All rights reserved.
X
XOPENWINHOME:sh = echo ${OPENWINHOME:-/usr/openwin}
XROOTDIR = ${SELF_BASELINE_DIR}
XWI_LIBPATH = -L$(OPENWINHOME)/lib
XWI_LIBS = -ljot -lwire -lcps
XINCLUDES = -I${ROOTDIR}/sun4/optimized -I${ROOTDIR}/glueDefs \
X -I$(OPENWINHOME)/include
XCDEFS = wireIPS.h
X%.h: %.cps
X cps $<
X
Xapp: $(CDEFS) wireI.so
X
X# Static constructors in the dynamic library is NOT working
XwireI.so: wireI.o
X @echo Linking $@
X @ld -o $@ $? $(WI_LIBPATH) $(WI_LIBS)
X
XwireI.o: wireI.C
X @echo Compiling wireI.C
X @${COMPILE.gnu.o} -o $@ $?
X
Xclean:
X -rm wireI.so wireI.o wireIPS.h
X
X# The following includes contain information about the current
X# installed g++ compiler, g++ options, and g++ include directories.
Xinclude ${ROOTDIR}/MakefileSun4Template
Xinclude ${ROOTDIR}/MakefileOptimizeTemplate
Xinclude ${ROOTDIR}/MakefileCompileTemplate
Xinclude ${ROOTDIR}/MakefileFTPTemplate
Xinclude ${ROOTDIR}/MakefilePublishTemplate
X
X
END_OF_SelfNews/Makefile
if test 1120 -ne `wc -c <SelfNews/Makefile`; then
echo shar: \"SelfNews/Makefile\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f SelfNews/fabrication.self -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"SelfNews/fabrication.self\"
else
echo shar: Extracting \"SelfNews/fabrication.self\" \(3020 characters\)
sed "s/^X//" >SelfNews/fabrication.self <<'END_OF_SelfNews/fabrication.self'
X" File fabrication.self
X created by Ian Wilkinson on Thu Sep 17 14:32:47 1992
X
X Copyright (c) Canon Research Centre Europe, 1992.
X All rights reserved."
X
Xtraits applications visualiser _AddSlotsIfAbsent: ( | ^ fabrication = () | )
Xtraits fabrication _Define: ( |
X _ parent* = traits clonable.
X
X ^ construction = (
X representationObject: postScriptMachine fashionReprObject.
X postScriptMachine sendPS: appearance.
X representationBehaviour: postScriptMachine fashionAspects: aspects.
X postScriptMachine sendPS: (representationObject printString,
X ' ', representationBehaviour printString, ' ', instantiate) asString
X ).
X
X ^ affect: action = (
X postScriptMachine affect: representationObject With: action
X ).
X
X ^ behaviourFor: obj On: evt Is: action = (
X postScriptMachine behaviourFor: obj
X WithReprObj: representationObject
X On: (representationBehaviour + evt) - 1
X Is: action
X )
X| )
X
Xprototypes visualiser _AddSlotsIfAbsent: ( | ^ fabrication = () | )
Xfabrication _Define: ( |
X ^ parent* <- traits fabrication.
X
X ^ representationObject.
X ^_ representationBehaviour.
X ^ aspects <- 0.
X ^ appearance <- ''.
X ^ instantiate <- ''
X| )
X
Xtraits applications visualiser _AddSlotsIfAbsent: ( | ^ fabricateTEdit = () | )
Xtraits fabricateTEdit _Define: ( |
X _ parent* = traits clonable.
X
X ^ on: tEditView Media: w = ( copy initialize: tEditView Media: w ).
X
X _ initialize: tEditView Media: w = (
X media: w.
X accessibleMedia: postScriptMachine fashionReprObject.
X representationObject: tEditView.
X media send: ('
X currentfile ', accessibleMedia printString,
X ' shareddict /MessageMachine get setfileinputtoken ',
X representationObject printString, ' getfileinputtoken
X ') asString.
X objectBehaviour: dictionary copyRemoveAll.
X self
X ).
X
X ^ construction = (
X listener: (process copySend:
X message copy receiver: self Selector: 'mediaTalk') resume
X ).
X
X ^ mediaTalk = ( | postScriptInput |
X postScriptInput:
X unixFile copyFd: media fileDescriptor Name: 'media'.
X [
X postScriptInput suspend.
X media messageOnWire ifTrue: [ messageTarget ].
X process this yield
X ] loop
X ).
X
X _ messageTarget = ( | tg |
X [
X tg: media peekTag.
X (tg < 0) ifTrue: [ warning: 'Media difficulty in tEdit.' ].
X (tg = 0)
X ifTrue: [ "" ]
X False: [
X (objectBehaviour includesKey: tg)
X ifTrue: [ (objectBehaviour at: tg) send ]
X False: [ media readTag ]
X ]
X ] untilFalse: [ media messageOnWire ]
X ).
X
X ^ behaviourFor: obj On: evt Is: action = (
X objectBehaviour at: evt Put: message copy receiver: obj Selector: action
X )
X| )
X
Xprototypes visualiser _AddSlotsIfAbsent: ( | ^ fabricateTEdit = () | )
XfabricateTEdit _Define: ( |
X ^ parent* <- traits fabricateTEdit.
X
X ^ representationObject.
X ^_ representationBehaviour.
X ^ aspects <- 0.
X ^ appearance <- ''.
X ^ instantiate <- ''.
X ^ media.
X ^ accessibleMedia.
X "_" listener.
X _ objectBehaviour
X| )
X
END_OF_SelfNews/fabrication.self
if test 3020 -ne `wc -c <SelfNews/fabrication.self`; then
echo shar: \"SelfNews/fabrication.self\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f SelfNews/jotI.self -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"SelfNews/jotI.self\"
else
echo shar: Extracting \"SelfNews/jotI.self\" \(6282 characters\)
sed "s/^X//" >SelfNews/jotI.self <<'END_OF_SelfNews/jotI.self'
X"File jotI.self
X created by Ian Wilkinson on Mon Oct 12 18:16:07 1992
X
X Copyright (c) Canon Research Centre Europe, 1992.
X All rights reserved."
X
Xprototypes system _AddSlotsIfAbsent: ( | ^ jotFct = () | )
X
X(jotFct _Define: foreignFct copyName: 'newJotTextGlue'
X Path: (unix environmentVariable: 'SELF_NEWS'), '/wireI.so')
X
Xtraits system _AddSlotsIfAbsent: ( | ^ jotI = () | )
Xtraits jotI _Define: ( |
X _ parent* = traits clonable.
X
X ^ initialize: w = (
X | ignore = jotFct copyName: 'jotInitializeGlue' |
X ignore value: w
X )
X| )
X
Xprototypes system _AddSlotsIfAbsent: ( | ^ jotI = () | )
XjotI _Define: ( |
X _ parent* = traits jotI.
X _ thisObjectPrints = true.
X
X ^ printString = 'a jotInterface'.
X| )
X
Xtraits system _AddSlotsIfAbsent: ( | ^ jotView = () | )
Xtraits jotView _Define: ( |
X _ parent* = traits proxy.
X
X ^ newViewFor: jotT On: w = ( | jotRsrcMaker = jotFct copyName: 'newJotViewGlue' |
X jotI initialize: w.
X (jotRsrcMaker value: jotT
X With: true
X With: w
X With: deadCopy)
X discoverBehaviour
X ).
X
X ^ canvas = (
X | jotRsrcMaker = jotFct copyName: 'jotViewCanvasGlue' |
X jotRsrcMaker value: self
X ).
X
X ^ discoverBehaviour = ( | jotViewInspect. bv. nBytes = typeSizes byteSize: 'int' |
X jotViewInspect: jotFct copyName: 'jotViewAspectsGlue'.
X aspects: jotViewInspect value: self.
X jotViewInspect: jotFct copyName: 'jotViewBehaviourGlue'.
X bv: byteVector copySize: nBytes * aspects.
X jotViewInspect value: self With: bv.
X behaviour: behaviour copySize: aspects FillingWith: 0.
X 0 to: bv size - nBytes By: nBytes Do: [ | :i |
X behaviour at: i / nBytes
X Put: (bv cIntSize: (typeSizes bitSize: 'int')
X Signed: true
X At: i)
X ].
X self
X ).
X
X ^ respond = ( | responder |
X responder: jotFct copyName: 'jotViewRespondGlue'.
X responder value: self
X ).
X
X ^ update: w = (
X (jotFct copyName: 'jotViewUpdateGlue') value: w With: self.
X self
X ).
X
X ^ setReadOnly: isProtected = (
X (jotFct copyName: 'jotViewSetReadOnlyGlue') value: isProtected With: self
X )
X| )
X
Xprototypes system _AddSlotsIfAbsent: ( | ^ jotView = () | )
XjotView _Define: proxy deadCopy _AddSlots: ( |
X _ parent* = traits jotView.
X
X ^_ aspects.
X ^_ behaviour <- vector
X| )
X
Xtraits system _AddSlotsIfAbsent: ( | ^ jotText = () | )
Xtraits jotText _Define: ( |
X _ parent* = traits proxy.
X
X ^ newText: initialSz = (
X | jotRsrcMaker = jotFct copyName: 'newJotTextGlue' |
X jotRsrcMaker value: initialSz With: deadCopy
X ).
X
X ^ placeAtEnd: text = (
X (jotFct copyName: 'placeAtEndGlue') value: text With: self
X ).
X
X ^ size = (
X (jotFct copyName: 'sizeGlue') value: self
X ).
X
X ^ contentsInto: s = (
X (jotFct copyName: 'contentsIntoGlue') value: s With: self
X )
X| )
X
Xprototypes system _AddSlotsIfAbsent: ( | ^ jotText = () | )
XjotText _Define: proxy deadCopy _AddSlots: ( |
X _ parent* = traits jotText.
X| )
X
Xtraits system _AddSlotsIfAbsent: ( | ^ jotRuler = () | )
Xtraits jotRuler _Define: ( |
X _ parent* = traits proxy.
X
X ^ newRuler = ( (jotFct copyName: 'newJotRulerGlue') value: deadCopy ).
X
X ^ initialiseFontFor: text In: view = (
X (jotFct copyName: 'jotFontInitializeGlue') value: self
X With: view
X With: text
X ).
X
X ^ firstIndent: fi = (
X (jotFct copyName: 'jotRulerSetParameterGlue')
X value: self With: jotFirstIndent With: fi.
X self
X ).
X ^ leftIndent: li = (
X (jotFct copyName: 'jotRulerSetParameterGlue')
X value: self With: jotLeftIndent With: li.
X self
X ).
X ^ rightIndent: ri = (
X (jotFct copyName: 'jotRulerSetParameterGlue')
X value: self With: jotRightIndent With: ri.
X self
X ).
X ^ spaceBefore: sb = (
X (jotFct copyName: 'jotRulerSetParameterGlue')
X value: self With: jotSpaceBefore With: fi.
X self
X ).
X ^ spaceAfter: sa = (
X (jotFct copyName: 'jotRulerSetParameterGlue')
X value: self With: jotSpaceAfter With: fi.
X self
X ).
X ^ lineSpacing: ls = (
X (jotFct copyName: 'jotRulerSetParameterGlue')
X value: self With: jotLineSpacing With: fi.
X self
X ).
X ^ tabStops: ts = (
X (jotFct copyName: 'jotRulerSetParameterGlue')
X value: self With: jotTabStops With: fi.
X self
X ).
X ^ font: fontName = (
X (jotFct copyName: 'jotRulerSetFontGlue')
X value: self With: fontName.
X self
X ).
X ^ bold: isOn = (
X (jotFct copyName: 'jotRulerSetParameterGlue')
X value: self With: jotBold With: isOn.
X self
X ).
X ^ italic: isOn = (
X (jotFct copyName: 'jotRulerSetParameterGlue')
X value: self With: jotItalic With: isOn.
X self
X ).
X ^ underline: isOn = (
X (jotFct copyName: 'jotRulerSetParameterGlue')
X value: self With: jotUnderline With: isOn.
X self
X ).
X ^ strike: st = (
X (jotFct copyName: 'jotRulerSetParameterGlue')
X value: self With: jotStrikethru With: st.
X self
X ).
X ^ fontSize: fs = (
X (jotFct copyName: 'jotRulerSetParameterGlue')
X value: self With: jotFontSize With: fs.
X self
X ).
X ^ baselineOffset: bo = (
X (jotFct copyName: 'jotRulerSetParameterGlue')
X value: self With: jotBaselineOffset With: bo.
X self
X ).
X ^ fgColor: fg = (
X (jotFct copyName: 'jotRulerSetParameterGlue')
X value: self With: jotFgColor With: fg.
X self
X ).
X ^ bgColor: bg = (
X (jotFct copyName: 'jotRulerSetParameterGlue')
X value: self With: jotBgColor With: bg.
X self
X ).
X ^ rulerName: rn = (
X (jotFct copyName: 'jotRulerSetRulerNameGlue')
X value: self With: rn.
X self
X ).
X
X ^ parameters* = ( |
X ^ jotLineStyle = 0.
X ^ jotFirstIndent = 1.
X ^ jotLeftIndent = 2.
X ^ jotRightIndent = 3.
X ^ jotSpaceBefore = 4.
X ^ jotSpaceAfter = 5.
X ^ jotLineSpacing = 6.
X ^ jotTabStops = 7.
X ^ jotFont = 8.
X ^ jotBold = 9.
X ^ jotItalic = 10.
X ^ jotUnderline = 11.
X ^ jotStrikethru = 12.
X ^ jotFontSize = 13.
X ^ jotBaselineOffset = 14.
X ^ jotFgColor = 15.
X ^ jotBgColor = 16.
X ^ jotRulerName = 18
X | ).
X
X ^ lineStyles* = ( |
X ^ justify = 200.
X ^ leftAlign = 201.
X ^ rightAlign = 202.
X ^ center = 203.
X ^ characterWrap = 204.
X ^ characterClip = 205
X | ).
X
X ^ strikethru* = ( |
X ^ off = 0.
X ^ on = 1.
X ^ invert = 2
X | )
X| )
X
Xprototypes system _AddSlotsIfAbsent: ( | ^ jotRuler = () | )
XjotRuler _Define: proxy deadCopy _AddSlots: ( |
X _ parent* = traits jotRuler
X| )
END_OF_SelfNews/jotI.self
if test 6282 -ne `wc -c <SelfNews/jotI.self`; then
echo shar: \"SelfNews/jotI.self\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f SelfNews/participant.self -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"SelfNews/participant.self\"
else
echo shar: Extracting \"SelfNews/participant.self\" \(2004 characters\)
sed "s/^X//" >SelfNews/participant.self <<'END_OF_SelfNews/participant.self'
X "File participant.self
X created by Ian Wilkinson on Wed Sep 9 12:24:06 1992
X
X Copyright (c) Canon Research Centre Europe, 1992.
X All rights reserved."
X
Xtraits applications visualiser _AddSlotsIfAbsent: ( | ^ participant = () | )
Xtraits participant _Define: ( |
X _ parent* = traits clonable.
X
X ^ synthesizeWithoutInteraction = ( | instantiationPlan. myPicF. myPic |
X visualisation: visualisation copy.
X visualisation aspects: syntheticsWarehouse participant behaviour.
X
X myPicF: ((unix environmentVariable: 'CRE_APP_VISUALISER'),
X '/SelfEngineering/People/', profile nameSeenBySystem, '.rs') asString.
X myPic: ('(', myPicF, ') readcanvas ') asString.
X (unixFile exists: myPicF) ifFalse: [ myPic: ' null ' ].
X
X instantiationPlan: ('(', (profile name), ') (', profile nameSeenBySystem, ') (',
X (profile homeAddress), ') (', (profile loginShell), ') ', myPic) asString.
X visualisation instantiate: (instantiationPlan,
X syntheticsWarehouse participant instantiateWithoutInteraction) asString.
X visualisation construction.
X visualisation behaviourFor: observer On: 2 Is: 'newObserver'.
X visualisation affect: syntheticsWarehouse participant removeFromWorld.
X visualisation affect: syntheticsWarehouse participant trackMotion
X ).
X
X "_" synthesize = (
X visualisation: visualisation copy.
X
X visualisation aspects: syntheticsWarehouse participant behaviour.
X visualisation instantiate: syntheticsWarehouse participant instantiate.
X visualisation construction.
X illustrateName
X ).
X
X "_" illustrateName = (
X visualisation affect: ('(', name, ') ',
X syntheticsWarehouse participant named) asString.
X ).
X
X ^ changeOfName: n = (
X name: n.
X illustrateName.
X )
X| )
X
Xprototypes visualiser _AddSlotsIfAbsent: ( | ^ participant = () | )
Xparticipant _Define: ( |
X _ parent* = traits participant.
X _ thisObjectPrints = true.
X
X "^_" name.
X ^ profile.
X ^ location.
X ^ visualisation <- fabrication.
X ^ whereabouts <- ''.
X ^ printString = 'a participant'.
X| )
END_OF_SelfNews/participant.self
if test 2004 -ne `wc -c <SelfNews/participant.self`; then
echo shar: \"SelfNews/participant.self\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f SelfNews/synthetics.self -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"SelfNews/synthetics.self\"
else
echo shar: Extracting \"SelfNews/synthetics.self\" \(4061 characters\)
sed "s/^X//" >SelfNews/synthetics.self <<'END_OF_SelfNews/synthetics.self'
X "File synthetics.self
X created by Ian Wilkinson on Mon Sep 21 17:36:45 1992
X
X Copyright (c) Canon Research Centre Europe, 1992.
X All rights reserved."
X
Xoddballs userInterface _AddSlotsIfAbsent: ( | ^ syntheticsWarehouse = () | )
XsyntheticsWarehouse _Define: ( |
X _ parent* = traits oddball.
X
X ^ participant = ( |
X ^ behaviour = 2.
X ^ looks = (
X '/ClassParticipant [ ClassCanvas ClassGeneric ]
X dictbegin
X /name nullstring def
X /nameSeenBySystem nullstring def
X /homeAddress nullstring def
X /loginShell nullstring def
X /pic null def
X dictend
X classbegin
X /FillingInX 20 def
X /FillingInY 20 def
X /ParticipantHeight 25 def
X /PicW 64 def
X /PicH 64 def
X /NameFont /Helvetica findfont 14 scalefont def
X /NameFontH NameFont fontheight def
X
X /NewInit { % tk tgStart creationArgs => -
X /NewInit super send
X [
X /tk /tgStart
X /name /nameSeenBySystem /homeAddress /loginShell /pic
X ]
X [] methoddict
X begin
X 2 dict dup begin
X /QuitApp tgStart def
X /NewObserver tgStart 1 add def
X end tk /setwireclient self send
X NameFont /settextfont self send
X /installStdBehaviour self send
X end
X } def
X
X /installStdBehaviour { % - => -
X [] [ /theMenu ] methoddict
X begin
X /installStdBehaviour super send
X /theMenu /Grid framebuffer /new ClassMenu send store
X [
X [ (Quit) /removeFromWorld ]
X [ (Observe) /newObserver ]
X ] /setitemlist theMenu send
X self /settarget theMenu send
X theMenu /setmenu self send
X end
X } def
X
X /newObserver { % cntl => -
X [] /NewObserver self messageSelf
X } def
X
X /participantIsNamed { % name => -
X /name exch store
X gsave
X self setcanvas
X /textfont self send setfont
X /minsize [
X /bbox self send pop pop
X name stringwidth pop FillingInX add ParticipantHeight
X ] cvx /promote self send
X grestore
X } def
X
X /Paint { % - => -
X [] [ /x /y /w /h ] methoddict
X begin
X /bbox self send [ /x /y /w /h ] methodstacktodict
X x y w h false /Paint3DBox self send
X gsave
X ColorDict /Blue get setcolor
X /textfont self send setfont
X pic null eq {
X w 2 div h 2 div moveto
X name /CenterShow self send
X }{
X w 2 div h NameFontH sub 5 sub moveto
X name /CenterShow self send
X gsave
X w 2 div PicW 2 div sub
X h NameFontH sub PicH sub 10 sub translate
X 0 0 moveto
X PicW PicH scale
X pic imagecanvas
X grestore
X } ifelse
X grestore
X end
X } def
X
X /minsize { % - => width height
X gsave
X self setcanvas
X /textfont self send setfont
X name stringwidth pop FillingInX add
X pic null eq {
X ParticipantHeight
X }{
X PicW FillingInX add max
X PicH NameFontH add FillingInY add
X } ifelse
X grestore
X } def
X classend def
X '
X ).
X
X ^ instantiate = (
X 'framebuffer /new ClassParticipant send
X /place 1 index send
X /new ClassEventMgr send /activate 2 index send
X /map exch send
X '
X ).
X
X ^ instantiateWithoutInteraction = (
X 'framebuffer /new ClassParticipant send
X /place exch send
X '
X ).
X
X ^ customLooks* = ( |
X ^ removeFromWorld = ('
X /removeFromWorld {
X self /removeclient Parent send { pop } if
X /paint Parent send
X %[] /QuitApp self send
X %/destroy self send
X } /promote
X '
X ).
X
X ^ trackMotion = ('
X /TrackMotion { % evt => -
X /Coordinates get aload pop offsetX offsetY xysub
X /move self send
X self /client Parent send {
X gsave
X Parent setcanvas
X [ /location self send ]
X /SetLayoutData Parent send
X grestore
X } if
X } /promote
X '
X )
X | ).
X
X ^ named = (
X ' /participantIsNamed '.
X )
X | ).
X
X ^ engenderLooks = ( | mirr |
X mirr: reflect: self.
X mirr do: [ | :aSlot. mirrOnRep |
X (aSlot isMethod || aSlot isParent) not
X ifTrue: [
X mirrOnRep: reflect: aSlot key sendTo: self.
X (mirrOnRep includesName: 'looks')
X ifTrue: [
X postScriptMachine sendPS: (aSlot key sendTo: self) looks
X ]
X ]
X ]
X )
X| )
END_OF_SelfNews/synthetics.self
if test 4061 -ne `wc -c <SelfNews/synthetics.self`; then
echo shar: \"SelfNews/synthetics.self\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f SelfNews/tEdit.self -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"SelfNews/tEdit.self\"
else
echo shar: Extracting \"SelfNews/tEdit.self\" \(1458 characters\)
sed "s/^X//" >SelfNews/tEdit.self <<'END_OF_SelfNews/tEdit.self'
X "File tEdit.self
X created by Ian Wilkinson on Mon Oct 12 17:52:40 1992
X
X Copyright (c) Canon Research Centre Europe, 1992.
X All rights reserved."
X
Xtraits applications visualiser _AddSlotsIfAbsent: ( | ^ tEdit = () | )
Xtraits tEdit _Define: ( |
X _ parent* = traits clonable.
X
X ^ fashion = ( copy initialize ).
X ^ initialize = (
X jotW: wireI open loadPackages.
X jotI initialize: jotW.
X textHolder: jotText newText: initialSz.
X formatter: jotView newViewFor: textHolder On: jotW.
X ruler: jotRuler newRuler.
X ruler initialiseFontFor: textHolder In: formatter.
X self
X ).
X
X ^ setReadOnly: isProtected = ( formatter setReadOnly: isProtected ).
X
X ^ placeAtEnd: text = ( textHolder placeAtEnd: text ).
X
X ^ synthesizeWithoutInteraction = (
X visualisation: fabricateTEdit on: formatter canvas Media: jotW.
X formatter behaviour do: [ | :aspect |
X visualisation behaviourFor: self On: aspect Is: 'formatterCalling'.
X ].
X visualisation construction
X ).
X
X ^ contents = ( | s |
X s: mutableString copySize: textHolder size + 1 FillingWith: ' '.
X textHolder contentsInto: s.
X s
X ).
X
X ^ formatterCalling = ( formatter respond )
X| )
X
Xprototypes visualiser _AddSlotsIfAbsent: ( | ^ tEdit = () | )
XtEdit _Define: ( |
X _ parent* = traits tEdit.
X _ thisObjectPrints = true.
X
X ^ visualisation <- fabricateTEdit.
X ^ jotW.
X ^ textHolder.
X ^ formatter.
X ^ ruler.
X _ initialSz = 1024.
X
X ^ printString = 'a tEdit'
X| )
END_OF_SelfNews/tEdit.self
if test 1458 -ne `wc -c <SelfNews/tEdit.self`; then
echo shar: \"SelfNews/tEdit.self\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f SelfNews/wireI.C -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"SelfNews/wireI.C\"
else
echo shar: Extracting \"SelfNews/wireI.C\" \(12261 characters\)
sed "s/^X//" >SelfNews/wireI.C <<'END_OF_SelfNews/wireI.C'
X/* File wireI.C
X * created by Ian Wilkinson on Thu Sep 10 16:15:30 1992
X *
X * Copyright (c) Canon Research Centre Europe, 1992.
X * All rights reserved.
X */
X
X#include <_glueDefs.c.incl>
X#include <NeWS/psio.h>
X#include <wire/wire.h>
X#include <jot/jot.h>
X#include "wireIPS.h"
X
X// From unixPrims.h.
Xextern fd_set activeFDs; // active file descriptors
X
Xchar *WireSeal = "wire_Wire";
Xchar *JotViewSeal = "JotView";
Xchar *JotTextSeal = "JotText";
Xchar *JotRulerSeal = "JotRuler";
X
X#define toCntl( c ) (c & 037)
X
Xvoid
XkybdManager( JotView *jotView, char ch )
X{
X if (JotView_ReadOnly(jotView) == FALSE) {
X JotText *jotText;
X int caretPosn;
X jotText = JotView_Text(jotView);
X caretPosn = JotText_Caret(jotText);
X
X switch (ch) {
X case toCntl('D'):
X case '\177':
X (void)JotText_DeleteCharacters(jotText, caretPosn, (ch == toCntl('D')) ?
X 1 : -1);
X break;
X
X case '\r':
X ch = '\n';
X default:
X JotText_InsertCharacters(jotText, caretPosn, &ch, 1);
X break;
X }
X JotView_EnsurePositionVisible(jotView, JotText_Caret(jotText));
X }
X}
X
Xint
XjotInitialize( int w )
X{
X Jot_Initialize((wire_Wire)w);
X return 1;
X}
X
XJotText *
XnewJotText( int initialSz )
X{
X return JotText_New(initialSz);
X}
X
Xint
XplaceAtEnd( char *text, JotText *jotText, void *FH )
X{
X int nChars;
X JotView *jotView;
X nChars = JotText_Characters(jotText);
X if (JotText_InsertString(jotText, nChars, text) == -1) {
X failure(FH, "JotText_InsertString");
X return 0;
X }
X if ((jotView = JotText_FirstView(jotText)) == 0) {
X failure(FH, "JotText_FirstView");
X return 0;
X }
X JotView_Update(jotView);
X return 1;
X}
X
XJotView *
XnewJotView( JotText *jotText, int isCanvasReqd, int w, void *FH )
X{
X JotView *jotView;
X wire_SetCurrent(w);
X jotView = JotView_New(jotText, (boolean)isCanvasReqd);
X JotView_SetEventHandlers(jotView, Jot_KEYBOARD_EVENT, kybdManager, Jot_NULL_EVENT);
X if (ps_flush_PostScript() == -1) {
X failure(FH, "ps_flush_PostScript in newJotView");
X return 0;
X }
X return jotView;
X}
X
Xint
XjotViewCanvas( JotView *jotView )
X{
X return JotView_Canvas(jotView);
X}
X
Xint
XjotViewSetReadOnly( int isProtected, JotView *jotView )
X{
X JotView_SetReadOnly(jotView, (boolean)isProtected);
X return 1;
X}
X
Xint
XjotViewAspects( JotView *jotView )
X{
X int tk;
X wire_Wire w;
X tk = JotView_Canvas(jotView);
X w = JotView_Wire(jotView);
X wire_SetCurrent(w);
X PSjotViewAspects(tk);
X return wire_ReadInt();
X}
X
Xint
XjotViewBehaviour( JotView *jotView, int *behaviour )
X{
X int tk;
X wire_Wire w;
X int aspects;
X tk = JotView_Canvas(jotView);
X w = JotView_Wire(jotView);
X wire_SetCurrent(w);
X PSjotViewBehaviour(tk);
X aspects = wire_ReadInt();
X for (int i = 0; i < aspects; i++)
X behaviour[i] = wire_ReadInt();
X return 1;
X}
X
Xint
XjotViewRespond( JotView *jotView, void *FH )
X{
X wire_Wire jotViewW;
X
X jotViewW = JotView_Wire(jotView);
X wire_SetCurrent(jotViewW);
X while (ps_check_input()) {
X wire_Handler callback;
X int tg;
X
X if (ps_peek_tag(&tg) == 1) {
X tg = wire_ReadTag();
X callback = wire_TagProc(tg);
X callback(tg, 0);
X }
X else {
X break;
X }
X }
X JotView_UpdateViews();
X return 1;
X}
X
XJotRuler *
XnewJotRuler()
X{
X return JotRuler_New();
X}
X
Xint
XjotFontInitialize( JotRuler *ruler, JotView *jotView, JotText *jotText )
X{
X JotFont *font;
X wire_Wire w;
X w = JotView_Wire(jotView);
X wire_SetCurrent(w);
X JotView_SetPrinterMatchFonts(jotView, TRUE);
X font = JotFont_New("LucidaSans");
X JotRuler_SetParameters(ruler, Jot_FONT, font,
X Jot_BOLD, FALSE,
X Jot_FONT_SIZE, 10,
X Jot_NULL_PARAMETER);
X JotText_SetDefaultRuler(jotText, ruler);
X return 1;
X}
X
Xint
XjotRulerSetParameter( JotRuler *ruler, int parameter, int value )
X{
X JotRuler_SetParameters(ruler, parameter, value, Jot_NULL_PARAMETER);
X return 1;
X}
X
Xint
XjotRulerSetFont( JotRuler *ruler, char *fontName )
X{
X JotFont *font;
X font = JotFont_New(fontName);
X JotRuler_SetParameters(ruler, Jot_FONT, font, Jot_NULL_PARAMETER);
X return 1;
X}
X
Xint
XjotRulerSetRulerName( JotRuler *ruler, char *rulerName )
X{
X JotRuler_SetParameters(ruler, Jot_RULER_NAME, rulerName, Jot_NULL_PARAMETER);
X return 1;
X}
X
Xint
XjotViewUpdate( int w, JotView *jotView )
X{
X wire_SetCurrent(w);
X JotView_Update(jotView);
X return 1;
X}
X
Xint
XjotTextSize( JotText *jotText )
X{
X return JotText_Characters(jotText);
X}
X
Xint
XjotTextContentsInto( char *s, JotText *jotText, void *FH )
X{
X int jotTextSz;
X JotSpan *jotSpan;
X jotTextSz = JotText_Characters(jotText);
X if ((jotSpan = JotSpan_New(jotText, 0, jotTextSz)) == 0) {
X failure(FH, "...in jotTextContentsInto: JotSpan_New");
X return 0;
X }
X if (JotSpan_Contents(jotSpan, s) == -1) {
X failure(FH, "...in jotTextContentsInto: JotSpan_Contents");
X return 0;
X }
X JotSpan_Free(jotSpan);
X return 1;
X}
X
Xint
XwireAllocateTags( int w, int nTgs )
X{
X wire_SetCurrent((wire_Wire)w);
X return wire_AllocateTags(nTgs);
X}
X
Xint
XwireAllocateTokens( int w, int nTks )
X{
X return wire_AllocateTokens((wire_Wire)w, nTks);
X}
X
Xint
XwireDeallocateToken( int w, int tk )
X{
X return wire_DeallocateTokens((wire_Wire)w, tk, 1);
X}
X
Xint
XwireClose( int w, void *FH )
X{
X if (wire_Close((wire_Wire)w) == FALSE) {
X failure(FH, wire_ErrorString());
X return 0;
X }
X return 1;
X}
X
Xint
XwireCurrent()
X{
X return wire_Current();
X}
X
Xint
XwireEnable( int w, void *FH )
X{
X if (wire_Enable((wire_Wire)w) == FALSE) {
X failure(FH, wire_ErrorString());
X return 0;
X }
X return 1;
X}
X
Xchar*
XwireErrorString()
X{
X return wire_ErrorString();
X}
X
Xint
XwireInputFd( int w )
X{
X PSFILE *psiop;
X psiop = wire_PSinput(w);
X return psio_fileno(psiop);
X}
X
Xint
XwireOutputFd( int w )
X{
X PSFILE *psiop;
X psiop = wire_PSoutput(w);
X return psio_fileno(psiop);
X}
X
Xint
XwireOpen( char *display, void *FH )
X{
X wire_Wire w;
X if ((w = wire_Open(display)) == wire_INVALID_WIRE) {
X failure(FH, wire_ErrorString());
X return 0;
X }
X FD_SET(wireOutputFd(w), &activeFDs);
X return w;
X}
X
Xint
XwireReadTag( int w )
X{
X wire_SetCurrent((wire_Wire)w);
X return wire_ReadTag();
X}
X
Xint
XwireReadInt( int w )
X{
X wire_SetCurrent((wire_Wire)w);
X return wire_ReadInt();
X}
X
Xchar*
XwireReadString( int w, char *aString )
X{
X wire_SetCurrent((wire_Wire)w);
X return wire_ReadString(aString);
X}
X
Xint
XwireSetCurrent( int w, void *FH )
X{
X if (wire_SetCurrent((wire_Wire)w) == FALSE) {
X failure(FH, wire_ErrorString());
X return 0;
X }
X return 1;
X}
X
Xint
XwireSkipEvent( int w, void *FH )
X{
X wire_SetCurrent((wire_Wire)w);
X if (wire_SkipEvent() == FALSE) {
X failure(FH, wire_ErrorString());
X return 0;
X }
X return 1;
X}
X
Xint
XwireValid( int w, void *FH )
X{
X if (wire_Valid((wire_Wire)w) == FALSE) {
X failure(FH, wire_ErrorString());
X return 0;
X }
X return 1;
X}
X
Xint
XwireWouldNotify( int w )
X{
X return wire_WouldNotify((wire_Wire)w);
X}
X
Xint
XwireInvalidWire()
X{
X return wire_INVALID_WIRE;
X}
X
Xint
XpsLoadPackages( int w, void *FH )
X{
X wire_SetCurrent((wire_Wire)w);
X PSloadPackages();
X if (ps_flush_PostScript() == -1) {
X failure(FH, "Problem with psLoadPackages");
X return 0;
X }
X return 1;
X}
X
Xint
XpsSend( int w, char *psFragment, void *FH )
X{
X wire_SetCurrent((wire_Wire)w);
X PSsend(psFragment);
X if (ps_flush_PostScript() == -1) {
X failure(FH, "Problem with psSend");
X return 0;
X }
X return 1;
X}
X
Xint
XpsSendTo( int w, int tk, char *psFragment, void *FH )
X{
X wire_SetCurrent((wire_Wire)w);
X PSsendTo(tk, psFragment);
X if (ps_flush_PostScript() == -1) {
X failure(FH, "Problem with psSendTo");
X return 0;
X }
X return 1;
X}
X
Xint
XpsSyncReply( int w, int tk, char *psFragment, void *FH )
X{
X wire_SetCurrent((wire_Wire)w);
X PSsyncReply(tk, psFragment);
X if (ps_flush_PostScript() == -1) {
X failure(FH, "Problem with psSyncReply");
X return 0;
X }
X return 1;
X}
X
Xint
XpsFlushPostScript( int w, void *FH )
X{
X wire_SetCurrent((wire_Wire)w);
X if (ps_flush_PostScript() == -1) {
X failure(FH, "Problem with ps_flush_PostScript");
X return 0;
X }
X return 1;
X}
X
Xint
XpeekTag( int w, void *FH )
X{
X int isTg, tg;
X wire_SetCurrent((wire_Wire)w);
X if ((isTg = ps_peek_tag(&tg)) == -1) {
X failure(FH, "Problem with ps_peek_tag");
X return 0;
X }
X return (isTg ? tg : -1);
X}
X
Xint
XcheckInput( int w, void *FH )
X{
X int isEmpty;
X wire_SetCurrent((wire_Wire)w);
X if ((isEmpty = ps_check_input()) == -1) {
X failure(FH, "Problem with ps_check_input");
X return 0;
X }
X return isEmpty;
X}
X
X#define WHAT_GLUE FUNCTIONS
X C_func_2(int,, wireAllocateTags, allocateTagsGlue,, proxy, (int, WireSeal), int,)
X C_func_2(int,, wireAllocateTokens, allocateTokensGlue,, proxy, (int, WireSeal), int,)
X C_func_2(bool,, wireDeallocateToken, deallocateTokenGlue,, proxy, (int, WireSeal), int,)
X C_func_1(bool,, wireClose, closeGlue, fail, proxy, (int, WireSeal))
X C_func_0(int,, wireCurrent, currentGlue,)
X C_func_1(bool,, wireEnable, enableGlue, fail, proxy, (int, WireSeal))
X C_func_0(string,, wireErrorString, errorStringGlue,)
X C_func_1(proxy, (int, WireSeal), wireOpen, openGlue, fail, string,)
X C_func_1(int,, wireReadTag, readTagGlue,, proxy, (int, WireSeal))
X C_func_1(int,, wireReadInt, readIntGlue,, proxy, (int, WireSeal))
X C_func_2(string,, wireReadString, readStringGlue,, proxy, (int, WireSeal), string,)
X C_func_1(bool,, wireSetCurrent, setCurrentGlue, fail, proxy, (int, WireSeal))
X C_func_1(bool,, wireSkipEvent, skipEventGlue, fail, proxy, (int, WireSeal))
X C_func_1(bool,, wireValid, validGlue, fail, proxy, (int, WireSeal))
X C_func_1(bool,, wireWouldNotify, wouldNotifyGlue,, proxy, (int, WireSeal))
X C_func_0(int,, wireInvalidWire, invalidWireGlue,)
X C_func_1(int,, wireInputFd, wireInputFdGlue,, proxy, (int, WireSeal))
X C_func_1(int,, wireOutputFd, wireOutputFdGlue,, proxy, (int, WireSeal))
X C_func_1(int,, psLoadPackages, loadPackagesGlue, fail, proxy, (int, WireSeal))
X C_func_2(int,, psSend, sendGlue, fail, proxy, (int, WireSeal), string,)
X C_func_3(int,, psSendTo, sendToGlue, fail, proxy, (int, WireSeal), int,, string,)
X C_func_3(int,, psSyncReply, syncReplyGlue, fail, proxy, (int, WireSeal), int,, string,)
X C_func_1(int,, psFlushPostScript, flushPostScriptGlue, fail, proxy, (int, WireSeal))
X C_func_1(int,, peekTag, peekTagGlue, fail, proxy, (int, WireSeal))
X C_func_1(bool,, checkInput, checkInputGlue, fail, proxy, (int, WireSeal))
X C_func_1(bool,, jotInitialize, jotInitializeGlue,, proxy, (int, WireSeal))
X C_func_1(proxy_null, (JotText *, JotTextSeal), newJotText, newJotTextGlue,, int,)
X C_func_3(proxy_null, (JotView *, JotViewSeal), newJotView, newJotViewGlue, fail,
X proxy, (JotText *, JotTextSeal), bool,, proxy, (int, WireSeal))
X C_func_2(bool,, placeAtEnd, placeAtEndGlue, fail, string,, proxy, (JotText *, JotTextSeal))
X C_func_1(int,, jotTextSize, sizeGlue,, proxy, (JotText *, JotTextSeal))
X C_func_2(bool,, jotTextContentsInto, contentsIntoGlue, fail,
X bv, char *, proxy, (JotText *, JotTextSeal))
X C_func_2(bool,, jotViewSetReadOnly, jotViewSetReadOnlyGlue,,
X bool,, proxy, (JotView *, JotViewSeal))
X C_func_1(int,, jotViewCanvas, jotViewCanvasGlue,, proxy, (JotView *, JotViewSeal))
X C_func_1(int,, jotViewAspects, jotViewAspectsGlue,, proxy, (JotView *, JotViewSeal))
X C_func_2(int,, jotViewBehaviour, jotViewBehaviourGlue,,
X proxy, (JotView *, JotViewSeal), bv, int *)
X C_func_1(bool,, jotViewRespond, jotViewRespondGlue, fail, proxy, (JotView *, JotViewSeal))
X C_func_2(bool,, jotViewUpdate, jotViewUpdateGlue,, proxy, (int, WireSeal), proxy, (JotView *, JotViewSeal))
X C_func_0(proxy_null, (JotRuler *, JotRulerSeal), newJotRuler, newJotRulerGlue,)
X C_func_3(bool,, jotFontInitialize, jotFontInitializeGlue,,
X proxy, (JotRuler *, JotRulerSeal),
X proxy, (JotView *, JotViewSeal),
X proxy, (JotText *, JotTextSeal))
X C_func_3(bool,, jotRulerSetParameter, jotRulerSetParameterGlue,,
X proxy, (JotRuler *, JotRulerSeal), int,, int,)
X C_func_2(bool,, jotRulerSetFont, jotRulerSetFontGlue,,
X proxy, (JotRuler *, JotRulerSeal), string,)
X C_func_2(bool,, jotRulerSetRulerName, jotRulerSetRulerNameGlue,,
X proxy, (JotRuler *, JotRulerSeal), string,)
X#undef WHAT_GLUE
END_OF_SelfNews/wireI.C
if test 12261 -ne `wc -c <SelfNews/wireI.C`; then
echo shar: \"SelfNews/wireI.C\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f SelfNews/wireI.self -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"SelfNews/wireI.self\"
else
echo shar: Extracting \"SelfNews/wireI.self\" \(5921 characters\)
sed "s/^X//" >SelfNews/wireI.self <<'END_OF_SelfNews/wireI.self'
X" File wireI.self
X created by Ian Wilkinson on Thu Sep 10 15:38:48 1992
X
X Copyright (c) Canon Research Centre Europe, 1992.
X All rights reserved."
X
Xprototypes system _AddSlotsIfAbsent: ( | ^ wireFct = () | )
X
X(wireFct _Define: foreignFct copyName: 'openGlue'
X Path: (unix environmentVariable: 'SELF_NEWS'), '/wireI.so')
X
Xtraits system _AddSlotsIfAbsent: ( | ^ wireI = () | )
Xtraits wireI _Define: ( |
X _ parent* = traits proxy.
X
X ^ allocateTags: nTg = (
X | connection = wireFct copyName: 'allocateTagsGlue'. |
X connection value: self With: nTg
X ).
X
X ^ allocateTokens: nTk = (
X | connection = wireFct copyName: 'allocateTokensGlue'. |
X connection value: self With: nTk
X ).
X
X ^ deallocateToken: tk = (
X (wireFct copyName: 'deallocateTokenGlue') value: self With: tk
X ).
X
X ^ close = (
X | connection = wireFct copyName: 'closeGlue'. |
X connection value: self
X ).
X
X ^ current = (
X | connection = wireFct copyName: 'currentGlue'. |
X connection value
X ).
X
X ^ enable = (
X | connection = wireFct copyName: 'enableGlue'. |
X connection value: self
X ).
X
X ^ errorString = (
X | connection = wireFct copyName: 'errorStringGlue'. |
X connection value
X ).
X
X ^ open = ( open: '' ).
X ^ open: onDisplay = (
X | connection = wireFct copyName: 'openGlue'. |
X connection value: onDisplay With: deadCopy
X ).
X
X ^ readTag = (
X | connection = wireFct copyName: 'readTagGlue'. |
X connection value: self
X ).
X
X ^ readInteger = (
X | connection = wireFct copyName: 'readIntGlue'. |
X connection value: self
X ).
X
X ^ readString: s = (
X | connection = wireFct copyName: 'readStringGlue'. |
X connection value: self With: s
X ).
X
X ^ setCurrent = (
X | connection = wireFct copyName: 'setCurrentGlue'. |
X connection value: self
X ).
X
X ^ skipEvent = (
X | connection = wireFct copyName: 'skipEventGlue'. |
X connection value: self
X ).
X
X ^ valid = (
X | connection = wireFct copyName: 'validGlue'. |
X connection value: self
X ).
X
X ^ wouldNotify = (
X | connection = wireFct copyName: 'wouldNotifyGlue'. |
X connection value: self
X ).
X
X ^ invalidWire = (
X | connection = wireFct copyName: 'invalidWireGlue'. |
X connection value: self
X ).
X
X ^ wireInputFd = (
X | connection = wireFct copyName: 'wireInputFdGlue'. |
X connection value: self
X ).
X
X ^ wireOutputFd = (
X | connection = wireFct copyName: 'wireOutputFdGlue'. |
X connection value: self
X ).
X
X ^ loadPackages = (
X | connection = wireFct copyName: 'loadPackagesGlue'. |
X connection value: self.
X self
X ).
X
X ^ send: psFragment = (
X | connection = wireFct copyName: 'sendGlue'. |
X connection value: self With: psFragment
X ).
X
X ^ sendTo: obj With: psFragment = (
X | connection = wireFct copyName: 'sendToGlue'. |
X connection value: self With: obj With: psFragment
X ).
X
X ^ syncReply: obj With: psFragment = (
X (wireFct copyName: 'syncReplyGlue') value: self With: obj With: psFragment
X ).
X
X ^ flushPostScript = (
X | connection = wireFct copyName: 'flushPostScriptGlue'. |
X connection value: self
X ).
X
X ^ peekTag = (
X | connection = wireFct copyName: 'peekTagGlue'. |
X connection value: self
X ).
X
X ^ messageOnWire = (
X | connection = wireFct copyName: 'checkInputGlue'. |
X connection value: self
X ).
X
X ^ fileDescriptor = ( wireOutputFd )
X| )
X
Xprototypes system _AddSlotsIfAbsent: ( | ^ wireI = () | )
XwireI _Define: proxy deadCopy _AddSlots: ( |
X _ parent* = traits wireI.
X| )
X
Xoddballs system _AddSlotsIfAbsent: ( | ^ postScriptMachine = () | )
XpostScriptMachine _Define: ( |
X _ parent* = traits oddball.
X
X ^ messageMachine = wireI open.
X ^ messageSelf = wireI open.
X ^ protMesgMach = semaphore copyBinary.
X ^ protMesgSelf = semaphore copyBinary.
X ^ objectBehaviour = dictionary copyRemoveAll.
X ^_ listener.
X
X ^ machineCalling = ( messageSelf messageOnWire ).
X
X ^ initialize = (
X messageMachine loadPackages.
X messageSelf loadPackages.
X messageSelf send: '
X shareddict /MessageSelf currentfile put
X shareddict /MessageSelfListenerProc currentprocess soften put
X shareddict /MessageSelfProt createmonitor put
X '.
X messageMachine send: '
X shareddict /MessageMachine currentfile put
X '.
X listener: (process copySend:
X message copy receiver: self Selector: 'watchMachine') resume
X ).
X
X ^ watchMachine = ( | postScriptInput |
X postScriptInput:
X unixFile copyFd: messageSelf fileDescriptor Name: 'messageSelf'.
X [
X postScriptInput suspend.
X machineCalling ifTrue: [ messageTarget ].
X process this yield
X ] loop
X ).
X
X _ messageTarget = ( | tg |
X [
X tg: messageSelf peekTag.
X (tg < 0) ifTrue: [ warning: 'postScriptMachine wire problem.' ].
X (tg = 0)
X ifTrue: [ "messageSelf flushPostScript" ]
X False: [
X (objectBehaviour includesKey: tg)
X ifTrue: [ (objectBehaviour at: tg) send ]
X False: [ messageSelf readTag ]
X ]
X ] untilFalse: [ machineCalling ]
X ).
X
X ^ sendPS: psFragment = (
X protMesgMach protect: [ messageMachine send: psFragment ]
X ).
X
X ^ affect: objectReference With: action = (
X protMesgMach protect: [ messageMachine sendTo: objectReference With: action ]
X ).
X
X ^ behaviourFor: obj WithReprObj: reprObj On: evt Is: action = (
X objectBehaviour at: evt Put: message copy receiver: obj Selector: action
X ).
X
X ^ fashionReprObject = (
X messageMachine allocateTokens: 1
X ).
X
X ^ fashionAspects: aspects = (
X messageMachine allocateTags: aspects
X ).
X
X ^ reclaimResourcesFrom: visualisation = ( | reprBehav |
X messageMachine deallocateToken: visualisation representationObject.
X reprBehav: visualisation representationBehaviour.
X visualisation aspects do: [ | :aspect |
X objectBehaviour removeKey: (reprBehav + aspect) - 1 IfAbsent: [
X warning: 'Object behaviour does not exist'
X ]
X ]
X )
X| )
X
XpostScriptMachine initialize
END_OF_SelfNews/wireI.self
if test 5921 -ne `wc -c <SelfNews/wireI.self`; then
echo shar: \"SelfNews/wireI.self\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f SelfNews/wireIPS.cps -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"SelfNews/wireIPS.cps\"
else
echo shar: Extracting \"SelfNews/wireIPS.cps\" \(3746 characters\)
sed "s/^X//" >SelfNews/wireIPS.cps <<'END_OF_SelfNews/wireIPS.cps'
X% File wireIPS.cps
X% created by Ian Wilkinson on Sat Sep 12 22:51:33 1992
X%
X% Copyright (c) Canon Research Centre Europe, 1992.
X% All rights reserved.
X
Xcdef PSloadPackages()
X /NeWS 3 0 findpackage beginpackage
X /TNTCore 3 0 findpackage beginpackage
X /TNT 3 0 findpackage beginpackage
X
X /ClassGeneric nullarray
X dictbegin
X /offsetX 0 def
X /offsetY 0 def
X dictend
X classbegin
X /methoddict { % [ argNames ] [ localNames ] => dict
X 0
X 2 index {
X dup null eq {
X pop
X }{
X /promoted? self send not { 1 add } if
X } ifelse
X } forall
X
X 1 index length add dict
X begin
X { null def } forall
X
X arrayreverse {
X dup null eq {
X pop pop
X }{
X dup /promoted? self send
X { exch store } { exch def } ifelse
X } ifelse
X } forall
X
X currentdict
X end
X } def
X
X /methodstacktodict { % [ argNames ] => -
X arrayreverse {
X dup null eq {
X pop pop
X }{
X dup /promoted? self send { exch store } { exch def } ifelse
X } ifelse
X } forall
X } def
X
X /containingWindow { % - => canvas
X [] [ /can ] methoddict
X begin
X /parents self send {
X /can exch store
X can /descendantof? ClassWindow send { exit } if
X } forall
X can framebuffer eq { null }{ can } ifelse
X end
X } def
X
X /installStdBehaviour { % - => -
X [] [ /theMenu ] methoddict
X begin
X true /setdamageable self send
X true /settrackable self send
X true /setfrontable self send
X true /setmenuable self send
X /theMenu /Grid framebuffer /new ClassMenu send store
X [
X [ (Quit) /removeFromWorld ]
X ] /setitemlist theMenu send
X self /settarget theMenu send
X theMenu /setmenu self send
X
X /TrackStart { % evt => /Default true
X [ /evt ] [] methoddict
X begin
X /totop self send
X gsave
X self setcanvas
X evt /Coordinates get aload pop
X /offsetY exch store
X /offsetX exch store
X grestore
X /Default true
X end
X } /installmethod self send
X
X /TrackMotion { % evt => -
X /Coordinates get aload pop offsetX offsetY xysub
X /move self send
X } /installmethod self send
X end
X } def
X
X /messageSyncSelf { % [ args ... ] methodName object => -
X [ /args /methodName /obj ] [ /wireProcF ] methoddict
X begin
X shareddict /MessageSelfProt get {
X /wireProcF wireProcess /Stdout get store
X wireProcess /Stdout shareddict /MessageSelf get put
X args methodName obj wiresendsync
X wireProcess /Stdout wireProcF put
X } monitor
X end
X } def
X
X /messageSelf { % [ args ... ] methodName object => -
X [ /args /methodName /obj ] [] methoddict
X begin
X shareddict /MessageSelfProt get {
X %%CHANGE. Terrible hack.
X wireProcess
X /wireProcess
X {} fork dup suspendprocess
X dup /Stdout shareddict /MessageSelf get put
X store
X args methodName obj wiresend
X /wireProcess exch store
X } monitor
X end
X } def
X
X /removeFromWorld { % cntl => -
X /unmap self send %%CHANGE. Find remaining reference.
X [] /QuitApp self messageSelf
X pop EventMgr /destroy self send /destroy exch send
X } def
X
X /vieForAttention { % - => -
X /totop self send
X } def
X classend def
X
X
Xcdef PSsend( postscript psFragment )
X psFragment
X
Xcdef PSsendTo( token tk, postscript psFragment )
X psFragment tk send
X
Xcdef PSsyncReply( int tk, postscript theReply )
X [ theReply ] /wireresume tk shareddict /MessageMachine get getfileinputtoken send
X
X#define JotViewAspects 2000
Xcdef PSjotViewAspects( token tk ) => JotViewAspects( )
X JotViewAspects tagprint
X /wire_Tags tk send length typedprint
X
X#define JotViewBehaviour 2001
Xcdef PSjotViewBehaviour( token tk ) => JotViewBehaviour( )
X JotViewBehaviour tagprint
X /wire_Tags tk send dup length typedprint
X { typedprint pop } forall
END_OF_SelfNews/wireIPS.cps
if test 3746 -ne `wc -c <SelfNews/wireIPS.cps`; then
echo shar: \"SelfNews/wireIPS.cps\" unpacked with wrong size!
fi
# end of overwriting check
fi
echo shar: End of shell archive.
exit 0
More information about the Self-interest
mailing list