DeviceWorkstation.st
changeset 9018 c795f1c356f5
parent 9015 4f7ab2f7a5fa
child 9020 8b06aef41a3c
equal deleted inserted replaced
9017:11edba40324e 9018:c795f1c356f5
   410 
   410 
   411     |newDevice someScreen|
   411     |newDevice someScreen|
   412 
   412 
   413     newDevice := self newFor:aScreenName.
   413     newDevice := self newFor:aScreenName.
   414     newDevice startDispatch.
   414     newDevice startDispatch.
   415     (someScreen := Screen current) isNil ifTrue:[
   415     (someScreen := self current) isNil ifTrue:[
   416 	someScreen := Screen default.
   416         someScreen := self default.
   417     ].
   417     ].
   418     someScreen notNil ifTrue:[
   418     someScreen notNil ifTrue:[
   419 	newDevice keyboardMap:(someScreen keyboardMap).
   419         newDevice keyboardMap:(someScreen keyboardMap).
   420 	newDevice buttonTranslation:(someScreen buttonTranslation).
   420         newDevice buttonTranslation:(someScreen buttonTranslation).
   421     ].
   421     ].
   422 
   422 
   423     "/ arrange for it to finish its event dispatch loop,
   423     "/ arrange for it to finish its event dispatch loop,
   424     "/ when the last view on it is closed.
   424     "/ when the last view on it is closed.
   425     newDevice exitOnLastClose:true.
   425     newDevice exitOnLastClose:true.
   439      if nil, the name is extracted from command-line-arguments or the environment.
   439      if nil, the name is extracted from command-line-arguments or the environment.
   440      Raise a signal if open fails."
   440      Raise a signal if open fails."
   441 
   441 
   442     |display displayName|
   442     |display displayName|
   443 
   443 
   444     displayName := aStringOrNil ? Screen defaultDisplayName.
   444     displayName := aStringOrNil ? self defaultDisplayName.
   445 
   445 
   446     "find out about the concrete Workstation class"
   446     "find out about the concrete Workstation class"
   447     Screen isAbstract ifTrue:[
   447     Screen isAbstract ifTrue:[
   448 	|wsClass wsClasses|
   448         |wsClass wsClasses|
   449 
   449 
   450 	wsClasses := OrderedCollection new.
   450         wsClasses := OrderedCollection new.
   451 
   451 
   452 	#(OpenGLWorkstation GLXWorkstation XWorkstation)
   452         wsClass := #(OpenGLWorkstation GLXWorkstation XWorkstation)
   453 	    detect:[:eachClassNameSymbol| (wsClass := Smalltalk classNamed:eachClassNameSymbol) notNil] ifNone:nil.
   453                         detect:[:eachClassNameSymbol| (Smalltalk classNamed:eachClassNameSymbol) notNil] ifNone:nil.
   454 	wsClass notNil ifTrue:[wsClasses add:wsClass].
   454         wsClass notNil ifTrue:[
   455 
   455             wsClasses add:wsClass
   456 	"preparation for WIN32/NeXTStep/OS2 and Mac interfacing;
   456         ].
   457 	 But if X11 is linked in and it is capable of setting up a connection, that will be used."
   457 
   458 	#(
   458         "preparation for WIN32/NeXTStep/OS2 and Mac interfacing;
   459 	    "/ #NeXTWorkstation  nil
   459          But if X11 is linked in and it is capable of setting up a connection, that will be used."
   460 	    OS2Workstation       isOS2like
   460         #(
   461 	    MacWorkstation       isMAClike
   461             "/ NeXTWorkstation  nil
   462 	    WinWorkstation       isMSWINDOWSlike
   462             OS2Workstation       isOS2like
   463 	    ElectronWorkstation  nil
   463             MacWorkstation       isMAClike
   464 	) pairWiseDo:[:wsClassName :checkSel|
   464             WinWorkstation       isMSWINDOWSlike
   465 	    (checkSel isNil or:[OperatingSystem perform:checkSel]) ifTrue:[
   465             ElectronWorkstation  nil
   466 		(wsClass := Smalltalk classNamed:wsClassName) notNil ifTrue:[
   466         ) pairWiseDo:[:wsClassName :checkSel|
   467 		    wsClasses add:wsClass.
   467             ((checkSel isNil or:[OperatingSystem perform:checkSel])
   468 		]
   468              and:[(wsClass := Smalltalk classNamed:wsClassName) notNil]) ifTrue:[
   469 	    ].
   469                 wsClasses add:wsClass.
   470 	].
   470             ].
   471 
   471         ].
   472 	"/ try all classes until open of display works.
   472 
   473 	wsClasses detect:[:cls|
   473         "/ try all classes until open of display works.
   474 		[
   474         wsClasses detect:[:eachWorkstationClass|
   475 		    display := cls newFor:displayName.
   475                 [
   476 		] on:Screen deviceOpenErrorSignal do:[:ex| ].
   476                     display := eachWorkstationClass newFor:displayName.
   477 		display notNil
   477                 ] on:eachWorkstationClass deviceOpenErrorSignal do:[:ex| ].
   478 	    ] ifNone:nil.
   478                 display notNil
       
   479             ] ifNone:nil.
   479 
   480 
   480     ] ifFalse:[
   481     ] ifFalse:[
   481 	display := Screen newFor:displayName.
   482         display := Screen newFor:displayName.
   482     ].
   483     ].
   483     display isNil ifTrue:[
   484     display isNil ifTrue:[
   484 	Screen deviceOpenErrorSignal raiseWith:displayName.
   485         Screen deviceOpenErrorSignal raiseWith:displayName.
   485     ].
   486     ].
   486     Screen := display class.
   487     Screen := display class.
   487     Screen default:display.
   488     Screen default:display.
       
   489 
       
   490     ^ display.
   488 ! !
   491 ! !
   489 
   492 
   490 !DeviceWorkstation class methodsFor:'Signal constants'!
   493 !DeviceWorkstation class methodsFor:'Signal constants'!
   491 
   494 
   492 currentScreenQuerySignal
   495 currentScreenQuerySignal
  1677     |view id|
  1680     |view id|
  1678 
  1681 
  1679     id := self viewIdFromPoint:aScreenPoint.
  1682     id := self viewIdFromPoint:aScreenPoint.
  1680     view := self viewFromId:id.
  1683     view := self viewFromId:id.
  1681     view isNil ifTrue:[
  1684     view isNil ifTrue:[
  1682 	"/ search on other devices (if present).
  1685         "/ search on other devices (if present).
  1683 	"/ This may find the view, in case another device
  1686         "/ This may find the view, in case another device
  1684 	"/ has its views on the same display screen
  1687         "/ has its views on the same display screen
  1685 	"/ (i.e. under X, if its another display connection to the same
  1688         "/ (i.e. under X, if its another display connection to the same
  1686 	"/  X-server)
  1689         "/  X-server)
  1687 	Screen allScreens do:[:aScreen |
  1690         self class allScreens do:[:aScreen |
  1688 	    |v|
  1691             |v|
  1689 
  1692 
  1690 	    aScreen ~~ self ifTrue:[
  1693             aScreen ~~ self ifTrue:[
  1691 		(v := aScreen viewFromId:id) notNil ifTrue:[
  1694                 (v := aScreen viewFromId:id) notNil ifTrue:[
  1692 		    ^ v
  1695                     ^ v
  1693 		]
  1696                 ]
  1694 	    ]
  1697             ]
  1695 	]
  1698         ]
  1696     ].
  1699     ].
  1697     ^ view
  1700     ^ view
  1698 
  1701 
  1699     "Modified (comment): / 13-02-2017 / 20:00:41 / cg"
  1702     "Modified (comment): / 13-02-2017 / 20:00:41 / cg"
  1700 !
  1703 !